lib/Net/FTP/I.pm

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