diff options
-rw-r--r-- | MANIFEST | 22 | ||||
-rw-r--r-- | Net/FTP.pm | 45 | ||||
-rw-r--r-- | Net/FTP/A.pm | 3 | ||||
-rw-r--r-- | Net/FTP/I.pm | 15 | ||||
-rw-r--r-- | Net/PH.pm | 19 | ||||
-rw-r--r-- | t/nntp.t | 15 |
6 files changed, 87 insertions, 32 deletions
@@ -3,22 +3,22 @@ Configure Hostname.pm.eg Example replacement for Hostname.pm MANIFEST Makefile.PL -Net/Cmd.pm (v2.09) -Net/Domain.pm (v2.0502) DNS Domain name lookup -Net/DummyInetd.pm (v1.06) -Net/FTP.pm (v2.27) File Transfer Protocol Client +Net/Cmd.pm +Net/Domain.pm DNS Domain name lookup +Net/DummyInetd.pm +Net/FTP.pm File Transfer Protocol Client Net/FTP/A.pm Net/FTP/E.pm Net/FTP/I.pm Net/FTP/L.pm Net/FTP/dataconn.pm -Net/NNTP.pm (v2.16) Network News Transfer Protocol -Net/Netrc.pm (v2.06) .netrc lookup routines -Net/PH.pm (v2.19) CCSO Nameserver Client class -Net/POP3.pm (v2.11) Post Office Protocol -Net/SMTP.pm (v2.10) Simple Mail Transfer Protocol Client -Net/SNPP.pm (v1.10) Simple Network Pager Protocol Client -Net/Time.pm (v2.05) time & nettime protocols +Net/NNTP.pm Network News Transfer Protocol +Net/Netrc.pm .netrc lookup routines +Net/PH.pm CCSO Nameserver Client class +Net/POP3.pm Post Office Protocol +Net/SMTP.pm Simple Mail Transfer Protocol Client +Net/SNPP.pm Simple Network Pager Protocol Client +Net/Time.pm time & nettime protocols README README.config demos/ftp @@ -21,9 +21,15 @@ use Net::Cmd; use Net::Config; use AutoLoader qw(AUTOLOAD); -$VERSION = "2.27"; # $Id: //depot/libnet/Net/FTP.pm#11 $ +$VERSION = "2.28"; # $Id: //depot/libnet/Net/FTP.pm#12 $ @ISA = qw(Exporter Net::Cmd IO::Socket::INET); +# Someday I will "use constant", when I am not bothered to much about +# compatability with older releases of perl + +use vars qw($TELNET_IAC $TELNET_IP $TELNET_DM); +($TELNET_IAC,$TELNET_IP,$TELNET_DM) = (255,244,242); + 1; __END__ @@ -270,8 +276,6 @@ sub type $oldval; } -my($TELNET_IAC,$TELNET_IP,$TELNET_DM) = (255,244,242); - sub abort { my $ftp = shift; @@ -807,6 +811,26 @@ sub pasv_xfer my $port = $sftp->pasv or return undef; + unless($dftp->port($port) && $sftp->retr($sfile) && $dftp->stor($dfile)) + { + $sftp->abort; + $dftp->abort; + return undef; + } + + $dftp->pasv_wait($sftp); +} + +sub pasv_xfer_unique +{ + my($sftp,$sfile,$dftp,$dfile) = @_; + + ($dfile = $sfile) =~ s#.*/## + unless(defined $dfile); + + my $port = $sftp->pasv or + return undef; + unless($dftp->port($port) && $sftp->retr($sfile) && $dftp->stou($dfile)) { $sftp->abort; @@ -888,6 +912,8 @@ sub _STAT { shift->unsupported(@_) } sub _STRU { shift->unsupported(@_) } sub _REIN { shift->unsupported(@_) } +1; + __END__ =head1 NAME @@ -1111,7 +1137,13 @@ Returns the I<modification time> of the given file =item size ( FILE ) -Returns the size in bytes for the given file. +Returns the size in bytes for the given file as stored on the remote server. + +B<NOTE>: The size reported is the size of the stored file on the remote server. +If the file is subsequently transfered from the server in ASCII mode +and the remote server and local machine have different ideas about +"End Of Line" then the size of file on the local machine after transfer +may be different. =item supported ( CMD ) @@ -1192,6 +1224,11 @@ servers, providing that these two servers can connect directly to each other. This method will do a file transfer between two remote ftp servers. If C<DEST_FILE> is omitted then the leaf name of C<SRC_FILE> will be used. +=item pasv_xfer_unique ( SRC_FILE, DEST_SERVER [, DEST_FILE ] ) + +Like C<pasv_xfer> but the file is stored on the remote server using +the STOU command. + =item pasv_wait ( NON_PASV_SERVER ) This method can be used to wait for a transfer to complete between a passive diff --git a/Net/FTP/A.pm b/Net/FTP/A.pm index d2644cc..6caa2d5 100644 --- a/Net/FTP/A.pm +++ b/Net/FTP/A.pm @@ -4,12 +4,13 @@ package Net::FTP::A; -use vars qw(@ISA $buf); +use vars qw(@ISA $buf $VERSION); use Carp; require Net::FTP::dataconn; @ISA = qw(Net::FTP::dataconn); +$VERSION = sprintf("1.%02d",(q$Id: //depot/libnet/Net/FTP/A.pm#5 $ =~ /#(\d+)/)[0]); sub read { diff --git a/Net/FTP/I.pm b/Net/FTP/I.pm index f5826ae..12dea20 100644 --- a/Net/FTP/I.pm +++ b/Net/FTP/I.pm @@ -4,12 +4,13 @@ package Net::FTP::I; -use vars qw(@ISA $buf); +use vars qw(@ISA $buf $VERSION); use Carp; require Net::FTP::dataconn; @ISA = qw(Net::FTP::dataconn); +$VERSION = sprintf("1.%02d",(q$Id: //depot/libnet/Net/FTP/I.pm#4 $ =~ /#(\d+)/)[0]); sub read { @@ -24,6 +25,7 @@ sub read my $n = sysread($data, $buf, $size); ${*$data}{'net_ftp_bytesread'} += $n if $n > 0; + ${*$data}{'net_ftp_eof'} = 1 unless $n; $n; } @@ -42,8 +44,15 @@ sub write # when we write. This can happen if the disk on the remote server fills up local $SIG{PIPE} = 'IGNORE'; - - syswrite($data, $buf, $size); + my $sent = $size; + my $off = 0; + while($sent > 0) { + my $n = syswrite($data, $buf, $sent,$off); + return $n if $n < 0; + $sent -= $n; + $off += $n; + } + $size; } 1; @@ -1,5 +1,5 @@ # -# Copyright (c) 1995-1997 Graham Barr <gbarr@ti.com> and +# Copyright (c) 1995-1997 Graham Barr <gbarr@pobox.com> and # Alex Hristov <hristov@slb.com>. All rights reserved. This program is free # software; you can redistribute it and/or modify it under the same terms # as Perl itself. @@ -17,7 +17,7 @@ use IO::Socket; use Net::Cmd; use Net::Config; -$VERSION = "2.20"; # $Id: //depot/libnet/Net/PH.pm#5 $ +$VERSION = "2.20"; # $Id: //depot/libnet/Net/PH.pm#6 $ @ISA = qw(Exporter Net::Cmd IO::Socket::INET); sub new @@ -574,7 +574,8 @@ The alternative syntax is to pass strings instead of references, for example 'name email schedule'); The C<SEARCH> argument is a string that is passed to the Nameserver as the -search criteria. +search criteria. The strings being passed should B<not> contain any carriage +returns, or else the query command might fail or return invalid data. C<RETURN> is optional, but if given it should be a string which will contain field names to be returned. @@ -606,7 +607,9 @@ The alternative syntax is to pass strings instead of references, for example 'schedule="busy"'); The C<SEARCH> argument is a string to be passed to the Nameserver as the -search criteria. +search criteria. The strings being passed should B<not> contain any carriage +returns, or else the query command might fail or return invalid data. + The C<MAKE> argument is a string to be passed to the Nameserver that will set new values to designated fields. @@ -672,7 +675,9 @@ The alternative syntax is to pass a string instead of a reference, for example $r = $ph->add('name=myname phone=myphone'); C<FIELD_VALUES> is a string that consists of field/value pairs which the -new entry will contain. +new entry will contain. The strings being passed should B<not> contain any +carriage returns, or else the query command might fail or return invalid data. + =item delete( FIELD_VALUES ) @@ -751,7 +756,7 @@ L<Net::Cmd> =head1 AUTHORS -Graham Barr <gbarr@ti.com> +Graham Barr <gbarr@pobox.com> Alex Hristov <hristov@slb.com> =head1 ACKNOWLEDGMENTS @@ -771,7 +776,7 @@ The encryption code is based upon cryptit.c, Copyright (C) 1988 by Steven Dorner, and Paul Pomes, and the University of Illinois Board of Trustees, and by CSNET. -All other code is Copyright (c) 1996-1997 Graham Barr <gbarr@ti.com> +All other code is Copyright (c) 1996-1997 Graham Barr <gbarr@pobox.com> and Alex Hristov <hristov@slb.com>. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. @@ -17,19 +17,22 @@ $nntp = Net::NNTP->new(Debug => 0) print "ok 1\n"; -@grp = $nntp->group('test'); -@grp = $nntp->group('control') unless @grp; -@grp = $nntp->group('news.announce.newusers') unless @grp; +my $grp; +foreach $grp (qw(test alt.test control news.announce.newusers)) { + @grp = $nntp->group($grp); + last if @grp; +} print "not " unless @grp; print "ok 2\n"; -if($grp[2] > $grp[1]) { +if(@grp && $grp[2] > $grp[1]) { $nntp->head($grp[1]) or print "not "; } print "ok 3\n"; - -$nntp->quit or print "not "; +if(@grp) { + $nntp->quit or print "not "; +} print "ok 4\n"; |