view release on metacpan or  search on metacpan

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

};

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
            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} );
                    }
                    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,
                res_bytes => 0,
            };

            $total_urls++;

        };
    }
}

sub run_tests {
    $test_started = [ gettimeofday ];

    $|=1;

    for my $concurrency ( @concurrency ) {
        LOG "\nRunning with concurrency of $concurrency" if INFO;
        my $pm = Parallel::ForkManager->new( $concurrency );

        $stats{$concurrency} = {
            reqs => Statistics::Descriptive::Full->new(),
            recs => {},
            counts => {
                successful_requests => 0,
                failed_requests => 0,
                bytes_sent => 0,
                bytes_recv => 0,
            },
            errors => {
                total => 0,
                recs => {}
            },
        };

        $pm->run_on_start(sub {