File Coverage

blib/lib/POE/Component/WWW/Shorten.pm
Criterion Covered Total %
statement 24 110 21.8
branch 3 40 7.5
condition 1 2 50.0
subroutine 6 19 31.5
pod 4 4 100.0
total 38 175 21.7


line stmt bran cond sub pod time code
1             package POE::Component::WWW::Shorten;
2              
3 2     2   30788 use strict;
  2         6  
  2         80  
4 2     2   11 use warnings;
  2         2  
  2         84  
5 2     2   918 use POE 0.38 qw(Wheel::Run Filter::Line Filter::Reference);
  2         126067  
  2         16  
6 2     2   575590 use vars qw($VERSION);
  2         5  
  2         86  
7 2     2   13 use Carp;
  2         4  
  2         4893  
8              
9             $VERSION = '1.20';
10              
11             sub spawn {
12 1     1 1 803 my $package = shift;
13 1 50       7 croak "$package requires an even number of parameters" if @_ & 1;
14 1         3 my %parms = @_;
15              
16 1         7 $parms{ lc $_ } = delete $parms{$_} for keys %parms;
17              
18 1 50       5 delete $parms{'options'} unless ref ( $parms{'options'} ) eq 'HASH';
19 1   50     12 my $type = delete $parms{'type'} || 'Metamark';
20              
21 1         2 eval {
22 1         40309 require WWW::Shorten;
23 0         0 import WWW::Shorten $type;
24             };
25 1 50       522 die "Problem loading WWW::Shorten \'$type\', please check\n" if $@;
26              
27 0           my $self = bless \%parms, $package;
28              
29 0 0         $self->{session_id} = POE::Session->create(
30             object_states => [
31             $self => { shorten => '_shorten',
32             shutdown => '_shutdown',
33             },
34             $self => [ qw(_child_error _child_closed _child_stdout _child_stderr _sig_chld _start _stop) ],
35             ],
36             ( defined ( $parms{'options'} ) ? ( options => $parms{'options'} ) : () ),
37             )->ID();
38              
39 0           return $self;
40             }
41              
42             sub _start {
43 0     0     my ($kernel,$self) = @_[KERNEL,OBJECT];
44 0           $self->{session_id} = $_[SESSION]->ID();
45              
46 0 0         if ( $self->{alias} ) {
47 0           $kernel->alias_set( $self->{alias} );
48             }
49             else {
50 0           $kernel->refcount_increment( $self->{session_id} => __PACKAGE__ );
51             }
52              
53 0 0         $self->{wheel} = POE::Wheel::Run->new(
54             Program => \&_shorten_wheel,
55             ErrorEvent => '_child_error',
56             CloseEvent => '_child_closed',
57             StdoutEvent => '_child_stdout',
58             StderrEvent => '_child_stderr',
59             StdioFilter => POE::Filter::Reference->new(),
60             StderrFilter => POE::Filter::Line->new(),
61             ( $^O eq 'MSWin32' ? ( CloseOnCall => 0 ) : ( CloseOnCall => 1 ) ),
62             );
63              
64 0 0         $kernel->yield( 'shutdown' ) unless $self->{wheel};
65 0           $kernel->sig_child( $self->{wheel}->PID, '_sig_chld' );
66 0           undef;
67             }
68              
69             sub _stop {
70 0     0     return;
71             }
72              
73             sub _sig_chld {
74 0     0     $poe_kernel->sig_handled();
75             }
76              
77             sub session_id {
78 0     0 1   return $_[0]->{session_id};
79             }
80              
81             sub shorten {
82 0     0 1   my $self = shift;
83 0           $poe_kernel->post( $self->{session_id} => 'shorten' => @_ );
84             }
85              
86             sub _shorten {
87 0     0     my ($kernel,$self) = @_[KERNEL,OBJECT];
88 0           my $sender = $_[SENDER]->ID();
89              
90 0 0         return if $self->{shutdown};
91 0           my $args;
92 0 0         if ( ref( $_[ARG0] ) eq 'HASH' ) {
93 0           $args = { %{ $_[ARG0] } };
  0            
94             } else {
95 0           warn "first parameter must be a hashref, trying to adjust. "
96             ."(fix this to get rid of this message)";
97 0           $args = { @_[ARG0..$#_] };
98             }
99              
100 0           $args->{lc $_} = delete $args->{$_} for grep { $_ !~ /^_/ } keys %{ $args };
  0            
  0            
101              
102 0 0         unless ( $args->{event} ) {
103 0           warn "where am i supposed to send the output?";
104 0           return;
105             }
106              
107 0 0         unless ( $args->{url} ) {
108 0           warn "No 'url' specified";
109 0           return;
110             }
111              
112 0 0         if ( $args->{session} ) {
113 0 0         if ( my $ref = $kernel->alias_resolve( $args->{session} ) ) {
114 0           $args->{sender} = $ref->ID();
115             }
116             else {
117 0           warn "Could not resolve 'session' to a valid POE session\n";
118 0           return;
119             }
120             }
121             else {
122 0           $args->{sender} = $sender;
123             }
124            
125 0 0         $args->{params} = $self->{params} ? $self->{params} : [];
126              
127 0           $kernel->refcount_increment( $args->{sender} => __PACKAGE__ );
128 0           $self->{wheel}->put( $args );
129 0           undef;
130             }
131              
132             sub shutdown {
133 0     0 1   my $self = shift;
134 0           $poe_kernel->call( $self->{session_id} => 'shutdown' => @_ );
135             }
136              
137             sub _shutdown {
138 0     0     my ($kernel,$self) = @_[KERNEL,OBJECT];
139 0           $kernel->alarm_remove_all();
140 0           $kernel->alias_remove( $_ ) for $kernel->alias_list();
141 0 0         $kernel->refcount_decrement( $self->{session_id} => __PACKAGE__ ) unless $self->{alias};
142 0           $self->{shutdown} = 1;
143 0 0         $self->{wheel}->shutdown_stdin if $self->{wheel};
144 0           undef;
145             }
146              
147             sub _child_closed {
148 0     0     my ($kernel,$self) = @_[KERNEL,OBJECT];
149 0           delete $self->{wheel};
150 0 0         $kernel->yield( 'shutdown' ) unless $self->{shutdown};
151 0           undef;
152             }
153              
154             sub _child_error {
155 0     0     my ($kernel,$self) = @_[KERNEL,OBJECT];
156 0           delete $self->{wheel};
157 0 0         $kernel->yield( 'shutdown' ) unless $self->{shutdown};
158 0           undef;
159             }
160              
161             sub _child_stderr {
162 0     0     my ($kernel,$self,$input) = @_[KERNEL,OBJECT,ARG0];
163 0 0         warn "$input\n" if $self->{debug};
164 0           undef;
165             }
166              
167             sub _child_stdout {
168 0     0     my ($kernel,$self,$input) = @_[KERNEL,OBJECT,ARG0];
169 0           my $session = delete $input->{sender};
170 0           my $event = delete $input->{event};
171              
172 0           $kernel->post( $session, $event, $input );
173 0           $kernel->refcount_decrement( $session => __PACKAGE__ );
174 0           undef;
175             }
176              
177             sub _shorten_wheel {
178 0 0   0     if ( $^O eq 'MSWin32' ) {
179 0           binmode(STDIN); binmode(STDOUT);
  0            
180             }
181 0           my $raw;
182 0           my $size = 4096;
183 0           my $filter = POE::Filter::Reference->new();
184              
185 0           while ( sysread ( STDIN, $raw, $size ) ) {
186 0           my $requests = $filter->get( [ $raw ] );
187 0           foreach my $req ( @{ $requests } ) {
  0            
188 0           $req->{short} = makeashorterlink( $req->{url}, @{$req->{params}} );
  0            
189 0           my $response = $filter->put( [ $req ] );
190 0           print STDOUT @$response;
191             }
192             }
193             }
194              
195             'snip';
196              
197             __END__