File: | bin/plackbench |
Coverage: | 80.2% |
line | stmt | bran | cond | sub | time | code |
---|---|---|---|---|---|---|
1 | #!/usr/bin/perl | |||||
2 | ||||||
3 | 4 4 4 | 56095 13 175 | use strict; | |||
4 | 4 4 4 | 23 9 120 | use warnings; | |||
5 | 4 4 4 | 1066 67671 22 | use autodie; | |||
6 | 4 4 4 | 22775 27 212 | use v5.10; | |||
7 | ||||||
8 | 4 4 4 | 2347 53601 126 | use Getopt::Long qw(); | |||
9 | ||||||
10 | 4 4 4 | 1132 14 7970 | use App::plackbench; | |||
11 | ||||||
12 | 4 | 439732 | my $opts = _parse_argv(\@ARGV); | |||
13 | ||||||
14 | 4 | 50 | unless ( $opts->{psgi_path} && $opts->{uri} ) { | |||
15 | 1 | 16 | say "Usage: $0 -n <num requests> /path/to/app.psgi <uri>"; | |||
16 | 1 | 0 | exit 1; | |||
17 | } | |||||
18 | 3 | 41 | $opts->{post_data} &&= _post_data( $opts->{post_data} ); | |||
19 | ||||||
20 | 3 | 13 | if ($opts->{fixup}) { | |||
21 | 1 | 133 | my $sub = eval("sub { \$_ = shift; $opts->{fixup} }"); | |||
22 | 1 | 6 | $opts->{fixup} = [$sub]; | |||
23 | } | |||||
24 | ||||||
25 | 3 3 | 7 26 | my $bench = App::plackbench->new(%{$opts}); | |||
26 | ||||||
27 | 3 | 15 | if ($opts->{fixup_files}) { | |||
28 | 1 | 4 | $bench->add_fixup_from_file($opts->{fixup_files}); | |||
29 | } | |||||
30 | ||||||
31 | 3 | 11 | my $stats = $bench->run(); | |||
32 | 1 | 4 | _report($stats); | |||
33 | ||||||
34 | 1 | 0 | exit 0; | |||
35 | ||||||
36 | sub _parse_argv { | |||||
37 | 4 | 12 | my $argv = shift; | |||
38 | ||||||
39 | 4 | 11 | my %opts; | |||
40 | ||||||
41 | 4 | 16 | Getopt::Long::Configure('bundling'); | |||
42 | 4 | 149 | 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 | ); | |||||
50 | ||||||
51 | 4 4 | 2140 18 | ( $opts{psgi_path}, $opts{uri} ) = @{$argv}; | |||
52 | ||||||
53 | 4 | 21 | for (keys %opts) { | |||
54 | 28 | 96 | delete $opts{$_} unless defined $opts{$_}; | |||
55 | } | |||||
56 | ||||||
57 | 4 | 17 | return \%opts; | |||
58 | } | |||||
59 | ||||||
60 | sub _post_data { | |||||
61 | 0 | 0 | my $file = shift; | |||
62 | ||||||
63 | 0 | 0 | my @bodies; | |||
64 | 0 | 0 | if ( $file eq '-' ) { | |||
65 | 0 | 0 | say 'Enter POST data. <Ctrl-D> when finished.'; | |||
66 | 0 | 0 | @bodies = <STDIN>; | |||
67 | } | |||||
68 | else { | |||||
69 | 0 | 0 | open( my $fh, $file ); | |||
70 | 0 | 0 | @bodies = <$fh>; | |||
71 | 0 | 0 | close($fh); | |||
72 | } | |||||
73 | ||||||
74 | 0 0 0 | 0 0 0 | return [ grep $_, map { chomp; $_ } @bodies ]; | |||
75 | } | |||||
76 | ||||||
77 | sub _report { | |||||
78 | 1 | 3 | my $stats = shift; | |||
79 | ||||||
80 | 1 | 12 | print "Request times (seconds):\n"; | |||
81 | 1 | 10 | printf( "%8s %8s %8s %8s %8s\n", 'min', 'mean', 'sd', 'median', 'max' ); | |||
82 | 1 | 6 | printf( "%8.3f %8.3f %8.3f %8.3f %8.3f\n\n", | |||
83 | $stats->min(), $stats->mean(), $stats->standard_deviation(), $stats->median(), $stats->max() ); | |||||
84 | ||||||
85 | 1 | 5 | print "Percentage of requests within a certain time (seconds):\n"; | |||
86 | 1 | 3 | for my $percent ( 50, 66, 75, 80, 90, 95, 98, 99, 100 ) { | |||
87 | 9 | 28 | my $value = $stats->percentile( $percent ); | |||
88 | 9 | 59 | printf( "%4d%% %8.3f\n", $percent, $value ); | |||
89 | } | |||||
90 | } | |||||
91 | ||||||
92 - 205 | =pod =head1 NAME plackbench - Benchmarking/Debugging tool for Plack web requests =head1 SYNOPSIS # Make a request 5 times, and print some stats $ plackbench -n 5 /path/to/app.psgi '/search?q=stuff' # Debug the same request $ PERL5OPT=-d plackbench -n 5 /path/to/app.psgi '/search?q=stuff' # Profile the same request $ PERL5OPT=-d:NYTProf plackbench -n 5 /path/to/app.psgi '/search?q=stuff' $ nytprofhtml -m =head1 DESCRIPTION This script benchmarks a web request. It hits the Plack app directly without going through a web server. This is somewhat useful on it's own for getting an idea of the time spent in Perl-land for a web request. But it's mostly a harness for a debugger or profiler. =head1 USAGE plackbench /path/to/app.psgi URI The first positional argument is the path to a .psgi file. The second is the URL to request. The URI is relative to the application root. =head1 OPTIONS =over 4 =item -n Number of times to execute the request. Defaults to 1. =item --warm Make an initial request that won't be included in the stats. =item --post=<file> Make a POST request instead of a GET. Pass the path to a file with the raw URL-encoded POST data. If the file contains multiple lines, each will be used a separate POST request. If the file is a '-', the POST body will be read from STDIN. =item -e <code> Pre-process the request using the Perl code passed. C<$_> will be set to a L<HTTP::Request> object. For example, to set the User-Agent: plackbench -e '$_->header("User-Agent" => "Mozilla")' /path/to/app.psgi / =item -f <file> Like C<-e>, however the code is read from a file. Should return a code reference, which will be passed a C<HTTP::Request> object. A simple example: sub { my $request = shift; $request->header( Cookie => 'session=mysid' ); return; } The file can contain any valid Perl code, but the last statement in the file must be a subroutine reference. =back =head1 Using with L<Devel::NYTProf> Just invoking the script through NYTProf is all that's necessary: PERL5OPT=-d:NYTProf plackbench /path/to/app.psgi '/search?q=stuff' In some applications, startup costs can overshadow the actual request in the report. If this happens prevent NYTProf from starting by default: NYTPROF=start=no PERL5OPT=-d:NYTPRof plackbench /path/to/app.psgi '/search?q=stuff' The script will call C<DB::enable_profile()> to start NYTProf before executing any requests. Which removes the startup code from the final report. If the C<--warm> flag is used, C<DB::enable_profile()> will be called after the initial request. See L<Devel::NYTProf> for more information. =head1 AUTHOR Paul Boyd <boyd.paul2@gmail.com> =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2014 by Paul Boyd. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut |