home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _e145e210447d275c5037aa34decfbf49 < prev    next >
Encoding:
Text File  |  2004-06-01  |  2.2 KB  |  122 lines
  1. ##
  2. ## Generic data connection package
  3. ##
  4.  
  5. package Net::FTP::dataconn;
  6.  
  7. use Carp;
  8. use vars qw(@ISA $timeout $VERSION);
  9. use Net::Cmd;
  10. use Errno;
  11.  
  12. $VERSION = '0.11';
  13. @ISA = qw(IO::Socket::INET);
  14.  
  15. sub reading
  16. {
  17.  my $data = shift;
  18.  ${*$data}{'net_ftp_bytesread'} = 0;
  19. }
  20.  
  21. sub abort
  22. {
  23.  my $data = shift;
  24.  my $ftp  = ${*$data}{'net_ftp_cmd'};
  25.  
  26.  # no need to abort if we have finished the xfer
  27.  return $data->close
  28.     if ${*$data}{'net_ftp_eof'};
  29.  
  30.  # for some reason if we continously open RETR connections and not
  31.  # read a single byte, then abort them after a while the server will
  32.  # close our connection, this prevents the unexpected EOF on the
  33.  # command channel -- GMB
  34.  if(exists ${*$data}{'net_ftp_bytesread'}
  35.     && (${*$data}{'net_ftp_bytesread'} == 0)) {
  36.    my $buf="";
  37.    my $timeout = $data->timeout;
  38.    $data->can_read($timeout) && sysread($data,$buf,1);
  39.  }
  40.  
  41.  ${*$data}{'net_ftp_eof'} = 1; # fake
  42.  
  43.  $ftp->abort; # this will close me
  44. }
  45.  
  46. sub _close
  47. {
  48.  my $data = shift;
  49.  my $ftp  = ${*$data}{'net_ftp_cmd'};
  50.  
  51.  $data->SUPER::close();
  52.  
  53.  delete ${*$ftp}{'net_ftp_dataconn'}
  54.     if exists ${*$ftp}{'net_ftp_dataconn'} &&
  55.         $data == ${*$ftp}{'net_ftp_dataconn'};
  56. }
  57.  
  58. sub close
  59. {
  60.  my $data = shift;
  61.  my $ftp  = ${*$data}{'net_ftp_cmd'};
  62.  
  63.  if(exists ${*$data}{'net_ftp_bytesread'} && !${*$data}{'net_ftp_eof'}) {
  64.    my $junk;
  65.    $data->read($junk,1,0);
  66.    return $data->abort unless ${*$data}{'net_ftp_eof'};
  67.  }
  68.  
  69.  $data->_close;
  70.  
  71.  $ftp->response() == CMD_OK &&
  72.     $ftp->message =~ /unique file name:\s*(\S*)\s*\)/ &&
  73.     (${*$ftp}{'net_ftp_unique'} = $1);
  74.  
  75.  $ftp->status == CMD_OK;
  76. }
  77.  
  78. sub _select {
  79.  my ($data, $timeout, $do_read) = @_;
  80.  my ($rin,$rout,$win,$wout,$tout,$nfound);
  81.  
  82.  vec($rin='',fileno($data),1) = 1;
  83.  
  84.  ($win, $rin) = ($rin, $win) unless $do_read;
  85.  
  86.  while (1) {
  87.    $nfound = select($rout=$rin, $wout=$win, undef, $tout=$timeout);
  88.  
  89.    last if $nfound >= 0;
  90.    
  91.    croak "select: $!"
  92.      unless $!{EINTR};
  93.  }
  94.  
  95.  $nfound;
  96. }
  97.  
  98. sub can_read
  99. {
  100.  _select(@_[0,1],1);
  101. }
  102.  
  103. sub can_write
  104. {
  105.  _select(@_[0,1],0);
  106. }
  107.  
  108. sub cmd
  109. {
  110.  my $ftp = shift;
  111.  
  112.  ${*$ftp}{'net_ftp_cmd'};
  113. }
  114.  
  115. sub bytes_read {
  116.  my $ftp = shift;
  117.  
  118.  ${*$ftp}{'net_ftp_bytesread'} || 0;
  119. }
  120.  
  121. 1;
  122.