perl - Memory leak in program that uses LWP::UserAgent to download a file -
i trying revive perl script using long time ago. downloading files cloud storage local client. i'm pretty sure worked fine then, having issue lwp::useragent
downloads file entirely memory before writing disk. expected , former behaviour should write chunks of received file target during download.
i'm trying on osx perl 5.16.3 , 5.18 , tried on windows not know perl version more. pretty confident related perl version, not know used , want know changed.
sub downloadfile { $url = shift; $filename = shift; $temp_filename = shift; $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 , !$options{'no-resume'} ) { @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 create download file: $!"; binmode download; $last_tick = time(); $host = "myhost"; if ( $url =~ m/http:\/\/(.*?)\//gi ) { $host = $1; } $agent->credentials( $host . ":80", "login required", $config->{"account_name"}, $config->{"account_password"} ); $response = $agent->get( $url, ':content_cb' => \&didreceivedata, ':read_size_hint' => ( 2**14 ) ); close download; @stat = stat($temp_filename); $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 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 { ( $data, $cb_response, $protocol ) = @_; #my($response, $ua, $h, $data) = @_; $data_size = scalar( length($data) ); $received_size += $data_size; $speed_count += $data_size; $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 , $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; }
output:
mun-m-sele:putio-perl-folder-sync sele$ perl putiosync.pl syncing folder 'test' '/users/sele/downloads/test'... 1 files queued 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
so output expected but still output appears after file has been loaded memory.
the content_cb
not called during download (tested putting print("cb")
top of didreceivedata
update
i found out works expected on windows strawberry perl 5.16.2. can provide package versions if tell me , how ;)
your own code contains lot of irrelevances, resume support, multiple server support, progress logging, site credentials, temporary download files, error handling, , average speed calculations. none of these relevant core problem described, , why asked create minimal, complete, , verifiable example. don't understand refusal, or why seem clinging idea error in perl , not in own code
without that, can demonstrate technique works well. here sort of thing should have generated demonstration of problem. little different own code, , works fine. downloads official iso image of ubuntu desktop distribution 1.4gb of information. process uses steady 17mb of memory , finishes in 14 minutes. size of resultant file matches content-length
specified in http header
beyond no 1 can further. encourage accept of experts when have asked it. it's worth noting problem revealed process of creating mcve faulty program: delete non-essential part of code , find issue has disappeared
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; $ua = lwp::useragent->new; $expected; { $res = $ua->head(iso_url); $expected = $res->header('content-length'); printf "expected file size %.3fmb\n", $expected / 1024**2; } ($iso_file) = iso_url =~ m{([^/]+)\z}; open $iso_fh, '>:raw', $iso_file or die $!; $total; $pc = 0; { $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 %.3fmb\n", (-s $iso_file) / 1024**2; } sub content_cb { ( $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++; } }
output
expected file size 1417.047mb 0% 1% 2% 3% 4% 5% : : 95% 96% 97% 98% 99% 200 ok final file size 1417.047mb
Comments
Post a Comment