Gossamer Forum
Home : General : Perl Programming :

UBB, cookie

Quote Reply
UBB, cookie
This BB sets it's cookies with javascript, but I would like to do it with perl!

In this cookie-lib.pl (of the BB) you can see that it has a sub set_cookie.

But I don't know how to call the sub (&set_cookie(??????) Wink ?


Code:

sub get_cookie {
local($chip, $val);
foreach (split(/; /, $ENV{'HTTP_COOKIE'})) {
# split cookie at each ; (cookie format is name=value; name=value; etc...)
# Convert plus to space (in case of encoding (not necessary, but recommended)
s/\+/ /g;
# Split into key and value.
($chip, $val) = split(/=/,$_,2); # splits on the first =.
# Convert %XX from hex numbers to alphanumeric
$chip =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
$val =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
# Associate key and value
$cookie{$chip} .= "\1" if (defined($cookie{$chip})); # \1 is the multiple separator
$cookie{$chip} .= $val;
}
}

sub set_cookie {
# $expires must be in unix time format, if defined. If not defined it sets the expiration to December 31, 1999.
# If you want no expiration date set, set $expires = -1 (this causes the cookie to be deleted when user closes
# his/her browser).

local($expires,$domain,$path,$sec) = @_;
local(@days) = ("Sun","Mon","Tue","Wed","Thu","Fri","Sat");
local(@months) = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec");
local($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($expires) if ($expires > 0); #get date info if expiration set.
$sec = "0" . $sec if $sec < 10; # formatting of date variables
$min = "0" . $min if $min < 10;
$hour = "0" . $hour if $hour < 10;
local(@secure) = ("","secure"); # add security to the cookie if defined. I'm not too sure how this works.
if (! defined $expires) { $expires = " expires\=Wed, 31-Dec-1999 00:00:00 GMT;"; } # if expiration not set, expire at 12/31/1999
elsif ($expires == -1) { $expires = "" } # if expiration set to -1, then eliminate expiration of cookie.
else {
$year += 1900;
$expires = "expires\=$days[$wday], $mday-$months[$mon]-$year $hour:$min:$sec GMT; "; #form expiration from value passed to function.
}
if (! defined $domain) { $domain = $ENV{'SERVER_NAME'}; } #set domain of cookie. Default is current host.
if (! defined $path) { $path = "/"; } #set default path = "/"
if (! defined $secure) { $secure = "0"; }
local($key);
foreach $key (keys %cookie) {
$cookie{$key} =~ s/ /+/g; #convert plus to space.
print "Set-Cookie: $key\=$cookie{$key};$expires path\=$path domain\=$domain $secure[$sec]\n";
#print cookie to browser,
#this must be done *before* you print any content type headers.
}
}

sub delete_cookie {
# to delete a cookie, simply pass delete_cookie the name of the cookie to delete.
# you may pass delete_cookie more than 1 name at a time.
local(@to_delete) = @_;
local($name);
foreach $name (@to_delete) {
undef $cookie{$name}; #undefines cookie so if you call set_cookie, it doesn't reset the cookie.
print "Set-Cookie: $name=; expires=Thu, 01-Jan-1970 00:00:00 GMT; path=/\n";
#this also must be done before you print any content type headers.
}
}

sub split_cookie {
# split_cookie
# Splits a multi-valued parameter into a list of the constituent parameters

local ($param) = @_;
local (@params) = split ("\1", $param);
return (wantarray ? @params : $params[0]);
}
Quote Reply
Re: UBB, cookie In reply to
Yikes, just use CGI module! Smile To set a cookie:

Code:
# Make sure we load the module.
use CGI;

# First create a cookie object:
$c = new CGI::Cookie(
-name => 'foo',
-value => 'bar',
);
# Then print the headers to the browser and include the
# cookie.
print CGI->header( -cookie => $c );

To access a cookie:

Code:
my $in = new CGI;
my $value = $in->cookie ( -name => 'foo' );

Hope this helps,

Alex
Quote Reply
Re: UBB, cookie In reply to
Can I alsow set this cookie with an <!--#exec cgi="/cgi-bin/set-cookie.cgi"-->?