1## $Id: //depot/libnet/Net/FTP/A.pm#17 $ 2## Package to read/write on ASCII data connections 3## 4 5package Net::FTP::A; 6use strict; 7use vars qw(@ISA $buf $VERSION); 8use Carp; 9 10require Net::FTP::dataconn; 11 12@ISA = qw(Net::FTP::dataconn); 13$VERSION = "1.16"; 14 15sub read { 16 my $data = shift; 17 local *buf = \$_[0]; shift; 18 my $size = shift || croak 'read($buf,$size,[$offset])'; 19 my $timeout = @_ ? shift : $data->timeout; 20 21 if (length(${*$data}) < $size && !${*$data}{'net_ftp_eof'}) { 22 my $blksize = ${*$data}{'net_ftp_blksize'}; 23 $blksize = $size if $size > $blksize; 24 25 my $l = 0; 26 my $n; 27 28 READ: 29 { 30 my $readbuf = defined(${*$data}{'net_ftp_cr'}) ? "\015" : ''; 31 32 $data->can_read($timeout) or 33 croak "Timeout"; 34 35 if ($n = sysread($data, $readbuf, $blksize, length $readbuf)) { 36 ${*$data}{'net_ftp_bytesread'} += $n; 37 ${*$data}{'net_ftp_cr'} = substr($readbuf,-1) eq "\015" 38 ? chop($readbuf) 39 : undef; 40 } 41 else { 42 return undef 43 unless defined $n; 44 45 ${*$data}{'net_ftp_eof'} = 1; 46 } 47 48 $readbuf =~ s/\015\012/\n/sgo; 49 ${*$data} .= $readbuf; 50 51 unless (length(${*$data})) { 52 53 redo READ 54 if($n > 0); 55 56 $size = length(${*$data}) 57 if($n == 0); 58 } 59 } 60 } 61 62 $buf = substr(${*$data},0,$size); 63 substr(${*$data},0,$size) = ''; 64 65 length $buf; 66} 67 68sub write { 69 my $data = shift; 70 local *buf = \$_[0]; shift; 71 my $size = shift || croak 'write($buf,$size,[$timeout])'; 72 my $timeout = @_ ? shift : $data->timeout; 73 74 (my $tmp = substr($buf,0,$size)) =~ s/\r?\n/\015\012/sg; 75 76 # If the remote server has closed the connection we will be signal'd 77 # when we write. This can happen if the disk on the remote server fills up 78 79 local $SIG{PIPE} = 'IGNORE' unless $^O eq 'MacOS'; 80 81 my $len = length($tmp); 82 my $off = 0; 83 my $wrote = 0; 84 85 my $blksize = ${*$data}{'net_ftp_blksize'}; 86 87 while($len) { 88 $data->can_write($timeout) or 89 croak "Timeout"; 90 91 $off += $wrote; 92 $wrote = syswrite($data, substr($tmp,$off), $len > $blksize ? $blksize : $len); 93 return undef 94 unless defined($wrote); 95 $len -= $wrote; 96 } 97 98 $size; 99} 100 1011; 102