package UserAgentWithStats;                                                                                               
                                                                                                                          
=pod                                                                                                                      
####
## author: bliako
## date: 03/06/2018
## A subclass of LWP::UserAgent which adds a handler
## (if requested) to the "request_send" phase of LWP's request()
## the purpose of which is to increment our internal counter
## every time a request is sent by LWP.
## There are three counters here, one counts the hits and the
## other two record the time started (unix epoch) recording and tim,e last-hit occured.
## The aim is to know the amount of hits and the time interval
## they occured in. Therefore each time a hit happens, the hit
## counter is incremented and "hit-count-time-last-hit" variable is
## updated with the current time(). There is also another time-keeping
## variable which is "hit-count-time-stopped". It records the time
## when the counter is turned off. So 2 time intervals for the same number
## of hits from turn-on to 1) time-last-hit and 2) time-stopped (or now if not stopped)
## 
####

use UserAgentWithStats;
my $ua = UserAgentWithStats->new();
my $urlstr = "http://www.python.org";
$ua->hit_counter_on();
print "$0 : hit count is now: ".$ua->hit_counter_statistics_toString()."\n";
print "$0 : hitting site '$urlstr' ...\n";
my $aresponse = $ua->get($urlstr);
if ($aresponse->is_success) {
        print "$0 : success hitting $urlstr\n";
} else {
        die "$urlstr : $aresponse->status_line";
}
print "$0 : hit count is now: ".$ua->hit_counter_statistics_toString()."\n";
my ($T1, $T2, $numhits) = @{$ua->hit_counter_statistics()};

print "$0 : resetting hit counter ...\n";
$ua->hit_counter_reset();
print "$0 : hit count is now: ".$ua->hit_counter_statistics_toString()."\n";
=cut

use strict;
use warnings;

use parent 'LWP::UserAgent';

our $VERSION = '1.0';

sub     new {
        my $class = $_[0];
        my $params = $_[1];

        my $parent = ( caller(1) )[3] || "N/A";
        my $whoami = ( caller(0) )[3];

        # call parent constructor
        my $self = $class->SUPER::new();

        # extra attributes in class
        $self->{'ua-stats'} = {
                # UA can have callbacks defined so when a request is made
                # a counter is hit. When doing hit counts we record thetime hit count was turned on too
                'hit-count-time-started' => -1, # unix epoch,
                'hit-count-time-stopped' => -1, # ditto
                'hit-count-time-last-hit' => -1, # ditto
                'hit-count' => 0,
        };
        bless($self, $class);

        return $self;
}
# increment a count each time a request is made, can also record the url etc.
sub     hit_counter_on {
        my $self = $_[0];

        $self->add_handler(
                'request_send', sub {
                        my($response, $ua, $h) = @_;
                        $self->register_a_hit();
                        return undef # we bloody need this
                },
                ('owner' => 'hit_counter_on') # use this id for when removing it
        );

        # reset previous counter and set the time when recording started
        $self->hit_counter_reset();
}
# increments the hit counter by 1
sub     increment_hit_count { $_[0]->{'ua-stats'}->{'ua-hit-count'} += 1 }
# registers a hit meaning that hit counter is incremented by 1 and
# last time a hit happens becomes current time.
sub     register_a_hit {
        my $self = $_[0];
        $self->increment_hit_count();
        $self->{'ua-stats'}->{'hit-count-time-last-hit'} = time;
}
sub     hit_counter_reset {
        my $self = $_[0];
        $self->{'ua-stats'}->{'ua-hit-count'} = 0;
        $self->{'ua-stats'}->{'hit-count-time-started'} = time;
        $self->{'ua-stats'}->{'hit-count-time-stopped'} = -1;
        $self->{'ua-stats'}->{'hit-count-time-last-hit'} = -1;
}
sub     hit_counter_off {
        my $self = $_[0];
        $self->remove_handler(
                'request_send', # phase we set it in
                ('owner' => 'hit_counter_on') # our id to remove
        );
        $self->{'ua-stats'}->{'hit-count-time-stopped'} = time;
}
sub     hit_count { return $_[0]->{'ua-stats'}->{'ua-hit-count'} }
sub     time_interval_to_last_hit {
        my $self = $_[0];

        return
        $self->{'ua-stats'}->{'hit-count-time-last-hit'} == -1 ?
                # no hits yet
                0
        : #(
                # hits recorded
                $self->{'ua-stats'}->{'hit-count-time-last-hit'} - $self->{'ua-stats'}->{'hit-count-time-started'}
        ; #)
}
sub     time_interval_to_now_or_when_stopped {
        my $self = $_[0];

        return
        $self->{'ua-stats'}->{'hit-count-time-stopped'} == -1 ?
                # if hit-counting is still on, then time interval is up to now
                time - $self->{'ua-stats'}->{'hit-count-time-started'}
        : #(
                # else hit-counting was turned off, so give last time interval
                $self->{'ua-stats'}->{'hit-count-time-stopped'} - $self->{'ua-stats'}->{'hit-count-time-started'}
        ; #)
}
# returns an arrayref of [TimeTimerval, Hits]
# see below for a string equivalent of this
sub     hit_counter_statistics {
        my $self = $_[0];

        return [
                $self->time_interval_to_last_hit(),
                $self->time_interval_to_now_or_when_stopped(),
                $self->hit_count()
        ]
}
sub     hit_counter_statistics_toString {
        my ($T1, $T2, $H) = @{$_[0]->hit_counter_statistics()};
        return "$H hits over $T1 s (to last hit) or over $T2 s (to now/when stopped) ("
                .sprintf("%.2f", 3600*$H/($T1==0?($T1+1):$T1))
                ." or ".sprintf("%.2f", 3600*$H/($T2==0?($T2+1):$T2))
                ." hits/hour)"
        ;
}
1;
__END__

