File Coverage

blib/lib/LWPx/Profile.pm
Criterion Covered Total %
statement 35 36 97.2
branch 5 6 83.3
condition n/a
subroutine 9 9 100.0
pod 0 2 0.0
total 49 53 92.4


line stmt bran cond sub pod time code
1             package LWPx::Profile;
2             $LWPx::Profile::VERSION = '0.1';
3 2     2   134228 use strict;
  2         4  
  2         73  
4 2     2   7 use warnings;
  2         2  
  2         46  
5 2     2   6 no warnings 'redefine';
  2         6  
  2         51  
6              
7 2     2   769 use LWP::UserAgent;
  2         60148  
  2         55  
8 2     2   1176 use Time::HiRes;
  2         2833  
  2         7  
9              
10             =head1 NAME
11              
12             LWPx::Profile - Basic Timing of HTTP Requests
13              
14             =head1 VERSION
15              
16             version 0.1
17              
18             =head1 SYNOPSIS
19              
20             use LWP::UserAgent;
21             use LWPx::Profile;
22            
23             my $ua = LWP::UserAgent;
24            
25             LWPx::Profile::start_profile();
26             foreach my $url (@sites) {
27             $ua->get($url);
28             }
29             my $results = LWPx::Profile::stop_profile;
30              
31              
32             =head1 DESCRIPTION
33              
34             This module provides a basic profiling framework for looking at how long
35             HTTP requests with LWP took to complete. The data structure returned by
36             C is a hashref of request-string => stats pairs. For example:
37              
38              
39             'GET http://www.google.com/
40             User-Agent: libwww-perl/6.08
41              
42             ' => {
43             'shortest_duration' => '0.111438989639282',
44             'time_of_first_sample' => '1424211134.8376',
45             'longest_duration' => '0.202037811279297',
46             'count' => 3,
47             'total_duration' => '0.436195850372314',
48             'time_of_last_sample' => '1424211135.07221',
49             'first_duration' => '0.202037811279297'
50             };
51              
52              
53             In this example, there have been three requests for http://www.google.com/.
54              
55             =cut
56              
57             our $original_lwp_ua_request = \&LWP::UserAgent::request;
58             our %timings;
59              
60             sub start_profiling {
61 3     3 0 87870 _wrap_request_sub();
62             }
63              
64             sub stop_profiling {
65 3     3 0 117 *LWP::UserAgent::request = $original_lwp_ua_request;
66 3         19 my %copy = %timings;
67 3         14 %timings = ();
68            
69 3         13 return \%copy;
70             }
71              
72             sub _wrap_request_sub {
73             *LWP::UserAgent::request = sub {
74 11     11   396960 my ($ua, $req, @args) = @_;
75            
76 11         45 my $start = Time::HiRes::time();
77 11         43 my $resp = $original_lwp_ua_request->($ua, $req, @args);
78 11         381885 my $end = Time::HiRes::time();
79            
80 11         29 my $duration = $end - $start;
81 11 100       46 if (my $data = $timings{$req->as_string}) {
82 2         137 $data->{count}++;
83 2         4 $data->{total_duration} += $duration;
84 2         5 $data->{time_of_last_sample} = $end;
85            
86 2 100       12 if ($duration < $data->{shortest_duration}) {
87 1         2 $data->{shortest_duration} = $duration;
88             }
89            
90 2 50       8 if ($duration > $data->{longest_duration}) {
91 0         0 $data->{longest_duration} = $duration
92             }
93             }
94             else {
95 9         991 $timings{$req->as_string} = {
96             count => 1,
97             total_duration => $duration,
98             first_duration => $duration,
99             shortest_duration => $duration,
100             longest_duration => $duration,
101             time_of_first_sample => $end,
102             time_of_last_sample => $end,
103             };
104             }
105            
106 11         733 return $resp;
107 3     3   40 };
108             }
109              
110             =head1 TODO
111              
112             =over 2
113              
114             =item *
115              
116             The docs are pretty middling at the moment.
117              
118             =back
119              
120             =head1 AUTHORS
121              
122             Chris Reinhardt
123             crein@cpan.org
124            
125             =head1 COPYRIGHT
126              
127             This program is free software; you can redistribute
128             it and/or modify it under the same terms as Perl itself.
129              
130             The full text of the license can be found in the
131             LICENSE file included with this module.
132              
133             =head1 SEE ALSO
134              
135             L, perl(1)
136              
137             =cut
138              
139             1;
140             __END__