File Coverage

blib/lib/LWPx/Profile.pm
Criterion Covered Total %
statement 36 37 97.3
branch 4 6 66.6
condition n/a
subroutine 9 9 100.0
pod 0 2 0.0
total 49 54 90.7


line stmt bran cond sub pod time code
1             package LWPx::Profile;
2             $LWPx::Profile::VERSION = '0.2';
3 2     2   165295 use strict;
  2         5  
  2         88  
4 2     2   10 use warnings;
  2         3  
  2         69  
5 2     2   7 no warnings 'redefine';
  2         5  
  2         66  
6              
7 2     2   22022 use LWP::UserAgent;
  2         66982  
  2         52  
8 2     2   1094 use Time::HiRes;
  2         2596  
  2         8  
9              
10             =head1 NAME
11              
12             LWPx::Profile - Basic Timing of HTTP Requests
13              
14             =head1 VERSION
15              
16             version 0.2
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;
58             our %timings;
59              
60             sub start_profiling {
61 3     3 0 20078 _wrap_request_sub();
62             }
63              
64             sub stop_profiling {
65 3     3 0 82 *LWP::UserAgent::request = $original_lwp_ua_request;
66 3         16 my %copy = %timings;
67 3         7 %timings = ();
68            
69 3         11 return \%copy;
70             }
71              
72             sub _wrap_request_sub {
73 3     3   11 $original_lwp_ua_request = \&LWP::UserAgent::request;
74            
75             *LWP::UserAgent::request = sub {
76 6     6   15396 my ($ua, $req, @args) = @_;
77            
78 6         21 my $start = Time::HiRes::time();
79 6         23 my $resp = $original_lwp_ua_request->($ua, $req, @args);
80 6         2156 my $end = Time::HiRes::time();
81            
82 6         17 my $duration = $end - $start;
83 6 100       21 if (my $data = $timings{$req->as_string}) {
84 2         93 $data->{count}++;
85 2         5 $data->{total_duration} += $duration;
86 2         3 $data->{time_of_last_sample} = $end;
87            
88 2 50       6 if ($duration < $data->{shortest_duration}) {
89 2         3 $data->{shortest_duration} = $duration;
90             }
91            
92 2 50       7 if ($duration > $data->{longest_duration}) {
93 0         0 $data->{longest_duration} = $duration
94             }
95             }
96             else {
97 4         412 $timings{$req->as_string} = {
98             count => 1,
99             total_duration => $duration,
100             first_duration => $duration,
101             shortest_duration => $duration,
102             longest_duration => $duration,
103             time_of_first_sample => $end,
104             time_of_last_sample => $end,
105             };
106             }
107            
108 6         235 return $resp;
109 3         38 };
110             }
111              
112             =head1 TODO
113              
114             =over 2
115              
116             =item *
117              
118             The docs are pretty middling at the moment.
119              
120             =back
121              
122             =head1 AUTHORS
123              
124             Chris Reinhardt
125             crein@cpan.org
126            
127             =head1 COPYRIGHT
128              
129             This program is free software; you can redistribute
130             it and/or modify it under the same terms as Perl itself.
131              
132             The full text of the license can be found in the
133             LICENSE file included with this module.
134              
135             =head1 SEE ALSO
136              
137             L, perl(1)
138              
139             =cut
140              
141             1;
142             __END__