[Summary view] [Print] [Text view]

   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;