package CGI::Cookie;

# See the bottom of this file for the POD documentation.  Search for the
# string '=head'.

# You can run this file through either pod2man or pod2html to produce pretty
# documentation in manual or html file format (these utilities are part of the
# Perl 5 distribution).

# Copyright 1995-1999, Lincoln D. Stein.  All rights reserved.
# It may be used and modified freely, but I do request that this copyright
# notice remain attached to the file.  You may modify this module as you 
# wish, but if you redistribute a modified version, please attach a note
# listing the modifications you have made.

$CGI::Cookie::VERSION='1.26';

use CGI::Util qw(rearrange unescape escape);
use overload '""' => \&as_string,
    'cmp' => \&compare,
    'fallback'=>1;

# Turn on special checking for Doug MacEachern's modperl
my $MOD_PERL = 0;
if (exists $ENV{MOD_PERL}) {
  if (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) {
      $MOD_PERL = 2;
      require Apache2::RequestUtil;
      require APR::Table;
  } else {
    $MOD_PERL = 1;
    require Apache;
  }
}

# fetch a list of cookies from the environment and
# return as a hash.  the cookies are parsed as normal
# escaped URL data.
sub fetch {
    my $class = shift;
    my $raw_cookie = get_raw_cookie(@_) or return;
    return $class->parse($raw_cookie);
}

# Fetch a list of cookies from the environment or the incoming headers and
# return as a hash. The cookie values are not unescaped or altered in any way.
 sub raw_fetch {
   my $class = shift;
   my $raw_cookie = get_raw_cookie(@_) or return;
   my %results;
   my($key,$value);
   
   my(@pairs) = split("; ?",$raw_cookie);
   foreach (@pairs) {
     s/\s*(.*?)\s*/$1/;
     if (/^([^=]+)=(.*)/) {
       $key = $1;
       $value = $2;
     }
     else {
       $key = $_;
       $value = '';
     }
     $results{$key} = $value;
   }
   return \%results unless wantarray;
   return %results;
}

sub get_raw_cookie {
  my $r = shift;
  $r ||= eval { $MOD_PERL == 2                    ? 
                  Apache2::RequestUtil->request() :
                  Apache->request } if $MOD_PERL;
  if ($r) {
    $raw_cookie = $r->headers_in->{'Cookie'};
  } else {
    if ($MOD_PERL && !exists $ENV{REQUEST_METHOD}) {
      die "Run $r->subprocess_env; before calling fetch()";
    }
    $raw_cookie = $ENV{HTTP_COOKIE} || $ENV{COOKIE};
  }
}


sub parse {
  my ($self,$raw_cookie) = @_;
  my %results;

  my(@pairs) = split("; ?",$raw_cookie);
  foreach (@pairs) {
    s/\s*(.*?)\s*/$1/;
    my($key,$value) = split("=",$_,2);

    # Some foreign cookies are not in name=value format, so ignore
    # them.
    next if !defined($value);
    my @values = ();
    if ($value ne '') {
      @values = map unescape($_),split(/[&;]/,$value.'&dmy');