[トップページ]
[戻る]
#! /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