Commit ccfc957c40dbb8817712cd014ae85c96f8e1a69f - libnet-dns-resolver-mock-perl

+19

-0

Changes less more

	0	Revision history for Net::DNS::Resolver::Mock
	1
	2	1.20200215 2020-02-15 15:07:49+00:00 UTC
	3	- Add missing Changelog
	4	- Debugging mode with output via STDERR and method
	5
	6	1.20200214
	7	- Add Mocking of Exceptions
	8
	9	1.20171219
	10	- Add CNAME lookups
	11	- Bugfix PTR lookups
	12
	13	1.20171031
	14	- Improve tests
	15
	16	1.20170814
	17	- First release
	18

+3

-1

MANIFEST less more

0		# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.010.
	0	# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.012.
	1	Changes
1	2	LICENSE
2	3	MANIFEST
3	4	META.yml

6	7	dist.ini
7	8	lib/Net/DNS/Resolver/Mock.pm
8	9	t/00-load.t
	10	t/01-debug.t
9	11	t/01-test.t
10	12	t/author-critic.t
11	13	t/author-pod-syntax.t

+5

-3

META.yml less more

2	2	author:
3	3	- 'Marc Bradshaw <marc@marcbradshaw.net>'
4	4	build_requires:
	5	Test::Exception: '0'
5	6	Test::More: '0'
6	7	perl: '5.006'
7	8	configure_requires:
8	9	ExtUtils::MakeMaker: '0'
9	10	dynamic_config: 0
10		generated_by: 'Dist::Zilla version 6.010, CPAN::Meta::Converter version 2.150010'
	11	generated_by: 'Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010'
11	12	license: perl
12	13	meta-spec:
13	14	url: http://module-build.sourceforge.net/META-spec-v1.4.html

21	22	base: '0'
22	23	strict: '0'
23	24	warnings: '0'
24		version: '1.20171219'
25		x_serialization_backend: 'YAML::Tiny version 1.70'
	25	version: '1.20200215'
	26	x_generated_by_perl: v5.30.1
	27	x_serialization_backend: 'YAML::Tiny version 1.73'

+4

-2

Makefile.PL less more

0		# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.010.
	0	# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.012.
1	1	use strict;
2	2	use warnings;
3	3

25	25	"warnings" => 0
26	26	},
27	27	"TEST_REQUIRES" => {
	28	"Test::Exception" => 0,
28	29	"Test::More" => 0
29	30	},
30		"VERSION" => "1.20171219",
	31	"VERSION" => "1.20200215",
31	32	"test" => {
32	33	"TESTS" => "t/*.t"
33	34	}

39	40	"Net::DNS::Question" => 0,
40	41	"Net::DNS::Resolver" => 0,
41	42	"Net::DNS::ZoneFile" => 0,
	43	"Test::Exception" => 0,
42	44	"Test::More" => 0,
43	45	"base" => 0,
44	46	"strict" => 0,

+21

-0

README less more

26	26
27	27	Reads the zone data from the supplied string
28	28
	29	die_on ( $Name, $Type, $Error )
	30
	31	Die with $Error for a query of $Name and $Type
	32
	33	enable_debug ()
	34
	35	Once set, the resolver will write any lookups received to STDERR and
	36	will be available via the following methods
	37
	38	disble_debug ()
	39
	40	Disable debugging
	41
	42	clear_debug ()
	43
	44	Clear the debugging list
	45
	46	get_debug ()
	47
	48	Returns a list of debugging entries
	49
29	50	DEPENDENCIES
30	51
31	52	Net::DNS::Resolver

+1

-0

dist.ini less more

21	21	location=build
22	22
23	23	[OurPkgVersion]
	24	[NextRelease]
24	25
25	26	[PodSyntaxTests]
26	27	[Test::Perl::Critic]

+66

-1

lib/Net/DNS/Resolver/Mock.pm less more

2	2	use strict;
3	3	use warnings;
4	4
5		our $VERSION = '1.20171219'; # VERSION
	5	our $VERSION = '1.20200215'; # VERSION
6	6
7	7	use base 'Net::DNS::Resolver';
8	8
9	9	use Net::DNS::Packet;
10	10	use Net::DNS::Question;
11	11	use Net::DNS::ZoneFile;
	12
	13	my $die_on = {};
	14	{
	15	my @_debug_output;
	16	sub enable_debug {
	17	my ( $self ) = @_;
	18	$self->{_mock_debug} = 1;
	19	$self->_add_debug( "Net::DNS::Resolver::Mock Debugging enabled" );
	20	return;
	21	}
	22	sub disable_debug {
	23	my ( $self ) = @_;
	24	$self->clear_debug();
	25	delete $self->{_mock_debug};
	26	return;
	27	}
	28	sub _add_debug {
	29	my ( $self, $debug ) = @_;
	30	push @_debug_output, $debug;
	31	warn $debug;
	32	return;
	33	}
	34	sub clear_debug {
	35	my ( $self ) = @_;
	36	@_debug_output = ();
	37	return;
	38	}
	39	sub get_debug {
	40	my ( $self ) = @_;
	41	return @_debug_output;
	42	}
	43	}
	44
	45	sub die_on {
	46	my ( $self, $name, $type, $error ) = @_;
	47	$die_on->{ "$name $type" } = $error;
	48	return;
	49	}
