Current File : //var/wcp4/million/public_html/file/private/lib/GT/CGI/Cookie.pm

# ==================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
#   GT::CGI::Cookie
#   $Id: Cookie.pm,v 1.1 2002/05/22 00:58:47 jagerman Exp $
# 
# Copyright (c) 2000 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 creats the cookie
    my $header  = "Set-Cookie: $name=$value";

    $self->{'-expires'} and $header .= "; expires=" . _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 {
# -------------------------------------------------------------------
# Return a string in http_gmt format, but accepts one in unknown format.
#   Wed, 23 Aug 2000 21:20:14 GMT
#
    my ($sep, $datestr) = @_;
    my $unix_time = defined $datestr ? _expire_calc($datestr) : time();

    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime ($unix_time);
    $year = $year + 1900;

    my $date = sprintf("%s, %02d$sep%s$sep%04d %02d:%02d:%02d GMT",
                    $WDAY[$wday],$mday,$MON[$mon],$year,$hour,$min,$sec);
    return $date;
}

sub _expire_calc {
# -------------------------------------------------------------------
# Calculates when a date based on +- times. See CGI.pm for more info.
#
    my $time = shift;
    my %mult = qw/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 = ($mult{$2} || 1)*$1;
    }
    else {
        return $time;
    }
    return time() + $offset;
}

1;