Perl：如何循环下载大型zip文件并提供反馈

Question

Using Perl, how do I download a large zip file from a web server, and while it's downloading, post status messages? I tried LWP::Simple 's getstore() and turned on $ua->show_progress(1) , but it hangs while it's downloading and I can't provide feedback over POSIX Named Pipes to another application.

Answer 1

After the comments on this answer specified the problems more precisely then your question you might try below. This forks a child with the download and in the master you will be able to read the progress information from a file descriptor.

Nevertheless, a much better interaction between the download and your program which handles the progress might be possible, because in my opinion forking a process just so that the download can somehow displayed is ugly. But this part of the download feedback depends mostly on the way you've designed your progress showing application, and this design is unknown too me.

use strict;
use warnings;
use LWP::UserAgent;

my $url = "http://...";
my $file = "outputfile";

pipe my $rfh, my $wfh;
defined( my $pid = fork() ) or die "fork failed: $!";
if ($pid == 0) {
    # download in child, redirect progress to pipe
    close($rfh);
    $wfh->autoflush(1);
    open(STDERR,">&",$wfh) || die $!;
    close($wfh);

    my $ua = LWP::UserAgent->new;
    $ua->show_progress(1);
    $ua->get($url, ':content_file' => $file );
    exit;
}

# read in master from pipe
close($wfh);
$SIG{CHLD} = 'IGNORE';
while (sysread($rfh, my $buf, 8192,0)) {
    print "progress... $buf\n";
}

Answer 2

#!/usr/bin/perl
use strict;
use warnings;
use LWP::Simple qw($ua getstore);
use POSIX qw(WNOHANG);

my $sURL = "http://example.com/example.zip";
my $sSaveFile = "/tmp/download.zip";

# it's probably a good idea to first check the server with a HEAD request on the URL before wasting time on a download. 
# But, besides that, here you go...

my $sMessage = "Downloading";
my $pid = fork(); 
if ($pid == 0) {
  getstore($sURL,$sSaveFile);
  exit;
}
do {
    # here, I print, but you could also provide feedback via Named Pipes or some other mechanism
    # you might also want to do a byte check to see if the file size is increasing, and if not, increase a flag counter, and if you hit like 5 flags, give up on the download with a "last" statement.
    # remember, byte checks can easily be done with: my $nBytes = (-s $sSaveFile);
    print "$sMessage\n";
    $sMessage .= '.';
    sleep(2);
} while (waitpid($pid, WNOHANG)==0);
print "\n\nDONE\n\n";

I found I had to do it this way instead of shelling out and running curl because on OSX Lion, it has a bug with Curl timing out after 30 seconds when used in a piped process, while versions of OSX after that no longer had this bug.