home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_ste.zip / Net / FTP / I.pm < prev    next >
Text File  |  1997-11-25  |  1KB  |  59 lines
  1. ##
  2. ## Package to read/write on BINARY data connections
  3. ##
  4.  
  5. package Net::FTP::I;
  6.  
  7. use vars qw(@ISA $buf $VERSION);
  8. use Carp;
  9.  
  10. require Net::FTP::dataconn;
  11.  
  12. @ISA = qw(Net::FTP::dataconn);
  13. $VERSION = sprintf("1.%02d",(q$Id: //depot/libnet/Net/FTP/I.pm#4$ =~ /#(\d+)/)[0]);
  14.  
  15. sub read
  16. {
  17.  my    $data     = shift;
  18.  local *buf     = \$_[0]; shift;
  19.  my    $size    = shift || croak 'read($buf,$size,[$timeout])';
  20.  my    $timeout = @_ ? shift : $data->timeout;
  21.  
  22.  $data->can_read($timeout) or
  23.     croak "Timeout";
  24.  
  25.  my $n = sysread($data, $buf, $size);
  26.  
  27.  ${*$data}{'net_ftp_bytesread'} += $n if $n > 0;
  28.  ${*$data}{'net_ftp_eof'} = 1 unless $n;
  29.  
  30.  $n;
  31. }
  32.  
  33. sub write
  34. {
  35.  my    $data    = shift;
  36.  local *buf     = \$_[0]; shift;
  37.  my    $size    = shift || croak 'write($buf,$size,[$timeout])';
  38.  my    $timeout = @_ ? shift : $data->timeout;
  39.  
  40.  $data->can_write($timeout) or
  41.     croak "Timeout";
  42.  
  43.  # If the remote server has closed the connection we will be signal'd
  44.  # when we write. This can happen if the disk on the remote server fills up
  45.  
  46.  local $SIG{PIPE} = 'IGNORE';
  47.  my $sent = $size;
  48.  my $off = 0;
  49.  while($sent > 0) {
  50.    my $n = syswrite($data, $buf, $sent,$off);
  51.    return $n if $n < 0;
  52.    $sent -= $n;
  53.    $off += $n;
  54.  }
  55.  $size;
  56. }
  57.  
  58. 1;
  59.