This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Initial integration of libnet-1.0703.
[perl5.git] / lib / Net / FTP / A.pm
1 ##
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
12 @ISA = qw(Net::FTP::dataconn);
13 $VERSION = "1.13"; # $Id: //depot/libnet/Net/FTP/A.pm#9 $
14
15 sub read {
16   my    $data    = shift;
17   local *buf     = \$_[0]; shift;
18   my    $size    = shift || croak 'read($buf,$size,[$offset])';
19   my    $timeout = @_ ? shift : $data->timeout;
20
21   if (length(${*$data}) < $size && !${*$data}{'net_ftp_eof'}) {
22     my $blksize = ${*$data}{'net_ftp_blksize'};
23     $blksize = $size if $size > $blksize;
24
25     my $l = 0;
26     my $n;
27
28     READ:
29     {
30       my $readbuf = defined(${*$data}{'net_ftp_cr'}) ? "\015" : '';
31
32       $data->can_read($timeout) or
33            croak "Timeout";
34
35       if ($n = sysread($data, $readbuf, $blksize, length $readbuf)) {
36         ${*$data}{'net_ftp_bytesread'} += $n;
37         ${*$data}{'net_ftp_cr'} = substr($readbuf,-1) eq "\015"
38                                         ? chop($readbuf)
39                                         : undef;
40       }
41       else {
42         return undef
43           unless defined $n;
44
45         ${*$data}{'net_ftp_eof'} = 1;
46       }
47
48       $readbuf =~ s/\015\012/\n/sgo;
49       ${*$data} .= $readbuf;
50
51       unless (length(${*$data})) {
52
53         redo READ
54           if($n > 0);
55
56         $size = length(${*$data})
57           if($n == 0);
58       }
59     }
60   }
61
62   $buf = substr(${*$data},0,$size);
63   substr(${*$data},0,$size) = '';
64
65   length $buf;
66 }
67
68 sub write {
69   my    $data   = shift;
70   local *buf    = \$_[0]; shift;
71   my    $size   = shift || croak 'write($buf,$size,[$timeout])';
72   my    $timeout = @_ ? shift : $data->timeout;
73
74   $data->can_write($timeout) or
75          croak "Timeout";
76
77   (my $tmp = substr($buf,0,$size)) =~ s/\n/\015\012/sg;
78
79   # If the remote server has closed the connection we will be signal'd
80   # when we write. This can happen if the disk on the remote server fills up
81
82   local $SIG{PIPE} = 'IGNORE';
83
84   my $len = length($tmp);
85   my $off = 0;
86   my $wrote = 0;
87
88   while($len) {
89     $off += $wrote;
90     $wrote = syswrite($data, substr($tmp,$off), $len);
91     return undef
92       unless defined($wrote);
93     $len -= $wrote;
94   }
95
96   $size;
97 }
98
99 1;