1## 2## Package to read/write on BINARY data connections 3## 4 5package Net::FTP::I; 6 7use 5.008001; 8 9use strict; 10use warnings; 11 12use Carp; 13use Net::FTP::dataconn; 14 15our @ISA = qw(Net::FTP::dataconn); 16our $VERSION = "3.14"; 17 18our $buf; 19 20sub read { 21 my $data = shift; 22 local *buf = \$_[0]; 23 shift; 24 my $size = shift || croak 'read($buf,$size,[$timeout])'; 25 my $timeout = @_ ? shift: $data->timeout; 26 27 my $n; 28 29 if ($size > length ${*$data} and !${*$data}{'net_ftp_eof'}) { 30 $data->can_read($timeout) 31 or croak "Timeout"; 32 33 my $blksize = ${*$data}{'net_ftp_blksize'}; 34 $blksize = $size if $size > $blksize; 35 36 unless ($n = sysread($data, ${*$data}, $blksize, length ${*$data})) { 37 return unless defined $n; 38 ${*$data}{'net_ftp_eof'} = 1; 39 } 40 } 41 42 $buf = substr(${*$data}, 0, $size); 43 44 $n = length($buf); 45 46 substr(${*$data}, 0, $n) = ''; 47 48 ${*$data}{'net_ftp_bytesread'} += $n; 49 50 $n; 51} 52 53 54sub write { 55 my $data = shift; 56 local *buf = \$_[0]; 57 shift; 58 my $size = shift || croak 'write($buf,$size,[$timeout])'; 59 my $timeout = @_ ? shift: $data->timeout; 60 61 # If the remote server has closed the connection we will be signal'd 62 # when we write. This can happen if the disk on the remote server fills up 63 64 local $SIG{PIPE} = 'IGNORE' 65 unless ($SIG{PIPE} || '') eq 'IGNORE' 66 or $^O eq 'MacOS'; 67 my $sent = $size; 68 my $off = 0; 69 70 my $blksize = ${*$data}{'net_ftp_blksize'}; 71 while ($sent > 0) { 72 $data->can_write($timeout) 73 or croak "Timeout"; 74 75 my $n = syswrite($data, $buf, $sent > $blksize ? $blksize : $sent, $off); 76 return unless defined($n); 77 $sent -= $n; 78 $off += $n; 79 } 80 81 $size; 82} 83 841; 85