Продолжить получение частично загруженного файла

Question

Существует ли Perl-инструмент, который ведет себя как wget --continue и может продолжать получать частично загруженный файл?

Answer 1

Документация

AnyEvent::HTTP содержит код, который использует возможность HTTP 1.1 для возобновления загрузки.Я никогда не использовал его, поэтому не могу комментировать его пригодность.

Видимо, пример ожидает, что вы уже знаете, как использовать AnyEvent, что, конечно, я сделалне знаю.Вам нужно изменить код, чтобы цикл событий, который он ожидал, уже был готов:

#!/usr/bin/perl

use strict;
use warnings;

use AnyEvent::HTTP;

my $url  = "http://localhost/foo.txt";
my $file = "foo.txt";

sub download {
    my ($url, $file, $cb) = @_;

    open my $fh, "+>>:raw", $file
        or die "could not open $file: $!";

    my %hdr;
    my $ofs = 0;

    if (stat $fh and $ofs = -s _) {
        $hdr{"if-unmodified-since"} = AnyEvent::HTTP::format_date((stat _)[9]);
        $hdr{"range"} = "bytes=$ofs-";
    }

    http_get $url, (
        headers   => \%hdr,
        on_header => sub {
            my ($hdr) = @_;

            if ($hdr->{Status} == 200 && $ofs) {
                # resume failed
                truncate $fh, $ofs = 0;
            }

            sysseek $fh, $ofs, 0;

            return 1;
        },
        on_body   => sub {
            my ($data, $hdr) = @_;

            if ($hdr->{Status} =~ /^2/) {
                length $data == syswrite $fh, $data
                    or return; # abort on write errors
            }

            return 1;
        },
        sub {
            my (undef, $hdr) = @_;

            my $status = $hdr->{Status};

            if (my $time = AnyEvent::HTTP::parse_date $hdr->{"last-modified"}) {
                utime $fh, $time, $time;
            }

            if ($status == 200 || $status == 206 || $status == 416) {
                # download ok || resume ok || file already fully downloaded
                $cb->(1, $hdr);

            } elsif ($status == 412) {
                # file has changed while resuming, delete and retry
                unlink $file;
                $cb->(0, $hdr);

            } elsif ($status == 500 or $status == 503 or $status =~ /^59/) {
                # retry later
                $cb->(0, $hdr);

            } else {
                $cb->(undef, $hdr);
            }
        }
    );
}

my $quit = AnyEvent->condvar; #create a handle to exit the loop

download $url, $file, sub {
    if ($_[0]) {
        print "OK!\n";
    } elsif (defined $_[0]) {
        print "please retry later\n";
    } else {
        print "ERROR\n";
    }
    $quit->send; #quit the loop
};

$quit->recv; #start the loop

Ключом к его работе является условная переменная $quit:

my $quit = AnyEvent->condvar; #handle to exit the loop
.
.
.
$quit->recv;

Это устанавливает цикл событий.Без цикла событий программа завершает работу до того, как вызов http_get получит возможность что-либо сделать, кроме создания файла.Чтобы выйти из цикла обработки событий, мы вызываем $quit->send в обратном вызове функции download.

Answer 2

Пробовал (2 раза) и все заработало.

#!/usr/local/bin/perl
use warnings;
use 5.014;
use utf8;
use LWP::UserAgent;
use File::Basename;

my $url = 'http://server/somelargefile';
my $file = basename $url;
my $ua = LWP::UserAgent->new( show_progress => 1 );

open my $fh, '>>:raw', $file or die $!; 
my $bytes = -s $file;
my $res;       
if ( $bytes ) { 
    say "resume download: $file ($bytes)";
    $res = $ua->get( 
        $url,
        'Range' => "bytes=$bytes-",
        ':content_cb' => sub { my ( $chunk ) = @_; print $fh $chunk; }
    );
} else {
    say "start download";
    $res = $ua->get( 
        $url,
        ':content_cb' => sub { my ( $chunk ) = @_; print $fh $chunk; } 
    );
}
close $fh;

my $status = $res->status_line;
if ( $status =~ /^(200|206|416)/ ) {
    say "OK" if $status =~ /^20[06]/;
    say "$file already downloaded" if $status =~ /^416/;
} else {
    say $status;
}

Answer 3

Я нашел это с помощью Google (нужны были конкретные условия поиска, не говоря о GIYF). Ссылка на Google Translate .

Пример кода, который у них там есть,

use strict;
use LWP::UserAgent;

my $u = "http://www.mangafox.com/media/manga.banner.png";
my $f = "tmp.jpg"; 

my $ua = LWP::UserAgent->new();

## Uncomment for test
# unlink $f;
# system("cp tmp.jpg tmp0.jpg");
# system( "head -c 10000 tmp0.jpg > tmp.jpg" );

download($u, $f);

sub download  {
    my ($url, $file) = @_;

    my ($tries, @parameters, $FD);

    @parameters = ( $url,                  
                    ":content_cb" => sub { my ($chunk) = @_;
                                           print $FD $chunk;
                                         } 
                  ); 
    $tries = 4;

    while ( $tries ) {

        open($FD, ">>$file") || die "ERROR: $!";      

        my $bytes = -s $file;        
        if ( $bytes > 0 ) { push(@parameters, "Range" => "bytes=$bytes-" ) }

        my $res =$ua->get( @parameters );
        print $res->status_line . "\n";
        close $FD;

        # 416 Requested Range Not Satisfiable
        # (file already fully downloaded)

        if ( $res->is_success || $res->code == 416 ) { return }        
        $tries --;
    }

    die "ERROR: download $url";   
}

# Test with ImageMagick
system("identify tmp.jpg");

Я не говорю, что это работает или подходит вам.Просто то, что я нашел.Используйте на свой страх и риск.