package ActivePerl::PPM::Web;

use strict;
use base qw(Exporter);
our @EXPORT_OK = qw(web_ua);

use ActivePerl::PPM ();
use ActivePerl ();

my $ua;

sub web_ua {
    unless ($ua) {
	my $perl_version = ActivePerl::perl_version();
	$ua = ActivePerl::PPM::Web::UA->new(
	    agent => "PPM/$ActivePerl::PPM::VERSION ActivePerl/$perl_version ($^O) ",
	    env_proxy => 1,
	    keep_alive => 1,
        );
	$ua->default_header("Accept-Encoding" => "gzip, deflate");
    }
    return $ua;
}

package ActivePerl::PPM::Web::UA;

use Time::HiRes qw(time);

use base 'LWP::UserAgent';
use ActivePerl::PPM::Logger qw(ppm_log ppm_status);

sub simple_request {
    my $self = shift;
    my $req = shift;
    my $before = time();

    my $res = $self->SUPER::simple_request($req, @_);

    if ($res->content_type =~ m,^application/(x-)?gzip$,) {
	# tweak reponse so that 'decoded_content' will decode it
	$res->content_type("application/octet-stream");
	$res->push_header("Content-Encoding", "gzip");
    }

    my $used = (time() - $before) || 1e-6;
    my $bytes = "";
    my $speed = "";
    if (my $len = $res->content_length || length(${$res->content_ref})) {
	if ($req->method ne "HEAD") {
	    $bytes = "$len bytes ";
	    $speed = sprintf " - %.0f KB/s", ($len/1024) / $used;
	}
    }
    if ($used < 3) {
	$used = sprintf "%.2f sec", $used;
    }
    elsif ($used < 20) {
	$used = sprintf "%.1f sec", $used;
    }
    else {
	$used = sprintf "%.0f sec", $used;
    }
    ppm_log("INFO", sprintf("%s %s ==> %s (${bytes}in $used$speed)", $req->method, $req->uri, $res->status_line));
    return $res;
}

sub progress {
    my($self, $status, $response) = @_;
    return unless $self->{progress_what};
    my @arg;
    if ($status eq "begin") {
	push(@arg, $self->{progress_what});
    }
    elsif ($status =~ /^\d/) {
	push(@arg, $status);
	$status = "tick";
    }
    elsif ($status eq "end") {
	unless ($response->is_success) {
	    my $code = $response->code;
	    push(@arg, {
               301 => "redirect",
               302 => "redirect",
               303 => "redirect",
               304 => "not modified",
               403 => "forbidden",
               404 => "not found",
	    }->{$code} || "failed $code " . $response->message);
	}
    }
    ppm_status($status, @arg);
}

1;