3 eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
4 if 0; # not running under some shell
8 lwp-download - Fetch large files from the web
12 B<lwp-download> [B<-a>] <I<url>> [<I<local path>>]
16 The B<lwp-download> program will save the file at I<url> to a local
19 If I<local path> is not specified, then the current directory is
22 If I<local path> is a directory, then the basename of the file to save
23 is picked up from the Content-Disposition header or the URL of the
24 response. If the file already exists, then B<lwp-download> will
25 prompt before it overwrites and will fail if its standard input is not
26 a terminal. This form of invocation will also fail is no acceptable
27 filename can be derived from the sources mentioned above.
29 If I<local path> is not a directory, then it is simply used as the
32 The I<lwp-download> program is implemented using the I<libwww-perl>
33 library. It is better suited to down load big files than the
34 I<lwp-request> program because it does not store the file in memory.
35 Another benefit is that it will keep you updated about its progress
36 and that you don't have much options to worry about.
38 Use the C<-a> option to save the file in text (ascii) mode. Might
39 make a difference on dosish systems.
43 Fetch the newest and greatest perl version:
45 $ lwp-download http://www.perl.com/CPAN/src/latest.tar.gz
46 Saving to 'latest.tar.gz'...
47 11.4 MB received in 8 seconds (1.43 MB/sec)
51 Gisle Aas <gisle@aas.no>
55 #' get emacs out of quote mode
59 use LWP::UserAgent ();
60 use LWP::MediaTypes qw(guess_media_type media_suffix);
65 $progname =~ s,.*/,,; # only basename left in progname
66 $progname =~ s,.*\\,, if $^O eq "MSWin32";
67 $progname =~ s/\.\w*$//; # strip extension if any
72 unless (getopts('a', \%opt)) {
76 my $url = URI->new(shift || usage());
78 usage() if defined($argfile) && !length($argfile);
79 my $VERSION = "5.813";
81 my $ua = LWP::UserAgent->new(
82 agent => "lwp-download/$VERSION ",
87 my $file; # name of file we download into
88 my $length; # total number of bytes to download
89 my $flength; # formatted length
90 my $size = 0; # number of bytes received
91 my $start_t; # start time of download
92 my $last_dur; # time of last callback
94 my $shown = 0; # have we called the show() function yet
96 $SIG{INT} = sub { die "Interrupted\n"; };
100 my $res = $ua->request(HTTP::Request->new(GET => $url),
102 unless(defined $file) {
106 if (defined $argfile && -d $argfile) {
107 ($directory, $argfile) = ($argfile, undef);
110 unless (defined $argfile) {
111 # find a suitable name to use
112 $file = $res->filename;
114 # if this fails we try to make something from the URL
116 my $req = $res->request; # not always there
117 my $rurl = $req ? $req->url : $url;
119 $file = ($rurl->path_segments)[-1];
120 if (!defined($file) || !length($file)) {
122 my $suffix = media_suffix($res->content_type);
123 $file .= ".$suffix" if $suffix;
125 elsif ($rurl->scheme eq 'ftp' ||
126 $file =~ /\.t[bg]z$/ ||
127 $file =~ /\.tar(\.(Z|gz|bz2?))?$/
129 # leave the filename as it was
132 my $ct = guess_media_type($file);
133 unless ($ct eq $res->content_type) {
134 # need a better suffix for this type
135 my $suffix = media_suffix($res->content_type);
136 $file .= ".$suffix" if $suffix;
141 # validate that we don't have a harmful filename now. The server
142 # might try to trick us into doing something bad.
143 if (!length($file) ||
144 $file =~ s/([^a-zA-Z0-9_\.\-\+\~])/sprintf "\\x%02x", ord($1)/ge)
146 die "Will not save <$url> as \"$file\".\nPlease override file name on the command line.\n";
149 if (defined $directory) {
151 $file = File::Spec->catfile($directory, $file);
154 # Check if the file is already present
156 die "Will not save <$url> to link \"$file\".\nPlease override file name on the command line.\n";
159 die "Will not save <$url> as \"$file\" without verification.\nEither run from terminal or override file name on the command line.\n"
162 print "Overwrite $file? [y] ";
164 unless (defined($ans) && $ans =~ /^y?\n/) {
166 print "Ok, aborting.\n";
169 print "\nAborting.\n";
176 die "Will not save <$url> as \"$file\". Path exists.\n";
179 print "Saving to '$file'...\n";
185 open(FILE, ">$file") || die "Can't open $file: $!\n";
186 binmode FILE unless $opt{a};
187 $length = $res->content_length;
188 $flength = fbytes($length) if defined $length;
193 print FILE $_[0] or die "Can't write to $file: $!\n";
194 $size += length($_[0]);
196 if (defined $length) {
197 my $dur = time - $start_t;
198 if ($dur != $last_dur) { # don't update too often
200 my $perc = $size / $length;
202 $speed = fbytes($size/$dur) . "/sec" if $dur > 3;
203 my $secs_left = fduration($dur/$perc - $dur);
204 $perc = int($perc*100);
205 my $show = "$perc% of $flength";
206 $show .= " (at $speed, $secs_left remaining)" if $speed;
211 show( fbytes($size) . " received");
217 close(FILE) || die "Can't write to $file: $!\n";
219 show(""); # clear text
222 print " of ", fbytes($length) if defined($length) && $length != $size;
224 my $dur = time - $start_t;
226 my $speed = fbytes($size/$dur) . "/sec";
227 print " in ", fduration($dur), " ($speed)";
231 if (my $mtime = $res->last_modified) {
232 utime time, $mtime, $file;
235 if ($res->header("X-Died") || !$res->is_success) {
236 if (my $died = $res->header("X-Died")) {
240 print "Transfer aborted. Delete $file? [n] ";
242 if (defined($ans) && $ans =~ /^y\n/) {
243 unlink($file) && print "Deleted.\n";
245 elsif ($length > $size) {
246 print "Truncated file kept: ", fbytes($length - $size), " missing\n";
249 print "File kept.\n";
254 print "Transfer aborted, $file kept\n";
260 # Did not manage to create any file
261 print "\n" if $shown;
262 if (my $xdied = $res->header("X-Died")) {
263 print "$progname: Aborted\n$xdied\n";
266 print "$progname: ", $res->status_line, "\n";
274 if ($n >= 1024 * 1024) {
275 return sprintf "%.3g MB", $n / (1024.0 * 1024);
278 return sprintf "%.3g KB", $n / 1024.0;
288 my $secs = int(shift);
289 my $hours = $secs / (60*60);
290 $secs -= $hours * 60*60;
291 my $mins = $secs / 60;
294 return "$hours hours $mins minutes";
297 return "$mins minutes";
301 return "$secs seconds";
307 my @ani = qw(- \ | /);
312 my($mess, $show_ani) = @_;
313 print "\r$mess" . (" " x (75 - length $mess));
314 print $show_ani ? "$ani[$ani++]\b" : " ";
322 die "Usage: $progname [-a] <url> [<lpath>]\n";