Re: Resume downloading with LWP

[Sean M. Burke]

At 03:34 2002-07-03 +0400, UpocoY wrote:
>Can LWP resume downloading?

With FTP?  I don't know.  With HTTP?  Yes.  Below is a primitive program I 
wrote that pulls down files with HTTP resumption.  Don't try it on servers 
that just blithely ignore Range headers.  Some time I should rewrite it so 
that it can detect when the remote server doesn't know about Range, and so 
that can detect when the remote file has changed.


use strict;
use LWP;
use URI;

die "What URL(s)?" unless @ARGV;
my $ua = LWP::UserAgent->new;

sub c { # add commas to
   my $c = $_[0];
   1 while $c =~ s/^([-+]?\d+)(\d{3})/$1,$2/;
   return $c;
}


foreach my $x (@ARGV) {
   my $url = $x;

   #print "Heading $url ...\n";

   my $head = $ua->request(HTTP::Request->new('HEAD'=>$url));
   die "HEAD error: ", $head->request->url, ' - ',
     $head->headers_as_string, "\n"
    unless $head->is_success;

   # print $head->as_string;
   my $cl = $head->content_length();
   die "No content length\n" unless defined $cl;
   die "content length is 0.\n" unless $cl;


   print "$url\nLength on server: ", c($cl), "\n";

   $url = $head->request->url;
   my $base;
   $url = URI->new($url) unless ref $url;
   die "what url?" unless $url->scheme;

   if($url->path =~ m<([^/]+)$>) {
     $base = $1;
   } else {
     $base = 'index.html';
   }
   $base =~ s/[^\x20-\x7E]/_/g;
   $base =~ s/[\/\\\:\*\?\"\<\>\|]/_/g;
    # illegal characters under MSDOS: / \ : * ? " < > |

   my $file_size = 0;
   if(-e $base) {
     die unless -f $base;
     $file_size = -s $base;
   }

   my $req_size = 20;

   if($file_size == $cl) {
     print "$base is the right size\n\n";
     next;
   }

   open(OUT, ">>$base") or die "Can't write-open $base: $!\n";
   binmode(OUT);
   select(OUT);
   $| = 1;
   select(STDOUT);
   $| = 1;

   my $req = HTTP::Request->new('GET' => $url);
   $req->init_header('Range' => sprintf("bytes=%s-%s",
     $file_size,  # so if it's 1 byte long, start at byte 1
     $cl - 1
   ));
   printf "Requesting %s - %s\n", c($file_size), c($cl - 1);

   my $dots = 0;
   my $to_get = $cl - $file_size;
   my $response = $ua->request($req, sub {
     print OUT $_[0];
     print ".";
     ++$dots;
     $to_get -= length($_[0]);
     if($dots == 60) {
       $dots = 0;
       print " ", c($to_get), "\n";
     }
   });
   print "\n", $base, " ", scalar(localtime), "\n\n";

   die "GET error: ", $response->request->uri, " - ",
     $response->status_line, "\n"
    unless $response->is_success;
   close(OUT);
}
exit;
__END__

--
Sean M. Burke    http://www.spinn.net/~sburke/