git.maemo.org Git - dh-make-perl/blob - dev/arm/libwww-perl/libwww-perl-5.813/debian/libwww-perl/usr/share/perl5/HTTP/Cookies.pm

   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 = "5.810";
  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://wp.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 unless @cur;
 244             next if $in_set2{$cur[0]};
 245
 246 #           push(@cur, "Port" => $req_port);
 247             push(@cur, "Discard" => undef) unless $expires;
 248             push(@cur, "Version" => 0);
 249             push(@cur, "ns-cookie" => 1);
 250             push(@set, \@cur);
 251         }
 252     }
 253
 254   SET_COOKIE:
 255     for my $set (@set) {
 256         next unless @$set >= 2;
 257
 258         my $key = shift @$set;
 259         my $val = shift @$set;
 260
 261         LWP::Debug::debug("Set cookie $key => $val");
 262
 263         my %hash;
 264         while (@$set) {
 265             my $k = shift @$set;
 266             my $v = shift @$set;
 267             my $lc = lc($k);
 268             # don't loose case distinction for unknown fields
 269             $k = $lc if $lc =~ /^(?:discard|domain|max-age|
 270                                     path|port|secure|version)$/x;
 271             if ($k eq "discard" || $k eq "secure") {
 272                 $v = 1 unless defined $v;
 273             }
 274             next if exists $hash{$k};  # only first value is signigicant
 275             $hash{$k} = $v;
 276         };
 277
 278         my %orig_hash = %hash;
 279         my $version   = delete $hash{version};
 280         $version = 1 unless defined($version);
 281         my $discard   = delete $hash{discard};
 282         my $secure    = delete $hash{secure};
 283         my $maxage    = delete $hash{'max-age'};
 284         my $ns_cookie = delete $hash{'ns-cookie'};
 285
 286         # Check domain
 287         my $domain  = delete $hash{domain};
 288         $domain = lc($domain) if defined $domain;
 289         if (defined($domain)
 290             && $domain ne $req_host && $domain ne ".$req_host") {
 291             if ($domain !~ /\./ && $domain ne "local") {
 292                 LWP::Debug::debug("Domain $domain contains no dot");
 293                 next SET_COOKIE;
 294             }
 295             $domain = ".$domain" unless $domain =~ /^\./;
 296             if ($domain =~ /\.\d+$/) {
 297                 LWP::Debug::debug("IP-address $domain illeagal as domain");
 298                 next SET_COOKIE;
 299             }
 300             my $len = length($domain);
 301             unless (substr($req_host, -$len) eq $domain) {
 302                 LWP::Debug::debug("Domain $domain does not match host $req_host");
 303                 next SET_COOKIE;
 304             }
 305             my $hostpre = substr($req_host, 0, length($req_host) - $len);
 306             if ($hostpre =~ /\./ && !$ns_cookie) {
 307                 LWP::Debug::debug("Host prefix contain a dot: $hostpre => $domain");
 308                 next SET_COOKIE;
 309             }
 310         }
 311         else {
 312             $domain = $req_host;
 313         }
 314
 315         my $path = delete $hash{path};
 316         my $path_spec;
 317         if (defined $path && $path ne '') {
 318             $path_spec++;
 319             _normalize_path($path) if $path =~ /%/;
 320             if (!$ns_cookie &&
 321                 substr($req_path, 0, length($path)) ne $path) {
 322                 LWP::Debug::debug("Path $path is not a prefix of $req_path");
 323                 next SET_COOKIE;
 324             }
 325         }
 326         else {
 327             $path = $req_path;
 328             $path =~ s,/[^/]*$,,;
 329             $path = "/" unless length($path);
 330         }
 331
 332         my $port;
 333         if (exists $hash{port}) {
 334             $port = delete $hash{port};
 335             if (defined $port) {
 336                 $port =~ s/\s+//g;
 337                 my $found;
 338                 for my $p (split(/,/, $port)) {
 339                     unless ($p =~ /^\d+$/) {
 340                       LWP::Debug::debug("Bad port $port (not numeric)");
 341                         next SET_COOKIE;
 342                     }
 343                     $found++ if $p eq $req_port;
 344                 }
 345                 unless ($found) {
 346                     LWP::Debug::debug("Request port ($req_port) not found in $port");
 347                     next SET_COOKIE;
 348                 }
 349             }
 350             else {
 351                 $port = "_$req_port";
 352             }
 353         }
 354         $self->set_cookie($version,$key,$val,$path,$domain,$port,$path_spec,$secure,$maxage,$discard, \%hash)
 355             if $self->set_cookie_ok(\%orig_hash);
 356     }
 357
 358     $response;
 359 }
 360
 361 sub set_cookie_ok
 362 {
 363     1;
 364 }
 365
 366
 367 sub set_cookie
 368 {
 369     my $self = shift;
 370     my($version,
 371        $key, $val, $path, $domain, $port,
 372        $path_spec, $secure, $maxage, $discard, $rest) = @_;
 373
 374     # path and key can not be empty (key can't start with '$')
 375     return $self if !defined($path) || $path !~ m,^/, ||
 376                     !defined($key)  || $key  =~ m,^\$,;
 377
 378     # ensure legal port
 379     if (defined $port) {
 380         return $self unless $port =~ /^_?\d+(?:,\d+)*$/;
 381     }
 382
 383     my $expires;
 384     if (defined $maxage) {
 385         if ($maxage <= 0) {
 386             delete $self->{COOKIES}{$domain}{$path}{$key};
 387             return $self;
 388         }
 389         $expires = time() + $maxage;
 390     }
 391     $version = 0 unless defined $version;
 392
 393     my @array = ($version, $val,$port,
 394                  $path_spec,
 395                  $secure, $expires, $discard);
 396     push(@array, {%$rest}) if defined($rest) && %$rest;
 397     # trim off undefined values at end
 398     pop(@array) while !defined $array[-1];
 399
 400     $self->{COOKIES}{$domain}{$path}{$key} = \@array;
 401     $self;
 402 }
 403
 404
 405 sub save
 406 {
 407     my $self = shift;
 408     my $file = shift || $self->{'file'} || return;
 409     local(*FILE);
 410     open(FILE, ">$file") or die "Can't open $file: $!";
 411     print FILE "#LWP-Cookies-1.0\n";
 412     print FILE $self->as_string(!$self->{ignore_discard});
 413     close(FILE);
 414     1;
 415 }
 416
 417
 418 sub load
 419 {
 420     my $self = shift;
 421     my $file = shift || $self->{'file'} || return;
 422     local(*FILE, $_);
 423     local $/ = "\n";  # make sure we got standard record separator
 424     open(FILE, $file) or return;
 425     my $magic = <FILE>;
 426     unless ($magic =~ /^\#LWP-Cookies-(\d+\.\d+)/) {
 427         warn "$file does not seem to contain cookies";
 428         return;
 429     }
 430     while (<FILE>) {
 431         next unless s/^Set-Cookie3:\s*//;
 432         chomp;
 433         my $cookie;
 434         for $cookie (split_header_words($_)) {
 435             my($key,$val) = splice(@$cookie, 0, 2);
 436             my %hash;
 437             while (@$cookie) {
 438                 my $k = shift @$cookie;
 439                 my $v = shift @$cookie;
 440                 $hash{$k} = $v;
 441             }
 442             my $version   = delete $hash{version};
 443             my $path      = delete $hash{path};
 444             my $domain    = delete $hash{domain};
 445             my $port      = delete $hash{port};
 446             my $expires   = str2time(delete $hash{expires});
 447
 448             my $path_spec = exists $hash{path_spec}; delete $hash{path_spec};
 449             my $secure    = exists $hash{secure};    delete $hash{secure};
 450             my $discard   = exists $hash{discard};   delete $hash{discard};
 451
 452             my @array = ($version,$val,$port,
 453                          $path_spec,$secure,$expires,$discard);
 454             push(@array, \%hash) if %hash;
 455             $self->{COOKIES}{$domain}{$path}{$key} = \@array;
 456         }
 457     }
 458     close(FILE);
 459     1;
 460 }
 461
 462
 463 sub revert
 464 {
 465     my $self = shift;
 466     $self->clear->load;
 467     $self;
 468 }
 469
 470
 471 sub clear
 472 {
 473     my $self = shift;
 474     if (@_ == 0) {
 475         $self->{COOKIES} = {};
 476     }
 477     elsif (@_ == 1) {
 478         delete $self->{COOKIES}{$_[0]};
 479     }
 480     elsif (@_ == 2) {
 481         delete $self->{COOKIES}{$_[0]}{$_[1]};
 482     }
 483     elsif (@_ == 3) {
 484         delete $self->{COOKIES}{$_[0]}{$_[1]}{$_[2]};
 485     }
 486     else {
 487         require Carp;
 488         Carp::carp('Usage: $c->clear([domain [,path [,key]]])');
 489     }
 490     $self;
 491 }
 492
 493
 494 sub clear_temporary_cookies
 495 {
 496     my($self) = @_;
 497
 498     $self->scan(sub {
 499         if($_[9] or        # "Discard" flag set
 500            not $_[8]) {    # No expire field?
 501             $_[8] = -1;            # Set the expire/max_age field
 502             $self->set_cookie(@_); # Clear the cookie
 503         }
 504       });
 505 }
 506
 507
 508 sub DESTROY
 509 {
 510     my $self = shift;
 511     $self->save if $self->{'autosave'};
 512 }
 513
 514
 515 sub scan
 516 {
 517     my($self, $cb) = @_;
 518     my($domain,$path,$key);
 519     for $domain (sort keys %{$self->{COOKIES}}) {
 520         for $path (sort keys %{$self->{COOKIES}{$domain}}) {
 521             for $key (sort keys %{$self->{COOKIES}{$domain}{$path}}) {
 522                 my($version,$val,$port,$path_spec,
 523                    $secure,$expires,$discard,$rest) =
 524                        @{$self->{COOKIES}{$domain}{$path}{$key}};
 525                 $rest = {} unless defined($rest);
 526                 &$cb($version,$key,$val,$path,$domain,$port,
 527                      $path_spec,$secure,$expires,$discard,$rest);
 528             }
 529         }
 530     }
 531 }
 532
 533
 534 sub as_string
 535 {
 536     my($self, $skip_discard) = @_;
 537     my @res;
 538     $self->scan(sub {
 539         my($version,$key,$val,$path,$domain,$port,
 540            $path_spec,$secure,$expires,$discard,$rest) = @_;
 541         return if $discard && $skip_discard;
 542         my @h = ($key, $val);
 543         push(@h, "path", $path);
 544         push(@h, "domain" => $domain);
 545         push(@h, "port" => $port) if defined $port;
 546         push(@h, "path_spec" => undef) if $path_spec;
 547         push(@h, "secure" => undef) if $secure;
 548         push(@h, "expires" => HTTP::Date::time2isoz($expires)) if $expires;
 549         push(@h, "discard" => undef) if $discard;
 550         my $k;
 551         for $k (sort keys %$rest) {
 552             push(@h, $k, $rest->{$k});
 553         }
 554         push(@h, "version" => $version);
 555         push(@res, "Set-Cookie3: " . join_header_words(\@h));
 556     });
 557     join("\n", @res, "");
 558 }
 559
 560 sub _host
 561 {
 562     my($request, $url) = @_;
 563     if (my $h = $request->header("Host")) {
 564         $h =~ s/:\d+$//;  # might have a port as well
 565         return lc($h);
 566     }
 567     return lc($url->host);
 568 }
 569
 570 sub _url_path
 571 {
 572     my $url = shift;
 573     my $path;
 574     if($url->can('epath')) {
 575        $path = $url->epath;    # URI::URL method
 576     }
 577     else {
 578        $path = $url->path;           # URI::_generic method
 579     }
 580     $path = "/" unless length $path;
 581     $path;
 582 }
 583
 584 sub _normalize_path  # so that plain string compare can be used
 585 {
 586     my $x;
 587     $_[0] =~ s/%([0-9a-fA-F][0-9a-fA-F])/
 588                  $x = uc($1);
 589                  $x eq "2F" || $x eq "25" ? "%$x" :
 590                                             pack("C", hex($x));
 591               /eg;
 592     $_[0] =~ s/([\0-\x20\x7f-\xff])/sprintf("%%%02X",ord($1))/eg;
 593 }
 594
 595 1;
 596
 597 __END__
 598
 599 =head1 NAME
 600
 601 HTTP::Cookies - HTTP cookie jars
 602
 603 =head1 SYNOPSIS
 604
 605   use HTTP::Cookies;
 606   $cookie_jar = HTTP::Cookies->new(
 607     file => "$ENV{'HOME'}/lwp_cookies.dat',
 608     autosave => 1,
 609   );
 610
 611   use LWP;
 612   my $browser = LWP::UserAgent->new;
 613   $browser->cookie_jar($cookie_jar);
 614
 615 Or for an empty and temporary cookie jar:
 616
 617   use LWP;
 618   my $browser = LWP::UserAgent->new;
 619   $browser->cookie_jar( {} );
 620
 621 =head1 DESCRIPTION
 622
 623 This class is for objects that represent a "cookie jar" -- that is, a
 624 database of all the HTTP cookies that a given LWP::UserAgent object
 625 knows about.
 626
 627 Cookies are a general mechanism which server side connections can use
 628 to both store and retrieve information on the client side of the
 629 connection.  For more information about cookies refer to
 630 <URL:http://wp.netscape.com/newsref/std/cookie_spec.html> and
 631 <URL:http://www.cookiecentral.com/>.  This module also implements the
 632 new style cookies described in I<RFC 2965>.
 633 The two variants of cookies are supposed to be able to coexist happily.
 634
 635 Instances of the class I<HTTP::Cookies> are able to store a collection
 636 of Set-Cookie2: and Set-Cookie: headers and are able to use this
 637 information to initialize Cookie-headers in I<HTTP::Request> objects.
 638 The state of a I<HTTP::Cookies> object can be saved in and restored from
 639 files.
 640
 641 =head1 METHODS
 642
 643 The following methods are provided:
 644
 645 =over 4
 646
 647 =item $cookie_jar = HTTP::Cookies->new
 648
 649 The constructor takes hash style parameters.  The following
 650 parameters are recognized:
 651
 652   file:            name of the file to restore cookies from and save cookies to
 653   autosave:        save during destruction (bool)
 654   ignore_discard:  save even cookies that are requested to be discarded (bool)
 655   hide_cookie2:    do not add Cookie2 header to requests
 656
 657 Future parameters might include (not yet implemented):
 658
 659   max_cookies               300
 660   max_cookies_per_domain    20
 661   max_cookie_size           4096
 662
 663   no_cookies   list of domain names that we never return cookies to
 664
 665 =item $cookie_jar->add_cookie_header( $request )
 666
 667 The add_cookie_header() method will set the appropriate Cookie:-header
 668 for the I<HTTP::Request> object given as argument.  The $request must
 669 have a valid url attribute before this method is called.
 670
 671 =item $cookie_jar->extract_cookies( $response )
 672
 673 The extract_cookies() method will look for Set-Cookie: and
 674 Set-Cookie2: headers in the I<HTTP::Response> object passed as
 675 argument.  Any of these headers that are found are used to update
 676 the state of the $cookie_jar.
 677
 678 =item $cookie_jar->set_cookie( $version, $key, $val, $path, $domain, $port, $path_spec, $secure, $maxage, $discard, \%rest )
 679
 680 The set_cookie() method updates the state of the $cookie_jar.  The
 681 $key, $val, $domain, $port and $path arguments are strings.  The
 682 $path_spec, $secure, $discard arguments are boolean values. The $maxage
 683 value is a number indicating number of seconds that this cookie will
 684 live.  A value <= 0 will delete this cookie.  %rest defines
 685 various other attributes like "Comment" and "CommentURL".
 686
 687 =item $cookie_jar->save
 688
 689 =item $cookie_jar->save( $file )
 690
 691 This method file saves the state of the $cookie_jar to a file.
 692 The state can then be restored later using the load() method.  If a
 693 filename is not specified we will use the name specified during
 694 construction.  If the attribute I<ignore_discard> is set, then we
 695 will even save cookies that are marked to be discarded.
 696
 697 The default is to save a sequence of "Set-Cookie3" lines.
 698 "Set-Cookie3" is a proprietary LWP format, not known to be compatible
 699 with any browser.  The I<HTTP::Cookies::Netscape> sub-class can
 700 be used to save in a format compatible with Netscape.
 701
 702 =item $cookie_jar->load
 703
 704 =item $cookie_jar->load( $file )
 705
 706 This method reads the cookies from the file and adds them to the
 707 $cookie_jar.  The file must be in the format written by the save()
 708 method.
 709
 710 =item $cookie_jar->revert
 711
 712 This method empties the $cookie_jar and re-loads the $cookie_jar
 713 from the last save file.
 714
 715 =item $cookie_jar->clear
 716
 717 =item $cookie_jar->clear( $domain )
 718
 719 =item $cookie_jar->clear( $domain, $path )
 720
 721 =item $cookie_jar->clear( $domain, $path, $key )
 722
 723 Invoking this method without arguments will empty the whole
 724 $cookie_jar.  If given a single argument only cookies belonging to
 725 that domain will be removed.  If given two arguments, cookies
 726 belonging to the specified path within that domain are removed.  If
 727 given three arguments, then the cookie with the specified key, path
 728 and domain is removed.
 729
 730 =item $cookie_jar->clear_temporary_cookies
 731
 732 Discard all temporary cookies. Scans for all cookies in the jar
 733 with either no expire field or a true C<discard> flag. To be
 734 called when the user agent shuts down according to RFC 2965.
 735
 736 =item $cookie_jar->scan( \&callback )
 737
 738 The argument is a subroutine that will be invoked for each cookie
 739 stored in the $cookie_jar.  The subroutine will be invoked with
 740 the following arguments:
 741
 742   0  version
 743   1  key
 744   2  val
 745   3  path
 746   4  domain
 747   5  port
 748   6  path_spec
 749   7  secure
 750   8  expires
 751   9  discard
 752  10  hash
 753
 754 =item $cookie_jar->as_string
 755
 756 =item $cookie_jar->as_string( $skip_discardables )
 757
 758 The as_string() method will return the state of the $cookie_jar
 759 represented as a sequence of "Set-Cookie3" header lines separated by
 760 "\n".  If $skip_discardables is TRUE, it will not return lines for
 761 cookies with the I<Discard> attribute.
 762
 763 =back
 764
 765 =head1 SEE ALSO
 766
 767 L<HTTP::Cookies::Netscape>, L<HTTP::Cookies::Microsoft>
 768
 769 =head1 COPYRIGHT
 770
 771 Copyright 1997-2002 Gisle Aas
 772
 773 This library is free software; you can redistribute it and/or
 774 modify it under the same terms as Perl itself.
 775