| 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 | |||||