102 lines
2.8 KiB
Perl
102 lines
2.8 KiB
Perl
# ==================================================================
|
|
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
|
#
|
|
# GT::CGI::Cookie
|
|
# CVS Info :
|
|
# $Id: Cookie.pm,v 1.5 2004/08/19 23:49:30 jagerman Exp $
|
|
#
|
|
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
# ==================================================================
|
|
#
|
|
# Description:
|
|
# Handles cookie creation and formatting
|
|
#
|
|
|
|
package GT::CGI::Cookie;
|
|
#================================================================================
|
|
|
|
use strict;
|
|
use GT::CGI;
|
|
use GT::Base;
|
|
use vars qw/@ISA $ATTRIBS @MON @WDAY/;
|
|
|
|
@ISA = qw/GT::Base/;
|
|
|
|
$ATTRIBS = {
|
|
-name => '',
|
|
-value => '',
|
|
-expires => '',
|
|
-path => '',
|
|
-domain => '',
|
|
-secure => ''
|
|
};
|
|
@MON = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
|
|
@WDAY = qw/Sun Mon Tue Wed Thu Fri Sat/;
|
|
|
|
sub cookie_header {
|
|
#--------------------------------------------------------------------------------
|
|
# Returns a cookie header.
|
|
#
|
|
my $self = shift;
|
|
|
|
# make sure we have a name to use
|
|
$self->{-name} or return;
|
|
|
|
my $name = GT::CGI::escape($self->{-name});
|
|
my $value = GT::CGI::escape($self->{-value});
|
|
|
|
# build the header that creates the cookie
|
|
my $header = "Set-Cookie: $name=$value";
|
|
|
|
$self->{-expires} and $header .= "; expires=" . $self->format_date('-', $self->{-expires});
|
|
$self->{-path} and $header .= "; path=$self->{-path}";
|
|
$self->{-domain} and $header .= "; domain=$self->{-domain}";
|
|
$self->{-secure} and $header .= "; secure";
|
|
|
|
return "$header";
|
|
}
|
|
|
|
sub format_date {
|
|
# -------------------------------------------------------------------
|
|
# Returns a string in http_gmt format, but accepts one in unknown format.
|
|
# Wed, 23 Aug 2000 21:20:14 GMT
|
|
#
|
|
my ($self, $sep, $datestr) = @_;
|
|
my $unix_time = defined $datestr ? $self->expire_calc($datestr) : time;
|
|
|
|
my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($unix_time);
|
|
$year += 1900;
|
|
|
|
return sprintf(
|
|
"%s, %02d$sep%s$sep%04d %02d:%02d:%02d GMT",
|
|
$WDAY[$wday], $mday, $MON[$mon], $year, $hour, $min, $sec
|
|
);
|
|
}
|
|
*_format_date = \&format_date; # deprecated
|
|
|
|
sub expire_calc {
|
|
# -------------------------------------------------------------------
|
|
# Calculates when a date based on +- times. See CGI.pm for more info.
|
|
#
|
|
my ($self, $time) = @_;
|
|
my %mult = (s => 1, m => 60, h => 3600, d => 86400, M => 2592000, y => 31536000);
|
|
my $offset;
|
|
|
|
if (!$time or lc $time eq 'now') {
|
|
$offset = 0;
|
|
}
|
|
elsif ($time =~ /^\d/) {
|
|
return $time;
|
|
}
|
|
elsif ($time=~/^([+-]?(?:\d+(?:\.\d*)?|\.\d+))([smhdMy]?)/) {
|
|
$offset = $1 * ($mult{$2} || 1);
|
|
}
|
|
else {
|
|
return $time;
|
|
}
|
|
return time + $offset;
|
|
}
|
|
*_expire_calc = \&expire_calc; # deprecated
|
|
|
|
1;
|