File Coverage

blib/lib/Test/Ping.pm

Criterion	Covered	Total	%
statement	67	74	90.5
branch	2	4	50.0
condition	2	6	33.3
subroutine	18	19	94.7
pod	4	4	100.0
total	93	107	86.9

package Test::Ping;

use strict;
use warnings;

use Test::Ping::Ties::BIND;
use Test::Ping::Ties::PORT;
use Test::Ping::Ties::PROTO;
use Test::Ping::Ties::HIRES;
use Test::Ping::Ties::TIMEOUT;
use Test::Ping::Ties::SOURCE_VERIFY;
use Test::Ping::Ties::SERVICE_CHECK;

my  $CLASS         = __PACKAGE__;
my  $OBJPATH       = __PACKAGE__->builder->{'_net-ping_object'};
my  $method_ignore = '__NONE';
our $VERSION       = '0.17';
our @EXPORT        = qw(
    ping_ok
    ping_not_ok
    create_ping_object_ok
    create_ping_object_not_ok
);

# Net::Ping variables
our $PORT;
our $BIND;
our $PROTO;
our $HIRES;
our $TIMEOUT;
our $SOURCE_VERIFY;
our $SERVICE_CHECK;

BEGIN {
    use base 'Test::Builder::Module';
    use Net::Ping;

    __PACKAGE__->builder->{'_net-ping_object'} = Net::Ping->new($PROTO);

    tie $PORT,          'Test::Ping::Ties::PORT';
    tie $BIND,          'Test::Ping::Ties::BIND';
    tie $PROTO,         'Test::Ping::Ties::PROTO';
    tie $HIRES,         'Test::Ping::Ties::HIRES';
    tie $TIMEOUT,       'Test::Ping::Ties::TIMEOUT';
    tie $SOURCE_VERIFY, 'Test::Ping::Ties::SOURCE_VERIFY';
    tie $SERVICE_CHECK, 'Test::Ping::Ties::SERVICE_CHECK';
}

sub ping_ok {
    my ( $host, $name ) = @_;
    my $tb     = $CLASS->builder;
    my $pinger = $OBJPATH;

    my ( $ret, $duration ) = $pinger->ping( $host, $TIMEOUT );
    $tb->ok( $ret, $name );

    return ( $ret, $duration );
}

sub ping_not_ok {
    my ( $host, $name ) = @_;
    my $tb     = $CLASS->builder;
    my $pinger = $OBJPATH;

    my $alive = $pinger->ping( $host, $TIMEOUT );
    $tb->ok( !$alive, $name );

    return 1;
}

sub create_ping_object_ok {
    my @args = @_;
    my $name = pop @args || q{};
    my $tb   = $CLASS->builder;
    $OBJPATH = Net::Ping->new(@args);

    if ($OBJPATH) {
        $tb->is_eq( ref $OBJPATH, 'Net::Ping', $name );
    } else {
        $tb->ok( 0, $name );
    }
}

sub create_ping_object_not_ok {
    my @args = @_;
    my $name = pop @args || q{};
    my $tb   = $CLASS->builder;
    $OBJPATH = Net::Ping->new(@args);

    $tb->ok( !$OBJPATH, $name );
}

sub _has_var_ok {
    my ( $var_name, $var_value, $name ) = @_;
    my $tb = $CLASS->builder;
    $tb->is_eq( $OBJPATH->{$var_name}, $var_value, $name ); ## no critic
    return 1;
}

sub _ping_object {
    my $obj = $_[1] || $_[0] || q{};

    if ( ref $obj eq 'Net::Ping' ) {
        $OBJPATH = $obj;
    }

    return $OBJPATH;
}

END { $OBJPATH->close(); }

1;

__END__