summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/site/lib/HTTP
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/site/lib/HTTP')
-rw-r--r--Master/tlpkg/tlperl/site/lib/HTTP/Cookies.pm157
-rw-r--r--Master/tlpkg/tlperl/site/lib/HTTP/Cookies/Microsoft.pm313
-rw-r--r--Master/tlpkg/tlperl/site/lib/HTTP/Cookies/Netscape.pm91
3 files changed, 317 insertions, 244 deletions
diff --git a/Master/tlpkg/tlperl/site/lib/HTTP/Cookies.pm b/Master/tlpkg/tlperl/site/lib/HTTP/Cookies.pm
index 79ac4f27f84..98bd7421012 100644
--- a/Master/tlpkg/tlperl/site/lib/HTTP/Cookies.pm
+++ b/Master/tlpkg/tlperl/site/lib/HTTP/Cookies.pm
@@ -1,5 +1,5 @@
package HTTP::Cookies;
-
+$HTTP::Cookies::VERSION = '6.03';
use strict;
use HTTP::Date qw(str2time parse_date time2str);
use HTTP::Headers::Util qw(_split_header_words join_header_words);
@@ -165,12 +165,32 @@ sub add_cookie_header
unshift(@cval, $old);
}
$request->header(Cookie => join("; ", @cval));
+ if (my $hash = $request->{_http_cookies}) {
+ %$hash = (map split(/=/, $_, 2), @cval);
+ }
}
$request;
}
+sub get_cookies
+{
+ my $self = shift;
+ my $url = shift;
+ $url = "https://$url" unless $url =~ m,^[a-zA-Z][a-zA-Z0-9.+\-]*:,;
+ require HTTP::Request;
+ my $req = HTTP::Request->new(GET => $url);
+ my $cookies = $req->{_http_cookies} = {};
+ $self->add_cookie_header($req);
+ if (@_) {
+ return map $cookies->{$_}, @_ if wantarray;
+ return $cookies->{$_[0]};
+ }
+ return $cookies;
+}
+
+
sub extract_cookies
{
my $self = shift;
@@ -411,11 +431,9 @@ sub save
{
my $self = shift;
my $file = shift || $self->{'file'} || return;
- local(*FILE);
- open(FILE, ">$file") or die "Can't open $file: $!";
- print FILE "#LWP-Cookies-1.0\n";
- print FILE $self->as_string(!$self->{ignore_discard});
- close(FILE);
+ open(my $fh, '>', $file) or die "Can't open $file: $!";
+ print {$fh} "#LWP-Cookies-1.0\n";
+ print {$fh} $self->as_string(!$self->{ignore_discard});
1;
}
@@ -424,43 +442,47 @@ sub load
{
my $self = shift;
my $file = shift || $self->{'file'} || return;
- local(*FILE, $_);
+
local $/ = "\n"; # make sure we got standard record separator
- open(FILE, $file) or return;
- my $magic = <FILE>;
- unless ($magic =~ /^\#LWP-Cookies-(\d+\.\d+)/) {
- warn "$file does not seem to contain cookies";
- return;
+ open(my $fh, '<', $file) or return;
+
+ # check that we have the proper header
+ my $magic = <$fh>;
+ chomp $magic;
+ unless ($magic =~ /^#LWP-Cookies-\d+\.\d+/) {
+ warn "$file does not seem to contain cookies";
+ return;
}
- while (<FILE>) {
- next unless s/^Set-Cookie3:\s*//;
- chomp;
- my $cookie;
- for $cookie (_split_header_words($_)) {
- my($key,$val) = splice(@$cookie, 0, 2);
- my %hash;
- while (@$cookie) {
- my $k = shift @$cookie;
- my $v = shift @$cookie;
- $hash{$k} = $v;
- }
- my $version = delete $hash{version};
- my $path = delete $hash{path};
- my $domain = delete $hash{domain};
- my $port = delete $hash{port};
- my $expires = str2time(delete $hash{expires});
-
- my $path_spec = exists $hash{path_spec}; delete $hash{path_spec};
- my $secure = exists $hash{secure}; delete $hash{secure};
- my $discard = exists $hash{discard}; delete $hash{discard};
-
- my @array = ($version,$val,$port,
- $path_spec,$secure,$expires,$discard);
- push(@array, \%hash) if %hash;
- $self->{COOKIES}{$domain}{$path}{$key} = \@array;
- }
+
+ # go through the file
+ while (my $line = <$fh>) {
+ chomp $line;
+ next unless $line =~ s/^Set-Cookie3:\s*//;
+ my $cookie;
+ for $cookie (_split_header_words($line)) {
+ my($key,$val) = splice(@$cookie, 0, 2);
+ my %hash;
+ while (@$cookie) {
+ my $k = shift @$cookie;
+ my $v = shift @$cookie;
+ $hash{$k} = $v;
+ }
+ my $version = delete $hash{version};
+ my $path = delete $hash{path};
+ my $domain = delete $hash{domain};
+ my $port = delete $hash{port};
+ my $expires = str2time(delete $hash{expires});
+
+ my $path_spec = exists $hash{path_spec}; delete $hash{path_spec};
+ my $secure = exists $hash{secure}; delete $hash{secure};
+ my $discard = exists $hash{discard}; delete $hash{discard};
+
+ my @array = ($version, $val, $port, $path_spec, $secure, $expires,
+ $discard);
+ push(@array, \%hash) if %hash;
+ $self->{COOKIES}{$domain}{$path}{$key} = \@array;
+ }
}
- close(FILE);
1;
}
@@ -600,12 +622,18 @@ sub _normalize_path # so that plain string compare can be used
1;
-__END__
+=pod
+
+=encoding UTF-8
=head1 NAME
HTTP::Cookies - HTTP cookie jars
+=head1 VERSION
+
+version 6.03
+
=head1 SYNOPSIS
use HTTP::Cookies;
@@ -635,7 +663,7 @@ to both store and retrieve information on the client side of the
connection. For more information about cookies refer to
<URL:http://curl.haxx.se/rfc/cookie_spec.html> and
<URL:http://www.cookiecentral.com/>. This module also implements the
-new style cookies described in I<RFC 2965>.
+new style cookies described in L<RFC 2965|https://tools.ietf.org/html/rfc2965>.
The two variants of cookies are supposed to be able to coexist happily.
Instances of the class I<HTTP::Cookies> are able to store a collection
@@ -644,6 +672,22 @@ information to initialize Cookie-headers in I<HTTP::Request> objects.
The state of a I<HTTP::Cookies> object can be saved in and restored from
files.
+=head1 LIMITATIONS
+
+This module does not support L<< Public Suffix|https://publicsuffix.org/
+>> encouraged by a more recent standard, L<< RFC
+6265|https://tools.ietf.org/html/rfc6265 >>.
+
+This module's shortcomings mean that a malicious Web site can set
+cookies to track your user agent across all sites under a top level
+domain. See F<< t/publicsuffix.t >> in this module's distribution for
+details.
+
+L<< HTTP::CookieJar::LWP >> supports Public Suffix, but only provides a
+limited subset of this module's functionality and L<< does not
+support|HTTP::CookieJar/LIMITATIONS-AND-CAVEATS >> standards older than
+I<RFC 6265>.
+
=head1 METHODS
The following methods are provided:
@@ -668,6 +712,16 @@ Future parameters might include (not yet implemented):
no_cookies list of domain names that we never return cookies to
+=item $cookie_jar->get_cookies( $url_or_domain )
+
+=item $cookie_jar->get_cookies( $url_or_domain, $cookie_key,... )
+
+Returns a hash of the cookies that applies to the given URL. If a
+domainname is given as argument, then a prefix of "https://" is assumed.
+
+If one or more $cookie_key parameters are provided return the given values,
+or C<undef> if the cookie isn't available.
+
=item $cookie_jar->add_cookie_header( $request )
The add_cookie_header() method will set the appropriate Cookie:-header
@@ -687,7 +741,7 @@ The set_cookie() method updates the state of the $cookie_jar. The
$key, $val, $domain, $port and $path arguments are strings. The
$path_spec, $secure, $discard arguments are boolean values. The $maxage
value is a number indicating number of seconds that this cookie will
-live. A value <= 0 will delete this cookie. %rest defines
+live. A value of $maxage <= 0 will delete this cookie. %rest defines
various other attributes like "Comment" and "CommentURL".
=item $cookie_jar->save
@@ -772,10 +826,19 @@ cookies with the I<Discard> attribute.
L<HTTP::Cookies::Netscape>, L<HTTP::Cookies::Microsoft>
-=head1 COPYRIGHT
+=head1 AUTHOR
+
+Gisle Aas <gisle@activestate.com>
-Copyright 1997-2002 Gisle Aas
+=head1 COPYRIGHT AND LICENSE
-This library is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
+This software is copyright (c) 2002-2017 by Gisle Aas.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
+
+__END__
+#ABSTRACT: HTTP cookie jars
diff --git a/Master/tlpkg/tlperl/site/lib/HTTP/Cookies/Microsoft.pm b/Master/tlpkg/tlperl/site/lib/HTTP/Cookies/Microsoft.pm
index 9c69fa364cf..bffa587adf9 100644
--- a/Master/tlpkg/tlperl/site/lib/HTTP/Cookies/Microsoft.pm
+++ b/Master/tlpkg/tlperl/site/lib/HTTP/Cookies/Microsoft.pm
@@ -1,56 +1,56 @@
package HTTP::Cookies::Microsoft;
-
+$HTTP::Cookies::Microsoft::VERSION = '6.03';
use strict;
use vars qw(@ISA $VERSION);
-$VERSION = "6.00";
+$VERSION = "6.01";
require HTTP::Cookies;
@ISA=qw(HTTP::Cookies);
sub load_cookies_from_file
{
- my ($file) = @_;
- my @cookies;
- my ($key, $value, $domain_path, $flags, $lo_expire, $hi_expire);
- my ($lo_create, $hi_create, $sep);
-
- open(COOKIES, $file) || return;
-
- while ($key = <COOKIES>)
- {
- chomp($key);
- chomp($value = <COOKIES>);
- chomp($domain_path= <COOKIES>);
- chomp($flags = <COOKIES>); # 0x0001 bit is for secure
- chomp($lo_expire = <COOKIES>);
- chomp($hi_expire = <COOKIES>);
- chomp($lo_create = <COOKIES>);
- chomp($hi_create = <COOKIES>);
- chomp($sep = <COOKIES>);
-
- if (!defined($key) || !defined($value) || !defined($domain_path) ||
- !defined($flags) || !defined($hi_expire) || !defined($lo_expire) ||
- !defined($hi_create) || !defined($lo_create) || !defined($sep) ||
- ($sep ne '*'))
- {
- last;
- }
-
- if ($domain_path =~ /^([^\/]+)(\/.*)$/)
- {
- my $domain = $1;
- my $path = $2;
-
- push(@cookies, {KEY => $key, VALUE => $value, DOMAIN => $domain,
- PATH => $path, FLAGS =>$flags, HIXP =>$hi_expire,
- LOXP => $lo_expire, HICREATE => $hi_create,
- LOCREATE => $lo_create});
- }
- }
-
- return \@cookies;
+ my ($file) = @_;
+ my @cookies;
+
+ open (my $fh, '<', $file) || return;
+
+ while (my $key = <$fh>) {
+ chomp $key;
+ my ($value, $domain_path, $flags, $lo_expire, $hi_expire);
+ my ($lo_create, $hi_create, $sep);
+ chomp($value = <$fh>);
+ chomp($domain_path= <$fh>);
+ chomp($flags = <$fh>); # 0x0001 bit is for secure
+ chomp($lo_expire = <$fh>);
+ chomp($hi_expire = <$fh>);
+ chomp($lo_create = <$fh>);
+ chomp($hi_create = <$fh>);
+ chomp($sep = <$fh>);
+
+ if (!defined($key) || !defined($value) || !defined($domain_path) ||
+ !defined($flags) || !defined($hi_expire) || !defined($lo_expire) ||
+ !defined($hi_create) || !defined($lo_create) || !defined($sep) ||
+ ($sep ne '*'))
+ {
+ last;
+ }
+
+ if ($domain_path =~ /^([^\/]+)(\/.*)$/) {
+ my $domain = $1;
+ my $path = $2;
+
+ push @cookies, {
+ KEY => $key, VALUE => $value, DOMAIN => $domain,
+ PATH => $path, FLAGS =>$flags, HIXP =>$hi_expire,
+ LOXP => $lo_expire, HICREATE => $hi_create,
+ LOCREATE => $lo_create
+ };
+ }
+ }
+
+ return \@cookies;
}
sub get_user_name
@@ -78,7 +78,7 @@ sub epoch_time_offset_from_win32_filetime
# 0x019db1de 0xd53e8000 is 1970 Jan 01 00:00:00 in Win32 FILETIME
#
# 100 nanosecond intervals == 0.1 microsecond intervals
-
+
my $filetime_low32_1970 = 0xd53e8000;
my $filetime_high32_1970 = 0x019db1de;
@@ -135,7 +135,7 @@ sub load_cookie
my $secure = ($cookie->{FLAGS} & 1) != 0;
my $expires = epoch_time_offset_from_win32_filetime($cookie->{HIXP}, $cookie->{LOXP});
- $self->set_cookie(undef, $cookie->{KEY}, $cookie->{VALUE},
+ $self->set_cookie(undef, $cookie->{KEY}, $cookie->{VALUE},
$cookie->{PATH}, $cookie->{DOMAIN}, undef,
0, $secure, $expires-$now, 0);
}
@@ -144,127 +144,109 @@ sub load_cookie
sub load
{
- my($self, $cookie_index) = @_;
- my $now = time() - $HTTP::Cookies::EPOCH_OFFSET;
- my $cookie_dir = '';
- my $delay_load = (defined($self->{'delayload'}) && $self->{'delayload'});
- my $user_name = get_user_name();
- my $data;
-
- $cookie_index ||= $self->{'file'} || return;
- if ($cookie_index =~ /[\\\/][^\\\/]+$/)
- {
- $cookie_dir = $` . "\\";
- }
-
- local(*INDEX, $_);
-
- open(INDEX, $cookie_index) || return;
- binmode(INDEX);
- if (256 != read(INDEX, $data, 256))
- {
- warn "$cookie_index file is not large enough";
- close(INDEX);
- return;
- }
-
- # Cookies' index.dat file starts with 32 bytes of signature
- # followed by an offset to the first record, stored as a little-endian DWORD
- my ($sig, $size) = unpack('a32 V', $data);
-
- if (($sig !~ /^Client UrlCache MMF Ver 5\.2/) || # check that sig is valid (only tested in IE6.0)
- (0x4000 != $size))
- {
- warn "$cookie_index ['$sig' $size] does not seem to contain cookies";
- close(INDEX);
- return;
- }
-
- if (0 == seek(INDEX, $size, 0)) # move the file ptr to start of the first record
- {
- close(INDEX);
- return;
- }
-
- # Cookies are usually stored in 'URL ' records in two contiguous 0x80 byte sectors (256 bytes)
- # so read in two 0x80 byte sectors and adjust if not a Cookie.
- while (256 == read(INDEX, $data, 256))
- {
- # each record starts with a 4-byte signature
- # and a count (little-endian DWORD) of 0x80 byte sectors for the record
- ($sig, $size) = unpack('a4 V', $data);
-
- # Cookies are found in 'URL ' records
- if ('URL ' ne $sig)
- {
- # skip over uninteresting record: I've seen 'HASH' and 'LEAK' records
- if (($sig eq 'HASH') || ($sig eq 'LEAK'))
- {
- # '-2' takes into account the two 0x80 byte sectors we've just read in
- if (($size > 0) && ($size != 2))
- {
- if (0 == seek(INDEX, ($size-2)*0x80, 1))
- {
- # Seek failed. Something's wrong. Gonna stop.
- last;
- }
- }
- }
- next;
- }
-
- #$REMOVE Need to check if URL records in Cookies' index.dat will
- # ever use more than two 0x80 byte sectors
- if ($size > 2)
- {
- my $more_data = ($size-2)*0x80;
-
- if ($more_data != read(INDEX, $data, $more_data, 256))
- {
- last;
- }
- }
-
- (my $user_name2 = $user_name) =~ s/ /_/g;
- if ($data =~ /Cookie\:\Q$user_name\E\@([\x21-\xFF]+).*?((?:\Q$user_name\E|\Q$user_name2\E)\@[\x21-\xFF]+\.txt)/)
- {
- my $cookie_file = $cookie_dir . $2; # form full pathname
-
- if (!$delay_load)
- {
- $self->load_cookie($cookie_file);
- }
- else
- {
- my $domain = $1;
-
- # grab only the domain name, drop everything from the first dir sep on
- if ($domain =~ m{[\\/]})
- {
- $domain = $`;
- }
-
- # set the delayload cookie for this domain with
- # the cookie_file as cookie for later-loading info
- $self->set_cookie(undef, 'cookie', $cookie_file,
- '//+delayload', $domain, undef,
- 0, 0, $now+86400, 0);
- }
- }
- }
-
- close(INDEX);
-
- 1;
+ my($self, $cookie_index) = @_;
+ my $now = time() - $HTTP::Cookies::EPOCH_OFFSET;
+ my $cookie_dir = '';
+ my $delay_load = (defined($self->{'delayload'}) && $self->{'delayload'});
+ my $user_name = get_user_name();
+ my $data;
+
+ $cookie_index ||= $self->{'file'} || return;
+ if ($cookie_index =~ /[\\\/][^\\\/]+$/) {
+ $cookie_dir = $` . "\\";
+ }
+
+ open (my $fh, '<:raw', $cookie_index) || return;
+ if (256 != read($fh, $data, 256)) {
+ warn "$cookie_index file is not large enough";
+ return;
+ }
+
+ # Cookies' index.dat file starts with 32 bytes of signature
+ # followed by an offset to the first record, stored as a little-endian DWORD
+ my ($sig, $size) = unpack('a32 V', $data);
+
+ # check that sig is valid (only tested in IE6.0)
+ if (($sig !~ /^Client UrlCache MMF Ver 5\.2/) || (0x4000 != $size)) {
+ warn "$cookie_index ['$sig' $size] does not seem to contain cookies";
+ return;
+ }
+
+ # move the file ptr to start of the first record
+ if (0 == seek($fh, $size, 0)) {
+ return;
+ }
+
+ # Cookies are usually stored in 'URL ' records in two contiguous 0x80 byte sectors (256 bytes)
+ # so read in two 0x80 byte sectors and adjust if not a Cookie.
+ while (256 == read($fh, $data, 256)) {
+ # each record starts with a 4-byte signature
+ # and a count (little-endian DWORD) of 0x80 byte sectors for the record
+ ($sig, $size) = unpack('a4 V', $data);
+
+ # Cookies are found in 'URL ' records
+ if ('URL ' ne $sig) {
+ # skip over uninteresting record: I've seen 'HASH' and 'LEAK' records
+ if (($sig eq 'HASH') || ($sig eq 'LEAK')) {
+ # '-2' takes into account the two 0x80 byte sectors we've just read in
+ if (($size > 0) && ($size != 2)) {
+ if (0 == seek($fh, ($size-2)*0x80, 1)) {
+ # Seek failed. Something's wrong. Gonna stop.
+ last;
+ }
+ }
+ }
+ next;
+ }
+
+ #$REMOVE Need to check if URL records in Cookies' index.dat will
+ # ever use more than two 0x80 byte sectors
+ if ($size > 2) {
+ my $more_data = ($size-2)*0x80;
+
+ if ($more_data != read($fh, $data, $more_data, 256)) {
+ last;
+ }
+ }
+
+ (my $user_name2 = $user_name) =~ s/ /_/g;
+ if ($data =~ /Cookie:\Q$user_name\E@([\x21-\xFF]+).*?((?:\Q$user_name\E|\Q$user_name2\E)@[\x21-\xFF]+\.txt)/) {
+ my $cookie_file = $cookie_dir . $2; # form full pathname
+
+ if (!$delay_load) {
+ $self->load_cookie($cookie_file);
+ }
+ else {
+ my $domain = $1;
+
+ # grab only the domain name, drop everything from the first dir sep on
+ if ($domain =~ m{[\\/]}) {
+ $domain = $`;
+ }
+
+ # set the delayload cookie for this domain with
+ # the cookie_file as cookie for later-loading info
+ $self->set_cookie(undef, 'cookie', $cookie_file, '//+delayload', $domain, undef, 0, 0, $now+86400, 0);
+ }
+ }
+ }
+
+ 1;
}
1;
-__END__
+=pod
+
+=encoding UTF-8
=head1 NAME
-HTTP::Cookies::Microsoft - access to Microsoft cookies files
+HTTP::Cookies::Microsoft - Access to Microsoft cookies files
+
+=head1 VERSION
+
+version 6.03
=head1 SYNOPSIS
@@ -325,5 +307,20 @@ Copyright 2002 Johnny Lee
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
+=head1 AUTHOR
+
+Gisle Aas <gisle@activestate.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2002-2017 by Gisle Aas.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
=cut
+__END__
+
+#ABSTRACT: Access to Microsoft cookies files
+
diff --git a/Master/tlpkg/tlperl/site/lib/HTTP/Cookies/Netscape.pm b/Master/tlpkg/tlperl/site/lib/HTTP/Cookies/Netscape.pm
index 5972029e558..180d5ff8116 100644
--- a/Master/tlpkg/tlperl/site/lib/HTTP/Cookies/Netscape.pm
+++ b/Master/tlpkg/tlperl/site/lib/HTTP/Cookies/Netscape.pm
@@ -1,38 +1,37 @@
package HTTP::Cookies::Netscape;
-
+$HTTP::Cookies::Netscape::VERSION = '6.03';
use strict;
use vars qw(@ISA $VERSION);
-$VERSION = "6.00";
+$VERSION = "6.01";
require HTTP::Cookies;
@ISA=qw(HTTP::Cookies);
sub load
{
- my($self, $file) = @_;
+ my ($self, $file) = @_;
$file ||= $self->{'file'} || return;
- local(*FILE, $_);
+
local $/ = "\n"; # make sure we got standard record separator
- my @cookies;
- open(FILE, $file) || return;
- my $magic = <FILE>;
- unless ($magic =~ /^\#(?: Netscape)? HTTP Cookie File/) {
- warn "$file does not look like a netscape cookies file" if $^W;
- close(FILE);
- return;
+ open (my $fh, '<', $file) || return;
+ my $magic = <$fh>;
+ chomp $magic;
+ unless ($magic =~ /^#(?: Netscape)? HTTP Cookie File/) {
+ warn "$file does not look like a netscape cookies file";
+ return;
}
+
my $now = time() - $HTTP::Cookies::EPOCH_OFFSET;
- while (<FILE>) {
- next if /^\s*\#/;
- next if /^\s*$/;
- tr/\n\r//d;
- my($domain,$bool1,$path,$secure, $expires,$key,$val) = split(/\t/, $_);
- $secure = ($secure eq "TRUE");
- $self->set_cookie(undef,$key,$val,$path,$domain,undef,
- 0,$secure,$expires-$now, 0);
+ while (my $line = <$fh>) {
+ chomp($line);
+ next if $line =~ /^\s*\#/;
+ next if $line =~ /^\s*$/;
+ $line =~ tr/\n\r//d;
+ my($domain,$bool1,$path,$secure, $expires,$key,$val) = split(/\t/, $line);
+ $secure = ($secure eq "TRUE");
+ $self->set_cookie(undef, $key, $val, $path, $domain, undef, 0, $secure, $expires-$now, 0);
}
- close(FILE);
1;
}
@@ -40,12 +39,12 @@ sub save
{
my($self, $file) = @_;
$file ||= $self->{'file'} || return;
- local(*FILE, $_);
- open(FILE, ">$file") || return;
+
+ open(my $fh, '>', $file) || return;
# Use old, now broken link to the old cookie spec just in case something
# else (not us!) requires the comment block exactly this way.
- print FILE <<EOT;
+ print {$fh} <<EOT;
# Netscape HTTP Cookie File
# http://www.netscape.com/newsref/std/cookie_spec.html
# This is a generated file! Do not edit.
@@ -54,25 +53,30 @@ EOT
my $now = time - $HTTP::Cookies::EPOCH_OFFSET;
$self->scan(sub {
- my($version,$key,$val,$path,$domain,$port,
- $path_spec,$secure,$expires,$discard,$rest) = @_;
- return if $discard && !$self->{ignore_discard};
- $expires = $expires ? $expires - $HTTP::Cookies::EPOCH_OFFSET : 0;
- return if $now > $expires;
- $secure = $secure ? "TRUE" : "FALSE";
- my $bool = $domain =~ /^\./ ? "TRUE" : "FALSE";
- print FILE join("\t", $domain, $bool, $path, $secure, $expires, $key, $val), "\n";
+ my ($version, $key, $val, $path, $domain, $port, $path_spec, $secure, $expires, $discard, $rest) = @_;
+ return if $discard && !$self->{ignore_discard};
+ $expires = $expires ? $expires - $HTTP::Cookies::EPOCH_OFFSET : 0;
+ return if $now > $expires;
+ $secure = $secure ? "TRUE" : "FALSE";
+ my $bool = $domain =~ /^\./ ? "TRUE" : "FALSE";
+ print {$fh} join("\t", $domain, $bool, $path, $secure, $expires, $key, $val), "\n";
});
- close(FILE);
1;
}
1;
-__END__
+
+=pod
+
+=encoding UTF-8
=head1 NAME
-HTTP::Cookies::Netscape - access to Netscape cookies files
+HTTP::Cookies::Netscape - Access to Netscape cookies files
+
+=head1 VERSION
+
+version 6.03
=head1 SYNOPSIS
@@ -97,18 +101,27 @@ Please note that the Netscape/Mozilla cookie file format can't store
all the information available in the Set-Cookie2 headers, so you will
probably lose some information if you save in this format.
-At time of writing, this module seems to work fine with Mozilla
+At time of writing, this module seems to work fine with Mozilla
Phoenix/Firebird.
=head1 SEE ALSO
L<HTTP::Cookies::Microsoft>
-=head1 COPYRIGHT
+=head1 AUTHOR
+
+Gisle Aas <gisle@activestate.com>
+
+=head1 COPYRIGHT AND LICENSE
-Copyright 2002-2003 Gisle Aas
+This software is copyright (c) 2002-2017 by Gisle Aas.
-This library is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
=cut
+
+__END__
+
+#ABSTRACT: Access to Netscape cookies files
+