view release on metacpan or  search on metacpan

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

    $|=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 {
            my ($pid, $tid) = @_;

            $stats{$concurrency}->{started} = [ gettimeofday ];
        });
        $pm->run_on_finish(sub {
            my ($pid, $failures, $tid, $exit_signal, $core_dump, $data) = @_;

            $stats{$concurrency}->{elapsed} = tv_interval( $stats{$concurrency}->{started} );

            $stats{$concurrency}->{counts}->{failed_requests} += $failures;

            if ( defined $data ) {
                # all failed request by $rec_no
                $stats{$concurrency}->{errors}->{recs}->{$_} += $data->{errors}->{$_}
                    for keys %{ $data->{errors} };
                # add to stats total time of all requests in all runs
                $stats{$concurrency}->{reqs}->add_data(
                    @{ $data->{reqs} }
                );

                # sum counts
                $stats{$concurrency}->{counts}->{$_} += $data->{counts}->{$_}
                    for qw( successful_requests bytes_sent bytes_recv 1xx 2xx 3xx 4xx 5xx );

                # add to stats time of each request in all runs
                for my $rec_no ( keys %{ $data->{recs} } ) {
                    $stats{$concurrency}->{recs}->{$rec_no} = Statistics::Descriptive::Full->new()
                        unless exists $stats{$concurrency}->{recs}->{$rec_no};
                    $stats{$concurrency}->{recs}->{$rec_no}->add_data(
                        @{ $data->{recs}->{$rec_no} }
                    );
                }
            }
        });


        for my $tid ( 1 .. $concurrency ) {
            LOG "Starting thread $tid" if INFO;
            $pm->start($tid) and next;

            my $failed_requests = 0;
            my $successful_requests = 0;
            my %req_stats = (
                reqs => Statistics::Descriptive::Full->new(),
                recs => {},
                counts => {},
            );
            my @req_stats_data;
            my %rec_stats_data;
            my $bytes_sent = 0;
            my $bytes_recv = 0;
            my %rec_errors;
            my %res_statuses = (
                '1xx' => 0,
                '2xx' => 0,
                '3xx' => 0,
                '4xx' => 0,
                '5xx' => 0,
            );
            for my $no ( 1 .. $OPTS{repeat} ) {
                LOG "Starting run $no (thread $tid)" if INFO;

                # create brand new UA for each loop
                my $ua = LWP::UserAgent->new(
                    (
                        $OPTS{reuse_cookies} ?
                        ()
                        :
                        ( cookie_jar => {} )
                    ),
                    %ua_opts
                );

                my $rec_no = 0;
                for my $rec ( @recs ) {
                    $rec_no++;
                    if ( ! ref $rec ) {
                        LOG "[$tid.$no.$rec_no] Waiting for ", elapsed($rec) if DEBUG;
                        sleep $rec;
                        next;
                    }

                    my $req = $rec->{req};
                    $bytes_sent += $rec->{req_bytes};
                    my $exp_res = $rec->{res};
                    LOG "[$tid.$no.$rec_no] REQ:\n", $req->headers->as_string if DEBUG;
                    LOG "[$tid.$no.$rec_no] REQ:\n", $req->as_string if TRACE;
                    my $res;

                    # start of the request in run $no
                    my $rec_stats_start = [ gettimeofday ];
                    eval {
                        $res = $ua->request($req, $OPTS{verbosity} == 1 ? sub { print "." } : () )
                            or die "No response\n";
                    };
                    my $err = $@;
                    push @{ $rec_stats_data{$rec_no} }, tv_interval( $rec_stats_start );

                    if ( $res ) {
                        LOG "[$tid.$no.$rec_no] RES:\n", $res->headers->as_string if DEBUG;
                        LOG "[$tid.$no.$rec_no] RES:\n", $res->as_string if TRACE;

                        my $res_headers = $res->headers;
                        $bytes_recv += $res_headers->header('Content-Length') ||
                            (length($res_headers->as_string) + length($res->content));

                        $res_statuses{int($res->code / 100) .'xx'}++;
                    }
                    if ( $err || ! response_matched($exp_res, $res) ) {
                        $failed_requests++;
                        $rec_errors{$rec_no}++;
                        if ( ERROR ) {
                            my $nl = $OPTS{verbosity} == 1 ? "\n" : '';
                            if ( $res ) {
                                LOG "$nl\[$tid.$no.$rec_no] RES FAILED: ", $res->status_line;
                            } else {
                                LOG "$nl\[$tid.$no.$rec_no] RES FAILED: (no response)";
                            }
                        }
                        if ( TRACE ) {
                            LOG "  Exception: $err" if $err;
                        }
                    } else {
                        $successful_requests++;
                        LOG "[$tid.$no.$rec_no] RES: ", $res->status_line if DEBUG;
                    }
                }
                LOG "\nFinished run $no (thread $tid)" if INFO;
            }
            $req_stats{reqs} = [];
            for my $rec_no ( keys %rec_stats_data ) {
                for ( my $i = 0; $i < @{ $rec_stats_data{$rec_no} }; $i++ ) {
                    # total time of all requests in given run $no
                    $req_stats{reqs}->[$i] += $rec_stats_data{$rec_no}->[$i];
                }
            }
            $req_stats{recs} = { %rec_stats_data };
            $req_stats{errors} = { %rec_errors };
            $req_stats{counts} = {
                successful_requests => $successful_requests,
                bytes_sent => $bytes_sent,
                bytes_recv => $bytes_recv,
                %res_statuses,
            };


            LOG "\nFinished thread $tid" if INFO;
            $pm->finish($failed_requests, \%req_stats);
        }

        $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 ) {