#!/usr/bin/perl
#
# Cookie-handling module
# Copyright (C) 2006 Rami Chowdhury
#
# This code can be modified and redistributed under the terms and cond-
# itions of the GNU Lesser General Public License, either Version 2 or,
# at your option, any later version, as found at the below URL:
#     http://www.gnu.org/licenses/lgpl.txt
#
# Usage:
#   my $c = new Cookie();
#   $c->set(name, value [, expires[, path[, domain]]]);
#   %cookies = $c->getAll();
#   $value = $c->get("NAME");
#

{ package Cookie;
    sub new {
        my $passedIn = shift;
        my $class = ref($passedIn) || $passedIn;
        my $self = {};
        # Defines the list of required cookie parameters, some defaults, passed-in arguments list, main hash
        my @required = ( "name", "value", "expires", "path", "domain" );
        my @defaults = ( "user_test", "1", "Fri Jan 01 00:01:01 2010", "", "" );
        my @params;
        my %cookie;
        # Allows arguments in, as many as are provided
        while (my $arg = shift) {
            push(@params, $arg);
        }
        # Iterates through the list, assigning to the hash
        my $ckey; my $cval;
        for (my $i=0; $i <= $#required; $i++) {
            $ckey = $required[$i];
            $cval = (defined $params[$i]) ? $params[$i] : $defaults[$i];
            $cookie{$ckey} = $cval;
        }
        # Assigns hash to object and returns
        $self->{data} = \%cookie;
        bless ($self, $class);
        return $self;
    }

    sub set {
        my $self = shift;
        my %cookie = %{$self->{data}};
        # Allows values to be set at this point as well.
        my @required = ( "name", "value", "expires", "path", "domain" );
        my @params;
        while (my $arg = shift) {
            push(@params, $arg);
        }
        # Iterates through the list, assigning to the hash
        my $ckey; my $cval;
        for (my $i=0; $i <= $#params; $i++) {
            $ckey = $required[$i];
            $cval = $params[$i];
            $cookie{$ckey} = $cval;
        }
        # Prints the set-cookie command
        my $header = "Set-Cookie: $cookie{name}=$cookie{value};";
        foreach my $one (keys %cookie) {
            if ($cookie{$one} ne "") {
                $header = $header . " $one=$cookie{$one};";
            }
        }
        $header = $header . "\n";
        print $header;
    }

    sub getAll {
        my $self = shift;
        my $str = $ENV{'HTTP_COOKIE'};
        my %cookieInfo; my @allCookies; my $cname; my $cval;
        @allCookies = split(";", $str);
        foreach my $c (@allCookies) {
            $c =~ s/ //gi;
            ($cname, $cval) = split("=", $c);
            $cookieInfo{$cname} = $cval;
        }
        $self->{cookies} = \%cookieInfo;
        return %cookieInfo;
    }

    sub get {
        my $self = shift;
        my $cname = shift;
        if ($self->{cookies} eq undef) {
            $self->getAll();
        }
        my %cdata = %{$self->{cookies}};
        return $cdata{$cname};
    }
}