Last active
June 30, 2016 17:21
-
-
Save jmcveigh/a2d3edae98667f8873299ff2c82a45b1 to your computer and use it in GitHub Desktop.
This is a command application that will download a file and save to the specified filename showing a Tk progress bar window on the Desktop. (Tested @ 4.5GB)
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/perl | |
use strict; | |
use warnings; | |
use threads; | |
use threads::shared; | |
use Tk; | |
use Tk::ProgressBar; | |
use LWP; | |
use Fcntl qw(SEEK_END); | |
use constant AFTER_TID => 5000; | |
# now, check for passed URLs for downloading. | |
die "Regrettably, no URL was passed for processing.\n" unless $ARGV[0]; | |
die "Regrettably, no output filename was passed for saving.\n" unless $ARGV[1]; | |
die "Regrettably, the output file exists.\n" if -e $ARGV[1]; | |
my $p:shared = 0; | |
my $url:shared = $ARGV[0]; | |
my $path:shared = $ARGV[1]; | |
my $total_download_size:shared = get_file_size($url); | |
my $download_size:shared = 0; | |
my $fin:shared = 0; | |
my $thr = threads->new(\&worker)->detach; | |
my $mw = MainWindow->new(-width => 300, -height => 96); | |
my $f1 = $mw->Frame(-borderwidth => 2, -width => 296, -height => 92, -relief => 'groove')->pack(-side => 'top'); | |
my $message = <<"EOT"; | |
This is an example, written in the context of MAGNet #perl IRC, to download and save a large file to disk. | |
EOT | |
$f1->Label(-text => $message,-wraplength => 280)->pack(-side => 'top'); | |
my $pb = $f1->ProgressBar( | |
-height => 10, | |
-length => 280, | |
-width => 10, | |
-from => 0, | |
-to => 100, | |
-blocks => 28, | |
-colors => [0, 'blue'], | |
)->pack(-side => 'top'); | |
my $out_file; | |
my $repeat1; | |
$repeat1 = $mw->repeat( | |
100 => sub { | |
$repeat1->cancel if $p == 100; | |
$pb->value($p); | |
} | |
); | |
my $repeat2; | |
$repeat2 = $mw->repeat( | |
100 => sub { | |
if ($fin) { | |
$repeat2->cancel; | |
my $r = $mw->messageBox(-type => 'Ok', -message => 'The file download has been completed successfully.'); | |
if ($r eq 'Ok') { | |
exit; | |
} | |
} | |
} | |
); | |
MainLoop; | |
sub worker { | |
open($out_file, "> $path") or die "Couldn't open $path for writing: $!\n"; | |
binmode($out_file); | |
select($out_file); | |
$|++; | |
select(STDOUT); | |
my $ua = LWP::UserAgent->new(); | |
my $response = $ua->get($url, ':content_cb' => \&callback, ); | |
close ($out_file); | |
$fin = 1; | |
} | |
# per chunk. | |
sub callback { | |
my ($data, $response, $protocol) = @_; | |
seek($out_file, 0, SEEK_END);a | |
$download_size += length($data); | |
$p = sprintf("%d",$download_size / $total_download_size * 100); | |
print $out_file $data; | |
} | |
sub get_file_size { | |
my $url = shift; | |
my $ua = new LWP::UserAgent; | |
$ua->agent("Mozilla/5.0"); | |
my $req = new HTTP::Request 'HEAD' => $url; | |
$req->header('Accept' => 'text/html'); | |
my $res = $ua->request($req); | |
if ($res->is_success) { | |
my $headers = $res->headers; | |
return $headers->content_length; | |
} | |
return 0; | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment