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