bold results from the CPAN

bold

App-livehttperf

view release on metacpan or search on metacpan

lib/App/livehttperf.pm view on Meta::CPAN


package App::livehttperf;
BEGIN {
  $App::livehttperf::AUTHORITY = 'cpan:AJGB';
}
{
  $App::livehttperf::VERSION = '0.03';
}
# ABSTRACT: Real life web performance testing tool

use strict;
use warnings;

use HTTP::Request;
use HTTP::Response;
use LWP::UserAgent;
use Parallel::ForkManager;
use Getopt::Long;
use Time::HiRes qw( gettimeofday tv_interval );
use Text::TabularDisplay;
use Statistics::Descriptive;
use Number::Bytes::Human qw( format_bytes );
use Time::Elapsed qw( -compile elapsed );
use List::Util qw( sum );
use utf8;

my @recs;
my %stats;
my @concurrency;
my $total_delays = 0;
my $total_urls = 0;
my $test_started;
my $elapsed_time;
my %ua_opts;

# xlsx output
my ($xls, $xls_summary, $xls_urls, $bold);
my $xls_s_row = 0;
my $xls_u_row = 0;

my %OPTS = (
    input => undef,
    reuse_cookies => 0,
    concurrency => [ 1 ],
    concurrency_max => 0,
    response_match_type => [],
    concurrency_step => 5,
    use_delay => 1,
    max_delay => 0,
    hostname => undef,
    verbosity => 1,
    quiet => 0,
    repeat => 10,
    timeout => 10,
    output => undef,
    output_xls => undef,
);

# subs
sub LOG(@)  { print @_, "\n" }
sub TRACE() { $OPTS{verbosity} >= 4; }
sub DEBUG() { $OPTS{verbosity} >= 3; }
sub INFO()  { $OPTS{verbosity} >= 2; }
sub WARN()  { $OPTS{verbosity} >= 1; }
sub ERROR() { ! $OPTS{quiet}; }