12	50
13	51	sub zonefile_read {
14	52	my ( $self, $zonefile ) = @_;

24	62
25	63	sub send {
26	64	my ( $self, $name, $type ) = @_;
	65
	66	$self->_add_debug( "DNS Lookup '$name' '$type'" ) if $self->{_mock_debug};
	67
	68	if ( exists ( $die_on->{ "$name $type" } ) ) {
	69	die $die_on->{ "$name $type" };
	70	}
27	71
28	72	$name =~ s/\.$//;
29	73

100	144
101	145	Reads the zone data from the supplied string
102	146
	147	=item die_on ( $Name, $Type, $Error )
	148
	149	Die with $Error for a query of $Name and $Type
	150
	151	=item enable_debug ()
	152
	153	Once set, the resolver will write any lookups received to STDERR
	154	and will be available via the following methods
	155
	156	=item disble_debug ()
	157
	158	Disable debugging
	159
	160	=item clear_debug ()
	161
	162	Clear the debugging list
	163
	164	=item get_debug ()
	165
	166	Returns a list of debugging entries
	167
103	168	=back
104	169
105	170	=head1 DEPENDENCIES

+57

-0

t/01-debug.t less more

	0	#!perl
	1	use 5.006;
	2	use strict;
	3	use warnings FATAL => 'all';
	4	use Test::More;
	5	use Test::Exception;
	6
	7	use Net::DNS::Resolver::Mock;
	8
	9	plan tests => 10;
	10
	11	{
	12	my $ZoneData = join( "\n",
	13	'example.com 3600 A 1.2.3.4',
	14	);
	15
	16	my $Resolver = Net::DNS::Resolver::Mock->new();
	17	$Resolver->zonefile_parse( $ZoneData );
	18
	19	my $Reply;
	20
	21	$Reply = $Resolver->query( 'google.com', 'A' );
	22	is( defined( $Reply ), '', 'Missing entry returns nothing' );
	23
	24	my @Debug = $Resolver->get_debug;
	25	is_deeply ( \@Debug, [], 'Disabled debugging does not log' );
	26
	27	$Resolver->enable_debug;
	28
	29	$Reply = $Resolver->query( 'google.com', 'A' );
	30	is( defined( $Reply ), '', 'Missing entry returns nothing' );
	31
	32	@Debug = $Resolver->get_debug;
	33	is_deeply ( \@Debug, [ "Net::DNS::Resolver::Mock Debugging enabled", "DNS Lookup 'google.com' 'A'" ], 'Enabled debugging logs' );
	34
	35	$Reply = $Resolver->query( 'google.com.au', 'TXT' );
	36	is( defined( $Reply ), '', 'Missing entry returns nothing' );
	37
	38	@Debug = $Resolver->get_debug;
	39	is_deeply ( \@Debug, [ "Net::DNS::Resolver::Mock Debugging enabled", "DNS Lookup 'google.com' 'A'", "DNS Lookup 'google.com.au' 'TXT'" ], 'Enabled debugging logs' );
	40
	41	$Reply = $Resolver->query( 'google.com.au', 'TXT' );
	42	is( defined( $Reply ), '', 'Missing entry returns nothing' );
	43
	44	@Debug = $Resolver->get_debug;
	45	is_deeply ( \@Debug, [ "Net::DNS::Resolver::Mock Debugging enabled", "DNS Lookup 'google.com' 'A'", "DNS Lookup 'google.com.au' 'TXT'", "DNS Lookup 'google.com.au' 'TXT'" ], 'Enabled debugging logs' );
	46
	47	$Resolver->disable_debug;
	48
	49	$Reply = $Resolver->query( 'google.com', 'A' );
	50	is( defined( $Reply ), '', 'Missing entry returns nothing' );
	51
	52	@Debug = $Resolver->get_debug;
	53	is_deeply ( \@Debug, [], 'Disabled debugging does not log' );
	54
	55	}
	56

+5

-1

t/01-test.t less more

2	2	use strict;
3	3	use warnings FATAL => 'all';
4	4	use Test::More;
	5	use Test::Exception;
5	6
6	7	use Net::DNS::Resolver::Mock;
7	8
8		plan tests => 19;
	9	plan tests => 20;
9	10
10	11	{
11	12	my $Resolver = Net::DNS::Resolver::Mock->new();

63	64	$Reply = $Resolver->query( 'cnameptr.example.com.', 'PTR' );
64	65	is( ref $Reply->{ 'answer' }->[0], 'Net::DNS::RR::PTR', 'New::DNS::RR::PTR object returned' );
65	66	is( $Reply->{ 'answer' }->[0]->rdatastr(), 'reverse.example.com.', 'Correct Address returned' );;
	67
	68	$Resolver->die_on( 'cnameptr.example.com.', 'PTR', 'Die Test' );;
	69	dies_ok( sub{ $Resolver->query( 'cnameptr.example.com.', 'PTR' ) }, 'Dies ok' );
66	70	}
67	71