home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_ste.zip / auto / Net / FTP / get.al < prev    next >
Text File  |  1997-11-28  |  1KB  |  66 lines
  1. # NOTE: Derived from ./blib/lib/Net/FTP.pm.  Changes made here will be lost.
  2. package Net::FTP;
  3.  
  4. sub get
  5. {
  6.  my($ftp,$remote,$local,$where) = @_;
  7.  
  8.  my($loc,$len,$buf,$resp,$localfd,$data);
  9.  local *FD;
  10.  
  11.  $localfd = ref($local) ? fileno($local)
  12.             : undef;
  13.  
  14.  ($local = $remote) =~ s#^.*/##
  15.     unless(defined $local);
  16.  
  17.  ${*$ftp}{'net_ftp_rest'} = $where
  18.     if ($where);
  19.  
  20.  delete ${*$ftp}{'net_ftp_port'};
  21.  delete ${*$ftp}{'net_ftp_pasv'};
  22.  
  23.  $data = $ftp->retr($remote) or
  24.     return undef;
  25.  
  26.  if(defined $localfd)
  27.   {
  28.    $loc = $local;
  29.   }
  30.  else
  31.   {
  32.    $loc = \*FD;
  33.  
  34.    unless(($where) ? open($loc,">>$local") : open($loc,">$local"))
  35.     {
  36.      carp "Cannot open Local file $local: $!\n";
  37.      $data->abort;
  38.      return undef;
  39.     }
  40.   }
  41.  
  42.  if($ftp->type eq 'I' && !binmode($loc))
  43.   {
  44.    carp "Cannot binmode Local file $local: $!\n";
  45.    $data->abort;
  46.    return undef;
  47.   }
  48.  
  49.  $buf = '';
  50.  
  51.  do
  52.   {
  53.    $len = $data->read($buf,1024);
  54.   }
  55.  while($len > 0 && syswrite($loc,$buf,$len) == $len);
  56.  
  57.  close($loc)
  58.     unless defined $localfd;
  59.  
  60.  $data->close(); # implied $ftp->response
  61.  
  62.  return $local;
  63. }
  64.  
  65. 1;
  66.