releasing/cbrtools/perl/Net/FTP/A.pm
author lorewang
Wed, 01 Dec 2010 16:05:36 +0800
changeset 715 e0739b8406dd
parent 602 3145852acc89
permissions -rw-r--r--
Specify extenal tool with path
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
602
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     1
# COPYRIGHT 1996-2000 Graham Barr. All rights reserved.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     2
#
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     3
# This library is free software; you can redistribute it and/or modify
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     4
# it under the same terms as Perl itself.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     5
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     6
## $Id: //depot/libnet/Net/FTP/A.pm#17 $
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     7
## Package to read/write on ASCII data connections
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     8
##
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     9
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    10
package Net::FTP::A;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    11
use strict;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    12
use vars qw(@ISA $buf $VERSION);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    13
use Carp;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    14
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    15
require Net::FTP::dataconn;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    16
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    17
@ISA = qw(Net::FTP::dataconn);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    18
$VERSION = "1.16";
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    19
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    20
sub read {
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    21
  my    $data 	 = shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    22
  local *buf 	 = \$_[0]; shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    23
  my    $size 	 = shift || croak 'read($buf,$size,[$offset])';
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    24
  my    $timeout = @_ ? shift : $data->timeout;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    25
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    26
  if (length(${*$data}) < $size && !${*$data}{'net_ftp_eof'}) {
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    27
    my $blksize = ${*$data}{'net_ftp_blksize'};
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    28
    $blksize = $size if $size > $blksize;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    29
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    30
    my $l = 0;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    31
    my $n;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    32
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    33
    READ:
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    34
    {
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    35
      my $readbuf = defined(${*$data}{'net_ftp_cr'}) ? "\015" : '';
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    36
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    37
      $data->can_read($timeout) or
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    38
	   croak "Timeout";
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    39
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    40
      if ($n = sysread($data, $readbuf, $blksize, length $readbuf)) {
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    41
        ${*$data}{'net_ftp_bytesread'} += $n;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    42
	${*$data}{'net_ftp_cr'} = substr($readbuf,-1) eq "\015"
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    43
					? chop($readbuf)
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    44
					: undef;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    45
      }
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    46
      else {
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    47
        return undef
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    48
	  unless defined $n;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    49
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    50
        ${*$data}{'net_ftp_eof'} = 1;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    51
      }
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    52
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    53
      $readbuf =~ s/\015\012/\n/sgo;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    54
      ${*$data} .= $readbuf;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    55
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    56
      unless (length(${*$data})) {
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    57
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    58
        redo READ
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    59
	  if($n > 0);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    60
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    61
        $size = length(${*$data})
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    62
          if($n == 0);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    63
      }
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    64
    }
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    65
  }
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    66
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    67
  $buf = substr(${*$data},0,$size);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    68
  substr(${*$data},0,$size) = '';
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    69
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    70
  length $buf;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    71
}
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    72
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    73
sub write {
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    74
  my    $data 	= shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    75
  local *buf 	= \$_[0]; shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    76
  my    $size 	= shift || croak 'write($buf,$size,[$timeout])';
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    77
  my    $timeout = @_ ? shift : $data->timeout;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    78
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    79
  (my $tmp = substr($buf,0,$size)) =~ s/\r?\n/\015\012/sg;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    80
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    81
  # If the remote server has closed the connection we will be signal'd
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    82
  # when we write. This can happen if the disk on the remote server fills up
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    83
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    84
  local $SIG{PIPE} = 'IGNORE' unless $^O eq 'MacOS';
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    85
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    86
  my $len = length($tmp);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    87
  my $off = 0;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    88
  my $wrote = 0;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    89
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    90
  my $blksize = ${*$data}{'net_ftp_blksize'};
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    91
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    92
  while($len) {
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    93
    $data->can_write($timeout) or
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    94
	 croak "Timeout";
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    95
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    96
    $off += $wrote;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    97
    $wrote = syswrite($data, substr($tmp,$off), $len > $blksize ? $blksize : $len);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    98
    return undef
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    99
      unless defined($wrote);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   100
    $len -= $wrote;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   101
  }
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   102
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   103
  $size;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   104
}
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   105
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   106
1;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   107
__END__
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   108
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   109
=head1 COPYRIGHT
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   110
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   111
COPYRIGHT
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   112
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   113
  © 1996-2000 Graham Barr. All rights reserved.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   114
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   115
This library is free software; you can redistribute it and/or modify
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   116
it under the same terms as Perl itself.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   117
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   118
=cut