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