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

   1 package HTTP::Cookies::Netscape;
   2
   3 use strict;
   4 use vars qw(@ISA $VERSION);
   5
   6 $VERSION = "5.810";
   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