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