summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/RequiresInternet.pm
diff options
context:
space:
mode:
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/RequiresInternet.pm')
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/RequiresInternet.pm131
1 files changed, 131 insertions, 0 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/RequiresInternet.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/RequiresInternet.pm
new file mode 100644
index 0000000000..e78ca0bc6d
--- /dev/null
+++ b/systems/texlive/tlnet/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