File Coverage

blib/lib/APP/REST/ParallelMyUA.pm
Criterion Covered Total %
statement 19 21 90.4
branch n/a
condition n/a
subroutine 7 7 100.0
pod n/a
total 26 28 92.8


line stmt bran cond sub pod time code
1             package APP::REST::ParallelMyUA;
2              
3 1     1   11 use 5.006;
  1         2  
  1         28  
4 1     1   3 use strict;
  1         2  
  1         19  
5 1     1   3 use warnings FATAL => 'all';
  1         1  
  1         29  
6 1     1   3 use Data::Dumper;
  1         1  
  1         40  
7 1     1   7 use Time::HiRes qw( time sleep );
  1         1  
  1         4  
8 1     1   98 use Exporter();
  1         1  
  1         11  
9 1     1   161 use LWP::Parallel::UserAgent qw(:CALLBACK);
  0            
  0            
10              
11             use base qw(LWP::Parallel::UserAgent Exporter);
12             our @EXPORT = @LWP::Parallel::UserAgent::EXPORT_OK;
13              
14             $| = 1; #make the pipe hot
15             $Data::Dumper::Indent = 1;
16              
17             =head1 NAME
18              
19             APP::REST::ParallelMyUA -
20             provide a subclassed UserAgent to override on_connect, on_failure and
21             on_return methods
22              
23             =head1 VERSION
24              
25             Version 0.03
26              
27             =cut
28              
29             our $VERSION = '0.03';
30              
31             =head1 SYNOPSIS
32              
33             #Quick summary of what the module does.
34             #Perhaps a little code snippet.
35              
36             use APP::REST::ParallelMyUA;
37             my $pua = APP::REST::ParallelMyUA->new();
38              
39              
40             =head1 SUBROUTINES/METHODS
41              
42             =head2 new
43              
44             Object Constructor
45              
46             =cut
47              
48             sub new {
49             my ( $proto, %args ) = @_;
50             my $class = ref($proto) || $proto;
51             my $self;
52              
53             $self = bless $proto->SUPER::new(%args), $class;
54             return $self;
55             }
56              
57             =head2 on_connect
58              
59             redefine methods: on_connect gets called whenever we're about to
60             make a a connection
61              
62             =cut
63              
64             sub on_connect {
65             my ( $self, $request, $response, $entry ) = @_;
66              
67             #print time,"Connecting to ", $request->url, "\n";
68             print STDERR ".";
69             $entry->{tick}->{start} = time;
70             }
71              
72             =head2 on_failure
73              
74             on_failure gets called whenever a connection fails right away
75             (either we timed out, or failed to connect to this address before,
76             or it's a duplicate). Please note that non-connection based
77             errors, for example requests for non-existant pages, will NOT call
78             on_failure since the response from the server will be a well
79             formed HTTP response!
80              
81             =cut
82              
83             sub on_failure {
84             my ( $self, $request, $response, $entry ) = @_;
85             print "Failed to connect to ", $request->url, "\n\t", $response->code, ", ",
86             $response->message, "\n"
87             if $response;
88             }
89              
90             =head2 on_return
91              
92             on_return gets called whenever a connection (or its callback)
93             returns EOF (or any other terminating status code available for
94             callback functions). Please note that on_return gets called for
95             any successfully terminated HTTP connection! This does not imply
96             that the response sent from the server is a success!
97              
98             =cut
99              
100             sub on_return {
101             my ( $self, $request, $response, $entry ) = @_;
102             print ".";
103              
104             #print time,"Response got from ", $request->url, "\n";
105              
106             $entry->{tick}->{end} = time;
107              
108             if ( $response->is_success ) {
109              
110             #print "\n\nWoa! Request to ",$request->url," returned code ", $response->code,
111             # ": ", $response->message, "\n";
112             #print $response->content;
113             } else {
114              
115             #print "\n\nBummer! Request to ",$request->url," returned code ", $response->code,
116             # ": ", $response->message, "\n";
117             #print $response->error_as_HTML;
118             }
119             return;
120             }
121              
122             1;
123              
124             =head1 AUTHOR
125              
126             Mithun Radhakrishnan, C<< >>
127              
128             =head1 BUGS
129              
130             =head1 SUPPORT
131              
132             You can find documentation for this module with the perldoc command.
133              
134             perldoc APP::REST::ParallelMyUA
135              
136              
137             =head1 ACKNOWLEDGEMENTS
138              
139              
140             =head1 LICENSE AND COPYRIGHT
141              
142             Copyright 2014 Mithun Radhakrishnan.
143              
144             This program is free software; you can redistribute it and/or modify it
145             under the terms of the the Artistic License (2.0). You may obtain a
146             copy of the full license at:
147              
148             L
149              
150             Any use, modification, and distribution of the Standard or Modified
151             Versions is governed by this Artistic License. By using, modifying or
152             distributing the Package, you accept this license. Do not use, modify,
153             or distribute the Package, if you do not accept this license.
154              
155             If your Modified Version has been derived from a Modified Version made
156             by someone other than you, you are nevertheless required to ensure that
157             your Modified Version complies with the requirements of this license.
158              
159             This license does not grant you the right to use any trademark, service
160             mark, tradename, or logo of the Copyright Holder.
161              
162             This license includes the non-exclusive, worldwide, free-of-charge
163             patent license to make, have made, use, offer to sell, sell, import and
164             otherwise transfer the Package with respect to any patent claims
165             licensable by the Copyright Holder that are necessarily infringed by the
166             Package. If you institute patent litigation (including a cross-claim or
167             counterclaim) against any party alleging that the Package constitutes
168             direct or contributory patent infringement, then this Artistic License
169             to you shall terminate on the date that such litigation is filed.
170              
171             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
172             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
173             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
174             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
175             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
176             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
177             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
178             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
179              
180              
181             =cut
182              
183             1; # End of APP::REST::ParallelMyUA