AW: IO::Dir destructor

[p5sagit/p5-mst-13.2.git] / lib / Net / Ping.pm

diff --git a/lib/Net/Ping.pm b/lib/Net/Ping.pm
index fee428c..ebdbb42 100644 (file)
--- a/lib/Net/Ping.pm
+++ b/lib/Net/Ping.pm
@@ -16,7 +16,7 @@ use Carp;
 
 @ISA = qw(Exporter);
 @EXPORT = qw(pingecho);
-$VERSION = "2.31_03";
+$VERSION = "2.35";
 
 sub SOL_IP { 0; };
 sub IP_TOS { 1; };
@@ -35,11 +35,20 @@ $syn_forking = 0;
 if ($^O =~ /Win32/i) {
   # Hack to avoid this Win32 spewage:
   # Your vendor has not defined POSIX macro ECONNREFUSED
-  *ECONNREFUSED = sub {10061;}; # "Unknown Error" Special Win32 Response?
-  *ENOTCONN     = sub {10057;};
-  *ECONNRESET   = sub {10054;};
-  *EINPROGRESS  = sub {10036;};
-  *EWOULDBLOCK  = sub {10035;};
+  my @pairs = (ECONNREFUSED => 10061, # "Unknown Error" Special Win32 Response?
+              ENOTCONN     => 10057,
+              ECONNRESET   => 10054,
+              EINPROGRESS  => 10036,
+              EWOULDBLOCK  => 10035,
+         );
+  while (my $name = shift @pairs) {
+    my $value = shift @pairs;
+    # When defined, these all are non-zero
+    unless (eval $name) {
+      no strict 'refs';
+      *{$name} = defined prototype \&{$name} ? sub () {$value} : sub {$value};
+    }
+  }
 #  $syn_forking = 1;    # XXX possibly useful in < Win2K ?
 };
 
@@ -240,6 +249,7 @@ sub mselect
        while (1) {
            $gran = $t if $gran > $t;
            my $nfound = select($_[0], $_[1], $_[2], $gran);
+           undef $nfound if $nfound == -1;
            $t -= $gran;
            return $nfound if $nfound or !defined($nfound) or $t <= 0;
 
@@ -248,7 +258,9 @@ sub mselect
        }
     }
     else {
-       return select($_[0], $_[1], $_[2], $_[3]);
+       my $nfound = select($_[0], $_[1], $_[2], $_[3]);
+       undef $nfound if $nfound == -1;
+       return $nfound;
     }
 }
 
@@ -454,7 +466,7 @@ sub ping_icmp
   {
     $nfound = mselect((my $rout=$rbits), undef, undef, $timeout); # Wait for packet
     $timeout = $finish_time - &time();    # Get remaining time
-    if ($nfound == -1)                    # Hmm, a strange error
+    if (!defined($nfound))                # Hmm, a strange error
     {
       $ret = undef;
       $done = 1;
@@ -478,6 +490,7 @@ sub ping_icmp
       $self->{"from_type"} = $from_type;
       $self->{"from_subcode"} = $from_subcode;
       if (($from_pid == $self->{"pid"}) && # Does the packet check out?
+          (! $source_verify || (inet_ntoa($from_ip) eq inet_ntoa($ip))) &&
           ($from_seq == $self->{"seq"})) {
         if ($from_type == ICMP_ECHOREPLY) {
           $ret = 1;
@@ -1366,6 +1379,15 @@ sub close
   }
 }
 
+sub port_number {
+   my $self = shift;
+   if(@_) {
+       $self->{port_num} = shift @_;
+       $self->service_check(1);
+   }
+   return $self->{port_num};
+}
+
 
 1;
 __END__
@@ -1395,7 +1417,7 @@ Net::Ping - check a remote host for reachability
 
     $p = Net::Ping->new("tcp", 2);
     # Try connecting to the www port instead of the echo port
-    $p->{port_num} = getservbyname("http", "tcp");
+    $p->port_number(getservbyname("http", "tcp"));
     while ($stop_time > time())
     {
         print "$host not reachable ", scalar(localtime()), "\n"
@@ -1406,7 +1428,7 @@ Net::Ping - check a remote host for reachability
 
     # Like tcp protocol, but with many hosts
     $p = Net::Ping->new("syn");
-    $p->{port_num} = getservbyname("http", "tcp");
+    $p->port_number(getservbyname("http", "tcp"));
     foreach $host (@host_array) {
       $p->ping($host);
     }
@@ -1628,6 +1650,14 @@ connection is also closed by "undef $p".  The network connection is
 automatically closed if the ping object goes out of scope (e.g. $p is
 local to a subroutine and you leave the subroutine).
 
+=item $p->port_number([$port_number])
+
+When called with a port number, the port number used to ping is set to
+$port_number rather than using the echo port.  It also has the effect
+of calling C<$p-E<gt>service_check(1)> causing a ping to return a successful
+response only if that specific port is accessible.  This function returns
+the value of the port that C<ping()> will connect to.
+
 =item pingecho($host [, $timeout]);
 
 To provide backward compatibility with the previous version of