releasing/cbrtools/perl/Net/FTP/I.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/I.pm#13 $
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     7
## Package to read/write on BINARY 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::I;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    11
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.12"; 
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,[$timeout])';
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
  my $n;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    27
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    28
  if ($size > length ${*$data} and !${*$data}{'net_ftp_eof'}) {
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    29
    $data->can_read($timeout) or
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    30
	   croak "Timeout";
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    31
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    32
    my $blksize = ${*$data}{'net_ftp_blksize'};
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    33
    $blksize = $size if $size > $blksize;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    34
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    35
    unless ($n = sysread($data, ${*$data}, $blksize, length ${*$data})) {
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    36
      return undef unless defined $n;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    37
      ${*$data}{'net_ftp_eof'} = 1;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    38
    }
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    39
  }
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    40
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    41
  $buf = substr(${*$data},0,$size);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    42
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    43
  $n = length($buf);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    44
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    45
  substr(${*$data},0,$n) = '';
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    46
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    47
  ${*$data}{'net_ftp_bytesread'} += $n;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    48
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    49
  $n;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    50
}
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    51
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    52
sub write {
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    53
  my    $data    = shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    54
  local *buf     = \$_[0]; shift;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    55
  my    $size    = shift || croak 'write($buf,$size,[$timeout])';
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    56
  my    $timeout = @_ ? shift : $data->timeout;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    57
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    58
  # If the remote server has closed the connection we will be signal'd
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    59
  # 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
    60
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    61
  local $SIG{PIPE} = 'IGNORE' unless $^O eq 'MacOS';
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    62
  my $sent = $size;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    63
  my $off = 0;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    64
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    65
  my $blksize = ${*$data}{'net_ftp_blksize'};
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    66
  while($sent > 0) {
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    67
    $data->can_write($timeout) or
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    68
	 croak "Timeout";
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    69
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    70
    my $n = syswrite($data, $buf, $sent > $blksize ? $blksize : $sent ,$off);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    71
    return undef unless defined($n);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    72
    $sent -= $n;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    73
    $off += $n;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    74
  }
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    75
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    76
  $size;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    77
}
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    78
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    79
1;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    80
__END__
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    81
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    82
=head1 COPYRIGHT
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    83
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    84
COPYRIGHT
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    85
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    86
  © 1996-2000 Graham Barr. All rights reserved.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    87
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    88
This library is free software; you can redistribute it and/or modify
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    89
it under the same terms as Perl itself.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    90
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    91
=cut