##</code><code>##

#!/usr/bin/env perl

use strict;
use warnings;

use UserAgentWithStats;
use Test::More;

my $ua = UserAgentWithStats->new();

my $urlstr = "http://www.python.org";

my $num_tests = 0;

print "$0 : turning hit counter on ...\n";
$ua->hit_counter_on();
sleep(1);
print "$0 : hit count is now: ".$ua->hit_counter_statistics_toString()."\n";
my ($intervalT1, $intervalT2, $numhits) = @{$ua->hit_counter_statistics()};
ok(($intervalT1==0), "time intervals (up-to-last-hit) must be zero on turn-on ($intervalT1)");
$num_tests++;
ok(($intervalT2>0), "time intervals (up-to-stopped) records since turn-on irrespective of hits ($intervalT2)");
$num_tests++;
is($numhits, 0, "0 hits at turn-on");
$num_tests++;

print "$0 : hitting site with GET '$urlstr' ...\n";
my $aresponse = $ua->get($urlstr);
if ($aresponse->is_success) {
        print "$0 : success hitting $urlstr\n";
} else {
        die "$urlstr : $aresponse->status_line";
}
print "$0 : hit count is now: ".$ua->hit_counter_statistics_toString()."\n";
($intervalT1, $intervalT2, $numhits) = @{$ua->hit_counter_statistics()};
ok(($intervalT1>0)&&($intervalT1<20), "time interval (up-to-stopped) must be positive (let's say 1-20 seconds).");
$num_tests++;
ok(($intervalT2>0)&&($intervalT2<20), "time interval (up-to-last-hit) must be positive (let's say 1-20 seconds).");
$num_tests++;
is($numhits, 2, "2 hits because of a redirect");
$num_tests++;

print "$0 : turning hit counter off ...\n";
$ua->hit_counter_off();
print "$0 : hit count is now: ".$ua->hit_counter_statistics_toString()."\n";

print "$0 : hitting site with GET '$urlstr' ...\n";
$aresponse = $ua->get($urlstr);
if ($aresponse->is_success) {
        print "$0 : success hitting $urlstr\n";
} else {
        die "$urlstr : $aresponse->status_line";
}
print "$0 : hit count is now: ".$ua->hit_counter_statistics_toString()."\n";

