Perl LWP POST上傳進度指示器

Question

我正在使用POST請求上傳大文件的Perl腳本。我的問題是，如果可能有狀態輸出，因爲上傳大文件可能需要一些時間與我的互聯網連接。

我的意思是像

$| = 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 value，那麼請求對象的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; 
}