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