#!/usr/bin/env perl
##
# webstress.pl -- Website stress-testing with AnyEvent.

use warnings ('FATAL' => 'all');
use strict;

use EV;
use AnyEvent;
use AnyEvent::HTTP;
use Getopt::Long;

sub usage
{
    die "Usage:\t$0 [--conmax 5] [--reqs 100] [--desist] <url>\n"
        unless @ARGV == 3;
}

sub main
{
    my %opts = ('desist' => 0, 'conmax' => 5, 'reqs' => 100);
    GetOptions(\%opts, qw/conmax=i reqs=i desist/) or usage();
    usage() unless @ARGV == 1;

    my $url = shift @ARGV;
    unless ($url =~ m{\Ahttps?://}) {
        print STDERR "URL must have scheme of http[s].\n";
        usage();
    }
    $opts{'url'} = $url;

    my $start = AnyEvent->time;
    my ($times, $bytes) = benchgets(\%opts);
    my $elapsed = AnyEvent->time - $start;

    printstats({ 'reqs'    => $opts{'reqs'},
                 'elapsed' => $elapsed,
                 'times'   => $times,
                 'bytes'   => $bytes });

    return 0;
}

sub benchgets
{
    my ($opts) = @_;

    my ($conmax, $reqcount, $url, $desist)
        = @{$opts}{qw/conmax reqs url desist/};

    my ($i, $bytes, $donecv, @times) = (0, 0, AnyEvent->condvar, ());

    $donecv->begin for 1 .. $reqcount;

    my $clockget; $clockget = sub {
        my $reqbeg = AnyEvent->time;
        my $cb = sub {
            my ($body, $hdrs) = @_;

            die "HTTP @{$hdrs}{'Status','Reason'}"
                unless $hdrs->{'Status'} == 200;
            die 'Content length is zero'
                if length $body == 0;

            $bytes += length $body;

            my $t = AnyEvent->time - $reqbeg;
            push @times, $t;
            $donecv->end;

            # After each response is received, send out another request.
            $clockget->() unless $i >= $reqcount;
        };

        http_get($url, 'persistent' => !$desist, $cb);
        ++$i;
    };

    # Start off a self-spawning batch of requests.
    $clockget->() for 1 .. $conmax;

    # Continue from here after the last response is received.
    $donecv->recv;

    return \@times, $bytes;
}

sub printstats
{
    my ($opts) = @_;
    my ($reqcount, $elapsed, $T, $bytes) =
        @{$opts}{'reqs', 'elapsed', 'times', 'bytes'};

    @$T = sort @$T; # makes min, max, median easier

    # Print simple statistics.
    printf "%0.3f seconds; %d requests (%0.1f/sec); %d bytes (%d/sec)\n",
        $elapsed, $reqcount, $reqcount / $elapsed, $bytes, $bytes / $elapsed;
    printf "%d min; %d mean; %d med; %d max; %d stdev\n", map { $_ * 1_000 }
        ($T->[0], mean($T), $T->[$#$T/2], $T->[$#$T], stdev($T));

    return;
}

sub sum { my $a; $a += $_ for @{$_[0]}; $a }

sub mean { sum($_[0]) / @{$_[0]} }

sub stdev
{
    my $a = shift;
    my $m = mean($a);
    sqrt mean([ map { ($_ - $m) ** 2 } @$a ]);
}

exit main(@ARGV);