use warnings; use 5.014;
use EV; use AnyEvent; use AnyEvent::HTTP;
use File::Temp qw/tempfile/; use File::Spec::Functions;
use Fcntl ();
use URI; use URI::file;
use Getopt::Long;
use Time::HiRes ();

our $VERSION = 0.002;

$EV::DIED = sub {
    warn $@;
    exit 1;
};

$AnyEvent::HTTP::PERSISTENT_TIMEOUT = 10;

sub montime {
    Time::HiRes::clock_gettime(Time::HiRes::CLOCK_MONOTONIC());
}

our $dirprefix = ".";
our $listfile;
our $dirtemp;
our $useragent = "wgetas";
our $sleepnorm = 60;
our $nburst = 5;
our $outlistfile;
our $keepgoing;
our($versionopt, $helpopt);
for (@ARGV) {
    /\A(.*)\z/s or die "internal error: untaint argv"; $_ = $1;
}
Getopt::Long::Configure qw"bundling gnu_compat prefix_pattern=(--|-)";
GetOptions(
    "i|input_file=s" => \$listfile,
    "P|directory-prefix=s" => \$dirprefix,
    "m|directory-temp=s" => \$dirtemp,
    "w|wait=f" => \$sleepnorm,
    "U|user-agent=s" => \$useragent,
    "b|burst=i" => \$nburst,
    "e|outlistfile=s" => \$outlistfile,
    "f|keep-going!" => \$keepgoing,
    "version" => \$versionopt,
    "help" => \$helpopt,
);
if ($versionopt) {
    die "wgetas $VERSION\n";
} elsif ($helpopt) {
    my $helpstr = q(Usage: wgetas -i listfile
        Downloads a list of small files through HTTP.  Each line of th
+e listfile has an URL and 
        a filename to save as.  Downloads for existing files are skipp
+ed.
        For more documentation and options, try perldoc wgetas.
    );
    $helpstr =~ s/\n\s*/\n/g;
    die $helpstr;
}
@ARGV and die "error: too many command-line arguments";
length($listfile) or die "error: missing argument -i listfile";
length($dirtemp) or $dirtemp = $dirprefix;

our @spec;    
{
    open my $U, "<", $listfile;
    chomp(@spec = <$U>);
}

our %exclude;
our $OUTLIST;
if (length($outlistfile)) {
    if (!open $OUTLIST, "+<", $outlistfile) {
        if ($!{ENOENT}) {
            open $OUTLIST, "+>", $outlistfile or
                die "error: cannot create outlistfile ($outlistfile): 
+$!";
        } else  {
            die "error: cannot open outlistfile ($outlistfile): $!";
        }
    }
    flock $OUTLIST, Fcntl::LOCK_EX | Fcntl::LOCK_NB or 
        die "error: cannot lock outlistfile ($outlistfile): $!";
    while (defined(my $l = <$OUTLIST>)) {
        chomp($l);
        $exclude{$l} = 1;
    }
    eof($OUTLIST) or die "error reading outlistfile: $!";
} else {
    $keepgoing and die "error: -f option not allowed because -e option
+ is unset";
}

our %fname;
our $sleepcycle = 0;
our $sleepnormcredit = 0;
our $sleepextracredit = 0;

sub paysleep {
    my($burst) = @_;
    my $s = 0;
    if (
        !$burst || 
        $nburst <= $sleepcycle || 
        $sleepnorm < $sleepextracredit
    ) {
        $s = $sleepnormcredit + $sleepextracredit;
        $sleepnormcredit = $sleepextracredit = 0;
        $sleepcycle = 0;
    }
    my $ct = AnyEvent->condvar;
    my $t = AnyEvent->timer(after => $s, cb => sub { $ct->send() });
    $ct->recv;
}

PAGE: for my $speci (keys @spec) {

    my $spec = $spec[$speci];
    my $specln = 1 + $speci;
    $spec =~ /\S/ or next;
    my($uri, $fnamej, $rest) = split " ", $spec;
    length($rest) and die "invalid spec (too many words, line $specln)
+: $spec";
    $uri =~ m"^(https?://[!#-;=?-Z\[\]_a-z~]*)$" or die "invalid uri (
+line $specln): $uri";
    $uri = $1;
    if (!defined($fnamej)) {
        $uri =~ m"/([^/]+)/*$" or 
            die "error: cannot find suffix or uri (line $specln): $uri
+";
        $fnamej = $1;
    }
    $fnamej =~ /\A([\x01-\xff]*)\z/ or die "error: invalid filename (l
+ine $specln): $fnamej";
    $fnamej = $1;
    my @fnamej_seg = URI::file->new($fnamej)->path_segments;
    length($fnamej_seg[0]) or 
        die "error: filename is absolute (line $specln): $fnamej";
    grep { ".." eq $_ } @fnamej_seg and
        die "error: filename contains up-dir (line $specln): $fnamej";
    $fname{$fnamej}++ and warn "warning: filename appears twice (line 
+$specln): $fnamej";
    $exclude{$fnamej} and next;
    my $fname = catfile($dirprefix, $fnamej);
    -f $fname and next;
    
    my $timestart = montime();
    print STDERR "GET $uri $fname : ";
    flush STDERR;
    my($hbody, $hhead, $status, $reason);
    my $cntconn = 0;
    {
        my $cond = AnyEvent->condvar;
        my $hagent = AnyEvent::HTTP::http_get(
            $uri, 
            recurse => 0, 
            timeout => 120,
            on_prepare => sub { $cntconn++ },
            headers => {"user-agent" => $useragent},
            sub { ($hbody, $hhead) = @_; $cond->send; },
        );
        $cond->recv;
        ($status, $reason) = @$hhead{(qw"Status Reason")};
    }
    my $timeend = montime();
    my $timedelta = $timeend - $timestart;
    my $bodylen = length($hbody);
    $sleepcycle++;
    $sleepnormcredit += abs($sleepnorm * (0.8 + rand(0.4)));
    $sleepextracredit += abs(1.2 * $timedelta);
    print STDERR sprintf "%.2fs %dc %db %s %s\n", 
        $timeend-$timestart, $cntconn, $bodylen, $status, $reason;
    flush STDERR;
    
    if (200 == $status) {

        my($O, $oname) = tempfile("get-XXXXXXXX", SUFFIX => ".tmp", DI
+R => $dirtemp, UNLINK => 0) or die;
        print $O $hbody or die "error writing output file";
        close $O or die "error closing output file";
        rename $oname, $fname or die "error renaming output file: $!";
    
    } elsif ($keepgoing && (404 == $status || 403 == $status)) {
        1;
    } else {
        die "Error getting page: $status $reason";
    }

    if ($OUTLIST) {
        say $OUTLIST $fnamej or die "error writing to outlistfile: $!"
+;
        flush $OUTLIST;
    }
    paysleep 1;

} # PAGE

if ($OUTLIST) {
    close $OUTLIST or die "error closing outlistfile: $!";
}
paysleep 0;

say STDERR "All done.";

__END__
[download]