Move libnet Net::* to the top level, to mirror the CPAN distribution.
[perl.git] / ext / libnet / Net / FTP / dataconn.pm
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
16 sub reading {
17   my $data = shift;
18   ${*$data}{'net_ftp_bytesread'} = 0;
19 }
20
21
22 sub abort {
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   {
37     my $buf     = "";
38     my $timeout = $data->timeout;
39     $data->can_read($timeout) && sysread($data, $buf, 1);
40   }
41
42   ${*$data}{'net_ftp_eof'} = 1;    # fake
43
44   $ftp->abort;                     # this will close me
45 }
46
47
48 sub _close {
49   my $data = shift;
50   my $ftp  = ${*$data}{'net_ftp_cmd'};
51
52   $data->SUPER::close();
53
54   delete ${*$ftp}{'net_ftp_dataconn'}
55     if exists ${*$ftp}{'net_ftp_dataconn'}
56     && $data == ${*$ftp}{'net_ftp_dataconn'};
57 }
58
59
60 sub close {
61   my $data = shift;
62   my $ftp  = ${*$data}{'net_ftp_cmd'};
63
64   if (exists ${*$data}{'net_ftp_bytesread'} && !${*$data}{'net_ftp_eof'}) {
65     my $junk;
66     $data->read($junk, 1, 0);
67     return $data->abort unless ${*$data}{'net_ftp_eof'};
68   }
69
70   $data->_close;
71
72   $ftp->response() == CMD_OK
73     && $ftp->message =~ /unique file name:\s*(\S*)\s*\)/
74     && (${*$ftp}{'net_ftp_unique'} = $1);
75
76   $ftp->status == CMD_OK;
77 }
78
79
80 sub _select {
81   my ($data, $timeout, $do_read) = @_;
82   my ($rin, $rout, $win, $wout, $tout, $nfound);
83
84   vec($rin = '', fileno($data), 1) = 1;
85
86   ($win, $rin) = ($rin, $win) unless $do_read;
87
88   while (1) {
89     $nfound = select($rout = $rin, $wout = $win, undef, $tout = $timeout);
90
91     last if $nfound >= 0;
92
93     croak "select: $!"
94       unless $!{EINTR};
95   }
96
97   $nfound;
98 }
99
100
101 sub can_read {
102   _select(@_[0, 1], 1);
103 }
104
105
106 sub can_write {
107   _select(@_[0, 1], 0);
108 }
109
110
111 sub cmd {
112   my $ftp = shift;
113
114   ${*$ftp}{'net_ftp_cmd'};
115 }
116
117
118 sub bytes_read {
119   my $ftp = shift;
120
121   ${*$ftp}{'net_ftp_bytesread'} || 0;
122 }
123
124 1;