File Coverage

blib/lib/Bot/Cobalt/Plugin/WWW.pm
Criterion Covered Total %
statement 16 83 19.2
branch 0 26 0.0
condition 0 8 0.0
subroutine 6 19 31.5
pod 0 13 0.0
total 22 149 14.7


line stmt bran cond sub pod time code
1             package Bot::Cobalt::Plugin::WWW;
2             $Bot::Cobalt::Plugin::WWW::VERSION = '0.021003';
3 1     1   755 use strictures 2;
  1         4  
  1         30  
4 1     1   128 use Scalar::Util 'reftype';
  1         1  
  1         40  
5              
6 1     1   4 use Bot::Cobalt;
  1         1  
  1         4  
7 1     1   565 use Bot::Cobalt::Common;
  1         1  
  1         6  
8              
9 1         6 use POE qw/
10             Component::Client::HTTP
11             Component::Client::Keepalive
12 1     1   445 /;
  1         23805  
13              
14              
15             sub opts {
16 0     0 0 0 my $opts = core->get_plugin_cfg($_[0])->{Opts};
17 0 0 0     0 return +{} unless ref $opts and reftype $opts eq 'HASH';
18 0         0 $opts
19             }
20              
21             sub bindaddr {
22             $_[0]->opts->{BindAddr}
23 0     0 0 0 }
24              
25             sub proxy {
26             $_[0]->opts->{Proxy}
27 0     0 0 0 }
28              
29             sub timeout {
30 0 0   0 0 0 $_[0]->opts->{Timeout} || 90
31             }
32              
33             sub max_per_host {
34 0 0   0 0 0 $_[0]->opts->{MaxPerHost} || 5
35             }
36              
37             sub max_workers {
38 0 0   0 0 0 $_[0]->opts->{MaxWorkers} || 25
39             }
40              
41             sub Requests {
42             return($_[0]->{REQS}//={})
43 0   0 0 0 0 }
44              
45 1     1 0 335 sub new { bless {}, shift }
46              
47             sub Cobalt_register {
48 0     0 0   my ($self, $core) = splice @_, 0, 2;
49              
50 0           register( $self, 'SERVER',
51             'www_request',
52             );
53            
54 0           POE::Session->create(
55             object_states => [
56             $self => [
57             '_start',
58             'ht_response',
59             'ht_post_request',
60             ],
61             ],
62             );
63              
64 0           logger->info("Loaded WWW interface");
65              
66 0           return PLUGIN_EAT_NONE
67             }
68              
69             sub Cobalt_unregister {
70 0     0 0   my ($self, $core) = splice @_, 0, 2;
71              
72 0           delete $core->Provided->{www_request};
73              
74 0           my $ht_alias = 'ht_'.$core->get_plugin_alias($self);
75 0           $poe_kernel->call( $ht_alias, 'shutdown' );
76              
77 0           my $sess_alias = 'www_'.$core->get_plugin_alias($self);
78 0           $poe_kernel->alias_remove( $sess_alias );
79              
80 0           logger->info("Unregistered");
81              
82 0           return PLUGIN_EAT_NONE
83             }
84              
85             sub Bot_www_request {
86 0     0 0   my ($self, $core) = splice @_, 0, 2;
87 0           my $request = ${ $_[0] };
  0            
88 0 0         my $event = defined $_[1] ? ${$_[1]} : undef ;
  0            
89 0 0         my $args = defined $_[2] ? ${$_[2]} : undef ;
  0            
90              
91 0 0 0       unless ($request && $request->isa('HTTP::Request')) {
92 0           logger->warn(
93             "www_request received but no request at "
94             .join ' ', (caller)[0,2]
95             );
96             }
97            
98 0 0         unless ($event) {
99             ## no event at all is legitimate
100 0           $event = 'www_not_handled';
101             }
102            
103 0 0         $args = [] unless $args;
104 0           my @p = ( 'a' .. 'f', 1 .. 9 );
105 0           my $tag = join '', map { $p[rand@p] } 1 .. 5;
  0            
106 0           $tag .= $p[rand@p] while exists $self->Requests->{$tag};
107              
108 0           $self->Requests->{$tag} = {
109             Event => $event,
110             Args => $args,
111             Request => $request,
112             Time => time(),
113             };
114              
115 0           logger->debug("www_request issue $tag -> $event");
116            
117 0           my $sess_alias = 'www_'.$core->get_plugin_alias($self);
118 0           $poe_kernel->call( $sess_alias,
119             'ht_post_request',
120             $request, $tag
121             );
122              
123 0           return PLUGIN_EAT_ALL
124             }
125              
126             sub ht_post_request {
127             ## Bridge to make sure response gets delivered to correct session
128 0     0 0   my ($self, $kernel) = @_[OBJECT, KERNEL];
129 0           my ($request, $tag) = @_[ARG0, ARG1];
130             ## Post the ::Request
131 0           my $ht_alias = 'ht_'. core()->get_plugin_alias($self);
132 0           $kernel->post( $ht_alias,
133             'request', 'ht_response',
134             $request, $tag
135             );
136             }
137              
138             sub ht_response {
139 0     0 0   my ($self, $kernel) = @_[OBJECT, KERNEL];
140 0           my ($req_pk, $resp_pk) = @_[ARG0, ARG1];
141              
142 0           my $response = $resp_pk->[0];
143 0           my $tag = $req_pk->[1];
144              
145 0           my $this_req = delete $self->Requests->{$tag};
146 0 0         return unless $this_req;
147            
148 0           my $event = $this_req->{Event};
149 0           my $args = $this_req->{Args};
150            
151 0           core->log->debug("ht_response dispatch: $event ($tag)");
152              
153 0 0         my $content = $response->is_success ?
154             $response->decoded_content
155             : $response->message;
156              
157 0           broadcast($event, $content, $response, $args);
158             }
159              
160             sub _start {
161 0     0     my ($self, $kernel) = @_[OBJECT, KERNEL];
162              
163 0           my $sess_alias = 'www_'. core()->get_plugin_alias($self);
164 0           $kernel->alias_set( $sess_alias );
165              
166 0           my %opts;
167 0 0         $opts{BindAddr} = $self->bindaddr if $self->bindaddr;
168 0 0         $opts{Proxy} = $self->proxy if $self->proxy;
169 0           $opts{Timeout} = $self->timeout;
170              
171             ## Create "ht_${plugin_alias}" session
172 0           POE::Component::Client::HTTP->spawn(
173              
174             FollowRedirects => 5,
175              
176             Agent => __PACKAGE__,
177              
178             Alias => 'ht_'. core()->get_plugin_alias($self),
179              
180             ConnectionManager => POE::Component::Client::Keepalive->new(
181             keep_alive => 1,
182             max_per_host => $self->max_per_host,
183             max_open => $self->max_workers,
184             timeout => $self->timeout,
185             ),
186            
187             %opts,
188              
189             );
190            
191 0           core()->Provided->{www_request} = __PACKAGE__ ;
192             }
193              
194             1;
195             __END__