Commit | Line | Data |
---|---|---|
b3f6f6a6 | 1 | ## |
406c51ee JH |
2 | ## Package to read/write on ASCII data connections |
3 | ## | |
4 | ||
5 | package Net::FTP::A; | |
2e173144 CBW |
6 | |
7 | use 5.008001; | |
8 | ||
406c51ee | 9 | use strict; |
2e173144 | 10 | use warnings; |
406c51ee | 11 | |
2e173144 CBW |
12 | use Carp; |
13 | use Net::FTP::dataconn; | |
406c51ee | 14 | |
2e173144 | 15 | our @ISA = qw(Net::FTP::dataconn); |
bfdb5bfe | 16 | our $VERSION = "3.08"; |
b3f6f6a6 | 17 | |
2e173144 | 18 | our $buf; |
406c51ee JH |
19 | |
20 | sub read { | |
b3f6f6a6 RGS |
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; | |
406c51ee JH |
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 | ||
b3f6f6a6 | 34 | READ: |
406c51ee JH |
35 | { |
36 | my $readbuf = defined(${*$data}{'net_ftp_cr'}) ? "\015" : ''; | |
37 | ||
b3f6f6a6 RGS |
38 | $data->can_read($timeout) |
39 | or croak "Timeout"; | |
406c51ee JH |
40 | |
41 | if ($n = sysread($data, $readbuf, $blksize, length $readbuf)) { | |
42 | ${*$data}{'net_ftp_bytesread'} += $n; | |
b3f6f6a6 RGS |
43 | ${*$data}{'net_ftp_cr'} = |
44 | substr($readbuf, -1) eq "\015" | |
45 | ? chop($readbuf) | |
46 | : undef; | |
406c51ee JH |
47 | } |
48 | else { | |
2e173144 | 49 | return |
b3f6f6a6 | 50 | unless defined $n; |
406c51ee JH |
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 | |
b3f6f6a6 | 61 | if ($n > 0); |
406c51ee JH |
62 | |
63 | $size = length(${*$data}) | |
b3f6f6a6 | 64 | if ($n == 0); |
406c51ee JH |
65 | } |
66 | } | |
67 | } | |
68 | ||
b3f6f6a6 RGS |
69 | $buf = substr(${*$data}, 0, $size); |
70 | substr(${*$data}, 0, $size) = ''; | |
406c51ee JH |
71 | |
72 | length $buf; | |
73 | } | |
74 | ||
406c51ee | 75 | |
b3f6f6a6 RGS |
76 | sub 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/; | |
0d0bc230 SH |
84 | $tmp =~ s/(?<!\015)\012/\015\012/sg if $nr; |
85 | $tmp =~ s/^\015// if ${*$data}{'net_ftp_outcr'}; | |
b3f6f6a6 | 86 | ${*$data}{'net_ftp_outcr'} = substr($tmp, -1) eq "\015"; |
406c51ee JH |
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 | ||
b3f6f6a6 RGS |
91 | local $SIG{PIPE} = 'IGNORE' |
92 | unless ($SIG{PIPE} || '') eq 'IGNORE' | |
93 | or $^O eq 'MacOS'; | |
406c51ee | 94 | |
b3f6f6a6 RGS |
95 | my $len = length($tmp); |
96 | my $off = 0; | |
406c51ee JH |
97 | my $wrote = 0; |
98 | ||
686337f3 JH |
99 | my $blksize = ${*$data}{'net_ftp_blksize'}; |
100 | ||
b3f6f6a6 RGS |
101 | while ($len) { |
102 | $data->can_write($timeout) | |
103 | or croak "Timeout"; | |
686337f3 | 104 | |
406c51ee | 105 | $off += $wrote; |
b3f6f6a6 | 106 | $wrote = syswrite($data, substr($tmp, $off), $len > $blksize ? $blksize : $len); |
2e173144 | 107 | return |
406c51ee JH |
108 | unless defined($wrote); |
109 | $len -= $wrote; | |
110 | } | |
111 | ||
112 | $size; | |
113 | } | |
114 | ||
115 | 1; |