home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _e25755fec7b6dbd0427538ec4c69efd1 < prev    next >
Text File  |  2004-06-01  |  3KB  |  117 lines
  1. package HTTP::Cookies::Netscape;
  2.  
  3. use strict;
  4. use vars qw(@ISA $VERSION);
  5.  
  6. $VERSION = sprintf("%d.%02d", q$Revision: 1.26 $ =~ /(\d+)\.(\d+)/);
  7.  
  8. require HTTP::Cookies;
  9. @ISA=qw(HTTP::Cookies);
  10.  
  11. sub load
  12. {
  13.     my($self, $file) = @_;
  14.     $file ||= $self->{'file'} || return;
  15.     local(*FILE, $_);
  16.     local $/ = "\n";  # make sure we got standard record separator
  17.     my @cookies;
  18.     open(FILE, $file) || return;
  19.     my $magic = <FILE>;
  20.     unless ($magic =~ /^\#(?: Netscape)? HTTP Cookie File/) {
  21.     warn "$file does not look like a netscape cookies file" if $^W;
  22.     LWP::Debug::debug("$file doesn't look like a netscape cookies file. Skipping.");
  23.     close(FILE);
  24.     return;
  25.     }
  26.     LWP::Debug::debug("Okay, $file is a netscape cookies file.  Parsing.");
  27.     my $now = time() - $HTTP::Cookies::EPOCH_OFFSET;
  28.     while (<FILE>) {
  29.     next if /^\s*\#/;
  30.     next if /^\s*$/;
  31.     tr/\n\r//d;
  32.     my($domain,$bool1,$path,$secure, $expires,$key,$val) = split(/\t/, $_);
  33.     LWP::Debug::debug(join '', "-Reading NS cookie: ",
  34.       map(" <$_>", split(/\t/, $_)));
  35.     $secure = ($secure eq "TRUE");
  36.     $self->set_cookie(undef,$key,$val,$path,$domain,undef,
  37.               0,$secure,$expires-$now, 0);
  38.     }
  39.     close(FILE);
  40.     1;
  41. }
  42.  
  43. sub save
  44. {
  45.     my($self, $file) = @_;
  46.     $file ||= $self->{'file'} || return;
  47.     local(*FILE, $_);
  48.     open(FILE, ">$file") || return;
  49.  
  50.     print FILE <<EOT;
  51. # Netscape HTTP Cookie File
  52. # http://www.netscape.com/newsref/std/cookie_spec.html
  53. # This is a generated file!  Do not edit.
  54.  
  55. EOT
  56.  
  57.     my $now = time - $HTTP::Cookies::EPOCH_OFFSET;
  58.     $self->scan(sub {
  59.     my($version,$key,$val,$path,$domain,$port,
  60.        $path_spec,$secure,$expires,$discard,$rest) = @_;
  61.     return if $discard && !$self->{ignore_discard};
  62.     $expires = $expires ? $expires - $HTTP::Cookies::EPOCH_OFFSET : 0;
  63.     return if $now > $expires;
  64.     $secure = $secure ? "TRUE" : "FALSE";
  65.     my $bool = $domain =~ /^\./ ? "TRUE" : "FALSE";
  66.     print FILE join("\t", $domain, $bool, $path, $secure, $expires, $key, $val), "\n";
  67.     });
  68.     close(FILE);
  69.     1;
  70. }
  71.  
  72. 1;
  73. __END__
  74.  
  75. =head1 NAME
  76.  
  77. HTTP::Cookies::Netscape - access to Netscape cookies files
  78.  
  79. =head1 SYNOPSIS
  80.  
  81.  use LWP;
  82.  use HTTP::Cookies::Netscape;
  83.  $cookie_jar = HTTP::Cookies::Netscape->new(
  84.    file => "c:/program files/netscape/users/ZombieCharity/cookies.txt",
  85.  );
  86.  my $browser = LWP::UserAgent->new;
  87.  $browser->cookie_jar( $cookie_jar );
  88.  
  89. =head1 DESCRIPTION
  90.  
  91. This is a subclass of C<HTTP::Cookies> that reads (and optionally
  92. writes) Netscape/Mozilla cookie files.
  93.  
  94. See the documentation for L<HTTP::Cookies>.
  95.  
  96. =head1 CAVEATS
  97.  
  98. Please note that the Netscape/Mozilla cookie file format can't store
  99. all the information available in the Set-Cookie2 headers, so you will
  100. probably lose some information if you save in this format.
  101.  
  102. At time of writing, this module seems to work fine with Mozilla      
  103. Phoenix/Firebird.
  104.  
  105. =head1 SEE ALSO
  106.  
  107. L<HTTP::Cookies::Microsoft>
  108.  
  109. =head1 COPYRIGHT
  110.  
  111. Copyright 2002-2003 Gisle Aas
  112.  
  113. This library is free software; you can redistribute it and/or
  114. modify it under the same terms as Perl itself.
  115.  
  116. =cut
  117.