lib/Net/FTP/I.pm

   1 ## $Id: //depot/libnet/Net/FTP/I.pm#12 $
   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 = "1.11";
  14
  15 sub read {
  16   my    $data    = shift;
  17   local *buf     = \$_[0]; shift;
  18   my    $size    = shift || croak 'read($buf,$size,[$timeout])';
  19   my    $timeout = @_ ? shift : $data->timeout;
  20
  21   $data->can_read($timeout) or
  22          croak "Timeout";
  23
  24   my($b,$n,$l);
  25   my $blksize = ${*$data}{'net_ftp_blksize'};
  26   $blksize = $size if $size > $blksize;
  27
  28   while(($l = length(${*$data})) < $size) {
  29    $n += ($b = sysread($data, ${*$data}, $blksize, $l)) || 0;
  30    last unless $b;
  31   }
  32
  33   $n = $size < ($l = length(${*$data})) ? $size : $l;
  34
  35   $buf = substr(${*$data},0,$n);
  36   substr(${*$data},0,$n) = '';
  37
  38   ${*$data}{'net_ftp_bytesread'} += $n if $n;
  39   ${*$data}{'net_ftp_eof'} = 1 unless $n;
  40
  41   $n;
  42 }
  43
  44 sub write {
  45   my    $data    = shift;
  46   local *buf     = \$_[0]; shift;
  47   my    $size    = shift || croak 'write($buf,$size,[$timeout])';
  48   my    $timeout = @_ ? shift : $data->timeout;
  49
  50   # If the remote server has closed the connection we will be signal'd
  51   # when we write. This can happen if the disk on the remote server fills up
  52
  53   local $SIG{PIPE} = 'IGNORE' unless $^O eq 'MacOS';
  54   my $sent = $size;
  55   my $off = 0;
  56
  57   my $blksize = ${*$data}{'net_ftp_blksize'};
  58   while($sent > 0) {
  59     $data->can_write($timeout) or
  60          croak "Timeout";
  61
  62     my $n = syswrite($data, $buf, $sent > $blksize ? $blksize : $sent ,$off);
  63     return undef unless defined($n);
  64     $sent -= $n;
  65     $off += $n;
  66   }
  67
  68   $size;
  69 }
  70
  71 1;