File Coverage

blib/lib/Mock/Net/Ping.pm

Criterion	Covered	Total	%
statement	37	37	100.0
branch	14	14	100.0
condition	3	3	100.0
subroutine	8	8	100.0
pod			n/a
total	62	62	100.0

package Mock::Net::Ping;

use strict;
use warnings;
use 5.006;
no warnings 'redefine';
use vars qw( $VERSION );

use Socket qw( inet_aton );
use Carp;

$VERSION = '0.09';

# Override Net::Ping::ping
# Any private IP address, localhost and any IP from 127.0.0.0/8 will always pass.
# Other hosts and IPs will fail.
*Net::Ping::ping = sub
{
    my ($self,
        $host,              # Name or IP number of host to ping
        $timeout,           # Seconds after which ping times out
    ) = @_;
    my ($ip,                # Packed IP number of $host
        $ret,               # The return value
        $ping_time,         # When ping began
        $address            # address of $host
    );

    croak("Usage: \$p->ping(\$host [, \$timeout])") unless @_ == 2 || @_ == 3;
    $timeout = $self->{"timeout"} unless defined $timeout;
    croak("Timeout must be greater than 0 seconds") if $timeout <= 0;

    return unless defined $host;

    # Dispatch to the appropriate routine.
    $ping_time = &Net::Ping::time();
    if ( $host eq 'localhost' )
    {
        $address = '127.0.0.1';
        $ret = 1;
    }
    elsif ( $host =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/ )
    {
        my $packed = inet_aton( $host );
        # modified version of regex from http://www.perlmonks.org/?node_id=791164
        # ret = 1 if local or private and 0 otherwise
        ( $ret ) = 0 + ( $packed =~ m{^(?:\x0a|\x7F|\xAC[\x10-\x1F]|\xC0\xA8)} );
        $address = $host;
    }
    else
    {
        $address = $host;
        $ret = 0;
    }

    return wantarray ? ($ret, &Net::Ping::time() - $ping_time, $address) : $ret;
};

1;
__END__