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

use strict;
use warnings;
package Test::RequiresInternet;
$Test::RequiresInternet::VERSION = '0.04';
# 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__