lib/Net/FTP/A.pm

   1 ## $Id: //depot/libnet/Net/FTP/A.pm#16 $
   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.15";
  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   (my $tmp = substr($buf,0,$size)) =~ s/\n/\015\012/sg;
  75
  76   # If the remote server has closed the connection we will be signal'd
  77   # when we write. This can happen if the disk on the remote server fills up
  78
  79   local $SIG{PIPE} = 'IGNORE' unless $^O eq 'MacOS';
  80
  81   my $len = length($tmp);
  82   my $off = 0;
  83   my $wrote = 0;
  84
  85   my $blksize = ${*$data}{'net_ftp_blksize'};
  86
  87   while($len) {
  88     $data->can_write($timeout) or
  89          croak "Timeout";
  90
  91     $off += $wrote;
  92     $wrote = syswrite($data, substr($tmp,$off), $len > $blksize ? $blksize : $len);
  93     return undef
  94       unless defined($wrote);
  95     $len -= $wrote;
  96   }
  97
  98   $size;
  99 }
 100
 101 1;