my ($interval2T1, $interval2T2, $numhits2) = @{$ua->hit_counter_statistics()};
is($interval2T1, $intervalT1, "no change in time interval because counter is off");
$num_tests++;

is($interval2T2, $intervalT2, "no change in time interval because counter is off");
$num_tests++;

is($numhits2, $numhits, "no change in hits because counter is off");
$num_tests++;

print "$0 : turning hit counter back on again ...\n";
$ua->hit_counter_on();
print "$0 : hit count is now: ".$ua->hit_counter_statistics_toString()."\n";

is($ua->hit_count(), 0, "hit count after starting");
$num_tests++;

sleep(1);
ok($ua->time_interval_to_now_or_when_stopped()>0, "time interval to-now after starting must be positive integer (after slept for 1)");
$num_tests++;

is($ua->time_interval_to_last_hit(), 0, "time interval since last hit must be zero, no hits yet");
$num_tests++;

print "$0 : hitting site with GET '$urlstr' ...\n";
$aresponse = $ua->get($urlstr);
if ($aresponse->is_success) {
        print "$0 : success hitting $urlstr\n";
} else {
        die "$urlstr : $aresponse->status_line";
}
print "$0 : hit count is now: ".$ua->hit_counter_statistics_toString()."\n";
($intervalT1, $intervalT2, $numhits) = @{$ua->hit_counter_statistics()};
ok(($intervalT1>0)&&($intervalT1<20), "time interval must be positive (let's say 1-20 seconds).");
$num_tests++;
ok(($intervalT2>0)&&($intervalT2<20), "time interval must be positive (let's say 1-20 seconds).");
$num_tests++;
is($numhits, 2, "2 hits because of a redirect");
$num_tests++;

print "$0 : hitting site with GET '$urlstr' again ...\n";
$aresponse = $ua->get($urlstr);
if ($aresponse->is_success) {
        print "$0 : success hitting $urlstr\n";
} else {
        die "$urlstr : $aresponse->status_line";
}
print "$0 : hit count is now: ".$ua->hit_counter_statistics_toString()."\n";
($intervalT1, $intervalT2, $numhits) = @{$ua->hit_counter_statistics()};
ok(($intervalT1>0)&&($intervalT1<20), "time interval must be positive (let's say 1-20 seconds).");
$num_tests++;
ok(($intervalT2>0)&&($intervalT2<20), "time interval must be positive (let's say 1-20 seconds).");
$num_tests++;
is($numhits, 4, "2 more hits because of a redirect");
$num_tests++;

print "$0 : resetting hit counter ...\n";
$ua->hit_counter_reset();
print "$0 : hit count is now: ".$ua->hit_counter_statistics_toString()."\n";
($intervalT1, $intervalT2, $numhits) = @{$ua->hit_counter_statistics()};
is($intervalT1, 0, "time interval must be zero after reset");
$num_tests++;
is($intervalT2, 0, "time interval must be zero after reset");
$num_tests++;
is($numhits, 0, "number of hits must be zero after reset");
$num_tests++;

sleep(1);
$urlstr = 'https://www.w3schools.com/action_page.php';
my $form = {'fname' => 'abc', 'lname' => 'fool on indenting'};
print "$0 : hitting site with a POST '$urlstr' ...\n";
$aresponse = $ua->post($urlstr, $form);
if ($aresponse->is_success) {
        print "$0 : success hitting $urlstr\n";
} else {
        die "$urlstr : $aresponse->status_line";
}
print "$0 : hit count is now: ".$ua->hit_counter_statistics_toString()."\n";
($intervalT1, $intervalT2, $numhits) = @{$ua->hit_counter_statistics()};
ok(($intervalT1>0)&&($intervalT1<20), "time interval must be positive (let's say 1-20 seconds).");
$num_tests++;
ok(($intervalT2>0)&&($intervalT2<20), "time interval must be positive (let's say 1-20 seconds).");
$num_tests++;
is($numhits, 1, "1 hit this time...");
$num_tests++;

done_testing($num_tests);

print "$0 : done.\n";