File Coverage

blib/lib/Net/DNS/Resolver/Mock.pm

Criterion	Covered	Total	%
statement	67	67	100.0
branch	16	16	100.0
condition	5	6	83.3
subroutine	15	15	100.0
pod	7	8	87.5
total	110	112	98.2

package Net::DNS::Resolver::Mock;

use strict;
use warnings;

our $VERSION = '1.20220817'; # VERSION

use base 'Net::DNS::Resolver';

use Net::DNS::Packet;
use Net::DNS::Question;
use Net::DNS::ZoneFile;

my $die_on = {};
{
    my @_debug_output;
    sub enable_debug {
        my ( $self ) = @_;
        $self->{_mock_debug} = 1;
        $self->_add_debug( "Net::DNS::Resolver::Mock Debugging enabled" );
        return;
    }
    sub disable_debug {
        my ( $self ) = @_;
        $self->clear_debug();
        delete $self->{_mock_debug};
        return;
    }
    sub _add_debug {
        my ( $self, $debug ) = @_;
        push @_debug_output, $debug;
        warn $debug;
        return;
    }
    sub clear_debug {
        my ( $self ) = @_;
        @_debug_output = ();
        return;
    }
    sub get_debug {
        my ( $self ) = @_;
        return @_debug_output;
    }
}

sub die_on {
    my ( $self, $name, $type, $error ) = @_;
    $die_on->{ "$name $type" } = $error;
    return;
}

sub zonefile_read {
    my ( $self, $zonefile ) = @_;
    $self->{ 'zonefile' } = Net::DNS::ZoneFile->read( $zonefile );
    return;
}

sub zonefile_parse {
    my ( $self, $zonefile ) = @_;
    $self->{ 'zonefile' } = Net::DNS::ZoneFile->parse( $zonefile );
    return;
}

sub send {
    my ( $self, $name, $type ) = @_;

    $self->_add_debug( "DNS Lookup '$name' '$type'" ) if $self->{_mock_debug};

    if ( exists ( $die_on->{ "$name $type" } ) ) {
        die $die_on->{ "$name $type" };
    }

    $name =~ s/\.$// unless $name eq '.';

    my $FakeZone = $self->{ 'zonefile' };

    my $origname = $name;
    if ( lc $type eq 'ptr' ) {
        if ( index( lc $name, '.in-addr.arpa' )  == -1 ) {
            if ( $name =~ /^\d+\.\d+\.\d+\.\d+$/ ) {
                $name = join( '.', reverse( split( /\./, $name ) ) );
                $name .= '.in-addr.arpa';
            }
        }
    }
    my $Packet = Net::DNS::Packet->new();
    $Packet->push( 'question' => Net::DNS::Question->new( $origname, $type, 'IN' ) );
    foreach my $Item ( @$FakeZone ) {
        my $itemname = $Item->name();
        my $itemtype = $Item->type();
        if ( ( lc $itemname eq lc $name ) && ( lc $itemtype eq lc $type ) ) {
        $Packet->push( 'answer' => $Item );
        }
        elsif ( ( lc $itemname eq lc $name ) && ( lc $itemtype eq lc 'cname' ) ) {
            $Packet->push( 'answer' => $Item );
        }
    }
    $Packet->{ 'answerfrom' } = '127.0.0.1';
    $Packet->{ 'status' } = 33152;
    return $Packet;
}

1;

__END__