1use strict; 2 3BEGIN { 4 if ($ENV{NO_NETWORK_TESTING} || 5 ($ENV{PERL_CORE}) && !$ENV{PERL_TEST_Net_Ping}) { 6 print "1..0 # Skip: network dependent test\n"; 7 exit; 8 } 9 unless (eval "require Socket") { 10 print "1..0 \# Skip: no Socket\n"; 11 exit; 12 } 13 unless (getservbyname('echo', 'tcp')) { 14 print "1..0 \# Skip: no echo port\n"; 15 exit; 16 } 17} 18 19# Hopefully this is never a routeable host 20my $fail_ip = $ENV{NET_PING_FAIL_IP} || "192.0.2.0"; 21 22# Remote network test using tcp protocol. 23# 24# NOTE: 25# Network connectivity will be required for all tests to pass. 26# Firewalls may also cause some tests to fail, so test it 27# on a clear network. If you know you do not have a direct 28# connection to remote networks, but you still want the tests 29# to pass, use the following: 30# 31# $ PERL_CORE=1 make test 32 33use Test::More tests => 13; 34BEGIN {use_ok('Net::Ping');} 35 36my $p = new Net::Ping "tcp",9; 37 38isa_ok($p, 'Net::Ping', 'new() worked'); 39 40# message_type can't be used 41eval { 42 $p->message_type(); 43}; 44like($@, qr/message type only supported on 'icmp' protocol/, "message_type() API only concern 'icmp' protocol"); 45 46my $localhost = $p->ping("localhost"); 47if ($localhost) { 48 isnt($p->ping("localhost"), 0, 'Test on the default port'); 49} else { 50 ok(1, "SKIP localhost on the default port on $^O"); 51} 52 53# Change to use the more common web port. 54# This will pull from /etc/services on UNIX. 55# (Make sure getservbyname works in scalar context.) 56isnt($p->{port_num} = (getservbyname("http", "tcp") || 80), undef, "getservbyname http"); 57 58if ($localhost) { 59 isnt($p->ping("localhost"), 0, 'Test localhost on the web port'); 60} else { 61 my $result = $p->ping("localhost"); 62 if ($result) { 63 isnt($p->ping("localhost"), 0, "localhost on the web port unexpectedly worked on $^O"); 64 } else { 65 ok(1, "SKIP localhost on the web port on $^O"); 66 } 67} 68 69is($p->ping($fail_ip), 0, "Can't reach $fail_ip"); 70 71# Test a few remote servers 72# Hopefully they are up when the tests are run. 73 74if ($p->ping('google.com')) { # check for firewall 75 foreach (qw(google.com www.google.com www.wisc.edu 76 yahoo.com www.yahoo.com www.about.com)) { 77 isnt($p->ping($_), 0, "Can ping $_"); 78 } 79} else { 80 SKIP: { 81 skip "Cannot ping google.com: no TCP connection or firewall", 6; 82 } 83} 84