home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_ste.zip / auto / LWP / UserAgent / mirror.al < prev    next >
Text File  |  1997-11-28  |  1KB  |  51 lines
  1. # NOTE: Derived from ./blib/lib/LWP/UserAgent.pm.  Changes made here will be lost.
  2. package LWP::UserAgent;
  3.  
  4. sub mirror
  5. {
  6.     my($self, $url, $file) = @_;
  7.  
  8.     LWP::Debug::trace('()');
  9.     my $request = new HTTP::Request('GET', $url);
  10.  
  11.     if (-e $file) {
  12.     my($mtime) = (stat($file))[9];
  13.     if($mtime) {
  14.         $request->header('If-Modified-Since' =>
  15.                  HTTP::Date::time2str($mtime));
  16.     }
  17.     }
  18.     my $tmpfile = "$file-$$";
  19.  
  20.     my $response = $self->request($request, $tmpfile);
  21.     if ($response->is_success) {
  22.  
  23.     my $file_length = (stat($tmpfile))[7];
  24.     my($content_length) = $response->header('Content-length');
  25.  
  26.     if (defined $content_length and $file_length < $content_length) {
  27.         unlink($tmpfile);
  28.         die "Transfer truncated: " .
  29.         "only $file_length out of $content_length bytes received\n";
  30.     } elsif (defined $content_length and $file_length > $content_length) {
  31.         unlink($tmpfile);
  32.         die "Content-length mismatch: " .
  33.         "expected $content_length bytes, got $file_length\n";
  34.     } else {
  35.         # OK
  36.         if (-e $file) {
  37.         # Some dosish systems fail to rename if the target exists
  38.         chmod 0777, $file;
  39.         unlink $file;
  40.         }
  41.         rename($tmpfile, $file) or
  42.         die "Cannot rename '$tmpfile' to '$file': $!\n";
  43.     }
  44.     } else {
  45.     unlink($tmpfile);
  46.     }
  47.     return $response;
  48. }
  49.  
  50. 1;
  51.