sub trim { s/\r?\n$// for @_ };
sub hb($) { return $_[0] ? 'Yes' : 'No' }

sub print_version {
    my $year = (localtime)[5] + 1900;
    my $years = $year != 2012 ? "2012-$year" : '2012';
    binmode STDOUT, ":utf8";
    print <<EOV;
livehttperf, version $App::livehttperf::VERSION  (perl $^V)

This software is copyright (c) $years by Alex J. G. BurzyÅ„ski <ajgb\@cpan.org>.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

EOV
};

sub configure {
    my $rv = GetOptions(
        'input|i=s' => \$OPTS{input},
        'output|o=s' => \$OPTS{output},
        'reuse_cookies|rc' => \$OPTS{reuse_cookies},
        'verbose|v+' => \$OPTS{verbosity},
        'quiet|q' => \$OPTS{quiet},
        'no_delay|nd' => sub { $OPTS{use_delay} = 0 },
        'max_delay|md=i' => \$OPTS{max_delay},
        'hostname|h=s' => \$OPTS{hostname},
        'match|m=s@' => \$OPTS{response_match_type},
        'response_match_type|m=s@' => \$OPTS{response_match_type},
        'concurrency|c=i@' => \$OPTS{concurrency},

lib/App/livehttperf.pm view on Meta::CPAN

    }

    {
        no warnings 'closure';
        if ( @{ $OPTS{response_match_type} } ) {
            eval q|
                sub App::livehttperf::response_matched {
                    return 0 unless $_[0]->status_line eq $_[1]->status_line;
                    my $eh = $_[0]->headers;
                    my $gh = $_[1]->headers;
                    for ( qw(|. join(' ', @{ $OPTS{response_match_type} } ) .q| ) ) {
                        my $ev = $eh->header($_);
                        my $gv = $gh->header($_);
                        return 0 unless defined $ev && defined $gv
                                        && $ev eq $gv;
                    }
                    return 1;
                }
            |;
        } else { # status_line only
            eval q{
                sub App::livehttperf::response_matched {
                    return $_[0]->status_line eq $_[1]->status_line;
                }
            };
        }
    }

    $OPTS{verbosity} = 0 if $OPTS{quiet};
    $OPTS{input} = '-' unless $OPTS{input};

    %ua_opts = (
        max_redirect => 0,
        timeout => $OPTS{timeout},
        keep_alive => 0,
    );

    if ( $OPTS{concurrency_max} && $OPTS{concurrency_step} ) {
        push @concurrency, 1
            unless $OPTS{concurrency_step} == 1;

        for ( my $c = $OPTS{concurrency_step}; $c <= $OPTS{concurrency_max}; $c += $OPTS{concurrency_step} ) {
            push @concurrency, $c;
        }
        push @concurrency, $OPTS{concurrency_max}
            unless $concurrency[-1] == $OPTS{concurrency_max};
    } else {
        push @concurrency, sort { $a <=> $b } @{ $OPTS{concurrency} };
    }

    if ( my $xlsx_file = $OPTS{output} ) {

        require Excel::Writer::XLSX;

        $xls = Excel::Writer::XLSX->new( $xlsx_file );
        $xls->set_optimization();
        $xls->set_properties(
            title => 'Performance tests',
            comments => "Generated by App::livehttperf/$App::livehttperf::VERSION",
        );
        $bold = $xls->add_format();
        $bold->set_bold();

        $xls_summary = $xls->add_worksheet('Summary');
        $xls_urls = $xls->add_worksheet('URLs');
    }

}

sub parse_livehttp_log {
    local $/ = "----------------------------------------------------------\r\n";

    open(my $ifh, "<$OPTS{input}") or die "Cannot open $OPTS{input}: $!\n";
    while(my $rrb = <$ifh>) { # Request-Response block
        trim($rrb);

        my ($url, $req, $res, $req_bytes, $res_bytes);
        my @fh = split(/^/, $rrb);
        RRB: for(my $i = 0; $i < @fh; $i++) {
            my $l = $fh[$i]; # single line
            unless ( defined $url ) {
                trim($l);
                $url = $l;
                $i++;
                next;
            }

            # request
            if ( ! defined $req && $l =~ /^[A-Z]+ /) {
                my $req_hdrs = $l;
                my $cl;
                REQ: while( defined( $l = $fh[++$i] ) ) {
                    if ( ! $OPTS{reuse_cookies} && $l =~ /^Cookie/i ) {
                        next REQ;
                    }
                    if ( $l =~ /^HTTP\// ) { # reached response block
                        $i--;
                        last REQ;
                    }
                    if ( $l =~ /^Content-Length:[ \t]+(\d+)/i ) {
                        $cl = int($1);
                    }
                    $req_hdrs .= $l;
                }
                $req_hdrs =~ s/\r?\n\z//;
                my $post_data;
                if ( $cl ) { # post data requires Content-Length
                    $post_data = substr($req_hdrs, -1 * $cl);
                    $req_hdrs = substr($req_hdrs, 0, -1 * $cl);
                }
                $req = HTTP::Request->parse($req_hdrs);
                if ( defined $post_data ) {
                    unless ( length($post_data) == $req->header('Content-Length')) {
                        die "Content-Length header doesn't match the length of post data:\n$rrb\n$post_data\n",
                    };
                    $req->content( $post_data );
                }

                $req->uri( $url );
                if ( $OPTS{hostname} ) {
                    if ( $req->header('Host') ) {
                        $req->header( Host => $OPTS{hostname} );

lib/App/livehttperf.pm view on Meta::CPAN


        $pm->wait_all_children;

        LOG "\nFinished testing concurrency $concurrency" if INFO;
    }

    $elapsed_time = tv_interval( $test_started );
}

sub get_concurrency_time_stats {
    my ($concurrency) = @_;

    my $reqs = $stats{$concurrency}->{reqs};

    return (
        $concurrency,
        scalar localtime($stats{$concurrency}->{started}->[0]),
        sprintf("%.6f", $stats{$concurrency}->{elapsed}),
        ( map { sprintf("%.6f", $reqs->$_() ) } qw( min max mean standard_deviation median ) ),
    );
}


sub get_concurrency_res_stats {
    my ($concurrency) = @_;

    my $counts = $stats{$concurrency}->{counts};

    return (
        $concurrency,
        ( map { $counts->{$_} } qw( successful_requests failed_requests 1xx 2xx 3xx 4xx 5xx ) ),
    );
}


sub xlsx_row {
    return [ @_ ];
}

sub save_results {

    print "\n";

    {
        my $reqs_sent = $total_urls * $OPTS{repeat} * sum(@concurrency);
        my $test_run_at = localtime();

        print "\n";
        print "SUMMARY\n";
        print "  Test run at:            ", $test_run_at, "\n";
        print "  URLs tested:            ", $total_urls, "\n";
        print "  Total delays (per run): ", ($total_delays ? elapsed($total_delays) : '0'), "\n";
        print "  Requests sent:          ", $reqs_sent, "\n";
        print "  Test elapsed time:      ", ($elapsed_time < 1 ? '< 1 sec' : elapsed($elapsed_time)), "\n";
        print "\n";


        if ( $xls ) {
            my @columns = ('Test run at', 'URLs tested', 'Total delays (per run)', 'Requests sent', 'Test elapsed time');

            $xls_summary->write_row($xls_s_row++, 0, xlsx_row(@columns), $bold);

            $xls_summary->write_row($xls_s_row++, 0, xlsx_row(
                $test_run_at,
                $total_urls,
                $total_delays,
                $reqs_sent,
                $elapsed_time
            ));
            $xls_s_row++;
        }
    }

    if ( INFO ) {
        my @columns = ('Option', 'Value');

        my $t = Text::TabularDisplay->new(@columns);

        $t->add('Input', $OPTS{input});
        $t->add('XLSX output', $OPTS{output} || '');
        $t->add('Reuse cookies', hb $OPTS{reuse_cookies});
        $t->add('Verbosity', $OPTS{verbosity});
        $t->add('Use delay', hb($OPTS{use_delay}) . ($OPTS{use_delay} && $OPTS{max_delay} ? " (max: $OPTS{max_delay} secs)" : ''));
        $t->add('Override hostname', hb($OPTS{hostname}) . ($OPTS{hostname} ? ": $OPTS{hostname}" : ''));
        $t->add('Concurrency', join(", ", @concurrency));
        $t->add('Repeats', $OPTS{repeat});
        $t->add('Connection timeout', $OPTS{timeout});
        $t->add('Compare headers', join("\n", @{ $OPTS{response_match_type} }));

        print "Configuration:\n";
        print $t->render, "\n";
        print "\n";
    }

    {
        my @columns = ('Concurrency', 'Started', 'Total', 'Min', 'Max', 'Avg', 'StdDev', 'Median');

        $xls_summary->write_row($xls_s_row++, 0, xlsx_row(@columns), $bold)
            if $xls;

        my $t = Text::TabularDisplay->new(@columns);

        for my $c ( @concurrency ) {

            my @row = get_concurrency_time_stats($c);

            $t->add( @row );
            $xls_summary->write_row($xls_s_row++, 0, xlsx_row(@row)) if $xls;
        }
        $xls_s_row++;

        print "Times (in seconds):\n";
        print $t->render, "\n";
        print "\n";
    }

    {
        my @columns = ('Concurrency', 'Successful', 'Failed', '1xx', '2xx', '3xx', '4xx', '5xx');

        $xls_summary->write_row($xls_s_row++, 0, xlsx_row(@columns), $bold) if $xls;

        my $t = Text::TabularDisplay->new(@columns);

        for my $c ( @concurrency ) {

            my @row = get_concurrency_res_stats($c);

            $t->add( @row );

            $xls_summary->write_row($xls_s_row++, 0, xlsx_row(@row)) if $xls;
        }
        $xls_s_row++;

        print "Responses:\n";
        print $t->render, "\n";
        print "\n";
    }

    {
        my @columns = ('Concurrency', 'Data sent', 'Data received');

        $xls_summary->write_row($xls_s_row++, 0, xlsx_row(@columns), $bold) if $xls;

        my $t = Text::TabularDisplay->new(@columns);

        for my $c ( @concurrency ) {

            my $counts = $stats{$c}->{counts};

            $t->add(
                $c,
                ( map { format_bytes( $counts->{$_} ) } qw( bytes_sent bytes_recv ) ),
            );

            $xls_summary->write_row($xls_s_row++, 0, xlsx_row(
                $c,
                ( map { $counts->{$_} } qw( bytes_sent bytes_recv ) ),
            )) if $xls;
        }
        $xls_s_row++;

        print "Data transfers:\n";
        print $t->render, "\n";
        print "\n";
    }

    {
        my @columns = ('Concurrency', 'URL', 'Min', 'Max', 'Avg', 'StdDev', 'Median', 'Errors');

        $xls_urls->write_row($xls_u_row++, 0, xlsx_row(@columns), $bold) if $xls;

        my $t = Text::TabularDisplay->new(@columns);

        for (my $rec_no = 1; $rec_no <= @recs; $rec_no++) {
            next unless ref $recs[$rec_no-1];
            for my $concurrency ( @concurrency ) {
                my $rec_stats = $stats{$concurrency}->{recs};
                my $rec_errors = $stats{$concurrency}->{errors}->{recs};

                my $url = $recs[$rec_no-1]->{req}->uri;
                my @row = (
                    $concurrency,
                    $url,
                    ( map { sprintf("%.6f", $rec_stats->{$rec_no}->$_() ) } qw( min max mean standard_deviation median ) ),
                    $rec_errors->{$rec_no} || 0
                );
                $t->add( @row );
                $xls_urls->write_row($xls_u_row++, 0, xlsx_row(@row)) if $xls;
            }
        }

        print "URLs:\n";
        print $t->render, "\n";
        print "\n";
    }

    $xls->close if $xls;
}

sub print_usage {
    print <<'EOH';
Usage: livehttperf [OPTIONS]

Input:
  -i, --input=file      Input file with recoreded session from LiveHTTP headers
                        Firefox extension.
                        Default: "-" (STDIN)

  -nd, --no_delay       Send requests one after another without detected delays.
                        Default: use delay

  -md, --max_delay=NUM  If using delay, wait for no more then NUM seconds
                        Default: none

  -h, --hostname=STRING Override hostname in requests and set Host header to
                        STRING.
                        Default: no change

  -rc, --reuse_cookies  Use Cookie/Set-Cookie headers from recorded session.
                        Default: do not reuse

Sessions:
  -n, --repeat=NUM      Repeat recorded session NUM times.
                        Default: 10

  -t, --timeout=NUM     Connection timeout.
                        Default: 10

  -m, --match=STRING    In addition to comparing HTTP response status line,
                        use specified STRING header to confirm successful

( run in 1.249 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )