#!/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 的版本:
=head1 AUTHOR
fukai <iakuf@163.com>
=cut
use strict;
use AE;
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,
path => $dest || $filename,
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;
}
)->start;
$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";
}
}