Question

我正在尝试恢复我很久以前使用的Perl脚本。它用于将文件从云存储下载到本地客户端。我非常确定它当时工作正常，但现在我遇到的问题是LWP::UserAgent在将文件写入磁盘之前将文件完全下载到内存中。预期和以前的行为是它应该在下载期间将接收文件的块写入目标。

我现在正在使用Perl 5.16.3和5.18在OSX上尝试它，并且还在Windows上尝试过它，但我不再知道Perl版本了。我非常有信心这与Perl版本有关，但我不知道我当时使用过哪个，我想知道发生了什么变化。

sub downloadFile {

    my $url           = shift;
    my $filename      = shift;
    my $temp_filename = shift;
    my $expected_size = shift;

    (   $download_size, $received_size, $avg_speed,   $avg_speed_s, $avg_speed_q,
        $speed_count,   $speed,         $byte_offset, $http_status
    ) = ( 0, 0, 0, 0, 0, 0, 0, 0, 0 );

    if ( -e $temp_filename and !$options{'no-resume'} ) {

        my @stat = stat($temp_filename);

        if ( $expected_size > $stat[7] ) {
            $byte_offset   = $stat[7];
            $received_size = $stat[7];
        }
    }

    open DOWNLOAD, ( $byte_offset > 0 ) ? ">>" : ">", $temp_filename
            or die "Unable to create download file: $!";
    binmode DOWNLOAD;

    $last_tick = time();

    my $host = "myhost";

    if ( $url =~ m/http:\/\/(.*?)\//gi ) {
        $host = $1;
    }

    $agent->credentials(
            $host . ":80",
            "Login Required",
            $config->{"account_name"},
            $config->{"account_password"} );

    my $response = $agent->get(
            $url,
            ':content_cb'     => \&didReceiveData,
            ':read_size_hint' => ( 2**14 ) );

    close DOWNLOAD;

    my @stat        = stat($temp_filename);
    my $actual_size = $stat[7];

    if ( ! $response->is_success() ) {

        printfvc( 0,
                "\rDownload failed: %s",
                'red',
                $response->status_line() );

        return 0;
    }
    elsif ( $actual_size != $expected_size ) {

        printfvc( 0,
                "\rDownloaded file does not have expected size (%s vs. %s)",
                'red',
                $actual_size, $expected_size );

        return 0;
    }
    else {

        rename $temp_filename, $filename;

        printfvc( 0,
                "\rDownload succeeded                                                           ",
                'green' );

        return 1;
    }
}

sub didReceiveData {

    my ( $data, $cb_response, $protocol ) = @_;

    #my($response, $ua, $h, $data) = @_;
    my $data_size = scalar( length($data) );
    $received_size += $data_size;
    $speed_count   += $data_size;

    my $now = time();

    if ( $last_tick < $now ) {
        $speed       = $speed_count;
        $speed_count = 0;
        $last_tick   = $now;
        $avg_speed_q++;
        $avg_speed_s += $speed;
        $avg_speed = $avg_speed_s / $avg_speed_q;
    }

    if ( $download_size > 0 and $http_status eq "200" or $http_status eq "206" ) {

        print DOWNLOAD $data;

        printf("-> %.1f %% (%s of %s, %s/s) %s      ",
                ( $received_size / $download_size ) * 100,
                fsize($received_size),
                fsize($download_size),
                fsize($speed),
                $avg_speed_q > 3
                ? fduration( ( $download_size - $received_size ) / $avg_speed ) . " remaining"
                : ""
        ) if ( $verbosity >= 0 );
    }
    else {
        printf("-> Initiating transfer...") if ( $verbosity >= 0 );
    }

    return 1;
}

输出：

mun-m-sele:PutIO-Perl-folder-sync sele$ perl putiosync.pl 
Syncing folder 'Test' to '/Users/sele/Downloads/Test'...
1 files queued to download
5MB.zip
Fetching '5MB.zip' [1 of 1]

-> 0.3 % (16.0 kiB of 5.0 MiB, 16.0 kiB/s)       
-> 0.6 % (32.0 kiB of 5.0 MiB, 16.0 kiB/s)       
-> 0.9 % (48.0 kiB of 5.0 MiB, 16.0 kiB/s)       
 .
 . 
 .      
