root/trunk/inc/HTTP/Cookies.pm

Revision 95, 19.8 kB (checked in by clinton, 4 years ago)

Add LWP to the inc bundle, tid10737 tid10892

Line 
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
Note: See TracBrowser for help on using the browser.