cookie.pm

• Back
• Raw format

#	cookie.pm
#	Copyright (c) 2004 Jan Henning Thorsen, all rights reserved
#	URL: http://eidolon.flodhest.net E-MAIL: [email protected]
#============================================================================
	package cookie;
	use strict;
#============================================================================
sub cookie2cgi {

	### init
	my $cgi     = shift;
	my %default = config::cookie('default');
	my %cookie;

	### get cookie
	if(my $cookie = $cgi->cookie( config::cookie('name') )) {
		for(split /&&&/, $cookie) {
			my($k, $v)  = split /=/, $_, 2;
			$cookie{$k} = $v;
		}
	}

	### fix
	for my $key (config::cookie('keys')) {
		if(defined $cgi->param($key)) {
			next;
		}
		elsif(defined $cookie{$key}) {
			$cgi->param($key, $cookie{$key});
		}
		else {
			$cgi->param($key, $default{$key});
		}
	}
}
#============================================================================
sub outcookie {
	
	### init
	my $cgi     = shift;
	my $name    = config::cookie('name');
	my %options = config::cookie('options');

	### create cookie value
	my $value = join "&&&", map {
			"$_=" .$cgi->param($_);
		} config::cookie('keys');

	### the end
	return $cgi->cookie(
			-name    => $name,
			-value   => $value,
			-path    => $options{path}    || "/",
			-expires => $options{expires} || undef,
			-domain  => $options{domain}  || undef,
			-secure  => $options{secure}  || 0,
		);
}
#============================================================================
sub header {

	### fix cgi and cookie
	my $cgi = shift;
	cookie2cgi($cgi);

	### print header
	return $cgi->header({
			-type    => 'text/html',
			-charset => 'iso-8859-1',
			-cookie  => outcookie($cgi),
		});
}
#============================================================================
1;