Makefile.PL

- change to code for creating Net::Config

Net::FTP::A
- Change to write() to ensure whole packet is sent
- Documentation correction to dir() and ls()

Net::FTP::dataconn
- Stop abort be called when a write socket is being closed.

Net::NNTP
- Changes to postok logic

Net::PH
- fields() now also returns a reference to an ordered array of tag names
  if called in an array context.

Net::Cmd
- Catch added for SIGPIPE while in ->command()

7 files changed, 45 insertions, 28 deletions

diff --git a/Makefile.PL b/Makefile.PL
index 29f78db..fbfe269 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -53,16 +53,14 @@ sub MY::post_initialize
 
 #--- Create Net::Config
 
-use IO::File;
-
 my $config_pm = "Net/Config.pm";
 my $libnet_cfg = "libnet.cfg";
 
-# Use %INC and IO::File to determine how this machine
+# Use %INC and ExtUtils::MakeMaker to determine how this machine
 # maps package names to path names
 
 foreach (keys %INC) {
- last if ($config_pm = $_) =~ s/^IO(.)File/Net${1}Config/;
+ last if ($config_pm = $_) =~ s/^ExtUtils(.)MakeMaker/Net${1}Config/;
 }
 
 system($^X, 'Configure')
diff --git a/Net/Cmd.pm b/Net/Cmd.pm
index 22081f9..38ff3a7 100644
--- a/Net/Cmd.pm
+++ b/Net/Cmd.pm
@@ -13,7 +13,7 @@ use strict;
 use vars qw(@ISA @EXPORT $VERSION);
 use Carp;
 
-$VERSION = "2.09";
+$VERSION = "2.10";
 @ISA     = qw(Exporter);
 @EXPORT  = qw(CMD_INFO CMD_OK CMD_MORE CMD_REJECT CMD_ERROR CMD_PENDING);
 
@@ -164,9 +164,13 @@ sub command
 
  if (scalar(@_))
   {
+   local $SIG{PIPE} = 'IGNORE';
+
    my $str =  join(" ",@_) . "\015\012";
+   my $len = length $str;
 
-   syswrite($cmd,$str,length $str);
+   $cmd->close
+        unless syswrite($cmd,$str,$len) == $len;
 
    $cmd->debug_print(1,$str)
         if($cmd->debug);
diff --git a/Net/FTP.pm b/Net/FTP.pm
index 289abc2..df05fe4 100644
--- a/Net/FTP.pm
+++ b/Net/FTP.pm
@@ -21,7 +21,7 @@ use Net::Cmd;
 use Net::Config;
 use AutoLoader qw(AUTOLOAD);
 
-$VERSION = "2.27"; # $Id: //depot/libnet/Net/FTP.pm#10 $
+$VERSION = "2.27"; # $Id: //depot/libnet/Net/FTP.pm#11 $
 @ISA     = qw(Exporter Net::Cmd IO::Socket::INET);
 
 1;
@@ -1050,13 +1050,15 @@ Returns the full pathname to the new directory.
 
 Get a directory listing of C<DIR>, or the current directory.
 
-Returns a reference to a list of lines returned from the server.
+In an array context, returns a list of lines returned from the server. In
+a scalar context, returns a reference to a list.
 
 =item dir ( [ DIR ] )
 
 Get a directory listing of C<DIR>, or the current directory in long format.
 
-Returns a reference to a list of lines returned from the server.
+In an array context, returns a list of lines returned from the server. In
+a scalar context, returns a reference to a list.
 
 =item get ( REMOTE_FILE [, LOCAL_FILE [, WHERE]] )
 
diff --git a/Net/FTP/A.pm b/Net/FTP/A.pm
index b3589db..d2644cc 100644
--- a/Net/FTP/A.pm
+++ b/Net/FTP/A.pm
@@ -69,23 +69,26 @@ sub write
  # What is previous pkt ended in \015 or not ??
 
  my $tmp;
- ($tmp = $buf) =~ s/(?!\015)\012/\015\012/sg;
+ ($tmp = substr($buf,0,$size)) =~ s/(?!\015)\012/\015\012/sg;
 
  # If the remote server has closed the connection we will be signal'd
  # when we write. This can happen if the disk on the remote server fills up
 
  local $SIG{PIPE} = 'IGNORE';
 
- my $len = $size + length($tmp) - length($buf);
- my $wrote = syswrite($data, $tmp, $len);
+ my $len = length($tmp);
+ my $off = 0;
+ my $wrote = 0;
 
- if($wrote > 0)
-  {
-   $wrote = $wrote == $len ? $size
-                           : $len - $wrote
-  }
+ while($len) {
+   $off += $wrote;
+   $wrote = syswrite($data, substr($tmp,$off), $len);
+   return $wrote
+     if $wrote <= 0;
+   $len -= $wrote;
+ }
 
- return $wrote;
+ return $size;
 }
 
 1;
