File Coverage

blib/lib/POE/Component/NonBlockingWrapper/Base.pm
Criterion Covered Total %
statement 12 101 11.8
branch 0 40 0.0
condition n/a
subroutine 4 21 19.0
pod 0 3 0.0
total 16 165 9.7


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