home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / Net / FTP / A.pm next >
Encoding:
Perl POD Document  |  2009-06-26  |  2.4 KB  |  112 lines
  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;
  112.