diff --git a/Net/FTP/dataconn.pm b/Net/FTP/dataconn.pm
index 8bab495..db7b196 100644
--- a/Net/FTP/dataconn.pm
+++ b/Net/FTP/dataconn.pm
@@ -59,7 +59,7 @@ sub close
  my $ftp  = ${*$data}{'net_ftp_cmd'};
 
  return $data->abort
-   unless(${*$data}{'net_ftp_eof'});
+   if(exists ${*$data}{'net_ftp_bytesread'} && !${*$data}{'net_ftp_eof'});
 
  $data->_close;
 
diff --git a/Net/NNTP.pm b/Net/NNTP.pm
index 355de87..9309b3d 100644
--- a/Net/NNTP.pm
+++ b/Net/NNTP.pm
@@ -14,7 +14,7 @@ use Carp;
 use Time::Local;
 use Net::Config;
 
-$VERSION = "2.16"; # $Id: //depot/libnet/Net/NNTP.pm#4 $
+$VERSION = "2.17"; # $Id: //depot/libnet/Net/NNTP.pm#5 $
 @ISA     = qw(Net::Cmd IO::Socket::INET);
 
 sub new
@@ -73,7 +73,8 @@ sub new
    # I want to ignore this failure, so restore the previous status.
    $obj->set_status($c,\@m);
   }
- ${*$obj}{'net_nntp_post'} = $c >= 200 && $c <= 209 ? 1 : 0;
+
+ ${*$obj}{'net_nntp_post'} = $c == 200 ? 1 : 0;
 
  $obj;
 }
diff --git a/Net/PH.pm b/Net/PH.pm
index 1a59364..b6d23fe 100644
--- a/Net/PH.pm
+++ b/Net/PH.pm
@@ -17,7 +17,7 @@ use IO::Socket;
 use Net::Cmd;
 use Net::Config;
 
-$VERSION = "2.19"; # $Id: //depot/libnet/Net/PH.pm#4 $
+$VERSION = "2.20"; # $Id: //depot/libnet/Net/PH.pm#5 $
 @ISA     = qw(Exporter Net::Cmd IO::Socket::INET);
 
 sub new
@@ -297,12 +297,14 @@ sub fields
  my $ln;
  my %resp;
  my $cur_num = 0;
-
+ my @tags = ();
+ 
  while(defined($ln = $ph->getline))
   {
    $ph->debug_print(0,$ln)
      if ($ph->debug & 2);
    chomp($ln);
+
    my($code,$num,$tag,$data,$last_tag);
 
    if($ln =~ /^-(\d+):(\d+):\s*([^:]*):\s*(.*)/o)
@@ -321,15 +323,17 @@ sub fields
      else
       {
        $resp{$tag} = bless [$code, $num, $tag, $data], "Net::PH::Result";
+       push @tags, $tag;
       }
     }
    else
     {
      $ph->set_status($ph->parse_response($ln));
-     return \%resp;
+     return wantarray ? (\%resp, \@tags) : \%resp;
     }
   }
- return undef;
+
+ return;
 }
 
 sub quit
@@ -637,9 +641,14 @@ Exit login mode and return to anonymous mode.
         print "field:[$field] [$c][$v][$f][$t]\n";
     }
 
-Returns a reference to a HASH. The keys of the HASH are the field names
-and the values are C<Net::PH:Result> objects (I<code>, I<value>, I<field>,
-I<text>).
+In a scalar context, returns a reference to a HASH. The keys of the HASH are
+the field names and the values are C<Net::PH:Result> objects (I<code>,
+I<value>, I<field>, I<text>).
+
+In an array context, returns a two element array. The first element is a
+reference to a HASH as above, the second element is a reference to an array
+which contains the tag names in the order that they were returned from the
+server.
 
 C<FIELD_LIST> is a string that lists the fields for which info will be
 returned.