view release on metacpan or  search on metacpan

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

}
# 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},
        'concurrency_max|cm=i' => \$OPTS{concurrency_max},
        'concurrency_step|cs=i' => \$OPTS{concurrency_step},
        'repeat|n=i' => \$OPTS{repeat},
        'timeout|t=i' => \$OPTS{timeout},
        'version' => sub { print_version(); exit 0 },
        'help' => sub { print_usage(); exit 0 },
    );

    unless ( @ARGV || $rv ) {
        print_usage();
        exit 1;
    }

    {
        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