Commit | Line | Data |
---|---|---|
b3f6f6a6 | 1 | ## |
406c51ee JH |
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 | ||
b3f6f6a6 RGS |
12 | @ISA = qw(Net::FTP::dataconn); |
13 | $VERSION = "1.18"; | |
14 | ||
406c51ee JH |
15 | |
16 | sub read { | |
b3f6f6a6 RGS |
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; | |
406c51ee JH |
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 | ||
b3f6f6a6 | 30 | READ: |
406c51ee JH |
31 | { |
32 | my $readbuf = defined(${*$data}{'net_ftp_cr'}) ? "\015" : ''; | |
33 | ||
b3f6f6a6 RGS |
34 | $data->can_read($timeout) |
35 | or croak "Timeout"; | |
406c51ee JH |
36 | |
37 | if ($n = sysread($data, $readbuf, $blksize, length $readbuf)) { | |
38 | ${*$data}{'net_ftp_bytesread'} += $n; | |
b3f6f6a6 RGS |
39 | ${*$data}{'net_ftp_cr'} = |
40 | substr($readbuf, -1) eq "\015" | |
41 | ? chop($readbuf) | |
42 | : undef; | |
406c51ee JH |
43 | } |
44 | else { | |
45 | return undef | |
b3f6f6a6 | 46 | unless defined $n; |
406c51ee JH |
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 | |
b3f6f6a6 | 57 | if ($n > 0); |
406c51ee JH |
58 | |
59 | $size = length(${*$data}) | |
b3f6f6a6 | 60 | if ($n == 0); |
406c51ee JH |
61 | } |
62 | } | |
63 | } | |
64 | ||
b3f6f6a6 RGS |
65 | $buf = substr(${*$data}, 0, $size); |
66 | substr(${*$data}, 0, $size) = ''; | |
406c51ee JH |
67 | |
68 | length $buf; | |
69 | } | |
70 | ||
406c51ee | 71 | |
b3f6f6a6 RGS |
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; | |
7cf5cf7c | 81 | $tmp =~ s/^\012/\015\012/ unless ${*$data}{'net_ftp_outcr'}; |
b3f6f6a6 | 82 | ${*$data}{'net_ftp_outcr'} = substr($tmp, -1) eq "\015"; |
406c51ee JH |
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 | ||
b3f6f6a6 RGS |
87 | local $SIG{PIPE} = 'IGNORE' |
88 | unless ($SIG{PIPE} || '') eq 'IGNORE' | |
89 | or $^O eq 'MacOS'; | |
406c51ee | 90 | |
b3f6f6a6 RGS |
91 | my $len = length($tmp); |
92 | my $off = 0; | |
406c51ee JH |
93 | my $wrote = 0; |
94 | ||
686337f3 JH |
95 | my $blksize = ${*$data}{'net_ftp_blksize'}; |
96 | ||
b3f6f6a6 RGS |
97 | while ($len) { |
98 | $data->can_write($timeout) | |
99 | or croak "Timeout"; | |
686337f3 | 100 | |
406c51ee | 101 | $off += $wrote; |
b3f6f6a6 | 102 | $wrote = syswrite($data, substr($tmp, $off), $len > $blksize ? $blksize : $len); |
406c51ee JH |
103 | return undef |
104 | unless defined($wrote); | |
105 | $len -= $wrote; | |
106 | } | |
107 | ||
108 | $size; | |
109 | } | |
110 | ||
111 | 1; |