perlでdownload speedに制限をかける

なぜかhttp getのときdownload speedに制限をかける必要が度々発生するので、そのやり方を考えてみた。

dataをgetして、data取りすぎのときテキトーにsleepを入れれば一応達成できた。

LWP::UserAgent, HTTP::Tiny でのやり方は以下。

use strict;
use warnings;
use LWP::UserAgent;
use HTTP::Tiny;
use Time::HiRes ();

my $LIMIT_UNIT_SECOND = 0.001;

sub limit_data_callback {
    my ($fh, $limit_bps) = @_;
    my $previous = [ [Time::HiRes::gettimeofday], 0 ];
    sub {
        print {$fh} $_[0];
        my $elapsed = Time::HiRes::tv_interval($previous->[0]);
        return 1 if $elapsed < $LIMIT_UNIT_SECOND;
        my $sleep = 8 * (tell($fh) - $previous->[1]) / $limit_bps - $elapsed;
        if ($sleep > 0) {
            select undef, undef, undef, $sleep;
            $previous->[0] = [Time::HiRes::gettimeofday];
            $previous->[1] = tell($fh);
        }
    };
}

my $url = "http://www.cpan.org/src/5.0/perl-5.22.0.tar.gz";
my $limit_bps = 10 * (1024**2); # 10Mbps

# LWP::UserAgent
open my $fh_lwp, ">", "lwp-perl-5.22.0.tar.gz" or die;
binmode $fh_lwp;
my $res_lwp = LWP::UserAgent->new
    ->get($url, ':content_cb' => limit_data_callback($fh_lwp, $limit_bps));
close $fh_lwp;

# HTTP::Tiny
open my $fh_tiny, ">", "tiny-perl-5.22.0.tar.gz" or die;
binmode $fh_tiny;
my $res_tiny = HTTP::Tiny->new
    ->get($url, {data_callback => limit_data_callback($fh_tiny, $limit_bps)});
close $fh_tiny;

これでだいたい10Mbpsに制限できる。

HTTP::Tiny->mirrorについてはmoduleにまとめてみた。 https://github.com/shoichikaji/HTTP-Tiny-Bandwidth

もっといいやり方ありましたら教えてください。