Upgrade to PathTools 3.25
[p5sagit/p5-mst-13.2.git] / lib / Net / FTP.pm
index beda695..99057af 100644 (file)
@@ -1,6 +1,6 @@
 # Net::FTP.pm
 #
-# Copyright (c) 1995-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# Copyright (c) 1995-2004 Graham Barr <gbarr@pobox.com>. All rights reserved.
 # This program is free software; you can redistribute it and/or
 # modify it under the same terms as Perl itself.
 #
@@ -22,7 +22,7 @@ use Net::Config;
 use Fcntl qw(O_WRONLY O_RDONLY O_APPEND O_CREAT O_TRUNC);
 # use AutoLoader qw(AUTOLOAD);
 
-$VERSION = "2.72"; # $Id: //depot/libnet/Net/FTP.pm#80 $
+$VERSION = "2.77_01";
 @ISA     = qw(Exporter Net::Cmd IO::Socket::INET);
 
 # Someday I will "use constant", when I am not bothered to much about
@@ -50,8 +50,14 @@ BEGIN {
 sub new
 {
  my $pkg  = shift;
- my $peer = shift;
- my %arg  = @_; 
+ my ($peer,%arg);
+ if (@_ % 2) {
+   $peer = shift ;
+   %arg  = @_;
+ } else {
+   %arg = @_;
+   $peer=delete $arg{Host};
+ }
 
  my $host = $peer;
  my $fire = undef;
@@ -124,6 +130,13 @@ sub new
 ## User interface methods
 ##
 
+
+sub host {
+ my $me = shift;
+ ${*$me}{'net_ftp_host'};
+}
+
+
 sub hash {
     my $ftp = shift;           # self
 
@@ -206,7 +219,7 @@ sub size {
   my $io;
   if($ftp->supported("SIZE")) {
     return $ftp->_SIZE($file)
-       ? ($ftp->message =~ /(\d+)\s*$/)[0]
+       ? ($ftp->message =~ /(\d+)\s*(bytes?\s*)?$/)[0]
        : undef;
  }
  elsif($ftp->supported("STAT")) {
@@ -443,8 +456,8 @@ sub get
  croak("Bad remote filename '$remote'\n")
        if $remote =~ /[\r\n]/s;
 
- ${*$ftp}{'net_ftp_rest'} = $where
-       if ($where);
+ ${*$ftp}{'net_ftp_rest'} = $where if defined $where;
+  my $rest = ${*$ftp}{'net_ftp_rest'};
 
  delete ${*$ftp}{'net_ftp_port'};
  delete ${*$ftp}{'net_ftp_pasv'};
@@ -460,7 +473,7 @@ sub get
   {
    $loc = \*FD;
 
-   unless(sysopen($loc, $local, O_CREAT | O_WRONLY | ($where ? O_APPEND : O_TRUNC)))
+   unless(sysopen($loc, $local, O_CREAT | O_WRONLY | ($rest ? O_APPEND : O_TRUNC)))
     {
      carp "Cannot open Local file $local: $!\n";
      $data->abort;
@@ -581,14 +594,14 @@ sub rmdir
 
     # Try to delete the contents
     # Get a list of all the files in the directory
-    my $filelist = $ftp->ls($dir);
+    my @filelist = grep { !/^\.{1,2}$/ } $ftp->ls($dir);
 
     return undef
-       unless $filelist && @$filelist; # failed, it is probably not a directory
+       unless @filelist; # failed, it is probably not a directory
 
     # Go thru and delete each file or the directory
     my $file;
-    foreach $file (map { m,/, ? $_ : "$dir/$_" } @$filelist)
+    foreach $file (map { m,/, ? $_ : "$dir/$_" } @filelist)
     {
        next  # successfully deleted the file
            if $ftp->delete($file);
@@ -713,7 +726,7 @@ sub _store_cmd
    # _store_cmd call, figure out if the local file is a regular file(not
    # a pipe, or device) and if so get the file size from stat, and send
    # an ALLO command before sending the STOR, STOU, or APPE command.
-   my $size = -f $local && -s _; # no ALLO if sending data from a pipe
+   my $size = do { local $^W; -f $local && -s _ }; # no ALLO if sending data from a pipe
    $ftp->_ALLO($size) if $size;
   }
  croak("Bad remote filename '$remote'\n")
@@ -939,7 +952,7 @@ sub _dataconn
 
  if(defined ${*$ftp}{'net_ftp_pasv'})
   {
-   my @port = split(/,/,${*$ftp}{'net_ftp_pasv'});
+   my @port = map { 0+$_ } split(/,/,${*$ftp}{'net_ftp_pasv'});
 
    $data = $pkg->new(PeerAddr => join(".",@port[0..3]),
                     PeerPort => $port[4] * 256 + $port[5],
@@ -1105,7 +1118,7 @@ sub response
 sub parse_response
 {
  return ($1, $2 eq "-")
-    if $_[1] =~ s/^(\d\d\d)(.?)//o;
+    if $_[1] =~ s/^(\d\d\d)([- ]?)//o;
 
  my $ftp = shift;
 
@@ -1204,11 +1217,21 @@ sub _STOR { shift->command("STOR",@_)->response() == CMD_INFO }
 sub _STOU { shift->command("STOU",@_)->response() == CMD_INFO }
 sub _RNFR { shift->command("RNFR",@_)->response() == CMD_MORE }
 sub _REST { shift->command("REST",@_)->response() == CMD_MORE }
-sub _USER { shift->command("user",@_)->response() } # A certain brain dead firewall :-)
 sub _PASS { shift->command("PASS",@_)->response() }
 sub _ACCT { shift->command("ACCT",@_)->response() }
 sub _AUTH { shift->command("AUTH",@_)->response() }
 
+sub _USER {
+  my $ftp = shift;
+  my $ok = $ftp->command("USER",@_)->response();
+
+  # A certain brain dead firewall :-)
+  $ok = $ftp->command("user",@_)->response()
+    unless $ok == CMD_MORE or $ok == CMD_OK;
+
+  $ok;
+}
+
 sub _SMNT { shift->unsupported(@_) }
 sub _MODE { shift->unsupported(@_) }
 sub _SYST { shift->unsupported(@_) }
@@ -1280,19 +1303,28 @@ this if you really know what you're doing).
 
 =over 4
 
-=item new (HOST [,OPTIONS])
+=item new ([ HOST ] [, OPTIONS ])
 
 This is the constructor for a new Net::FTP object. C<HOST> is the
 name of the remote host to which an FTP connection is required.
 
+C<HOST> is optional. If C<HOST> is not given then it may instead be
+passed as the C<Host> option described below. 
+
 C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
 Possible options are:
 
+B<Host> - FTP host to connect to. It may be a single scalar, as defined for
+the C<PeerAddr> option in L<IO::Socket::INET>, or a reference to
+an array with hosts to try in turn. The L</host> method will return the value
+which was used to connect to the host.
+
+
 B<Firewall> - The name of a machine which acts as an FTP firewall. This can be
 overridden by an environment variable C<FTP_FIREWALL>. If specified, and the
 given host cannot be directly connected to, then the
 connection is made to the firewall machine and the string C<@hostname> is
-appended to the login identifier. This kind of setup is also refered to
+appended to the login identifier. This kind of setup is also referred to
 as an ftp proxy.
 
 B<FirewallType> - The type of firewall running on the machine indicated by
@@ -1310,10 +1342,18 @@ B<Timeout> - Set a timeout value (defaults to 120)
 
 B<Debug> - debug level (see the debug method in L<Net::Cmd>)
 
-B<Passive> - If set to a non-zero value then all data transfers will be done
-using passive mode. This is not usually required except for some I<dumb>
-servers, and some firewall configurations. This can also be set by the
-environment variable C<FTP_PASSIVE>.
+B<Passive> - If set to a non-zero value then all data transfers will
+be done using passive mode. If set to zero then data transfers will be
+done using active mode.  If the machine is connected to the Internet
+directly, both passive and active mode should work equally well.
+Behind most firewall and NAT configurations passive mode has a better
+chance of working.  However, in some rare firewall configurations,
+active mode actually works when passive mode doesn't.  Some really old
+FTP servers might not implement passive transfers.  If not specified,
+then the transfer mode is set by the environment variable
+C<FTP_PASSIVE> or if that one is not set by the settings done by the
+F<libnetcfg> utility.  If none of these apply then passive mode is
+used.
 
 B<Hash> - If given a reference to a file handle (e.g., C<\*STDERR>),
 print hash marks (#) on that filehandle every 1024 bytes.  This
@@ -1416,12 +1456,10 @@ C<mkdir> will attempt to create all the directories in the given path.
 
 Returns the full pathname to the new directory.
 
-=item ls ( [ DIR ] )
-
 =item alloc ( SIZE [, RECORD_SIZE] )
 
 The alloc command allows you to give the ftp server a hint about the size
-of the file about to be transfered using the ALLO ftp command. Some storage
+of the file about to be transferred using the ALLO ftp command. Some storage
 systems use this to make intelligent decisions about how to store the file.
 The C<SIZE> argument represents the size of the file in bytes. The
 C<RECORD_SIZE> argument indicates a mazimum record or page size for files
@@ -1429,9 +1467,11 @@ sent with a record or page structure.
 
 The size of the file will be determined, and sent to the server
 automatically for normal files so that this method need only be called if
-you are transfering data from a socket, named pipe, or other stream not
+you are transferring data from a socket, named pipe, or other stream not
 associated with a normal file.
 
+=item ls ( [ DIR ] )
+
 Get a directory listing of C<DIR>, or the current directory.
 
 In an array context, returns a list of lines returned from the server. In
@@ -1451,7 +1491,7 @@ a filename or a filehandle. If not specified, the file will be stored in
 the current directory with the same leafname as the remote file.
 
 If C<WHERE> is given then the first C<WHERE> bytes of the file will
-not be transfered, and the remaining bytes will be appended to
+not be transferred, 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>
@@ -1468,7 +1508,7 @@ Returns C<REMOTE_FILE>, or the generated remote filename if C<REMOTE_FILE>
 is not given.
 
 B<NOTE>: If for some reason the transfer does not complete and an error is
-returned then the contents that had been transfered will not be remove
+returned then the contents that had been transferred will not be remove
 automatically.
 
 =item put_unique ( LOCAL_FILE [, REMOTE_FILE ] )
@@ -1498,7 +1538,7 @@ Returns the I<modification time> of 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
+If the file is subsequently transferred 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.
@@ -1761,12 +1801,8 @@ Roderick Schertler <roderick@gate.net> - for various inputs
 
 =head1 COPYRIGHT
 
-Copyright (c) 1995-1998 Graham Barr. All rights reserved.
+Copyright (c) 1995-2004 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#80 $>
-
 =cut