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.18";
  14
  15
  16 sub read {
  17   my $data = shift;
  18   local *buf = \$_[0];
  19   shift;
  20   my $size = shift || croak 'read($buf,$size,[$offset])';
  21   my $timeout = @_ ? shift: $data->timeout;
  22
  23   if (length(${*$data}) < $size && !${*$data}{'net_ftp_eof'}) {
  24     my $blksize = ${*$data}{'net_ftp_blksize'};
  25     $blksize = $size if $size > $blksize;
  26
  27     my $l = 0;
  28     my $n;
  29
  30   READ:
  31     {
  32       my $readbuf = defined(${*$data}{'net_ftp_cr'}) ? "\015" : '';
  33
  34       $data->can_read($timeout)
  35         or croak "Timeout";
  36
  37       if ($n = sysread($data, $readbuf, $blksize, length $readbuf)) {
  38         ${*$data}{'net_ftp_bytesread'} += $n;
  39         ${*$data}{'net_ftp_cr'} =
  40           substr($readbuf, -1) eq "\015"
  41           ? chop($readbuf)
  42           : undef;
  43       }
  44       else {
  45         return undef
  46           unless defined $n;
  47
  48         ${*$data}{'net_ftp_eof'} = 1;
  49       }
  50
  51       $readbuf =~ s/\015\012/\n/sgo;
  52       ${*$data} .= $readbuf;
  53
  54       unless (length(${*$data})) {
  55
  56         redo READ
  57           if ($n > 0);
  58
  59         $size = length(${*$data})
  60           if ($n == 0);
  61       }
  62     }
  63   }
  64
  65   $buf = substr(${*$data}, 0, $size);
  66   substr(${*$data}, 0, $size) = '';
  67
  68   length $buf;
  69 }
  70
  71
  72 sub write {
  73   my $data = shift;
  74   local *buf = \$_[0];
  75   shift;
  76   my $size = shift || croak 'write($buf,$size,[$timeout])';
  77   my $timeout = @_ ? shift: $data->timeout;
  78
  79   my $nr = (my $tmp = substr($buf, 0, $size)) =~ tr/\r\n/\015\012/;
  80   $tmp =~ s/([^\015])\012/$1\015\012/sg if $nr;
  81   $tmp =~ s/^\012/\015\012/ unless ${*$data}{'net_ftp_outcr'};
  82   ${*$data}{'net_ftp_outcr'} = substr($tmp, -1) eq "\015";
  83
  84   # If the remote server has closed the connection we will be signal'd
  85   # when we write. This can happen if the disk on the remote server fills up
  86
  87   local $SIG{PIPE} = 'IGNORE'
  88     unless ($SIG{PIPE} || '') eq 'IGNORE'
  89     or $^O eq 'MacOS';
  90
  91   my $len   = length($tmp);
  92   my $off   = 0;
  93   my $wrote = 0;
  94
  95   my $blksize = ${*$data}{'net_ftp_blksize'};
  96
  97   while ($len) {
  98     $data->can_write($timeout)
  99       or croak "Timeout";
 100
 101     $off += $wrote;
 102     $wrote = syswrite($data, substr($tmp, $off), $len > $blksize ? $blksize : $len);
 103     return undef
 104       unless defined($wrote);
 105     $len -= $wrote;
 106   }
 107
 108   $size;
 109 }
 110
 111 1;