File Coverage

blib/lib/Test/RequiresInternet.pm
Criterion Covered Total %
statement 39 40 97.5
branch 18 22 81.8
condition n/a
subroutine 7 7 100.0
pod 0 3 0.0
total 64 72 88.8


line stmt bran cond sub pod time code
1 7     7   157851 use strict;
  7         17  
  7         270  
2 7     7   34 use warnings;
  7         15  
  7         343  
3             package Test::RequiresInternet;
4             $Test::RequiresInternet::VERSION = '0.03';
5             # ABSTRACT: Easily test network connectivity
6              
7              
8 7     7   7821 use Socket;
  7         35999  
  7         10523  
9              
10             sub import {
11 6 100   6   60 skip_all("NO_NETWORK_TESTING") if env("NO_NETWORK_TESTING");
12              
13 5         11 my $namespace = shift;
14              
15 5         11 my $argc = scalar @_;
16 5 50       43 if ( $argc == 0 ) {
    100          
17 0         0 push @_, 'www.google.com', 80;
18             }
19             elsif ( $argc % 2 != 0 ) {
20 1         10 die "Must supply server and a port pairs. You supplied " . (join ", ", @_) . "\n";
21             }
22              
23 4         15 while ( @_ ) {
24 5         13 my $host = shift;
25 5         8 my $port = shift;
26              
27 5         11 local $@;
28              
29 5         17 eval {make_socket($host, $port)};
  5         16  
30              
31 5 100       4241 if ( $@ ) {
32 2         19 skip_all("$@");
33             }
34             }
35             }
36              
37             sub make_socket {
38 5     5 0 11 my ($host, $port) = @_;
39              
40 5         8 my $portnum;
41 5 100       29 if ($port =~ /\D/) {
42 2         15997 $portnum = getservbyname($port, "tcp");
43             }
44             else {
45 3         6 $portnum = $port;
46             }
47              
48 5 100       35 die "Could not find a port number for $port\n" if not $portnum;
49              
50 4 100       181042 my $iaddr = inet_aton($host) or die "no host: $host\n";
51              
52 3         24 my $paddr = sockaddr_in($portnum, $iaddr);
53 3         724 my $proto = getprotobyname("tcp");
54              
55 3 50       133 socket(my $sock, PF_INET, SOCK_STREAM, $proto) or die "socket: $!\n";
56 3 50       150706 connect($sock, $paddr) or die "connect: $!\n";
57 3 50       480 close ($sock) or die "close: $!\n";
58              
59 3         39 1;
60             }
61              
62             sub env {
63 6 100   6 0 129 exists $ENV{$_[0]} && $ENV{$_[0]} eq '1'
64             }
65              
66             sub skip_all {
67 3     3 0 8 my $reason = shift;
68 3         209 print "1..0 # Skipped: $reason";
69 3         4025 exit 0;
70             }
71              
72             1;
73              
74             __END__
75              
76             =pod
77              
78             =encoding UTF-8
79              
80             =head1 NAME
81              
82             Test::RequiresInternet - Easily test network connectivity
83              
84             =head1 VERSION
85              
86             version 0.03
87              
88             =head1 SYNOPSIS
89              
90             use Test::More;
91             use Test::RequiresInternet ('www.example.com' => 80, 'foobar.io' => 25);
92              
93             # if you reach here, sockets successfully connected to hosts/ports above
94              
95             ok(do_that_internet_thing());
96              
97             done_testing();
98              
99             =head1 OVERVIEW
100              
101             This module is intended to easily test network connectivity before functional
102             tests begin to non-local Internet resources. It does not require any modules
103             beyond those supplied in core Perl.
104              
105             If you do not specify a host/port pair, then the module defaults to using
106             C<www.google.com> on port C<80>.
107              
108             You may optionally specify the port by its name, as in C<http> or C<ldap>.
109             If you do this, the test module will attempt to look up the port number
110             using C<getservbyname>.
111              
112             If you do specify a host and port, they must be specified in B<pairs>. It is a
113             fatal error to omit one or the other.
114              
115             If the environment variable C<NO_NETWORK_TESTING> is set, then the tests
116             will be skipped without attempting any socket connections.
117              
118             If the sockets cannot connect to the specified hosts and ports, the exception
119             is caught, reported and the tests skipped.
120              
121             =head1 AUTHOR
122              
123             Mark Allen <mrallen1@yahoo.com>
124              
125             =head1 COPYRIGHT AND LICENSE
126              
127             This software is copyright (c) 2014 by Mark Allen.
128              
129             This is free software; you can redistribute it and/or modify it under
130             the same terms as the Perl 5 programming language system itself.
131              
132             =cut