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