# GetCookie.pm - Created by James Pattie, 04/28/2000.

# Copyright (c) 2000 PC & Web Xperience, Inc. http://www.pcxperience.com/
# All rights reserved.  This program is free software; you can redistribute it
# and/or modify it under the same terms as Perl itself.

# This is the cookie module for all our programs that allows us to read cookies
# from the client (server).

# updated 02/24/2001 - Converted to new naming scheme.

package HTMLObject::GetCookie;
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

require Exporter;

@ISA = qw(Exporter AutoLoader);
@EXPORT = qw(
);
	#%Cookies GetCookies GetCompressedCookies

$VERSION = '1.06';

my ( @DecodeChars, %DecodeChars );
use vars '%Cookies';

# %Cookies is the hash of cookies found in the Server Environment.
# Since this will be exported it will be available to the calling program.


@DecodeChars = ( '\+', '\%3A\%3A', '\%26', '\%3D', '\%2C', '\%3B', '\%2B', '\%25' );

%DecodeChars = ( '\+' => ' ',
                  '\%3A\%3A' => '::',
                  '\%26' => '&',
                  '\%3D' => '=',
                  '\%2C' => ',',
                  '\%3B' => ';',
                  '\%2B' => '+',
                  '\%25' => '%'
                );

# decode_string
# Takes:        String to un-URI encode.
# Returns:      un-URI encoded string.
sub decode_string
{
  my %args = ( @_, );
  my $string = $args{'string'};

  foreach my $char (@DecodeChars)
  {
    $string =~ s/$char/$DecodeChars{$char}/g;
  }

  return $string;
}

# decodeString
# Takes:        String to un-URI encode.
# Returns:      un-URI encoded string.
sub decodeString
{
  my %args = ( @_, );
  my $string = $args{'string'};

  foreach my $char (@DecodeChars)
  {
    $string =~ s/$char/$DecodeChars{$char}/g;
  }

  return $string;
}

# GetCookies() - Gets Cookie(s) from the Server Environment.
# Takes: 	Array of Cookie Names or A Single Cookie Name or Nothing.
# Returns:	1 (If Successful), 0 (Otherwise)

sub GetCookies
{
  my @BrowserCookies = @_;
  my $cookieFound = 0;
  my ($cookie, $value);

  # check and make sure that the Browser sent us some cookies via the server.
  if ($ENV{'HTTP_COOKIE'})
  {
	# see if they requested a particular cookie(s).
    if (scalar @BrowserCookies > 0)
    {
      foreach my $temp (split(/; /,$ENV{'HTTP_COOKIE'}))
      {
        # Split the name=value pairs.

        ($cookie,$value) = split /=/, $temp;
        #print "cookie='$cookie', value='$value'\n\n";

        # do URL decoding
        $cookie = decodeString( string => "$cookie" ); 
        $value = decodeString( string => "$value" );

        # Check and see if this cookie was requested.
        foreach my $temp2 (@BrowserCookies)
        {
          if ($temp2 eq $cookie)
          {
            $Cookies{$cookie} = $value;
            $cookieFound = 1; # signal we found one of the specified cookies
          }
        }
      }
    }
    else # get all cookies passed in by the browser.
    {
      foreach my $temp (split(/; /,$ENV{'HTTP_COOKIE'}))
      {
        ($cookie,$value) = split /=/, $temp;

        # do URL decoding
        $cookie = decodeString( string => "$cookie" ); 
        $value = decodeString( string => "$value" );

        $Cookies{$cookie} = $value;
      }
      $cookieFound = 1; # signal we succeeded.
    }
  }

  return $cookieFound;
}

# GetCompressedCookies - This takes the compressed cookie names, and optionally the names of specific cookies you want returned
#                and uncompresses them, setting the values into %Cookies.  Specific names of cookies are optional and if not specified
#                all cookies found in the compressed cookie will be set.
# Takes -	cname - Name of the compressed cookie to be uncompressed.
#               names - Optional names of cookies to be returned from the
#                       compressed cookie if you don't want them all.
# Returns:       1 - If successful, 0 - If no cookies are retrieved.

sub GetCompressedCookies
{
  my ($cookieName, @Cookies) = @_;
  my $cookieFound = 0;
  my ($ResultingCookie, $cookie, $value);

  if (GetCookies($cookieName))
  { # we found the cookie in question
    if (scalar @Cookies > 0)
    {
      foreach my $temp (split(/&/, $Cookies{$cookieName}))
      {
        # Split the cookie name and value pair.
        #print "\$temp = '$temp'\n";

        ($cookie, $value) = split /::/, $temp;

        # if we get a match, set the cookie.

        foreach $ResultingCookie (@Cookies)
        {
          if ($ResultingCookie eq $cookie)
          {
            $Cookies{$cookie} = $value;
            #print "\$Cookies{\$cookie} = '$Cookies{$cookie}', cookie = '$cookie', value = '$value'\n";
            $cookieFound = 1;
          }
        }
      }
    }
    else # get all cookies
    {
      foreach my $temp (split(/&/, $Cookies{$cookieName}))
      {
        #print "\$temp = '$temp'\n";
        ($cookie, $value) = split /::/, $temp;

        $Cookies{$cookie} = $value;
        #print "\$Cookies{\$cookie} = '$Cookies{$cookie}', cookie = '$cookie', value = '$value'\n";
      }
      $cookieFound = 1;
    }

    delete($Cookies{$cookieName}); # remove the Compressed cookie so it is not used by accident.
  }

  return $cookieFound;
}

1;
__END__

=head1 NAME

HTMLObject::GetCookie - Perl extension for HTMLObject.

=head1 SYNOPSIS

  use HTMLObject::GetCookie;
  HTMLObject::GetCookie::GetCookies();
  if (exists $HTMLObject::GetCookie::Cookies{'cookie name'})
  {
    print "Cookie 'cookie name' exists!\n";
  }

=head1 DESCRIPTION

The GetCookie module allows you to check for the existance of cookies
that were set via the HTMLObject set_cookie method.  You can retrieve the
value(s) of any cookie you set and then proceed to work with them as
necessary.

=head1 Exported FUNCTIONS

  scalar decode_string( string => '' )
    un-URI encodes the string and returns it.

  scalar decodeString( string => '' )
    un-URI encodes the string and returns it.

  scalar GetCookies()
    Takes: 	Array of Cookie Names or A Single Cookie Name or Nothing.
    Returns:	1 (If Successful), 0 (Otherwise)

  scalar GetCompressedCookies()
    This takes the compressed cookie names, and optionally the names of
    specific cookies you want returned and uncompresses them, setting the
    values into %Cookies.  Specific names of cookies are optional and if
    not specified all cookies found in the compressed cookie will be set.
    Takes -	cname - Name of the compressed cookie to be uncompressed.
            names - Optional names of cookies to be returned from the
                    compressed cookie if you don't want them all.
    Returns:    1 - If successful, 0 - If no cookies are retrieved.

=head1 AUTHOR

James A. Pattie, htmlobject@pcxperience.com

=head1 SEE ALSO

perl(1), HTMLObject::Base(3), HTMLObject::Normal(3), HTMLObject::FrameSet(3).

=cut
