
package main;
;#----------------------------------------------------------------------------
;# cookie.pl : cookie関連 Perl パッケージ
;# http://www.junkperl.com/
;# Copyright (C) 2006- By HeRO
;# Ver 1.00 2006/08/09
;# 
;# このプログラムはフリーソフトウェアです。あなたはこれを、フリーソフトウェア
;# 財団によって発行された GNU 一般公衆利用許諾契約書(バージョン2か、希望によっ
;# てはそれ以降のバージョンのうちどれか)の定める条件の下で再頒布または改変する
;# ことができます。
;#
;# このプログラムは有用であることを願って頒布されますが、*全くの無保証* です。
;# 商業可能性の保証や特定の目的への適合性は、言外に示されたものも含め全く存在
;# しません。詳しくはGNU 一般公衆利用許諾契約書をご覧ください。
;#
;# あなたはこのプログラムと共に、GNU 一般公衆利用許諾契約書の複製物を一部受け
;# 取ったはずです。もし受け取っていなければ、フリーソフトウェア財団まで請求し
;# てください(宛先は the Free Software Foundation, Inc., 59 Temple Place,
;# Suite 330, Boston, MA 02111-1307 USA)。
;#----------------------------------------------------------------------------
sub set_cookie_onetime {
	local( $cookkey, $cookvalue ) = @_;
	local($gmt, $cook, @t, @m, @w);
	print "Set-Cookie: $cookkey=$cookvalue;\n";					# ワンタイム
}
;#----------------------------------------------------------------------------
sub set_cookie {
	local( $cookkey, $cookvalue ) = @_;
	local($gmt, $cook, @t, @m, @w);
	@t = gmtime(time + 60*60);
#	@t = gmtime(time - 1);				# cookie を消すとき
	@m = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
	@w = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
	$gmt = sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",
			$w[$t[6]], $t[3], $m[$t[4]], $t[5]+1900, $t[2], $t[1], $t[0]);
	print "Set-Cookie: $cookkey=$cookvalue; expires=$gmt;\n";
}
;#----------------------------------------------------------------------------
sub get_cookie {
	local( $cookkey, *cookie ) = @_;
	local( $key, $val, @cook, $retcd );

	$retcd = 0;
	@cook = split( /;/, $ENV{'HTTP_COOKIE'} );
	foreach( @cook ){
		($key, $val) = split( /=/ );
		$key =~ s/\s//g;
		if( $key eq $cookkey ){
			%cookie = split( /<>/, $val );
			$retcd = 1;
			last;
		}
	}
	return $retcd;
}
;#----------------------------------------------------------------------------

1;

