File Coverage: bin/plackbench

# File Coverage

File: | bin/plackbench
Coverage: | 80.2%

line | stmt | bran | cond | sub | time | code
--- | --- | --- | --- | --- | --- | ---
1 |  |  |  |  |  | #!/usr/bin/perl
2 |
3 | 4 4 4 |  |  | 4 | 56095 13 175 | use strict;
4 | 4 4 4 |  |  | 4 | 23 9 120 | use warnings;
5 | 4 4 4 |  |  | 4 | 1066 67671 22 | use autodie;
6 | 4 4 4 |  |  | 4 | 22775 27 212 | use v5.10;
7 |
8 | 4 4 4 |  |  | 4 | 2347 53601 126 | use Getopt::Long qw();
9 |
10 | 4 4 4 |  |  | 4 | 1132 14 7970 | use App::plackbench;
11 |
12 | 4 |  |  |  | 439732 | my $opts = _parse_argv(\@ARGV);
13 |
14 | 4 | 100 | 67 |  | 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 |  | 33 |  | 41 | $opts->{post_data} &&= _post_data( $opts->{post_data} );
19 |
20 | 3 | 100 |  |  | 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 | 100 |  |  | 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 |  |  | 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 | 100 |  |  | 96 | delete $opts{$_} unless defined $opts{$_};
55 |  |  |  |  |  | }
56 |
57 | 4 |  |  |  | 17 | return \%opts;
58 |  |  |  |  |  | }
59 |
60 |  |  |  |  |  | sub _post_data {
61 | 0 |  |  | 0 | 0 | my $file = shift;
62 |
63 | 0 |  |  |  | 0 | my @bodies;
64 | 0 | 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 |  |  | 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