File Coverage

blib/lib/POE/Component/WebService/Validator/HTML/W3C.pm
Criterion Covered Total %
statement 44 128 34.3
branch 10 56 17.8
condition n/a
subroutine 11 18 61.1
pod 3 4 75.0
total 68 206 33.0


line stmt bran cond sub pod time code
1             package POE::Component::WebService::Validator::HTML::W3C;
2              
3 6     6   1252145 use warnings;
  6         16  
  6         225  
4 6     6   35 use strict;
  6         11  
  6         323  
5              
6             our $VERSION = '1.001004'; # VERSION
7              
8 6     6   5150 use WebService::Validator::HTML::W3C;
  6         368573  
  6         77  
9 6     6   245 use POE (qw( Wheel::Run Filter::Reference Filter::Line));
  6         13  
  6         86  
10 6     6   161145 use Carp;
  6         12  
  6         10514  
11              
12             sub spawn {
13 1     1 0 18 my $package = shift;
14              
15 1 50       7 croak "Even number of arguments must be passed to $package"
16             if @_ & 1;
17              
18 1         5 my %params = @_;
19              
20 1         8 $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         5 my $self = bless \%params, $package;
26              
27 1 50       21 $self->{session_id} = POE::Session->create(
28             object_states => [
29             $self => {
30             validate => '_validate',
31             shutdown => '_shutdown',
32             },
33             $self => [
34             qw(
35             _child_error
36             _child_close
37             _child_stderr
38             _child_stdout
39             _sig_chld
40             _start
41             )
42             ],
43             ],
44             ( exists $params{options} ? ( options => $params{options} ) : () ),
45             )->ID;
46              
47 1         771 return $self;
48             }
49              
50             sub _start {
51 1     1   335 my ( $kernel, $self ) = @_[ KERNEL, OBJECT ];
52 1         6 $self->{session_id} = $_[SESSION]->ID();
53              
54 1 50       8 if ( $self->{alias} ) {
55 0         0 $kernel->alias_set( $self->{alias} );
56             }
57             else {
58 1         7 $kernel->refcount_increment( $self->{session_id} => __PACKAGE__ );
59             }
60              
61 1 50       49 $self->{wheel} = POE::Wheel::Run->new(
62             Program => \&_validate_wheel,
63             ErrorEvent => '_child_error',
64             CloseEvent => '_child_close',
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       6264 $kernel->call('shutdown')
73             unless $self->{wheel};
74              
75 1         35 $kernel->sig_child( $self->{wheel}->PID, '_sig_chld' );
76             }
77              
78             sub _sig_chld {
79 1     1   807 $poe_kernel->sig_handled;
80             }
81              
82             sub _child_close {
83 0     0   0 my ( $kernel, $self, $wheel_id ) = @_[ KERNEL, OBJECT, ARG0 ];
84              
85 0 0       0 warn "_child_close called (@_[ARG0..$#_])\n"
86             if $self->{debug};
87              
88 0         0 delete $self->{wheel};
89 0 0       0 $kernel->yield('shutdown')
90             unless $self->{shutdown};
91              
92 0         0 undef;
93             }
94              
95             sub _child_error {
96 1     1   2289525 my ( $kernel, $self ) = @_[ KERNEL, OBJECT ];
97 1 50       157 warn "_child_error called (@_[ARG0..$#_])\n"
98             if $self->{debug};
99              
100 1         16 delete $self->{wheel};
101 1 50       351 $kernel->yield('shutdown')
102             unless $self->{shutdown};
103              
104 1         4 undef;
105             }
106              
107             sub _child_stderr {
108 0     0   0 my ( $kernel, $self ) = @_[ KERNEL, OBJECT ];
109 0 0       0 warn "_child_stderr: $_[ARG0]\n"
110             if $self->{debug};
111              
112 0         0 undef;
113             }
114              
115             sub _child_stdout {
116 0     0   0 my ( $kernel, $self, $input ) = @_[ KERNEL, OBJECT, ARG0 ];
117              
118 0         0 my $session = delete $input->{sender};
119 0         0 my $event = delete $input->{event};
120 0         0 $kernel->post( $session, $event, $input );
121 0         0 $kernel->refcount_decrement( $session => __PACKAGE__ );
122              
123 0         0 undef;
124             }
125              
126             sub shutdown {
127 1     1 1 2471 my $self = shift;
128 1         21 $poe_kernel->post( $self->{session_id} => 'shutdown' );
129             }
130              
131             sub _shutdown {
132 1     1   2815 my ( $kernel, $self ) = @_[ KERNEL, OBJECT ];
133 1         29 $kernel->alarm_remove_all;
134 1         85 $kernel->alias_remove( $_ ) for $kernel->alias_list;
135 1 50       54 $kernel->refcount_decrement( $self->{session_id} => __PACKAGE__ )
136             unless $self->{alias};
137              
138 1         54 $self->{shutdown} = 1;
139 1 50       23 $self->{wheel}->shutdown_stdin
140             if $self->{wheel};
141             }
142              
143             sub session_id {
144 0     0 1   return $_[0]->{session_id};
145             }
146              
147             sub validate {
148 0     0 1   my $self = shift;
149 0           $poe_kernel->post( $self->{session_id} => 'validate' => @_ );
150             }
151              
152             sub _validate {
153 0     0     my ( $kernel, $self ) = @_[KERNEL, OBJECT];
154              
155 0           my $sender = $_[SENDER]->ID;
156              
157             return
158 0 0         if $self->{shutdown};
159              
160 0           my $args;
161 0 0         if ( ref $_[ARG0] eq 'HASH' ) {
162 0           $args = { %{ $_[ARG0] } };
  0            
163             }
164             else {
165 0           warn "Argument must be a hashref, trying to adjust";
166 0           $args = { @_[ARG0 .. $#_] };
167             }
168              
169 0           $args->{ lc $_ } = delete $args->{ $_ }
170 0           for grep { !/^_/ } keys %{ $args };
  0            
171              
172 0 0         unless ( $args->{event} ) {
173 0           warn "No `event` parameter specified. Aborting...";
174 0           return;
175             }
176              
177 0 0         unless ( $args->{in} ) {
178 0           warn "No `in` parameter specified. Aborting...";
179 0           return;
180             }
181              
182 0 0         unless ( exists $args->{options}{detailed} ) {
183 0           $args->{options}{detailed} = 1;
184             }
185              
186 0 0         if ( $args->{type} ) {
187 0           $args->{type} = lc $args->{type};
188             }
189             else {
190 0           $args->{type} = 'uri';
191             }
192              
193 0 0         if ( $args->{session} ) {
194 0 0         if ( my $ref = $kernel->alias_resolve( $args->{session} ) ) {
195 0           $args->{sender} = $ref->ID;
196             }
197             else {
198 0           warn "Could not resolve `session` parameter to a "
199             . "valid POE session. Aborting...";
200 0           return;
201             }
202             }
203             else {
204 0           $args->{sender} = $sender;
205             }
206 0           $kernel->refcount_increment( $args->{sender} => __PACKAGE__ );
207 0           $self->{wheel}->put( $args );
208              
209 0           undef;
210             }
211              
212             sub _validate_wheel {
213 0 0   0     if ( $^O eq 'MSWin32' ) {
214 0           binmode STDIN;
215 0           binmode STDOUT;
216             }
217              
218 0           my $raw;
219 0           my $size = 4096;
220 0           my $filter = POE::Filter::Reference->new;
221              
222 0           while ( sysread STDIN, $raw, $size ) {
223 0           my $requests = $filter->get( [ $raw ] );
224 0           foreach my $req ( @$requests ) {
225              
226 0           my $val
227 0           = WebService::Validator::HTML::W3C->new( %{ $req->{options} } );
228              
229 0           my $val_success = 0;
230 0 0         if ( $req->{type} eq 'file' ) {
    0          
231 0           $val_success = $val->validate_file( $req->{in} );
232             }
233             elsif ( $req->{type} eq 'markup' ) {
234 0           $val_success = $val->validate_markup( $req->{in} );
235             }
236             else {
237 0           $val_success = $val->validate( $req->{in} );
238             }
239              
240 0 0         if ( $val_success ) {
241              
242 0           @{ $req }{
243 0           qw(
244             is_valid
245             num_errors
246             )
247             }
248             = (
249             $val->is_valid,
250             $val->num_errors,
251             );
252              
253 0           $req->{errors} = undef;
254 0 0         foreach my $error ( @{ $val->errors || [] } ) {
  0            
255 0           push @{ $req->{errors} }, {
  0            
256             line => $error->line,
257             col => $error->col,
258             msg => $error->msg,
259             };
260             }
261 0 0         if ( $req->{get_warnings} ) {
262 0           $req->{'warnings'} = undef;
263 0 0         foreach my $warning ( @{ $val->warnings || [] } ) {
  0            
264 0           push @{ $req->{'warnings'} }, {
  0            
265             line => $warning->line,
266             col => $warning->col,
267             msg => $warning->msg,
268             }
269             }
270             }
271              
272             }
273             else {
274 0           $req->{validator_error} = $val->validator_error;
275             }
276 0           $req->{validator_uri} = $val->validator_uri;
277              
278 0           my $response = $filter->put( [ $req ] );
279 0           print STDOUT @$response;
280             }
281             }
282             }
283              
284             1;
285             __END__