File Coverage

blib/lib/Net/Prober.pm

Criterion	Covered	Total	%
statement	58	63	92.0
branch	6	10	60.0
condition	8	14	57.1
subroutine	19	21	90.4
pod	2	10	20.0
total	93	118	78.8

# ABSTRACT: Probes network hosts for downtime, latency, etc...

package Net::Prober;
$Net::Prober::VERSION = '0.16';

use 5.010;
use strict;
use warnings;

use Carp ();
use Data::Dumper ();
use Digest::MD5 ();
use IO::Socket::INET ();
use LWPx::ParanoidAgent ();
use Net::Ping ();
use Time::HiRes ();

use Net::Prober::Probe::Base ();


sub port_name_to_num {
    my ($port) = @_;

    if (defined $port and $port ne "" and $port =~ m{^\D}) {
        $port = (getservbyname($port, "tcp"))[2];
    }

    return $port;
}

sub probe_any {
    my ($class, $args) = @_;
    my $full_pkg = $class;

    # Open up for != Net::Prober::* classes
    if ($full_pkg !~ m{::}) {
        $full_pkg = "Net::Prober::${full_pkg}";
    }

    eval "require $full_pkg; 1" or do {
        Carp::croak("Couldn't load $full_pkg class: $@");
    };

    my $p = $full_pkg->new();
    return $p->probe($args);
}

sub probe_icmp {
    return probe_any('ping', @_);
}

sub probe_ping {
    return probe_any('ping', @_);
}

sub probe_imap {
    return probe_any('imap', @_);
}

sub probe_ssh {
    return probe_any('ssh', @_);
}

sub probe_smtp {
    return probe_any('smtp', @_);
}

sub probe_http {
    return probe_any('http', @_);
}

sub probe_tcp {
    return probe_any('tcp', @_);
}


sub probe {
    my ($probe_type) = @_;

    if (! $probe_type || ref $probe_type ne 'HASH') {
        Carp::croak("Invalid probe data");
    }

    my $host = $probe_type->{host};
    if (! defined $host or $host eq "") {
        Carp::croak("Can't probe undefined host");
    }

    my %probe_args = %{ $probe_type };
    my $class = lc ($probe_args{class} || 'tcp');

    # Resolve port names (http => 80)
    $probe_args{port} = port_name_to_num($probe_args{port});

    my $result = probe_any($class, \%probe_args);

    return $result;
}

1;

__END__