home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_ste.zip / Net / FTP / A.pm next >
Text File  |  1997-11-25  |  2KB  |  96 lines
  1. ##
  2. ## Package to read/write on ASCII data connections
  3. ##
  4.  
  5. package Net::FTP::A;
  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/A.pm#5$ =~ /#(\d+)/)[0]);
  14.  
  15. sub read
  16. {
  17.  my    $data     = shift;
  18.  local *buf     = \$_[0]; shift;
  19.  my    $size     = shift || croak 'read($buf,$size,[$offset])';
  20.  my    $timeout = @_ ? shift : $data->timeout;
  21.  
  22.  ${*$data} ||= "";
  23.  my $l = 0;
  24.  
  25.  READ:
  26.   {
  27.    $data->can_read($timeout) or
  28.     croak "Timeout";
  29.  
  30.    $buf = ${*$data};
  31.    ${*$data} = "";
  32.    my $n = sysread($data, $buf, $size, length $buf);
  33.  
  34.    return $n
  35.      if($n < 0);
  36.  
  37.    ${*$data}{'net_ftp_bytesread'} += $n;
  38.    ${*$data}{'net_ftp_eof'} = 1 unless $n;
  39.  
  40.    $buf =~ s/(\015)?(?!\012)\Z//so;
  41.  
  42.    ${*$data} = $1 || "";
  43.    $buf =~ s/\015\012/\n/sgo;
  44.    $l = length($buf);
  45.    
  46.    redo READ
  47.      if($l == 0 && $n > 0);
  48.  
  49.    if($n == 0 && $l == 0)
  50.     {
  51.      $buf = ${*$data};
  52.      ${*$data} = "";
  53.      $l = length($buf);
  54.     }
  55.   }
  56.  
  57.  return $l;
  58. }
  59.  
  60. sub write
  61. {
  62.  my    $data     = shift;
  63.  local *buf     = \$_[0]; shift;
  64.  my    $size     = shift || croak 'write($buf,$size,[$timeout])';
  65.  my    $timeout = @_ ? shift : $data->timeout;
  66.  
  67.  $data->can_write($timeout) or
  68.     croak "Timeout";
  69.  
  70.  # What is previous pkt ended in \015 or not ??
  71.  
  72.  my $tmp;
  73.  ($tmp = substr($buf,0,$size)) =~ s/(?!\015)\012/\015\012/sg;
  74.  
  75.  # If the remote server has closed the connection we will be signal'd
  76.  # when we write. This can happen if the disk on the remote server fills up
  77.  
  78.  local $SIG{PIPE} = 'IGNORE';
  79.  
  80.  my $len = length($tmp);
  81.  my $off = 0;
  82.  my $wrote = 0;
  83.  
  84.  while($len) {
  85.    $off += $wrote;
  86.    $wrote = syswrite($data, substr($tmp,$off), $len);
  87.    return $wrote
  88.      if $wrote <= 0;
  89.    $len -= $wrote;
  90.  }
  91.  
  92.  return $size;
  93. }
  94.  
  95. 1;
  96.