diff options
Diffstat (limited to 'Master/tlpkg/tlperl/site/lib/Test/RequiresInternet.pm')
-rw-r--r-- | Master/tlpkg/tlperl/site/lib/Test/RequiresInternet.pm | 131 |
1 files changed, 131 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/site/lib/Test/RequiresInternet.pm b/Master/tlpkg/tlperl/site/lib/Test/RequiresInternet.pm new file mode 100644 index 00000000000..e78ca0bc6dc --- /dev/null +++ b/Master/tlpkg/tlperl/site/lib/Test/RequiresInternet.pm @@ -0,0 +1,131 @@ +use strict; +use warnings; +package Test::RequiresInternet; +$Test::RequiresInternet::VERSION = '0.05'; +# ABSTRACT: Easily test network connectivity + + +use Socket; + +sub import { + skip_all("NO_NETWORK_TESTING") if env("NO_NETWORK_TESTING"); + + my $namespace = shift; + + my $argc = scalar @_; + if ( $argc == 0 ) { + push @_, 'www.google.com', 80; + } + elsif ( $argc % 2 != 0 ) { + die "Must supply server and a port pairs. You supplied " . (join ", ", @_) . "\n"; + } + + while ( @_ ) { + my $host = shift; + my $port = shift; + + local $@; + + eval {make_socket($host, $port)}; + + if ( $@ ) { + skip_all("$@"); + } + } +} + +sub make_socket { + my ($host, $port) = @_; + + my $portnum; + if ($port =~ /\D/) { + $portnum = getservbyname($port, "tcp"); + } + else { + $portnum = $port; + } + + die "Could not find a port number for $port\n" if not $portnum; + + my $iaddr = inet_aton($host) or die "no host: $host\n"; + + my $paddr = sockaddr_in($portnum, $iaddr); + my $proto = getprotobyname("tcp"); + + socket(my $sock, PF_INET, SOCK_STREAM, $proto) or die "socket: $!\n"; + connect($sock, $paddr) or die "connect: $!\n"; + close ($sock) or die "close: $!\n"; + + 1; +} + +sub env { + exists $ENV{$_[0]} && $ENV{$_[0]} eq '1' +} + +sub skip_all { + my $reason = shift; + print "1..0 # Skipped: $reason"; + exit 0; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Test::RequiresInternet - Easily test network connectivity + +=head1 VERSION + +version 0.05 + +=head1 SYNOPSIS + + use Test::More; + use Test::RequiresInternet ('www.example.com' => 80, 'foobar.io' => 25); + + # if you reach here, sockets successfully connected to hosts/ports above + plan tests => 1; + + ok(do_that_internet_thing()); + +=head1 OVERVIEW + +This module is intended to easily test network connectivity before functional +tests begin to non-local Internet resources. It does not require any modules +beyond those supplied in core Perl. + +If you do not specify a host/port pair, then the module defaults to using +C<www.google.com> on port C<80>. + +You may optionally specify the port by its name, as in C<http> or C<ldap>. +If you do this, the test module will attempt to look up the port number +using C<getservbyname>. + +If you do specify a host and port, they must be specified in B<pairs>. It is a +fatal error to omit one or the other. + +If the environment variable C<NO_NETWORK_TESTING> is set, then the tests +will be skipped without attempting any socket connections. + +If the sockets cannot connect to the specified hosts and ports, the exception +is caught, reported and the tests skipped. + +=head1 AUTHOR + +Mark Allen <mrallen1@yahoo.com> + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2014 by Mark Allen. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut |