5 lwp-download - Fetch large files from the web
9 B<lwp-download> [B<-a>] <I<url>> [<I<local path>>]
13 The B<lwp-download> program will save the file at I<url> to a local
16 If I<local path> is not specified, then the current directory is
19 If I<local path> is a directory, then the basename of the file to save
20 is picked up from the Content-Disposition header or the URL of the
21 response. If the file already exists, then B<lwp-download> will
22 prompt before it overwrites and will fail if its standard input is not
23 a terminal. This form of invocation will also fail is no acceptable
24 filename can be derived from the sources mentioned above.
26 If I<local path> is not a directory, then it is simply used as the
29 The I<lwp-download> program is implemented using the I<libwww-perl>
30 library. It is better suited to down load big files than the
31 I<lwp-request> program because it does not store the file in memory.
32 Another benefit is that it will keep you updated about its progress
33 and that you don't have much options to worry about.
35 Use the C<-a> option to save the file in text (ascii) mode. Might
36 make a difference on dosish systems.
40 Fetch the newest and greatest perl version:
42 $ lwp-download http://www.perl.com/CPAN/src/latest.tar.gz
43 Saving to 'latest.tar.gz'...
44 11.4 MB received in 8 seconds (1.43 MB/sec)
48 Gisle Aas <gisle@aas.no>
52 #' get emacs out of quote mode
56 use LWP::UserAgent ();
57 use LWP::MediaTypes qw(guess_media_type media_suffix);
62 $progname =~ s,.*/,,; # only basename left in progname
63 $progname =~ s,.*\\,, if $^O eq "MSWin32";
64 $progname =~ s/\.\w*$//; # strip extension if any
69 unless (getopts('a', \%opt)) {
73 my $url = URI->new(shift || usage());
75 usage() if defined($argfile) && !length($argfile);
76 my $VERSION = "5.813";
78 my $ua = LWP::UserAgent->new(
79 agent => "lwp-download/$VERSION ",
84 my $file; # name of file we download into
85 my $length; # total number of bytes to download
86 my $flength; # formatted length
87 my $size = 0; # number of bytes received
88 my $start_t; # start time of download
89 my $last_dur; # time of last callback
91 my $shown = 0; # have we called the show() function yet
93 $SIG{INT} = sub { die "Interrupted\n"; };
97 my $res = $ua->request(HTTP::Request->new(GET => $url),
99 unless(defined $file) {
103 if (defined $argfile && -d $argfile) {
104 ($directory, $argfile) = ($argfile, undef);
107 unless (defined $argfile) {
108 # find a suitable name to use
109 $file = $res->filename;
111 # if this fails we try to make something from the URL
113 my $req = $res->request; # not always there
114 my $rurl = $req ? $req->url : $url;
116 $file = ($rurl->path_segments)[-1];
117 if (!defined($file) || !length($file)) {
119 my $suffix = media_suffix($res->content_type);
120 $file .= ".$suffix" if $suffix;
122 elsif ($rurl->scheme eq 'ftp' ||
123 $file =~ /\.t[bg]z$/ ||
124 $file =~ /\.tar(\.(Z|gz|bz2?))?$/
126 # leave the filename as it was
129 my $ct = guess_media_type($file);
130 unless ($ct eq $res->content_type) {
131 # need a better suffix for this type
132 my $suffix = media_suffix($res->content_type);
133 $file .= ".$suffix" if $suffix;
138 # validate that we don't have a harmful filename now. The server
139 # might try to trick us into doing something bad.
140 if (!length($file) ||
141 $file =~ s/([^a-zA-Z0-9_\.\-\+\~])/sprintf "\\x%02x", ord($1)/ge)
143 die "Will not save <$url> as \"$file\".\nPlease override file name on the command line.\n";
146 if (defined $directory) {
148 $file = File::Spec->catfile($directory, $file);
151 # Check if the file is already present
153 die "Will not save <$url> to link \"$file\".\nPlease override file name on the command line.\n";
156 die "Will not save <$url> as \"$file\" without verification.\nEither run from terminal or override file name on the command line.\n"
159 print "Overwrite $file? [y] ";
161 unless (defined($ans) && $ans =~ /^y?\n/) {
163 print "Ok, aborting.\n";
166 print "\nAborting.\n";
173 die "Will not save <$url> as \"$file\". Path exists.\n";
176 print "Saving to '$file'...\n";
182 open(FILE, ">$file") || die "Can't open $file: $!\n";
183 binmode FILE unless $opt{a};
184 $length = $res->content_length;
185 $flength = fbytes($length) if defined $length;
190 print FILE $_[0] or die "Can't write to $file: $!\n";
191 $size += length($_[0]);
193 if (defined $length) {
194 my $dur = time - $start_t;
195 if ($dur != $last_dur) { # don't update too often
197 my $perc = $size / $length;
199 $speed = fbytes($size/$dur) . "/sec" if $dur > 3;
200 my $secs_left = fduration($dur/$perc - $dur);
201 $perc = int($perc*100);
202 my $show = "$perc% of $flength";
203 $show .= " (at $speed, $secs_left remaining)" if $speed;
208 show( fbytes($size) . " received");
214 close(FILE) || die "Can't write to $file: $!\n";
216 show(""); # clear text
219 print " of ", fbytes($length) if defined($length) && $length != $size;
221 my $dur = time - $start_t;
223 my $speed = fbytes($size/$dur) . "/sec";
224 print " in ", fduration($dur), " ($speed)";
228 if (my $mtime = $res->last_modified) {
229 utime time, $mtime, $file;
232 if ($res->header("X-Died") || !$res->is_success) {
233 if (my $died = $res->header("X-Died")) {
237 print "Transfer aborted. Delete $file? [n] ";
239 if (defined($ans) && $ans =~ /^y\n/) {
240 unlink($file) && print "Deleted.\n";
242 elsif ($length > $size) {
243 print "Truncated file kept: ", fbytes($length - $size), " missing\n";
246 print "File kept.\n";
251 print "Transfer aborted, $file kept\n";
257 # Did not manage to create any file
258 print "\n" if $shown;
259 if (my $xdied = $res->header("X-Died")) {
260 print "$progname: Aborted\n$xdied\n";
263 print "$progname: ", $res->status_line, "\n";
271 if ($n >= 1024 * 1024) {
272 return sprintf "%.3g MB", $n / (1024.0 * 1024);
275 return sprintf "%.3g KB", $n / 1024.0;
285 my $secs = int(shift);
286 my $hours = $secs / (60*60);
287 $secs -= $hours * 60*60;
288 my $mins = $secs / 60;
291 return "$hours hours $mins minutes";
294 return "$mins minutes";
298 return "$secs seconds";
304 my @ani = qw(- \ | /);
309 my($mess, $show_ani) = @_;
310 print "\r$mess" . (" " x (75 - length $mess));
311 print $show_ani ? "$ani[$ani++]\b" : " ";
319 die "Usage: $progname [-a] <url> [<lpath>]\n";