Perl LWP POST上传的进度指示器

Question

我正在研究Perl脚本,该脚本使用POST请求上传大文件.我的问题是,是否有可能有状态输出,因为上传大文件可能需要一些时间与我的互联网连接.

我的意思是像状态栏一样

$| = 1;
print "\r|---------->                   | 33%";
print "\r|-------------------->         | 66%";
print "\r|------------------------------| 100%\n";

这是我的上传代码:

my $ua=LWP::UserAgent->new();
$file = "my_big_holyday_vid.mp4";

$user = "username";
$pass = "password";

print "starting Upload...\n";
$res = $ua->post(
                  "http://$server",
                  Content_Type => 'form-data',
                  Content =>[
                    fn => ["$file" => $file],
                    username => $user,
                    password => $pass,
                  ],
                );
print "Upload complete!\n"

Answer 1

如果查看文档,HTTP::Request::Common您将看到,如果设置$HTTP::Request::Common::DYNAMIC_FILE_UPLOAD为true值,则请求对象的content方法将提供用于获取块中数据的回调.

通常,每次上传需要更多数据时都会调用此方法,但您可以将其包装在自己的子例程中以监控上载进度.

下面的程序给出了一个例子.如您所见,HTTP::Request创建了对象(我假设该fn字段应该只是[$file]),并且该content方法用于获取回调子例程.

子例程wrapper只是$callback在第一行调用以获取下一个数据块,并在最后一行返回它,就像它$callback本身一样.在这两行之间你可以添加你喜欢的东西,只要它不会干扰将块传递回LWP.在这种情况下,我已经打印了每个块的大小以及每次调用到目前为止上传的百分比.

出于百分比计算的目的,可以访问文件的完整大小$req->header('content-length'),这比-s在文件上使用更正确.

此外,如果需要,可以检测最后的迭代,因为回调将返回大小为零的块.

请注意,这是未经测试的,只要它编译并做大致正确的事情,因为我没有可用的互联网服务需要文件上传.

use strict;
use warnings;

use LWP;
use HTTP::Request::Common;
$HTTP::Request::Common::DYNAMIC_FILE_UPLOAD = 1;

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

my $server        = 'example.com';
my $file          = 'my_big_holyday_vid.mp4';
my ($user, $pass) = qw/ username password /;

print "Starting Upload...\n";

my $req = POST "http://$server",
  Content_Type => 'form-data',
  Content => [
    fn => [$file],
    username => $user,
    password => $pass,
  ];

my $total;
my $callback = $req->content;
my $size = $req->header('content-length');
$req->content(\&wrapper);
my $resp = $ua->request($req);

sub wrapper {
  my $chunk = $callback->();

  if ($chunk) {
    my $length = length $chunk;
    $total += $length;
    printf "%+5d = %5.1f%%\n", $length, $total / $size * 100;
  }
  else {
    print "Completed\n";
  }

  $chunk;
}