Commit | Line | Data |
686337f3 |
1 | ## $Id: //depot/libnet/Net/FTP/I.pm#11 $ |
406c51ee |
2 | ## Package to read/write on BINARY data connections |
3 | ## |
4 | |
5 | package Net::FTP::I; |
6 | |
7 | use vars qw(@ISA $buf $VERSION); |
8 | use Carp; |
9 | |
10 | require Net::FTP::dataconn; |
11 | |
12 | @ISA = qw(Net::FTP::dataconn); |
686337f3 |
13 | $VERSION = "1.10"; |
406c51ee |
14 | |
15 | sub read { |
16 | my $data = shift; |
17 | local *buf = \$_[0]; shift; |
18 | my $size = shift || croak 'read($buf,$size,[$timeout])'; |
19 | my $timeout = @_ ? shift : $data->timeout; |
20 | |
21 | $data->can_read($timeout) or |
22 | croak "Timeout"; |
23 | |
24 | my($b,$n,$l); |
25 | my $blksize = ${*$data}{'net_ftp_blksize'}; |
26 | $blksize = $size if $size > $blksize; |
27 | |
28 | while(($l = length(${*$data})) < $size) { |
29 | $n += ($b = sysread($data, ${*$data}, $blksize, $l)); |
30 | last unless $b; |
31 | } |
32 | |
33 | $n = $size < ($l = length(${*$data})) ? $size : $l; |
34 | |
35 | $buf = substr(${*$data},0,$n); |
36 | substr(${*$data},0,$n) = ''; |
37 | |
38 | ${*$data}{'net_ftp_bytesread'} += $n if $n; |
39 | ${*$data}{'net_ftp_eof'} = 1 unless $n; |
40 | |
41 | $n; |
42 | } |
43 | |
44 | sub write { |
45 | my $data = shift; |
46 | local *buf = \$_[0]; shift; |
47 | my $size = shift || croak 'write($buf,$size,[$timeout])'; |
48 | my $timeout = @_ ? shift : $data->timeout; |
49 | |
406c51ee |
50 | # If the remote server has closed the connection we will be signal'd |
51 | # when we write. This can happen if the disk on the remote server fills up |
52 | |
686337f3 |
53 | local $SIG{PIPE} = 'IGNORE' unless $^O eq 'MacOS'; |
406c51ee |
54 | my $sent = $size; |
55 | my $off = 0; |
56 | |
686337f3 |
57 | my $blksize = ${*$data}{'net_ftp_blksize'}; |
406c51ee |
58 | while($sent > 0) { |
686337f3 |
59 | $data->can_write($timeout) or |
60 | croak "Timeout"; |
61 | |
62 | my $n = syswrite($data, $buf, $sent > $blksize ? $blksize : $sent ,$off); |
406c51ee |
63 | return undef unless defined($n); |
64 | $sent -= $n; |
65 | $off += $n; |
66 | } |
67 | |
68 | $size; |
69 | } |
70 | |
71 | 1; |