File Coverage

blib/lib/Plack/Middleware/Debug/LWP.pm
Criterion Covered Total %
statement 12 29 41.3
branch n/a
condition n/a
subroutine 4 6 66.6
pod 1 1 100.0
total 17 36 47.2


line stmt bran cond sub pod time code
1             package Plack::Middleware::Debug::LWP;
2             $Plack::Middleware::Debug::LWP::VERSION = '0.2';
3 1     1   17063 use strict;
  1         2  
  1         48  
4 1     1   4 use warnings;
  1         1  
  1         28  
5              
6 1     1   476 use LWPx::Profile;
  1         44253  
  1         35  
7 1     1   448 use parent qw(Plack::Middleware::Debug::Base);
  1         243  
  1         4  
8              
9             =head1 NAME
10              
11             Plack::Middleware::Debug::LWP - LWP Profiling Panel
12              
13             =head1 VERSION
14              
15             version 0.2
16              
17             =head1 SYNOPSIS
18              
19             enable 'Debug::LWP';
20              
21             =head1 DESCRIPTION
22              
23             This module provides a panel for the L that gives
24             profiling information for L requests.
25              
26             =cut
27              
28              
29            
30             my $lwp_template = __PACKAGE__->build_template(<<'ENDOFIT');
31            
32            
33            
34             Request
35             Timing
36            
37            
38            
39             % my $i;
40             % while (@{$_[0]->{list}}) {
41             % my($key, $value) = splice(@{$_[0]->{list}}, 0, 2);
42            
43            
<%= $key %>
44             <%= $value %>
45            
46             % }
47            
48            
49             ENDOFIT
50              
51            
52             sub run {
53 0     0 1   my($self, $env, $panel) = @_;
54            
55 0           LWPx::Profile::start_profiling();
56            
57             return sub {
58 0     0     my $res = shift;
59            
60 0           my $profile = LWPx::Profile::stop_profiling();
61            
62 0           my @lines;
63 0           my ($time, $requests);
64 0           while (my ($req, $stats) = each %$profile) {
65 0           my $summary = sprintf("%.5f/%d (%.5f avg)", $stats->{total_duration}, $stats->{count}, $stats->{total_duration} / $stats->{count});
66 0           push(@lines, $req, $summary);
67 0           $requests += $stats->{count};
68 0           $time += $stats->{total_duration};
69             }
70            
71 0           my $summary = sprintf("%d requests / %.2f seconds", $requests, $time);
72            
73 0           $panel->nav_title("LWP Requests");
74 0           $panel->title("LWP Requests ($summary)");
75 0           $panel->nav_subtitle($summary);
76              
77 0           $panel->content(
78             $self->render($lwp_template, { list => \@lines })
79             );
80 0           };
81             }
82              
83              
84              
85             =head1 TODO
86              
87             =over 2
88              
89             =item *
90              
91             The docs are pretty middling at the moment.
92              
93             =back
94              
95             =head1 AUTHORS
96              
97             Chris Reinhardt
98             crein@cpan.org
99              
100             Mark Ng
101             cpan@markng.co.uk
102            
103             =head1 COPYRIGHT
104              
105             This program is free software; you can redistribute
106             it and/or modify it under the same terms as Perl itself.
107              
108             The full text of the license can be found in the
109             LICENSE file included with this module.
110              
111             =head1 SEE ALSO
112              
113             L, L, L, perl(1)
114              
115             =cut
116              
117             1;
118             __END__