home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2007 September / PCWSEP07.iso / Software / Linux / Linux Mint 3.0 Light / LinuxMint-3.0-Light.iso / casper / filesystem.squashfs / usr / share / perl5 / HTTP / Cookies.pm next >
Encoding:
Perl POD Document  |  2004-11-12  |  20.1 KB  |  775 lines
  1. package HTTP::Cookies;
  2.  
  3. use strict;
  4. use HTTP::Date qw(str2time time2str);
  5. use HTTP::Headers::Util qw(split_header_words join_header_words);
  6. use LWP::Debug ();
  7.  
  8. use vars qw($VERSION $EPOCH_OFFSET);
  9. $VERSION = sprintf("%d.%02d", q$Revision: 1.39 $ =~ /(\d+)\.(\d+)/);
  10.  
  11. # Legacy: because "use "HTTP::Cookies" used be the ONLY way
  12. #  to load the class HTTP::Cookies::Netscape.
  13. require HTTP::Cookies::Netscape;
  14.  
  15. $EPOCH_OFFSET = 0;  # difference from Unix epoch
  16. if ($^O eq "MacOS") {
  17.     require Time::Local;
  18.     $EPOCH_OFFSET = Time::Local::timelocal(0,0,0,1,0,70);
  19. }
  20.  
  21. # A HTTP::Cookies object is a hash.  The main attribute is the
  22. # COOKIES 3 level hash:  $self->{COOKIES}{$domain}{$path}{$key}.
  23.  
  24. sub new
  25. {
  26.     my $class = shift;
  27.     my $self = bless {
  28.     COOKIES => {},
  29.     }, $class;
  30.     my %cnf = @_;
  31.     for (keys %cnf) {
  32.     $self->{lc($_)} = $cnf{$_};
  33.     }
  34.     $self->load;
  35.     $self;
  36. }
  37.  
  38.  
  39. sub add_cookie_header
  40. {
  41.     my $self = shift;
  42.     my $request = shift || return;
  43.     my $url = $request->url;
  44.     my $scheme = $url->scheme;
  45.     unless ($scheme =~ /^https?\z/) {
  46.     LWP::Debug::debug("Will not add cookies to non-HTTP requests");
  47.     return;
  48.     }
  49.  
  50.     my $domain = _host($request, $url);
  51.     $domain = "$domain.local" unless $domain =~ /\./;
  52.     my $secure_request = ($scheme eq "https");
  53.     my $req_path = _url_path($url);
  54.     my $req_port = $url->port;
  55.     my $now = time();
  56.     _normalize_path($req_path) if $req_path =~ /%/;
  57.  
  58.     my @cval;    # cookie values for the "Cookie" header
  59.     my $set_ver;
  60.     my $netscape_only = 0; # An exact domain match applies to any cookie
  61.  
  62.     while ($domain =~ /\./) {
  63.  
  64.         LWP::Debug::debug("Checking $domain for cookies");
  65.     my $cookies = $self->{COOKIES}{$domain};
  66.     next unless $cookies;
  67.     if ($self->{delayload} && defined($cookies->{'//+delayload'})) {
  68.         my $cookie_data = $cookies->{'//+delayload'}{'cookie'};
  69.         delete $self->{COOKIES}{$domain};
  70.         $self->load_cookie($cookie_data->[1]);
  71.         $cookies = $self->{COOKIES}{$domain};
  72.         next unless $cookies;  # should not really happen
  73.     }
  74.  
  75.     # Want to add cookies corresponding to the most specific paths
  76.     # first (i.e. longest path first)
  77.     my $path;
  78.     for $path (sort {length($b) <=> length($a) } keys %$cookies) {
  79.             LWP::Debug::debug("- checking cookie path=$path");
  80.         if (index($req_path, $path) != 0) {
  81.             LWP::Debug::debug("  path $path:$req_path does not fit");
  82.         next;
  83.         }
  84.  
  85.         my($key,$array);
  86.         while (($key,$array) = each %{$cookies->{$path}}) {
  87.         my($version,$val,$port,$path_spec,$secure,$expires) = @$array;
  88.             LWP::Debug::debug(" - checking cookie $key=$val");
  89.         if ($secure && !$secure_request) {
  90.             LWP::Debug::debug("   not a secure requests");
  91.             next;
  92.         }
  93.         if ($expires && $expires < $now) {
  94.             LWP::Debug::debug("   expired");
  95.             next;
  96.         }
  97.         if ($port) {
  98.             my $found;
  99.             if ($port =~ s/^_//) {
  100.             # The correponding Set-Cookie attribute was empty
  101.             $found++ if $port eq $req_port;
  102.             $port = "";
  103.             }
  104.             else {
  105.             my $p;
  106.             for $p (split(/,/, $port)) {
  107.                 $found++, last if $p eq $req_port;
  108.             }
  109.             }
  110.             unless ($found) {
  111.                 LWP::Debug::debug("   port $port:$req_port does not fit");
  112.             next;
  113.             }
  114.         }
  115.         if ($version > 0 && $netscape_only) {
  116.             LWP::Debug::debug("   domain $domain applies to " .
  117.                       "Netscape-style cookies only");
  118.             next;
  119.         }
  120.  
  121.             LWP::Debug::debug("   it's a match");
  122.  
  123.         # set version number of cookie header.
  124.             # XXX: What should it be if multiple matching
  125.                 #      Set-Cookie headers have different versions themselves
  126.         if (!$set_ver++) {
  127.             if ($version >= 1) {
  128.             push(@cval, "\$Version=$version");
  129.             }
  130.             elsif (!$self->{hide_cookie2}) {
  131.             $request->header(Cookie2 => '$Version="1"');
  132.             }
  133.         }
  134.  
  135.         # do we need to quote the value
  136.         if ($val =~ /\W/ && $version) {
  137.             $val =~ s/([\\\"])/\\$1/g;
  138.             $val = qq("$val");
  139.         }
  140.  
  141.         # and finally remember this cookie
  142.         push(@cval, "$key=$val");
  143.         if ($version >= 1) {
  144.             push(@cval, qq(\$Path="$path"))     if $path_spec;
  145.             push(@cval, qq(\$Domain="$domain")) if $domain =~ /^\./;
  146.             if (defined $port) {
  147.             my $p = '$Port';
  148.             $p .= qq(="$port") if length $port;
  149.             push(@cval, $p);
  150.             }
  151.         }
  152.  
  153.         }
  154.         }
  155.  
  156.     } continue {
  157.     # Try with a more general domain, alternately stripping
  158.     # leading name components and leading dots.  When this
  159.     # results in a domain with no leading dot, it is for
  160.     # Netscape cookie compatibility only:
  161.     #
  162.     # a.b.c.net    Any cookie
  163.     # .b.c.net    Any cookie
  164.     # b.c.net    Netscape cookie only
  165.     # .c.net    Any cookie
  166.  
  167.     if ($domain =~ s/^\.+//) {
  168.         $netscape_only = 1;
  169.     }
  170.     else {
  171.         $domain =~ s/[^.]*//;
  172.         $netscape_only = 0;
  173.     }
  174.     }
  175.  
  176.     $request->header(Cookie => join("; ", @cval)) if @cval;
  177.  
  178.     $request;
  179. }
  180.  
  181.  
  182. sub extract_cookies
  183. {
  184.     my $self = shift;
  185.     my $response = shift || return;
  186.  
  187.     my @set = split_header_words($response->_header("Set-Cookie2"));
  188.     my @ns_set = $response->_header("Set-Cookie");
  189.  
  190.     return $response unless @set || @ns_set;  # quick exit
  191.  
  192.     my $request = $response->request;
  193.     my $url = $request->url;
  194.     my $req_host = _host($request, $url);
  195.     $req_host = "$req_host.local" unless $req_host =~ /\./;
  196.     my $req_port = $url->port;
  197.     my $req_path = _url_path($url);
  198.     _normalize_path($req_path) if $req_path =~ /%/;
  199.  
  200.     if (@ns_set) {
  201.     # The old Netscape cookie format for Set-Cookie
  202.         # http://www.netscape.com/newsref/std/cookie_spec.html
  203.     # can for instance contain an unquoted "," in the expires
  204.     # field, so we have to use this ad-hoc parser.
  205.     my $now = time();
  206.  
  207.     # Build a hash of cookies that was present in Set-Cookie2
  208.     # headers.  We need to skip them if we also find them in a
  209.     # Set-Cookie header.
  210.     my %in_set2;
  211.     for (@set) {
  212.         $in_set2{$_->[0]}++;
  213.     }
  214.  
  215.     my $set;
  216.     for $set (@ns_set) {
  217.         my @cur;
  218.         my $param;
  219.         my $expires;
  220.         my $first_param = 1;
  221.         for $param (split(/;\s*/, $set)) {
  222.         my($k,$v) = split(/\s*=\s*/, $param, 2);
  223.         if (defined $v) {
  224.             $v =~ s/\s+$//;
  225.             #print "$k => $v\n";
  226.         }
  227.         else {
  228.             $k =~ s/\s+$//;
  229.             #print "$k => undef";
  230.         }
  231.         if (!$first_param && lc($k) eq "expires") {
  232.             my $etime = str2time($v);
  233.             if ($etime) {
  234.             push(@cur, "Max-Age" => str2time($v) - $now);
  235.             $expires++;
  236.             }
  237.         }
  238.         else {
  239.             push(@cur, $k => $v);
  240.         }
  241.         $first_param = 0;
  242.         }
  243.         next if $in_set2{$cur[0]};
  244.  
  245. #        push(@cur, "Port" => $req_port);
  246.         push(@cur, "Discard" => undef) unless $expires;
  247.         push(@cur, "Version" => 0);
  248.         push(@cur, "ns-cookie" => 1);
  249.         push(@set, \@cur);
  250.     }
  251.     }
  252.  
  253.   SET_COOKIE:
  254.     for my $set (@set) {
  255.     next unless @$set >= 2;
  256.  
  257.     my $key = shift @$set;
  258.     my $val = shift @$set;
  259.  
  260.         LWP::Debug::debug("Set cookie $key => $val");
  261.  
  262.     my %hash;
  263.     while (@$set) {
  264.         my $k = shift @$set;
  265.         my $v = shift @$set;
  266.         my $lc = lc($k);
  267.         # don't loose case distinction for unknown fields
  268.         $k = $lc if $lc =~ /^(?:discard|domain|max-age|
  269.                                     path|port|secure|version)$/x;
  270.         if ($k eq "discard" || $k eq "secure") {
  271.         $v = 1 unless defined $v;
  272.         }
  273.         next if exists $hash{$k};  # only first value is signigicant
  274.         $hash{$k} = $v;
  275.     };
  276.  
  277.     my %orig_hash = %hash;
  278.     my $version   = delete $hash{version};
  279.     $version = 1 unless defined($version);
  280.     my $discard   = delete $hash{discard};
  281.     my $secure    = delete $hash{secure};
  282.     my $maxage    = delete $hash{'max-age'};
  283.     my $ns_cookie = delete $hash{'ns-cookie'};
  284.  
  285.     # Check domain
  286.     my $domain  = delete $hash{domain};
  287.     $domain = lc($domain) if defined $domain;
  288.     if (defined($domain)
  289.         && $domain ne $req_host && $domain ne ".$req_host") {
  290.         if ($domain !~ /\./ && $domain ne "local") {
  291.             LWP::Debug::debug("Domain $domain contains no dot");
  292.         next SET_COOKIE;
  293.         }
  294.         $domain = ".$domain" unless $domain =~ /^\./;
  295.         if ($domain =~ /\.\d+$/) {
  296.             LWP::Debug::debug("IP-address $domain illeagal as domain");
  297.         next SET_COOKIE;
  298.         }
  299.         my $len = length($domain);
  300.         unless (substr($req_host, -$len) eq $domain) {
  301.             LWP::Debug::debug("Domain $domain does not match host $req_host");
  302.         next SET_COOKIE;
  303.         }
  304.         my $hostpre = substr($req_host, 0, length($req_host) - $len);
  305.         if ($hostpre =~ /\./ && !$ns_cookie) {
  306.             LWP::Debug::debug("Host prefix contain a dot: $hostpre => $domain");
  307.         next SET_COOKIE;
  308.         }
  309.     }
  310.     else {
  311.         $domain = $req_host;
  312.     }
  313.  
  314.     my $path = delete $hash{path};
  315.     my $path_spec;
  316.     if (defined $path && $path ne '') {
  317.         $path_spec++;
  318.         _normalize_path($path) if $path =~ /%/;
  319.         if (!$ns_cookie &&
  320.                 substr($req_path, 0, length($path)) ne $path) {
  321.             LWP::Debug::debug("Path $path is not a prefix of $req_path");
  322.         next SET_COOKIE;
  323.         }
  324.     }
  325.     else {
  326.         $path = $req_path;
  327.         $path =~ s,/[^/]*$,,;
  328.         $path = "/" unless length($path);
  329.     }
  330.  
  331.     my $port;
  332.     if (exists $hash{port}) {
  333.         $port = delete $hash{port};
  334.         if (defined $port) {
  335.         $port =~ s/\s+//g;
  336.         my $found;
  337.         for my $p (split(/,/, $port)) {
  338.             unless ($p =~ /^\d+$/) {
  339.               LWP::Debug::debug("Bad port $port (not numeric)");
  340.             next SET_COOKIE;
  341.             }
  342.             $found++ if $p eq $req_port;
  343.         }
  344.         unless ($found) {
  345.             LWP::Debug::debug("Request port ($req_port) not found in $port");
  346.             next SET_COOKIE;
  347.         }
  348.         }
  349.         else {
  350.         $port = "_$req_port";
  351.         }
  352.     }
  353.     $self->set_cookie($version,$key,$val,$path,$domain,$port,$path_spec,$secure,$maxage,$discard, \%hash)
  354.         if $self->set_cookie_ok(\%orig_hash);
  355.     }
  356.  
  357.     $response;
  358. }
  359.  
  360. sub set_cookie_ok
  361. {
  362.     1;
  363. }
  364.  
  365.  
  366. sub set_cookie
  367. {
  368.     my $self = shift;
  369.     my($version,
  370.        $key, $val, $path, $domain, $port,
  371.        $path_spec, $secure, $maxage, $discard, $rest) = @_;
  372.  
  373.     # path and key can not be empty (key can't start with '$')
  374.     return $self if !defined($path) || $path !~ m,^/, ||
  375.                 !defined($key)  || $key  =~ m,^\$,;
  376.  
  377.     # ensure legal port
  378.     if (defined $port) {
  379.     return $self unless $port =~ /^_?\d+(?:,\d+)*$/;
  380.     }
  381.  
  382.     my $expires;
  383.     if (defined $maxage) {
  384.     if ($maxage <= 0) {
  385.         delete $self->{COOKIES}{$domain}{$path}{$key};
  386.         return $self;
  387.     }
  388.     $expires = time() + $maxage;
  389.     }
  390.     $version = 0 unless defined $version;
  391.  
  392.     my @array = ($version, $val,$port,
  393.          $path_spec,
  394.          $secure, $expires, $discard);
  395.     push(@array, {%$rest}) if defined($rest) && %$rest;
  396.     # trim off undefined values at end
  397.     pop(@array) while !defined $array[-1];
  398.  
  399.     $self->{COOKIES}{$domain}{$path}{$key} = \@array;
  400.     $self;
  401. }
  402.  
  403.  
  404. sub save
  405. {
  406.     my $self = shift;
  407.     my $file = shift || $self->{'file'} || return;
  408.     local(*FILE);
  409.     open(FILE, ">$file") or die "Can't open $file: $!";
  410.     print FILE "#LWP-Cookies-1.0\n";
  411.     print FILE $self->as_string(!$self->{ignore_discard});
  412.     close(FILE);
  413.     1;
  414. }
  415.  
  416.  
  417. sub load
  418. {
  419.     my $self = shift;
  420.     my $file = shift || $self->{'file'} || return;
  421.     local(*FILE, $_);
  422.     local $/ = "\n";  # make sure we got standard record separator
  423.     open(FILE, $file) or return;
  424.     my $magic = <FILE>;
  425.     unless ($magic =~ /^\#LWP-Cookies-(\d+\.\d+)/) {
  426.     warn "$file does not seem to contain cookies";
  427.     return;
  428.     }
  429.     while (<FILE>) {
  430.     next unless s/^Set-Cookie3:\s*//;
  431.     chomp;
  432.     my $cookie;
  433.     for $cookie (split_header_words($_)) {
  434.         my($key,$val) = splice(@$cookie, 0, 2);
  435.         my %hash;
  436.         while (@$cookie) {
  437.         my $k = shift @$cookie;
  438.         my $v = shift @$cookie;
  439.         $hash{$k} = $v;
  440.         }
  441.         my $version   = delete $hash{version};
  442.         my $path      = delete $hash{path};
  443.         my $domain    = delete $hash{domain};
  444.         my $port      = delete $hash{port};
  445.         my $expires   = str2time(delete $hash{expires});
  446.  
  447.         my $path_spec = exists $hash{path_spec}; delete $hash{path_spec};
  448.         my $secure    = exists $hash{secure};    delete $hash{secure};
  449.         my $discard   = exists $hash{discard};   delete $hash{discard};
  450.  
  451.         my @array =    ($version,$val,$port,
  452.              $path_spec,$secure,$expires,$discard);
  453.         push(@array, \%hash) if %hash;
  454.         $self->{COOKIES}{$domain}{$path}{$key} = \@array;
  455.     }
  456.     }
  457.     close(FILE);
  458.     1;
  459. }
  460.  
  461.  
  462. sub revert
  463. {
  464.     my $self = shift;
  465.     $self->clear->load;
  466.     $self;
  467. }
  468.  
  469.  
  470. sub clear
  471. {
  472.     my $self = shift;
  473.     if (@_ == 0) {
  474.     $self->{COOKIES} = {};
  475.     }
  476.     elsif (@_ == 1) {
  477.     delete $self->{COOKIES}{$_[0]};
  478.     }
  479.     elsif (@_ == 2) {
  480.     delete $self->{COOKIES}{$_[0]}{$_[1]};
  481.     }
  482.     elsif (@_ == 3) {
  483.     delete $self->{COOKIES}{$_[0]}{$_[1]}{$_[2]};
  484.     }
  485.     else {
  486.     require Carp;
  487.         Carp::carp('Usage: $c->clear([domain [,path [,key]]])');
  488.     }
  489.     $self;
  490. }
  491.  
  492.  
  493. sub clear_temporary_cookies
  494. {
  495.     my($self) = @_;
  496.  
  497.     $self->scan(sub {
  498.         if($_[9] or        # "Discard" flag set
  499.            not $_[8]) {    # No expire field?
  500.             $_[8] = -1;            # Set the expire/max_age field
  501.             $self->set_cookie(@_); # Clear the cookie
  502.         }
  503.       });
  504. }
  505.  
  506.  
  507. sub DESTROY
  508. {
  509.     my $self = shift;
  510.     $self->save if $self->{'autosave'};
  511. }
  512.  
  513.  
  514. sub scan
  515. {
  516.     my($self, $cb) = @_;
  517.     my($domain,$path,$key);
  518.     for $domain (sort keys %{$self->{COOKIES}}) {
  519.     for $path (sort keys %{$self->{COOKIES}{$domain}}) {
  520.         for $key (sort keys %{$self->{COOKIES}{$domain}{$path}}) {
  521.         my($version,$val,$port,$path_spec,
  522.            $secure,$expires,$discard,$rest) =
  523.                @{$self->{COOKIES}{$domain}{$path}{$key}};
  524.         $rest = {} unless defined($rest);
  525.         &$cb($version,$key,$val,$path,$domain,$port,
  526.              $path_spec,$secure,$expires,$discard,$rest);
  527.         }
  528.     }
  529.     }
  530. }
  531.  
  532.  
  533. sub as_string
  534. {
  535.     my($self, $skip_discard) = @_;
  536.     my @res;
  537.     $self->scan(sub {
  538.     my($version,$key,$val,$path,$domain,$port,
  539.        $path_spec,$secure,$expires,$discard,$rest) = @_;
  540.     return if $discard && $skip_discard;
  541.     my @h = ($key, $val);
  542.     push(@h, "path", $path);
  543.     push(@h, "domain" => $domain);
  544.     push(@h, "port" => $port) if defined $port;
  545.     push(@h, "path_spec" => undef) if $path_spec;
  546.     push(@h, "secure" => undef) if $secure;
  547.     push(@h, "expires" => HTTP::Date::time2isoz($expires)) if $expires;
  548.     push(@h, "discard" => undef) if $discard;
  549.     my $k;
  550.     for $k (sort keys %$rest) {
  551.         push(@h, $k, $rest->{$k});
  552.     }
  553.     push(@h, "version" => $version);
  554.     push(@res, "Set-Cookie3: " . join_header_words(\@h));
  555.     });
  556.     join("\n", @res, "");
  557. }
  558.  
  559. sub _host
  560. {
  561.     my($request, $url) = @_;
  562.     if (my $h = $request->header("Host")) {
  563.     $h =~ s/:\d+$//;  # might have a port as well
  564.     return lc($h);
  565.     }
  566.     return lc($url->host);
  567. }
  568.  
  569. sub _url_path
  570. {
  571.     my $url = shift;
  572.     my $path;
  573.     if($url->can('epath')) {
  574.        $path = $url->epath;    # URI::URL method
  575.     }
  576.     else {
  577.        $path = $url->path;           # URI::_generic method
  578.     }
  579.     $path = "/" unless length $path;
  580.     $path;
  581. }
  582.  
  583. sub _normalize_path  # so that plain string compare can be used
  584. {
  585.     my $x;
  586.     $_[0] =~ s/%([0-9a-fA-F][0-9a-fA-F])/
  587.              $x = uc($1);
  588.                  $x eq "2F" || $x eq "25" ? "%$x" :
  589.                                             pack("C", hex($x));
  590.               /eg;
  591.     $_[0] =~ s/([\0-\x20\x7f-\xff])/sprintf("%%%02X",ord($1))/eg;
  592. }
  593.  
  594. 1;
  595.  
  596. __END__
  597.  
  598. =head1 NAME
  599.  
  600. HTTP::Cookies - HTTP cookie jars
  601.  
  602. =head1 SYNOPSIS
  603.  
  604.   use HTTP::Cookies;
  605.   $cookie_jar = HTTP::Cookies->new(
  606.     file => "$ENV{'HOME'}/lwp_cookies.dat',
  607.     autosave => 1,
  608.   );
  609.  
  610.   use LWP;
  611.   my $browser = LWP::UserAgent->new;
  612.   $browser->cookie_jar($cookie_jar);
  613.  
  614. Or for an empty and temporary cookie jar:
  615.  
  616.   use LWP;
  617.   my $browser = LWP::UserAgent->new;
  618.   $browser->cookie_jar( {} );
  619.  
  620. =head1 DESCRIPTION
  621.  
  622. This class is for objects that represent a "cookie jar" -- that is, a
  623. database of all the HTTP cookies that a given LWP::UserAgent object
  624. knows about.
  625.  
  626. Cookies are a general mechanism which server side connections can use
  627. to both store and retrieve information on the client side of the
  628. connection.  For more information about cookies refer to
  629. <URL:http://www.netscape.com/newsref/std/cookie_spec.html> and
  630. <URL:http://www.cookiecentral.com/>.  This module also implements the
  631. new style cookies described in I<RFC 2965>.
  632. The two variants of cookies are supposed to be able to coexist happily.
  633.  
  634. Instances of the class I<HTTP::Cookies> are able to store a collection
  635. of Set-Cookie2: and Set-Cookie: headers and are able to use this
  636. information to initialize Cookie-headers in I<HTTP::Request> objects.
  637. The state of a I<HTTP::Cookies> object can be saved in and restored from
  638. files.
  639.  
  640. =head1 METHODS
  641.  
  642. The following methods are provided:
  643.  
  644. =over 4
  645.  
  646. =item $cookie_jar = HTTP::Cookies->new
  647.  
  648. The constructor takes hash style parameters.  The following
  649. parameters are recognized:
  650.  
  651.   file:            name of the file to restore cookies from and save cookies to
  652.   autosave:        save during destruction (bool)
  653.   ignore_discard:  save even cookies that are requested to be discarded (bool)
  654.   hide_cookie2:    do not add Cookie2 header to requests
  655.  
  656. Future parameters might include (not yet implemented):
  657.  
  658.   max_cookies               300
  659.   max_cookies_per_domain    20
  660.   max_cookie_size           4096
  661.  
  662.   no_cookies   list of domain names that we never return cookies to
  663.  
  664. =item $cookie_jar->add_cookie_header( $request )
  665.  
  666. The add_cookie_header() method will set the appropriate Cookie:-header
  667. for the I<HTTP::Request> object given as argument.  The $request must
  668. have a valid url attribute before this method is called.
  669.  
  670. =item $cookie_jar->extract_cookies( $response )
  671.  
  672. The extract_cookies() method will look for Set-Cookie: and
  673. Set-Cookie2: headers in the I<HTTP::Response> object passed as
  674. argument.  Any of these headers that are found are used to update
  675. the state of the $cookie_jar.
  676.  
  677. =item $cookie_jar->set_cookie( $version, $key, $val, $path, $domain, $port, $path_spec, $secure, $maxage, $discard, \%rest )
  678.  
  679. The set_cookie() method updates the state of the $cookie_jar.  The
  680. $key, $val, $domain, $port and $path arguments are strings.  The
  681. $path_spec, $secure, $discard arguments are boolean values. The $maxage
  682. value is a number indicating number of seconds that this cookie will
  683. live.  A value <= 0 will delete this cookie.  %rest defines
  684. various other attributes like "Comment" and "CommentURL".
  685.  
  686. =item $cookie_jar->save
  687.  
  688. =item $cookie_jar->save( $file )
  689.  
  690. This method file saves the state of the $cookie_jar to a file.
  691. The state can then be restored later using the load() method.  If a
  692. filename is not specified we will use the name specified during
  693. construction.  If the attribute I<ignore_discard> is set, then we
  694. will even save cookies that are marked to be discarded.
  695.  
  696. The default is to save a sequence of "Set-Cookie3" lines.
  697. "Set-Cookie3" is a proprietary LWP format, not known to be compatible
  698. with any browser.  The I<HTTP::Cookies::Netscape> sub-class can
  699. be used to save in a format compatible with Netscape.
  700.  
  701. =item $cookie_jar->load
  702.  
  703. =item $cookie_jar->load( $file )
  704.  
  705. This method reads the cookies from the file and adds them to the
  706. $cookie_jar.  The file must be in the format written by the save()
  707. method.
  708.  
  709. =item $cookie_jar->revert
  710.  
  711. This method empties the $cookie_jar and re-loads the $cookie_jar
  712. from the last save file.
  713.  
  714. =item $cookie_jar->clear
  715.  
  716. =item $cookie_jar->clear( $domain )
  717.  
  718. =item $cookie_jar->clear( $domain, $path )
  719.  
  720. =item $cookie_jar->clear( $domain, $path, $key )
  721.  
  722. Invoking this method without arguments will empty the whole
  723. $cookie_jar.  If given a single argument only cookies belonging to
  724. that domain will be removed.  If given two arguments, cookies
  725. belonging to the specified path within that domain are removed.  If
  726. given three arguments, then the cookie with the specified key, path
  727. and domain is removed.
  728.  
  729. =item $cookie_jar->clear_temporary_cookies
  730.  
  731. Discard all temporary cookies. Scans for all cookies in the jar
  732. with either no expire field or a true C<discard> flag. To be
  733. called when the user agent shuts down according to RFC 2965.
  734.  
  735. =item $cookie_jar->scan( \&callback )
  736.  
  737. The argument is a subroutine that will be invoked for each cookie
  738. stored in the $cookie_jar.  The subroutine will be invoked with
  739. the following arguments:
  740.  
  741.   0  version
  742.   1  key
  743.   2  val
  744.   3  path
  745.   4  domain
  746.   5  port
  747.   6  path_spec
  748.   7  secure
  749.   8  expires
  750.   9  discard
  751.  10  hash
  752.  
  753. =item $cookie_jar->as_string
  754.  
  755. =item $cookie_jar->as_string( $skip_discardables )
  756.  
  757. The as_string() method will return the state of the $cookie_jar
  758. represented as a sequence of "Set-Cookie3" header lines separated by
  759. "\n".  If $skip_discardables is TRUE, it will not return lines for
  760. cookies with the I<Discard> attribute.
  761.  
  762. =back
  763.  
  764. =head1 SEE ALSO
  765.  
  766. L<HTTP::Cookies::Netscape>, L<HTTP::Cookies::Microsoft>
  767.  
  768. =head1 COPYRIGHT
  769.  
  770. Copyright 1997-2002 Gisle Aas
  771.  
  772. This library is free software; you can redistribute it and/or
  773. modify it under the same terms as Perl itself.
  774.  
  775.