cpan/libnet/lib/Net/FTP/dataconn.pm

   1 ##
   2 ## Generic data connection package
   3 ##
   4
   5 package Net::FTP::dataconn;
   6
   7 use 5.008001;
   8
   9 use strict;
  10 use warnings;
  11
  12 use Carp;
  13 use Errno;
  14 use Net::Cmd;
  15
  16 our $VERSION = '3.07';
  17
  18 $Net::FTP::IOCLASS or die "please load Net::FTP before Net::FTP::dataconn";
  19 our @ISA = $Net::FTP::IOCLASS;
  20
  21 sub reading {
  22   my $data = shift;
  23   ${*$data}{'net_ftp_bytesread'} = 0;
  24 }
  25
  26
  27 sub abort {
  28   my $data = shift;
  29   my $ftp  = ${*$data}{'net_ftp_cmd'};
  30
  31   # no need to abort if we have finished the xfer
  32   return $data->close
  33     if ${*$data}{'net_ftp_eof'};
  34
  35   # for some reason if we continuously open RETR connections and not
  36   # read a single byte, then abort them after a while the server will
  37   # close our connection, this prevents the unexpected EOF on the
  38   # command channel -- GMB
  39   if (exists ${*$data}{'net_ftp_bytesread'}
  40     && (${*$data}{'net_ftp_bytesread'} == 0))
  41   {
  42     my $buf     = "";
  43     my $timeout = $data->timeout;
  44     $data->can_read($timeout) && sysread($data, $buf, 1);
  45   }
  46
  47   ${*$data}{'net_ftp_eof'} = 1;    # fake
  48
  49   $ftp->abort;                     # this will close me
  50 }
  51
  52
  53 sub _close {
  54   my $data = shift;
  55   my $ftp  = ${*$data}{'net_ftp_cmd'};
  56
  57   $data->SUPER::close();
  58
  59   delete ${*$ftp}{'net_ftp_dataconn'}
  60     if defined $ftp
  61     && exists ${*$ftp}{'net_ftp_dataconn'}
  62     && $data == ${*$ftp}{'net_ftp_dataconn'};
  63 }
  64
  65
  66 sub close {
  67   my $data = shift;
  68   my $ftp  = ${*$data}{'net_ftp_cmd'};
  69
  70   if (exists ${*$data}{'net_ftp_bytesread'} && !${*$data}{'net_ftp_eof'}) {
  71     my $junk;
  72     eval { local($SIG{__DIE__}); $data->read($junk, 1, 0) };
  73     return $data->abort unless ${*$data}{'net_ftp_eof'};
  74   }
  75
  76   $data->_close;
  77
  78   return unless defined $ftp;
  79
  80   $ftp->response() == CMD_OK
  81     && $ftp->message =~ /unique file name:\s*(\S*)\s*\)/
  82     && (${*$ftp}{'net_ftp_unique'} = $1);
  83
  84   $ftp->status == CMD_OK;
  85 }
  86
  87
  88 sub _select {
  89   my ($data, $timeout, $do_read) = @_;
  90   my ($rin, $rout, $win, $wout, $tout, $nfound);
  91
  92   vec($rin = '', fileno($data), 1) = 1;
  93
  94   ($win, $rin) = ($rin, $win) unless $do_read;
  95
  96   while (1) {
  97     $nfound = select($rout = $rin, $wout = $win, undef, $tout = $timeout);
  98
  99     last if $nfound >= 0;
 100
 101     croak "select: $!"
 102       unless $!{EINTR};
 103   }
 104
 105   $nfound;
 106 }
 107
 108
 109 sub can_read {
 110   _select(@_[0, 1], 1);
 111 }
 112
 113
 114 sub can_write {
 115   _select(@_[0, 1], 0);
 116 }
 117
 118
 119 sub cmd {
 120   my $ftp = shift;
 121
 122   ${*$ftp}{'net_ftp_cmd'};
 123 }
 124
 125
 126 sub bytes_read {
 127   my $ftp = shift;
 128
 129   ${*$ftp}{'net_ftp_bytesread'} || 0;
 130 }
 131
 132 1;
 133
 134 __END__
 135
 136 =head1 NAME
 137
 138 Net::FTP::dataconn - FTP Client data connection class
 139
 140 =head1 DESCRIPTION
 141
 142 Some of the methods defined in C<Net::FTP> return an object which will
 143 be derived from this class. The dataconn class itself is derived from
 144 the C<IO::Socket::INET> class, so any normal IO operations can be performed.
 145 However the following methods are defined in the dataconn class and IO should
 146 be performed using these.
 147
 148 =over 4
 149
 150 =item read ( BUFFER, SIZE [, TIMEOUT ] )
 151
 152 Read C<SIZE> bytes of data from the server and place it into C<BUFFER>, also
 153 performing any <CRLF> translation necessary. C<TIMEOUT> is optional, if not
 154 given, the timeout value from the command connection will be used.
 155
 156 Returns the number of bytes read before any <CRLF> translation.
 157
 158 =item write ( BUFFER, SIZE [, TIMEOUT ] )
 159
 160 Write C<SIZE> bytes of data from C<BUFFER> to the server, also
 161 performing any <CRLF> translation necessary. C<TIMEOUT> is optional, if not
 162 given, the timeout value from the command connection will be used.
 163
 164 Returns the number of bytes written before any <CRLF> translation.
 165
 166 =item bytes_read ()
 167
 168 Returns the number of bytes read so far.
 169
 170 =item abort ()
 171
 172 Abort the current data transfer.
 173
 174 =item close ()
 175
 176 Close the data connection and get a response from the FTP server. Returns
 177 I<true> if the connection was closed successfully and the first digit of
 178 the response from the server was a '2'.
 179
 180 =back
 181
 182 =cut