File Coverage

blib/lib/HTTP/Cookies/MozRepl.pm
Criterion Covered Total %
statement 15 39 38.4
branch 0 10 0.0
condition 0 10 0.0
subroutine 5 8 62.5
pod 3 3 100.0
total 23 70 32.8


line stmt bran cond sub pod time code
1             package HTTP::Cookies::MozRepl;
2 80     80   584 use strict;
  80         183  
  80         2723  
3 80     80   40258 use HTTP::Date qw(time2str);
  80         355182  
  80         5111  
4 80     80   678 use MozRepl::RemoteObject 'as_list';
  80         196  
  80         3618  
5 80     80   526 use parent 'HTTP::Cookies';
  80         189  
  80         329  
6 80     80   591446 use Carp qw[croak];
  80         1031  
  80         33197  
7              
8             our $VERSION = '0.80';
9              
10             =head1 NAME
11              
12             HTTP::Cookies::MozRepl - retrieve cookies from a live Firefox instance
13              
14             =head1 SYNOPSIS
15              
16             use HTTP::Cookies::MozRepl;
17             my $cookie_jar = HTTP::Cookies::MozRepl->new();
18             # use just like HTTP::Cookies
19              
20             =head1 DESCRIPTION
21              
22             This package overrides the load() and save() methods of HTTP::Cookies
23             so it can work with a live Firefox instance.
24              
25             Note: To use this module, Firefox must be running and it must
26             have the C extension installed.
27              
28             See L.
29              
30             =head1 Reusing an existing connection
31              
32             If you already have an existing connection to Firefox
33             that you want to reuse, just pass the L
34             instance to the cookie jar constructor in the C parameter:
35              
36             my $cookie_jar = HTTP::Cookies::MozRepl->new(
37             repl => $repl
38             );
39              
40             =cut
41              
42             sub load {
43 0     0 1   my ($self,$repl) = @_;
44 0   0       $repl ||= $self->{'file'} || $self->{'repl'} || return;
      0        
45            
46             # Get cookie manager
47 0           my $cookie_manager = $repl->expr(<<'JS');
48             Components.classes["@mozilla.org/cookiemanager;1"]
49             .getService(Components.interfaces.nsICookieManager)
50             JS
51              
52 0           my $nsICookie = $repl->expr(<<'JS');
53             Components.interfaces.nsICookie
54             JS
55              
56 0           my $nsICookieManager = $repl->expr(<<'JS');
57             Components.interfaces.nsICookieManager
58             JS
59 0           $cookie_manager = $cookie_manager->QueryInterface($nsICookieManager);
60            
61 0           my $e = $cookie_manager->{enumerator};
62 0           my $fetch_cookies = $e->bridge->declare(<<'JS', 'list');
63             function(e,nsiCookie) {
64             var r=[];
65             while (e.hasMoreElements()) {
66             var cookie = e.getNext().QueryInterface(nsiCookie);
67             r.push([1,cookie.name,cookie.value,cookie.path,cookie.host,null,null,cookie.isSecure,cookie.expires]);
68             };
69             return r
70             };
71             JS
72             # This could be even more efficient by fetching the whole result
73             # as one huge data structure
74 0           for my $c ($fetch_cookies->($e,$nsICookie)) {
75 0           my @v = as_list $c;
76 0 0         if( $v[8] > 0) {
    0          
77 0           $v[8] -= time;
78             } elsif( $v[8] == 0 ) {
79             # session cookie, we never let it expire within HTTP::Cookie
80 0           $v[8] += 3600; # well, "never"
81             };
82 0           $self->SUPER::set_cookie(@v);
83             };
84              
85             # This code is pure Perl, but involves far too many roundtrips :-(
86             #$e->bridge->queued(sub{
87             # while ($e->hasMoreElements) {
88             # my $cookie = $e->getNext()->QueryInterface($nsICookie);
89             #
90             # my @values = map { $cookie->{$_} } (qw(name value path host isSecure expires));
91             # $self->set_cookie( undef, @values[0, 1, 2, 3, ], undef, undef, $values[ 4 ], time-$values[5], 0 );
92             # };
93             #});
94             }
95              
96             sub set_cookie {
97 0     0 1   my ($self, $version, $key, $val, $path, $domain, $port, $path_spec, $secure, $maxage, $discard, $rest ) = @_;
98 0   0       $rest ||= {};
99 0   0       my $repl = $rest->{repl} || $self->{repl};
100            
101 0           my $uri = URI->new("http://$domain",'http');
102             #$uri->protocol('http'); # ???
103 0           $uri->host($domain);
104 0 0         $uri->path($path) if $path;
105 0 0         $uri->port($port) if $port;
106            
107 0           my $set = $repl->declare(<<'JS');
108             function (host,path,name,value,secure,httponly,session,expiry) {
109             var cookieMgr = Components.classes["@mozilla.org/cookiemanager;1"].getService(Components.interfaces.nsICookieManager2);
110              
111             cookieMgr.add(host,path,name,value,secure,httponly,session,expiry);
112             };
113             JS
114 0 0         $set->($uri->host, $uri->path, $key, $val, 0, 0, 0, $maxage ? time+$maxage : 0);
115             };
116              
117             sub save {
118 0     0 1   croak 'save is not yet implemented'
119             }
120              
121             1;
122              
123             __END__