local-lib5/lib/perl5/HTTP/Cookies.pm

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