Move libnet Net::* to the top level, to mirror the CPAN distribution.
[perl.git] / ext / libnet / Net / FTP / I.pm
1 ## 
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);
13 $VERSION = "1.12";
14
15
16 sub read {
17   my $data = shift;
18   local *buf = \$_[0];
19   shift;
20   my $size = shift || croak 'read($buf,$size,[$timeout])';
21   my $timeout = @_ ? shift: $data->timeout;
22
23   my $n;
24
25   if ($size > length ${*$data} and !${*$data}{'net_ftp_eof'}) {
26     $data->can_read($timeout)
27       or croak "Timeout";
28
29     my $blksize = ${*$data}{'net_ftp_blksize'};
30     $blksize = $size if $size > $blksize;
31
32     unless ($n = sysread($data, ${*$data}, $blksize, length ${*$data})) {
33       return undef unless defined $n;
34       ${*$data}{'net_ftp_eof'} = 1;
35     }
36   }
37
38   $buf = substr(${*$data}, 0, $size);
39
40   $n = length($buf);
41
42   substr(${*$data}, 0, $n) = '';
43
44   ${*$data}{'net_ftp_bytesread'} += $n;
45
46   $n;
47 }
48
49
50 sub write {
51   my $data = shift;
52   local *buf = \$_[0];
53   shift;
54   my $size = shift || croak 'write($buf,$size,[$timeout])';
55   my $timeout = @_ ? shift: $data->timeout;
56
57   # If the remote server has closed the connection we will be signal'd
58   # when we write. This can happen if the disk on the remote server fills up
59
60   local $SIG{PIPE} = 'IGNORE'
61     unless ($SIG{PIPE} || '') eq 'IGNORE'
62     or $^O eq 'MacOS';
63   my $sent = $size;
64   my $off  = 0;
65
66   my $blksize = ${*$data}{'net_ftp_blksize'};
67   while ($sent > 0) {
68     $data->can_write($timeout)
69       or croak "Timeout";
70
71     my $n = syswrite($data, $buf, $sent > $blksize ? $blksize : $sent, $off);
72     return undef unless defined($n);
73     $sent -= $n;
74     $off += $n;
75   }
76
77   $size;
78 }
79
80 1;