diff options
Diffstat (limited to 'lib/Net/FTP.pm')
| -rw-r--r-- | lib/Net/FTP.pm | 113 |
1 files changed, 96 insertions, 17 deletions
diff --git a/lib/Net/FTP.pm b/lib/Net/FTP.pm index dd863005e8..a1daedc00d 100644 --- a/lib/Net/FTP.pm +++ b/lib/Net/FTP.pm @@ -21,7 +21,7 @@ use Net::Cmd; use Net::Config; # use AutoLoader qw(AUTOLOAD); -$VERSION = "2.56"; # $Id:$ +$VERSION = "2.58"; # $Id: //depot/libnet/Net/FTP.pm#57 $ @ISA = qw(Exporter Net::Cmd IO::Socket::INET); # Someday I will "use constant", when I am not bothered to much about @@ -36,6 +36,12 @@ sub pasv_xfer_unique { $sftp->pasv_xfer($sfile,$dftp,$dfile,1); } +BEGIN { + # make a constant so code is fast'ish + my $is_os390 = $^O eq 'os390'; + *trEBCDIC = sub () { $is_os390 } +} + 1; # Having problems with AutoLoader #__END__ @@ -205,7 +211,7 @@ sub size { my $io; if($ftp->supported("SIZE")) { return $ftp->_SIZE($file) - ? ($ftp->message =~ /(\d+)/)[0] + ? ($ftp->message =~ /(\d+)$/)[0] : undef; } elsif($ftp->supported("STAT")) { @@ -399,7 +405,7 @@ sub abort send($ftp,pack("CCC", $TELNET_IAC, $TELNET_IP, $TELNET_IAC),MSG_OOB); $ftp->command(pack("C",$TELNET_DM) . "ABOR"); - + ${*$ftp}{'net_ftp_dataconn'}->close() if defined ${*$ftp}{'net_ftp_dataconn'}; @@ -469,6 +475,13 @@ sub get while(1) { last unless $len = $data->read($buf,$blksize); + + if (trEBCDIC && $ftp->type ne 'I') + { + $buf = $ftp->toebcdic($buf); + $len = length($buf); + } + if($hashh) { $count += $len; print $hashh "#" x (int($count / $hashb)); @@ -487,10 +500,20 @@ sub get print $hashh "\n" if $hashh; - close($loc) - unless defined $localfd; - - $data->close(); # implied $ftp->response + unless (defined $localfd) + { + unless (close($loc)) + { + carp "Cannot close file $local (perhaps disk space) $!\n"; + return undef; + } + } + + unless ($data->close()) # implied $ftp->response + { + carp "Unable to close datastream"; + return undef; + } return $local; } @@ -542,7 +565,7 @@ sub rmdir my $ok; return $ok - if $ftp->_RMD( $dir ) || !$recurse; + if $ok = $ftp->_RMD( $dir ) or !$recurse; # Try to delete the contents # Get a list of all the files in the directory @@ -573,6 +596,18 @@ sub rmdir return $ftp->_RMD($dir) ; } +sub restart +{ + @_ == 2 || croak 'usage: $ftp->restart( BYTE_OFFSET )'; + + my($ftp,$where) = @_; + + ${*$ftp}{'net_ftp_rest'} = $where; + + return undef; +} + + sub mkdir { @_ == 2 || @_ == 3 or croak 'usage: $ftp->mkdir( DIR [, RECURSE ] )'; @@ -606,7 +641,7 @@ sub mkdir { my($status,$message) = ($ftp->status,$ftp->message); my $pwd = $ftp->pwd; - + if($pwd && $ftp->cwd($dir)) { $path = $dir; @@ -701,6 +736,12 @@ sub _store_cmd { last unless $len = sysread($loc,$buf="",$blksize); + if (trEBCDIC) + { + $buf = $ftp->toascii($buf); + $len = length($buf); + } + if($hashh) { $count += $len; print $hashh "#" x (int($count / $hashb)); @@ -726,8 +767,11 @@ sub _store_cmd $sock->close() or return undef; - ($remote) = $ftp->message =~ /unique file name:\s*(\S*)\s*\)/ - if ('STOU' eq uc $cmd); + if ('STOU' eq uc $cmd and $ftp->message =~ m/unique\ file\ name:(.*)\)|"(.*)"/) + { + require File::Basename; + $remote = File::Basename::basename($+) + } return $remote; } @@ -747,11 +791,13 @@ sub port ${*$ftp}{'net_ftp_listen'} ||= IO::Socket::INET->new(Listen => 5, Proto => 'tcp', + Timeout => $ftp->timeout, + LocalAddr => $ftp->sockhost, ); - + my $listen = ${*$ftp}{'net_ftp_listen'}; - my($myport, @myaddr) = ($listen->sockport, split(/\./,$ftp->sockhost)); + my($myport, @myaddr) = ($listen->sockport, split(/\./,$listen->sockhost)); $port = join(',', @myaddr, $myport >> 8, $myport & 0xff); @@ -923,6 +969,11 @@ sub _list_cmd $data->close(); + if (trEBCDIC) + { + for (@$list) { $_ = $ftp->toebcdic($_) } + } + wantarray ? @{$list} : $list; } @@ -996,9 +1047,9 @@ sub _data_cmd return $data; } - + close(delete ${*$ftp}{'net_ftp_listen'}); - + return undef; } @@ -1151,7 +1202,7 @@ Net::FTP - FTP Client class =head1 SYNOPSIS use Net::FTP; - + $ftp = Net::FTP->new("some.host.name", Debug => 0); $ftp->login("anonymous",'me@here.there'); $ftp->cwd("/pub"); @@ -1307,6 +1358,13 @@ Change directory to the parent of the current directory. Returns the full pathname of the current directory. +=item restart ( WHERE ) + +Set the byte offset at which to begin the next data transfer. Net::FTP simply +records this value and uses it when during the next data transfer. For this +reason this method will not return an error, but setting it may cause +a subsequent data transfer to fail. + =item rmdir ( DIR ) Remove the directory with the name C<DIR>. @@ -1343,7 +1401,7 @@ not be transfered, and the remaining bytes will be appended to the local file if it already exists. Returns C<LOCAL_FILE>, or the generated local file name if C<LOCAL_FILE> -is not given. +is not given. If an error was encountered undef is returned. =item put ( LOCAL_FILE [, REMOTE_FILE ] ) @@ -1546,6 +1604,10 @@ given the the timeout value from the command connection will be used. Returns the number of bytes written before any <CRLF> translation. +=item bytes_read () + +Returns the number of bytes read so far. + =item abort () Abort the current data transfer. @@ -1625,6 +1687,19 @@ L<Net::Cmd> ftp(1), ftpd(8), RFC 959 http://www.cis.ohio-state.edu/htbin/rfc/rfc959.html +=head1 USE EXAMPLES + +For an example of the use of Net::FTP see + +=over 4 + +=item http://www.csh.rit.edu/~adam/Progs/autoftp-2.0.tar.gz + +C<autoftp> is a program that can retrieve, send, or list files via +the FTP protocol in a non-interactive manner. + +=back + =head1 CREDITS Henry Gabryjelski <henryg@WPI.EDU> - for the suggestion of creating directories @@ -1640,4 +1715,8 @@ Copyright (c) 1995-1998 Graham Barr. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. +=for html <hr> + +I<$Id: //depot/libnet/Net/FTP.pm#57 $> + =cut |