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;

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

    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} );
                    }
                    my $new_host = $req->uri;
                    $new_host->host( $OPTS{hostname} );
                    $req->uri( $new_host );
                }
                next RRB;
            # response
            } elsif ( defined $req && $l =~ /^HTTP/ ) {
                $l =~ s/\r?\n\z//;
                # status line is parsed up to \n by HTTP::Response->parse()
                my $res_hdrs = "$l\n";
                RES: while( $l = $fh[++$i] ) {
                    last RES if $l =~ /^\-{58}/;
                    unless ( $OPTS{reuse_cookies} ) {
                        next if $l =~ /^Set-Cookie/i;
                    }
                    $res_hdrs .= $l;
                }
                $res = HTTP::Response->parse($res_hdrs);
                unless ( $ua_opts{keep_alive} ) {
                    if ( my $ka = $res->header('Keep-Alive') ) {
                        my ($max) = $ka =~ /max=(\d+)/;
                        $ua_opts{keep_alive} = $max || 100;
                    }
                }
                last RRB;
            }
        }

        if ( $req ) {
            if ( $OPTS{use_delay} ) {
                if ( @recs > 0 ) {
                    my $prev_date = $recs[-1]->{res}->headers->date;
                    my $cur_date = $res->headers->date;
                    my $delay = $cur_date - $prev_date;
                    if ( $delay > 0 ) {
                        my $delay_sec = $OPTS{max_delay} && $delay > $OPTS{max_delay} ?
                                $OPTS{max_delay} : $delay;
                        $total_delays += $delay_sec;

                        push @recs, $delay_sec;
                    }
                }
            }

            push @recs, {
                req => $req,
                res => $res,
                req_bytes => length $req->as_string,