File Coverage

blib/lib/POE/Component/WWW/Google/Calculator.pm
Criterion Covered Total %
statement 72 105 68.5
branch 17 42 40.4
condition n/a
subroutine 14 18 77.7
pod 3 4 75.0
total 106 169 62.7


line stmt bran cond sub pod time code
1             package POE::Component::WWW::Google::Calculator;
2              
3 1     1   413678 use strict;
  1         2  
  1         35  
4 1     1   6 use warnings;
  1         1  
  1         50  
5              
6             our $VERSION = '0.03';
7              
8 1     1   6 use POE qw( Filter::Reference Filter::Line Wheel::Run );
  1         6  
  1         9  
9 1     1   657 use WWW::Google::Calculator;
  1         2  
  1         6  
10 1     1   30 use Carp;
  1         2  
  1         7392  
11             sub spawn {
12 1     1 0 339 my $package = shift;
13 1 50       5 croak "$package requires an even number of arguments"
14             if @_ & 1;
15              
16 1         5 my %params = @_;
17              
18 1         10 $params{ lc $_ } = delete $params{ $_ } for keys %params;
19              
20 1 50       5 delete $params{options}
21             unless ref $params{options} eq 'HASH';
22              
23 1         4 my $self = bless \%params, $package;
24              
25 1 50       20 $self->{session_id} = POE::Session->create(
26             object_states => [
27             $self => {
28             calc => '_calc',
29             shutdown => '_shutdown',
30             },
31             $self => [
32             qw(
33             _child_error
34             _child_closed
35             _child_stdout
36             _child_stderr
37             _sig_child
38             _start
39             )
40             ]
41             ],
42             ( defined $params{options} ? ( options => $params{options} ) : () ),
43             )->ID();
44              
45 1         346 return $self;
46             }
47              
48             sub _start {
49 1     1   311 my ( $kernel, $self ) = @_[ KERNEL, OBJECT ];
50 1         6 $self->{session_id} = $_[SESSION]->ID();
51 1 50       8 if ( $self->{alias} ) {
52 1         7 $kernel->alias_set( $self->{alias} );
53             }
54             else {
55 0         0 $kernel->refcount_increment( $self->{session_id} => __PACKAGE__ );
56             }
57              
58 1 50       53 $self->{wheel} = POE::Wheel::Run->new(
59             Program => \&_calc_wheel,
60             ErrorEvent => '_child_error',
61             CloseEvent => '_child_close',
62             StdoutEvent => '_child_stdout',
63             StderrEvent => '_child_stderr',
64             StdioFilter => POE::Filter::Reference->new,
65             StderrFilter => POE::Filter::Line->new,
66             ( $^O eq 'MSWin32' ? ( CloseOnCall => 0 ) : ( CloseOnCall => 1 ) )
67             );
68              
69 1 50       6002 $kernel->yield('shutdown')
70             unless $self->{wheel};
71              
72 1         45 $kernel->sig_child( $self->{wheel}->PID(), '_sig_child' );
73              
74 1         389 undef;
75             }
76              
77             sub _sig_child {
78 1     1   7589 $poe_kernel->sig_handled;
79             }
80              
81             sub session_id {
82 0     0 1 0 return $_[0]->{session_id};
83             }
84              
85             sub calc {
86 2     2 1 2629 my $self = shift;
87 2         23 $poe_kernel->post( $self->{session_id} => 'calc' => @_ );
88             }
89              
90             sub _calc {
91 3     3   1009 my ( $kernel, $self ) = @_[ KERNEL, OBJECT ];
92 3         21 my $sender = $_[SENDER]->ID;
93              
94             return
95 3 50       28 if $self->{shutdown};
96              
97 3         9 my $args;
98 3 50       15 if ( ref $_[ARG0] eq 'HASH' ) {
99 3         3 $args = { %{ $_[ARG0] } };
  3         17  
100             }
101             else {
102 0         0 warn "First parameter must be a hashref, trying to adjust...";
103 0         0 $args = { @_[ARG0 .. $#_] };
104             }
105              
106 10         61 $args->{ lc $_ } = delete $args->{ $_ }
107 3         6 for grep { !/^_/ } keys %{ $args };
  3         11  
108              
109 3 50       19 unless ( $args->{event} ) {
110 0         0 warn "Missing 'event' parameter to calc";
111 0         0 return;
112             }
113              
114 3 50       7 unless ( $args->{term} ) {
115 0         0 warn "No 'term' parameter specified";
116 0         0 return;
117             }
118              
119 3 100       15 if ( $args->{session} ) {
120 1 50       12 if ( my $ref = $kernel->alias_resolve( $args->{session} ) ) {
121 1         40 $args->{sender} = $ref->ID;
122             }
123             else {
124 0         0 warn "Could not resolve 'session' parameter to a valid"
125             . " POE session";
126 0         0 return;
127             }
128             }
129             else {
130 2         18 $args->{sender} = $sender;
131             }
132              
133 3         15 $kernel->refcount_increment( $args->{sender} => __PACKAGE__ );
134 3         95 $self->{wheel}->put( $args );
135              
136 3         526 undef;
137             }
138              
139             sub shutdown {
140 1     1 1 1255 my $self = shift;
141 1         8 $poe_kernel->call( $self->{session_id} => 'shutdown' => @_ );
142             }
143              
144             sub _shutdown {
145 1     1   89 my ( $kernel, $self ) = @_[ KERNEL, OBJECT ];
146 1         19 $kernel->alarm_remove_all;
147 1         107 $kernel->alias_remove( $_ ) for $kernel->alias_list;
148 1 50       105 $kernel->refcount_decrement( $self->{session_id} => __PACKAGE__ )
149             unless $self->{alias};
150              
151 1         5 $self->{shutdown} = 1;
152              
153 1 50       41 $self->{wheel}->shutdown_stdin
154             if $self->{wheel};
155             }
156              
157             sub _child_closed {
158 0     0   0 my ( $kernel, $self ) = @_[ KERNEL, OBJECT ];
159              
160 0 0       0 warn "_child_closed called (@_[ARG0..$#_])\n"
161             if $self->{debug};
162              
163 0         0 delete $self->{wheel};
164 0 0       0 $kernel->yield('shutdown')
165             unless $self->{shutdown};
166              
167 0         0 undef;
168             }
169              
170             sub _child_error {
171 1     1   1463 my ( $kernel, $self ) = @_[ KERNEL, OBJECT ];
172 1 50       58 warn "_child_error called (@_[ARG0..$#_])\n"
173             if $self->{debug};
174              
175 1         65 delete $self->{wheel};
176 1 50       592 $kernel->yield('shutdown')
177             unless $self->{shutdown};
178              
179 1         6 undef;
180             }
181              
182             sub _child_stderr {
183 0     0   0 my ( $kernel, $self ) = @_[ KERNEL, OBJECT ];
184 0 0       0 warn "_child_stderr: $_[ARG0]\n"
185             if $self->{debug};
186              
187 0         0 undef;
188             }
189              
190             sub _child_stdout {
191 3     3   4252826 my ( $kernel, $self, $input ) = @_[ KERNEL, OBJECT, ARG0 ];
192              
193 3         16 my $session = delete $input->{sender};
194 3         8 my $event = delete $input->{event};
195              
196 3         26 $kernel->post( $session, $event, $input );
197 3         434 $kernel->refcount_decrement( $session => __PACKAGE__ );
198              
199 3         140 undef;
200             }
201              
202             sub _calc_wheel {
203 0 0   0     if ( $^O eq 'MSWin32' ) {
204 0           binmode STDIN;
205 0           binmode STDOUT;
206             }
207              
208 0           my $raw;
209 0           my $size = 4096;
210 0           my $filter = POE::Filter::Reference->new;
211              
212 0           my $calculator = WWW::Google::Calculator->new;
213              
214 0           while ( sysread STDIN, $raw, $size ) {
215 0           my $requests = $filter->get( [ $raw ] );
216 0           foreach my $req ( @$requests ) {
217 0           $req->{out} = $calculator->calc( $req->{term} );
218 0 0         unless ( defined $req->{out} ) {
219 0           $req->{error} = $calculator->error;
220             }
221              
222 0           my $response = $filter->put( [ $req ] );
223 0           print STDOUT @$response;
224             }
225             }
226             }
227              
228             1;
229             __END__