#
# $Id: cookielib,v 1.5 2002/07/08 09:56:12 missbarbell Exp $
# 
# $Log: cookielib,v $
# Revision 1.5  2002/07/08 09:56:12  missbarbell
# fixed GetCompressedCookies so it correctly extracts compressed cookies as per Matt's original script.
#
# Revision 1.4  2002/01/29 18:01:19  jfryan
# fixed GetCompressedCookies() function to properly call GetCookies
#
# Revision 1.3  2002/01/28 09:19:33  gellyfish
# * Fixed line-endings on cookielib
# * Added some more FAQ
# * put the house style README in gallery
#
# Revision 1.2  2002/01/27 12:47:58  gellyfish
# * Added MANIFEST and README
# * Put RCS tags in cookielib
#
#

use strict;
use vars qw(%cookie_config);
use CGI;
use CGI::Cookie;

sub SetCookieExpDate
{
    $cookie_config{expires} = $_[0];
}

sub SetCookiePath
{
    $cookie_config{path} = $_[0];
}

sub SetCookieDomain
{

    if ($_[0] =~ /(.com|.edu|.net|.org|.gov|.mil|.int)$/i &&
        $_[0] =~ /\.[^.]+\.\w{3}$/) {
        $cookie_config{domain} = $_[0];
        return 1;
    }
    elsif ($_[0] !~ /(.com|.edu|.net|.org|.gov|.mil|.int)$/i &&
           $_[0] =~ /\.[^.]+\.[^.]+\./) {
        $cookie_config{domain} = $_[0];
        return 1;
    }
    else
    {
        return 0;
    }
}

sub SetSecureCookie
{
    $cookie_config{secure} = $_[0];
}

sub GetCookies
{
    my @cookies = @_;

    my $exists = 0;
    foreach my $name (@cookies)
    {
        my $value = CGI->cookie($name);
        $main::Cookies{$name} = $value;
        $exists = 1 if $value;
    }
    return $exists;
}

sub SetCookies {

    my (%input) = @_;
    while( my($name,$value) = each %input )
    {
        my $c = CGI->cookie (
                             -name    => $name,
                             -value   => $value,
                             -expires => ((exists($cookie_config{expires}) && $cookie_config{expires} ==1) ? $cookie_config{expires} : undef),
                             -domain  => ((exists($cookie_config{domain})  && $cookie_config{domain}  ==1) ? $cookie_config{domain}  : undef),
                             -secure  => ((exists($cookie_config{secure})  && $cookie_config{secure}  ==1) ? $cookie_config{secure}  : undef),
                             -path    => ((exists($cookie_config{path})    && $cookie_config{path}    ==1) ? $cookie_config{path}    : undef),
                            );
        print "Set-Cookie: ", $c, "\n";
    }
}

sub GetCompressedCookies
{
    my($cookie_name,@cookies) = @_;
    my $exists = 0;

    return unless( GetCookies(@_) );

    # extract specified cookies
    if( @cookies ) {	
        foreach my $name (@cookies) {
            if($main::Cookies{$cookie_name} =~ /$name\:\:([^&]+)/) {
                my $value = $1;
                $main::Cookies{$name} = $value;
                $exists = 1 if $value;
	        }
        }

    # extract all cookies
    } else {
        foreach my $cookie (split /&/, $main::Cookies{$cookie_name}) {
            my ($name,$value) = (split /::/, $cookie);
            $main::Cookies{$name} = $value;
            $exists = 1 if $value;
	    }
    } 

    return $exists;
}

sub SetCompressedCookies
{
    my($cookie_name,@cookies) = @_;
    my $cookie_value = "";

    my %input = (@cookies);
    while( my($name,$value) = each %input )
    {
        if ($cookie_value)
        {
            $cookie_value .= '&'.$name.'::'.$value;
        }
        else
        {
            $cookie_value = $name.'::'.$value;
        }
    }
    SetCookies($cookie_name,$cookie_value);
}

1;
