The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl  

=encoding utf-8

=head1 NAME

md-request - 多线程多地址非阻塞的下载工具

=head1 DESCRIPTION

本工具支持从多个地址下载同一个文件, 并且是单线程事件驱动的分块下载.

=head1 参数

=head2 -a 下载的地址

这个下载的地址可以是多个, 但这多个地址必须是同一个文件. 这样就能从多个地址下载.

=head2 -d 目标地址

如果不写文件存放的地址, 会从 url 传进来的参数中, 取第一个 url 的最后面部分的文件名做为下载后存放的目标文件.

=head2 -n 每个主机的并发数量

这个参数用于指定, 对于下载的地址中, 每个地址开启多少个并发. 这个是以主机名做为标识的.

=head2 -h 自定义的 header

你想指定自定义的 header 的话, 就指定这个参数, -h 这个参数可以多次指定, 来加入不同的 header . 例如你想指定主机名:

    -h "HOST:www.php-oa.com" -h "User-Agent: Mozilla/5.0 (Windows NT 6.1; WOW64; rv:23.0) Gecko/20100101 Firefox/23.0"

=head1 EXAMPLE

例如, 下载最新的 Perl 的版本:

    $ md-request -a http://www.perl.com/CPAN/src/latest.tar.gz

=head1 AUTHOR

fukai <iakuf@163.com>

=cut 

use strict;
use AnyEvent;
use AE;
use AnyEvent::MultiDownload;
use Getopt::Long;

my $progname = $0;
$progname =~ s,.*/,,;    # only basename left in progname
$progname =~ s,.*\\,, if $^O eq "MSWin32";
$progname =~ s/\.\w*$//; # strip extension if any

#parse option
my (@urls, $dest, $num_connections, @header);

GetOptions(
    'a=s', \@urls, 
    'd=s', \$dest,
    'num-connections|n=i', \$num_connections,
    'header|h=s', \@header,
);

unless (@urls) {
    usage();
}

$SIG{INT} = sub { die "Interrupted\n"; };

$| = 1;

my ($filename) = $urls[0] =~ /([^\/]+)$/;
my $start_t = time();

my %headers = map {split '=|:',$_} @header;
my $cv = AE::cv;
my $MultiDown = AnyEvent::MultiDownload->new(
    url     => shift @urls,
    mirror  => \@urls,
    headers => \%headers,
    content_file => $dest || $filename,
    seg_size  => 1 * 1024 * 1024, # 1M
    max_per_host => $num_connections || 20,
    on_finish => sub {
        my $len = shift;
        my $dur = time - $start_t || 1;
        my $speed = fbytes($len/$dur) . "/sec";
        print STDERR "Finished. " . fbytes($len) . " received in $dur seconds ($speed)\n";
        $cv->send;
    },
    on_error => sub {
        my $error = shift;
        print STDERR "Transfer aborted, $error\n";
        $cv->send;
    }
)->multi_get_file;

$cv->recv;

sub usage {
    die "Usage: $progname [-a] <url> [-n] <10>\n";
}

sub fbytes {
    my $n = int(shift);
    if ($n >= 1024 * 1024) {
        return sprintf "%.3g MB", $n / (1024.0 * 1024);
    }
    elsif ($n >= 1024) {
        return sprintf "%.3g KB", $n / 1024.0;
    }
    else {
        return "$n bytes";
    }
}