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