[Nms-cgi-devel] Prelim for Cookie.lib done

[Joseph F. R. <rya...@os...>]

Here's what I have so far; it works, but probably needs much more testing 
(I've tested it with the sample given in the MWS cookie distro).  I still 
have issues with the SetCookieDomain function; it seems to be fine, but I 
left it unaltered from MW's code.  I'd appreciate it if someone took a 
look.  Also note that its now 96 lines, down from 550 ;)

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
{
     getCookies();
}

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;