[トップページ] [戻る]
#! /usr/local/bin/perl
#
#-------------------------------------------------------------
# Cookie
#-------------------------------------------------------------
#

# Cookieデータ取得
	&get_cookie();
	
	$count = $COOKIE{'counter'};
	if ($count eq "")
		{$count = 0;}
	$count++;

# Cookieデータセット/HTML出力
	print &set_cookie("counter", $count);
	print "Content-type: text/html\n\n";
	print "<HTML>\n";
	print "<HEAD>\n";
	print "<TITLE>Cookie Test</TITLE>\n";
	print "</HEAD>\n";
	print "<BODY BGCOLOR=\"#FFFFFF\" TEXT=\"000000\">\n";
	print "$count 回目の訪問です。ありがとうございます。<BR>\n";
	print "</BODY>\n";
	print "</HTML>\n";

	exit;

#-------------------------------------------------------------
sub get_Cookie {
	local($str);
	local($name);
	local($value);

# 環境変数HTTP_COOKIEよりCookieデータを取得
    for $str (split(/; */, $ENV{'HTTP_COOKIE'})) {
        ($name, $value) = split(/=/, $str);
	# データのデコード
        $value =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C", hex($1))/eg;
        $COOKIE{$name} = $value;
    }
}
#-------------------------------------------------------------
sub set_Cookie {
    local($value);
    local($cookie_data);

# データのエンコード
    $value = $_[1];
    $value =~ s/(\W)/sprintf("%%%02X", unpack("C", $1))/eg;

# Cookieデータのセット
    $cookie_data = "Set-Cookie: ";
    $cookie_data .= "$_[0]=$value; ";
    $cookie_data .= "expires=Fri, 31-Dec-1999 23:59:59 GMT; \n";

    return ($cookie_data);
}

[トップページ] [戻る]
Copyright (C) 2000 Me All rights reserved
Mail To webmaster