-> 99.1 % (5.0 MiB of 5.0 MiB, 16.0 kiB/s)       
-> 99.4 % (5.0 MiB of 5.0 MiB, 16.0 kiB/s)       
-> 99.7 % (5.0 MiB of 5.0 MiB, 16.0 kiB/s)       
Download succeeded

因此输出符合预期但是此输出仅在文件加载到内存后才会出现。

下载期间未调用content_cb（只需将print("cb")放在didReceiveData的顶部进行测试

更新

我发现它在Windows Strawberry Perl 5.16.2上按预期工作。如果你告诉我哪些以及如何，我可以为你提供包装版本;）

Answer 1

您自己的代码包含许多不相关的内容，例如简历支持，多服务器支持，进度日志记录，站点凭据，临时下载文件，错误处理和平均速度计算。这些都与您描述的核心问题无关，这就是我要求您创建Minimal, Complete, and Verifiable example的原因。我不理解你的拒绝，或者为什么你似乎坚持认为错误是在Perl而不在你自己的代码中

没有它，我所能做的就是证明这项技术运作良好。这是你应该产生的一种事情，作为问题的演示。它与您自己的代码差别很小，而且运行正常。它下载了Ubuntu桌面发行版的官方ISO映像，大约有1.4GB的信息。该过程使用稳定的17MB内存，并在14分钟内完成。结果文件的大小与HTTP标头

中指定的Content-Length完全匹配

除此之外，没有人可以帮助你。我鼓励您在提出要求时接受专家的帮助。同样值得注意的是，通过从错误的程序创建 MCVE 的过程经常会发现问题：您很可能删除代码的非必要部分并找到这个问题已经消失了

use strict;
use warnings 'all';

use LWP;

use constant ISO_URL => 'http://releases.ubuntu.com/16.04/ubuntu-16.04-desktop-amd64.iso';

STDOUT->autoflush;

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

my $expected;
{
    my $res = $ua->head(ISO_URL);
    $expected = $res->header('Content-Length');
    printf "Expected file size is %.3fMB\n",  $expected / 1024**2;
}

my ($iso_file) = ISO_URL =~ m{([^/]+)\z};
open my $iso_fh, '>:raw', $iso_file or die $!;
my $total;
my $pc = 0;

{
    my $res = $ua->get(
        ISO_URL,
        ':content_cb'     => \&content_cb,
        ':read_size_hint' => 16 * 1024,
    );

    close $iso_fh or die $!;

    print $res->status_line, "\n";
    printf "Final file size is %.3fMB\n", (-s $iso_file) / 1024**2;
}

sub content_cb {

    my ( $data, $res ) = @_;

    die $res->status_line unless $res->is_success;

    print $iso_fh $data;

    $total += length $data;
    while ( $pc < 100 * $total / $expected ) {
        printf "%3d%%\n", $pc++;
    }
}

输出

Expected file size is 1417.047MB
  0%
  1%
  2%
  3%
  4%
  5%
  :
  :
 95%
 96%
 97%
 98%
 99%
200 OK
Final file size is 1417.047MB

Answer 2

问题在于文件I / O而不是LWP吗？我假设在关闭文件之前，数据没有被刷新到文件中。

下面是关于如何使文件处理刷新数据到硬盘的示例代码：

{ my $ofh = select LOG;
  $| = 1;
  select $ofh;
}

查看perldoc -q flush以及有关缓冲的有趣文章，＆＃34; Suffering from Buffering?＆＃34;。

Answer 3

您的代码存在的主要问题是永远不会分配$http_status。它只能通过回调didReceiveData设置，或者在get呼叫退出后完成整个下载后

但是你的回调在打印到DOWNLOAD文件句柄之前测试$http_status eq "200"（应该是$cb_response->is_success），所以什么都写不出来

我可以相信你的代码会升级内存，因为它无休止地将-> Initiating transfer...打印到STDOUT，但由于未经测试的HTTP状态，所以不会将任何内容写入临时文件。我确信您看到您的进程运行并因 Out of memory 错误而死亡，并立即指责Perl，甚至没有尝试下载1KB文件。你的代码从来没有工作过，而那些对你有帮助的人的问题和支持是令人愤慨的

“我很确定它当时工作正常”不是一个好的开始，但是当你在此基础上拒绝解决方案的所有应用程序或信息请求时，你就是太荒谬了

使用LWP :: UserAgent下载文件

3 个答案:

输出