File Coverage

blib/lib/Net/PortTest.pm

Criterion	Covered	Total	%
statement	25	52	48.0
branch	0	12	0.0
condition	0	6	0.0
subroutine	8	11	72.7
pod	0	3	0.0
total	33	84	39.2

package Net::PortTest;

use 5.014002;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Net::PortTest ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
	ok alias run_tests
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
	ok alias run_tests
);

our $VERSION = '0.010001';

use IO::Socket::INET;
use Carp;

my $portmap = {};

sub on {
	my $port = shift;
	my $sub = shift;

	carp 'Not a valid port'
		unless( $port =~ /^\d+$/ and ( $port < 56000 and $port > 0 ) );

	carp 'You must provide a function reference'
		unless( ref( $sub ) eq 'CODE' );

	# Register the handler with the port
	$portmap->{$port} = $sub;
}

sub alias {
	my @vars = reverse @_;

	my $port = shift @vars;
	my @aliases = reverse @vars;

	if( ref \@aliases eq 'ARRAY' ){
		for my $a ( @aliases ){
			if( defined $portmap->{$port} ){
				on $a => $portmap->{$port};
			} else {
				carp "Can't create alias: target port $port not defined\n";
			}
		}
	}
}

sub run_tests {
	my $hostname = shift;
	my @ports = @_;

	my $result_map = {};

	use Time::HiRes qw/ time sleep /;

	for my $port ( @ports ){
		if( defined $portmap->{$port} ){
			my $fnref = $portmap->{$port};

			my $sock = IO::Socket::INET->new(
				PeerAddr => $hostname,
                                PeerPort => $port,
                                Proto    => 'tcp'
			);

			carp 'Could not create socket'
				unless $sock;

			my $start = time;
			my ($rc,$res) = &$fnref( $sock );
			my $end   = time;

			# Return the time deltas, plus whatever is returned
			# by the handler
			$result_map->{$port} = {
				delta => ( $end - $start ),
				res   => $res,
				rc    => $rc,
			};

		} else {
			warn "No handler for port $port defined\n";
		}
	}
	return $result_map;
}

sub import {
	no strict 'refs';
	my ( $package, $file, $line ) = caller;

	for( qw(on alias run_tests)){
		*{$package . "::$_"} = \&$_;
	}
}

1;
__END__