File Coverage

blib/lib/POE/Component/WWW/Google/PageRank.pm
Criterion Covered Total %
statement 74 112 66.0
branch 18 48 37.5
condition n/a
subroutine 14 18 77.7
pod 3 4 75.0
total 109 182 59.8


line stmt bran cond sub pod time code
1             package POE::Component::WWW::Google::PageRank;
2              
3 1     1   293507 use strict;
  1         1  
  1         27  
4 1     1   4 use warnings;
  1         2  
  1         44  
5              
6             our $VERSION = '1.001004'; # VERSION
7              
8 1     1   4 use POE (qw( Wheel::Run Filter::Reference Filter::Line ));
  1         1  
  1         7  
9 1     1   473 use Carp;
  1         2  
  1         43  
10 1     1   10 use WWW::Google::PageRank;
  1         2  
  1         1279  
11              
12             sub spawn {
13 1     1 0 345 my $package = shift;
14              
15 1 50       6 croak "$package requires an even number of arguments"
16             if @_ & 1;
17              
18 1         5 my %params = @_;
19              
20 1         10 $params{ lc $_ } = delete $params{ $_ } for keys %params;
21              
22 1 50       6 delete $params{options}
23             unless ref $params{options} eq 'HASH';
24              
25 1         4 my $self = bless \%params, $package;
26              
27 1 50       22 $self->{session_id} = POE::Session->create(
28             object_states => [
29             $self => {
30             rank => '_rank',
31             shutdown => '_shutdown',
32             },
33             $self => [
34             qw(
35             _start
36             _child_error
37             _child_closed
38             _child_stderr
39             _child_stdout
40             _sig_chld
41             )
42             ],
43             ],
44             ( defined $params{options} ? ( options => $params{options} ) : () )
45             )->ID;
46              
47 1         415 return $self;
48             }
49              
50             sub _start {
51 1     1   326 my ( $kernel, $self ) = @_[ KERNEL, OBJECT ];
52 1         6 $self->{session_id} = $_[SESSION]->ID();
53              
54 1 50       8 if ( $self->{alias} ) {
55 1         7 $kernel->alias_set( $self->{alias} );
56             }
57             else {
58 0         0 $kernel->refcount_increment( $self->{session_id} => __PACKAGE__ );
59             }
60              
61 1 50       49 $self->{wheel} = POE::Wheel::Run->new(
62             Program => \&_rank_wheel,
63             ErrorEvent => '_child_error',
64             CloseEvent => '_child_closed',
65             StderrEvent => '_child_stderr',
66             StdoutEvent => '_child_stdout',
67             StdioFilter => POE::Filter::Reference->new,
68             StderrFilter => POE::Filter::Line->new,
69             ( $^O eq 'MSWin32' ? ( CloseOnCall => 0 ) : ( CloseOnCall => 1 ) ),
70             );
71              
72 1 50       7217 $kernel->yield('shutdown')
73             unless $self->{wheel};
74              
75 1         35 $kernel->sig_child( $self->{wheel}->PID, '_sig_chld' );
76              
77 1         507 undef;
78             }
79              
80             sub _sig_chld {
81 1     1   9705 $poe_kernel->sig_handled;
82             }
83              
84             sub session_id {
85 0     0 1 0 return $_[0]->{session_id};
86             }
87              
88             sub rank {
89 2     2 1 2562 my $self = shift;
90 2         13 $poe_kernel->post( $self->{session_id} => 'rank' => @_ );
91             }
92              
93             sub _rank {
94 3     3   1383 my ( $kernel, $self ) = @_[ KERNEL, OBJECT ];
95 3         30 my $sender = $_[SENDER]->ID;
96              
97             return
98 3 50       23 if $self->{shutdown};
99              
100 3         5 my $args;
101              
102 3 50       12 if ( ref $_[ARG0] eq 'HASH' ) {
103 3         4 $args = { %{ $_[ARG0] } };
  3         18  
104             }
105             else {
106 0         0 warn "First parameter must be a hashref... trying to adjust";
107 0         0 $args = { @_[ARG0 .. $#_] };
108             }
109              
110 10         65 $args->{ lc $_ } = delete $args->{ $_ }
111 3         7 for grep { !/^_/ } keys %{ $args };
  3         10  
112              
113 3 50       11 unless ( $args->{event} ) {
114 0         0 warn "No `event` parameter was specified";
115 0         0 return;
116             }
117              
118 3 50       11 unless ( $args->{page} ) {
119 0         0 warn "No `page` parameter was specified";
120 0         0 return;
121             }
122              
123             # not sure if this is mandatory but WWW::Google:PageRank rejects URIs
124             # not matching this regex, so we'll fix it up and hope it won't
125             # eat us
126 3 50       24 unless ( $args->{page} =~ m#^https?://#i ) {
127 0 0       0 warn "Parameter `page` does not match m#^https?://#i"
128             if $self->{debug};
129              
130 0         0 $args->{page} = "http://$args->{page}";
131             }
132              
133 3 100       20 if ( $args->{session} ) {
134 1 50       15 if ( my $ref = $kernel->alias_resolve( $args->{session} ) ) {
135 1         34 $args->{sender} = $ref->ID;
136             }
137             else {
138 0         0 warn "Parameter `session` did not resolve to an active POE"
139             . " session, aborting";
140 0         0 return;
141             }
142             }
143             else {
144 2         8 $args->{sender} = $sender;
145             }
146              
147 3         28 $kernel->refcount_increment( $args->{sender} => __PACKAGE__ );
148 3         142 $self->{wheel}->put( $args );
149              
150 3         705 undef;
151             }
152              
153             sub shutdown {
154 1     1 1 2391 my $self = shift;
155 1         10 $poe_kernel->post( $self->{session_id} => 'shutdown' => @_ );
156             }
157              
158             sub _shutdown {
159 1     1   314 my ( $kernel, $self ) = @_[ KERNEL, OBJECT ];
160 1         8 $kernel->alarm_remove_all;
161 1         86 $kernel->alias_remove( $_ ) for $kernel->alias_list;
162 1 50       83 $kernel->refcount_decrement( $self->{session_id} => __PACKAGE__ )
163             unless $self->{alias};
164              
165 1         4 $self->{shutdown} = 1;
166 1 50       18 $self->{wheel}->shutdown_stdin
167             if $self->{wheel};
168              
169 1         6122 undef;
170             }
171             sub _child_closed {
172 0     0   0 my ( $kernel, $self ) = @_[ KERNEL, OBJECT ];
173              
174 0 0       0 warn "Got _child_closed() (@_[ARG0..$#_])"
175             if $self->{debug};
176              
177 0         0 delete $self->{wheel};
178 0 0       0 $kernel->yield('shutdown')
179             unless $self->{shutdown};
180              
181 0         0 undef;
182             }
183              
184             sub _child_error {
185 1     1   379 my ( $kernel, $self ) = @_[ KERNEL, OBJECT ];
186              
187 1 50       8 warn "Got _child_error() (@_[ARG0..$#_])"
188             if $self->{debug};
189              
190 1         11 delete $self->{wheel};
191 1 50       400 $kernel->yield('shutdown')
192             unless $self->{shutdown};
193              
194 1         4 undef;
195             }
196              
197             sub _child_stderr {
198 0     0   0 my ( $kernel, $self, $input ) = @_[ KERNEL, OBJECT, ARG0 ];
199 0 0       0 warn "Got _child_stderr: $input\n"
200             if $self->{debug};
201              
202 0         0 undef;
203             }
204              
205             sub _child_stdout {
206 3     3   2870531 my ( $kernel, $self, $input ) = @_[ KERNEL, OBJECT, ARG0 ];
207              
208 3         2863 my $session = delete $input->{sender};
209 3         14 my $event = delete $input->{event};
210              
211 3         70 $kernel->post( $session => $event => $input );
212 3         580 $kernel->refcount_decrement( $session => __PACKAGE__ );
213              
214 3         162 undef;
215             }
216              
217             sub _rank_wheel {
218 0 0   0     if ( $^O eq 'MSWin32' ) {
219 0           binmode STDIN;
220 0           binmode STDOUT;
221             }
222              
223 0           my $raw;
224 0           my $size = 4096;
225 0           my $filter = POE::Filter::Reference->new;
226              
227 0           while ( sysread STDIN, $raw, $size ) {
228 0           my $requests = $filter->get( [ $raw ] );
229 0           foreach my $req ( @$requests ) {
230 0 0         my $page_rank
231 0           = WWW::Google::PageRank->new( %{ $req->{options} || {} } );
232              
233 0           @{ $req }{ qw(rank response) }
  0            
234             = $page_rank->get( $req->{page} );
235              
236 0 0         unless ( $req->{response}->is_success ) {
237 0           @{ $req }{ qw(rank error) }
  0            
238             = ( undef, $req->{response}->status_line );
239             }
240              
241 0           my $response = $filter->put( [ $req ] );
242 0           print STDOUT @$response;
243             }
244             }
245             }
246              
247             1;
248             __END__