summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/bin/lwp-download
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/bin/lwp-download')
-rwxr-xr-xMaster/tlpkg/tlperl/bin/lwp-download320
1 files changed, 0 insertions, 320 deletions
diff --git a/Master/tlpkg/tlperl/bin/lwp-download b/Master/tlpkg/tlperl/bin/lwp-download
deleted file mode 100755
index a85ac551d9f..00000000000
--- a/Master/tlpkg/tlperl/bin/lwp-download
+++ /dev/null
@@ -1,320 +0,0 @@
-#!/usr/bin/perl -w
-
-=head1 NAME
-
-lwp-download - Fetch large files from the web
-
-=head1 SYNOPSIS
-
-B<lwp-download> [B<-a>] <I<url>> [<I<local path>>]
-
-=head1 DESCRIPTION
-
-The B<lwp-download> program will save the file at I<url> to a local
-file.
-
-If I<local path> is not specified, then the current directory is
-assumed.
-
-If I<local path> is a directory, then the basename of the file to save
-is picked up from the Content-Disposition header or the URL of the
-response. If the file already exists, then B<lwp-download> will
-prompt before it overwrites and will fail if its standard input is not
-a terminal. This form of invocation will also fail is no acceptable
-filename can be derived from the sources mentioned above.
-
-If I<local path> is not a directory, then it is simply used as the
-path to save into.
-
-The I<lwp-download> program is implemented using the I<libwww-perl>
-library. It is better suited to down load big files than the
-I<lwp-request> program because it does not store the file in memory.
-Another benefit is that it will keep you updated about its progress
-and that you don't have much options to worry about.
-
-Use the C<-a> option to save the file in text (ascii) mode. Might
-make a difference on dosish systems.
-
-=head1 EXAMPLE
-
-Fetch the newest and greatest perl version:
-
- $ lwp-download http://www.perl.com/CPAN/src/latest.tar.gz
- Saving to 'latest.tar.gz'...
- 11.4 MB received in 8 seconds (1.43 MB/sec)
-
-=head1 AUTHOR
-
-Gisle Aas <gisle@aas.no>
-
-=cut
-
-#' get emacs out of quote mode
-
-use strict;
-
-use LWP::UserAgent ();
-use LWP::MediaTypes qw(guess_media_type media_suffix);
-use URI ();
-use HTTP::Date ();
-
-my $progname = $0;
-$progname =~ s,.*/,,; # only basename left in progname
-$progname =~ s,.*\\,, if $^O eq "MSWin32";
-$progname =~ s/\.\w*$//; # strip extension if any
-
-#parse option
-use Getopt::Std;
-my %opt;
-unless (getopts('a', \%opt)) {
- usage();
-}
-
-my $url = URI->new(shift || usage());
-my $argfile = shift;
-usage() if defined($argfile) && !length($argfile);
-my $VERSION = "5.827";
-
-my $ua = LWP::UserAgent->new(
- agent => "lwp-download/$VERSION ",
- keep_alive => 1,
- env_proxy => 1,
-);
-
-my $file; # name of file we download into
-my $length; # total number of bytes to download
-my $flength; # formatted length
-my $size = 0; # number of bytes received
-my $start_t; # start time of download
-my $last_dur; # time of last callback
-
-my $shown = 0; # have we called the show() function yet
-
-$SIG{INT} = sub { die "Interrupted\n"; };
-
-$| = 1; # autoflush
-
-my $res = $ua->request(HTTP::Request->new(GET => $url),
- sub {
- unless(defined $file) {
- my $res = $_[1];
-
- my $directory;
- if (defined $argfile && -d $argfile) {
- ($directory, $argfile) = ($argfile, undef);
- }
-
- unless (defined $argfile) {
- # find a suitable name to use
- $file = $res->filename;
-
- # if this fails we try to make something from the URL
- unless ($file) {
- my $req = $res->request; # not always there
- my $rurl = $req ? $req->uri : $url;
-
- $file = ($rurl->path_segments)[-1];
- if (!defined($file) || !length($file)) {
- $file = "index";
- my $suffix = media_suffix($res->content_type);
- $file .= ".$suffix" if $suffix;
- }
- elsif ($rurl->scheme eq 'ftp' ||
- $file =~ /\.t[bg]z$/ ||
- $file =~ /\.tar(\.(Z|gz|bz2?))?$/
- ) {
- # leave the filename as it was
- }
- else {
- my $ct = guess_media_type($file);
- unless ($ct eq $res->content_type) {
- # need a better suffix for this type
- my $suffix = media_suffix($res->content_type);
- $file .= ".$suffix" if $suffix;
- }
- }
- }
-
- # validate that we don't have a harmful filename now. The server
- # might try to trick us into doing something bad.
- if (!length($file) ||
- $file =~ s/([^a-zA-Z0-9_\.\-\+\~])/sprintf "\\x%02x", ord($1)/ge)
- {
- die "Will not save <$url> as \"$file\".\nPlease override file name on the command line.\n";
- }
-
- if (defined $directory) {
- require File::Spec;
- $file = File::Spec->catfile($directory, $file);
- }
-
- # Check if the file is already present
- if (-l $file) {
- die "Will not save <$url> to link \"$file\".\nPlease override file name on the command line.\n";
- }
- elsif (-f _) {
- die "Will not save <$url> as \"$file\" without verification.\nEither run from terminal or override file name on the command line.\n"
- unless -t;
- $shown = 1;
- print "Overwrite $file? [y] ";
- my $ans = <STDIN>;
- unless (defined($ans) && $ans =~ /^y?\n/) {
- if (defined $ans) {
- print "Ok, aborting.\n";
- }
- else {
- print "\nAborting.\n";
- }
- exit 1;
- }
- $shown = 0;
- }
- elsif (-e _) {
- die "Will not save <$url> as \"$file\". Path exists.\n";
- }
- else {
- print "Saving to '$file'...\n";
- }
- }
- else {
- $file = $argfile;
- }
- open(FILE, ">$file") || die "Can't open $file: $!\n";
- binmode FILE unless $opt{a};
- $length = $res->content_length;
- $flength = fbytes($length) if defined $length;
- $start_t = time;
- $last_dur = 0;
- }
-
- print FILE $_[0] or die "Can't write to $file: $!\n";
- $size += length($_[0]);
-
- if (defined $length) {
- my $dur = time - $start_t;
- if ($dur != $last_dur) { # don't update too often
- $last_dur = $dur;
- my $perc = $size / $length;
- my $speed;
- $speed = fbytes($size/$dur) . "/sec" if $dur > 3;
- my $secs_left = fduration($dur/$perc - $dur);
- $perc = int($perc*100);
- my $show = "$perc% of $flength";
- $show .= " (at $speed, $secs_left remaining)" if $speed;
- show($show, 1);
- }
- }
- else {
- show( fbytes($size) . " received");
- }
- }
-);
-
-if (fileno(FILE)) {
- close(FILE) || die "Can't write to $file: $!\n";
-
- show(""); # clear text
- print "\r";
- print fbytes($size);
- print " of ", fbytes($length) if defined($length) && $length != $size;
- print " received";
- my $dur = time - $start_t;
- if ($dur) {
- my $speed = fbytes($size/$dur) . "/sec";
- print " in ", fduration($dur), " ($speed)";
- }
- print "\n";
-
- if (my $mtime = $res->last_modified) {
- utime time, $mtime, $file;
- }
-
- if ($res->header("X-Died") || !$res->is_success) {
- if (my $died = $res->header("X-Died")) {
- print "$died\n";
- }
- if (-t) {
- print "Transfer aborted. Delete $file? [n] ";
- my $ans = <STDIN>;
- if (defined($ans) && $ans =~ /^y\n/) {
- unlink($file) && print "Deleted.\n";
- }
- elsif ($length > $size) {
- print "Truncated file kept: ", fbytes($length - $size), " missing\n";
- }
- else {
- print "File kept.\n";
- }
- exit 1;
- }
- else {
- print "Transfer aborted, $file kept\n";
- }
- }
- exit 0;
-}
-
-# Did not manage to create any file
-print "\n" if $shown;
-if (my $xdied = $res->header("X-Died")) {
- print "$progname: Aborted\n$xdied\n";
-}
-else {
- print "$progname: ", $res->status_line, "\n";
-}
-exit 1;
-
-
-sub fbytes
-{
- my $n = int(shift);
- if ($n >= 1024 * 1024) {
- return sprintf "%.3g MB", $n / (1024.0 * 1024);
- }
- elsif ($n >= 1024) {
- return sprintf "%.3g KB", $n / 1024.0;
- }
- else {
- return "$n bytes";
- }
-}
-
-sub fduration
-{
- use integer;
- my $secs = int(shift);
- my $hours = $secs / (60*60);
- $secs -= $hours * 60*60;
- my $mins = $secs / 60;
- $secs %= 60;
- if ($hours) {
- return "$hours hours $mins minutes";
- }
- elsif ($mins >= 2) {
- return "$mins minutes";
- }
- else {
- $secs += $mins * 60;
- return "$secs seconds";
- }
-}
-
-
-BEGIN {
- my @ani = qw(- \ | /);
- my $ani = 0;
-
- sub show
- {
- my($mess, $show_ani) = @_;
- print "\r$mess" . (" " x (75 - length $mess));
- print $show_ani ? "$ani[$ani++]\b" : " ";
- $ani %= @ani;
- $shown++;
- }
-}
-
-sub usage
-{
- die "Usage: $progname [-a] <url> [<lpath>]\n";
-}