Hard timeout for LWP::UserAgent

download.pl

#!/usr/bin/env perl

use 5.12.1;
use POSIX ":sys_wait_h";
use Log::Minimal;
use LWP::UserAgent;
use Time::HiRes qw/ sleep time /;
use HTTP::Request::Common;

my ($url, $output, $timeout) = @ARGV;
if (-e $output) {
    unlink $output or die $!;
}

my $pid;
if ($pid = fork) {
    # parent
    my $start = time;
    while (1) {
        my $kid = waitpid($pid, WNOHANG);
        if ($kid) {
            infof "%d is exited", $kid;
            last;
        }
        if (time - $start > $timeout) {
            warnf "timed out. kill -KILL %d", $pid;
            kill 'KILL', $pid;
        }
        sleep 0.1;
    }
} else {
    # child
    my $ua = LWP::UserAgent->new;
    my $req = GET $url;
    infof "starting %s", $req->as_string;
    $ua->request( $req => $output );
    infof "child done";
    exit;
}

infof "%s size %d bytes", $output, ( -s $output );