File Coverage

bin/plackbench
Criterion Covered Total %
statement 53 64 82.8
branch 8 10 80.0
condition 4 8 50.0
subroutine 8 9 88.8
pod n/a
total 73 91 80.2


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3 4     4   24057 use strict;
  4         10  
  4         172  
4 4     4   19 use warnings;
  4         10  
  4         253  
5 4     4   2606 use autodie;
  4         91788  
  4         57  
6 4     4   35296 use v5.10;
  4         32  
7              
8 4     4   3788 use Getopt::Long qw();
  4         73618  
  4         195  
9              
10 4     4   2300 use App::plackbench;
  4         16  
  4         9904  
11              
12 4         809649 my $opts = _parse_argv(\@ARGV);
13              
14 4 100 66     37 unless ( $opts->{psgi_path} && $opts->{uri} ) {
15 1         8 say "Usage: $0 -n /path/to/app.psgi ";
16 1         0 exit 1;
17             }
18 3   33     13 $opts->{post_data} &&= _post_data( $opts->{post_data} );
19              
20 3 100       11 if ($opts->{fixup}) {
21 1         135 my $sub = eval("sub { \$_ = shift; $opts->{fixup} }");
22 1         6 $opts->{fixup} = [$sub];
23             }
24              
25 3         7 my $bench = App::plackbench->new(%{$opts});
  3         82  
26              
27 3 100       18 if ($opts->{fixup_files}) {
28 1         6 $bench->add_fixup_from_file($opts->{fixup_files});
29             }
30              
31 3         18 my $stats = $bench->run();
32 1         7 _report($stats, $opts);
33              
34 1         0 exit 0;
35              
36             sub _parse_argv {
37 4     4   11 my $argv = shift;
38              
39 4         12 my %opts;
40              
41 4         38 Getopt::Long::Configure('bundling');
42             Getopt::Long::GetOptionsFromArray(
43             $argv,
44             'n=i' => \$opts{count},
45             'warm' => \$opts{warm},
46             'post=s' => \$opts{post_data},
47             'e=s' => \$opts{fixup},
48             'f=s' => \$opts{fixup_files},
49             'p=i' => \$opts{precision},
50 4         265 );
51              
52 4         5391 ( $opts{psgi_path}, $opts{uri} ) = @{$argv};
  4         28  
53              
54 4         21 for (keys %opts) {
55 32 100       155 delete $opts{$_} unless defined $opts{$_};
56             }
57              
58 4         21 return \%opts;
59             }
60              
61             sub _post_data {
62 0     0   0 my $file = shift;
63              
64 0         0 my @bodies;
65 0 0       0 if ( $file eq '-' ) {
66 0         0 say 'Enter POST data. when finished.';
67 0         0 @bodies = ;
68             }
69             else {
70 0         0 open( my $fh, $file );
71 0         0 @bodies = <$fh>;
72 0         0 close($fh);
73             }
74              
75 0         0 return [ grep $_, map { chomp; $_ } @bodies ];
  0         0  
  0         0  
76             }
77              
78             sub _report {
79 1     1   2 my $stats = shift;
80 1         2 my $opts = shift;
81              
82 1   50     8 $opts->{precision} //= 3;
83 1         4 my $time = "%8.$opts->{precision}f";
84              
85 1         6 printf "Rate (requests per second): %.2f\n\n", $stats->rate;
86              
87 1         5 print "Request times (seconds):\n";
88 1         6 printf( "%8s %8s %8s %8s %8s\n", 'min', 'mean', 'sd', 'median', 'max' );
89 1         8 printf( "$time $time $time $time $time\n\n",
90             $stats->min(), $stats->mean(), $stats->standard_deviation(), $stats->median(), $stats->max() );
91              
92 1         3 print "Percentage of requests within a certain time (seconds):\n";
93 1         4 for my $percent ( 50, 66, 75, 80, 90, 95, 98, 99, 100 ) {
94 9         22 my $value = $stats->percentile( $percent );
95 9         40 printf( "%4d%% $time\n", $percent, $value );
96             }
97             }
98              
99             =pod
100              
101             =head1 NAME
102              
103             plackbench - Benchmarking/Debugging tool for Plack web requests
104              
105             =head1 SYNOPSIS
106              
107             # Make a request 5 times, and print some stats
108             $ plackbench -n 5 /path/to/app.psgi '/search?q=stuff'
109              
110             # Debug the same request
111             $ PERL5OPT=-d plackbench -n 5 /path/to/app.psgi '/search?q=stuff'
112              
113             # Profile the same request
114             $ PERL5OPT=-d:NYTProf plackbench -n 5 /path/to/app.psgi '/search?q=stuff'
115             $ nytprofhtml -m
116              
117             =head1 DESCRIPTION
118              
119             This script benchmarks a web request. It hits the Plack app directly without
120             going through a web server.
121              
122             This is somewhat useful on it's own for getting an idea of the time spent in
123             Perl-land for a web request. But it's mostly a harness for a debugger or
124             profiler.
125              
126             =head1 USAGE
127              
128             plackbench /path/to/app.psgi URI
129              
130             The first positional argument is the path to a .psgi file. The second is the
131             URL to request.
132              
133             The URI is relative to the application root.
134              
135             =head1 OPTIONS
136              
137             =over 4
138              
139             =item -n
140              
141             Number of times to execute the request. Defaults to 1.
142              
143             =item --warm
144              
145             Make an initial request that won't be included in the stats.
146              
147             =item --post=
148              
149             Make a POST request instead of a GET. Pass the path to a file with the raw
150             URL-encoded POST data. If the file contains multiple lines, each will be used a
151             separate POST request.
152              
153             If the file is a '-', the POST body will be read from STDIN.
154              
155             =item -e
156              
157             Pre-process the request using the Perl code passed. C<$_> will be set to a
158             L object.
159              
160             For example, to set the User-Agent:
161              
162             plackbench -e '$_->header("User-Agent" => "Mozilla")' /path/to/app.psgi /
163              
164             =item -f
165              
166             Like C<-e>, however the code is read from a file. Should return a code
167             reference, which will be passed a C object.
168              
169             A simple example:
170              
171             sub {
172             my $request = shift;
173             $request->header( Cookie => 'session=mysid' );
174             return;
175             }
176              
177             The file can contain any valid Perl code, but the last statement in the file
178             must be a subroutine reference.
179              
180             =item -p
181              
182             The number of decimal places in times included in the report. Defaults to 3.
183              
184             =back
185              
186             =head1 Using with L
187              
188             Just invoking the script through NYTProf is all that's necessary:
189              
190             PERL5OPT=-d:NYTProf plackbench /path/to/app.psgi '/search?q=stuff'
191              
192             In some applications, startup costs can overshadow the actual request in the
193             report. If this happens prevent NYTProf from starting by default:
194              
195             NYTPROF=start=no PERL5OPT=-d:NYTPRof plackbench /path/to/app.psgi '/search?q=stuff'
196              
197             The script will call C to start NYTProf before executing
198             any requests. Which removes the startup code from the final report.
199              
200             If the C<--warm> flag is used, C will be called after the
201             initial request.
202              
203             See L for more information.
204              
205             =head1 AUTHOR
206              
207             Paul Boyd
208              
209             Currently maintained by Bartosz Jarzyna
210              
211             =head1 COPYRIGHT AND LICENSE
212              
213             This software is copyright (c) 2014 by Paul Boyd.
214              
215             This is free software; you can redistribute it and/or modify it under
216             the same terms as the Perl 5 programming language system itself.
217              
218             =cut
219