This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Net::Ping: Handle getprotobyn{ame,umber} not being available
authorBrian Fraser <fraserbn@gmail.com>
Mon, 29 Apr 2013 03:23:56 +0000 (00:23 -0300)
committerBrian Fraser <fraserbn@gmail.com>
Sun, 26 Jan 2014 17:44:24 +0000 (14:44 -0300)
dist/Net-Ping/lib/Net/Ping.pm
dist/Net-Ping/t/110_icmp_inst.t
dist/Net-Ping/t/120_udp_inst.t
dist/Net-Ping/t/130_tcp_inst.t
dist/Net-Ping/t/140_stream_inst.t
dist/Net-Ping/t/150_syn_inst.t
dist/Net-Ping/t/450_service.t
dist/Net-Ping/t/500_ping_icmp.t
dist/Net-Ping/t/510_ping_udp.t
dist/Net-Ping/t/520_icmp_ttl.t

index 341f0c5..2766c9e 100644 (file)
@@ -17,7 +17,7 @@ use Time::HiRes;
 
 @ISA = qw(Exporter);
 @EXPORT = qw(pingecho);
-$VERSION = "2.42";
+$VERSION = "2.43";
 
 # Constants
 
@@ -135,7 +135,7 @@ sub new
   $self->{"seq"} = 0;                         # For counting packets
   if ($self->{"proto"} eq "udp")              # Open a socket
   {
-    $self->{"proto_num"} = (getprotobyname('udp'))[2] ||
+    $self->{"proto_num"} = eval { (getprotobyname('udp'))[2] } ||
       croak("Can't udp protocol by name");
     $self->{"port_num"} = (getservbyname('echo', 'udp'))[2] ||
       croak("Can't get udp echo port by name");
@@ -155,7 +155,7 @@ sub new
   elsif ($self->{"proto"} eq "icmp")
   {
     croak("icmp ping requires root privilege") if ($> and $^O ne 'VMS' and $^O ne 'cygwin');
-    $self->{"proto_num"} = (getprotobyname('icmp'))[2] ||
+    $self->{"proto_num"} = eval { (getprotobyname('icmp'))[2] } ||
       croak("Can't get icmp protocol by name");
     $self->{"pid"} = $$ & 0xffff;           # Save lower 16 bits of pid
     $self->{"fh"} = FileHandle->new();
@@ -176,7 +176,7 @@ sub new
   }
   elsif ($self->{"proto"} eq "tcp" || $self->{"proto"} eq "stream")
   {
-    $self->{"proto_num"} = (getprotobyname('tcp'))[2] ||
+    $self->{"proto_num"} = eval { (getprotobyname('tcp'))[2] } ||
       croak("Can't get tcp protocol by name");
     $self->{"port_num"} = (getservbyname('echo', 'tcp'))[2] ||
       croak("Can't get tcp echo port by name");
@@ -184,7 +184,7 @@ sub new
   }
   elsif ($self->{"proto"} eq "syn")
   {
-    $self->{"proto_num"} = (getprotobyname('tcp'))[2] ||
+    $self->{"proto_num"} = eval { (getprotobyname('tcp'))[2] } ||
       croak("Can't get tcp protocol by name");
     $self->{"port_num"} = (getservbyname('echo', 'tcp'))[2] ||
       croak("Can't get tcp echo port by name");
index b36d32f..deddd8f 100644 (file)
@@ -2,12 +2,17 @@
 # Root access is required to actually perform icmp testing.
 
 use strict;
+use Config;
 
 BEGIN {
   unless (eval "require Socket") {
     print "1..0 \# Skip: no Socket\n";
     exit;
   }
+  unless ($Config{d_getpbyname}) {
+    print "1..0 \# Skip: no getprotobyname\n";
+    exit;
+  }
 }
 
 use Test::More tests => 2;
index ca10543..d86dd00 100644 (file)
@@ -2,6 +2,7 @@
 # I do not know of any servers that support udp echo anymore.
 
 use strict;
+use Config;
 
 BEGIN {
   unless (eval "require Socket") {
@@ -12,6 +13,10 @@ BEGIN {
     print "1..0 \# Skip: no echo port\n";
     exit;
   }
+  unless ($Config{d_getpbyname}) {
+    print "1..0 \# Skip: no getprotobyname\n";
+    exit;
+  }
 }
 
 use Test::More tests => 2;
index 2810c8f..21f0181 100644 (file)
@@ -1,6 +1,7 @@
 # Test to make sure object can be instantiated for tcp protocol.
 
 use strict;
+use Config;
 
 BEGIN {
   unless (eval "require Socket") {
@@ -11,6 +12,10 @@ BEGIN {
     print "1..0 \# Skip: no echo port\n";
     exit;
   }
+  unless ($Config{d_getpbyname}) {
+    print "1..0 \# Skip: no getprotobyname\n";
+    exit;
+  }
 }
 
 use Test::More tests => 2;
index cb1ba5f..860402e 100644 (file)
@@ -1,6 +1,7 @@
 # Test to make sure object can be instantiated for stream protocol.
 
 use strict;
+use Config;
 
 BEGIN {
   unless (eval "require Socket") {
@@ -11,6 +12,10 @@ BEGIN {
     print "1..0 \# Skip: no echo port\n";
     exit;
   }
+  unless ($Config{d_getpbyname}) {
+    print "1..0 \# Skip: no getprotobyname\n";
+    exit;
+  }
 }
 
 use Test::More tests => 2;
index d32bc85..2012c96 100644 (file)
@@ -1,6 +1,7 @@
 # Test to make sure object can be instantiated for syn protocol.
 
 use strict;
+use Config;
 
 BEGIN {
   unless (eval "require Socket") {
@@ -11,6 +12,10 @@ BEGIN {
     print "1..0 \# Skip: no echo port\n";
     exit;
   }
+  unless ($Config{d_getpbyname}) {
+    print "1..0 \# Skip: no getprotobyname\n";
+    exit;
+  }
 }
 
 
index 6c1d938..c16b30d 100644 (file)
@@ -1,5 +1,7 @@
 # Testing service_check method using tcp and syn protocols.
 
+use Config;
+
 BEGIN {
   unless (eval "require IO::Socket") {
     print "1..0 \# Skip: no IO::Socket\n";
@@ -9,6 +11,10 @@ BEGIN {
     print "1..0 \# Skip: no echo port\n";
     exit;
   }
+  unless ($Config{d_getpbyname}) {
+    print "1..0 \# Skip: no getprotobyname\n";
+    exit;
+  }
 }
 
 use strict;
index 3050cc3..62855ff 100644 (file)
@@ -2,12 +2,17 @@
 # Root access is required.
 
 use strict;
+use Config;
 
 BEGIN {
   unless (eval "require Socket") {
     print "1..0 \# Skip: no Socket\n";
     exit;
   }
+  unless ($Config{d_getpbyname}) {
+    print "1..0 \# Skip: no getprotobyname\n";
+    exit;
+  }
 }
 
 use Test::More tests => 2;
index cb0ca1b..aa48e90 100644 (file)
@@ -1,6 +1,7 @@
 # Test to perform udp protocol testing.
 
 use strict;
+use Config;
 
 sub isWindowsVista {
    return unless $^O eq 'MSWin32' or $^O eq "cygwin";
@@ -19,6 +20,7 @@ BEGIN {use_ok('Net::Ping')};
 SKIP: {
     skip "No udp echo port", 1 unless getservbyname('echo', 'udp');
     skip "udp ping blocked by Window's default settings", 1 if isWindowsVista();
+    skip "No getprotobyname", 1 unless $Config{d_getpbyname};
     my $p = new Net::Ping "udp";
     is($p->ping("127.0.0.1"), 1);
 }
index f553c63..75c8c49 100644 (file)
@@ -1,11 +1,17 @@
 # Test to perform icmp protocol testing.
 # Root access is required.
 
+use Config;
+
 BEGIN {
   unless (eval "require Socket") {
     print "1..0 \# Skip: no Socket\n";
     exit;
   }
+  unless ($Config{d_getpbyname}) {
+    print "1..0 \# Skip: no getprotobyname\n";
+    exit;
+  }
 }
 
 use Test::More qw(no_plan);