开源软件构建与测试

Changes of Revision 2

_service:tar_scm:perl-Net-DNS.spec Changed

_service Changed

_service:tar_scm:Net-DNS-1.34.tar.gz/t/06-packet-unique-push.t Deleted

@@ -1,106 +0,0 @@
-#!/usr/bin/perl
-# $Id: 06-packet-unique-push.t 1856 2021-12-02 14:36:25Z willem $
-#
-
-use strict;
-use warnings;
-use Test::More tests => 45;
-
-use_ok('Net::DNS');
-
-
-# Matching of RR name is not case sensitive
-my $domain = 'example.com';
-my $method = 'unique_push';
-my $packet = Net::DNS::Packet->new($domain);
-
-my $rr_1 = Net::DNS::RR->new('bla.foo 100 IN TXT "text" ;lower case');
-my $rr_2 = Net::DNS::RR->new('bla.Foo 100 IN Txt "text" ;mixed case');
-my $rr_3 = Net::DNS::RR->new('bla.foo 100 IN TXT "mixed CASE"');
-my $rr_4 = Net::DNS::RR->new('bla.foo 100 IN TXT "MIXED case"');
-
-$packet->unique_push( "answer", $rr_1 );
-$packet->unique_push( "answer", $rr_2 );
-is( $packet->header->ancount, 1, "unique_push  case sensitivity test 1" );
-
-$packet->unique_push( "answer", $rr_3 );
-$packet->unique_push( "answer", $rr_4 );
-is( $packet->header->ancount, 3, "unique_push  case sensitivity test 2" );
-
-
-my %sections = (
-	answer	   => 'ancount',
-	authority  => 'nscount',
-	additional => 'arcount',
-	);
-
-my @tests = (
-		1,
-		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'),
-		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'),
-		,
-		2,
-		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'),
-		Net::DNS::RR->new('bar.example.com 60 IN A 192.0.2.1'),
-		,
-		1,
-		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'),
-		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'),
-		Net::DNS::RR->new('foo.example.com 90 IN A 192.0.2.1'),
-		,
-		3,
-		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'),
-		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.2'),
-		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.3'),
-		,
-		3,
-		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'),
-		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.2'),
-		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.3'),
-		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'),
-		,
-		3,
-		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'),
-		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.2'),
-		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'),
-		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.4'),
-		Net::DNS::RR->new('foo.example.com 60 HS A 192.0.2.4'),
-		,
-		3,						# without RDATA
-		Net::DNS::RR->new('foo.example.com IN A'),
-		Net::DNS::RR->new('foo.example.com ANY A'),
-		Net::DNS::RR->new('foo.example.com NONE A'),
-		,
-	);
-
-
-foreach my $test (@tests) {
-	my ( $expect, @rrs ) = @$test;
-
-	while ( my ( $section, $count_meth ) = each %sections ) {
-
-		my $packet = Net::DNS::Update->new($domain);
-
-		$packet->$method( $section => @rrs );
-
-		my $count = $packet->header->$count_meth();
-		is( $count, $expect, "$method  $section	=> RR, RR, ..." );
-
-	}
-
-	#
-	# Now do it again, pushing each RR individually.
-	#
-	while ( my ( $section, $count_meth ) = each %sections ) {
-
-		my $packet = Net::DNS::Update->new($domain);
-
-		foreach my $rr (@rrs) {
-			$packet->$method( $section => $rr );
-		}
-
-		my $count = $packet->header->$count_meth();
-		is( $count, $expect, "$method  $section	=> RR" );
-	}
-}
-

_service:tar_scm:Net-DNS-1.34.tar.gz/t/NonFatal.pm Deleted

@@ -1,68 +0,0 @@
-# $Id: NonFatal.pm 1832 2021-03-22 08:33:36Z willem $	-*-perl-*-
-
-# Test::More calls functions from Test::Builder which all eventually call
-# Test::Builder::ok (on the (singular) builder instance) to report the
-# status. Here we define a builder subclass derived from Test::Builder,
-# with a redefined ok method that overrides the completion status seen by
-# the test harness.
-#
-# Note: The reported completion status is only modified if the file
-# 't/online.nonfatal' exists.
-#
-# The functions NonFatalBegin and NonFatalEnd re-bless the builder
-# instance to be of type NonFatal and Test::Builder respectively.
-# Tests that are between those functions will thus appear to succeed.
-# The failure report itself is not suppressed.
-#
-# This is just a quick hack to allow for non-fatal unit tests. It has many
-# problems such as for example that blocks marked by the NonFatalBegin and
-# NonFatalEnd subroutines may not be nested.
-
-
-package NonFatal;
-
-use strict;
-use warnings;
-use base qw(Test::Builder);
-
-use constant NONFATAL => eval { -e 't/online.nonfatal' };
-
-my @failed;
-
-sub ok {
-	my ( $self, $test, @name ) = @_;
-
-	return $self->SUPER::ok( $test, @name ) unless NONFATAL;
-	return $self->SUPER::ok( $test, @name ) if $test;
-
-	push @failed, join( "\t", $self->current_test, @name );
-
-	$self->SUPER::ok( 1, "NOT OK (tolerating failure)  @name" );
-	return $test;
-}
-
-
-END {
-	my $n = scalar(@failed) || return;
-	my $s = ( $n == 1 ) ? '' : 's';
-	Test::Builder->new->diag( join "\n\t", "\tDisregarding $n failed sub-test$s", @failed );
-}
-
-
-package main;				## no critic ProhibitMultiplePackages
-
-sub NonFatalBegin {
-	bless Test::Builder->new, qw(NonFatal);
-	return;
-}
-
-sub NonFatalEnd {
-	bless Test::Builder->new, qw(Test::Builder);
-	return;
-}
-
-
-1;
-
-__END__
-

_service:tar_scm:Net-DNS-1.34.tar.gz/Changes -> _service:tar_scm:Net-DNS-1.38.tar.gz/Changes Changed

@@ -1,32 +1,82 @@
-$Id: Changes 1867 2022-05-30 10:07:36Z willem $                       -*-text-*-
+$Id: Changes 1922 2023-05-08 18:46:00Z willem $                       -*-text-*-
+
+
+**** 1.38 May 9, 2023
+
+	Mailbox.pm: Improve robustness of address parsing.
+	Deprecate packet->edns->size() method.
+	Deprecate rdatastr() historical RR subtype method.
+	Major overhaul of pre-installation test scripts.
+	Add new t/TestToolkit.pm
+	Refactor socket code and control structure in
+	Nameserver.pm and improve efficiency of zonefile
+	data storage and retrieval.
+
+Fix rt.cpan.org #148274
+	Multicast DNS flag breaks Net::DNS::Parameters::classbyval
+
+Fix rt.cpan.org #148273
+	EDNS extended rcode not handled correctly
+
+Fix rt.cpan.org #147507
+	Nameserver.pm: peerhost undefined after $sock->accept
+
+
+**** 1.37 Mar 13, 2023
+
+	Add links to relevant RFCs in package documentation.
+
+Fix rt.cpan.org #147038
+	resolver->axfr( undef ) fails silently
+
+Fix rt.cpan.org #145944
+	Case sensitivity issue with AXFR
+
+
+**** 1.36 Dec 30, 2022
+
+	Adopt JSON as presentation notation for EDNS options.
+	Disallow zero packet->id in outbound packet.
+	Remove deprecated 2-argument TSIG->create() method.
+	Revise TSIG test scripts and documentation.
+
+
+**** 1.35 Oct 4, 2022
+
+	Improve SVCB error reporting.
+
+Fix rt.cpan.org #144328
+	accept_reply test fails with matched consecutive "random"
+	generated packet->id
+
+Fix rt.cpan.org #144299
+	Spelling errors.
 
 
 **** 1.34 May 30, 2022
 
 	Improve robustness of EDNS option compose/decompose functions.
-
 	Simplify code in Makefile.PL.
 
 Fix rt.cpan.org #142426
-
 	Avoid "Useless use of a constant in void context" warning.
 
 
 **** 1.33 Dec 16, 2021
 
 Fix rt.cpan.org #137768
-
 	Test t/05-SVCB.t on Perl 5.18.0 fails with deep recursion.
 
+Fix rt.cpan.org #144136/#132921
+	$resolver->send wrongly overwrites RD flag in user's packet.
+
 
 **** 1.32 Jul 16, 2021
 
 	Text: Offer both Unicode and escaped-ASCII strings.
-
 	Add LICENSE file to comply with Fedora/RedHat announcement.
 
 Fix rt.cpan.org #136666
-
 	Net::DNS::RR::ZoneFile parser erroneously strips line
 	terminators in quoted string forming part of multiline RR.
 
@@ -59,7 +109,6 @@
 **** 1.27 Sep 11, 2020
 
 Fix rt.cpan.org #133203
-
 	Net::DNS::RR::LOC erroneously strips non default values from
 	string representation
 
@@ -69,7 +118,6 @@
 	Add HTTPS/SVCB packages.
 
 Fix rt.cpan.org #132921
-
 	EDNS OPT handling
 
 
@@ -81,7 +129,6 @@
 **** 1.24 May 27, 2020
 
 	Accept TSIG key generated by BIND tsig-keygen.
-
 	Add Net::DNS::RR::AMTRELAY package.
 
 
@@ -90,18 +137,15 @@
 	Deprecate 2-argument form of TSIG create().
 
 Fix rt.cpan.org #132170
-
 	Documentation Problems with TSIG on ddns update.
 
 Fix rt.cpan.org #131906
-
 	Undefined errorstring/warning when axfr fails
 
 
 **** 1.22 Feb 13, 2020
 
 Fix rt.cpan.org #131579
-
 	Parse issue in Net::DNS::RR->token
 
 Feature
@@ -111,36 +155,26 @@
 **** 1.21 Aug 30, 2019
 
 	Fix error report for non-existent or recursive zone file $INCLUDE.
-
 	Emit one deprecation warning on invocation of obsolete method.
-
 	Rework OPT.pm EDNS0 option construction.
-
 	Remove obsolete Net::DNS::RR::DLV package.
-
 	Add Net::DNS::RR::ZONEMD package.
 
 Fix rt.cpan.org #128901
-
 	background TCP query logic expects to read entire response at once
 
 
 **** 1.20 Mar 22, 2019
 
 	TSIG MAC representation changed to Base64 (align with BIND).
-
 	Update Parameters.pm to resync with IANA registry.
-
 	Refactor resolver test scripts.
-
 	Revise documentation examples to use AAAA instead of A records.
 
 Fix rt.cpan.org #128081
-
 	Recurse.pm fails to resolve domain "kickboxingireland.ie"
 
 Fix rt.cpan.org #127307
-
 	Provide a more informative exception report if application code
 	has no "use Net::DNS::SEC" declaration but nevertheless attempts
 	to invoke the DNSSEC sign or verify features.
@@ -151,11 +185,9 @@
 	Show structure of EDNS options using Perl-like syntax.
 
 Fix rt.cpan.org #127557
-
 	Net::DNS::Resolver::Base should use 3 args open
 
 Fix rt.cpan.org #127182
-
 	Incorrect logic can cause DNS search to emit fruitless queries.
 
 
@@ -166,26 +198,21 @@
 	and the entire reply packet received from a nameserver.
 
 Fix rt.cpan.org #127018
-
 	Net::DNS::ZoneFile->parse() fails if include directory specified.
 
 Fix rt.cpan.org #127012
-
 	DNS resolution broken when options ndots used in /etc/resolv.conf
 
 
 **** 1.17 Jul 25, 2018
 
 Fix rt.cpan.org #125890
-
 	AXFR: 1 record per packet responses.
 
 Fix rt.cpan.org #125889
-
 	New NSEC3 for empty non-terminal leaves type bitmap undefined.
 
 Fix rt.cpan.org #125882
-
 	RDATA name compression pointer calculated incorrectly.
 
 
@@ -204,7 +231,6 @@
 
 	IO::Socket::INET6 removed from recommended module metadata.
 	IPv6 requires IO::Socket::IP which is now a core package.
-
 	No requirement to escape @ in unquoted contiguous string.
 
 
@@ -219,19 +245,16 @@
 **** 1.14 Dec 15, 2017
 
 Fix rt.cpan.org #123702
-
 	'use base' should not be used in packages with several
 	subpackages defined
 
 Fix rt.cpan.org #123676
-
 	Net::DNS::Nameserver malformed message on big axfr
 
 
 **** 1.13 Oct 18, 2017
 
 Feature IDN query support
-
 	Queries for domain names containing non-ASCII characters are
 	now possible on Unicode platforms using CPAN Net::LibIDN2
 
@@ -239,11 +262,9 @@
 **** 1.12 Aug 18, 2017
 
 Fix rt.cpan.org #122586
-
 	Persistent UDP reports false timeouts
 
 Fix rt.cpan.org #122352
-
 	bgsend(): TCP retry can stall for IO::Socket::IP before 0.38
 
 Feature
@@ -253,7 +274,6 @@
 **** 1.11 Jun 26, 2017
 
 Fix rt.cpan.org #122138
-
 	Send a UDP query with udppacketsize=512
 
 Feature
@@ -264,13 +284,11 @@
 **** 1.10 May 5, 2017
 
 Fix rt.cpan.org #120748
-
 	Net::DNS::Resolver::MSWin32 critical issue
 	Thanks to Dmytro Zagashev for his valuable assistance during
 	the investigation which exposed five distinct issues.
 
 Feature rt.cpan.org #18819
-
 	Perl 5.22.0 puts EBCDIC character encoding back on the agenda.
 	Thanks to Yaroslav Kuzmin for successful test build on os390.
 
@@ -278,59 +296,47 @@
 **** 1.09 March 24, 2017
 
 Fix rt.cpan.org #120542
-
 	Fails tests when no "." in @INC
 
 Fix rt.cpan.org #120470
-
 	Fragmented TCP length not correctly reassembled
 
 Feature rt.cpan.org #75357
-
 	Add mechanism to encode/decode EDNS option octet strings
 
 
 **** 1.08 February 20, 2017
 
-Fix rt.cpan.org #120208
+	Discontinue support for pre-5.6 perl
+	Remove pre-5.6 workarounds and outdated language features
 
+Fix rt.cpan.org #120208
 	Unable to install 1.07 in local::lib environment
 
 Feature rt.cpan.org #119679
-
 	Net::DNS::Nameserver: UpdateHandler for responding to UPDATE packets
 
 Feature rt.cpan.org #75357
-
 	Net::DNS::Nameserver: optionmask (similar to headermask) added
 	to allow user to set EDNS options in reply packet
 
-Discontinue support for pre-5.6 perl
-
-	Remove pre-5.6 workarounds and outdated language features
-
 
 **** 1.07 December 29, 2016
 
 Fix rt.cpan.org #118598/#108908
-
 	Serious Makefile.PL issues
 	"make install" now suppressed if pre-1.01 version detected
 
 Fix rt.cpan.org #115558
-
 	Net::DNS::Nameserver does not allow EDNS replies
 
 Fix rt.cpan.org #114917
-
 	Net::DNS::ZoneFile fails to parse mixed case mnemonics
 
 Fix rt.cpan.org #114876
-
 	Use of uninitialized value in lc at MSWin32.pm line 77
 
 Fix rt.cpan.org #114819
-
 	Net::DNS fails to compile with taint checks enabled
 
 Feature
@@ -341,39 +347,31 @@
 **** 1.06 May 27, 2016
 
 Fix rt.cpan.org #114918
-
 	Net::DNS::ZoneFile fails when unnamed RR follows $ORIGIN
 
 Fix rt.cpan.org #114351
-
 	Case sensitive compression breaks resolver->nameservers()
 
 Fix rt.cpan.org #113579
-
 	Net::DNS::Resolver dies on scoped IPv6 nameserver address
 
 Fix rt.cpan.org #113020
-
 	Resolve::Recurse Hangs
 
 Fix rt.cpan.org #112860
-
 	improperly terminated AXFR at t/08-IPv4.t line 446.
 
 
 **** 1.05 March 7, 2016
 
 Fix rt.cpan.org #111559
-
 	1.04: TSIG not working anymore (TSIG.pm)
 
 Fix rt.cpan.org #108908
-
 	Installing recent version gets shadowed by old version.
 	Warnings added to Makefile.PL and t/00-version.t.
 
 Fix rt.cpan.org #66900
-
 	Net::DNS::Async unable to retry truncated UDP using TCP because
 	of limitations in Net::DNS.
 
@@ -381,61 +379,48 @@
 **** 1.04 December 8, 2015
 
 Fix rt.cpan.org #109183
-
 	Semantics of "retry" and "retrans" options has changed with 1.03
 
 Fix rt.cpan.org #109152
-
 	Deprecated method make_query_packet breaks calling code
 
 Fix rt.cpan.org #109135
-
 	Resolver behaves differently with long and short IPv6 address format
 
 Fix rt.cpan.org #108745
-
 	Net::DNS::Resolver bgsend
 
 
 **** 1.03 November 6, 2015
 
 Fix rt.cpan.org #107897
-
 	t/10-recurse.t freezes, never completes
 
 Fix rt.cpan.org #101978
-
 	Update Net::DNS to use IO::Socket::IP
 
 Fix rt.cpan.org #84375
-
 	Timeout doesn't work with bgsend/bgread
 
 Fix rt.cpan.org #47050
-
 	persistent sockets for Resolver::bg(send|read|isready)
 
 Fix rt.cpan.org #15515
-
 	bgsend on TCP
 
 
 **** 1.02 September 16, 2015
 
 Fix rt.cpan.org #107052
-
  	suppress messages: Can't locate Net/DNS/Resolver/linux.pm
 
 Fix rt.cpan.org #106916
-
 	Dependency on MIME::Base32 makes Net::DNS not installable on MSWin32
 
 Fix rt.cpan.org #106565
-
 	Net::DNS::Resolver::Recurse and IPv6 Reverse DNS
 
 Fix rt.cpan.org #105808
-
 	Version test for Pod::Test is broken
 
 
@@ -447,23 +432,18 @@
 	to enable the signature generation and verification functions.
 
 Fix rt.cpan.org #105491
-
 	Can't call method "zclass" on an undefined value at ... Net/DNS/Packet.pm line 474
 
 Fix rt.cpan.org #105421
-
 	Dead link in Net::DNS::FAQ
 
 Fix rt.cpan.org #104657
-
 	Wrong split on Cygwin
 
 Fix rt.cpan.org #102810
-
 	Dynamic update: rr_add overrides ttl of zero
 
 Fix rt.cpan.org #102809
-
 	CAA broken
 
 
@@ -785,8 +765,7 @@
 	to fail silently when creating a TSIG signed packet.
 
 Fix rt.cpan.org #81869
-
-	The rr_del auxilliary function broken by a conflicting change
+	The rr_del auxiliary function broken by a conflicting change
 	in the RR.pm string parser. Note the ambiguous use of ANY,
 	which may stand for CLASS255 or TYPE255 depending upon the
 	argument string presented.

_service:tar_scm:Net-DNS-1.34.tar.gz/MANIFEST -> _service:tar_scm:Net-DNS-1.38.tar.gz/MANIFEST Changed

_service:tar_scm:Net-DNS-1.34.tar.gz/META.json -> _service:tar_scm:Net-DNS-1.38.tar.gz/META.json Changed

@@ -29,15 +29,15 @@
       },
       "configure" : {
          "requires" : {
-            "ExtUtils::MakeMaker" : "6.66",
+            "ExtUtils::MakeMaker" : "6.48",
             "Getopt::Long" : "2.43",
-            "IO::File" : "1.08",
+            "IO::File" : "1.14",
             "IO::Socket::IP" : "0.38"
          }
       },
       "runtime" : {
          "recommends" : {
-            "Digest::BubbleBabble" : "0.01",
+            "Digest::BubbleBabble" : "0.02",
             "Net::LibIDN2" : "1"
          },
          "requires" : {
@@ -46,30 +46,31 @@
             "Digest::MD5" : "2.13",
             "Digest::SHA" : "5.23",
             "Encode" : "2.26",
-            "Exporter" : "5.56",
-            "File::Spec" : "0.86",
-            "IO::File" : "1.08",
-            "IO::Select" : "1.14",
-            "IO::Socket" : "1.26",
+            "Exporter" : "5.63",
+            "File::Spec" : "3.29",
+            "IO::File" : "1.14",
+            "IO::Select" : "1.17",
+            "IO::Socket" : "1.3",
             "IO::Socket::IP" : "0.38",
             "MIME::Base64" : "2.13",
             "PerlIO" : "1.05",
-            "Scalar::Util" : "1.25",
+            "Scalar::Util" : "1.19",
             "Time::Local" : "1.19",
             "perl" : "5.008009"
          }
       },
       "test" : {
          "requires" : {
-            "File::Find" : "1.05",
-            "File::Spec" : "0.86",
-            "IO::File" : "1.08",
-            "Test::Builder" : "0",
-            "Test::More" : "0"
+            "ExtUtils::MakeMaker" : "0",
+            "File::Find" : "1.13",
+            "File::Spec" : "3.29",
+            "IO::File" : "1.14",
+            "Test::Builder" : "0.8",
+            "Test::More" : "0.8"
          }
       }
    },
    "release_status" : "stable",
-   "version" : "1.34",
+   "version" : "1.38",
    "x_serialization_backend" : "JSON::PP version 4.08"
 }

_service:tar_scm:Net-DNS-1.34.tar.gz/META.yml -> _service:tar_scm:Net-DNS-1.38.tar.gz/META.yml Changed

@@ -6,15 +6,15 @@
   - 'Michael Fuhr'
 build_requires:
   ExtUtils::MakeMaker: '0'
-  File::Find: '1.05'
-  File::Spec: '0.86'
-  IO::File: '1.08'
-  Test::Builder: '0'
-  Test::More: '0'
+  File::Find: '1.13'
+  File::Spec: '3.29'
+  IO::File: '1.14'
+  Test::Builder: '0.8'
+  Test::More: '0.8'
 configure_requires:
-  ExtUtils::MakeMaker: '6.66'
+  ExtUtils::MakeMaker: '6.48'
   Getopt::Long: '2.43'
-  IO::File: '1.08'
+  IO::File: '1.14'
   IO::Socket::IP: '0.38'
 dynamic_config: 1
 generated_by: 'ExtUtils::MakeMaker version 7.64, CPAN::Meta::Converter version 2.150010'
@@ -28,7 +28,7 @@
     - t
     - inc
 recommends:
-  Digest::BubbleBabble: '0.01'
+  Digest::BubbleBabble: '0.02'
   Net::LibIDN2: '1'
 requires:
   Carp: '1.1'
@@ -36,16 +36,16 @@
   Digest::MD5: '2.13'
   Digest::SHA: '5.23'
   Encode: '2.26'
-  Exporter: '5.56'
-  File::Spec: '0.86'
-  IO::File: '1.08'
-  IO::Select: '1.14'
-  IO::Socket: '1.26'
+  Exporter: '5.63'
+  File::Spec: '3.29'
+  IO::File: '1.14'
+  IO::Select: '1.17'
+  IO::Socket: '1.3'
   IO::Socket::IP: '0.38'
   MIME::Base64: '2.13'
   PerlIO: '1.05'
-  Scalar::Util: '1.25'
+  Scalar::Util: '1.19'
   Time::Local: '1.19'
   perl: '5.008009'
-version: '1.34'
+version: '1.38'
 x_serialization_backend: 'CPAN::Meta::YAML version 0.018'

_service:tar_scm:Net-DNS-1.34.tar.gz/Makefile.PL -> _service:tar_scm:Net-DNS-1.38.tar.gz/Makefile.PL Changed

@@ -1,40 +1,41 @@
 #
-# $Id: Makefile.PL 1864 2022-04-14 15:18:49Z willem $	-*-perl-*-
+# $Id: Makefile.PL 1921 2023-05-08 18:39:59Z willem $	-*-perl-*-
 #
 
 use 5.008009;
 use strict;
 use warnings;
 use ExtUtils::MakeMaker;
-my $MM = $ExtUtils::MakeMaker::VERSION;
 
 my $distro = 'Net::DNS';
 my $module = join '/', 'lib', split /::/, "$distro.pm";
-my @author = ( 'Dick Franks', 'Olaf Kolkman', 'Michael Fuhr' );
+my $author = 'Dick Franks', 'Olaf Kolkman', 'Michael Fuhr';
+$author = join ', ', @$author if $ExtUtils::MakeMaker::VERSION < 6.58;
 
 
 # See perldoc ExtUtils::MakeMaker for details of how to influence
 # the contents of the Makefile that is written.
 
 my %metadata = (
-	NAME		   => "$distro",
-	VERSION_FROM	   => "$module",
-	ABSTRACT_FROM	   => "$module",
-	AUTHOR		   => $MM < 6.58 ? "$author0 et al" : @author,
+	NAME		   => $distro,
+	VERSION_FROM	   => $module,
+	ABSTRACT_FROM	   => $module,
+	AUTHOR		   => $author,
 	LICENSE		   => 'mit',
 	MIN_PERL_VERSION   => '5.008009',
 	CONFIGURE_REQUIRES => {
-		'ExtUtils::MakeMaker' => 6.66,
+		'ExtUtils::MakeMaker' => 6.48,
 		'Getopt::Long'	      => 2.43,
-		'IO::File'	      => 1.08,
+		'IO::File'	      => 1.14,
 		'IO::Socket::IP'      => 0.38,
 		},
 	TEST_REQUIRES => {
-		'File::Find'	=> 1.05,
-		'File::Spec'	=> 0.86,
-		'IO::File'	=> 1.08,
-		'Test::Builder' => 0,
-		'Test::More'	=> 0,
+		'ExtUtils::MakeMaker' => 0,
+		'File::Find'	      => 1.13,
+		'File::Spec'	      => 3.29,
+		'IO::File'	      => 1.14,
+		'Test::Builder'	      => 0.80,
+		'Test::More'	      => 0.80,
 		} );
 
 
@@ -54,22 +55,22 @@
 	'Digest::MD5'	 => 2.13,
 	'Digest::SHA'	 => 5.23,
 	'Encode'	 => 2.26,
-	'Exporter'	 => 5.56,
-	'File::Spec'	 => 0.86,
-	'IO::File'	 => 1.08,
-	'IO::Select'	 => 1.14,
-	'IO::Socket'	 => 1.26,
+	'Exporter'	 => 5.63,
+	'File::Spec'	 => 3.29,
+	'IO::File'	 => 1.14,
+	'IO::Select'	 => 1.17,
+	'IO::Socket'	 => 1.30,
 	'IO::Socket::IP' => 0.38,
 	'MIME::Base64'	 => 2.13,
 	'PerlIO'	 => 1.05,
-	'Scalar::Util'	 => 1.25,
+	'Scalar::Util'	 => 1.19,
 	'Time::Local'	 => 1.19,
 	%$platform
 	);
 
 
 my %optional = (
-	'Digest::BubbleBabble' => 0.01,
+	'Digest::BubbleBabble' => 0.02,
 	'Net::LibIDN2'	       => 1.00,
 	);
 
@@ -215,11 +216,15 @@
 package MY;				## customise generated Makefile
 
 sub test {
-	return shift->SUPER::test() if $^O =~ /cygwin|MSWin/i;
+	return join '', shift->SUPER::test(), <<'END' if $^O =~ /MSWin/i;
+TEST_DIR = t
+FULLPERLRUN = $(FULLPERL) "-I$(TEST_DIR)"
+END
 
 	return join '', shift->SUPER::test(), <<'END';
-# suppress parallel test execution
-FULLPERLRUN = HARNESS_OPTIONS=c $(FULLPERL)
+# suppress parallel test execution	include test directory
+TEST_DIR = t
+FULLPERLRUN = HARNESS_OPTIONS=j1:c $(FULLPERL) "-I$(TEST_DIR)"
 END
 }
 
@@ -272,7 +277,7 @@
 ##	@installed
 ##
 ##	The installation would be rendered ineffective because the
-##	installed version occurs in the library search path before
+##	existing @version occurs in the library search path before
 ##	$install_site
 ##
 ##	The generated Makefile supports build and test only.
@@ -281,13 +286,10 @@
 	my $echo = '	$(NOECHO) $(ECHO) "##"';
 	$message =~ s/##/$echo/eg;
 
-	return join '', <<'END', $message;
+	return join '', <<"END";
 install :
-	$(NOECHO) $(ECHO) "##	Makefile supports build and test only"
-	$(NOECHO) $(ECHO) "##	(see message from Makefile.PL)"
-	$(NOECHO) $(FALSE)
-
-test :: $(TEST_TYPE)
+	$message
+	\$(NOECHO) \$(FALSE)
 END
 }
 
@@ -297,7 +299,7 @@
 test_cover :
 	cover -delete
 	HARNESS_PERL_SWITCHES=-MDevel::Cover $(MAKE) test
-	cover -summary
+	cover
 END
 }

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS.pm Changed

@@ -4,9 +4,9 @@
 use warnings;
 
 our $VERSION;
-$VERSION = '1.34';
-$VERSION = eval { $VERSION };
-our $SVNVERSION = (qw$Id: DNS.pm 1867 2022-05-30 10:07:36Z willem $)2;
+$VERSION = '1.38';
+$VERSION = eval {$VERSION};
+our $SVNVERSION = (qw$Id: DNS.pm 1922 2023-05-08 18:46:00Z willem $)2;
 
 
 =head1 NAME
@@ -23,8 +23,8 @@
 (DNS) resolver. It allows the programmer to perform DNS queries that are
 beyond the capabilities of "gethostbyname" and "gethostbyaddr".
 
-The programmer should be familiar with the structure of a DNS packet.
-See RFC 1035 or DNS and BIND (Albitz & Liu) for details.
+The programmer should be familiar with the structure of a DNS packet
+and the zone file presentation format described in RFC1035.
 
 =cut
 
@@ -56,10 +56,10 @@
 #	@rr = rr($res, 'example.com' ... );
 #
 sub rr {
-	my ($arg1) = @_;
-	my $res = ref($arg1) ? shift : Net::DNS::Resolver->new();
+	my @arg = @_;
+	my $res = ( ref( $arg0 ) ? shift @arg : Net::DNS::Resolver->new() );
 
-	my $reply = $res->query(@_);
+	my $reply = $res->query(@arg);
 	my @list  = $reply ? $reply->answer : ();
 	return @list;
 }
@@ -73,9 +73,9 @@
 #	@mx = mx($res, 'example.com');
 #
 sub mx {
-	my ($arg1) = @_;
-	my @res = ( ref($arg1) ? shift : () );
-	my ( $name, @class ) = @_;
+	my @arg = @_;
+	my @res = ( ref( $arg0 ) ? shift @arg : () );
+	my ( $name, @class ) = @arg;
 
 	# This construct is best read backwards.
 	#
@@ -98,9 +98,10 @@
 #    @prioritysorted = rrsort( "SRV", "priority", @rr_array );
 #
 sub rrsort {
-	my $rrtype = uc shift;
-	my ( $attribute, @rr ) = @_;	## NB: attribute is optional
-	( @rr, $attribute ) = @_ if ref($attribute) =~ /^Net::DNS::RR/;
+	my @arg	   = @_;
+	my $rrtype = uc shift @arg;
+	my ( $attribute, @rr ) = @arg;	## NB: attribute is optional
+	( @rr, $attribute ) = @arg if ref($attribute) =~ /^Net::DNS::RR/;
 
 	my @extracted = grep { $_->type eq $rrtype } @rr;
 	return @extracted unless scalar @extracted;
@@ -111,7 +112,7 @@
 
 
 #
-# Auxilliary functions to support policy-driven zone serial numbering.
+# Auxiliary functions to support policy-driven zone serial numbering.
 #
 #	$successor = $soa->serial(SEQUENTIAL);
 #	$successor = $soa->serial(UNIXTIME);
@@ -129,18 +130,20 @@
 
 
 #
-# Auxilliary functions to support dynamic update.
+# Auxiliary functions to support dynamic update.
 #
 
 sub yxrrset {
-	my $rr = Net::DNS::RR->new(@_);
+	my @arg = @_;
+	my $rr	= Net::DNS::RR->new(@arg);
 	$rr->ttl(0);
 	$rr->class('ANY') unless $rr->rdata;
 	return $rr;
 }
 
 sub nxrrset {
-	my $rr = Net::DNS::RR->new(@_);
+	my @arg = @_;
+	my $rr	= Net::DNS::RR->new(@arg);
 	return Net::DNS::RR->new(
 		name  => $rr->name,
 		type  => $rr->type,
@@ -149,8 +152,9 @@
 }
 
 sub yxdomain {
-	my ( $domain, @etc ) = map {split} @_;
-	my $rr = Net::DNS::RR->new( scalar(@etc) ? @_ : ( name => $domain ) );
+	my @arg = @_;
+	my ( $domain, @etc ) = map {split} @arg;
+	my $rr = Net::DNS::RR->new( scalar(@etc) ? @arg : ( name => $domain ) );
 	return Net::DNS::RR->new(
 		name  => $rr->name,
 		type  => 'ANY',
@@ -159,8 +163,9 @@
 }
 
 sub nxdomain {
-	my ( $domain, @etc ) = map {split} @_;
-	my $rr = Net::DNS::RR->new( scalar(@etc) ? @_ : ( name => $domain ) );
+	my @arg = @_;
+	my ( $domain, @etc ) = map {split} @arg;
+	my $rr = Net::DNS::RR->new( scalar(@etc) ? @arg : ( name => $domain ) );
 	return Net::DNS::RR->new(
 		name  => $rr->name,
 		type  => 'ANY',
@@ -169,14 +174,16 @@
 }
 
 sub rr_add {
-	my $rr = Net::DNS::RR->new(@_);
+	my @arg = @_;
+	my $rr	= Net::DNS::RR->new(@arg);
 	$rr->{ttl} = 86400 unless defined $rr->{ttl};
 	return $rr;
 }
 
 sub rr_del {
-	my ( $domain, @etc ) = map {split} @_;
-	my $rr = Net::DNS::RR->new( scalar(@etc) ? @_ : ( name => $domain, type => 'ANY' ) );
+	my @arg = @_;
+	my ( $domain, @etc ) = map {split} @arg;
+	my $rr = Net::DNS::RR->new( scalar(@etc) ? @arg : ( name => $domain, type => 'ANY' ) );
 	$rr->class( $rr->rdata ? 'NONE' : 'ANY' );
 	$rr->ttl(0);
 	return $rr;
@@ -251,7 +258,7 @@
 
 =head1 METHODS
 
-Net::DNS exports methods and auxilliary functions to support
+Net::DNS exports methods and auxiliary functions to support
 DNS updates, zone serial number management, and simple DNS queries.
 
 =head2 version
@@ -305,7 +312,7 @@
 
 =head1 Dynamic DNS Update Support
 
-The Net::DNS module provides auxilliary functions which support
+The Net::DNS module provides auxiliary functions which support
 dynamic DNS update requests.
 
     $update = Net::DNS::Update->new( 'example.com' );
@@ -413,7 +420,7 @@
 
 =head1 Zone Serial Number Management
 
-The Net::DNS module provides auxilliary functions which support
+The Net::DNS module provides auxiliary functions which support
 policy-driven zone serial numbering regimes.
 
     $soa->serial(SEQUENTIAL);
@@ -437,7 +444,7 @@
 
     $successor = $soa->serial( YYYYMMDDxx );
 
-The 32 bit value returned by the auxilliary C<YYYYMMDDxx()> function
+The 32 bit value returned by the auxiliary C<YYYYMMDDxx()> function
 will be used as the base for the date-coded zone serial number.
 Serial number increments must be limited to 100 per day for the
 date information to remain useful.
@@ -647,10 +654,9 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS::Resolver>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-L<Net::DNS::Packet>, L<Net::DNS::Update>,
-RFC1035, L<http://www.net-dns.org/>,
-I<DNS and BIND> by Paul Albitz & Cricket Liu
+L<perl> L<Net::DNS::Resolver> L<Net::DNS::Question> L<Net::DNS::RR>
+L<Net::DNS::Packet> L<Net::DNS::Update>
+L<RFC1035|https://tools.ietf.org/html/rfc1035>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/Domain.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/Domain.pm Changed

@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-our $VERSION = (qw$Id: Domain.pm 1855 2021-11-26 11:33:48Z willem $)2;
+our $VERSION = (qw$Id: Domain.pm 1913 2023-04-20 12:33:30Z willem $)2;
 
 
 =head1 NAME
@@ -124,7 +124,8 @@
 		}
 
 		s/\134(\060-\071{3})/$unescape{$1}/eg;	# restore numeric escapes
-		s/\134(.)/$1/g;					# restore character escapes
+		s/\134(^\134)/$1/g;				# restore character escapes
+		s/\134(\134)/$1/g;				# restore escaped escapes
 		croak qq(label too long in "$s") if length > 63;
 	}
 
@@ -170,7 +171,7 @@
 
 =head2 fqdn
 
-    @fqdn = $domain->fqdn;
+    $fqdn = $domain->fqdn;
 
 Returns a character string containing the fully qualified domain
 name, including the trailing dot.
@@ -179,7 +180,7 @@
 
 sub fqdn {
 	my $name = &name;
-	return $name =~ /.$/ ? $name : $name . '.';		# append trailing dot
+	return $name =~ /.$/ ? $name : "$name.";		# append trailing dot
 }
 
 
@@ -243,10 +244,7 @@
 
 =cut
 
-sub string {
-	my $name = &name;
-	return $name =~ /.$/ ? $name : $name . '.';		# append trailing dot
-}
+sub string { return &fqdn }
 
 
 =head2 origin
@@ -265,7 +263,7 @@
 
 sub origin {
 	my ( $class, $name ) = @_;
-	my $domain = defined $name ? Net::DNS::Domain->new($name) : return $placebo;
+	my $domain = defined $name ? __PACKAGE__->new($name) : return $placebo;
 
 	return sub {						# closure w.r.t. $domain
 		my $constructor = shift;
@@ -393,7 +391,10 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::LibIDN2>, RFC1034, RFC1035, RFC5891, Unicode TR#16
+L<perl> L<Net::DNS> L<Net::LibIDN2>
+L<RFC1034|https://tools.ietf.org/html/rfc1034>
+L<RFC1035|https://tools.ietf.org/html/rfc1035>
+L<RFC5891|https://tools.ietf.org/html/rfc5891>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/DomainName.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/DomainName.pm Changed

@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-our $VERSION = (qw$Id: DomainName.pm 1855 2021-11-26 11:33:48Z willem $)2;
+our $VERSION = (qw$Id: DomainName.pm 1898 2023-02-15 14:27:22Z willem $)2;
 
 
 =head1 NAME
@@ -97,7 +97,9 @@
 	my $self   = bless {label => $label}, shift;
 	my $buffer = shift;					# reference to data buffer
 	my $offset = shift || 0;				# offset within buffer
-	my $cache  = shift || {};				# hashed objectref by offset
+	my $linked = shift;					# caller's compression index
+	my $cache  = $linked;
+	$cache->{$offset} = $self;				# hashed objectref by offset
 
 	my $buflen = length $$buffer;
 	my $index  = $offset;
@@ -116,9 +118,10 @@
 		} else {					# compression pointer
 			my $link = 0x3FFF & unpack( "\@$index n", $$buffer );
 			croak 'corrupt compression pointer' unless $link < $offset;
+			croak 'invalid compression pointer' unless $linked;
 
 			# uncoverable condition false
-			$self->{origin} = $cache->{$link} ||= Net::DNS::DomainName->decode( $buffer, $link, $cache );
+			$self->{origin} = $cache->{$link} ||= __PACKAGE__->decode( $buffer, $link, $cache );
 			return wantarray ? ( $self, $index + 2 ) : $self;
 		}
 	}
@@ -276,8 +279,11 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::Domain>, RFC1035, RFC2535,
-RFC3597, RFC4034
+L<perl> L<Net::DNS> L<Net::DNS::Domain>
+L<RFC1035|https://tools.ietf.org/html/rfc1035>
+L<RFC2535|https://tools.ietf.org/html/rfc2535>
+L<RFC3597|https://tools.ietf.org/html/rfc3597>
+L<RFC4034|https://tools.ietf.org/html/rfc4034>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/Header.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/Header.pm Changed

@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-our $VERSION = (qw$Id: Header.pm 1855 2021-11-26 11:33:48Z willem $)2;
+our $VERSION = (qw$Id: Header.pm 1910 2023-03-30 19:16:30Z willem $)2;
 
 
 =head1 NAME
@@ -66,16 +66,16 @@
 	my $an	   = $self->ancount;
 	my $ns	   = $self->nscount;
 	my $ar	   = $self->arcount;
-
-	my $opt = $$self->edns;
-	my $edns = $opt->_specified ? $opt->string : '';
-
-	return <<END . $edns if $opcode eq 'UPDATE';
+	return <<"QQ" if $opcode eq 'DSO';
+;;	id = $id
+;;	qr = $qr		opcode = $opcode	rcode = $rcode
+;;	qdcount = $qd	ancount = $an	nscount = $ns	arcount = $ar
+QQ
+	return <<"QQ" if $opcode eq 'UPDATE';
 ;;	id = $id
 ;;	qr = $qr		opcode = $opcode	rcode = $rcode
 ;;	zocount = $qd	prcount = $an	upcount = $ns	adcount = $ar
-END
-
+QQ
 	my $aa = $self->aa;
 	my $tc = $self->tc;
 	my $rd = $self->rd;
@@ -84,14 +84,13 @@
 	my $ad = $self->ad;
 	my $cd = $self->cd;
 	my $do = $self->do;
-
-	return <<END . $edns;
+	return <<"QQ";
 ;;	id = $id
 ;;	qr = $qr	aa = $aa	tc = $tc	rd = $rd	opcode = $opcode
 ;;	ra = $ra	z  = $zz	ad = $ad	cd = $cd	rcode  = $rcode
 ;;	qdcount = $qd	ancount = $an	nscount = $ns	arcount = $ar
 ;;	do = $do
-END
+QQ
 }
 
 
@@ -120,11 +119,18 @@
 
 =cut
 
+my ( $cache1, $cache2, $limit );				# two layer cache
+
 sub id {
-	my ( $self, @arg ) = @_;
-	$$self->{id} = shift(@arg) if scalar @arg;
-	return $$self->{id} if defined $$self->{id};
-	return $$self->{id} = int rand(0xffff);
+	my ( $self, @value ) = @_;
+	for (@value) { $$self->{id} = $_ }
+	my $ident = $$self->{id};
+	return $ident if $ident;
+	return $ident if defined($ident) && $self->opcode eq 'DSO';
+	( $cache1, $cache2, $limit ) = ( {0 => 1}, $cache1, 50 ) unless $limit--;
+	$ident = int rand(0xffff);				# preserve short-term uniqueness
+	$ident = int rand(0xffff) while $cache1->{$ident}++ + exists( $cache2->{$ident} );
+	return $$self->{id} = $ident;
 }
 
 
@@ -143,7 +149,7 @@
 	for ( $$self->{status} ) {
 		return opcodebyval( ( $_ >> 11 ) & 0x0f ) unless defined $arg;
 		$opcode = opcodebyname($arg);
-		$_ = ( $_ & 0x87ff ) | ( $opcode << 11 );
+		$_	= ( $_ & 0x87ff ) | ( $opcode << 11 );
 	}
 	return $opcode;
 }
@@ -164,7 +170,6 @@
 	for ( $$self->{status} ) {
 		my $opt = $$self->edns;
 		unless ( defined $arg ) {
-			return rcodebyval( $_ & 0x0f ) unless $opt->_specified;
 			$rcode = ( $opt->rcode & 0xff0 ) | ( $_ & 0x00f );
 			$opt->rcode($rcode);			# write back full 12-bit rcode
 			return $rcode == 16 ? 'BADVERS' : rcodebyval($rcode);
@@ -188,7 +193,8 @@
 =cut
 
 sub qr {
-	return shift->_dnsflag( 0x8000, @_ );
+	my ( $self, @value ) = @_;
+	return $self->_dnsflag( 0x8000, @value );
 }
 
 
@@ -202,7 +208,8 @@
 =cut
 
 sub aa {
-	return shift->_dnsflag( 0x0400, @_ );
+	my ( $self, @value ) = @_;
+	return $self->_dnsflag( 0x0400, @value );
 }
 
 
@@ -216,7 +223,8 @@
 =cut
 
 sub tc {
-	return shift->_dnsflag( 0x0200, @_ );
+	my ( $self, @value ) = @_;
+	return $self->_dnsflag( 0x0200, @value );
 }
 
 
@@ -230,7 +238,8 @@
 =cut
 
 sub rd {
-	return shift->_dnsflag( 0x0100, @_ );
+	my ( $self, @value ) = @_;
+	return $self->_dnsflag( 0x0100, @value );
 }
 
 
@@ -244,7 +253,8 @@
 =cut
 
 sub ra {
-	return shift->_dnsflag( 0x0080, @_ );
+	my ( $self, @value ) = @_;
+	return $self->_dnsflag( 0x0080, @value );
 }
 
 
@@ -255,7 +265,8 @@
 =cut
 
 sub z {
-	return shift->_dnsflag( 0x0040, @_ );
+	my ( $self, @value ) = @_;
+	return $self->_dnsflag( 0x0040, @value );
 }
 
 
@@ -272,7 +283,8 @@
 =cut
 
 sub ad {
-	return shift->_dnsflag( 0x0020, @_ );
+	my ( $self, @value ) = @_;
+	return $self->_dnsflag( 0x0020, @value );
 }
 
 
@@ -286,7 +298,8 @@
 =cut
 
 sub cd {
-	return shift->_dnsflag( 0x0010, @_ );
+	my ( $self, @value ) = @_;
+	return $self->_dnsflag( 0x0010, @value );
 }
 
 
@@ -300,13 +313,10 @@
 
 =cut
 
-our $warned;
-
 sub qdcount {
-	my $self = shift;
-	return $$self->{count}0 || scalar @{$$self->{question}} unless scalar @_;
-	carp 'header->qdcount attribute is read-only' unless $warned++;
-	return;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->_warn('packet->header->qdcount is read-only') }
+	return $$self->{count}0 || scalar @{$$self->{question}};
 }
 
 
@@ -323,10 +333,9 @@
 =cut
 
 sub ancount {
-	my $self = shift;
-	return $$self->{count}1 || scalar @{$$self->{answer}} unless scalar @_;
-	carp 'header->ancount attribute is read-only' unless $warned++;
-	return;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->_warn('packet->header->ancount is read-only') }
+	return $$self->{count}1 || scalar @{$$self->{answer}};
 }
 
 
@@ -343,10 +352,9 @@
 =cut
 
 sub nscount {
-	my $self = shift;
-	return $$self->{count}2 || scalar @{$$self->{authority}} unless scalar @_;
-	carp 'header->nscount attribute is read-only' unless $warned++;
-	return;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->_warn('packet->header->nscount is read-only') }
+	return $$self->{count}2 || scalar @{$$self->{authority}};
 }
 
 
@@ -362,10 +370,9 @@
 =cut
 
 sub arcount {
-	my $self = shift;
-	return $$self->{count}3 || scalar @{$$self->{additional}} unless scalar @_;
-	carp 'header->arcount attribute is read-only' unless $warned++;
-	return;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->_warn('packet->header->arcount is read-only') }
+	return $$self->{count}3 || scalar @{$$self->{additional}};
 }
 
 sub zocount { return &qdcount; }
@@ -387,7 +394,8 @@
 =cut
 
 sub do {
-	return shift->_ednsflag( 0x8000, @_ );
+	my ( $self, @value ) = @_;
+	return $self->_ednsflag( 0x8000, @value );
 }
 
 
@@ -398,20 +406,16 @@
 
 =head2 UDP packet size
 
-    $udp_max = $packet->header->size;
-    $udp_max = $packet->edns->size;
+    $udp_max = $packet->edns->UDPsize;
 
 EDNS offers a mechanism to advertise the maximum UDP packet size
 which can be assembled by the local network stack.
 
-UDP size advertisement can be viewed as either a header extension or
-an EDNS feature.  Endless debate is avoided by supporting both views.
-
 =cut
 
-sub size {
-	my $self = shift;
-	return $$self->edns->size(@_);
+sub size {				## historical
+	my ( $self, @value ) = @_;
+	return $$self->edns->UDPsize(@value);
 }
 
 
@@ -421,7 +425,7 @@
     $version = $header->edns->version;
     @options = $header->edns->options;
     $option  = $header->edns->option(n);
-    $udp_max = $packet->edns->size;
+    $udp_max = $packet->edns->UDPsize;
 
 Auxiliary function which provides access to the EDNS protocol
 extension OPT RR.
@@ -437,27 +441,33 @@
 ########################################
 
 sub _dnsflag {
-	my $self = shift;
-	my $flag = shift;
+	my ( $self, $flag, @value ) = @_;
 	for ( $$self->{status} ) {
 		my $set = $_ | $flag;
-		my $not = $set - $flag;
-		$_ = (shift) ? $set : $not if scalar @_;
-		$flag = ( $_ & $flag ) ? 1 : 0;
+		$_ = ( shift @value ) ? $set : ( $set ^ $flag ) if @value;
+		$flag &= $_;
 	}
-	return $flag;
+	return $flag ? 1 : 0;
 }
 
 
 sub _ednsflag {
-	my ( $self, $flag, @val ) = @_;
-	my $edns = $$self->edns->flags || 0;
-	return $flag & $edns ? 1 : 0 unless scalar @val;
-	my $set = $flag | $edns;
-	my $not = $set - $flag;
-	my $val = shift(@val) ? $set : $not;
-	$$self->edns->flags($val) unless $val == $edns;
-	return ( $val & $flag ) ? 1 : 0;
+	my ( $self, $flag, @value ) = @_;
+	my $edns = $$self->edns;
+	for ( $edns->flags ) {
+		my $set = $_ | $flag;
+		$edns->flags( $_ = ( shift @value ) ? $set : ( $set ^ $flag ) ) if @value;
+		$flag &= $_;
+	}
+	return $flag ? 1 : 0;
+}
+
+
+my %warned;
+
+sub _warn {
+	my ( undef, @note ) = @_;
+	return carp "usage; @note" unless $warned{"@note"}++;
 }
 
 
@@ -473,7 +483,7 @@
 
 Portions Copyright (c)2002,2003 Chris Reinhardt.
 
-Portions Copyright (c)2012 Dick Franks.
+Portions Copyright (c)2012,2022 Dick Franks.
 
 All rights reserved.
 
@@ -499,8 +509,8 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::Packet>, L<Net::DNS::RR::OPT>
-RFC 1035 Section 4.1.1
+L<perl> L<Net::DNS> L<Net::DNS::Packet> L<Net::DNS::RR::OPT>
+L<RFC1035(4.1.1)|https://tools.ietf.org/html/rfc1035>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/Mailbox.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/Mailbox.pm Changed

@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-our $VERSION = (qw$Id: Mailbox.pm 1855 2021-11-26 11:33:48Z willem $)2;
+our $VERSION = (qw$Id: Mailbox.pm 1910 2023-03-30 19:16:30Z willem $)2;
 
 
 =head1 NAME
@@ -61,18 +61,13 @@
 
 	s/^.*<//g;						# strip excess on left
 	s/>.*$//g;						# strip excess on right
+	s/^\@.+://;						# strip deprecated source route
+	s/\\\./\\046/g;						# disguise escaped dots
 
-	s/\\\@/\\064/g;						# disguise escaped @
-	s/("^"*)\@(^"*")/$1\\064$2/g;			# disguise quoted @
+	my ( $localpart, @domain ) = split /@.(^@;:"*$)/;	# split on rightmost @
+	s/\./\\046/g for $localpart ||= '';			# escape dots in local part
 
-	my ( $mbox, @host ) = split /\@/;			# split on @ if present
-	for ( $mbox ||= '' ) {
-		s/^.*"(.*)".*$/$1/;				# strip quotes
-		s/\\\./\\046/g;					# disguise escaped dot
-		s/\./\\046/g if @host;				# escape dots in local part
-	}
-
-	return bless __PACKAGE__->SUPER::new( join '.', $mbox, @host ), $class;
+	return bless __PACKAGE__->SUPER::new( join '.', $localpart, @domain ), $class;
 }
 
 
@@ -91,10 +86,10 @@
 	my @label = shift->label;
 	local $_ = shift(@label) || return '<>';
 	s/\\\\//g;						# delete escaped \
+	s/^\\034(.*)\\034$/"$1"/;				# unescape enclosing quotes
 	s/\\\d\d\d//g;						# delete non-printable
 	s/\\\./\./g;						# unescape dots
-	s/\\"//g;						# delete \ "
-	s/^(.*)$/"$1"/ if /"(),:;<>@\\\\/;			# quote local part
+	s/\\//g;						# delete escapes
 	return $_ unless scalar(@label);
 	return join '@', $_, join '.', @label;
 }
@@ -148,7 +143,9 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::DomainName>, RFC1035, RFC5322 (RFC822)
+L<perl> L<Net::DNS> L<Net::DNS::DomainName>
+L<RFC1035|https://tools.ietf.org/html/rfc1035>
+L<RFC5322|https://tools.ietf.org/html/rfc5322>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/Nameserver.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/Nameserver.pm Changed

@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-our $VERSION = (qw$Id: Nameserver.pm 1860 2021-12-11 09:19:50Z willem $)2;
+our $VERSION = (qw$Id: Nameserver.pm 1923 2023-05-09 08:06:25Z willem $)2;
 
 
 =head1 NAME
@@ -15,7 +15,7 @@
     use Net::DNS::Nameserver;
 
     my $nameserver = Net::DNS::Nameserver->new(
-	LocalAddr	=> '::1' , '127.0.0.1',
+	LocalAddr	=> '::1', '127.0.0.1',
 	ZoneFile	=> "filename"
 	);
 
@@ -39,26 +39,19 @@
 
 =cut
 
-use constant USE_SOCKET_IP => defined eval 'use IO::Socket::IP 0.38; 1;';    ## no critic
-require IO::Socket::INET unless USE_SOCKET_IP;
-
 use integer;
 use Carp;
 use Net::DNS;
 use Net::DNS::ZoneFile;
 
-use IO::Socket;
+use IO::Socket::IP 0.38;
 use IO::Select;
 
-use constant FORCE_IPv4 => 0;
+use constant USE_POSIX => defined eval 'use POSIX ":sys_wait_h"; 1';	## no critic
 
 use constant DEFAULT_ADDR => qw(::1 127.0.0.1);
 use constant DEFAULT_PORT => 5353;
 
-use constant STATE_ACCEPTED   => 1;
-use constant STATE_GOT_LENGTH => 2;
-use constant STATE_SENDING    => 3;
-
 use constant PACKETSZ => 512;
 
 
@@ -69,91 +62,22 @@
 sub new {
 	my ( $class, %self ) = @_;
 	my $self = bless \%self, $class;
-	if ( !exists $self{ReplyHandler} ) {
-		if ( my $handler = UNIVERSAL::can( $class, "ReplyHandler" ) ) {
-			$self{ReplyHandler} = sub { $handler->( $self, @_ ); };
-		}
-	}
-	croak 'No reply handler!' unless ref( $self{ReplyHandler} ) eq "CODE";
 
 	$self->ReadZoneFile( $self{ZoneFile} ) if exists $self{ZoneFile};
 
-	# local server addresses must also be accepted by a resolver
+	croak 'No reply handler!' unless ref( $self{ReplyHandler} ) eq "CODE";
+
+	# local server addresses need to be accepted by a resolver
 	my $LocalAddr = $self{LocalAddr} || DEFAULT_ADDR;
 	my $resolver  = Net::DNS::Resolver->new( nameservers => $LocalAddr );
-	$resolver->force_v4(1) unless USE_SOCKET_IP;
-	$resolver->force_v4(1) if FORCE_IPv4;
-	my @localaddresses = $resolver->nameservers;
+	$resolver->force_v4(1) if $self{Force_IPv4};
+	$resolver->force_v6(1) if $self{Force_IPv6};
+	$self{LocalAddr} = $resolver->nameservers;
+	$self{LocalPort} ||= DEFAULT_PORT;
 
-	my $port = $self{LocalPort} || DEFAULT_PORT;
 	$self{Truncate}	   = 1	 unless defined( $self{Truncate} );
 	$self{IdleTimeout} = 120 unless defined( $self{IdleTimeout} );
 
-	my @sock_tcp;						# All the TCP sockets we will listen to.
-	my @sock_udp;						# All the UDP sockets we will listen to.
-
-	# while we are here, print incomplete lines as they come along.
-	local $| = 1 if $self{Verbose};
-
-	foreach my $addr (@localaddresses) {
-
-		#--------------------------------------------------------------------------
-		# Create the TCP socket.
-		#--------------------------------------------------------------------------
-
-		print "\nCreating TCP socket $addr#$port - " if $self{Verbose};
-
-		my $sock_tcp = inet_new(
-			LocalAddr => $addr,
-			LocalPort => $port,
-			Listen	  => 64,
-			Proto	  => "tcp",
-			Reuse	  => 1,
-			Blocking  => 0,
-			);
-		if ($sock_tcp) {
-			push @sock_tcp, $sock_tcp;
-			print "done.\n" if $self{Verbose};
-		} else {
-			carp "Couldn't create TCP socket: $!";
-		}
-
-		#--------------------------------------------------------------------------
-		# Create the UDP Socket.
-		#--------------------------------------------------------------------------
-
-		print "Creating UDP socket $addr#$port - " if $self{Verbose};
-
-		my $sock_udp = inet_new(
-			LocalAddr => $addr,
-			LocalPort => $port,
-			Proto	  => "udp",
-			);
-
-		if ($sock_udp) {
-			push @sock_udp, $sock_udp;
-			print "done.\n" if $self{Verbose};
-		} else {
-			carp "Couldn't create UDP socket: $!";
-		}
-
-	}
-
-	#--------------------------------------------------------------------------
-	# Create the Select object.
-	#--------------------------------------------------------------------------
-
-	my $select = $self{select} = IO::Select->new;
-
-	$select->add(@sock_tcp);
-	$select->add(@sock_udp);
-
-	return unless $select->count;
-
-	#--------------------------------------------------------------------------
-	# Return the object.
-	#--------------------------------------------------------------------------
-
 	return $self;
 }
 
@@ -166,16 +90,24 @@
 	my ( $self, $file ) = @_;
 	my $zonefile = Net::DNS::ZoneFile->new($file);
 
-	my $RRhash = $self->{RRhash} = {};
+	my $RRhash = $self->{index} = {};
 	my $RRlist = ;
+	my @zonelist;
 	while ( my $rr = $zonefile->read ) {
-		my ($leaf) = $rr->{owner}->label;
-		push @{$RRhash->{lc $leaf}}, $rr;
+		push @{$RRhash->{lc $rr->owner}}, $rr;
 
 		# Warning: Nasty trick abusing SOA to reference zone RR list
-		if ( $rr->type eq 'SOA' ) { $RRlist = $rr->{RRlist} =  }
-		else			  { push @$RRlist, $rr }
+		if ( $rr->type eq 'SOA' ) {
+			$RRlist = $rr->{RRlist} = ;
+			push @zonelist, lc $rr->owner;
+		} else {
+			push @$RRlist, $rr;
+		}
 	}
+
+	$self->{namelist}     = sort { length($b) <=> length($a) } keys %$RRhash;
+	$self->{zonelist}     = sort { length($b) <=> length($a) } @zonelist;
+	$self->{ReplyHandler} = sub { $self->ReplyHandler(@_) };
 	return;
 }
 
@@ -187,55 +119,77 @@
 sub ReplyHandler {
 	my ( $self, $qname, $qclass, $qtype, $peerhost, $query, $conn ) = @_;
 	my $opcode = $query->header->opcode;
-	my $rcode  = 'NOERROR';
+	my $RRhash = $self->{index};
+	my $rcode;
+	my %headermask;
 	my @ans;
-
-	my $lcase = lc $qname;					# assume $qclass always 'IN'
-	my ( $leaf, @tail ) = split /\./, $lcase;
-	my $RRhash = $self->{RRhash};
-	my $RRlist = $RRhash->{$leaf} || ;			# hash, then linear search
-	my @match  = grep { lc( $_->owner ) eq $lcase } @$RRlist;
+	my @auth;
 
 	if ( $qtype eq 'AXFR' ) {
-		my ($soa) = grep { $_->type eq 'SOA' } @match;
-		if ($soa) { push @ans, $soa, @{$soa->{RRlist}}, $soa }
-		else	  { $rcode = 'NOTAUTH' }
+		my $RRlist = $RRhash->{lc $qname} || ;
+		my ($soa) = grep { $_->type eq 'SOA' } @$RRlist;
+		if ($soa) {
+			$rcode = 'NOERROR';
+			push @ans, $soa, @{$soa->{RRlist}}, $soa;
+		} else {
+			$rcode = 'NOTAUTH';
+		}
+	}
 
-	} else {
-		unless ( scalar(@match) ) {
-			my $wildcard = join '.', '*', @tail;
-			my $wildlist = $RRhash->{'*'} || ;
-			foreach ( grep { lc( $_->owner ) eq $wildcard } @$wildlist ) {
-				my $clone = bless {%$_}, ref($_);
-				$clone->owner($qname);
-				push @match, $clone;
+	{
+		my $RRlist = $RRhash->{lc $qname} || ;	# hash, then linear search
+		my @match  = @$RRlist;				# assume $qclass always 'IN'
+		if ( scalar(@match) ) {				# exact match
+			$rcode = 'NOERROR';
+		} elsif ( grep {/\.$qname$/i} keys %$RRhash ) { # empty non-terminal
+			$rcode = 'NOERROR';			# NODATA
+		} else {
+			my @namelist = @{$self->{namelist}};	# pre-sorted, longest first
+			$rcode = 'NXDOMAIN';
+			foreach ( grep {/^*./} @namelist ) {
+				my $wildcard = $_;		# match wildcard per RFC4592
+				s/^\*//;			# delete leading asterisk
+				s/(.?*+)/\\$1/g;		# escape dots and regex quantifiers
+				next unless $qname =~ /.?(^.+$_)$/i;
+				my $encloser = $1;		# check no ENT encloses qname
+				$rcode = 'NOERROR';
+				last if grep {/(^|\.)$encloser$/i} @namelist;	 # NODATA
+
+				my ($q) = $query->question;	# synthesise RR at qname
+				foreach my $rr ( @{$RRhash->{$wildcard}} ) {
+					my $clone = bless( {%$rr}, ref($rr) );
+					$clone->{owner} = $q->{qname};
+					push @match, $clone;
+				}
+				last;
 			}
-			$rcode = 'NXDOMAIN' unless @match;
 		}
-		@ans = grep { $_->type eq $qtype } @match;
+		push @ans, my @cname = grep { $_->type eq 'CNAME' } @match;
+		$qname = $_->cname for @cname;
+		redo if @cname;
+		unless ( push @ans, grep { $_->type eq $qtype } @match ) {
+			foreach ( @{$self->{zonelist}} ) {
+				s/(.?*+)/\\$1/g;		# escape dots and regex quantifiers
+				next unless $qname =~ /^.+.$_.?$/i;
+				push @auth, grep { $_->type eq 'SOA' } @{$RRhash->{$_}};
+				last;
+			}
+		}
+		$headermask{aa} = 1;
 	}
-
-	return ( $rcode, \@ans, , , {aa => 1}, {} );
+	return ( $rcode, \@ans, \@auth, , \%headermask, {} );
 }
 
 
 #------------------------------------------------------------------------------
-# inet_new - Calls the constructor in the correct module for making sockets.
-#------------------------------------------------------------------------------
-
-sub inet_new {
-	return USE_SOCKET_IP ? IO::Socket::IP->new(@_) : IO::Socket::INET->new(@_);
-}
-
-#------------------------------------------------------------------------------
 # make_reply - Make a reply packet.
 #------------------------------------------------------------------------------
 
 sub make_reply {
 	my ( $self, $query, $sock ) = @_;
+	my $verbose = $self->{Verbose};
 
 	unless ($query) {
-		print "ERROR: invalid packet\n" if $self->{Verbose};
 		my $empty = Net::DNS::Packet->new();		# create empty reply packet
 		my $reply = $empty->reply();
 		$reply->header->rcode("FORMERR");
@@ -243,7 +197,7 @@
 	}
 
 	if ( $query->header->qr() ) {
-		print "ERROR: invalid packet (qr set), dropping\n" if $self->{Verbose};
+		print "ERROR: invalid packet (qr set), dropping\n" if $verbose;
 		return;
 	}
 
@@ -259,7 +213,6 @@
 		$header->rcode("NOERROR");
 
 	} elsif ( $qdcount > 1 ) {
-		print "ERROR: qdcount $qdcount unsupported\n" if $self->{Verbose};
 		$header->rcode("FORMERR");
 
 	} else {
@@ -268,12 +221,10 @@
 		my $qtype  = $qr->qtype;
 		my $qclass = $qr->qclass;
 
-		my $id = $query->header->id;
-		print "query $id : $qname $qclass $qtype\n" if $self->{Verbose};
+		print $qr->string, "\n" if $verbose;
 
-		my $peer = $sock->peerhost;
 		my $conn = {
-			peerhost => $peer,
+			peerhost => my $peer = $sock->peerhost,
 			peerport => $sock->peerport,
 			protocol => $sock->protocol,
 			sockhost => $sock->sockhost,
@@ -304,12 +255,12 @@
 			}
 
 		} else {
-			print "ERROR: opcode $opcode unsupported\n" if $self->{Verbose};
+			print "ERROR: opcode $opcode unsupported\n" if $verbose;
 			$rcode = "FORMERR";
 		}
 
 		if ( !defined($rcode) ) {
-			print "remaining silent\n" if $self->{Verbose};
+			print "remaining silent\n" if $verbose;
 			return;
 		}
 
@@ -328,278 +279,291 @@
 		$reply->edns->option( $option, $value );
 	}
 
-	$header->print if $self->{Verbose} && ( $headermask || $optionmask );
+	$header->print if $verbose && ( $headermask || $optionmask );
 
 	return $reply;
 }
 
 
 #------------------------------------------------------------------------------
-# readfromtcp - read from a TCP client
+# TCP_connection - Handle a TCP connection.
 #------------------------------------------------------------------------------
 
-sub readfromtcp {
-	my ( $self, $sock ) = @_;
-	return -1 unless defined $self->{_tcp}{$sock};
-	my $peer = $self->{_tcp}{$sock}{peer};
-	my $buf;
-	my $charsread = $sock->sysread( $buf, 16384 );
-	$self->{_tcp}{$sock}{inbuffer} .= $buf;
-	$self->{_tcp}{$sock}{timeout} = time() + $self->{IdleTimeout};	  # Reset idle timer
-	print "Received $charsread octets from $peer\n" if $self->{Verbose};
-
-	if ( $charsread == 0 ) {				# 0 octets means socket has closed
-		print "Connection to $peer closed or lost.\n" if $self->{Verbose};
-		$self->{select}->remove($sock);
-		$sock->close();
-		delete $self->{_tcp}{$sock};
-		return $charsread;
-	}
-	return $charsread;
-}
-
-#------------------------------------------------------------------------------
-# tcp_connection - Handle a TCP connection.
-#------------------------------------------------------------------------------
-
-sub tcp_connection {
-	my ( $self, $sock ) = @_;
+sub TCP_connection {
+	my ( $self, $socket ) = @_;
+	my $timeout = $self->{IdleTimeout};
+	my $verbose = $self->{Verbose};
 
-	if ( not $self->{_tcp}{$sock} ) {
-
-		# We go here if we are called with a listener socket.
-		my $client = $sock->accept;
-		if ( not defined $client ) {
-			print "TCP connection closed by peer before we could accept it.\n" if $self->{Verbose};
-			return 0;
+	while (1) {
+		alarm $timeout;
+		my $l = '';
+		my $n = sysread( $socket, $l, 2 );
+		unless ( defined $n ) {
+			redo if $!{EINTR};	## retry if aborted by signal
+			die "sysread: $!";
 		}
-		my $peerport = $client->peerport;
-		my $peerhost = $client->peerhost;
-
-		print "TCP connection from $peerhost:$peerport\n" if $self->{Verbose};
-		$client->blocking(0);
-		$self->{_tcp}{$client}{peer}	= "tcp:" . $peerhost . ":" . $peerport;
-		$self->{_tcp}{$client}{state}	= STATE_ACCEPTED;
-		$self->{_tcp}{$client}{socket}	= $client;
-		$self->{_tcp}{$client}{timeout} = time() + $self->{IdleTimeout};
-		$self->{select}->add($client);
-
-		# After we accepted we will look at the socket again
-		# to see if there is any data there. ---Olaf
-		$self->loop_once(0);
-	} else {
-
-		# We go here if we are called with a client socket
-		my $peer = $self->{_tcp}{$sock}{peer};
-
-		if ( $self->{_tcp}{$sock}{state} == STATE_ACCEPTED ) {
-			if ( not $self->{_tcp}{$sock}{inbuffer} =~ s/^(..)//s ) {
-				return;				# Still not 2 octets ready
+		last if $n == 0;
+		my $msglen = unpack 'n', $l;
+
+		my $buffer = '';
+		while ( $msglen > ( my $l = length $buffer ) ) {
+			my $n = sysread( $socket, $buffer, ( $msglen - $l ), $l );
+			unless ( defined $n ) {
+				redo if $!{EINTR};	## retry if aborted by signal
+				die "sysread: $!";
 			}
-			my $msglen = unpack( "n", $1 );
-			print "$peer said his query contains $msglen octets\n" if $self->{Verbose};
-			$self->{_tcp}{$sock}{state}	  = STATE_GOT_LENGTH;
-			$self->{_tcp}{$sock}{querylength} = $msglen;
 		}
 
-		# Not elsif, because we might already have all the data
-		if ( $self->{_tcp}{$sock}{state} == STATE_GOT_LENGTH ) {
+		if ($verbose) {
+			my $peer = $socket->peerhost;
+			my $port = $socket->peerport;
+			my $size = length $buffer;
+			print "Received $size octets from $peer port $port\n";
+		}
 
-			# return if not all data has been received yet.
-			return if $self->{_tcp}{$sock}{querylength} > length $self->{_tcp}{$sock}{inbuffer};
+		my $query = Net::DNS::Packet->new( \$buffer );
+		if ($@) {
+			print "Error decoding query packet: $@\n" if $verbose;
+			undef $query;	## force FORMERR reply
+		}
 
-			my $qbuf = substr( $self->{_tcp}{$sock}{inbuffer}, 0, $self->{_tcp}{$sock}{querylength} );
-			substr( $self->{_tcp}{$sock}{inbuffer}, 0, $self->{_tcp}{$sock}{querylength} ) = "";
-			my $query = Net::DNS::Packet->new( \$qbuf );
-			if ( my $err = $@ ) {
-				print "Error decoding query packet: $err\n" if $self->{Verbose};
-				undef $query;			# force FORMERR reply
-			}
+		my $reply = $self->make_reply( $query, $socket );
+		die 'Failed to create reply' unless defined $reply;
 
-			my $reply = $self->make_reply( $query, $sock );
-			if ( not defined $reply ) {
-				print "I couldn't create a reply for $peer. Closing socket.\n"
-						if $self->{Verbose};
-				$self->{select}->remove($sock);
-				$sock->close();
-				delete $self->{_tcp}{$sock};
-				return;
-			}
-			my $reply_data = $reply->data(65535);	# limit to one TCP envelope
-			warn "multi-packet TCP response not implemented" if $reply->header->tc;
-			my $len = length $reply_data;
-			$self->{_tcp}{$sock}{outbuffer} = pack( 'n a*', $len, $reply_data );
-			print "Queued TCP response (2 + $len octets) to $peer\n"
-					if $self->{Verbose};
-
-			# We are done.
-			$self->{_tcp}{$sock}{state} = STATE_SENDING;
+		my $segment = $reply->data(65500);		# limit to one TCP envelope
+		my $length  = length $segment;
+		warn "Multi-packet TCP response not implemented" if $reply->header->tc;
+		if ($verbose) {
+			print "TCP response (2 + $length octets) - ";
+			print $socket->send( pack 'na*', $length, $segment ) ? "sent" : "failed: $!", "\n";
+		} else {
+			$socket->send( pack 'na*', $length, $segment );
 		}
 	}
+	alarm 0;
+	close $socket;
 	return;
 }
 
+
 #------------------------------------------------------------------------------
-# udp_connection - Handle a UDP connection.
+# UDP_connection - Handle a UDP connection.
 #------------------------------------------------------------------------------
 
-sub udp_connection {
-	my ( $self, $sock ) = @_;
+sub UDP_connection {
+	my ( $self, $socket ) = @_;
+	my $verbose = $self->{Verbose};
+	alarm 3;
 
-	my $buf = "";
+	my $buffer = "";
+	return unless defined $socket->recv( $buffer, PACKETSZ );
 
-	$sock->recv( $buf, PACKETSZ );
-	my ( $peerhost, $peerport, $sockhost ) = ( $sock->peerhost, $sock->peerport, $sock->sockhost );
-	unless ( defined $peerhost && defined $peerport ) {
-		print "the Peer host and sock host appear to be undefined: bailing out of handling the UDP connection"
-				if $self->{Verbose};
-		return;
+	if ($verbose) {
+		my $peer = $socket->peerhost;
+		my $port = $socket->peerport;
+		my $size = length $buffer;
+		print "Received $size octets from $peer port $port\n";
+	}
+
+	my $query = Net::DNS::Packet->new( \$buffer );
+	if ($@) {
+		print "Error decoding query packet: $@\n" if $verbose;
+		undef $query;		## force FORMERR reply
 	}
 
-	print "UDP connection from $peerhost:$peerport to $sockhost\n" if $self->{Verbose};
+	my $reply = $self->make_reply( $query, $socket );
+	die 'Failed to create reply' unless defined $reply;
 
-	my $query = Net::DNS::Packet->new( \$buf );
-	if ( my $err = $@ ) {
-		print "Error decoding query packet: $err\n" if $self->{Verbose};
-		undef $query;					# force FORMERR reply
+	my $max_len = ( $query && $self->{Truncate} ) ? $query->edns->UDPsize : undef;
+	if ($verbose) {
+		my $response = $reply->data($max_len);
+		print 'UDP response (', length($response), ' octets) - ';
+		print $socket->send($response) ? "sent" : "failed: $!", "\n";
+	} else {
+		$socket->send( $reply->data($max_len) );
 	}
+	alarm 0;
+	close $socket;
+	return;
+}
 
-	my $reply = $self->make_reply( $query, $sock ) || return;
 
-	my $max_len = ( $query && $self->{Truncate} ) ? $query->edns->size : undef;
-	if ( $self->{Verbose} ) {
-		local $| = 1;
-		print "Maximum UDP size advertised by $peerhost#$peerport: $max_len\n" if $max_len;
-		print "Writing response - ";
-		print $sock->send( $reply->data($max_len) ) ? "done" : "failed: $!", "\n";
+#------------------------------------------------------------------------------
+# Socket mechanics.
+#------------------------------------------------------------------------------
 
-	} else {
-		$sock->send( $reply->data($max_len) );
+use constant DEBUG => 0;
+
+sub logmsg { return print "$0 $$: @_ at ", scalar localtime(), "\n" }
+
+sub spawn {
+	my $coderef = shift;
+	confess "usage: spawn CODEREF" unless ref($coderef) eq 'CODE';
+
+	unless ( defined( my $pid = fork() ) ) {
+		die "cannot fork: $!";
+	} elsif ($pid) {
+		logmsg "begat $pid" if DEBUG;
+		return $pid;		## parent
+	}
+
+	# else ...			## child
+	$coderef->();
+	exit;
+}
+
+sub reaper {
+	local $!;			## protect current error
+	$SIG{CHLD} = \&reaper;		## no critic	sysV semantics
+	while ( ( my $pid = waitpid( -1, USE_POSIX ? WNOHANG : 0 ) ) > 0 ) {
+		logmsg "reaped $pid" if DEBUG;
 	}
 	return;
 }
 
 
-sub get_open_tcp {
+sub start_server {
 	my $self = shift;
-	return keys %{$self->{_tcp}};
+	my $list = $self->{LocalAddr};
+	my $port = $self->{LocalPort};
+	my @pid;
+	foreach my $ip (@$list) {
+		push @pid, spawn( sub { $self->TCP_server( $ip, $port ) } );
+		push @pid, spawn( sub { $self->UDP_server( $ip, $port ) } );
+	}
+	return @pid;
 }
 
+sub start_noloop {
+	my ( $self, $timeout ) = ( @_, 600 );
+	my $list = $self->{LocalAddr};
+	my $port = $self->{LocalPort};
+	foreach my $ip (@$list) {
+		spawn(	sub {
+				alarm $timeout;
+				$self->TCP_initialise( $ip, $port );
+			} );
+		spawn(	sub {
+				alarm $timeout;
+				$self->UDP_initialise( $ip, $port );
+			} );
+	}
+	return;
+}
 
-#------------------------------------------------------------------------------
-# loop_once - Just check "once" on sockets already set up
-#------------------------------------------------------------------------------
 
-# This function might not actually return immediately. If an AXFR request is
-# coming in which will generate a huge reply, we will not relinquish control
-# until our outbuffers are empty.
+sub TCP_initialise {
+	my ( $self, $ip, $port ) = @_;
+	my $socket = IO::Socket::IP->new(
+		LocalAddr => $ip,
+		LocalPort => $port,
+		ReuseAddr => 1,
+		ReusePort => 1,
+		Proto	  => "tcp",
+		Listen	  => SOMAXCONN,
+		Type	  => SOCK_STREAM
+		)
+			|| die "can't setup TCP socket";
+
+	logmsg "TCP server $ip port $port started";
+
+	{
+		my $client = $socket->accept() || do {
+			redo if $!{EINTR};	## retry if aborted by signal
+			die "accept: $!";
+		};
+
+		spawn( sub { $self->TCP_connection($client) } );
+	}
+	return $socket;
+}
 
-#
-#  NB  this method may be subject to change and is therefore left 'undocumented'
-#
+sub TCP_server {
+	my ( $self, $ip, $port ) = @_;
+	my $socket = $self->TCP_initialise( $ip, $port );
+	while (1) {
+		my $client = $socket->accept() || do {
+			redo if $!{EINTR};	## retry if aborted by signal
+			die "accept: $!";
+		};
 
-sub loop_once {
-	my ( $self, $timeout ) = @_;
+		spawn( sub { $self->TCP_connection($client) } );
+	}
+	exit;
+}
 
-	print ";loop_once called with timeout: " . ( defined($timeout) ? $timeout : "undefined" ) . "\n"
-			if $self->{Verbose} && $self->{Verbose} > 4;
-	foreach my $sock ( keys %{$self->{_tcp}} ) {
 
-		# There is TCP traffic to handle
-		$timeout = 0.1 if $self->{_tcp}{$sock}{outbuffer};
-	}
-	my @ready = $self->{select}->can_read($timeout);
-
-	foreach my $sock (@ready) {
-		my $protonum = $sock->protocol;
-
-		# This is a weird and nasty hack. Although not incorrect,
-		# I just don't know why ->protocol won't tell me the protocol
-		# on a connected socket. --robert
-		$protonum = getprotobyname('tcp') if not defined $protonum and $self->{_tcp}{$sock};
-
-		my $proto = getprotobynumber($protonum);
-		if ( !$proto ) {
-			print "ERROR: connection with unknown protocol\n"
-					if $self->{Verbose};
-		} elsif ( lc($proto) eq "tcp" ) {
-
-			$self->readfromtcp($sock)
-					&& $self->tcp_connection($sock);
-		} elsif ( lc($proto) eq "udp" ) {
-			$self->udp_connection($sock);
-		} else {
-			print "ERROR: connection with unsupported protocol $proto\n"
-					if $self->{Verbose};
+sub UDP_initialise {
+	my ( $self, $ip, $port ) = @_;
+	my $socket = IO::Socket::IP->new(
+		LocalAddr => $ip,
+		LocalPort => $port,
+		ReuseAddr => 1,
+		ReusePort => 1,
+		Proto	  => "udp",
+		Type	  => SOCK_DGRAM
+		)
+			|| die "can't setup UDP socket";
+
+	logmsg "UDP server $ip port $port started";
+
+	my $select = IO::Select->new($socket);
+	{
+		local $! = 0;
+		scalar( my @ready = $select->can_read() ) || do {
+			redo if $!{EINTR};	## retry if aborted by signal
+			die "select->can_read(): $!";
+		};
+
+		foreach my $client (@ready) {
+			spawn( sub { $self->UDP_connection($client) } );
 		}
 	}
-	my $now = time();
-
-	# Lets check if any of our TCP clients has pending actions.
-	# (outbuffer, timeout)
-	foreach my $s ( keys %{$self->{_tcp}} ) {
-		my $sock = $self->{_tcp}{$s}{socket};
-		if ( $self->{_tcp}{$s}{outbuffer} ) {
-
-			# If we have buffered output, then send as much as the OS will accept
-			# and wait with the rest
-			my $len	 = length $self->{_tcp}{$s}{outbuffer};
-			my $sent = $sock->syswrite( $self->{_tcp}{$s}{outbuffer} ) || 0;
-			print "Sent $sent of $len octets to ", $self->{_tcp}{$s}{peer}, ".\n"
-					if $self->{Verbose};
-			substr( $self->{_tcp}{$s}{outbuffer}, 0, $sent ) = "";
-			if ( length $self->{_tcp}{$s}{outbuffer} == 0 ) {
-				delete $self->{_tcp}{$s}{outbuffer};
-				$self->{_tcp}{$s}{state} = STATE_ACCEPTED;
-				if ( length $self->{_tcp}{$s}{inbuffer} >= 2 ) {
-
-					# See if the client has send us enough data to process the
-					# next query.
-					# We do this here, because we only want to process (and buffer!!)
-					# a single query at a time, per client. If we allowed a STATE_SENDING
-					# client to have new requests processed. We could be easilier
-					# victims of DoS (client sending lots of queries and never reading
-					# from it's socket).
-					# Note that this does not disable serialisation on part of the
-					# client. The split second it should take for us to lookup the
-					# next query, is likely faster than the time it takes to
-					# send the response... well, unless it's a lot of tiny queries,
-					# in which case we will be generating an entire TCP packet per
-					# reply. --robert
-					$self->tcp_connection( $self->{_tcp}{$s}{socket} );
-				}
-			}
-			$self->{_tcp}{$s}{timeout} = time() + $self->{IdleTimeout};
-		} else {
+	return $socket;
+}
 
-			# Get rid of idle clients.
-			my $timeout = $self->{_tcp}{$s}{timeout};
-			if ( $timeout - $now < 0 ) {
-				print $self->{_tcp}{$s}{peer}, " has been idle for too long and will be disconnected.\n"
-						if $self->{Verbose};
-				$self->{select}->remove($sock);
-				$sock->close();
-				delete $self->{_tcp}{$s};
-			}
+sub UDP_server {
+	my ( $self, $ip, $port ) = @_;
+	my $socket = $self->UDP_initialise( $ip, $port );
+	my $select = IO::Select->new($socket);
+	while (1) {
+		local $! = 0;
+		scalar( my @ready = $select->can_read() ) || do {
+			redo if $!{EINTR};	## retry if aborted by signal
+			die "select->can_read(): $!";
+		};
+
+		foreach my $client (@ready) {
+			spawn( sub { $self->UDP_connection($client) } );
 		}
 	}
-	return;
+	exit;
 }
 
+
 #------------------------------------------------------------------------------
-# main_loop - Main nameserver loop.
+# main_loop - Start nameserver loop.
 #------------------------------------------------------------------------------
 
 sub main_loop {
-	my $self = shift;
+	local $SIG{CHLD} = \&reaper;
+	my @pid = shift->start_server;
+	local $SIG{TERM} = sub { kill( 'TERM', @pid ) };
+	1 while waitpid( -1, 0 ) > 0;	## park main process until
+	return;				## user CTRL_C kills the children
+}
 
-	while (1) {
-		print "Waiting for connections...\n" if $self->{Verbose};
 
-		# You really need an argument otherwise you'll be burning CPU.
-		$self->loop_once(10);
-	}
-	return;
+#------------------------------------------------------------------------------
+# loop_once - Start single-transaction nameserver
+#------------------------------------------------------------------------------
+
+sub loop_once {
+	my ( $self, @timeout ) = @_;
+	local $SIG{CHLD} = \&reaper;
+	$self->start_noloop(@timeout);
+	1 while waitpid( -1, 0 ) > 0;	## park main process until timeout or
+	return;				## user CTRL_C kills remaining children
 }
 
 
@@ -612,7 +576,7 @@
 =head2 new
 
     $nameserver = Net::DNS::Nameserver->new(
-	LocalAddr	=> '::1' , '127.0.0.1',
+	LocalAddr	=> '::1', '127.0.0.1',
 	ZoneFile	=> "filename"
 	);
 
@@ -624,15 +588,15 @@
 	Truncate	=> 0
     );
 
-Returns a Net::DNS::Nameserver object, or undef if the object
-could not be created.
+Instantiates a Net::DNS::Nameserver object.
+An exception is raised if the object could not be created.
 
 Each instance is configured using the following optional arguments:
 
     LocalAddr		IP address on which to listen	Defaults to loopback address
     LocalPort		Port on which to listen		Defaults to 5353
     ZoneFile		Name of file containing RRs
-			accessed using the default
+			accessed using the internal
 			reply-handling subroutine
     ReplyHandler	Reference to customised
 			reply-handling subroutine
@@ -649,11 +613,8 @@
 			if they are idle longer than
 			this duration			Defaults to 120 (secs)
 
-The LocalAddr attribute may alternatively be specified as a list of IP
-addresses to listen to.
-If the IO::Socket::IP library package is available on the system
-this may also include IPv6 addresses.
-
+The LocalAddr attribute may alternatively be specified as an array
+of IP addresses to listen to.
 
 The ReplyHandler subroutine is passed the query name, query class,
 query type, peerhost, query record, and connection descriptor.
@@ -670,17 +631,14 @@
 
 For advanced usage it may also contain a headermask containing an
 hashref with the settings for the C<aa>, C<ra>, and C<ad>
-header bits. The argument is of the form
-C<< { ad => 1, aa => 0, ra => 1 } >>.
+header bits. The argument is of the form:
+	{ad => 1, aa => 0, ra => 1}
 
-EDNS options may be specified in a similar manner using optionmask
-C<< { $optioncode => $value, $optionname => $value } >>.
+EDNS options may be specified in a similar manner using the optionmask:
+	{$optioncode => $value, $optionname => $value}
 
+See RFC1035 and IANA DNS parameters file for more information:
 
-See RFC 1035 and the IANA dns-parameters file for more information:
-
-  ftp://ftp.rfc-editor.org/in-notes/rfc1035.txt
-  http://www.isi.edu/in-notes/iana/assignments/dns-parameters
 
 The nameserver will listen for both UDP and TCP connections.
 On Unix-like systems, unprivileged users are denied access to ports below 1024.
@@ -693,6 +651,7 @@
 
 See L</EXAMPLE> for an example.
 
+
 =head2 main_loop
 
     $ns->main_loop;
@@ -704,51 +663,23 @@
 
     $ns->loop_once( TIMEOUT_IN_SECONDS );
 
-Start accepting queries, but returns. If called without a parameter, the
-call will not return until a request has been received (and replied to).
-Otherwise, the parameter specifies the maximum time to wait for a request.
-A zero timeout forces an immediate return if there is nothing to do.
-
-Handling a request and replying obviously depends on the speed of
-ReplyHandler. Assuming a fast ReplyHandler, loop_once should spend just a
-fraction of a second, if called with a timeout value of 0.0 seconds. One
-exception is when an AXFR has requested a huge amount of data that the OS
-is not ready to receive in full. In that case, it will remain in a loop
-(while servicing new requests) until the reply has been sent.
-
-In case loop_once accepted a TCP connection it will immediately check if
-there is data to be read from the socket. If not it will return and you
-will have to call loop_once() again to check if there is any data waiting
-on the socket to be processed. In most cases you will have to count on
-calling "loop_once" twice.
-
-A code fragment like:
-
-    $ns->loop_once(10);
-    while( $ns->get_open_tcp() ){
-	$ns->loop_once(0);
-    }
-
-Would wait for 10 seconds for the initial connection and would then
-process all TCP sockets until none is left.
+Initialises the specified UDP and TCP sockets and starts the server
+which will respond to a single connection on each socket.
 
-
-=head2 get_open_tcp
-
-In scalar context returns the number of TCP connections for which state
-is maintained. In array context it returns IO::Socket objects, these could
-be useful for troubleshooting but be careful using them.
+The timeout parameter specifies the maximum time to wait for a request.
+If called without parameters a default timeout of 10 minutes is applied.
+If called with a zero parameter, the timeout function is disabled.
 
 
 =head1 EXAMPLE
 
 The following example will listen on port 5353 and respond to all queries
-for A records with the IP address 10.1.2.3.	 All other queries will be
+for A records with the IP address 10.1.2.3.  All other queries will be
 answered with NXDOMAIN.	 Authority and additional sections are left empty.
 The $peerhost variable catches the IP address of the peer host, so that
-additional filtering on its basis may be applied.
+additional filtering on a per-host basis may be applied.
 
-    #!/usr/bin/perl
+    #!/usr/bin/perl -T
 
     use strict;
     use warnings;
@@ -792,6 +723,8 @@
 
     $ns->main_loop;
 
+    exit;
+
 
 =head1 BUGS
 
@@ -819,9 +752,9 @@
 
 Portions Copyright (c)2005 Robert Martin-Legene.
 
-Portions Copyright (c)2005-2009 O.M, Kolkman, RIPE NCC.
+Portions Copyright (c)2005-2009 O.M.Kolkman, RIPE NCC.
 
-Portions Copyright (c)2017 Dick Franks.
+Portions Copyright (c)2017,2023 R.W.Franks.
 
 All rights reserved.
 
@@ -847,9 +780,15 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
-L<Net::DNS::Update>, L<Net::DNS::Header>, L<Net::DNS::Question>,
-L<Net::DNS::RR>, RFC 1035
+L<perl> L<Net::DNS> L<Net::DNS::Resolver> L<Net::DNS::Packet>
+L<Net::DNS::Update> L<Net::DNS::Header> L<Net::DNS::Question>
+L<Net::DNS::RR>
+
+L<RFC1035|https://tools.ietf.org/html/rfc1035>
+
+L<IANA DNS parameters|http://www.iana.org/assignments/dns-parameters>
 
 =cut
 
+__END__
+

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/Packet.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/Packet.pm Changed

@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-our $VERSION = (qw$Id: Packet.pm 1865 2022-05-21 09:57:49Z willem $)2;
+our $VERSION = (qw$Id: Packet.pm 1910 2023-03-30 19:16:30Z willem $)2;
 
 
 =head1 NAME
@@ -58,8 +58,8 @@
 =cut
 
 sub new {
-	return &decode if ref $_1;
-	my $class = shift;
+	my ( $class, @arg ) = @_;
+	return &decode if ref $arg0;
 
 	my $self = bless {
 		status	   => 0,
@@ -69,7 +69,7 @@
 		additional => ,
 		}, $class;
 
-	$self->{question} = Net::DNS::Question->new(@_) if scalar @_;
+	$self->{question} = Net::DNS::Question->new(@arg) if scalar @arg;
 
 	return $self;
 }
@@ -138,23 +138,23 @@
 		my $record;
 		$offset = HEADER_LENGTH;
 		while ( $qd-- ) {
-			( $record, $offset ) = decode Net::DNS::Question( $data, $offset, $hash );
+			( $record, $offset ) = Net::DNS::Question->decode( $data, $offset, $hash );
 			CORE::push( @{$self->{question}}, $record );
 		}
 
 		# RR sections
 		while ( $an-- ) {
-			( $record, $offset ) = decode Net::DNS::RR( $data, $offset, $hash );
+			( $record, $offset ) = Net::DNS::RR->decode( $data, $offset, $hash );
 			CORE::push( @{$self->{answer}}, $record );
 		}
 
 		while ( $ns-- ) {
-			( $record, $offset ) = decode Net::DNS::RR( $data, $offset, $hash );
+			( $record, $offset ) = Net::DNS::RR->decode( $data, $offset, $hash );
 			CORE::push( @{$self->{authority}}, $record );
 		}
 
 		while ( $ar-- ) {
-			( $record, $offset ) = decode Net::DNS::RR( $data, $offset, $hash );
+			( $record, $offset ) = Net::DNS::RR->decode( $data, $offset, $hash );
 			CORE::push( @{$self->{additional}}, $record );
 		}
 
@@ -173,7 +173,7 @@
 	if ($debug) {
 		local $@ = $@;
 		print $@ if $@;
-		$self->print if $self;
+		eval { $self->print };
 	}
 
 	return wantarray ? ( $self, $offset ) : $self;
@@ -289,7 +289,7 @@
 
 	my $edns = $reply->edns();
 	CORE::push( @{$reply->{additional}}, $edns );
-	$edns->size($UDPmax);
+	$edns->udpsize($UDPmax);
 	return $reply;
 }
 
@@ -408,11 +408,14 @@
 		CORE::push( @record, ";; DSO SECTION" );
 		foreach ( @{$self->{dso}} ) {
 			my ( $t, $v ) = @$_;
-			CORE::push( @record, pack 'a* A18 a*', ";;\t", dsotypebyval($t), unpack( 'H*', $v ) );
+			CORE::push( @record, sprintf( ";;\t%s\t%s", dsotypebyval($t), unpack( 'H*', $v ) ) );
 		}
 		return join "\n", @record, "\n";
 	}
 
+	my $edns = $self->edns;
+	CORE::push( @record, $edns->string ) if $edns->_specified;
+
 	my @section  = $opcode eq 'UPDATE' ? qw(ZONE PREREQUISITE UPDATE) : qw(QUESTION ANSWER AUTHORITY);
 	my @question = $self->question;
 	my $qdcount  = scalar @question;
@@ -432,7 +435,9 @@
 	my @additional = $self->additional;
 	my $arcount    = scalar @additional;
 	my $ars	       = $arcount != 1 ? 's' : '';
-	CORE::push( @record, "\n;; ADDITIONAL SECTION ($arcount record$ars)", map { $_->string } @additional );
+	my $EDNSmarker = join ' ', qq;; {\t"EDNS-VERSION":, $edns->version, qq}\n;
+	CORE::push( @record, "\n;; ADDITIONAL SECTION ($arcount record$ars)" );
+	CORE::push( @record, map { ( $_ eq $edns ) ? $EDNSmarker : $_->string } @additional );
 
 	return join "\n", @record, "\n";
 }
@@ -448,9 +453,8 @@
 =cut
 
 sub from {
-	my $self = shift;
-
-	$self->{replyfrom} = shift if scalar @_;
+	my ( $self, @argument ) = @_;
+	for (@argument) { $self->{replyfrom} = $_ }
 	return $self->{replyfrom};
 }
 
@@ -492,9 +496,9 @@
 =cut
 
 sub push {
-	my $self = shift;
-	my $list = $self->_section(shift);
-	return CORE::push( @$list, grep { ref($_) } @_ );
+	my ( $self, $section, @rr ) = @_;
+	my $list = $self->_section($section);
+	return CORE::push( @$list, @rr );
 }
 
 
@@ -517,12 +521,10 @@
 =cut
 
 sub unique_push {
-	my $self = shift;
-	my $list = $self->_section(shift);
-	my @rr	 = grep { ref($_) } @_;
+	my ( $self, $section, @rr ) = @_;
+	my $list = $self->_section($section);
 
 	my %unique = map { ( bless( {%$_, ttl => 0}, ref $_ )->canonical => $_ ) } @rr, @$list;
-
 	return scalar( @$list = values %unique );
 }
 
@@ -565,7 +567,7 @@
     $query = Net::DNS::Packet->new( 'www.example.com', 'A' );
 
     $query->sign_tsig(
-		'Khmac-sha512.example.+165+01018.private',
+		$keyfile,
 		fudge => 60
 		);
 
@@ -599,12 +601,6 @@
     $query->sign_tsig( $tsig );
 
 
-The historical simplified syntax is still available, but additional
-options can not be specified.
-
-    $packet->sign_tsig( $key_name, $key );
-
-
 The response to an inbound request is signed by presenting the request
 in place of the key parameter.
 
@@ -629,12 +625,11 @@
 =cut
 
 sub sign_tsig {
-	my $self = shift;
-
+	my ( $self, @argument ) = @_;
 	return eval {
 		local $SIG{__DIE__};
 		require Net::DNS::RR::TSIG;
-		my $tsig = Net::DNS::RR::TSIG->create(@_);
+		my $tsig = Net::DNS::RR::TSIG->create(@argument);
 		$self->push( 'additional' => $tsig );
 		return $tsig;
 	} || return croak "$@\nTSIG: unable to sign packet";
@@ -662,16 +657,13 @@
 =cut
 
 sub verify {
-	my $self = shift;
-
+	my ( $self, @argument ) = @_;
 	my $sig = $self->sigrr;
-	return $sig ? $sig->verify( $self, @_ ) : shift;
+	return $sig ? $sig->verify( $self, @argument ) : shift @argument;
 }
 
 sub verifyerr {
-	my $self = shift;
-
-	my $sig = $self->sigrr;
+	my $sig = shift->sigrr;
 	return $sig ? $sig->vrfyerrstr : 'not signed';
 }
 
@@ -735,8 +727,9 @@
 
 	my ($sig) = reverse $self->additional;
 	return unless $sig;
-	return $sig if $sig->type eq 'TSIG';
-	return $sig if $sig->type eq 'SIG';
+	for ( $sig->type ) {
+		return $sig if /TSIG|SIG/;
+	}
 	return;
 }
 
@@ -838,10 +831,12 @@
 ########################################
 
 sub dump {				## print internal data structure
-	require Data::Dumper;					# uncoverable pod
+	my @data = @_;						# uncoverable pod
+	require Data::Dumper;
 	local $Data::Dumper::Maxdepth = $Data::Dumper::Maxdepth || 3;
 	local $Data::Dumper::Sortkeys = $Data::Dumper::Sortkeys || 1;
-	print Data::Dumper::Dumper(@_);
+	local $Data::Dumper::Useqq    = $Data::Dumper::Useqq	|| 1;
+	print Data::Dumper::Dumper(@data);
 	return;
 }
 
@@ -884,9 +879,11 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::Update>, L<Net::DNS::Header>,
-L<Net::DNS::Question>, L<Net::DNS::RR>, L<Net::DNS::RR::TSIG>,
-RFC1035 Section 4.1, RFC2136 Section 2, RFC2845
+L<perl> L<Net::DNS> L<Net::DNS::Update> L<Net::DNS::Header>
+L<Net::DNS::Question> L<Net::DNS::RR> L<Net::DNS::RR::TSIG>
+L<RFC1035(4.1)|https://tools.ietf.org/html/rfc1035>
+L<RFC2136(2)|https://tools.ietf.org/html/rfc2136>
+L<RFC8945|https://tools.ietf.org/html/rfc8945>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/Parameters.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/Parameters.pm Changed

@@ -3,13 +3,13 @@
 ################################################
 ##
 ##	Domain Name System (DNS) Parameters
-##	(last updated 2022-04-01)
+##	(last updated 2023-04-28)
 ##
 ################################################
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: Parameters.pm 1865 2022-05-21 09:57:49Z willem $)2;
+our $VERSION = (qw$Id: Parameters.pm 1921 2023-05-08 18:39:59Z willem $)2;
 
 use integer;
 use Carp;
@@ -71,8 +71,8 @@
 	X25	   => 19,					# RFC1183
 	ISDN	   => 20,					# RFC1183
 	RT	   => 21,					# RFC1183
-	NSAP	   => 22,					# RFC1706
-	'NSAP-PTR' => 23,					# RFC1706
+	NSAP	   => 22,					# RFC1706 https://datatracker.ietf.org/doc/status-change-int-tlds-to-historic
+	'NSAP-PTR' => 23,					# RFC1706 https://datatracker.ietf.org/doc/status-change-int-tlds-to-historic
 	SIG	   => 24,					# RFC2536 RFC2931 RFC3110 RFC4034
 	KEY	   => 25,					# RFC2536 RFC2539 RFC3110 RFC4034
 	PX	   => 26,					# RFC2163
@@ -112,8 +112,8 @@
 	OPENPGPKEY => 61,					# RFC7929
 	CSYNC	   => 62,					# RFC7477
 	ZONEMD	   => 63,					# RFC8976
-	SVCB	   => 64,					# draft-ietf-dnsop-svcb-https-00
-	HTTPS	   => 65,					# draft-ietf-dnsop-svcb-https-00
+	SVCB	   => 64,					# RFC-ietf-dnsop-svcb-https-12
+	HTTPS	   => 65,					# RFC-ietf-dnsop-svcb-https-12
 	SPF	   => 99,					# RFC7208
 	UINFO	   => 100,					# IANA-Reserved
 	UID	   => 101,					# IANA-Reserved
@@ -251,6 +251,42 @@
 our %dsotypebyname = @dsotypebyname;
 
 
+# Registry: Extended DNS Error Codes
+my @dnserrorbyval = (
+	0  => 'Other Error',					# RFC8914
+	1  => 'Unsupported DNSKEY Algorithm',			# RFC8914
+	2  => 'Unsupported DS Digest Type',			# RFC8914
+	3  => 'Stale Answer',					# RFC8914 RFC8767
+	4  => 'Forged Answer',					# RFC8914
+	5  => 'DNSSEC Indeterminate',				# RFC8914
+	6  => 'DNSSEC Bogus',					# RFC8914
+	7  => 'Signature Expired',				# RFC8914
+	8  => 'Signature Not Yet Valid',			# RFC8914
+	9  => 'DNSKEY Missing',					# RFC8914
+	10 => 'RRSIGs Missing',					# RFC8914
+	11 => 'No Zone Key Bit Set',				# RFC8914
+	12 => 'NSEC Missing',					# RFC8914
+	13 => 'Cached Error',					# RFC8914
+	14 => 'Not Ready',					# RFC8914
+	15 => 'Blocked',					# RFC8914
+	16 => 'Censored',					# RFC8914
+	17 => 'Filtered',					# RFC8914
+	18 => 'Prohibited',					# RFC8914
+	19 => 'Stale NXDomain Answer',				# RFC8914
+	20 => 'Not Authoritative',				# RFC8914
+	21 => 'Not Supported',					# RFC8914
+	22 => 'No Reachable Authority',				# RFC8914
+	23 => 'Network Error',					# RFC8914
+	24 => 'Invalid Data',					# RFC8914
+	25 => 'Signature Expired before Valid',			# https://github.com/NLnetLabs/unbound/pull/604#discussion_r802678343
+	26 => 'Too Early',					# RFC9250
+	27 => 'Unsupported NSEC3 Iterations Value',		# RFC9276
+	28 => 'Unable to conform to policy',			# draft-homburg-dnsop-codcp-00
+	29 => 'Synthesized',					# https://github.com/PowerDNS/pdns/pull/12334
+	);
+our %dnserrorbyval = @dnserrorbyval;
+
+
 ########
 
 # The following functions are wrappers around similarly named hashes.
@@ -261,18 +297,18 @@
 	return $classbyname{$name} || $classbyname{uc $name} || return do {
 		croak qqunknown class "$name" unless $name =~ m/^(CLASS)?(\d+)/i;
 		my $val = 0 + $2;
-		croak qqclassbyname("$name") out of range if $val > 0xffff;
+		croak qqclassbyname("$name") out of range if $val > 0x7fff;
 		return $val;
 	}
 }
 
 sub classbyval {
-	my $val = shift;
+	my $arg = shift;
 
-	return $classbyval{$val} || return do {
-		$val += 0;
-		croak qqclassbyval($val) out of range if $val > 0xffff;
-		return "CLASS$val";
+	return $classbyval{$arg} || return do {
+		my $val = ( $arg += 0 ) & 0x7fff;		# MSB used by mDNS
+		croak qqclassbyval($arg) out of range if $arg > 0xffff;
+		return $classbyval{$arg} = $classbyval{$val} || "CLASS$val";
 	}
 }
 
@@ -364,7 +400,7 @@
 
 sub _typespec {
 	my $generate = defined wantarray;
-	return EXTLANG ? eval <<'END' : '';			# no critic
+	return EXTLANG ? eval <<'END' : '';	## no critic
 	my ($node) = @_;		## draft-levine-dnsextlang
 	my $instance = Net::DNS::Extlang->new();
 	my $basename = $instance->domain || return '';

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/Question.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/Question.pm Changed

@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-our $VERSION = (qw$Id: Question.pm 1855 2021-11-26 11:33:48Z willem $)2;
+our $VERSION = (qw$Id: Question.pm 1895 2023-01-16 13:38:08Z willem $)2;
 
 
 =head1 NAME
@@ -106,10 +106,11 @@
 use constant QFIXEDSZ => length pack 'n2', (0) x 2;
 
 sub decode {
-	my $self = bless {}, shift;
-	my ( $data, $offset ) = @_;
+	my ( $class, @argument ) = @_;
+	my ( $data,  $offset )	 = @argument;
+	my $self = bless {}, $class;
 
-	( $self->{qname}, $offset ) = Net::DNS::DomainName1035->decode(@_);
+	( $self->{qname}, $offset ) = Net::DNS::DomainName1035->decode(@argument);
 
 	my $next = $offset + QFIXEDSZ;
 	die 'corrupt wire-format data' if length $$data < $next;
@@ -133,9 +134,8 @@
 =cut
 
 sub encode {
-	my $self = shift;
-
-	return pack 'a* n2', $self->{qname}->encode(@_), @{$self}{qw(qtype qclass)};
+	my ( $self, @opaque ) = @_;
+	return pack 'a* n2', $self->{qname}->encode(@opaque), @{$self}{qw(qtype qclass)};
 }
 
 
@@ -149,7 +149,6 @@
 
 sub string {
 	my $self = shift;
-
 	return join "\t", $self->{qname}->string, $self->qclass, $self->qtype;
 }
 
@@ -190,9 +189,8 @@
 =cut
 
 sub name {
-	my $self = shift;
-
-	croak 'immutable object: argument invalid' if scalar @_;
+	my ( $self, @argument ) = @_;
+	for (@argument) { croak 'immutable object: argument invalid' }
 	return $self->{qname}->xname;
 }
 
@@ -209,9 +207,8 @@
 =cut
 
 sub qname {
-	my $self = shift;
-
-	croak 'immutable object: argument invalid' if scalar @_;
+	my ( $self, @argument ) = @_;
+	for (@argument) { croak 'immutable object: argument invalid' }
 	return $self->{qname}->name;
 }
 
@@ -230,9 +227,8 @@
 =cut
 
 sub type {
-	my $self = shift;
-
-	croak 'immutable object: argument invalid' if scalar @_;
+	my ( $self, @argument ) = @_;
+	for (@argument) { croak 'immutable object: argument invalid' }
 	return typebyval( $self->{qtype} );
 }
 
@@ -252,9 +248,8 @@
 =cut
 
 sub class {
-	my $self = shift;
-
-	croak 'immutable object: argument invalid' if scalar @_;
+	my ( $self, @argument ) = @_;
+	for (@argument) { croak 'immutable object: argument invalid' }
 	return classbyval( $self->{qclass} );
 }
 
@@ -333,8 +328,8 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::DomainName>, L<Net::DNS::Packet>,
-RFC 1035 Section 4.1.2
+L<perl> L<Net::DNS> L<Net::DNS::DomainName> L<Net::DNS::Packet>
+L<RFC1035(4.1.2)|https://tools.ietf.org/html/rfc1035>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR.pm Changed

@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-our $VERSION = (qw$Id: RR.pm 1864 2022-04-14 15:18:49Z willem $)2;
+our $VERSION = (qw$Id: RR.pm 1910 2023-03-30 19:16:30Z willem $)2;
 
 
 =head1 NAME
@@ -50,15 +50,15 @@
 =cut
 
 sub new {
-	return eval {
+	my ( $class, @list ) = @_;
+	my $rr = eval {
 		local $SIG{__DIE__};
-		scalar @_ > 2 ? &_new_hash : &_new_string;
-	} || do {
-		my $class = shift || __PACKAGE__;
-		my @param = map { defined($_) ? split /\s+/ : 'undef' } @_;
-		my $stmnt = substr "$class->new( @param )", 0, 80;
-		croak "${@}in $stmnt\n";
+		scalar @list > 1 ? &_new_hash : &_new_string;
 	};
+	return $rr if $rr;
+	my @param = map { defined($_) ? split /\s+/ : 'undef' } @list;
+	my $stmnt = substr "$class->new( @param )", 0, 80;
+	croak "${@}in $stmnt\n";
 }
 
 
@@ -88,11 +88,10 @@
 my $PARSE_REGEX = q/("^"*")|;^\n*| \t\n\r\f()+/;		# NB: *not* \s (matches Unicode white space)
 
 sub _new_string {
-	my $base;
-	local $_;
-	( $base, $_ ) = @_;
-	croak 'argument absent or undefined' unless defined $_;
-	croak 'non-scalar argument' if ref $_;
+	my ( $base, $string ) = @_;
+	local $_ = $string;
+	die 'argument absent or undefined' unless defined $_;
+	die 'non-scalar argument' if ref $_;
 
 	# parse into quoted strings, contiguous non-whitespace and (discarded) comments
 	s/\\\\/\\092/g;						# disguise escaped escape
@@ -102,7 +101,7 @@
 	s/\\;/\\059/g;						# disguise escaped semicolon
 	my ( $owner, @token ) = grep { defined && length } split /$PARSE_REGEX/o;
 
-	croak 'unable to parse RR string' unless scalar @token;
+	die 'unable to parse RR string' unless scalar @token;
 	my $t1 = $token0;
 	my $t2 = $token1;
 
@@ -122,8 +121,8 @@
 
 	my $self = $base->_subclass( $type, $populated );	# create RR object
 	$self->owner($owner);
-	$self->class($class) if defined $class;			# specify CLASS
-	$self->ttl($ttl)     if defined $ttl;			# specify TTL
+	&class( $self, $class );				# specify CLASS
+	&ttl( $self, $ttl );					# specify TTL
 
 	return $self unless $populated;				# empty RR
 
@@ -131,7 +130,7 @@
 		shift @token;					# RFC3597 hexadecimal format
 		my $rdlen = shift(@token) || 0;
 		my $rdata = pack 'H*', join( '', @token );
-		croak 'length and hexadecimal data inconsistent' unless $rdlen == length $rdata;
+		die 'length and hexadecimal data inconsistent' unless $rdlen == length $rdata;
 		$self->rdata($rdata);				# unpack RDATA
 	} else {
 		$self->_parse_rdata(@token);			# parse arguments
@@ -201,15 +200,15 @@
 
 =head2 decode
 
-    ( $rr, $next ) = decode Net::DNS::RR( \$data, $offset, @opaque );
+    ( $rr, $next ) = Net::DNS::RR->decode( \$data, $offset, @opaque );
 
 Decodes a DNS resource record at the specified location within a
 DNS packet.
 
 The argument list consists of a reference to the buffer containing
 the packet data and offset indicating where resource record begins.
-Remaining arguments, if any, are passed as opaque data to
-subordinate decoders.
+Any remaining arguments are passed as opaque data to subordinate
+decoders and do not form part of the published interface.
 
 Returns a C<Net::DNS::RR> object and the offset of the next record
 in the packet.
@@ -217,20 +216,16 @@
 An exception is raised if the data buffer contains insufficient or
 corrupt data.
 
-Any remaining arguments are passed as opaque data to subordinate
-decoders and do not form part of the published interface.
-
 =cut
 
 use constant RRFIXEDSZ => length pack 'n2 N n', (0) x 4;
 
 sub decode {
-	my $base = shift;
-	my ( $data, $offset, @opaque ) = @_;
-
-	my ( $owner, $fixed ) = decode Net::DNS::DomainName1035(@_);
+	my ( $base, @argument ) = @_;
 
+	my ( $owner, $fixed ) = Net::DNS::DomainName1035->decode(@argument);
 	my $index = $fixed + RRFIXEDSZ;
+	my ( $data, $offset, @opaque ) = @argument;
 	die 'corrupt wire-format data' if length $$data < $index;
 	my $self = $base->_subclass( unpack "\@$fixed n", $$data );
 	$self->{owner} = $owner;
@@ -239,9 +234,8 @@
 	my $next = $index + $self->{rdlength};
 	die 'corrupt wire-format data' if length $$data < $next;
 
-	$self->{offset} = $offset || 0;
+	local $self->{offset} = $offset;
 	$self->_decode_rdata( $data, $index, @opaque ) if $next > $index or $self->type eq 'OPT';
-	delete $self->{offset};
 
 	return wantarray ? ( $self, $next ) : $self;
 }
@@ -263,8 +257,8 @@
 =cut
 
 sub encode {
-	my $self = shift;
-	my ( $offset, @opaque ) = scalar(@_) ? @_ : ( 0x4000, {} );
+	my ( $self, $offset, @opaque ) = @_;
+	( $offset, @opaque ) = ( 0x4000, {} ) unless defined $offset;
 
 	my $owner = $self->{owner}->encode( $offset, @opaque );
 	my ( $type, $class, $ttl ) = @{$self}{qw(type class ttl)};
@@ -329,18 +323,18 @@
 	my @ttl	 = grep {defined} $self->{ttl};
 	my @core = ( $name, @ttl, $self->class, $self->type );
 
+	local $SIG{__DIE__};
 	my $empty = $self->_empty;
 	my @rdata = $empty ? () : eval { $self->_format_rdata };
 	carp $@ if $@;
 
 	my $tab = length($name) < 72 ? "\t" : ' ';
-	$self->_annotation('no data') if $empty;
-
 	my @line = _wrap( join( $tab, @core, '(' ), @rdata, ')' );
 
 	my $last = pop(@line);					# last or only line
 	$last = join $tab, @core, "@rdata" unless scalar(@line);
 
+	$self->_annotation('no data') if $empty;
 	return join "\n\t", @line, _wrap( $last, map {"; $_"} $self->_annotation );
 }
 
@@ -418,8 +412,8 @@
 =cut
 
 sub owner {
-	my $self = shift;
-	$self->{owner} = Net::DNS::DomainName1035->new(shift) if scalar @_;
+	my ( $self, @name ) = @_;
+	for (@name) { $self->{owner} = Net::DNS::DomainName1035->new($_) }
 	return defined wantarray ? $self->{owner}->name : undef;
 }
 
@@ -435,8 +429,8 @@
 =cut
 
 sub type {
-	my $self = shift;
-	croak 'not possible to change RR->type' if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { croak 'not possible to change RR->type' }
 	return typebyval( $self->{type} );
 }
 
@@ -450,8 +444,8 @@
 =cut
 
 sub class {
-	my $self = shift;
-	return $self->{class} = classbyname(shift) if scalar @_;
+	my ( $self, $class ) = @_;
+	return $self->{class} = classbyname($class) if defined $class;
 	return defined $self->{class} ? classbyval( $self->{class} ) : 'IN';
 }
 
@@ -522,14 +516,18 @@
 
 
 sub dump {				## print internal data structure
-	require Data::Dumper;					# uncoverable pod
+	my @data = @_;						# uncoverable pod
+	require Data::Dumper;
 	local $Data::Dumper::Maxdepth = $Data::Dumper::Maxdepth || 6;
 	local $Data::Dumper::Sortkeys = $Data::Dumper::Sortkeys || 1;
-	return print Data::Dumper::Dumper(@_);
+	local $Data::Dumper::Useqq    = $Data::Dumper::Useqq	|| 1;
+	return print Data::Dumper::Dumper(@data);
 }
 
 sub rdatastr {				## historical RR subtype method
-	return &rdstring;					# uncoverable pod
+	my $self = shift;					# uncoverable pod
+	$self->_deprecate('prefer $rr->rdstring()');
+	return $self->rdstring;
 }
 
 
@@ -547,9 +545,7 @@
 	return $self->_empty ? '' : eval { $self->_encode_rdata( 0x4000, {} ) } unless @_;
 
 	my $data = shift || '';
-	my $hash = {};
-	$self->_decode_rdata( \$data, 0, $hash ) if ( $self->{rdlength} = length $data );
-	croak 'compression pointer in rdata'	 if keys %$hash;
+	$self->_decode_rdata( \$data, 0 ) if ( $self->{rdlength} = length $data );
 	return;
 }
 
@@ -564,6 +560,7 @@
 
 sub rdstring {
 	my $self = shift;
+	local $SIG{__DIE__};
 
 	my @rdata = $self->_empty ? () : eval { $self->_format_rdata };
 	carp $@ if $@;
@@ -596,7 +593,7 @@
 
 =head2 set_rrsort_func
 
-    my $function = sub {		## numerically ascending order
+    my $function = sub {	## numerically ascending order
 	$Net::DNS::a->{'preference'} <=> $Net::DNS::b->{'preference'};
     };
 
@@ -714,8 +711,8 @@
 
 
 sub _annotation {
-	my $self = shift;
-	$self->{annotation} = "@_" if scalar @_;
+	my ( $self, @note ) = @_;
+	$self->{annotation} = "@note" if scalar @note;
 	return wantarray ? @{$self->{annotation} || } : ();
 }
 
@@ -723,8 +720,8 @@
 my %warned;
 
 sub _deprecate {
-	my $msg = pop(@_);
-	carp join ' ', 'deprecated method;', $msg unless $warned{$msg}++;
+	my ( undef, @note ) = @_;
+	carp "deprecated method; @note" unless $warned{"@note"}++;
 	return;
 }
 
@@ -744,8 +741,6 @@
 
 	my ( @line, @fill );
 	foreach (@text) {
-		s/\\034/\\"/g;					# tart up escaped "
-		s/\\092/\\\\/g;					# tart up escaped escape
 		$coln += ( length || next ) + 1;
 		if ( $coln > $cols ) {				# start new line
 			push( @line, join ' ', @fill ) if @fill;
@@ -755,28 +750,32 @@
 		$coln = $cols	  if chomp;			# force line break
 		push( @fill, $_ ) if length;
 	}
-	push @line, join ' ', @fill;
-	return @line;
+	return ( @line, join ' ', @fill );
 }
 
 
 ################################################################################
 
-our $AUTOLOAD;
-
 sub DESTROY { }				## Avoid tickling AUTOLOAD (in cleanup)
 
+## no critic
 sub AUTOLOAD {				## Default method
-	my $self     = shift;
+	my ($self) = @_;
+
+	no strict 'refs';		## no critic ProhibitNoStrict
+	our $AUTOLOAD;
 	my ($method) = reverse split /::/, $AUTOLOAD;
 
-	for ($method) {			## tolerate mixed-case attribute name
-		return $self->$_(@_) if tr A-Z- a-z_;
+	for ( my $action = $method ) {	## tolerate mixed-case attribute name
+		tr A-Z- a-z_;
+		if ( $self->can($action) ) {
+			*{$AUTOLOAD} = sub { shift->$action(@_) };
+			return &$AUTOLOAD;
+		}
 	}
 
-	no strict 'refs';		## no critic ProhibitNoStrict
-	*{$AUTOLOAD} = sub {undef};	## suppress repetition and deep recursion
 	my $oref = ref($self);
+	*{$AUTOLOAD} = sub {};		## suppress deep recursion
 	croak qq$self has no class method "$method" unless $oref;
 
 	my $string = $self->string;
@@ -797,7 +796,7 @@
 @object
 $@
 END
-	goto &{'Carp::confess'};
+	goto &Carp::confess;
 }
 
 
@@ -839,9 +838,10 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::Question>,
-L<Net::DNS::Packet>, L<Net::DNS::Update>,
-RFC1035 Section 4.1.3, RFC1123, RFC3597
+L<perl> L<Net::DNS>
+L<Net::DNS::Question> L<Net::DNS::Packet> L<Net::DNS::Update>
+L<RFC1035(4.1.3)|https://tools.ietf.org/html/rfc1035>
+L<RFC3597|https://tools.ietf.org/html/rfc3597>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/A.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/A.pm Changed

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/AAAA.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/AAAA.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: AAAA.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: AAAA.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -17,8 +17,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	$self->{address} = unpack "\@$offset a16", $$data;
 	return;
@@ -40,9 +39,9 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->address(shift);
+	$self->address(@argument);
 	return;
 }
 
@@ -64,11 +63,10 @@
 
 
 sub address {
-	my $self = shift;
+	my ( $self, $addr ) = @_;
 
-	return address_long($self) unless scalar @_;
+	return address_long($self) unless defined $addr;
 
-	my $addr  = shift;
 	my @parse = split /:/, "0$addr";
 
 	if ( (@parse)$#parse =~ /\./ ) {			# embedded IPv4
@@ -168,6 +166,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC3596, RFC3513, RFC5952
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC3596|https://tools.ietf.org/html/rfc3596>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/AFSDB.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/AFSDB.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: AFSDB.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: AFSDB.pm 1898 2023-02-15 14:27:22Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -19,18 +19,16 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset, @opaque ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	$self->{subtype}  = unpack "\@$offset n", $$data;
-	$self->{hostname} = Net::DNS::DomainName2535->decode( $data, $offset + 2, @opaque );
+	$self->{hostname} = Net::DNS::DomainName2535->decode( $data, $offset + 2 );
 	return;
 }
 
 
 sub _encode_rdata {			## encode rdata as wire-format octet string
-	my $self = shift;
-	my ( $offset, @opaque ) = @_;
+	my ( $self, $offset, @opaque ) = @_;
 
 	my $hostname = $self->{hostname};
 	return pack 'n a*', $self->subtype, $hostname->encode( $offset + 2, @opaque );
@@ -46,26 +44,23 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->subtype(shift);
-	$self->hostname(shift);
+	for (qw(subtype hostname)) { $self->$_( shift @argument ) }
 	return;
 }
 
 
 sub subtype {
-	my $self = shift;
-
-	$self->{subtype} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{subtype} = 0 + $_ }
 	return $self->{subtype} || 0;
 }
 
 
 sub hostname {
-	my $self = shift;
-
-	$self->{hostname} = Net::DNS::DomainName2535->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{hostname} = Net::DNS::DomainName2535->new($_) }
 	return $self->{hostname} ? $self->{hostname}->name : undef;
 }
 
@@ -142,6 +137,8 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1183, RFC5864
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC1183(1)|https://tools.ietf.org/html/rfc1183>
+L<RFC5864|https://tools.ietf.org/html/rfc5864>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/AMTRELAY.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/AMTRELAY.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: AMTRELAY.pm 1855 2021-11-26 11:33:48Z willem $)2;
+our $VERSION = (qw$Id: AMTRELAY.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -23,8 +23,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	my $size = $self->{rdlength} - 2;
 	@{$self}{qw(precedence relaytype relay)} = unpack "\@$offset C2 a$size", $$data;
@@ -60,10 +59,10 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
 	foreach (qw(precedence dbit relaytype relay)) {
-		$self->$_(shift);
+		$self->$_( shift @argument );
 	}
 	return;
 }
@@ -78,33 +77,32 @@
 
 
 sub precedence {
-	my $self = shift;
-
-	$self->{precedence} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{precedence} = 0 + $_ }
 	return $self->{precedence} || 0;
 }
 
 
 sub dbit {
-	my $self = shift;					# uncoverable pod
-	$self->{relaytype} = $self->relaytype | ( $_0 ? 0x80 : 0 ) if scalar @_;
+	my ( $self, @value ) = @_;				# uncoverable pod
+	for (@value) { $self->{relaytype} = $self->relaytype | ( $_ ? 0x80 : 0 ) }
 	return ( $self->{relaytype} || 0 ) >> 7;
 }
 
-sub d {&dbit}							# uncoverable pod
+sub d { return &dbit }						# uncoverable pod
 
 
 sub relaytype {
-	my $self = shift;
-	$self->{relaytype} = $self->dbit ? ( 0x80 | shift ) : shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{relaytype} = $self->dbit ? ( 0x80 | $_ ) : $_ }
 	return 0x7f & ( $self->{relaytype} || 0 );
 }
 
 
 sub relay {
-	my $self = shift;
+	my ( $self, @value ) = @_;
 
-	for (@_) {
+	for (@value) {
 		/^\.*$/ && do {
 			$self->relaytype(0);
 			$self->{relay} = '';			# no relay
@@ -255,6 +253,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC8777, RFC7450
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC8777|https://tools.ietf.org/html/rfc8777>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/APL.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/APL.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: APL.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: APL.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -19,8 +19,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	my $limit = $offset + $self->{rdlength};
 
@@ -64,19 +63,20 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->aplist(@_);
+	$self->aplist(@argument);
 	return;
 }
 
 
 sub aplist {
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	while ( scalar @_ ) {					# parse apitem strings
-		last unless $_0 =~ m#!:./#;
-		shift =~ m#^(!?)(\d+):(.+)/(\d+)$#;
+	while ( scalar @argument ) {				# parse apitem strings
+		last unless $argument0 =~ m#!:./#;
+		local $_ = shift @argument;
+		m#^(!?)(\d+):(.+)/(\d+)$#;
 		my $n = $1 ? 1 : 0;
 		my $f = $2 || 0;
 		my $a = $3;
@@ -85,7 +85,7 @@
 	}
 
 	my $aplist = $self->{aplist} ||= ;
-	if ( my %argval = @_ ) {				# parse attribute=value list
+	if ( my %argval = @argument ) {				# parse attribute=value list
 		my $item = bless {}, 'Net::DNS::RR::APL::Item';
 		while ( my ( $attribute, $value ) = each %argval ) {
 			$item->$attribute($value) unless $attribute eq 'address';
@@ -112,36 +112,34 @@
 
 
 sub negate {
-	my $self = shift;
-	return $self->{negate} = shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { return $self->{negate} = $_ }
 	return $self->{negate};
 }
 
 
 sub family {
-	my $self = shift;
-
-	$self->{family} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{family} = 0 + $_ }
 	return $self->{family} || 0;
 }
 
 
 sub prefix {
-	my $self = shift;
-
-	$self->{prefix} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{prefix} = 0 + $_ }
 	return $self->{prefix} || 0;
 }
 
 
 sub address {
-	my $self = shift;
+	my ( $self, @value ) = @_;
 
 	my $family = $family{$self->family} || die 'unknown address family';
-	return bless( {%$self}, $family )->address unless scalar @_;
+	return bless( {%$self}, $family )->address unless scalar @value;
 
 	my $bitmask = $self->prefix;
-	my $address = bless( {}, $family )->address(shift);
+	my $address = bless( {}, $family )->address( shift @value );
 	return $self->{address} = pack "B$bitmask", unpack 'B*', $address;
 }
 
@@ -273,6 +271,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC3123
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC3123|https://tools.ietf.org/html/rfc3123>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/CAA.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/CAA.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: CAA.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: CAA.pm 1910 2023-03-30 19:16:30Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -19,8 +19,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	my $limit = $offset + $self->{rdlength};
 	$self->{flags} = unpack "\@$offset C", $$data;
@@ -46,11 +45,11 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->flags(shift);
-	$self->tag( lc shift );
-	$self->value(shift);
+	$self->flags( shift @argument );
+	$self->tag( lc shift @argument );
+	$self->value( shift @argument );
 	return;
 }
 
@@ -64,37 +63,34 @@
 
 
 sub flags {
-	my $self = shift;
-
-	$self->{flags} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{flags} = 0 + $_ }
 	return $self->{flags} || 0;
 }
 
 
 sub critical {
-	my $self = shift;
-	if ( scalar @_ ) {
-		for ( $self->{flags} ) {
-			$_ = 0x0080 | ( $_ || 0 );
-			$_ ^= 0x0080 unless shift;
+	my ( $self, @value ) = @_;
+	for ( $self->{flags} |= 0 ) {
+		if ( scalar @value ) {
+			$_ |= 0x0080;
+			$_ ^= 0x0080 unless shift @value;
 		}
 	}
-	return 0x0080 & ( $self->{flags} || 0 );
+	return $self->{flags} & 0x0080;
 }
 
 
 sub tag {
-	my $self = shift;
-
-	$self->{tag} = Net::DNS::Text->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{tag} = Net::DNS::Text->new($_) }
 	return $self->{tag} ? $self->{tag}->value : undef;
 }
 
 
 sub value {
-	my $self = shift;
-
-	$self->{value} = Net::DNS::Text->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{value} = Net::DNS::Text->new($_) }
 	return $self->{value} ? $self->{value}->value : undef;
 }
 
@@ -194,6 +190,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC8659
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC8659|https://tools.ietf.org/html/rfc8659>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/CDNSKEY.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/CDNSKEY.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: CDNSKEY.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: CDNSKEY.pm 1909 2023-03-23 11:36:16Z willem $)2;
 
 use base qw(Net::DNS::RR::DNSKEY);
 
@@ -16,22 +16,23 @@
 use integer;
 
 
+sub _format_rdata {			## format rdata portion of RR string.
+	my $self = shift;
+
+	return $self->SUPER::_format_rdata() if $self->algorithm;
+	return my @rdata = @{$self}{qw(flags protocol algorithm)}, "AA==";
+}
+
+
 sub algorithm {
 	my ( $self, $arg ) = @_;
 	return $self->SUPER::algorithm($arg) if $arg;
 	return $self->SUPER::algorithm() unless defined $arg;
-	@{$self}{qw(flags protocol algorithm)} = ( 0, 3, 0 );
+	@{$self}{qw(flags protocol algorithm keybin)} = ( 0, 3, 0, chr(0) );
 	return;
 }
 
 
-sub key {
-	my $self = shift;
-	return $self->SUPER::key(@_) unless defined( $_0 ) && length( $_0 ) < 2;
-	return $self->SUPER::keybin( $_0 ? '' : chr(0) );
-}
-
-
 1;
 __END__
 
@@ -91,6 +92,8 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, L<Net::DNS::RR::DNSKEY>, RFC7344, RFC8078(erratum 5049)
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<Net::DNS::RR::DNSKEY>
+L<RFC7344|https://tools.ietf.org/html/rfc7344>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/CDS.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/CDS.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: CDS.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: CDS.pm 1909 2023-03-23 11:36:16Z willem $)2;
 
 use base qw(Net::DNS::RR::DS);
 
@@ -20,21 +20,15 @@
 	my ( $self, $arg ) = @_;
 	return $self->SUPER::algorithm($arg) if $arg;
 	return $self->SUPER::algorithm() unless defined $arg;
-	@{$self}{qw(keytag algorithm digtype)} = ( 0, 0, 0 );
+	@{$self}{qw(keytag algorithm digtype digestbin)} = ( 0, 0, 0, chr(0) );
 	return;
 }
 
 
 sub digtype {
 	my ( $self, $arg ) = @_;
-	return $self->SUPER::digtype( $arg ? $arg : () );
-}
-
-
-sub digest {
-	my $self = shift;
-	return $self->SUPER::digest(@_) unless defined( $_0 ) && length( $_0 ) < 2;
-	return $self->SUPER::digestbin( $_0 ? '' : chr(0) );
+	return $self->SUPER::digtype($arg) if $arg;
+	return $self->SUPER::digtype();
 }
 
 
@@ -97,6 +91,8 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, L<Net::DNS::RR::DS>, RFC7344, RFC8078(erratum 5049)
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<Net::DNS::RR::DS>
+L<RFC7344|https://tools.ietf.org/html/rfc7344>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/CERT.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/CERT.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: CERT.pm 1856 2021-12-02 14:36:25Z willem $)2;
+our $VERSION = (qw$Id: CERT.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -33,8 +33,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	@{$self}{qw(certtype keytag algorithm)} = unpack "\@$offset n2 C", $$data;
 	$self->{certbin} = substr $$data, $offset + 5, $self->{rdlength} - 5;
@@ -59,22 +58,22 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->certtype(shift);
-	$self->keytag(shift);
-	$self->algorithm(shift);
-	$self->cert(@_);
+	foreach (qw(certtype keytag algorithm)) {
+		$self->$_( shift @argument );
+	}
+	$self->cert(@argument);
 	return;
 }
 
 
 sub certtype {
-	my $self = shift;
+	my ( $self, @value ) = @_;
 
-	return $self->{certtype} unless scalar @_;
+	return $self->{certtype} unless scalar @value;
 
-	my $certtype = shift || 0;
+	my $certtype = shift @value;
 	return $self->{certtype} = $certtype unless $certtype =~ /\D/;
 
 	my $typenum = $certtype{$certtype};
@@ -84,9 +83,8 @@
 
 
 sub keytag {
-	my $self = shift;
-
-	$self->{keytag} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{keytag} = 0 + $_ }
 	return $self->{keytag} || 0;
 }
 
@@ -104,17 +102,16 @@
 
 
 sub certbin {
-	my $self = shift;
-
-	$self->{certbin} = shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{certbin} = $_ }
 	return $self->{certbin} || "";
 }
 
 
 sub cert {
-	my $self = shift;
-	return MIME::Base64::encode( $self->certbin(), "" ) unless scalar @_;
-	return $self->certbin( MIME::Base64::decode( join "", @_ ) );
+	my ( $self, @value ) = @_;
+	return MIME::Base64::encode( $self->certbin(), "" ) unless scalar @value;
+	return $self->certbin( MIME::Base64::decode( join "", @value ) );
 }
 
 
@@ -264,7 +261,8 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC4398
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC4398|https://tools.ietf.org/html/rfc4398>
 
 L<Algorithm Numbers|http://www.iana.org/assignments/dns-sec-alg-numbers>

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/CNAME.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/CNAME.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: CNAME.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: CNAME.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -19,18 +19,18 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->{cname} = Net::DNS::DomainName1035->decode(@_);
+	$self->{cname} = Net::DNS::DomainName1035->decode(@argument);
 	return;
 }
 
 
 sub _encode_rdata {			## encode rdata as wire-format octet string
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
 	my $cname = $self->{cname};
-	return $cname->encode(@_);
+	return $cname->encode(@argument);
 }
 
 
@@ -43,17 +43,16 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->cname(shift);
+	$self->cname(@argument);
 	return;
 }
 
 
 sub cname {
-	my $self = shift;
-
-	$self->{cname} = Net::DNS::DomainName1035->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{cname} = Net::DNS::DomainName1035->new($_) }
 	return $self->{cname} ? $self->{cname}->name : undef;
 }
 
@@ -128,6 +127,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1035 Section 3.3.1
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC1035(3.3.1)|https://tools.ietf.org/html/rfc1035>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/CSYNC.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/CSYNC.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: CSYNC.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: CSYNC.pm 1910 2023-03-30 19:16:30Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -19,8 +19,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	my $limit = $offset + $self->{rdlength};
 	@{$self}{qw(soaserial flags)} = unpack "\@$offset Nn", $$data;
@@ -46,52 +45,50 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->soaserial(shift);
-	$self->flags(shift);
-	$self->typelist(@_);
+	$self->soaserial( shift @argument );
+	$self->flags( shift @argument );
+	$self->typelist(@argument);
 	return;
 }
 
 
 sub soaserial {
-	my $self = shift;
-
-	$self->{soaserial} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{soaserial} = 0 + $_ }
 	return $self->{soaserial} || 0;
 }
 
 
 sub flags {
-	my $self = shift;
-
-	$self->{flags} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{flags} = 0 + $_ }
 	return $self->{flags} || 0;
 }
 
 
 sub immediate {
-	my $self = shift;
-	if ( scalar @_ ) {
-		for ( $self->{flags} ) {
-			$_ = 0x0001 | ( $_ || 0 );
-			$_ ^= 0x0001 unless shift;
+	my ( $self, @value ) = @_;
+	for ( $self->{flags} |= 0 ) {
+		if ( scalar @value ) {
+			$_ |= 0x0001;
+			$_ ^= 0x0001 unless shift @value;
 		}
 	}
-	return 0x0001 & ( $self->{flags} || 0 );
+	return $self->{flags} & 0x0001;
 }
 
 
 sub soaminimum {
-	my $self = shift;
-	if ( scalar @_ ) {
-		for ( $self->{flags} ) {
-			$_ = 0x0002 | ( $_ || 0 );
-			$_ ^= 0x0002 unless shift;
+	my ( $self, @value ) = @_;
+	for ( $self->{flags} |= 0 ) {
+		if ( scalar @value ) {
+			$_ |= 0x0002;
+			$_ ^= 0x0002 unless shift @value;
 		}
 	}
-	return 0x0002 & ( $self->{flags} || 0 );
+	return $self->{flags} & 0x0002;
 }
 
 
@@ -213,6 +210,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC7477
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC7477|https://tools.ietf.org/html/rfc7477>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/DHCID.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/DHCID.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: DHCID.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: DHCID.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -19,8 +19,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	my $size = $self->{rdlength} - 3;
 	@{$self}{qw(identifiertype digesttype digest)} = unpack "\@$offset nC a$size", $$data;
@@ -44,9 +43,9 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	my $data = MIME::Base64::decode( join "", @_ );
+	my $data = MIME::Base64::decode( join "", @argument );
 	my $size = length($data) - 3;
 	@{$self}{qw(identifiertype digesttype digest)} = unpack "n C a$size", $data;
 	return;
@@ -73,25 +72,22 @@
 
 
 sub identifiertype {
-	my $self = shift;
-
-	$self->{identifiertype} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{identifiertype} = 0 + $_ }
 	return $self->{identifiertype} || 0;
 }
 
 
 sub digesttype {
-	my $self = shift;
-
-	$self->{digesttype} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{digesttype} = 0 + $_ }
 	return $self->{digesttype} || 0;
 }
 
 
 sub digest {
-	my $self = shift;
-
-	$self->{digest} = shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{digest} = $_ }
 	return $self->{digest} || "";
 }
 
@@ -182,6 +178,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC4701
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC4701|https://tools.ietf.org/html/rfc4701>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/DNAME.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/DNAME.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: DNAME.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: DNAME.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -19,18 +19,18 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->{target} = Net::DNS::DomainName2535->decode(@_);
+	$self->{target} = Net::DNS::DomainName2535->decode(@argument);
 	return;
 }
 
 
 sub _encode_rdata {			## encode rdata as wire-format octet string
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
 	my $target = $self->{target};
-	return $target->encode(@_);
+	return $target->encode(@argument);
 }
 
 
@@ -43,17 +43,16 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->target(shift);
+	$self->target(@argument);
 	return;
 }
 
 
 sub target {
-	my $self = shift;
-
-	$self->{target} = Net::DNS::DomainName2535->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{target} = Net::DNS::DomainName2535->new($_) }
 	return $self->{target} ? $self->{target}->name : undef;
 }
 
@@ -123,6 +122,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC6672
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC6672|https://tools.ietf.org/html/rfc6672>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/DNSKEY.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/DNSKEY.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: DNSKEY.pm 1856 2021-12-02 14:36:25Z willem $)2;
+our $VERSION = (qw$Id: DNSKEY.pm 1910 2023-03-30 19:16:30Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -21,12 +21,10 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	my $rdata = substr $$data, $offset, $self->{rdlength};
-	$self->{keybin} = unpack '@4 a*', $rdata;
-	@{$self}{qw(flags protocol algorithm)} = unpack 'n C*', $rdata;
+	@{$self}{qw(flags protocol algorithm keybin)} = unpack 'n C2 a*', $rdata;
 	return;
 }
 
@@ -41,23 +39,26 @@
 sub _format_rdata {			## format rdata portion of RR string.
 	my $self = shift;
 
-	my $algorithm = $self->{algorithm};
-	$self->_annotation( 'Key ID =', $self->keytag ) if $algorithm;
-	return $self->SUPER::_format_rdata() unless BASE64;
-	my @param = ( @{$self}{qw(flags protocol)}, $algorithm );
-	my @rdata = ( @param, split /\s+/, MIME::Base64::encode( $self->{keybin} ) || '-' );
+	my @rdata = @{$self}{qw(flags protocol algorithm)};
+	if ( my $keybin = $self->keybin ) {
+		$self->_annotation( 'Key ID =', $self->keytag );
+		return $self->SUPER::_format_rdata() unless BASE64;
+		push @rdata, split /\s+/, MIME::Base64::encode($keybin);
+	} else {
+		push @rdata, '""';
+	}
 	return @rdata;
 }
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	my $flags = shift;		## avoid destruction by CDNSKEY algorithm(0)
-	$self->protocol(shift);
-	$self->algorithm(shift);
-	$self->flags($flags);
-	$self->key(@_);
+	$self->flags( shift @argument );
+	$self->protocol( shift @argument );
+	my $algorithm = shift @argument;
+	$self->key(@argument) if $algorithm;
+	$self->algorithm($algorithm);
 	return;
 }
 
@@ -65,62 +66,60 @@
 sub _defaults {				## specify RR attribute default values
 	my $self = shift;
 
-	$self->algorithm(1);
 	$self->flags(256);
 	$self->protocol(3);
+	$self->algorithm(1);
 	$self->keybin('');
 	return;
 }
 
 
 sub flags {
-	my $self = shift;
-
-	$self->{flags} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{flags} = 0 + $_ }
 	return $self->{flags} || 0;
 }
 
 
 sub zone {
-	my $self = shift;
-	if ( scalar @_ ) {
-		for ( $self->{flags} ) {
-			$_ = 0x0100 | ( $_ || 0 );
-			$_ ^= 0x0100 unless shift;
+	my ( $self, @value ) = @_;
+	for ( $self->{flags} |= 0 ) {
+		if ( scalar @value ) {
+			$_ |= 0x0100;
+			$_ ^= 0x0100 unless shift @value;
 		}
 	}
-	return 0x0100 & ( $self->{flags} || 0 );
+	return $self->{flags} & 0x0100;
 }
 
 
 sub revoke {
-	my $self = shift;
-	if ( scalar @_ ) {
-		for ( $self->{flags} ) {
-			$_ = 0x0080 | ( $_ || 0 );
-			$_ ^= 0x0080 unless shift;
+	my ( $self, @value ) = @_;
+	for ( $self->{flags} |= 0 ) {
+		if ( scalar @value ) {
+			$_ |= 0x0080;
+			$_ ^= 0x0080 unless shift @value;
 		}
 	}
-	return 0x0080 & ( $self->{flags} || 0 );
+	return $self->{flags} & 0x0080;
 }
 
 
 sub sep {
-	my $self = shift;
-	if ( scalar @_ ) {
-		for ( $self->{flags} ) {
-			$_ = 0x0001 | ( $_ || 0 );
-			$_ ^= 0x0001 unless shift;
+	my ( $self, @value ) = @_;
+	for ( $self->{flags} |= 0 ) {
+		if ( scalar @value ) {
+			$_ |= 0x0001;
+			$_ ^= 0x0001 unless shift @value;
 		}
 	}
-	return 0x0001 & ( $self->{flags} || 0 );
+	return $self->{flags} & 0x0001;
 }
 
 
 sub protocol {
-	my $self = shift;
-
-	$self->{protocol} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{protocol} = 0 + $_ }
 	return $self->{protocol} || 0;
 }
 
@@ -140,21 +139,23 @@
 
 
 sub key {
-	my $self = shift;
-	return MIME::Base64::encode( $self->keybin(), "" ) unless scalar @_;
-	return $self->keybin( MIME::Base64::decode( join "", @_ ) );
+	my ( $self, @value ) = @_;
+	return MIME::Base64::encode( $self->keybin(), "" ) unless scalar @value;
+	return $self->keybin( MIME::Base64::decode( join "", @value ) );
 }
 
 
 sub keybin {
-	my $self = shift;
-
-	$self->{keybin} = shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{keybin} = $_ }
 	return $self->{keybin} || "";
 }
 
 
-sub publickey { return shift->key(@_); }
+sub publickey {
+	my ( $self, @value ) = @_;
+	return $self->key(@value);
+}
 
 
 sub privatekeyname {
@@ -203,7 +204,7 @@
 sub keytag {
 	my $self = shift;
 
-	my $keybin = $self->keybin || return 0;
+	my $keybin = $self->{keybin} || return;
 
 	# RFC4034 Appendix B.1: most significant 16 bits of least significant 24 bits
 	return unpack 'n', substr $keybin, -3 if $self->{algorithm} == 1;
@@ -429,7 +430,8 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC4034
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC4034|https://tools.ietf.org/html/rfc4034>
 
 L<DNSKEY Flags|http://www.iana.org/assignments/dnskey-flags>

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/DS.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/DS.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: DS.pm 1856 2021-12-02 14:36:25Z willem $)2;
+our $VERSION = (qw$Id: DS.pm 1909 2023-03-23 11:36:16Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -33,8 +33,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	my $rdata = substr $$data, $offset, $self->{rdlength};
 	@{$self}{qw(keytag algorithm digtype digestbin)} = unpack 'n C2 a*', $rdata;
@@ -52,29 +51,32 @@
 sub _format_rdata {			## format rdata portion of RR string.
 	my $self = shift;
 
-	$self->_annotation( $self->babble ) if BABBLE && $self->{algorithm};
-	my @param = @{$self}{qw(keytag algorithm digtype)};
-	my @rdata = ( @param, split /(\S{64})/, $self->digest || '-' );
+	my @rdata = @{$self}{qw(keytag algorithm digtype)};
+	if ( my $digest = $self->digest ) {
+		$self->_annotation( $self->babble ) if BABBLE;
+		push @rdata, split /(\S{64})/, $digest;
+	} else {
+		push @rdata, '""';
+	}
 	return @rdata;
 }
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	my $keytag = shift;		## avoid destruction by CDS algorithm(0)
-	$self->algorithm(shift);
-	$self->keytag($keytag);
-	$self->digtype(shift);
-	$self->digest(@_);
+	$self->keytag( shift @argument );
+	my $algorithm = shift @argument;
+	$self->digtype( shift @argument );
+	$self->digest(@argument);
+	$self->algorithm($algorithm);
 	return;
 }
 
 
 sub keytag {
-	my $self = shift;
-
-	$self->{keytag} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{keytag} = 0 + $_ }
 	return $self->{keytag} || 0;
 }
 
@@ -108,16 +110,16 @@
 
 
 sub digest {
-	my $self = shift;
-	return unpack "H*", $self->digestbin() unless scalar @_;
-	return $self->digestbin( pack "H*", join "", map { /^"*(\dA-Fa-f*)"*$/ || croak("corrupt hex"); $1 } @_ );
+	my ( $self, @value ) = @_;
+	return unpack "H*", $self->digestbin() unless scalar @value;
+	my @hex = map { /^"*(\dA-Fa-f*)"*$/ || croak("corrupt hex"); $1 } @value;
+	return $self->digestbin( pack "H*", join "", @hex );
 }
 
 
 sub digestbin {
-	my $self = shift;
-
-	$self->{digestbin} = shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{digestbin} = $_ }
 	return $self->{digestbin} || "";
 }
 
@@ -128,25 +130,22 @@
 
 
 sub create {
-	my $class = shift;
-	my $keyrr = shift;
-	my %args  = @_;
-
+	my ( $class, $keyrr, %args ) = @_;
 	my ($type) = reverse split '::', $class;
 
-	croak "Unable to create $type record for non-zone key" unless $keyrr->zone;
-	croak "Unable to create $type record for revoked key" if $keyrr->revoke;
 	croak "Unable to create $type record for invalid key" unless $keyrr->protocol == 3;
+	croak "Unable to create $type record for revoked key" if $keyrr->revoke;
+	croak "Unable to create $type record for non-zone key" unless $keyrr->zone;
 
 	my $self = Net::DNS::RR->new(
-		owner	  => $keyrr->owner,			# per definition, same as keyrr
-		type	  => $type,
-		class	  => $keyrr->class,
-		ttl	  => $keyrr->{ttl},
-		keytag	  => $keyrr->keytag,
+		owner	=> $keyrr->owner,			# per definition, same as keyrr
+		type	=> $type,
+		class	=> $keyrr->class,
+		ttl	=> $keyrr->{ttl},
+		digtype => 1,					# SHA1 by default
+		%args,
 		algorithm => $keyrr->algorithm,
-		digtype	  => 1,					# SHA1 by default
-		%args
+		keytag	  => $keyrr->keytag
 		);
 
 	my $hash = $digest{$self->digtype};
@@ -397,7 +396,8 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC4034
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC4034|https://tools.ietf.org/html/rfc4034>
 
 L<Digest Types|http://www.iana.org/assignments/ds-rr-types>

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/EUI48.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/EUI48.pm Changed

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/EUI64.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/EUI64.pm Changed

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/GPOS.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/GPOS.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: GPOS.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: GPOS.pm 1910 2023-03-30 19:16:30Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -20,13 +20,14 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	my $limit = $offset + $self->{rdlength};
-	( $self->{latitude},  $offset ) = Net::DNS::Text->decode( $data, $offset ) if $offset < $limit;
-	( $self->{longitude}, $offset ) = Net::DNS::Text->decode( $data, $offset ) if $offset < $limit;
-	( $self->{altitude},  $offset ) = Net::DNS::Text->decode( $data, $offset ) if $offset < $limit;
+	for (qw(latitude longitude altitude)) {
+		my $text;
+		( $text, $offset ) = Net::DNS::Text->decode( $data, $offset );
+		$self->$_( $text->value );
+	}
 	croak('corrupt GPOS data') unless $offset == $limit;	# more or less FUBAR
 	return;
 }
@@ -35,26 +36,23 @@
 sub _encode_rdata {			## encode rdata as wire-format octet string
 	my $self = shift;
 
-	return '' unless defined $self->{altitude};
-	return join '', map { $self->{$_}->encode } qw(latitude longitude altitude);
+	return join '', map { Net::DNS::Text->new($_)->encode } @{$self}{qw(latitude longitude altitude)};
 }
 
 
 sub _format_rdata {			## format rdata portion of RR string.
 	my $self = shift;
 
-	return '' unless defined $self->{altitude};
-	return join ' ', map { $self->{$_}->string } qw(latitude longitude altitude);
+	return map { Net::DNS::Text->new($_)->string } @{$self}{qw(latitude longitude altitude)};
 }
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->latitude(shift);
-	$self->longitude(shift);
-	$self->altitude(shift);
-	die 'too many arguments for GPOS' if scalar @_;
+	$self->latitude( shift @argument );
+	$self->longitude( shift @argument );
+	$self->altitude(@argument);
 	return;
 }
 
@@ -68,35 +66,31 @@
 
 
 sub latitude {
-	my $self = shift;
-	$self->{latitude} = _fp2text(shift) if scalar @_;
-	return defined(wantarray) ? _text2fp( $self->{latitude} ) : undef;
+	my ( $self, @value ) = @_;
+	for (@value) { return $self->{latitude} = _fp($_) }
+	return $self->{latitude};
 }
 
 
 sub longitude {
-	my $self = shift;
-	$self->{longitude} = _fp2text(shift) if scalar @_;
-	return defined(wantarray) ? _text2fp( $self->{longitude} ) : undef;
+	my ( $self, @value ) = @_;
+	for (@value) { return $self->{longitude} = _fp($_) }
+	return $self->{longitude};
 }
 
 
 sub altitude {
-	my $self = shift;
-	$self->{altitude} = _fp2text(shift) if scalar @_;
-	return defined(wantarray) ? _text2fp( $self->{altitude} ) : undef;
+	my ( $self, @value ) = @_;
+	for (@value) { return $self->{altitude} = _fp($_) }
+	return $self->{altitude};
 }
 
 
 ########################################
 
-sub _fp2text {
-	return Net::DNS::Text->new( sprintf( '%1.10g', shift ) );
-}
-
-sub _text2fp {
+sub _fp {
 	no integer;
-	return ( 0.0 + shift->value );
+	return sprintf( '%1.10g', 0.0 + shift );
 }
 
 ########################################
@@ -177,6 +171,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1712
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC1712|https://tools.ietf.org/html/rfc1712>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/HINFO.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/HINFO.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: HINFO.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: HINFO.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -19,8 +19,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	( $self->{cpu}, $offset ) = Net::DNS::Text->decode( $data, $offset );
 	( $self->{os},	$offset ) = Net::DNS::Text->decode( $data, $offset );
@@ -43,26 +42,24 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->cpu(shift);
-	$self->os(@_);
+	$self->cpu( shift @argument );
+	$self->os(@argument);
 	return;
 }
 
 
 sub cpu {
-	my $self = shift;
-
-	$self->{cpu} = Net::DNS::Text->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{cpu} = Net::DNS::Text->new($_) }
 	return $self->{cpu} ? $self->{cpu}->value : undef;
 }
 
 
 sub os {
-	my $self = shift;
-
-	$self->{os} = Net::DNS::Text->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{os} = Net::DNS::Text->new($_) }
 	return $self->{os} ? $self->{os}->value : undef;
 }
 
@@ -135,6 +132,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1035 Section 3.3.2
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC1035(3.3.2)|https://tools.ietf.org/html/rfc1035>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/HIP.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/HIP.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: HIP.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: HIP.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -21,8 +21,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	my ( $hitlen, $pklen ) = unpack "\@$offset Cxn", $$data;
 	@{$self}{qw(algorithm hitbin keybin)} = unpack "\@$offset xCxx a$hitlen a$pklen", $$data;
@@ -61,63 +60,59 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	foreach (qw(algorithm hit key)) { $self->$_(shift) }
-	$self->servers(@_);
+	foreach (qw(algorithm hit key)) { $self->$_( shift @argument ) }
+	$self->servers(@argument);
 	return;
 }
 
 
 sub algorithm {
-	my $self = shift;
-
-	$self->{algorithm} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{algorithm} = 0 + $_ }
 	return $self->{algorithm} || 0;
 }
 
 
 sub hit {
-	my $self = shift;
-	return unpack "H*", $self->hitbin() unless scalar @_;
-	return $self->hitbin( pack "H*", join "", map { /^"*(\dA-Fa-f*)"*$/ || croak("corrupt hex"); $1 } @_ );
+	my ( $self, @value ) = @_;
+	return unpack "H*", $self->hitbin() unless scalar @value;
+	my @hex = map { /^"*(\dA-Fa-f*)"*$/ || croak("corrupt hex"); $1 } @value;
+	return $self->hitbin( pack "H*", join "", @hex );
 }
 
 
 sub hitbin {
-	my $self = shift;
-
-	$self->{hitbin} = shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{hitbin} = $_ }
 	return $self->{hitbin} || "";
 }
 
 
 sub key {
-	my $self = shift;
-	return MIME::Base64::encode( $self->keybin(), "" ) unless scalar @_;
-	return $self->keybin( MIME::Base64::decode( join "", @_ ) );
+	my ( $self, @value ) = @_;
+	return MIME::Base64::encode( $self->keybin(), "" ) unless scalar @value;
+	return $self->keybin( MIME::Base64::decode( join "", @value ) );
 }
 
 
 sub keybin {
-	my $self = shift;
-
-	$self->{keybin} = shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{keybin} = $_ }
 	return $self->{keybin} || "";
 }
 
 
 sub servers {
-	my $self = shift;
-
+	my ( $self, @names ) = @_;
 	my $servers = $self->{servers} ||= ;
-	@$servers = map { Net::DNS::DomainName->new($_) } @_ if scalar @_;
+	for (@names) { push @$servers, Net::DNS::DomainName->new($_) }
 	return defined(wantarray) ? map( { $_->name } @$servers ) : ();
 }
 
 sub rendezvousservers {			## historical
-	$_0->_deprecate('prefer $rr->servers()');		# uncoverable pod
-	my @servers = &servers;
+	my @servers = &servers;					# uncoverable pod
 	return \@servers;
 }
 
@@ -227,6 +222,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC8005
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC8005|https://tools.ietf.org/html/rfc8005>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/HTTPS.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/HTTPS.pm Changed

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/IPSECKEY.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/IPSECKEY.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: IPSECKEY.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: IPSECKEY.pm 1909 2023-03-23 11:36:16Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -16,16 +16,23 @@
 use integer;
 
 use Carp;
-use MIME::Base64;
 
 use Net::DNS::DomainName;
 use Net::DNS::RR::A;
 use Net::DNS::RR::AAAA;
 
+use constant BASE64 => defined eval { require MIME::Base64 };
+
+my %wireformat = (
+	0 => 'C3 a0 a*',
+	1 => 'C3 a4 a*',
+	2 => 'C3 a16 a*',
+	3 => 'C3 a* a*',
+	);
+
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	my $limit = $offset + $self->{rdlength};
 
@@ -47,7 +54,7 @@
 	} elsif ( $gatetype == 3 ) {
 		my $name;
 		( $name, $offset ) = Net::DNS::DomainName->decode( $data, $offset );
-		$self->{gateway} = $name;
+		$self->{gateway} = $name->encode;
 
 	} else {
 		die "unknown gateway type ($gatetype)";
@@ -67,46 +74,33 @@
 	my $algorithm  = $self->algorithm;
 	my $keybin     = $self->keybin;
 
-	if ( not $gatetype ) {
-		return pack 'C3 a*', $precedence, $gatetype, $algorithm, $keybin;
-
-	} elsif ( $gatetype == 1 ) {
-		return pack 'C3 a4 a*', $precedence, $gatetype, $algorithm, $gateway, $keybin;
-
-	} elsif ( $gatetype == 2 ) {
-		return pack 'C3 a16 a*', $precedence, $gatetype, $algorithm, $gateway, $keybin;
-
-	} elsif ( $gatetype == 3 ) {
-		my $namebin = $gateway->encode;
-		return pack 'C3 a* a*', $precedence, $gatetype, $algorithm, $namebin, $keybin;
-	}
-	die "unknown gateway type ($gatetype)";
+	return pack $wireformat{$gatetype}, $precedence, $gatetype, $algorithm, $gateway, $keybin;
 }
 
 
 sub _format_rdata {			## format rdata portion of RR string.
 	my $self = shift;
 
-	my @params = map { $self->$_ } qw(precedence gatetype algorithm);
-	my @base64 = split /\s+/, encode_base64( $self->keybin );
-	my @rdata  = ( @params, $self->gateway, @base64 );
+	return $self->SUPER::_format_rdata() unless BASE64;
+	my @rdata  = map { $self->$_ } qw(precedence gatetype algorithm);
+	my @base64 = split /\s+/, MIME::Base64::encode( $self->keybin );
+	push @rdata, ( $self->gateway, @base64 );
 	return @rdata;
 }
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	foreach (qw(precedence gatetype algorithm gateway)) { $self->$_(shift) }
-	$self->key(@_);
+	foreach (qw(precedence gatetype algorithm gateway)) { $self->$_( shift @argument ) }
+	$self->key(@argument);
 	return;
 }
 
 
 sub precedence {
-	my $self = shift;
-
-	$self->{precedence} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{precedence} = 0 + $_ }
 	return $self->{precedence} || 0;
 }
 
@@ -117,20 +111,19 @@
 
 
 sub algorithm {
-	my $self = shift;
-
-	$self->{algorithm} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{algorithm} = 0 + $_ }
 	return $self->{algorithm} || 0;
 }
 
 
 sub gateway {
-	my $self = shift;
+	my ( $self, @value ) = @_;
 
-	for (@_) {
+	for (@value) {
 		/^\.*$/ && do {
 			$self->{gatetype} = 0;
-			$self->{gateway}  = undef;		# no gateway
+			$self->{gateway}  = '';			# no gateway
 			last;
 		};
 		/:.*:/ && do {
@@ -145,38 +138,35 @@
 		};
 		/\..+/ && do {
 			$self->{gatetype} = 3;
-			$self->{gateway}  = Net::DNS::DomainName->new($_);
+			$self->{gateway}  = Net::DNS::DomainName->new($_)->encode;
 			last;
 		};
 		croak 'unrecognised gateway type';
 	}
 
 	if ( defined wantarray ) {
-		my $gatetype = $self->{gatetype};
-		return wantarray ? '.' : undef unless $gatetype;
 		my $gateway = $self->{gateway};
-		for ($gatetype) {
+		for ( $self->gatetype ) {
 			/^1$/ && return Net::DNS::RR::A::address( {address => $gateway} );
 			/^2$/ && return Net::DNS::RR::AAAA::address( {address => $gateway} );
-			/^3$/ && return wantarray ? $gateway->string : $gateway->name;
-			die "unknown gateway type ($gatetype)";
+			/^3$/ && return Net::DNS::DomainName->decode( \$gateway )->name;
 		}
+		return wantarray ? '.' : undef;
 	}
 	return;
 }
 
 
 sub key {
-	my $self = shift;
-	return MIME::Base64::encode( $self->keybin(), "" ) unless scalar @_;
-	return $self->keybin( MIME::Base64::decode( join "", @_ ) );
+	my ( $self, @value ) = @_;
+	return MIME::Base64::encode( $self->keybin(), "" ) unless scalar @value;
+	return $self->keybin( MIME::Base64::decode( join "", @value ) );
 }
 
 
 sub keybin {
-	my $self = shift;
-
-	$self->{keybin} = shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{keybin} = $_ }
 	return $self->{keybin} || "";
 }
 
@@ -296,6 +286,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC4025
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC4025|https://tools.ietf.org/html/rfc4025>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/ISDN.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/ISDN.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: ISDN.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: ISDN.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -19,8 +19,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	( $self->{address}, $offset ) = Net::DNS::Text->decode( $data, $offset );
 	( $self->{sa},	    $offset ) = Net::DNS::Text->decode( $data, $offset );
@@ -45,10 +44,10 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->address(shift);
-	$self->sa(@_);
+	$self->address( shift @argument );
+	$self->sa(@argument);
 	return;
 }
 
@@ -62,17 +61,15 @@
 
 
 sub address {
-	my $self = shift;
-
-	$self->{address} = Net::DNS::Text->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{address} = Net::DNS::Text->new($_) }
 	return $self->{address} ? $self->{address}->value : undef;
 }
 
 
 sub sa {
-	my $self = shift;
-
-	$self->{sa} = Net::DNS::Text->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{sa} = Net::DNS::Text->new($_) }
 	return $self->{sa} ? $self->{sa}->value : undef;
 }
 
@@ -152,6 +149,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1183 Section 3.2
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC1183(3.2)|https://tools.ietf.org/html/rfc1183>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/KEY.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/KEY.pm Changed

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/KX.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/KX.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: KX.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: KX.pm 1898 2023-02-15 14:27:22Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -19,18 +19,16 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset, @opaque ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	$self->{preference} = unpack( "\@$offset n", $$data );
-	$self->{exchange}   = Net::DNS::DomainName2535->decode( $data, $offset + 2, @opaque );
+	$self->{exchange}   = Net::DNS::DomainName2535->decode( $data, $offset + 2 );
 	return;
 }
 
 
 sub _encode_rdata {			## encode rdata as wire-format octet string
-	my $self = shift;
-	my ( $offset, @opaque ) = @_;
+	my ( $self, $offset, @opaque ) = @_;
 
 	my $exchange = $self->{exchange};
 	return pack 'n a*', $self->preference, $exchange->encode( $offset + 2, @opaque );
@@ -46,26 +44,23 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->preference(shift);
-	$self->exchange(shift);
+	for (qw(preference exchange)) { $self->$_( shift @argument ) }
 	return;
 }
 
 
 sub preference {
-	my $self = shift;
-
-	$self->{preference} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{preference} = 0 + $_ }
 	return $self->{preference} || 0;
 }
 
 
 sub exchange {
-	my $self = shift;
-
-	$self->{exchange} = Net::DNS::DomainName2535->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{exchange} = Net::DNS::DomainName2535->new($_) }
 	return $self->{exchange} ? $self->{exchange}->name : undef;
 }
 
@@ -150,6 +145,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC2230
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC2230|https://tools.ietf.org/html/rfc2230>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/L32.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/L32.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: L32.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: L32.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -17,8 +17,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	@{$self}{qw(preference locator32)} = unpack "\@$offset n a4", $$data;
 	return;
@@ -40,18 +39,16 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->preference(shift);
-	$self->locator32(shift);
+	for (qw(preference locator32)) { $self->$_( shift @argument ) }
 	return;
 }
 
 
 sub preference {
-	my $self = shift;
-
-	$self->{preference} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{preference} = 0 + $_ }
 	return $self->{preference} || 0;
 }
 
@@ -157,6 +154,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC6742
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC6742|https://tools.ietf.org/html/rfc6742>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/L64.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/L64.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: L64.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: L64.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -17,8 +17,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	@{$self}{qw(preference locator64)} = unpack "\@$offset n a8", $$data;
 	return;
@@ -40,18 +39,16 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->preference(shift);
-	$self->locator64(shift);
+	for (qw(preference locator64)) { $self->$_( shift @argument ) }
 	return;
 }
 
 
 sub preference {
-	my $self = shift;
-
-	$self->{preference} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{preference} = 0 + $_ }
 	return $self->{preference} || 0;
 }
 
@@ -157,6 +154,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC6742
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC6742|https://tools.ietf.org/html/rfc6742>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/LOC.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/LOC.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: LOC.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: LOC.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -19,8 +19,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	my $version = $self->{version} = unpack "\@$offset C", $$data;
 	@{$self}{qw(size hp vp latitude longitude altitude)} = unpack "\@$offset xC3N3", $$data;
@@ -50,27 +49,27 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
 	my @lat;
-	while ( scalar @_ ) {
-		my $this = shift;
+	while ( scalar @argument ) {
+		my $this = shift @argument;
 		push( @lat, $this );
 		last if $this =~ /NSns/;
 	}
 	$self->latitude(@lat);
 
 	my @long;
-	while ( scalar @_ ) {
-		my $this = shift;
+	while ( scalar @argument ) {
+		my $this = shift @argument;
 		push( @long, $this );
 		last if $this =~ /EWew/;
 	}
 	$self->longitude(@long);
 
 	foreach my $attr (qw(altitude size hp vp)) {
-		$self->$attr(@_);
-		shift;
+		$self->$attr(@argument);
+		shift @argument;
 	}
 	return;
 }
@@ -88,36 +87,36 @@
 
 
 sub latitude {
-	my $self = shift;
-	$self->{latitude} = _encode_angle(@_) if scalar @_;
+	my ( $self, @value ) = @_;
+	$self->{latitude} = _encode_angle(@value) if scalar @value;
 	return _decode_angle( $self->{latitude} || return, 'N', 'S' );
 }
 
 
 sub longitude {
-	my $self = shift;
-	$self->{longitude} = _encode_angle(@_) if scalar @_;
+	my ( $self, @value ) = @_;
+	$self->{longitude} = _encode_angle(@value) if scalar @value;
 	return _decode_angle( $self->{longitude} || return, 'E', 'W' );
 }
 
 
 sub altitude {
-	my $self = shift;
-	$self->{altitude} = _encode_alt(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	$self->{altitude} = _encode_alt(@value) if scalar @value;
 	return _decode_alt( $self->{altitude} );
 }
 
 
 sub size {
-	my $self = shift;
-	$self->{size} = _encode_prec(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	$self->{size} = _encode_prec(@value) if scalar @value;
 	return _decode_prec( $self->{size} );
 }
 
 
 sub hp {
-	my $self = shift;
-	$self->{hp} = _encode_prec(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	$self->{hp} = _encode_prec(@value) if scalar @value;
 	return _decode_prec( $self->{hp} );
 }
 
@@ -125,8 +124,8 @@
 
 
 sub vp {
-	my $self = shift;
-	$self->{vp} = _encode_prec(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	$self->{vp} = _encode_prec(@value) if scalar @value;
 	return _decode_prec( $self->{vp} );
 }
 
@@ -134,9 +133,10 @@
 
 
 sub latlon {
-	my $self = shift;
-	my ( $lat, @lon ) = @_;
-	return ( scalar $self->latitude(@_), scalar $self->longitude(@lon) );
+	my ( $self, @argument ) = @_;
+	my @lat = @argument;
+	my ( undef, @long ) = @argument;
+	return ( scalar $self->latitude(@lat), scalar $self->longitude(@long) );
 }
 
 
@@ -166,7 +166,8 @@
 
 
 sub _encode_angle {
-	my @ang = scalar @_ > 1 ? (@_) : ( split /\s\260'"+/, shift );
+	my @ang = @_;
+	@ang = split /\s\260'"+/, shift @ang unless scalar @ang > 1;
 	my $ang = ( 0 + shift @ang ) * 3600000;
 	my $neg = ( @ang ? pop @ang : '' ) =~ /SWsw/;
 	$ang += ( @ang ? shift @ang : 0 ) * 60000;
@@ -340,6 +341,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1876
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC1876|https://tools.ietf.org/html/rfc1876>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/LP.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/LP.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: LP.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: LP.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -17,8 +17,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	$self->{preference} = unpack( "\@$offset n", $$data );
 	$self->{target}	    = Net::DNS::DomainName->decode( $data, $offset + 2 );
@@ -43,26 +42,23 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->preference(shift);
-	$self->target(shift);
+	for (qw(preference target)) { $self->$_( shift @argument ) }
 	return;
 }
 
 
 sub preference {
-	my $self = shift;
-
-	$self->{preference} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{preference} = 0 + $_ }
 	return $self->{preference} || 0;
 }
 
 
 sub target {
-	my $self = shift;
-
-	$self->{target} = Net::DNS::DomainName->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{target} = Net::DNS::DomainName->new($_) }
 	return $self->{target} ? $self->{target}->name : undef;
 }
 
@@ -166,6 +162,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC6742
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC6742|https://tools.ietf.org/html/rfc6742>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/MB.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/MB.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: MB.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: MB.pm 1910 2023-03-30 19:16:30Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -19,41 +19,38 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->{madname} = Net::DNS::DomainName1035->decode(@_);
+	$self->{madname} = Net::DNS::DomainName1035->decode(@argument);
 	return;
 }
 
 
 sub _encode_rdata {			## encode rdata as wire-format octet string
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	my $madname = $self->{madname} || return '';
-	return $madname->encode(@_);
+	return $self->{madname}->encode(@argument);
 }
 
 
 sub _format_rdata {			## format rdata portion of RR string.
 	my $self = shift;
 
-	my $madname = $self->{madname} || return '';
-	return $madname->string;
+	return $self->{madname}->string;
 }
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->madname(shift);
+	$self->madname(@argument);
 	return;
 }
 
 
 sub madname {
-	my $self = shift;
-
-	$self->{madname} = Net::DNS::DomainName1035->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{madname} = Net::DNS::DomainName1035->new($_) }
 	return $self->{madname} ? $self->{madname}->name : undef;
 }
 
@@ -120,6 +117,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1035 Section 3.3.3
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC1035(3.3.3)|https://tools.ietf.org/html/rfc1035>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/MG.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/MG.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: MG.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: MG.pm 1910 2023-03-30 19:16:30Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -19,41 +19,38 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->{mgmname} = Net::DNS::DomainName1035->decode(@_);
+	$self->{mgmname} = Net::DNS::DomainName1035->decode(@argument);
 	return;
 }
 
 
 sub _encode_rdata {			## encode rdata as wire-format octet string
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	my $mgmname = $self->{mgmname} || return '';
-	return $mgmname->encode(@_);
+	return $self->{mgmname}->encode(@argument);
 }
 
 
 sub _format_rdata {			## format rdata portion of RR string.
 	my $self = shift;
 
-	my $mgmname = $self->{mgmname} || return '';
-	return $mgmname->string;
+	return $self->{mgmname}->string;
 }
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->mgmname(shift);
+	$self->mgmname(@argument);
 	return;
 }
 
 
 sub mgmname {
-	my $self = shift;
-
-	$self->{mgmname} = Net::DNS::DomainName1035->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{mgmname} = Net::DNS::DomainName1035->new($_) }
 	return $self->{mgmname} ? $self->{mgmname}->name : undef;
 }
 
@@ -120,6 +117,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1035 Section 3.3.6
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC1035(3.3.6)|https://tools.ietf.org/html/rfc1035>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/MINFO.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/MINFO.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: MINFO.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: MINFO.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -19,20 +19,20 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset, @opaque ) = @_;
+	my ( $self, @argument ) = @_;
+	my ( $data, $offset, @opaque ) = @argument;
 
-	( $self->{rmailbx}, $offset ) = Net::DNS::Mailbox1035->decode(@_);
+	( $self->{rmailbx}, $offset ) = Net::DNS::Mailbox1035->decode(@argument);
 	( $self->{emailbx}, $offset ) = Net::DNS::Mailbox1035->decode( $data, $offset, @opaque );
 	return;
 }
 
 
 sub _encode_rdata {			## encode rdata as wire-format octet string
-	my $self = shift;
-	my ( $offset, @opaque ) = @_;
+	my ( $self,   @argument ) = @_;
+	my ( $offset, @opaque )	  = @argument;
 
-	my $rdata = $self->{rmailbx}->encode(@_);
+	my $rdata = $self->{rmailbx}->encode(@argument);
 	$rdata .= $self->{emailbx}->encode( $offset + length $rdata, @opaque );
 	return $rdata;
 }
@@ -47,26 +47,23 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->rmailbx(shift);
-	$self->emailbx(shift);
+	for (qw(rmailbx emailbx)) { $self->$_( shift @argument ) }
 	return;
 }
 
 
 sub rmailbx {
-	my $self = shift;
-
-	$self->{rmailbx} = Net::DNS::Mailbox1035->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{rmailbx} = Net::DNS::Mailbox1035->new($_) }
 	return $self->{rmailbx} ? $self->{rmailbx}->address : undef;
 }
 
 
 sub emailbx {
-	my $self = shift;
-
-	$self->{emailbx} = Net::DNS::Mailbox1035->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{emailbx} = Net::DNS::Mailbox1035->new($_) }
 	return $self->{emailbx} ? $self->{emailbx}->address : undef;
 }
 
@@ -150,6 +147,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1035 Section 3.3.7
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC1035(3.3.7)|https://tools.ietf.org/html/rfc1035>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/MR.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/MR.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: MR.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: MR.pm 1910 2023-03-30 19:16:30Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -19,41 +19,38 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->{newname} = Net::DNS::DomainName1035->decode(@_);
+	$self->{newname} = Net::DNS::DomainName1035->decode(@argument);
 	return;
 }
 
 
 sub _encode_rdata {			## encode rdata as wire-format octet string
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	my $newname = $self->{newname} || return '';
-	return $newname->encode(@_);
+	return $self->{newname}->encode(@argument);
 }
 
 
 sub _format_rdata {			## format rdata portion of RR string.
 	my $self = shift;
 
-	my $newname = $self->{newname} || return '';
-	return $newname->string;
+	return $self->{newname}->string;
 }
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->newname(shift);
+	$self->newname(@argument);
 	return;
 }
 
 
 sub newname {
-	my $self = shift;
-
-	$self->{newname} = Net::DNS::DomainName1035->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{newname} = Net::DNS::DomainName1035->new($_) }
 	return $self->{newname} ? $self->{newname}->name : undef;
 }
 
@@ -120,6 +117,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1035 Section 3.3.8
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC1035(3.3.8)|https://tools.ietf.org/html/rfc1035>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/MX.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/MX.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: MX.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: MX.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -19,8 +19,8 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset, @opaque ) = @_;
+	my ( $self, @argument ) = @_;
+	my ( $data, $offset, @opaque ) = @argument;
 
 	$self->{preference} = unpack( "\@$offset n", $$data );
 	$self->{exchange}   = Net::DNS::DomainName1035->decode( $data, $offset + 2, @opaque );
@@ -29,8 +29,8 @@
 
 
 sub _encode_rdata {			## encode rdata as wire-format octet string
-	my $self = shift;
-	my ( $offset, @opaque ) = @_;
+	my ( $self,   @argument ) = @_;
+	my ( $offset, @opaque )	  = @argument;
 
 	my $exchange = $self->{exchange};
 	return pack 'n a*', $self->preference, $exchange->encode( $offset + 2, @opaque );
@@ -46,10 +46,9 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->preference(shift);
-	$self->exchange(shift);
+	for (qw(preference exchange)) { $self->$_( shift @argument ) }
 	return;
 }
 
@@ -63,17 +62,15 @@
 
 
 sub preference {
-	my $self = shift;
-
-	$self->{preference} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{preference} = 0 + $_ }
 	return $self->{preference} || 0;
 }
 
 
 sub exchange {
-	my $self = shift;
-
-	$self->{exchange} = Net::DNS::DomainName1035->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{exchange} = Net::DNS::DomainName1035->new($_) }
 	return $self->{exchange} ? $self->{exchange}->name : undef;
 }
 
@@ -160,6 +157,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1035 Section 3.3.9
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC1035(3.3.9)|https://tools.ietf.org/html/rfc1035>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/NAPTR.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/NAPTR.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: NAPTR.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: NAPTR.pm 1898 2023-02-15 14:27:22Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -20,21 +20,19 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset, @opaque ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	@{$self}{qw(order preference)} = unpack "\@$offset n2", $$data;
 	( $self->{flags},   $offset ) = Net::DNS::Text->decode( $data, $offset + 4 );
 	( $self->{service}, $offset ) = Net::DNS::Text->decode( $data, $offset );
 	( $self->{regexp},  $offset ) = Net::DNS::Text->decode( $data, $offset );
-	$self->{replacement} = Net::DNS::DomainName2535->decode( $data, $offset, @opaque );
+	$self->{replacement} = Net::DNS::DomainName2535->decode( $data, $offset );
 	return;
 }
 
 
 sub _encode_rdata {			## encode rdata as wire-format octet string
-	my $self = shift;
-	my ( $offset, @opaque ) = @_;
+	my ( $self, $offset, @opaque ) = @_;
 
 	my $rdata = pack 'n2', @{$self}{qw(order preference)};
 	$rdata .= $self->{flags}->encode;
@@ -55,57 +53,51 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	foreach (qw(order preference flags service regexp replacement)) { $self->$_(shift) }
+	foreach (qw(order preference flags service regexp replacement)) { $self->$_( shift @argument ) }
 	return;
 }
 
 
 sub order {
-	my $self = shift;
-
-	$self->{order} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{order} = 0 + $_ }
 	return $self->{order} || 0;
 }
 
 
 sub preference {
-	my $self = shift;
-
-	$self->{preference} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{preference} = 0 + $_ }
 	return $self->{preference} || 0;
 }
 
 
 sub flags {
-	my $self = shift;
-
-	$self->{flags} = Net::DNS::Text->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{flags} = Net::DNS::Text->new($_) }
 	return $self->{flags} ? $self->{flags}->value : undef;
 }
 
 
 sub service {
-	my $self = shift;
-
-	$self->{service} = Net::DNS::Text->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{service} = Net::DNS::Text->new($_) }
 	return $self->{service} ? $self->{service}->value : undef;
 }
 
 
 sub regexp {
-	my $self = shift;
-
-	$self->{regexp} = Net::DNS::Text->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{regexp} = Net::DNS::Text->new($_) }
 	return $self->{regexp} ? $self->{regexp}->value : undef;
 }
 
 
 sub replacement {
-	my $self = shift;
-
-	$self->{replacement} = Net::DNS::DomainName2535->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{replacement} = Net::DNS::DomainName2535->new($_) }
 	return $self->{replacement} ? $self->{replacement}->name : undef;
 }
 
@@ -231,6 +223,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC2915, RFC2168, RFC3403
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC3403|https://tools.ietf.org/html/rfc3403>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/NID.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/NID.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: NID.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: NID.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -17,8 +17,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	@{$self}{qw(preference nodeid)} = unpack "\@$offset n a8", $$data;
 	return;
@@ -40,28 +39,23 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->preference(shift);
-	$self->nodeid(shift);
+	for (qw(preference nodeid)) { $self->$_( shift @argument ) }
 	return;
 }
 
 
 sub preference {
-	my $self = shift;
-
-	$self->{preference} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{preference} = 0 + $_ }
 	return $self->{preference} || 0;
 }
 
 
 sub nodeid {
-	my $self = shift;
-	my $idnt = shift;
-
+	my ( $self, $idnt ) = @_;
 	$self->{nodeid} = pack 'n4', map { hex($_) } split /:/, $idnt if defined $idnt;
-
 	return $self->{nodeid} ? sprintf( '%0.4x:%0.4x:%0.4x:%0.4x', unpack 'n4', $self->{nodeid} ) : undef;
 }
 
@@ -158,6 +152,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC6742
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC6742|https://tools.ietf.org/html/rfc6742>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/NS.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/NS.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: NS.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: NS.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -19,18 +19,18 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->{nsdname} = Net::DNS::DomainName1035->decode(@_);
+	$self->{nsdname} = Net::DNS::DomainName1035->decode(@argument);
 	return;
 }
 
 
 sub _encode_rdata {			## encode rdata as wire-format octet string
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
 	my $nsdname = $self->{nsdname};
-	return $nsdname->encode(@_);
+	return $nsdname->encode(@argument);
 }
 
 
@@ -43,17 +43,16 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->nsdname(shift);
+	$self->nsdname(@argument);
 	return;
 }
 
 
 sub nsdname {
-	my $self = shift;
-
-	$self->{nsdname} = Net::DNS::DomainName1035->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{nsdname} = Net::DNS::DomainName1035->new($_) }
 	return $self->{nsdname} ? $self->{nsdname}->name : undef;
 }
 
@@ -126,6 +125,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1035 Section 3.3.11
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC1035(3.3.11)|https://tools.ietf.org/html/rfc1035>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/NSEC.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/NSEC.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: NSEC.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: NSEC.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -20,11 +20,10 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	my $limit = $offset + $self->{rdlength};
-	( $self->{nxtdname}, $offset ) = Net::DNS::DomainName->decode(@_);
+	( $self->{nxtdname}, $offset ) = Net::DNS::DomainName->decode( $data, $offset );
 	$self->{typebm} = substr $$data, $offset, $limit - $offset;
 	return;
 }
@@ -47,10 +46,10 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->nxtdname(shift);
-	$self->typelist(@_);
+	$self->nxtdname( shift @argument );
+	$self->typelist(@argument);
 	return;
 }
 
@@ -64,18 +63,17 @@
 
 
 sub nxtdname {
-	my $self = shift;
-
-	$self->{nxtdname} = Net::DNS::DomainName->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{nxtdname} = Net::DNS::DomainName->new($_) }
 	return $self->{nxtdname} ? $self->{nxtdname}->name : undef;
 }
 
 
 sub typelist {
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	if ( scalar(@_) || !defined(wantarray) ) {
-		$self->{typebm} = &_type2bm;
+	if ( scalar(@argument) || !defined(wantarray) ) {
+		$self->{typebm} = &_type2bm(@argument);
 		return;
 	}
 
@@ -85,9 +83,9 @@
 
 
 sub typemap {
-	my $self = shift;
+	my ( $self, $type ) = @_;
 
-	my $number = typebyname(shift);
+	my $number = typebyname($type);
 	my $window = $number >> 8;
 	my $bitnum = $number & 255;
 
@@ -106,15 +104,15 @@
 
 
 sub match {
-	my $self = shift;
-	my $name = Net::DNS::DomainName->new(shift)->canonical;
+	my ( $self, $qname ) = @_;
+	my $name = Net::DNS::DomainName->new($qname)->canonical;
 	return $name eq $self->{owner}->canonical;
 }
 
 
 sub covers {
-	my $self = shift;
-	my $name = join chr(0), reverse Net::DNS::DomainName->new(shift)->_wire;
+	my ( $self, $qname ) = @_;
+	my $name = join chr(0), reverse Net::DNS::DomainName->new($qname)->_wire;
 	my $this = join chr(0), reverse $self->{owner}->_wire;
 	my $next = join chr(0), reverse $self->{nxtdname}->_wire;
 	foreach ( $name, $this, $next ) {tr /\101-\132/\141-\172/}
@@ -125,23 +123,23 @@
 
 
 sub encloser {
-	my $self  = shift;
-	my @qname = Net::DNS::Domain->new(shift)->label;
+	my ( $self, $qname ) = @_;
+	my @label = Net::DNS::Domain->new($qname)->label;
 
 	my @owner = $self->{owner}->label;
 	my $depth = scalar(@owner);
 	my $next;
-	while ( scalar(@qname) > $depth ) {
-		$next = shift @qname;
+	while ( scalar(@label) > $depth ) {
+		$next = shift @label;
 	}
 
 	return unless defined $next;
 
-	my $nextcloser = join( '.', $next, @qname );
+	my $nextcloser = join( '.', $next, @label );
 	return if lc($nextcloser) ne lc( join '.', $next, @owner );
 
 	$self->{nextcloser} = $nextcloser;
-	$self->{wildcard}   = join( '.', '*', @qname );
+	$self->{wildcard}   = join( '.', '*', @label );
 	return $self->owner;
 }
 
@@ -154,8 +152,9 @@
 ########################################
 
 sub _type2bm {
+	my @typelist = @_;
 	my @typearray;
-	foreach my $typename ( map { split() } @_ ) {
+	foreach my $typename ( map { split() } @typelist ) {
 		my $number = typebyname($typename);
 		my $window = $number >> 8;
 		my $bitnum = $number & 255;
@@ -179,11 +178,12 @@
 
 
 sub _bm2type {
-	my @typelist;
-	my $bitmap = shift || return @typelist;
+	my @empty;
+	my $bitmap = shift || return @empty;
 
 	my $index = 0;
 	my $limit = length $bitmap;
+	my @typelist;
 
 	while ( $index < $limit ) {
 		my ( $block, $size ) = unpack "\@$index C2", $bitmap;
@@ -206,15 +206,15 @@
 
 
 sub typebm {				## historical
-	my $self = shift;					# uncoverable pod
-	$self->{typebm} = shift if scalar @_;
+	my ( $self, @typebm ) = @_;				# uncoverable pod
+	for (@typebm) { $self->{typebm} = $_ }
 	$self->_deprecate('prefer $rr->typelist() or $rr->typemap()');
 	return $self->{typebm};
 }
 
 sub covered {				## historical
-	my $self = shift;					# uncoverable pod
-	return $self->covers(@_);
+	my ( $self, @argument ) = @_;				# uncoverable pod
+	return $self->covers(@argument);
 }
 
 ########################################
@@ -333,6 +333,8 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC4034, RFC9077
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC4034|https://tools.ietf.org/html/rfc4034>
+L<RFC9077|https://tools.ietf.org/html/rfc9077>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/NSEC3.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/NSEC3.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: NSEC3.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: NSEC3.pm 1910 2023-03-30 19:16:30Z willem $)2;
 
 use base qw(Net::DNS::RR::NSEC);
 
@@ -26,8 +26,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	my $limit = $offset + $self->{rdlength};
 	my $ssize = unpack "\@$offset x4 C", $$data;
@@ -67,15 +66,15 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	my $alg = $self->algorithm(shift);
-	$self->flags(shift);
-	my $iter = $self->iterations(shift);
-	my $salt = shift;
+	my $alg = $self->algorithm( shift @argument );
+	$self->flags( shift @argument );
+	my $iter = $self->iterations( shift @argument );
+	my $salt = shift @argument;
 	$self->salt($salt) unless $salt eq '-';
-	$self->hnxtname(shift);
-	$self->typelist(@_);
+	$self->hnxtname( shift @argument );
+	$self->typelist(@argument);
 	$self->{hashfn} = _hashfn( $alg, $iter, $self->{saltbin} );
 	return;
 }
@@ -104,51 +103,49 @@
 
 
 sub flags {
-	my $self = shift;
-
-	$self->{flags} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{flags} = 0 + $_ }
 	return $self->{flags} || 0;
 }
 
 
 sub optout {
-	my $self = shift;
-	if ( scalar @_ ) {
-		for ( $self->{flags} ) {
-			$_ = 0x01 | ( $_ || 0 );
-			$_ ^= 0x01 unless shift;
+	my ( $self, @value ) = @_;
+	for ( $self->{flags} |= 0 ) {
+		if ( scalar @value ) {
+			$_ |= 0x01;
+			$_ ^= 0x01 unless shift @value;
 		}
 	}
-	return 0x01 & ( $self->{flags} || 0 );
+	return $self->{flags} & 0x01;
 }
 
 
 sub iterations {
-	my $self = shift;
-
-	$self->{iterations} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{iterations} = 0 + $_ }
 	return $self->{iterations} || 0;
 }
 
 
 sub salt {
-	my $self = shift;
-	return unpack "H*", $self->saltbin() unless scalar @_;
-	return $self->saltbin( pack "H*", join "", map { /^"*(\dA-Fa-f*)"*$/ || croak("corrupt hex"); $1 } @_ );
+	my ( $self, @value ) = @_;
+	return unpack "H*", $self->saltbin() unless scalar @value;
+	my @hex = map { /^"*(\dA-Fa-f*)"*$/ || croak("corrupt hex"); $1 } @value;
+	return $self->saltbin( pack "H*", join "", @hex );
 }
 
 
 sub saltbin {
-	my $self = shift;
-
-	$self->{saltbin} = shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{saltbin} = $_ }
 	return $self->{saltbin} || "";
 }
 
 
 sub hnxtname {
-	my $self = shift;
-	$self->{hnxtname} = _decode_base32hex(shift) if scalar @_;
+	my ( $self, @name ) = @_;
+	for (@name) { $self->{hnxtname} = _decode_base32hex($_) }
 	return defined(wantarray) ? _encode_base32hex( $self->{hnxtname} ) : undef;
 }
 
@@ -498,7 +495,9 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC5155, RFC9077
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC5155|https://tools.ietf.org/html/rfc5155>
+L<RFC9077|https://tools.ietf.org/html/rfc9077>
 
 L<Hash Algorithms|http://www.iana.org/assignments/dnssec-nsec3-parameters>

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/NSEC3PARAM.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/NSEC3PARAM.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: NSEC3PARAM.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: NSEC3PARAM.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -19,8 +19,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	my $size = unpack "\@$offset x4 C", $$data;
 	@{$self}{qw(algorithm flags iterations saltbin)} = unpack "\@$offset CCnx a$size", $$data;
@@ -44,52 +43,47 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->algorithm(shift);
-	$self->flags(shift);
-	$self->iterations(shift);
-	my $salt = shift;
+	for (qw(algorithm flags iterations)) { $self->$_( shift @argument ) }
+	my $salt = shift @argument;
 	$self->salt($salt) unless $salt eq '-';
 	return;
 }
 
 
 sub algorithm {
-	my $self = shift;
-
-	$self->{algorithm} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{algorithm} = 0 + $_ }
 	return $self->{algorithm} || 0;
 }
 
 
 sub flags {
-	my $self = shift;
-
-	$self->{flags} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{flags} = 0 + $_ }
 	return $self->{flags} || 0;
 }
 
 
 sub iterations {
-	my $self = shift;
-
-	$self->{iterations} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{iterations} = 0 + $_ }
 	return $self->{iterations} || 0;
 }
 
 
 sub salt {
-	my $self = shift;
-	return unpack "H*", $self->saltbin() unless scalar @_;
-	return $self->saltbin( pack "H*", join "", map { /^"*(\dA-Fa-f*)"*$/ || croak("corrupt hex"); $1 } @_ );
+	my ( $self, @value ) = @_;
+	return unpack "H*", $self->saltbin() unless scalar @value;
+	my @hex = map { /^"*(\dA-Fa-f*)"*$/ || croak("corrupt hex"); $1 } @value;
+	return $self->saltbin( pack "H*", join "", @hex );
 }
 
 
 sub saltbin {
-	my $self = shift;
-
-	$self->{saltbin} = shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{saltbin} = $_ }
 	return $self->{saltbin} || "";
 }
 
@@ -204,6 +198,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC5155
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC5155|https://tools.ietf.org/html/rfc5155>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/NULL.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/NULL.pm Changed

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/OPENPGPKEY.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/OPENPGPKEY.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: OPENPGPKEY.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: OPENPGPKEY.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -19,8 +19,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	my $length = $self->{rdlength};
 	$self->keybin( substr $$data, $offset, $length );
@@ -44,24 +43,23 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->key(@_);
+	$self->key(@argument);
 	return;
 }
 
 
 sub key {
-	my $self = shift;
-	return MIME::Base64::encode( $self->keybin(), "" ) unless scalar @_;
-	return $self->keybin( MIME::Base64::decode( join "", @_ ) );
+	my ( $self, @value ) = @_;
+	return MIME::Base64::encode( $self->keybin(), "" ) unless scalar @value;
+	return $self->keybin( MIME::Base64::decode( join "", @value ) );
 }
 
 
 sub keybin {
-	my $self = shift;
-
-	$self->{keybin} = shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{keybin} = $_ }
 	return $self->{keybin} || "";
 }
 
@@ -135,6 +133,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC7929
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC7929|https://tools.ietf.org/html/rfc7929>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/OPT.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/OPT.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: OPT.pm 1864 2022-04-14 15:18:49Z willem $)2;
+our $VERSION = (qw$Id: OPT.pm 1921 2023-05-08 18:39:59Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -18,7 +18,7 @@
 use Carp;
 use Net::DNS::Parameters qw(:rcode :ednsoption);
 
-use constant CLASS_TTL_RDLENGTH => length pack 'n N n', (0) x 3;
+use constant UTIL => scalar eval { require Scalar::Util; Scalar::Util->can('isdual') };
 
 use constant OPT => Net::DNS::Parameters::typebyname qw(OPT);
 
@@ -29,22 +29,26 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
-	my $index = $offset - CLASS_TTL_RDLENGTH;		# OPT redefines class and TTL fields
-	@{$self}{qw(size rcode version flags)} = unpack "\@$index n C2 n", $$data;
-	@{$self}{rcode} = @{$self}{rcode} << 4;
-	delete @{$self}{qw(class ttl)};
+	my $class = delete $self->{class};			# OPT redefines CLASS and TTL fields
+	$self->udpsize($class) if defined $class;
 
-	my $limit = $offset + $self->{rdlength} - 4;
+	my $ttl = delete $self->{ttl};
+	$self->_ttl($ttl) if defined $ttl;
 
-	while ( $offset <= $limit ) {
-		my ( $code, $length ) = unpack "\@$offset nn", $$data;
-		my $value = unpack "\@$offset x4 a$length", $$data;
-		$self->{option}{$code} = $value;
-		$offset += $length + 4;
-	}
+	my $limit = $offset + $self->{rdlength} - 4;
+	my @index;
+	eval {
+		while ( $offset <= $limit ) {
+			my ( $code, $length ) = unpack "\@$offset nn", $$data;
+			my $value = unpack "\@$offset x4 a$length", $$data;
+			$self->{option}{$code} = $value;
+			push @index, $code;
+			$offset += $length + 4;
+		}
+	};
+	@{$self->{index}} = @index;
 	return;
 }
 
@@ -53,185 +57,258 @@
 	my $self = shift;
 
 	my $option = $self->{option} || {};
-	return join '', map { pack( 'nna*', $_, length $option->{$_}, $option->{$_} ) } keys %$option;
+	return join '', map { pack( 'nna*', $_, length $option->{$_}, $option->{$_} ) } $self->options;
 }
 
 
-sub encode {				## overide RR method
+sub encode {				## override RR method
 	my $self = shift;
-
 	my $data = $self->_encode_rdata;
-	my $size = $self->size;
-	my @xttl = ( $self->rcode >> 4, $self->version, $self->flags );
-	return pack 'C n n C2n n a*', 0, OPT, $size, @xttl, length($data), $data;
+	return pack 'C n n N na*', 0, OPT, $self->udpsize, $self->_ttl, length($data), $data;
 }
 
 
-sub string {				## overide RR method
-	my $self = shift;
-
-	my $edns   = $self->version;
-	my $flags  = sprintf '%04x', $self->flags;
-	my $rcode  = $self->rcode;
-	my $size   = $self->size;
-	my @option = map { join( "\n;;\t\t\t\t", $self->_format_option($_) ) } $self->options;
-	my @format = join "\n;;\t\t", @option;
-
-	$rcode = 0 if $rcode < 16;				# weird: 1 .. 15 not EDNS codes!!
+sub string {				## override RR method
+	my @line = split /\r\n+/, shift->json;
+	return join '', map {";;$_\n"} @line;
+}
 
-	my $rc = exists( $self->{rdlength} ) && $rcode ? "$rcode + 4-bits" : rcodebyval($rcode);
+sub class {				## override RR method
+	my ( $self, @value ) = @_;
+	$self->_deprecate(qqplease use "UDPsize()");
+	return $self->udpsize(@value);
+}
 
-	$rc = 'BADVERS' if $rcode == 16;			# code 16 unambiguous here
+sub size {
+	my ( $self, @value ) = @_;				# uncoverable pod
+	$self->_deprecate(qqsize() is an alias of "UDPsize()");
+	return $self->udpsize(@value);
+}
 
-	return <<"QQ";
-;; EDNS version $edns
-;;	flags:	$flags
-;;	rcode:	$rc
-;;	size:	$size
-;;	option: @format
-QQ
+sub ttl {				## override RR method
+	my ( $self, @value ) = @_;
+	$self->_deprecate(qqplease use "flags()", "rcode()" or "version()");
+	return $self->_ttl(@value);
 }
 
+sub _ttl {
+	my ( $self, @value ) = @_;
+	for (@value) {
+		@{$self}{qw(rcode version flags)} = unpack 'C2n', pack( 'N', $_ );
+		$self->{rcode} = $self->{rcode} << 4;
+		return;
+	}
+	return unpack 'N', pack( 'C2n', $self->rcode >> 4, $self->version, $self->flags );
+}
 
-sub class {				## overide RR method
+sub generic {				## override RR method
 	my $self = shift;
-	$self->_deprecate(qqplease use "size()");
-	return $self->size(@_);
+	local $self->{class} = $self->udpsize;
+	my @xttl = ( $self->rcode >> 4, $self->version, $self->flags );
+	local $self->{ttl} = unpack 'N', pack( 'C2n', @xttl );
+	return $self->SUPER::generic;
 }
 
-sub ttl {				## overide RR method
-	my $self = shift;
-	$self->_deprecate(qqplease use "flags()" or "rcode()");
-	my @rcode = map { unpack( 'C',	 pack 'N', $_ ) } @_;
-	my @flags = map { unpack( 'x2n', pack 'N', $_ ) } @_;
-	return pack 'C2n', $self->rcode(@rcode), $self->version, $self->flags(@flags);
+sub token {				## override RR method
+	return grep { !m/^()$/ } split /\s+/, &generic;
 }
 
+sub json {
+	my $self = shift;					# uncoverable pod
 
-sub version {
-	my $self = shift;
+	my $version = $self->version;
+	unless ( $version == 0 ) {
+		my $content = unpack 'H*', $self->encode;
+		return <<"QQ";
+ {	"EDNS-VERSION":	$version,
+	"BASE16":	"$content"
+	}
+QQ
+	}
+
+	my $flags  = sprintf '%04x', $self->flags;
+	my $rcode  = $self->rcode;
+	my $size   = $self->udpsize;
+	my @format = map { join( "\n\t\t\t", $self->_format_option($_) ) } $self->options;
+	my @indent = scalar(@format) ? "\n\t\t" : ();
+	my @option = join ",\n\t\t", @format;
 
-	$self->{version} = 0 + shift if scalar @_;
+	return <<"QQ";
+ {	"EDNS-VERSION":	$version,
+	"FLAGS":	"$flags",
+	"RCODE":	$rcode,
+	"UDPSIZE":	$size,
+	"OPTIONS":	@indent@option 
+	}
+QQ
+}
+
+
+sub version {
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{version} = 0 + $_ }
 	return $self->{version} || 0;
 }
 
 
-sub size {
-	my $self = shift;
-	$self->{size} = shift if scalar @_;
-	return ( $self->{size} || 0 ) > 512 ? $self->{size} : 512;
+sub udpsize {
+	my ( $self, @value ) = @_;				# uncoverable pod
+	for (@value) { $self->{udpsize} = ( $_ > 512 ) ? $_ : 0 }
+	return $self->{udpsize} || 0;
 }
 
 
 sub rcode {
-	my $self = shift;
-	return $self->{rcode} || 0 unless scalar @_;
-	delete $self->{rdlength};				# (ab)used to signal incomplete value
-	my $val = shift || 0;
-	return $self->{rcode} = $val < 16 ? 0 : $val;		# discard non-EDNS rcodes 1 .. 15
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{rcode} = ( $_ < 16 ) ? 0 : $_ }	# discard non-EDNS rcodes 1 .. 15
+	return $self->{rcode} || 0;
 }
 
 
 sub flags {
-	my $self = shift;
-	$self->{flags} = shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{flags} = 0 + $_ }
 	return $self->{flags} || 0;
 }
 
 
 sub options {
-	my ($self) = @_;
+	my $self   = shift;
 	my $option = $self->{option} || {};
-	my @option = sort { $a <=> $b } keys %$option;
+	my @option = defined( $self->{index} ) ? @{$self->{index}} : sort { $a <=> $b } keys %$option;
 	return @option;
 }
 
 sub option {
-	my $self   = shift;
-	my $number = ednsoptionbyname(shift);
-	return $self->_get_option($number) unless scalar @_;
-	return $self->_set_option( $number, @_ );
+	my ( $self, $name, @value ) = @_;
+	my $number = ednsoptionbyname($name);
+	return $self->_get_option($number) unless scalar @value;
+	my $value = $self->_set_option( $number, @value );
+	return $@ ? croak( ( split /\sat/i, $@ )0 ) : $value;
 }
 
 
 ########################################
 
-sub _format_option {
-	my ( $self, $number ) = @_;
-	my $option  = ednsoptionbyval($number);
-	my $options = $self->{option} || {};
-	my $payload = $options->{$number};
-	return () unless defined $payload;
-	my $package = join '::', __PACKAGE__, $option;
-	$package =~ s/-/_/g;
-	my $defined = length($payload) && $package->can('_image');
-	my @element = $defined ? eval { $package->_image($payload) } : unpack 'H*', $payload;
-	my $protect = pop(@element);
-	return Net::DNS::RR::_wrap( "$option\t=> (", map( {"$_,"} @element ), "$protect )" );
-}
-
-
 sub _get_option {
 	my ( $self, $number ) = @_;
 
 	my $options = $self->{option} || {};
 	my $payload = $options->{$number};
 	return $payload unless wantarray;
-	return ()	unless $payload;
 	my $package = join '::', __PACKAGE__, ednsoptionbyval($number);
 	$package =~ s/-/_/g;
-	return ( 'OPTION-DATA' => $payload ) unless $package->can('_decompose');
-	return eval { $package->_decompose($payload) };
+	if ( $package->can('_decompose') ) {
+		return {'OPTION-LENGTH' => 0} unless length $payload;
+		my @structure = eval { $package->_decompose($payload) };
+		return @structure if scalar @structure;
+	}
+	warn $@ if $@;
+	return length($payload) ? {BASE16 => unpack 'H*', $payload} : '';
 }
 
 
 sub _set_option {
-	my ( $self, $number, $value, @etc ) = @_;
+	my ( $self, $number, @value ) = @_;
+	my ($arg) = @value;
 
-	my $options = $self->{option} ||= {};
+	my $options = $self->{option} || {};
 	delete $options->{$number};
-	return unless defined $value;
-	if ( ref($value) || scalar(@etc) || $value !~ /\D/ ) {
-		my @arg = ( $value, @etc );
-		@arg = @$value if ref($value) eq 'ARRAY';
-		@arg = %$value if ref($value) eq 'HASH';
-		if ( $arg0 eq 'OPTION-DATA' ) {
-			$value = $arg1;
-		} else {
-			my $option  = ednsoptionbyval($number);
-			my $package = join '::', __PACKAGE__, $option;
-			$package =~ s/-/_/g;
-			if ( $package->can('_compose') ) {
-				$value = $package->_compose(@arg);
-			} elsif ( scalar(@etc) ) {
-				croak "unable to compose option $option";
-			}
-		}
+	delete $self->{option} unless scalar( keys %$options );
+
+	return unless defined $arg;
+	$self->{option} = $options;
+
+	if ( ref($arg) eq 'HASH' ) {
+		for ( keys %$arg ) { $$arg{uc $_} = $$arg{$_} } # tolerate mixed case
+		my $length = $$arg{'OPTION-LENGTH'};
+		my $octets = $$arg{'OPTION-DATA'};
+		$octets = pack 'H*', $$arg{'BASE16'} if defined $$arg{'BASE16'};
+		$octets = '' if defined($length) && $length == 0;
+		return $options->{$number} = $octets if defined $octets;
 	}
-	return $options->{$number} = $value;
+
+	my $option  = ednsoptionbyval($number);
+	my $package = join '::', __PACKAGE__, $option;
+	$package =~ s/-/_/g;
+	return eval { $options->{$number} = $package->_compose(@value) } if length($arg) && $package->can('_compose');
+
+	croak "unable to compose option $number" if ref($arg);
+	return $options->{$number} = $arg;
 }
 
 
 sub _specified {
 	my $self = shift;
-	return scalar grep { $self->{$_} } qw(size flags rcode option);
+	return scalar grep { $self->{$_} } qw(udpsize flags rcode option);
+}
+
+
+sub _format_option {
+	my ( $self, $number ) = @_;
+	my $option = ednsoptionbyval($number);
+	my ($content) = $self->_get_option($number);
+	return Net::DNS::RR::_wrap( _JSONify( {$option => $content} ) );
+}
+
+
+sub _JSONify {
+	my $value = shift;
+	return 'null' unless defined $value;
+
+	if ( ref($value) eq 'HASH' ) {
+		my @tags = sort keys %$value;
+		my $tail = pop @tags;
+		for ( $$value{BASE16} ) { $_ = pack( 'U0a*', $_ ) if defined }	  # mark as UTF-8
+		my @body = map { my @x = ( qq("$_":), _JSONify( $$value{$_} ) ); $x-1 .= ','; @x } @tags;
+		push @body, ( qq("$tail":), _JSONify( $$value{$tail} ) );
+		$body0 = '{' . $body0;
+		$body-1 .= '}';
+		return @body;
+	}
+
+	if ( ref($value) eq 'ARRAY' ) {
+		my @array = @$value;
+		my @tail  = map { _JSONify($_) } grep {defined} pop @array;
+		my @body  = map { my @x = _JSONify($_); $x-1 .= ','; @x } @array;
+		return ( '', @body, @tail, '' );
+	}
+
+	my $string = "$value";		## stringify, then use isdual() as discriminant
+	return $string if UTIL && Scalar::Util::isdual($value); # native numeric representation
+	for ($string) {
+		unless ( utf8::is_utf8($value) ) {
+			return $_ if /^-?\d+$/;			# integer (string representation)
+			return $_ if /^-?\d+\.\d+$/;		# non-integer
+			return $_ if /^-?\d+(\.\d+)?e+-\d\d?$/i;
+		}
+		s/\\/\\\\/g;					# escaped escape
+		s/^"(.*)"$/$1/;					# strip enclosing quotes
+		s/"/\\"/g;					# escape interior quotes
+	}
+	return qq("$string");
 }
 
 
 ## no critic ProhibitMultiplePackages
-package Net::DNS::RR::OPT::DAU;					# RFC6975
+package Net::DNS::RR::OPT::NSID;				# RFC5001
 
 sub _compose {
-	shift;
-	return pack 'C*', @_;
+	my ( undef, @argument ) = map { ref($_) ? %$_ : $_ } @_;
+	return pack 'H*', pop @argument;
 }
 
-sub _decompose {
-	my @payload = unpack 'C*', $_1;
-	return @payload;
+sub _decompose { return pack 'U0a*', unpack 'H*', pop @_ }	# mark as UTF-8
+
+
+package Net::DNS::RR::OPT::DAU;					# RFC6975
+
+sub _compose {
+	my ( undef, @argument ) = map { ref($_) ? @$_ : $_ } @_;
+	return pack 'C*', @argument;
 }
 
-sub _image { return &_decompose; }
+sub _decompose { return unpack 'C*', pop @_ }
 
 
 package Net::DNS::RR::OPT::DHU;					# RFC6975
@@ -243,157 +320,150 @@
 
 package Net::DNS::RR::OPT::CLIENT_SUBNET;			# RFC7871
 
-my %family = qw(0 Net::DNS::RR::AAAA	1 Net::DNS::RR::A	2 Net::DNS::RR::AAAA);
-my @field8 = qw(FAMILY SOURCE-PREFIX-LENGTH SCOPE-PREFIX-LENGTH ADDRESS);
+my %family = qw(1 Net::DNS::RR::A	2 Net::DNS::RR::AAAA);
+my @field8 = qw(FAMILY SOURCE-PREFIX SCOPE-PREFIX ADDRESS);
 
 sub _compose {
-	my ( $class, %argument ) = ( map( ( $_ => 0 ), @field8 ), @_ );
-	my $address = bless( {}, $family{$argument{FAMILY}} )->address( $argument{ADDRESS} );
-	my $bitmask = $argument{'SOURCE-PREFIX-LENGTH'};
-	return pack "a* B$bitmask", pack( 'nC2', @argument{@field8} ), unpack 'B*', $address;
+	shift @_;
+	my %argument = ( map( ( $_ => 0 ), @field8 ), map { ref($_) ? %$_ : $_ } @_ );
+	my $family   = $family{$argument{FAMILY}} || die 'unrecognised address family';
+	my $bitmask  = $argument{'SOURCE-PREFIX'};
+	my $address  = bless( {}, $family )->address( $argument{ADDRESS} );
+	return pack 'a* B*', pack( 'nC2', @argument{@field8} ), unpack "B$bitmask", $address;
 }
 
 sub _decompose {
-	my %hash;
-	@hash{@field8} = unpack 'nC2a*', $_1;
-	$hash{ADDRESS} = bless( {address => $hash{ADDRESS}}, $family{$hash{FAMILY}} )->address;
-	my @payload = map( ( $_ => $hash{$_} ), @field8 );
-	return @payload;
-}
-
-sub _image {
-	my %hash  = &_decompose;
-	my @image = map "$_ => $hash{$_}", @field8;
-	return @image;
+	my %object;
+	@object{@field8} = unpack 'nC2a*', pop @_;
+	my $family = $family{$object{FAMILY}} || die 'unrecognised address family';
+	for ( $object{ADDRESS} ) {
+		$_ = bless( {address => $_}, $family )->address;
+		s/::0+$/::/;
+	}
+	return \%object;
 }
 
 
 package Net::DNS::RR::OPT::EXPIRE;				# RFC7314
 
 sub _compose {
-	return pack 'N', pop @_;
+	my ( undef, @argument ) = map { ref($_) ? %$_ : $_ } @_;
+	return pack 'N', pop @argument;
 }
 
 sub _decompose {
-	my @payload = ( 'EXPIRE-TIMER' => unpack 'N', $_1 );
-	return @payload;
+	my $argument = pop @_;
+	return {'EXPIRE-TIMER' => unpack 'N', $argument};
 }
 
-sub _image { return join ' => ', &_decompose; }
-
 
 package Net::DNS::RR::OPT::COOKIE;				# RFC7873
 
-my @field10 = qw(VERSION RESERVED TIMESTAMP HASH);
+my @field10 = qw(CLIENT SERVER);
 
 sub _compose {
-	my ( $class, %argument ) = ( VERSION => 1, RESERVED => '', @_ );
-	return pack 'a8', $argument{'CLIENT-COOKIE'} if $argument{'CLIENT-COOKIE'};
-	return pack 'Ca3Na*', map $_, @argument{@field10};
+	my ( undef, @argument ) = @_;
+	for ( ref( $argument0 ) ) {
+		/HASH/	&& ( @argument = @{$argument0}{@field10} );
+		/ARRAY/ && ( @argument = @{$argument0} );
+	}
+	return pack 'a8a*', map { pack 'H*', $_ || '' } @argument;
 }
 
 sub _decompose {
-	my ( $class, $argument ) = @_;
-	return ( 'CLIENT-COOKIE', $argument ) unless length($argument) > 8;
-	my %hash;
-	@hash{@field10} = unpack 'Ca3Na*', $argument;
-	my @payload = map( ( $_ => $hash{$_} ), @field10 );
-	return @payload;
-}
-
-sub _image {
-	my %hash = &_decompose;
-	return unpack 'H*', $hash{'CLIENT-COOKIE'} if $hash{'CLIENT-COOKIE'};
-	for (qw(RESERVED HASH)) { $hash{$_} = unpack 'H*', $hash{$_} }
-	my @image = map "$_ => $hash{$_}", @field10;
-	return @image;
+	my %object;
+	@object{@field10} = map { pack 'U0a*', $_ } unpack 'H16H*', pop @_;    # mark as UTF-8
+	return \%object;
 }
 
 
 package Net::DNS::RR::OPT::TCP_KEEPALIVE;			# RFC7828
 
 sub _compose {
-	return pack 'n', pop @_;
+	my ( undef, @argument ) = map { ref($_) ? %$_ : $_ } @_;
+	return pack 'n', pop @argument;
 }
 
 sub _decompose {
-	my @payload = ( 'TIMEOUT' => unpack 'n', $_1 );
-	return @payload;
+	my $argument = pop @_;
+	return {'TIMEOUT' => unpack 'n', $argument};
 }
 
-sub _image { return join ' => ', &_decompose; }
-
 
 package Net::DNS::RR::OPT::PADDING;				# RFC7830
 
 sub _compose {
-	my $size = pop @_;
-	return pack "x$size";
+	my ( undef, @argument ) = map { ref($_) ? %$_ : $_ } @_;
+	my $length = pop(@argument) || 0;
+	return pack "x$length";
 }
 
 sub _decompose {
-	my @payload = ( 'OPTION-LENGTH' => length( $_1 ) );
-	return @payload;
+	my $argument = pop @_;
+	return {'OPTION-LENGTH' => length $argument} if $argument =~ /^\000*$/;
+	return {'BASE16'	=> unpack 'H*', $argument};
 }
 
-sub _image { return join ' => ', &_decompose; }
-
 
 package Net::DNS::RR::OPT::CHAIN;				# RFC7901
 
 sub _compose {
-	my ( $class, %argument ) = @_;
-	my ($trust_point) = values %argument;
-	return Net::DNS::DomainName->new($trust_point)->encode;
+	my ( undef, @argument ) = map { ref($_) ? %$_ : $_ } @_;
+	return Net::DNS::DomainName->new( pop @argument )->encode;
 }
 
 sub _decompose {
-	my ( $class, $payload ) = @_;
-	my $fqdn    = Net::DNS::DomainName->decode( \$payload )->string;
-	my @payload = ( 'CLOSEST-TRUST-POINT' => $fqdn );
-	return @payload;
+	my $argument = pop @_;
+	return {'CLOSEST-TRUST-POINT' => Net::DNS::DomainName->decode( \$argument )->string};
 }
 
-sub _image { return join ' => ', &_decompose; }
-
 
 package Net::DNS::RR::OPT::KEY_TAG;				# RFC8145
 
 sub _compose {
-	shift;
-	return pack 'n*', @_;
-}
-
-sub _decompose {
-	my @payload = unpack 'n*', $_1;
-	return @payload;
+	my ( undef, @argument ) = map { ref($_) ? @$_ : $_ } @_;
+	return pack 'n*', @argument;
 }
 
-sub _image { return &_decompose; }
+sub _decompose { return unpack 'n*', pop @_ }
 
 
 package Net::DNS::RR::OPT::EXTENDED_ERROR;			# RFC8914
 
-my @field15 = qw(INFO-CODE EXTRA-TEXT);
-
 sub _compose {
-	my ( $class, %argument ) = ( 'INFO-CODE' => 0, 'EXTRA-TEXT' => '', @_ );
-	my ( $code,  $text )	 = @argument{@field15};
-	return pack 'na*', $code, Net::DNS::Text->new($text)->raw;
+	my ( undef, @arg ) = @_;
+	my %arg	 = ref( $arg0 ) ? %{$arg0} : @arg;
+	my $text = join '', Net::DNS::RR::OPT::_JSONify( $arg{'EXTRA-TEXT'} || '' );
+	return pack 'na*', $arg{'INFO-CODE'}, Net::DNS::Text->new($text)->raw;
 }
 
 sub _decompose {
-	my ( $code, $text ) = unpack 'na*', $_1;
-	my @payload = (
-		'INFO-CODE'  => $code,
-		'EXTRA-TEXT' => Net::DNS::Text->decode( \$text, 0, length $text )->string
-		);
-	return @payload;
+	my ( $code, $text ) = unpack 'na*', pop @_;
+	my $error = $Net::DNS::Parameters::dnserrorbyval{$code};
+	my @error = defined($error) ? ( 'ERROR' => $error ) : ();
+	my $extra = Net::DNS::Text->decode( \$text, 0, length $text );
+	my $REGEX = q/("^"*")|(\\{}:,)|\s+/;
+	for ( $extra->value ) {
+		last unless /^\\{/;
+		s/(\@\$)/\\$1/g;
+		my $info = eval join( ' ', map { s/^:$/=>/; $_ } grep {defined} split /$REGEX/o );
+		return {'INFO-CODE' => $code, @error, 'EXTRA-TEXT' => $info || last};
+	}
+	return {'INFO-CODE' => $code, @error, 'EXTRA-TEXT' => $extra->string};
 }
 
-sub _image {
-	my %hash  = &_decompose;
-	my @image = map "$_ => $hash{$_}", @field15;
+
+package Net::DNS::RR::OPT::REPORT_CHANNEL;			# draft-ietf-dnsop-dns-error-reporting
+$Net::DNS::Parameters::ednsoptionbyval{65023} = 'REPORT-CHANNEL';	## experimental/private use
+
+sub _compose {
+	my ( undef, @argument ) = map { ref($_) ? %$_ : $_ } @_;
+	return Net::DNS::DomainName->new( pop @argument )->encode;
+}
+
+sub _decompose {
+	my $argument = pop @_;
+	return {'AGENT-DOMAIN' => Net::DNS::DomainName->decode( \$argument )->string};
 }
 
 ########################################
@@ -406,25 +476,31 @@
 =head1 SYNOPSIS
 
     use Net::DNS;
-    $packet = Net::DNS::Packet->new( ... );
+    my $packet = Net::DNS::Packet->new( ... );
 
-    $packet->header->do(1);			# extended flag
+    $packet->header->do(1);		# extended header flag 
 
-    $packet->edns->size(1280);			# UDP payload size
+    $packet->edns->UDPsize(1232);	# UDP payload size
 
-    $packet->edns->option( COOKIE => 'rawbytes' );
+    $packet->edns->option( 'NSID'	    => {'OPTION-DATA' => 'rawbytes'} );
+    $packet->edns->option( 'DAU'	    => 8, 10, 13, 14, 15, 16 );
+    $packet->edns->option( 'TCP-KEEPALIVE'  => 200 );
+    $packet->edns->option( 'EXTENDED-ERROR' => {'INFO-CODE' => 123} );
+    $packet->edns->option( '65023'	    => {'BASE16' => '076578616d706c6500'} );
 
     $packet->edns->print;
 
-    ;; EDNS version 0
-    ;;	    flags:  8000
-    ;;	    rcode:  NOERROR
-    ;;	    size:   1280
-    ;;	    option: COOKIE => ( 7261776279746573 )
-    ;;		    DAU	   => ( 8, 10, 13, 14, 15, 16 )
-    ;;		    DHU	   => ( 1, 2, 4 )
-    ;;		    EXTENDED-ERROR => ( INFO-CODE => 123, EXTRA-TEXT =>	 )
-
+	;; {	"EDNS-VERSION":	0,
+	;;	"FLAGS":	"8000",
+	;;	"RCODE":	0,
+	;;	"UDPSIZE":	1232,
+	;;	"OPTIONS":	
+	;;		{"NSID": "7261776279746573"},
+	;;		{"DAU":  8, 10, 13, 14, 15, 16 },
+	;;		{"TCP-KEEPALIVE": {"TIMEOUT": 200}},
+	;;		{"EXTENDED-ERROR": {"INFO-CODE": 123, "EXTRA-TEXT": ""}},
+	;;		{"65023": {"BASE16": "076578616d706c6500"}} 
+	;;	}
 
 =head1 DESCRIPTION
 
@@ -435,7 +511,7 @@
 
 All EDNS features are performed indirectly by operations on the objects
 returned by the $packet->header and $packet->edns creator methods.
-The underlying mechanisms are entirely hidden from the user.
+The underlying mechanisms are, or should be, entirely hidden from the user.
 
 =head1 METHODS
 
@@ -449,87 +525,82 @@
 
 =head2 version
 
-    $version = $rr->version;
-    $rr->version( $version );
+	$version = $packet->edns->version;
 
 The version of EDNS supported by this OPT record.
 
-=head2 size
+=head2 UDPsize
 
-	$size = $packet->edns->size;
-	$more = $packet->edns->size(1280);
+	$size = $packet->edns->UDPsize;
+	$packet->edns->UDPsize($size);
 
-size() advertises the maximum size (octets) of UDP packet that can be
+UDPsize() advertises the maximum size (octets) of UDP packet that can be
 reassembled in the network stack of the originating host.
 
 =head2 rcode
 
 	$extended_rcode	  = $packet->header->rcode;
-	$incomplete_rcode = $packet->edns->rcode;
 
-The 12 bit extended RCODE. The most significant 8 bits reside in the OPT
-record. The least significant 4 bits can only be obtained from the packet
+The 12 bit extended RCODE. The most significant 8 bits are obtained from
+the OPT record. The least significant 4 bits reside in the packet
 header.
 
 =head2 flags
 
-	$edns_flags = $packet->edns->flags;
-
 	$do = $packet->header->do;
 	$packet->header->do(1);
 
+	$edns_flags = $packet->edns->flags;
+
 16 bit field containing EDNS extended header flags.
 
 =head2 options, option
 
-	@option = $packet->edns->options;
-
-	$octets = $packet->edns->option($option_code);
-
-	$packet->edns->option( COOKIE => $octets );
-	$packet->edns->option( 10     => $octets );
+	my @option = $packet->edns->options;
 
 When called in a list context, options() returns a list of option codes
 found in the OPT record.
 
+	my $octets = $packet->edns->option('COOKIE');
+	my $base16 = unpack 'H*', $octets;
+
+	$packet->edns->option( 'COOKIE' => {'OPTION-DATA' => $octets} );
+	$packet->edns->option( '10'	=> {'BASE16'	  => $base16} );
+
 When called in a scalar context with a single argument,
 option() returns the uninterpreted octet string
 corresponding to the specified option.
-The method returns undef if the specified option is absent.
+The method returns undef if the option is absent.
 
 Options can be added or replaced by providing the (name => value) pair.
 The option is deleted if the value is undefined.
 
-
-When option() is called in a list context with a single argument,
-the returned values provide a structured interpretation
-appropriate to the specified option.
+When called in a list context with a single argument,
+option() returns a structured representation of the option value.
 
 For example:
 
-	@algorithms = $packet->edns->option('DAU');
-
-
-For some options, a hash table is more convenient:
-
-	%hash_table = $packet->edns->option(15);
-	$info_code  = $hash_table{'INFO-CODE'};
-	$extra_text = $hash_table{'EXTRA-TEXT'};
+	my ($structure) = $packet->edns->option('DAU');
+	my @algorithms	= @$structure;
 
+	my ($structure) = $packet->edns->option(15);
+	my $info_code	= $$structure{'INFO-CODE'};
+	my $extra_text	= $$structure{'EXTRA-TEXT'};
 
 Similar forms of array or hash syntax may be used to construct the
 option value:
 
-	$packet->edns->option( DHU => 1, 2, 4 );
+	$packet->edns->option( 'DAU' => 8, 10, 13, 14, 15, 16 );
 
-	$packet->edns->option( EXPIRE => {'EXPIRE-TIMER' => 604800} );
+	$packet->edns->option( 'EXTENDED-ERROR' => {'INFO-CODE'	 => 123,
+						    'EXTRA-TEXT' => ""} );
 
 
 =head1 COPYRIGHT
 
 Copyright (c)2001,2002 RIPE NCC.  Author Olaf M. Kolkman.
 
-Portions Copyright (c)2012,2017-2022 Dick Franks.
+Portions Copyright (c)2012,2017-2023 Dick Franks.
 
 All rights reserved.
 
@@ -557,6 +628,8 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC6891, RFC3225
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC6891|https://tools.ietf.org/html/rfc6891>
+L<RFC3225|https://tools.ietf.org/html/rfc3225>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/PTR.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/PTR.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: PTR.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: PTR.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -19,18 +19,18 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->{ptrdname} = Net::DNS::DomainName1035->decode(@_);
+	$self->{ptrdname} = Net::DNS::DomainName1035->decode(@argument);
 	return;
 }
 
 
 sub _encode_rdata {			## encode rdata as wire-format octet string
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
 	my $ptrdname = $self->{ptrdname};
-	return $ptrdname->encode(@_);
+	return $ptrdname->encode(@argument);
 }
 
 
@@ -43,17 +43,16 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->ptrdname(shift);
+	$self->ptrdname(@argument);
 	return;
 }
 
 
 sub ptrdname {
-	my $self = shift;
-
-	$self->{ptrdname} = Net::DNS::DomainName1035->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{ptrdname} = Net::DNS::DomainName1035->new($_) }
 	return $self->{ptrdname} ? $self->{ptrdname}->name : undef;
 }
 
@@ -120,6 +119,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1035 Section 3.3.12
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC1035(3.3.12)|https://tools.ietf.org/html/rfc1035>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/PX.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/PX.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: PX.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: PX.pm 1898 2023-02-15 14:27:22Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -19,19 +19,17 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset, @opaque ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	$self->{preference} = unpack( "\@$offset n", $$data );
-	( $self->{map822},  $offset ) = Net::DNS::DomainName2535->decode( $data, $offset + 2, @opaque );
-	( $self->{mapx400}, $offset ) = Net::DNS::DomainName2535->decode( $data, $offset + 0, @opaque );
+	( $self->{map822},  $offset ) = Net::DNS::DomainName2535->decode( $data, $offset + 2 );
+	( $self->{mapx400}, $offset ) = Net::DNS::DomainName2535->decode( $data, $offset );
 	return;
 }
 
 
 sub _encode_rdata {			## encode rdata as wire-format octet string
-	my $self = shift;
-	my ( $offset, @opaque ) = @_;
+	my ( $self, $offset, @opaque ) = @_;
 
 	my $mapx400 = $self->{mapx400};
 	my $rdata   = pack( 'n', $self->{preference} );
@@ -50,35 +48,30 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->preference(shift);
-	$self->map822(shift);
-	$self->mapx400(shift);
+	for (qw(preference map822 mapx400)) { $self->$_( shift @argument ) }
 	return;
 }
 
 
 sub preference {
-	my $self = shift;
-
-	$self->{preference} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{preference} = 0 + $_ }
 	return $self->{preference} || 0;
 }
 
 
 sub map822 {
-	my $self = shift;
-
-	$self->{map822} = Net::DNS::DomainName2535->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{map822} = Net::DNS::DomainName2535->new($_) }
 	return $self->{map822} ? $self->{map822}->name : undef;
 }
 
 
 sub mapx400 {
-	my $self = shift;
-
-	$self->{mapx400} = Net::DNS::DomainName2535->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{mapx400} = Net::DNS::DomainName2535->new($_) }
 	return $self->{mapx400} ? $self->{mapx400}->name : undef;
 }
 
@@ -172,6 +165,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC2163
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC2163|https://tools.ietf.org/html/rfc2163>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/RP.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/RP.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: RP.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: RP.pm 1898 2023-02-15 14:27:22Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -20,18 +20,16 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset, @opaque ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
-	( $self->{mbox}, $offset ) = Net::DNS::Mailbox2535->decode( $data, $offset, @opaque );
-	$self->{txtdname} = Net::DNS::DomainName2535->decode( $data, $offset, @opaque );
+	( $self->{mbox}, $offset ) = Net::DNS::Mailbox2535->decode( $data, $offset );
+	$self->{txtdname} = Net::DNS::DomainName2535->decode( $data, $offset );
 	return;
 }
 
 
 sub _encode_rdata {			## encode rdata as wire-format octet string
-	my $self = shift;
-	my ( $offset, @opaque ) = @_;
+	my ( $self, $offset, @opaque ) = @_;
 
 	my $txtdname = $self->{txtdname};
 	my $rdata    = $self->{mbox}->encode( $offset, @opaque );
@@ -49,26 +47,23 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->mbox(shift);
-	$self->txtdname(shift);
+	for (qw(mbox txtdname)) { $self->$_( shift @argument ) }
 	return;
 }
 
 
 sub mbox {
-	my $self = shift;
-
-	$self->{mbox} = Net::DNS::Mailbox2535->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{mbox} = Net::DNS::Mailbox2535->new($_) }
 	return $self->{mbox} ? $self->{mbox}->address : undef;
 }
 
 
 sub txtdname {
-	my $self = shift;
-
-	$self->{txtdname} = Net::DNS::DomainName2535->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{txtdname} = Net::DNS::DomainName2535->new($_) }
 	return $self->{txtdname} ? $self->{txtdname}->name : undef;
 }
 
@@ -149,6 +144,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1183 Section 2.2
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC1183(2.2)|https://tools.ietf.org/html/rfc1183>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/RRSIG.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/RRSIG.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: RRSIG.pm 1856 2021-12-02 14:36:25Z willem $)2;
+our $VERSION = (qw$Id: RRSIG.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -28,9 +28,7 @@
 
 # IMPORTANT: Downstream distros MUST NOT create dependencies on Net::DNS::SEC	(strong crypto prohibited in many territories)
 use constant USESEC => defined $INC{'Net/DNS/SEC.pm'};		# Discover how we got here, without exposing any crypto
-use constant							# Discourage static code analysers and casual greppers
-		DNSSEC => USESEC && defined eval join '',
-		qw(r e q u i r e), ' Net::DNS', qw(:: SEC :: Private);	  ## no critic
+use constant DNSSEC => USESEC && defined eval join '', qw(r e q u i r e), ' Net::DNS::SEC::Private';	## no critic
 
 my @index;
 if (DNSSEC) {
@@ -51,8 +49,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	my $limit = $offset + $self->{rdlength};
 	@{$self}{@field} = unpack "\@$offset n C2 N3 n", $$data;
@@ -81,10 +78,10 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	foreach ( @field, qw(signame) ) { $self->$_(shift) }
-	$self->signature(@_);
+	foreach ( @field, qw(signame) ) { $self->$_( shift @argument ) }
+	$self->signature(@argument);
 	return;
 }
 
@@ -98,8 +95,8 @@
 
 
 sub typecovered {
-	my $self = shift;
-	$self->{typecovered} = typebyname(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{typecovered} = typebyname($_) }
 	my $typecode = $self->{typecovered};
 	return defined $typecode ? typebyval($typecode) : undef;
 }
@@ -120,32 +117,30 @@
 
 
 sub labels {
-	my $self = shift;
-
-	$self->{labels} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{labels} = 0 + $_ }
 	return $self->{labels} || 0;
 }
 
 
 sub orgttl {
-	my $self = shift;
-
-	$self->{orgttl} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{orgttl} = 0 + $_ }
 	return $self->{orgttl} || 0;
 }
 
 
 sub sigexpiration {
-	my $self = shift;
-	$self->{sigexpiration} = _string2time(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{sigexpiration} = _string2time($_) }
 	my $time = $self->{sigexpiration};
 	return unless defined wantarray && defined $time;
 	return UTIL ? Scalar::Util::dualvar( $time, _time2string($time) ) : _time2string($time);
 }
 
 sub siginception {
-	my $self = shift;
-	$self->{siginception} = _string2time(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{siginception} = _string2time($_) }
 	my $time = $self->{siginception};
 	return unless defined wantarray && defined $time;
 	return UTIL ? Scalar::Util::dualvar( $time, _time2string($time) ) : _time2string($time);
@@ -156,39 +151,36 @@
 sub sigin { return &siginception; }	## historical
 
 sub sigval {
-	my $self = shift;
+	my ( $self, @value ) = @_;
 	no integer;
-	return ( $self->{sigval} ) = map { int( 86400 * $_ ) } @_;
+	return ( $self->{sigval} ) = map { int( 86400 * $_ ) } @value;
 }
 
 
 sub keytag {
-	my $self = shift;
-
-	$self->{keytag} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{keytag} = 0 + $_ }
 	return $self->{keytag} || 0;
 }
 
 
 sub signame {
-	my $self = shift;
-
-	$self->{signame} = Net::DNS::DomainName->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{signame} = Net::DNS::DomainName->new($_) }
 	return $self->{signame} ? $self->{signame}->name : undef;
 }
 
 
 sub sig {
-	my $self = shift;
-	return MIME::Base64::encode( $self->sigbin(), "" ) unless scalar @_;
-	return $self->sigbin( MIME::Base64::decode( join "", @_ ) );
+	my ( $self, @value ) = @_;
+	return MIME::Base64::encode( $self->sigbin(), "" ) unless scalar @value;
+	return $self->sigbin( MIME::Base64::decode( join "", @value ) );
 }
 
 
 sub sigbin {
-	my $self = shift;
-
-	$self->{sigbin} = shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{sigbin} = $_ }
 	return $self->{sigbin} || "";
 }
 
@@ -459,14 +451,14 @@
 
 sub _CreateSig {
 	if (DNSSEC) {
-		my $self = shift;
+		my ( $self, @argument ) = @_;
 
 		my $algorithm = $self->algorithm;
 		my $class     = $DNSSEC_siggen{$algorithm};
 
 		return eval {
 			die "algorithm $algorithm not supported\n" unless $class;
-			$self->sigbin( $class->sign(@_) );
+			$self->sigbin( $class->sign(@argument) );
 		} || return croak "${@}signature generation failed";
 	}
 }
@@ -474,14 +466,14 @@
 
 sub _VerifySig {
 	if (DNSSEC) {
-		my $self = shift;
+		my ( $self, @argument ) = @_;
 
 		my $algorithm = $self->algorithm;
 		my $class     = $DNSSEC_verify{$algorithm};
 
 		my $retval = eval {
 			die "algorithm $algorithm not supported\n" unless $class;
-			$class->verify( @_, $self->sigbin );
+			$class->verify( @argument, $self->sigbin );
 		};
 
 		unless ($retval) {
@@ -499,13 +491,13 @@
 
 
 sub _ordered() {			## irreflexive 32-bit partial ordering
-	use integer;
 	my ( $n1, $n2 ) = @_;
 
 	return 0 unless defined $n2;				# ( any, undef )
 	return 1 unless defined $n1;				# ( undef, any )
 
 	# unwise to assume 64-bit arithmetic, or that 32-bit integer overflow goes unpunished
+	use integer;
 	if ( $n2 < 0 ) {					# fold, leaving $n2 non-negative
 		$n1 = ( $n1 & 0xFFFFFFFF ) ^ 0x80000000;	# -2**31 <= $n1 < 2**32
 		$n2 = ( $n2 & 0x7FFFFFFF );			#  0	 <= $n2 < 2**31
@@ -579,8 +571,8 @@
 
     use Net::DNS::SEC;
     $sigrr = Net::DNS::RR::RRSIG->create( \@rrset, $keypath,
-					sigex => 20211231010101
-					sigin => 20211201010101
+					sigex => 20231231010101
+					sigin => 20231201010101
 					);
 
     $sigrr->verify( \@rrset, $keyrr ) || die $sigrr->vrfyerrstr;
@@ -704,8 +696,8 @@
     $sigrr = Net::DNS::RR::RRSIG->create( \@rrsetref, $keypath );
 
     $sigrr = Net::DNS::RR::RRSIG->create( \@rrsetref, $keypath,
-					sigex => 20211231010101
-					sigin => 20211201010101
+					sigex => 20231231010101
+					sigin => 20231201010101
 					);
     $sigrr->print;
 
@@ -731,8 +723,8 @@
 The optional remaining arguments consist of ( name => value ) pairs
 as follows:
 
-	sigex  => 20211231010101,	# signature expiration
-	sigin  => 20211201010101,	# signature inception
+	sigex  => 20231231010101,	# signature expiration
+	sigin  => 20231201010101,	# signature inception
 	sigval => 30,			# validity window (days)
 	ttl    => 3600			# TTL
 
@@ -846,8 +838,9 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, L<Net::DNS::SEC>,
-RFC4034
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<Net::DNS::SEC>
+L<RFC4034|https://tools.ietf.org/html/rfc4034>
 
 L<Algorithm Numbers|http://www.iana.org/assignments/dns-sec-alg-numbers>

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/RT.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/RT.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: RT.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: RT.pm 1898 2023-02-15 14:27:22Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -19,18 +19,16 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset, @opaque ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	$self->{preference}   = unpack( "\@$offset n", $$data );
-	$self->{intermediate} = Net::DNS::DomainName2535->decode( $data, $offset + 2, @opaque );
+	$self->{intermediate} = Net::DNS::DomainName2535->decode( $data, $offset + 2 );
 	return;
 }
 
 
 sub _encode_rdata {			## encode rdata as wire-format octet string
-	my $self = shift;
-	my ( $offset, @opaque ) = @_;
+	my ( $self, $offset, @opaque ) = @_;
 
 	return pack 'n a*', $self->preference, $self->{intermediate}->encode( $offset + 2, @opaque );
 }
@@ -44,26 +42,23 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->preference(shift);
-	$self->intermediate(shift);
+	for (qw(preference intermediate)) { $self->$_( shift @argument ) }
 	return;
 }
 
 
 sub preference {
-	my $self = shift;
-
-	$self->{preference} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{preference} = 0 + $_ }
 	return $self->{preference} || 0;
 }
 
 
 sub intermediate {
-	my $self = shift;
-
-	$self->{intermediate} = Net::DNS::DomainName2535->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{intermediate} = Net::DNS::DomainName2535->new($_) }
 	return $self->{intermediate} ? $self->{intermediate}->name : undef;
 }
 
@@ -149,6 +144,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1183 Section 3.3
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC1183(3.3)|https://tools.ietf.org/html/rfc1183>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/SIG.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/SIG.pm Changed

@@ -1,16 +1,8 @@
-
-#	pre-5.14.0 perl inadvertently destroys signal handlers
-#	http://rt.perl.org/rt3/Public/Bug/Display.html?id=76138
-use strict;
-use warnings;
-local %SIG = %SIG;
-
-
 package Net::DNS::RR::SIG;
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: SIG.pm 1856 2021-12-02 14:36:25Z willem $)2;
+our $VERSION = (qw$Id: SIG.pm 1908 2023-03-15 07:28:50Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -36,9 +28,7 @@
 
 # IMPORTANT: Downstream distros MUST NOT create dependencies on Net::DNS::SEC	(strong crypto prohibited in many territories)
 use constant USESEC => defined $INC{'Net/DNS/SEC.pm'};		# Discover how we got here, without exposing any crypto
-use constant							# Discourage static code analysers and casual greppers
-		DNSSEC => USESEC && defined eval join '',
-		qw(r e q u i r e), ' Net::DNS', qw(:: SEC :: Private);	  ## no critic
+use constant DNSSEC => USESEC && defined eval join '', qw(r e q u i r e), ' Net::DNS::SEC::Private';	## no critic
 
 my @index;
 if (DNSSEC) {
@@ -56,36 +46,33 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset, @opaque ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	my $limit = $offset + $self->{rdlength};
 	@{$self}{@field} = unpack "\@$offset n C2 N3 n", $$data;
-	( $self->{signame}, $offset ) = Net::DNS::DomainName2535->decode( $data, $offset + 18 );
+	( $self->{signame}, $offset ) = Net::DNS::DomainName->decode( $data, $offset + 18 );
 	$self->{sigbin} = substr $$data, $offset, $limit - $offset;
 
 	croak('misplaced or corrupt SIG') unless $limit == length $$data;
-	my $raw = substr $$data, 0, $self->{offset};
+	my $raw = substr $$data, 0, $self->{offset}++;
 	$self->{rawref} = \$raw;
 	return;
 }
 
 
 sub _encode_rdata {			## encode rdata as wire-format octet string
-	my $self = shift;
-	my ( $offset, @opaque ) = @_;
-
-	my ( $hash, $packet ) = @opaque;
+	my ( $self, $offset, @opaque ) = @_;
 
 	my $signame = $self->{signame};
 
 	if ( DNSSEC && !$self->{sigbin} ) {
+		my ( undef, $packet ) = @opaque;
 		my $private = delete $self->{private};		# one shot is all you get
 		my $sigdata = $self->_CreateSigData($packet);
 		$self->_CreateSig( $sigdata, $private || die 'missing key reference' );
 	}
 
-	return pack 'n C2 N3 n a* a*', @{$self}{@field}, $signame->encode, $self->sigbin;
+	return pack 'n C2 N3 n a* a*', @{$self}{@field}, $signame->canonical, $self->sigbin;
 }
 
 
@@ -100,10 +87,10 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	foreach ( @field, qw(signame) ) { $self->$_(shift) }
-	$self->signature(@_);
+	foreach ( @field, qw(signame) ) { $self->$_( shift @argument ) }
+	$self->signature(@argument);
 	return;
 }
 
@@ -122,8 +109,8 @@
 
 
 sub typecovered {
-	my $self = shift;					# uncoverable pod
-	$self->{typecovered} = typebyname(shift) if scalar @_;
+	my ( $self, @value ) = @_;				# uncoverable pod
+	for (@value) { $self->{typecovered} = typebyname($_) }
 	my $typecode = $self->{typecovered};
 	return defined $typecode ? typebyval($typecode) : undef;
 }
@@ -154,16 +141,16 @@
 
 
 sub sigexpiration {
-	my $self = shift;
-	$self->{sigexpiration} = _string2time(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{sigexpiration} = _string2time($_) }
 	my $time = $self->{sigexpiration};
 	return unless defined wantarray && defined $time;
 	return UTIL ? Scalar::Util::dualvar( $time, _time2string($time) ) : _time2string($time);
 }
 
 sub siginception {
-	my $self = shift;
-	$self->{siginception} = _string2time(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{siginception} = _string2time($_) }
 	my $time = $self->{siginception};
 	return unless defined wantarray && defined $time;
 	return UTIL ? Scalar::Util::dualvar( $time, _time2string($time) ) : _time2string($time);
@@ -174,40 +161,37 @@
 sub sigin { return &siginception; }	## historical
 
 sub sigval {
-	my $self = shift;
+	my ( $self, @value ) = @_;
 	no integer;
-	( $self->{sigval} ) = map { int( 60.0 * $_ ) } @_;
+	( $self->{sigval} ) = map { int( 60.0 * $_ ) } @value;
 	return;
 }
 
 
 sub keytag {
-	my $self = shift;
-
-	$self->{keytag} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{keytag} = 0 + $_ }
 	return $self->{keytag} || 0;
 }
 
 
 sub signame {
-	my $self = shift;
-
-	$self->{signame} = Net::DNS::DomainName2535->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{signame} = Net::DNS::DomainName2535->new($_) }
 	return $self->{signame} ? $self->{signame}->name : undef;
 }
 
 
 sub sig {
-	my $self = shift;
-	return MIME::Base64::encode( $self->sigbin(), "" ) unless scalar @_;
-	return $self->sigbin( MIME::Base64::decode( join "", @_ ) );
+	my ( $self, @value ) = @_;
+	return MIME::Base64::encode( $self->sigbin(), "" ) unless scalar @value;
+	return $self->sigbin( MIME::Base64::decode( join "", @value ) );
 }
 
 
 sub sigbin {
-	my $self = shift;
-
-	$self->{sigbin} = shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{sigbin} = $_ }
 	return $self->{sigbin} || "";
 }
 
@@ -447,14 +431,14 @@
 
 sub _CreateSig {
 	if (DNSSEC) {
-		my $self = shift;
+		my ( $self, @argument ) = @_;
 
 		my $algorithm = $self->algorithm;
 		my $class     = $DNSSEC_siggen{$algorithm};
 
 		return eval {
 			die "algorithm $algorithm not supported\n" unless $class;
-			$self->sigbin( $class->sign(@_) );
+			$self->sigbin( $class->sign(@argument) );
 		} || return croak "${@}signature generation failed";
 	}
 }
@@ -462,14 +446,14 @@
 
 sub _VerifySig {
 	if (DNSSEC) {
-		my $self = shift;
+		my ( $self, @argument ) = @_;
 
 		my $algorithm = $self->algorithm;
 		my $class     = $DNSSEC_verify{$algorithm};
 
 		my $retval = eval {
 			die "algorithm $algorithm not supported\n" unless $class;
-			$class->verify( @_, $self->sigbin );
+			$class->verify( @argument, $self->sigbin );
 		};
 
 		unless ($retval) {
@@ -487,13 +471,13 @@
 
 
 sub _ordered() {			## irreflexive 32-bit partial ordering
-	use integer;
 	my ( $n1, $n2 ) = @_;
 
 	return 0 unless defined $n2;				# ( any, undef )
 	return 1 unless defined $n1;				# ( undef, any )
 
 	# unwise to assume 64-bit arithmetic, or that 32-bit integer overflow goes unpunished
+	use integer;
 	if ( $n2 < 0 ) {					# fold, leaving $n2 non-negative
 		$n1 = ( $n1 & 0xFFFFFFFF ) ^ 0x80000000;	# -2**31 <= $n1 < 2**32
 		$n2 = ( $n2 & 0x7FFFFFFF );			#  0	 <= $n2 < 2**31
@@ -693,8 +677,8 @@
 The optional remaining arguments consist of ( name => value ) pairs
 as follows:
 
-	sigin  => 20211201010101,	# signature inception
-	sigex  => 20211201011101,	# signature expiration
+	sigin  => 20231201010101,	# signature inception
+	sigex  => 20231201011101,	# signature expiration
 	sigval => 10,			# validity window (minutes)
 
 The sigin and sigex values may be specified as Perl time values or as
@@ -795,8 +779,12 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, L<Net::DNS::SEC>,
-RFC2536, RFC2931, RFC3110, RFC4034
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<Net::DNS::SEC>
+L<RFC2536|https://tools.ietf.org/html/rfc2536>
+L<RFC2931|https://tools.ietf.org/html/rfc2931>
+L<RFC3110|https://tools.ietf.org/html/rfc3110>
+L<RFC4034|https://tools.ietf.org/html/rfc4034>
 
 L<Algorithm Numbers|http://www.iana.org/assignments/dns-sec-alg-numbers>

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/SMIMEA.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/SMIMEA.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: SMIMEA.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: SMIMEA.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -21,8 +21,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	my $next = $offset + $self->{rdlength};
 
@@ -51,51 +50,46 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->usage(shift);
-	$self->selector(shift);
-	$self->matchingtype(shift);
-	$self->cert(@_);
+	for (qw(usage selector matchingtype)) { $self->$_( shift @argument ) }
+	$self->cert(@argument);
 	return;
 }
 
 
 sub usage {
-	my $self = shift;
-
-	$self->{usage} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{usage} = 0 + $_ }
 	return $self->{usage} || 0;
 }
 
 
 sub selector {
-	my $self = shift;
-
-	$self->{selector} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{selector} = 0 + $_ }
 	return $self->{selector} || 0;
 }
 
 
 sub matchingtype {
-	my $self = shift;
-
-	$self->{matchingtype} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{matchingtype} = 0 + $_ }
 	return $self->{matchingtype} || 0;
 }
 
 
 sub cert {
-	my $self = shift;
-	return unpack "H*", $self->certbin() unless scalar @_;
-	return $self->certbin( pack "H*", join "", map { /^"*(\dA-Fa-f*)"*$/ || croak("corrupt hex"); $1 } @_ );
+	my ( $self, @value ) = @_;
+	return unpack "H*", $self->certbin() unless scalar @value;
+	my @hex = map { /^"*(\dA-Fa-f*)"*$/ || croak("corrupt hex"); $1 } @value;
+	return $self->certbin( pack "H*", join "", @hex );
 }
 
 
 sub certbin {
-	my $self = shift;
-
-	$self->{certbin} = shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{certbin} = $_ }
 	return $self->{certbin} || "";
 }
 
@@ -222,7 +216,8 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC8162,
-RFC6698
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC8162|https://tools.ietf.org/html/rfc8162>
+L<RFC6698|https://tools.ietf.org/html/rfc6698>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/SOA.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/SOA.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: SOA.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: SOA.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -20,10 +20,10 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset, @opaque ) = @_;
+	my ( $self, @argument ) = @_;
+	my ( $data, $offset, @opaque ) = @argument;
 
-	( $self->{mname}, $offset ) = Net::DNS::DomainName1035->decode(@_);
+	( $self->{mname}, $offset ) = Net::DNS::DomainName1035->decode(@argument);
 	( $self->{rname}, $offset ) = Net::DNS::Mailbox1035->decode( $data, $offset, @opaque );
 	@{$self}{qw(serial refresh retry expire minimum)} = unpack "\@$offset N5", $$data;
 	return;
@@ -31,11 +31,11 @@
 
 
 sub _encode_rdata {			## encode rdata as wire-format octet string
-	my $self = shift;
-	my ( $offset, @opaque ) = @_;
+	my ( $self,   @argument ) = @_;
+	my ( $offset, @opaque )	  = @argument;
 
 	my $rname = $self->{rname};
-	my $rdata = $self->{mname}->encode(@_);
+	my $rdata = $self->{mname}->encode(@argument);
 	$rdata .= $rname->encode( $offset + length($rdata), @opaque );
 	$rdata .= pack 'N5', $self->serial, @{$self}{qw(refresh retry expire minimum)};
 	return $rdata;
@@ -58,13 +58,12 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->mname(shift);
-	$self->rname(shift);
-	$self->serial(shift);
+	for (qw(mname rname serial)) { $self->$_( shift @argument ) }
 	for (qw(refresh retry expire minimum)) {
-		$self->$_( Net::DNS::RR::ttl( {}, shift ) ) if scalar @_;
+		last unless scalar @argument;
+		$self->$_( Net::DNS::RR::ttl( {}, shift @argument ) );
 	}
 	return;
 }
@@ -80,27 +79,25 @@
 
 
 sub mname {
-	my $self = shift;
-
-	$self->{mname} = Net::DNS::DomainName1035->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{mname} = Net::DNS::DomainName1035->new($_) }
 	return $self->{mname} ? $self->{mname}->name : undef;
 }
 
 
 sub rname {
-	my $self = shift;
-
-	$self->{rname} = Net::DNS::Mailbox1035->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{rname} = Net::DNS::Mailbox1035->new($_) }
 	return $self->{rname} ? $self->{rname}->address : undef;
 }
 
 
 sub serial {
-	my $self = shift;
+	my ( $self, @value ) = @_;
 
-	return $self->{serial} || 0 unless scalar @_;		# current/default value
+	return $self->{serial} || 0 unless scalar @value;	# current/default value
 
-	my $value = shift;					# replace if in sequence
+	my $value = shift @value;				# replace if in sequence
 	return $self->{serial} = ( $value & 0xFFFFFFFF ) if _ordered( $self->{serial}, $value );
 
 	# unwise to assume 64-bit arithmetic, or that 32-bit integer overflow goes unpunished
@@ -112,33 +109,29 @@
 
 
 sub refresh {
-	my $self = shift;
-
-	$self->{refresh} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{refresh} = 0 + $_ }
 	return $self->{refresh} || 0;
 }
 
 
 sub retry {
-	my $self = shift;
-
-	$self->{retry} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{retry} = 0 + $_ }
 	return $self->{retry} || 0;
 }
 
 
 sub expire {
-	my $self = shift;
-
-	$self->{expire} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{expire} = 0 + $_ }
 	return $self->{expire} || 0;
 }
 
 
 sub minimum {
-	my $self = shift;
-
-	$self->{minimum} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{minimum} = 0 + $_ }
 	return $self->{minimum} || 0;
 }
 
@@ -146,13 +139,13 @@
 ########################################
 
 sub _ordered() {			## irreflexive 32-bit partial ordering
-	use integer;
 	my ( $n1, $n2 ) = @_;
 
 	return 0 unless defined $n2;				# ( any, undef )
 	return 1 unless defined $n1;				# ( undef, any )
 
 	# unwise to assume 64-bit arithmetic, or that 32-bit integer overflow goes unpunished
+	use integer;
 	if ( $n2 < 0 ) {					# fold, leaving $n2 non-negative
 		$n1 = ( $n1 & 0xFFFFFFFF ) ^ 0x80000000;	# -2**31 <= $n1 < 2**32
 		$n2 = ( $n2 & 0x7FFFFFFF );			#  0	 <= $n2 < 2**31
@@ -257,14 +250,14 @@
     $successor = $soa->serial( SEQUENTIAL );
 
 The existing serial number is incremented modulo 2**32 because the
-value returned by the auxilliary SEQUENTIAL() function can never
+value returned by the auxiliary SEQUENTIAL() function can never
 satisfy the serial number ordering constraint.
 
 =head2 Date Encoded
 
     $successor = $soa->serial( YYYYMMDDxx );
 
-The 32 bit value returned by the auxilliary YYYYMMDDxx() function will
+The 32 bit value returned by the auxiliary YYYYMMDDxx() function will
 be used if it satisfies the ordering constraint, otherwise the serial
 number will be incremented as above.
 
@@ -275,7 +268,7 @@
 
     $successor = $soa->serial( UNIXTIME );
 
-The 32 bit value returned by the auxilliary UNIXTIME() function will
+The 32 bit value returned by the auxiliary UNIXTIME() function will
 used if it satisfies the ordering constraint, otherwise the existing
 serial number will be incremented as above.
 
@@ -314,6 +307,8 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1035 Section 3.3.13, RFC1982
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC1035(3.3.13)|https://tools.ietf.org/html/rfc1035>
+L<RFC1982|https://tools.ietf.org/html/rfc1982>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/SPF.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/SPF.pm Changed

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/SRV.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/SRV.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: SRV.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: SRV.pm 1898 2023-02-15 14:27:22Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -19,19 +19,17 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset, @opaque ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	@{$self}{qw(priority weight port)} = unpack( "\@$offset n3", $$data );
 
-	$self->{target} = Net::DNS::DomainName2535->decode( $data, $offset + 6, @opaque );
+	$self->{target} = Net::DNS::DomainName2535->decode( $data, $offset + 6 );
 	return;
 }
 
 
 sub _encode_rdata {			## encode rdata as wire-format octet string
-	my $self = shift;
-	my ( $offset, @opaque ) = @_;
+	my ( $self, $offset, @opaque ) = @_;
 
 	my $target = $self->{target};
 	my @nums   = ( $self->priority, $self->weight, $self->port );
@@ -49,43 +47,39 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
 	foreach my $attr (qw(priority weight port target)) {
-		$self->$attr(shift);
+		$self->$attr( shift @argument );
 	}
 	return;
 }
 
 
 sub priority {
-	my $self = shift;
-
-	$self->{priority} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{priority} = 0 + $_ }
 	return $self->{priority} || 0;
 }
 
 
 sub weight {
-	my $self = shift;
-
-	$self->{weight} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{weight} = 0 + $_ }
 	return $self->{weight} || 0;
 }
 
 
 sub port {
-	my $self = shift;
-
-	$self->{port} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{port} = 0 + $_ }
 	return $self->{port} || 0;
 }
 
 
 sub target {
-	my $self = shift;
-
-	$self->{target} = Net::DNS::DomainName2535->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{target} = Net::DNS::DomainName2535->new($_) }
 	return $self->{target} ? $self->{target}->name : undef;
 }
 
@@ -193,6 +187,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC2782
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC2782|https://tools.ietf.org/html/rfc2782>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/SSHFP.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/SSHFP.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: SSHFP.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: SSHFP.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -21,8 +21,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	my $size = $self->{rdlength} - 2;
 	@{$self}{qw(algorithm fptype fpbin)} = unpack "\@$offset C2 a$size", $$data;
@@ -48,42 +47,39 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->algorithm(shift);
-	$self->fptype(shift);
-	$self->fp(@_);
+	for (qw(algorithm fptype)) { $self->$_( shift @argument ) }
+	$self->fp(@argument);
 	return;
 }
 
 
 sub algorithm {
-	my $self = shift;
-
-	$self->{algorithm} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{algorithm} = 0 + $_ }
 	return $self->{algorithm} || 0;
 }
 
 
 sub fptype {
-	my $self = shift;
-
-	$self->{fptype} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{fptype} = 0 + $_ }
 	return $self->{fptype} || 0;
 }
 
 
 sub fp {
-	my $self = shift;
-	return unpack "H*", $self->fpbin() unless scalar @_;
-	return $self->fpbin( pack "H*", join "", map { /^"*(\dA-Fa-f*)"*$/ || croak("corrupt hex"); $1 } @_ );
+	my ( $self, @value ) = @_;
+	return unpack "H*", $self->fpbin() unless scalar @value;
+	my @hex = map { /^"*(\dA-Fa-f*)"*$/ || croak("corrupt hex"); $1 } @value;
+	return $self->fpbin( pack "H*", join "", @hex );
 }
 
 
 sub fpbin {
-	my $self = shift;
-
-	$self->{fpbin} = shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{fpbin} = $_ }
 	return $self->{fpbin} || "";
 }
 
@@ -202,6 +198,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC4255
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC4255|https://tools.ietf.org/html/rfc4255>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/SVCB.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/SVCB.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: SVCB.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: SVCB.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -15,7 +15,6 @@
 
 use integer;
 
-use Carp;
 use MIME::Base64;
 use Net::DNS::DomainName;
 use Net::DNS::RR::A;
@@ -31,12 +30,12 @@
 	ipv4hint	  => 'key4',
 	ech		  => 'key5',
 	ipv6hint	  => 'key6',
+	dohpath		  => 'key7',				# draft-schwartz-svcb-dns
 	);
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	my $rdata = substr $$data, $offset, $self->{rdlength};
 	$self->{SvcPriority} = unpack( 'n', $rdata );
@@ -81,11 +80,11 @@
 
 	my $encode = $self->{TargetName}->encode();
 	my $length = 2 + length $encode;
-	my @target = split /(\S{32})/, unpack 'H*', $encode;
+	my @target = grep {length} split /(\S{32})/, unpack 'H*', $encode;
 	my @rdata  = unpack 'H4', pack 'n', $priority;
 	push @rdata, "\t; priority: $priority\n";
 	push @rdata, shift @target;
-	push @rdata, join '', "\t\t; target: ", substr( $target, 0, 50 ), "\n";
+	push @rdata, join '', "\t; target: ", substr( $target, 0, 50 ), "\n";
 	push @rdata, @target;
 
 	my @params = @$params;
@@ -94,7 +93,7 @@
 		my $val = shift @params;
 		push @rdata, "\n";
 		push @rdata, "; key$key=...\n" if $key > 15;
-		push @rdata, unpack 'H4H4', pack( 'n2', $key, length $val );
+		push @rdata, unpack 'H4H4',    pack( 'n2', $key, length $val );
 		push @rdata, split /(\S{32})/, unpack 'H*', $val;
 		$length += 4 + length $val;
 	}
@@ -103,20 +102,20 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->svcpriority(shift);
-	$self->targetname(shift);
+	$self->svcpriority( shift @argument );
+	$self->targetname( shift @argument );
 
 	local $SIG{__WARN__} = sub { die @_ };
-	while ( my $svcparam = shift ) {
+	while ( my $svcparam = shift @argument ) {
 		for ($svcparam) {
 			my @value;
 			if (/^key\d+=(.*)$/i) {
-				push @value, length($1) ? $1 : shift;
-			} elsif (/=(.*)$/) {
-				local $_ = length($1) ? $1 : shift;
-				s/^"(.*)"$/$1/;			# strip enclosing quotes
+				push @value, length($1) ? $1 : shift @argument;
+			} elsif (/^^=+=(.*)$/) {
+				local $_ = length($1) ? $1 : shift @argument;
+				s/^"(^"*)"$/$1/;		# strip enclosing quotes
 				push @value, split /,/;
 			} else {
 				push @value, '' unless $keybyname{lc $_};    # empty | Boolean
@@ -141,13 +140,13 @@
 	if ( defined $svcparam{0} ) {
 		my %unique;
 		foreach ( grep { !$unique{$_}++ } unpack 'n*', $svcparam{0} ) {
-			croak( $self->type . qq: unexpected "key0" in mandatory list ) if $unique{0};
-			croak( $self->type . qq: duplicate "key$_" in mandatory list ) if --$unique{$_};
-			croak( $self->type . qq: mandatory "key$_" not present ) unless defined $svcparam{$_};
+			die( $self->type . qq: unexpected "key0" in mandatory list ) if $unique{0};
+			die( $self->type . qq: duplicate "key$_" in mandatory list ) if --$unique{$_};
+			die( $self->type . qq: mandatory "key$_" not present ) unless defined $svcparam{$_};
 		}
 		$self->mandatory( keys %unique );		# restore mandatory key list
 	}
-	croak( $self->type . qq: expected alpn="..." not present ) if defined( $svcparam{2} ) and !$svcparam{1};
+	die( $self->type . qq: expected alpn="..." not present ) if defined( $svcparam{2} ) && !$svcparam{1};
 	return;
 }
 
@@ -161,17 +160,16 @@
 
 
 sub svcpriority {
-	my $self = shift;					# uncoverable pod
-
-	$self->{SvcPriority} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;				# uncoverable pod
+	for (@value) { $self->{SvcPriority} = 0 + $_ }
 	return $self->{SvcPriority} || 0;
 }
 
 
 sub targetname {
-	my $self = shift;					# uncoverable pod
+	my ( $self, @value ) = @_;				# uncoverable pod
 
-	$self->{TargetName} = Net::DNS::DomainName->new(shift) if scalar @_;
+	for (@value) { $self->{TargetName} = Net::DNS::DomainName->new($_) }
 
 	my $target = $self->{TargetName} ? $self->{TargetName}->name : return;
 	return $target unless $self->{SvcPriority};
@@ -180,40 +178,45 @@
 
 
 sub mandatory {				## mandatory=key1,port,...
-	my $self = shift;
-	my @list = map { $keybyname{lc $_} || $_ } map { split /,/ } @_;
-	my @keys = map { /(\d+)$/ ? $1 : croak( $self->type . qq: unexpected "$_" ) } @list;
+	my ( $self, @value ) = @_;
+	my @list = map { $keybyname{lc $_} || $_ } map { split /,/ } @value;
+	my @keys = map { /(\d+)$/ ? $1 : die( $self->type . qq: unexpected "$_" ) } @list;
 	return $self->key0( _integer16( sort { $a <=> $b } @keys ) );
 }
 
 sub alpn {				## alpn=h3,h2,...
-	my $self = shift;
-	return $self->key1( _string(@_) );
+	my ( $self, @value ) = @_;
+	return $self->key1( _string(@value) );
 }
 
 sub no_default_alpn {			## no-default-alpn
-	my $self = shift;					# uncoverable pod
-	return $self->key2( ( defined(wantarray) ? @_ : '' ), @_ );
+	my ( $self, @value ) = @_;				# uncoverable pod
+	return $self->key2( ( defined(wantarray) ? @value : '' ), @value );
 }
 
 sub port {				## port=1234
-	my $self = shift;
-	return $self->key3( map { _integer16($_) } @_ );
+	my ( $self, @value ) = @_;
+	return $self->key3( map { _integer16($_) } @value );
 }
 
 sub ipv4hint {				## ipv4hint=192.0.2.1,...
-	my $self = shift;
-	return $self->key4( _ipv4(@_) );
+	my ( $self, @value ) = @_;
+	return $self->key4( _ipv4(@value) );
 }
 
 sub ech {				## ech=base64string
-	my $self = shift;
-	return $self->key5( map { _base64($_) } @_ );
+	my ( $self, @value ) = @_;
+	return $self->key5( map { _base64($_) } @value );
 }
 
 sub ipv6hint {				## ipv6hint=2001:DB8::1,...
-	my $self = shift;
-	return $self->key6( _ipv6(@_) );
+	my ( $self, @value ) = @_;
+	return $self->key6( _ipv6(@value) );
+}
+
+sub dohpath {				## dohpath=/dns-query{?dns}
+	my ( $self, @value ) = @_;				# uncoverable pod
+	return $self->key7(@value);
 }
 
 
@@ -221,60 +224,66 @@
 
 
 sub _presentation {			## render octet string(s) in presentation format
-	return () unless scalar @_;
-	my $raw = join '', @_;
+	my @arg = @_;
+	my $raw = scalar(@arg) ? join( '', @arg ) : return ();
 	return Net::DNS::Text->decode( \$raw, 0, length($raw) )->string;
 }
 
 sub _base64 {
-	return _presentation( map { MIME::Base64::decode($_) } @_ );
+	my @arg = @_;
+	return _presentation( map { MIME::Base64::decode($_) } @arg );
 }
 
 sub _integer16 {
-	return _presentation( map { pack( 'n', $_ ) } @_ );
+	my @arg = @_;
+	return _presentation( map { pack( 'n', $_ ) } @arg );
 }
 
 sub _ipv4 {
-	return _presentation( map { Net::DNS::RR::A::address( {}, $_ ) } @_ );
+	my @arg = @_;
+	return _presentation( map { Net::DNS::RR::A::address( {}, $_ ) } @arg );
 }
 
 sub _ipv6 {
-	return _presentation( map { Net::DNS::RR::AAAA::address( {}, $_ ) } @_ );
+	my @arg = @_;
+	return _presentation( map { Net::DNS::RR::AAAA::address( {}, $_ ) } @arg );
 }
 
 sub _string {
-	local $_ = join ',', '', @_;				# reassemble argument string
-	s/\\092,/\\044/g;		### tolerate unnecessary double-escape nonsense in
-	s/\\092\\092/\\092/g;		### draft-ietf-dnsop-svcb-https that contradicts RFC1035
+	my @arg = @_;
+	local $_ = join ',', @arg;				# reassemble argument string
 	s/\\,/\\044/g;						# disguise (RFC1035) escaped comma
-	my ( undef, @reparsed ) = split /,/;			# multi-valued argument
-	return _presentation( map { Net::DNS::Text->new($_)->encode() } @reparsed );
+	die <<"QQ" if /\\092,|\\092\\092/;
+SVCB: Please use standard RFC1035 escapes\n draft-ietf-dnsop-svcb-https double-escape nonsense not implemented
+QQ
+	return _presentation( map { Net::DNS::Text->new($_)->encode() } split /,/ );
 }
 
 
 our $AUTOLOAD;
 
 sub AUTOLOAD {				## Dynamic constructor/accessor methods
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
 	my ($method) = reverse split /::/, $AUTOLOAD;
 
 	my $super = "SUPER::$method";
-	return $self->$super(@_) unless $method =~ /^key0*(\d+)$/i;
+	return $self->$super(@argument) unless $method =~ /^key0*(\d+)$/i;
 	my $key = $1;
 
 	my $paramsref = $self->{SvcParams} || ;
 	my %svcparams = @$paramsref;
 
-	if ( scalar @_ ) {
-		my $arg = shift;				# keyNN($value);
+	if ( scalar @argument ) {
+		my $arg = shift @argument;			# keyNN($value);
 		delete $svcparams{$key} unless defined $arg;
-		croak( $self->type . qq: duplicate SvcParam "key$key" ) if defined $svcparams{$key};
+		die( $self->type . qq: duplicate SvcParam "key$key" ) if defined $svcparams{$key};
+		die( $self->type . qq: invalid SvcParam "key$key" )	if $key > 65534;
 		$svcparams{$key}   = Net::DNS::Text->new("$arg")->raw if defined $arg;
 		$self->{SvcParams} = map { ( $_, $svcparams{$_} ) } sort { $a <=> $b } keys %svcparams;
-		croak( $self->type . qq: unexpected number of values for "key$key" ) if scalar @_;
+		die( $self->type . qq: unexpected number of values for "key$key" ) if scalar @argument;
 	} else {
-		croak( $self->type . qq: no value specified for "key$key" ) unless defined wantarray;
+		die( $self->type . qq: no value specified for "key$key" ) unless defined wantarray;
 	}
 
 	my $value = $svcparams{$key};
@@ -361,7 +370,7 @@
 
 =head1 COPYRIGHT
 
-Copyright (c)2020-2021 Dick Franks. 
+Copyright (c)2020-2022 Dick Franks. 
 
 All rights reserved.
 
@@ -389,6 +398,10 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, draft-ietf-dnsop-svcb-https
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+draft-ietf-dnsop-svcb-https,
+L<RFC1035|https://tools.ietf.org/html/rfc1035>
+
+L<Service Parameter Keys|https://www.iana.org/assignments/dns-svcb>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/TKEY.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/TKEY.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: TKEY.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: TKEY.pm 1908 2023-03-15 07:28:50Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -21,16 +21,15 @@
 use Net::DNS::DomainName;
 
 use constant ANY  => classbyname qw(ANY);
-use constant TKEY => typebyname qw(TKEY);
+use constant TKEY => typebyname	 qw(TKEY);
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	my $limit = $offset + $self->{rdlength};
 
-	( $self->{algorithm}, $offset ) = Net::DNS::DomainName->decode(@_);
+	( $self->{algorithm}, $offset ) = Net::DNS::DomainName->decode( $data, $offset );
 
 	@{$self}{qw(inception expiration mode error)} = unpack "\@$offset N2n2", $$data;
 	$offset += 12;
@@ -65,11 +64,11 @@
 }
 
 
-sub class {				## overide RR method
+sub class {				## override RR method
 	return 'ANY';
 }
 
-sub encode {				## overide RR method
+sub encode {				## override RR method
 	my $self = shift;
 
 	my $owner = $self->{owner}->encode();
@@ -79,57 +78,50 @@
 
 
 sub algorithm {
-	my $self = shift;
-
-	$self->{algorithm} = Net::DNS::DomainName->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{algorithm} = Net::DNS::DomainName->new($_) }
 	return $self->{algorithm} ? $self->{algorithm}->name : undef;
 }
 
 
 sub inception {
-	my $self = shift;
-
-	$self->{inception} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{inception} = 0 + $_ }
 	return $self->{inception} || 0;
 }
 
 
 sub expiration {
-	my $self = shift;
-
-	$self->{expiration} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{expiration} = 0 + $_ }
 	return $self->{expiration} || 0;
 }
 
 
 sub mode {
-	my $self = shift;
-
-	$self->{mode} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{mode} = 0 + $_ }
 	return $self->{mode} || 0;
 }
 
 
 sub error {
-	my $self = shift;
-
-	$self->{error} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{error} = 0 + $_ }
 	return $self->{error} || 0;
 }
 
 
 sub key {
-	my $self = shift;
-
-	$self->{key} = shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{key} = $_ }
 	return $self->{key} || "";
 }
 
 
 sub other {
-	my $self = shift;
-
-	$self->{other} = shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{other} = $_ }
 	return $self->{other} || "";
 }
 
@@ -247,6 +239,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC2930
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC2930|https://tools.ietf.org/html/rfc2930>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/TLSA.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/TLSA.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: TLSA.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: TLSA.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -20,8 +20,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	my $next = $offset + $self->{rdlength};
 
@@ -50,51 +49,46 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->usage(shift);
-	$self->selector(shift);
-	$self->matchingtype(shift);
-	$self->cert(@_);
+	for (qw(usage selector matchingtype)) { $self->$_( shift @argument ) }
+	$self->cert(@argument);
 	return;
 }
 
 
 sub usage {
-	my $self = shift;
-
-	$self->{usage} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{usage} = 0 + $_ }
 	return $self->{usage} || 0;
 }
 
 
 sub selector {
-	my $self = shift;
-
-	$self->{selector} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{selector} = 0 + $_ }
 	return $self->{selector} || 0;
 }
 
 
 sub matchingtype {
-	my $self = shift;
-
-	$self->{matchingtype} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{matchingtype} = 0 + $_ }
 	return $self->{matchingtype} || 0;
 }
 
 
 sub cert {
-	my $self = shift;
-	return unpack "H*", $self->certbin() unless scalar @_;
-	return $self->certbin( pack "H*", join "", map { /^"*(\dA-Fa-f*)"*$/ || croak("corrupt hex"); $1 } @_ );
+	my ( $self, @value ) = @_;
+	return unpack "H*", $self->certbin() unless scalar @value;
+	my @hex = map { /^"*(\dA-Fa-f*)"*$/ || croak("corrupt hex"); $1 } @value;
+	return $self->certbin( pack "H*", join "", @hex );
 }
 
 
 sub certbin {
-	my $self = shift;
-
-	$self->{certbin} = shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{certbin} = $_ }
 	return $self->{certbin} || "";
 }
 
@@ -221,6 +215,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC6698
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC6698|https://tools.ietf.org/html/rfc6698>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/TSIG.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/TSIG.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: TSIG.pm 1856 2021-12-02 14:36:25Z willem $)2;
+our $VERSION = (qw$Id: TSIG.pm 1909 2023-03-23 11:36:16Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -32,11 +32,10 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	my $limit = $offset + $self->{rdlength};
-	( $self->{algorithm}, $offset ) = Net::DNS::DomainName->decode(@_);
+	( $self->{algorithm}, $offset ) = Net::DNS::DomainName->decode( $data, $offset );
 
 	# Design decision: Use 32 bits, which will work until the end of time()!
 	@{$self}{qw(time_signed fudge)} = unpack "\@$offset xxN n", $$data;
@@ -54,7 +53,7 @@
 	$offset += $other_size + 2;
 
 	croak('misplaced or corrupt TSIG') unless $limit == length $$data;
-	my $raw = substr $$data, 0, $self->{offset};
+	my $raw = substr $$data, 0, $self->{offset}++;
 	$self->{rawref} = \$raw;
 	return;
 }
@@ -63,13 +62,14 @@
 sub _encode_rdata {			## encode rdata as wire-format octet string
 	my $self = shift;
 
+	my $offset = shift;
+	my $undef  = shift;
+	my $packet = shift;
 	my $macbin = $self->macbin;
 	unless ($macbin) {
-		my ( $offset, undef, $packet ) = @_;
-
+		$self->original_id( $packet->header->id );
 		my $sigdata = $self->sig_data($packet);		# form data to be signed
 		$macbin = $self->macbin( $self->_mac_function($sigdata) );
-		$self->original_id( $packet->header->id );
 	}
 
 	my $rdata = $self->{algorithm}->canonical;
@@ -107,18 +107,16 @@
 }
 
 
-sub encode {				## overide RR method
-	my $self = shift;
-
+sub encode {				## override RR method
+	my ( $self, @argument ) = @_;
 	my $kname = $self->{owner}->encode();			# uncompressed key name
-	my $rdata = eval { $self->_encode_rdata(@_) } || '';
+	my $rdata = eval { $self->_encode_rdata(@argument) } || '';
 	return pack 'a* n2 N n a*', $kname, TSIG, ANY, 0, length $rdata, $rdata;
 }
 
 
-sub string {				## overide RR method
-	my $self = shift;
-
+sub string {				## override RR method
+	my $self	= shift;
 	my $owner	= $self->{owner}->string;
 	my $type	= $self->type;
 	my $algorithm	= $self->algorithm;
@@ -144,9 +142,9 @@
 
 
 sub key {
-	my $self = shift;
-	return MIME::Base64::encode( $self->keybin(), "" ) unless scalar @_;
-	return $self->keybin( MIME::Base64::decode( join "", @_ ) );
+	my ( $self, @argument ) = @_;
+	return MIME::Base64::encode( $self->keybin(), "" ) unless scalar @argument;
+	return $self->keybin( MIME::Base64::decode( join "", @argument ) );
 }
 
 
@@ -154,86 +152,82 @@
 
 
 sub time_signed {
-	my $self = shift;
-
-	$self->{time_signed} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{time_signed} = 0 + $_ }
 	return $self->{time_signed} ? $self->{time_signed} : ( $self->{time_signed} = time() );
 }
 
 
 sub fudge {
-	my $self = shift;
-
-	$self->{fudge} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{fudge} = 0 + $_ }
 	return $self->{fudge} || 0;
 }
 
 
 sub mac {
-	my $self = shift;
-	return MIME::Base64::encode( $self->macbin(), "" ) unless scalar @_;
-	return $self->macbin( MIME::Base64::decode( join "", @_ ) );
+	my ( $self, @value ) = @_;
+	return MIME::Base64::encode( $self->macbin(), "" ) unless scalar @value;
+	return $self->macbin( MIME::Base64::decode( join "", @value ) );
 }
 
 
 sub macbin {
-	my $self = shift;
-
-	$self->{macbin} = shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{macbin} = $_ }
 	return $self->{macbin} || "";
 }
 
 
 sub prior_mac {
-	my $self = shift;
-	return MIME::Base64::encode( $self->prior_macbin(), "" ) unless scalar @_;
-	return $self->prior_macbin( MIME::Base64::decode( join "", @_ ) );
+	my ( $self, @value ) = @_;
+	return MIME::Base64::encode( $self->prior_macbin(), "" ) unless scalar @value;
+	return $self->prior_macbin( MIME::Base64::decode( join "", @value ) );
 }
 
 
 sub prior_macbin {
-	my $self = shift;
-
-	$self->{prior_macbin} = shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{prior_macbin} = $_ }
 	return $self->{prior_macbin} || "";
 }
 
 
 sub request_mac {
-	my $self = shift;
-	return MIME::Base64::encode( $self->request_macbin(), "" ) unless scalar @_;
-	return $self->request_macbin( MIME::Base64::decode( join "", @_ ) );
+	my ( $self, @value ) = @_;
+	return MIME::Base64::encode( $self->request_macbin(), "" ) unless scalar @value;
+	return $self->request_macbin( MIME::Base64::decode( join "", @value ) );
 }
 
 
 sub request_macbin {
-	my $self = shift;
-
-	$self->{request_macbin} = shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{request_macbin} = $_ }
 	return $self->{request_macbin} || "";
 }
 
 
 sub original_id {
-	my $self = shift;
-
-	$self->{original_id} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{original_id} = 0 + $_ }
 	return $self->{original_id} || 0;
 }
 
 
 sub error {
-	my $self = shift;
-	$self->{error} = rcodebyname(shift) if scalar @_;
-	return rcodebyval( $self->{error} );
+	my ( $self, @value ) = @_;
+	for (@value) {
+		my $error = $self->{error} = rcodebyname($_);
+		$self->other( time() ) if $error == 18;
+	}
+	return rcodebyval( $self->{error} || '' );
 }
 
 
 sub other {
-	my $self = shift;
-	$self->{other} = shift if scalar @_;
-	my $time = $self->{error} == 18 ? pack 'xxN', time() : '';
-	return $self->{other} ? $self->{other} : ( $self->{other} = $time );
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{other} = $_ ? pack( 'xxN', $_ ) : '' }
+	return $self->{other} ? unpack( 'N', $self->{other} ) : '';
 }
 
 
@@ -241,9 +235,8 @@
 
 
 sub sig_function {
-	my $self = shift;
-
-	$self->{sig_function} = shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{sig_function} = $_ }
 	return $self->{sig_function};
 }
 
@@ -301,8 +294,7 @@
 
 
 sub create {
-	my $class = shift;
-	my $karg  = shift;
+	my ( $class, $karg, @argument ) = @_;
 	croak 'argument undefined' unless defined $karg;
 
 	if ( ref($karg) ) {
@@ -314,7 +306,7 @@
 				type	       => 'TSIG',
 				algorithm      => $sigrr->algorithm,
 				request_macbin => $sigrr->macbin,
-				@_
+				@argument
 				);
 
 		} elsif ( ref($karg) eq __PACKAGE__ ) {
@@ -328,21 +320,11 @@
 				type	  => 'TSIG',
 				algorithm => $karg->algorithm,
 				key	  => $karg->key,
-				@_
+				@argument
 				);
 		}
 
-		croak "Usage:	$class->create( \$keyfile, \@options )";
-
-	} elsif ( scalar(@_) == 1 ) {
-		$class->_deprecate('create( $keyname, $key )'); # ( keyname, key )
-		return Net::DNS::RR->new(
-			name => $karg,
-			type => 'TSIG',
-			key  => shift
-			);
-
-	} else {
+	} elsif ( ( scalar(@argument) % 2 ) == 0 ) {
 		require File::Spec;				# ( keyfile, options )
 		require Net::DNS::ZoneFile;
 		my ($keypath) = SYMLINK ? grep( {$_} readlink($karg), $karg ) : $karg;
@@ -351,20 +333,20 @@
 		my ( $keyname, $keytag ) = ( $1, $2 );
 
 		my $keyfile = Net::DNS::ZoneFile->new($karg);
-		my ( $algorithm, $secret, $x );
+		my ( $algorithm, $secret );
 		while ( $keyfile->_getline ) {
 			/^key "(^"+)"/     and $keyname   = $1;    # BIND tsig key
 			/algorithm (^;+);/ and $algorithm = $1;
 			/secret "(^"+)";/  and $secret    = $1;
 
-			/^Algorithm:/ and ( $x, $algorithm ) = split;	 # BIND dnssec private key
-			/^Key:/	      and ( $x, $secret )    = split;
+			/^Algorithm:/ and ( undef, $algorithm ) = split;    # BIND dnssec private key
+			/^Key:/	      and ( undef, $secret )	= split;
 
 			next unless /\bIN\s+KEY\b/;		# BIND dnssec public key
 			my $keyrr = Net::DNS::RR->new($_);
 			carp "$karg  does not appear to be a BIND dnssec public key"
-					unless $keytag and ( $keytag == $keyrr->keytag );
-			return $class->create( $keyrr, @_ );
+					unless $keyrr->keytag == ( $keytag || 0 );
+			return $class->create( $keyrr, @argument );
 		}
 
 		foreach ( $keyname, $algorithm, $secret ) {
@@ -376,41 +358,44 @@
 			type	  => 'TSIG',
 			algorithm => $algorithm,
 			key	  => $secret,
-			@_
+			@argument
 			);
 	}
+
+	croak "Usage:	$class->create( \$keyfile, \@options )";
 }
 
 
 sub verify {
-	my $self = shift;
-	my $data = shift;
+	my ( $self, $data, @link ) = @_;
+	my $fail = undef;
 
-	if ( scalar @_ ) {
-		my $arg = shift;
+	if ( scalar @link ) {
 
-		unless ( ref($arg) ) {
-			$self->error(16);			# BADSIG (multi-packet)
-			return;
+		my $link = shift @link;
+		unless ( ref($link) ) {
+			$self->error('BADSIG');			# (multi-packet)
+			return $fail;
 		}
 
 		my $signerkey = lc( join '+', $self->name, $self->algorithm );
-		if ( $arg->isa('Net::DNS::Packet') ) {
-			my $request = $arg->sigrr;		# request TSIG
+		if ( $link->isa('Net::DNS::Packet') ) {
+			my $request = $link->sigrr;		# request TSIG
 			my $rqstkey = lc( join '+', $request->name, $request->algorithm );
-			$self->error(17) unless $signerkey eq $rqstkey;			     # BADKEY
+			$self->error('BADKEY') unless $signerkey eq $rqstkey;
 			$self->request_macbin( $request->macbin );
 
-		} elsif ( $arg->isa(__PACKAGE__) ) {
-			my $priorkey = lc( join '+', $arg->name, $arg->algorithm );
-			$self->error(17) unless $signerkey eq $priorkey;		     # BADKEY
-			$self->prior_macbin( $arg->macbin );
+		} elsif ( $link->isa(__PACKAGE__) ) {
+			my $priorkey = lc( join '+', $link->name, $link->algorithm );
+			$self->error('BADKEY') unless $signerkey eq $priorkey;
+			$self->prior_macbin( $link->macbin );
 
 		} else {
 			croak 'Usage: $tsig->verify( $reply, $query )';
 		}
 	}
-	return if $self->{error};
+
+	return $fail if $self->{error};
 
 	my $sigdata = $self->sig_data($data);			# form data to be verified
 	my $tsigmac = $self->_mac_function($sigdata);
@@ -418,19 +403,23 @@
 
 	my $macbin = $self->macbin;
 	my $maclen = length $macbin;
+	$self->error('BADSIG') if $macbin ne substr $tsigmac, 0, $maclen;
+
 	my $minlen = length($tsigmac) >> 1;			# per RFC4635, 3.1
-	$self->error(16) if $macbin ne substr $tsigmac, 0, $maclen;			       # BADSIG
-	$self->error(22) if $maclen < $minlen or $maclen < 10 or $maclen > length $tsigmac;    # BADTRUNC
-	$self->error(18) if abs( time() - $self->time_signed ) > $self->fudge;		       # BADTIME
+	$self->error('BADTRUNC') if $maclen < $minlen or $maclen > length $tsigmac;
+	$self->error('BADTRUNC') if $maclen < 10;
 
-	return $self->{error} ? undef : $tsig;
-}
+	my $time_signed = $self->time_signed;
+	if ( abs( time() - $time_signed ) > $self->fudge ) {
+		$self->error('BADTIME');
+		$self->other($time_signed);
+	}
 
-sub vrfyerrstr {
-	my $self = shift;
-	return $self->error;
+	return $self->{error} ? $fail : $tsig;
 }
 
+sub vrfyerrstr { return shift->error; }
+
 
 ########################################
 
@@ -515,10 +504,10 @@
 
 
 	sub _keybin {			## install key in key table
-		my $self = shift;
-		croak 'Unauthorised access to TSIG key material denied' unless scalar @_;
+		my ( $self, @argument ) = @_;
+		croak 'access to TSIG key material denied' unless scalar @argument;
 		my $keyref  = $keytable{$self->{owner}->canonical} ||= {};
-		my $private = shift;				# closure keeps private key private
+		my $private = shift @argument;			# closure keeps private key private
 		$keyref->{key} = sub {
 			my $function = $keyref->{digest};
 			return &$function( $private, @_ );
@@ -528,14 +517,13 @@
 
 
 	sub _mac_function {		## apply keyed hash function to argument
-		my $self = shift;
-
+		my ( $self, @argument ) = @_;
 		my $owner = $self->{owner}->canonical;
 		$self->algorithm( $self->algorithm ) unless $keytable{$owner}{digest};
 		my $keyref = $keytable{$owner};
 		$keyref->{digest} = $self->sig_function unless $keyref->{digest};
 		my $function = $keyref->{key};
-		return &$function(@_);
+		return &$function(@argument);
 	}
 }
 
@@ -776,7 +764,7 @@
 
 =head1 BUGS
 
-A 32-bit representation of time is used, contrary to RFC2845 which
+A 32-bit representation of time is used, contrary to RFC8945 which
 demands 48 bits.  This design decision will need to be reviewed
 before the code stops working on 7 February 2106.
 
@@ -815,7 +803,8 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC8945
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC8945|https://tools.ietf.org/html/rfc8945>
 
 L<TSIG Algorithm Names|http://www.iana.org/assignments/tsig-algorithm-names>

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/TXT.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/TXT.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: TXT.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: TXT.pm 1911 2023-04-17 12:30:59Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -22,8 +22,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	my $limit = $offset + $self->{rdlength};
 	my $text;
@@ -55,17 +54,17 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->{txtdata} = map { Net::DNS::Text->new($_) } @_;
+	$self->{txtdata} = map { Net::DNS::Text->new($_) } @argument;
 	return;
 }
 
 
 sub txtdata {
-	my $self = shift;
+	my ( $self, @value ) = @_;
 
-	$self->{txtdata} = map { Net::DNS::Text->new($_) } @_ if scalar @_;
+	$self->{txtdata} = map { Net::DNS::Text->new($_) } @value if scalar @value;
 
 	my $txtdata = $self->{txtdata} || ;
 
@@ -75,7 +74,7 @@
 }
 
 
-sub char_str_list { return (&txtdata); }			# uncoverable pod
+sub char_str_list { return my @txt = &txtdata }			# uncoverable pod
 
 
 1;
@@ -158,6 +157,8 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1035 Section 3.3.14, RFC3629
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC1035(3.3.14)|https://tools.ietf.org/html/rfc1035>
+L<RFC3629|https://tools.ietf.org/html/rfc3629>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/URI.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/URI.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: URI.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: URI.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -19,8 +19,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	my $limit = $offset + $self->{rdlength};
 	@{$self}{qw(priority weight)} = unpack( "\@$offset n2", $$data );
@@ -48,33 +47,30 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->$_(shift) foreach qw(priority weight target);
+	for (qw(priority weight target)) { $self->$_( shift @argument ) }
 	return;
 }
 
 
 sub priority {
-	my $self = shift;
-
-	$self->{priority} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{priority} = 0 + $_ }
 	return $self->{priority} || 0;
 }
 
 
 sub weight {
-	my $self = shift;
-
-	$self->{weight} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{weight} = 0 + $_ }
 	return $self->{weight} || 0;
 }
 
 
 sub target {
-	my $self = shift;
-
-	$self->{target} = Net::DNS::Text->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{target} = Net::DNS::Text->new($_) }
 	return $self->{target} ? $self->{target}->value : undef;
 }
 
@@ -174,7 +170,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, 
-RFC7553
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC7553|https://tools.ietf.org/html/rfc7553>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/X25.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/X25.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: X25.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: X25.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -19,8 +19,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	$self->{address} = Net::DNS::Text->decode( $data, $offset );
 	return;
@@ -42,17 +41,16 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->address(shift);
+	$self->address(@argument);
 	return;
 }
 
 
 sub address {
-	my $self = shift;
-
-	$self->{address} = Net::DNS::Text->new(shift) if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{address} = Net::DNS::Text->new($_) }
 	return $self->{address} ? $self->{address}->value : undef;
 }
 
@@ -125,6 +123,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1183 Section 3.1
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC1183(3.1)|https://tools.ietf.org/html/rfc1183>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/RR/ZONEMD.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/RR/ZONEMD.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: ZONEMD.pm 1857 2021-12-07 13:38:02Z willem $)2;
+our $VERSION = (qw$Id: ZONEMD.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 use base qw(Net::DNS::RR);
 
@@ -19,8 +19,7 @@
 
 
 sub _decode_rdata {			## decode rdata from wire-format octet string
-	my $self = shift;
-	my ( $data, $offset ) = @_;
+	my ( $self, $data, $offset ) = @_;
 
 	my $rdata = substr $$data, $offset, $self->{rdlength};
 	@{$self}{qw(serial scheme algorithm digestbin)} = unpack 'NC2a*', $rdata;
@@ -45,12 +44,10 @@
 
 
 sub _parse_rdata {			## populate RR from rdata in argument list
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	$self->serial(shift);
-	$self->scheme(shift);
-	$self->algorithm(shift);
-	$self->digest(@_);
+	for (qw(serial scheme algorithm)) { $self->$_( shift @argument ) }
+	$self->digest(@argument);
 	return;
 }
 
@@ -64,40 +61,37 @@
 
 
 sub serial {
-	my $self = shift;
-
-	$self->{serial} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{serial} = 0 + $_ }
 	return $self->{serial} || 0;
 }
 
 
 sub scheme {
-	my $self = shift;
-
-	$self->{scheme} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{scheme} = 0 + $_ }
 	return $self->{scheme} || 0;
 }
 
 
 sub algorithm {
-	my $self = shift;
-
-	$self->{algorithm} = 0 + shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{algorithm} = 0 + $_ }
 	return $self->{algorithm} || 0;
 }
 
 
 sub digest {
-	my $self = shift;
-	return unpack "H*", $self->digestbin() unless scalar @_;
-	return $self->digestbin( pack "H*", join "", map { /^"*(\dA-Fa-f*)"*$/ || croak("corrupt hex"); $1 } @_ );
+	my ( $self, @value ) = @_;
+	return unpack "H*", $self->digestbin() unless scalar @value;
+	my @hex = map { /^"*(\dA-Fa-f*)"*$/ || croak("corrupt hex"); $1 } @value;
+	return $self->digestbin( pack "H*", join "", @hex );
 }
 
 
 sub digestbin {
-	my $self = shift;
-
-	$self->{digestbin} = shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{digestbin} = $_ }
 	return $self->{digestbin} || "";
 }
 
@@ -196,6 +190,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC8976
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC8976|https://tools.ietf.org/html/rfc8976>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/Resolver.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/Resolver.pm Changed

@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-our $VERSION = (qw$Id: Resolver.pm 1855 2021-11-26 11:33:48Z willem $)2;
+our $VERSION = (qw$Id: Resolver.pm 1895 2023-01-16 13:38:08Z willem $)2;
 
 
 =head1 NAME
@@ -254,7 +254,7 @@
 Here is an example that uses a timeout and TSIG verification:
 
     $resolver->tcp_timeout( 10 );
-    $resolver->tsig( 'Khmac-sha1.example.+161+24053.private' );
+    $resolver->tsig( $keyfile );
     @zone = $resolver->axfr( 'example.com' );
 
     foreach $rr (@zone) {
@@ -274,7 +274,7 @@
 Here is the example above, implemented using an iterator:
 
     $resolver->tcp_timeout( 10 );
-    $resolver->tsig( 'Khmac-sha1.example.+161+24053.private' );
+    $resolver->tsig( $keyfile );
     $iterator = $resolver->axfr( 'example.com' );
 
     while ( $rr = $iterator->() ) {
@@ -602,17 +602,13 @@
 
 =head2 tsig
 
-    $resolver->tsig( $tsig );
+    $resolver->tsig( $keyfile );
 
-    $resolver->tsig( 'Khmac-sha1.example.+161+24053.private' );
-
-    $resolver->tsig( 'Khmac-sha1.example.+161+24053.key' );
-
-    $resolver->tsig( 'Khmac-sha1.example.+161+24053.key',
+    $resolver->tsig( $keyfile,
 		fudge => 60
 		);
 
-    $resolver->tsig( $key_name, $key );
+    $resolver->tsig( $tsig_rr );
 
     $resolver->tsig( undef );
 
@@ -753,9 +749,11 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::Packet>, L<Net::DNS::Update>,
-L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
-L<resolver(5)>, RFC 1034, RFC 1035
+L<perl> L<Net::DNS> L<Net::DNS::Packet> L<Net::DNS::Update>
+L<Net::DNS::Header> L<Net::DNS::Question> L<Net::DNS::RR>
+L<resolver(5)>
+L<RFC1034|https://tools.ietf.org/html/rfc1034>
+L<RFC1035|https://tools.ietf.org/html/rfc1035>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/Resolver/Base.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/Resolver/Base.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: Base.pm 1864 2022-04-14 15:18:49Z willem $)2;
+our $VERSION = (qw$Id: Base.pm 1910 2023-03-30 19:16:30Z willem $)2;
 
 
 #
@@ -25,7 +25,7 @@
 # Revised March 2016, June 2018
 
 
-use constant USE_SOCKET_IP => defined eval 'use IO::Socket::IP 0.38; 1;';	## no critic
+use constant USE_SOCKET_IP => defined eval 'use IO::Socket::IP 0.38; 1;';    ## no critic
 require IO::Socket::INET unless USE_SOCKET_IP;
 
 use constant IPv6 => USE_SOCKET_IP;
@@ -98,20 +98,21 @@
 my %warned;
 
 sub _deprecate {
-	my $msg = pop(@_);
-	carp join ' ', 'deprecated method;', $msg unless $warned{$msg}++;
+	my ( undef, @note ) = @_;
+	carp join ' ', 'deprecated method;', "@note" unless $warned{"@note"}++;
 	return;
 }
 
 
-sub _untaint {
+sub _untaint {				## no critic		# recurses into user list arguments
 	return TAINT ? map { ref($_) ? _untaint(@$_) : do { /^(.*)$/; $1 } } @_ : @_;
 }
 
 
 # These are the attributes that the user may specify in the new() constructor.
 my %public_attr = (
-	map { $_ => $_ } keys %{&_defaults}, qw(domain nameserver srcaddr),
+	map { $_ => $_ } keys %{&_defaults},
+	qw(domain nameserver srcaddr),
 	map { $_ => 0 } qw(nameserver4 nameserver6 srcaddr4 srcaddr6),
 	);
 
@@ -128,7 +129,7 @@
 	if ( my $file = $args{config_file} ) {
 		my $conf = bless {@$initial}, $class;
 		$conf->_read_config_file($file);		# user specified config
-		$self = bless {_untaint(%$conf)}, $class;
+		$self  = bless {_untaint(%$conf)}, $class;
 		%$base = %$self unless $init;			# define default configuration
 
 	} elsif ($init) {
@@ -187,8 +188,7 @@
 
 
 sub _read_config_file {			## read resolver config file
-	my $self = shift;
-	my $file = shift;
+	my ( $self, $file ) = @_;
 
 	my $filehandle = IO::File->new( $file, '<' ) or croak "$file: $!";
 
@@ -237,8 +237,8 @@
 	my $self = shift;
 	$self = $self->_defaults unless ref($self);
 
-	my @nslist = $self->nameservers();
-	my ($force)  = ( grep( { $self->{$_} } qw(force_v6 force_v4) ),   'force_v4' );
+	my @nslist   = $self->nameservers();
+	my ($force)  = ( grep( { $self->{$_} } qw(force_v6 force_v4) ),	  'force_v4' );
 	my ($prefer) = ( grep( { $self->{$_} } qw(prefer_v6 prefer_v4) ), 'prefer_v4' );
 	return <<END;
 ;; RESOLVER state:
@@ -266,26 +266,22 @@
 	my ( $self, @domain ) = @_;
 	$self = $self->_defaults unless ref($self);
 
-	if ( scalar(@domain) || !defined(wantarray) ) {
-		foreach (@domain) { $_ = Net::DNS::Domain->new($_)->name }
-		$self->{searchlist} = @domain;
-	}
-
-	return ( @{$self->{searchlist}} );
+	foreach (@domain) { $_ = Net::DNS::Domain->new($_)->name }
+	$self->{searchlist} = \@domain if scalar(@domain);
+	return @{$self->{searchlist}};
 }
 
 sub domain {
-	my ($head) = &searchlist;
-	return wantarray ? ( grep {defined} $head ) : $head;
+	return (&searchlist)0;
 }
 
 
 sub nameservers {
-	my $self = shift;
+	my ( $self, @ns ) = @_;
 	$self = $self->_defaults unless ref($self);
 
 	my @ip;
-	foreach my $ns ( grep {defined} @_ ) {
+	foreach my $ns ( grep {defined} @ns ) {
 		if ( _ipv4($ns) || _ipv6($ns) ) {
 			push @ip, $ns;
 
@@ -311,7 +307,7 @@
 		}
 	}
 
-	if ( scalar(@_) || !defined(wantarray) ) {
+	if ( scalar(@ns) || !defined(wantarray) ) {
 		my @ipv4 = grep { _ipv4($_) } @ip;
 		my @ipv6 = grep { _ipv6($_) } @ip;
 		$self->{nameservers} = \@ip;
@@ -321,6 +317,7 @@
 
 	my @ns4 = $self->{force_v6} ? () : @{$self->{nameserver4}};
 	my @ns6 = $self->{force_v4} ? () : @{$self->{nameserver6}};
+
 	my @nameservers = @{$self->{nameservers}};
 	@nameservers = ( @ns4, @ns6 ) if $self->{prefer_v4} || !scalar(@ns6);
 	@nameservers = ( @ns6, @ns4 ) if $self->{prefer_v6} || !scalar(@ns4);
@@ -343,7 +340,7 @@
 	# Out of bailiwick will fail.
 	my @null;
 	my $packet = shift || return @null;
-	my $names = shift;
+	my $names  = shift;
 
 	$names->{lc( $_->qname )}++ foreach $packet->question;
 	$names->{lc( $_->cname )}++ foreach grep { $_->can('cname') } $packet->answer;
@@ -362,7 +359,6 @@
 
 sub _reset_errorstring {
 	shift->{errorstring} = '';
-	$! = $@ = undef;
 	return;
 }
 
@@ -375,24 +371,24 @@
 
 
 sub query {
-	my $self = shift;
-	my $name = shift || '.';
+	my ( $self, @argument ) = @_;
 
+	my $name = shift(@argument) || '.';
 	my @sfix = $self->{defnames} && ( $name !~ m/.:/ ) ? $self->domain : ();
 
 	my $fqdn = join '.', $name, @sfix;
-	$self->_diag( 'query(', $fqdn, @_, ')' );
-	my $packet = $self->send( $fqdn, @_ ) || return;
+	$self->_diag( 'query(', $fqdn, @argument, ')' );
+	my $packet = $self->send( $fqdn, @argument ) || return;
 	return $packet->header->ancount ? $packet : undef;
 }
 
 
 sub search {
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	return $self->query(@_) unless $self->{dnsrch};
+	return $self->query(@argument) unless $self->{dnsrch};
 
-	my $name = shift || '.';
+	my $name = shift(@argument) || '.';
 	my $dots = $name =~ tr/././;
 
 	my @sfix = ( $dots < $self->{ndots} ) ? @{$self->{searchlist}} : ();
@@ -400,8 +396,8 @@
 
 	foreach my $suffix ( $one, @more ) {
 		my $fqname = $suffix ? join( '.', $name, $suffix ) : $name;
-		$self->_diag( 'search(', $fqname, @_, ')' );
-		my $packet = $self->send( $fqname, @_ ) || next;
+		$self->_diag( 'search(', $fqname, @argument, ')' );
+		my $packet = $self->send( $fqname, @argument ) || next;
 		return $packet if $packet->header->ancount;
 	}
 
@@ -410,8 +406,8 @@
 
 
 sub send {
-	my $self	= shift;
-	my $packet	= $self->_make_query_packet(@_);
+	my ( $self, @argument ) = @_;
+	my $packet	= $self->_make_query_packet(@argument);
 	my $packet_data = $packet->data;
 
 	$self->_reset_errorstring;
@@ -479,7 +475,7 @@
 	my @ns	    = $self->nameservers;
 	my $port    = $self->{port};
 	my $retrans = $self->{retrans} || 1;
-	my $retry   = $self->{retry} || 1;
+	my $retry   = $self->{retry}   || 1;
 	my $servers = scalar(@ns);
 	my $timeout = $servers ? do { no integer; $retrans / $servers } : 0;
 	my $fallback;
@@ -494,23 +490,23 @@
 
 			# state vector replaces corresponding element of @ns array
 			unless ( ref $ns ) {
-				my $dst_sockaddr = $self->_create_dst_sockaddr( $ns, $port );
-				my $socket = $self->_create_udp_socket($ns) || next;
-				$ns = $socket, $ns, $dst_sockaddr;
+				my $sockaddr = $self->_create_dst_sockaddr( $ns, $port );
+				my $socket   = $self->_create_udp_socket($ns) || next;
+				$ns = $socket, $ns, $sockaddr;
 			}
 
-			my ( $socket, $ip, $dst_sockaddr, $failed ) = @$ns;
+			my ( $socket, $ip, $sockaddr, $failed ) = @$ns;
 			next if $failed;
 
 			$self->_diag( 'udp send', "$ip:$port" );
 
 			$select->add($socket);
-			$socket->send( $query_data, 0, $dst_sockaddr );
+			$socket->send( $query_data, 0, $sockaddr );
 			$self->errorstring( $$ns3 = $! );
 
 			# handle failure to detect taint inside socket->send()
 			die 'Insecure dependency while running with -T switch'
-					if TESTS && Scalar::Util::tainted($dst_sockaddr);
+					if TESTS && Scalar::Util::tainted($sockaddr);
 
 			my $reply;
 			while ( my ($socket) = $select->can_read($timeout) ) {
@@ -552,8 +548,8 @@
 
 
 sub bgsend {
-	my $self	= shift;
-	my $packet	= $self->_make_query_packet(@_);
+	my ( $self, @argument ) = @_;
+	my $packet	= $self->_make_query_packet(@argument);
 	my $packet_data = $packet->data;
 
 	$self->_reset_errorstring;
@@ -598,7 +594,7 @@
 
 	foreach my $ip ( $self->nameservers ) {
 		my $sockaddr = $self->_create_dst_sockaddr( $ip, $port );
-		my $socket = $self->_create_udp_socket($ip) || next;
+		my $socket   = $self->_create_udp_socket($ip) || next;
 
 		$self->_diag( 'bgsend', "$ip:$port" );
 
@@ -618,7 +614,7 @@
 }
 
 
-sub bgbusy {
+sub bgbusy {				## no critic		# overwrites user UDP handle
 	my ( $self, $handle ) = @_;
 	return unless $handle;
 
@@ -639,19 +635,20 @@
 
 	$self->_diag('packet truncated: retrying using TCP');
 	my $tcp = $self->_bgsend_tcp( $query, $query->data ) || return;
-	return defined( $_1 = $tcp );
+	return defined( $_1 = $tcp );				# caller's UDP handle now TCP
 }
 
 
 sub bgisready {				## historical
-	_deprecate('prefer  ! bgbusy(...)');			# uncoverable pod
+	__PACKAGE__->_deprecate('prefer ! bgbusy(...)');	# uncoverable pod
 	return !&bgbusy;
 }
 
 
 sub bgread {
+	my ( $self, $handle ) = @_;
 	while (&bgbusy) {					# side effect: TCP retry
-		IO::Select->new( $_1 )->can_read(0.02);	# reduce my CPU usage by 3 orders of magnitude
+		IO::Select->new($handle)->can_read(0.02);	# reduce my CPU usage by 3 orders of magnitude
 	}
 	return &_bgread;
 }
@@ -673,7 +670,7 @@
 
 	my $peer = $self->{replyfrom} = $handle->peerhost;
 
-	my $dgram = $handle->socktype() == SOCK_DGRAM;
+	my $dgram  = $handle->socktype() == SOCK_DGRAM;
 	my $buffer = $dgram ? _read_udp( $handle, $self->_packetsz ) : _read_tcp($handle);
 	$self->_diag( "reply from $peer", length($buffer), 'bytes' );
 
@@ -703,11 +700,15 @@
 
 
 sub axfr {				## zone transfer
-	return eval {
-		my $self = shift;
+	my ( $self, @argument ) = @_;
+	my $zone  = scalar(@argument) ? shift @argument : $self->domain;
+	my @class = @argument;
 
-		# initialise iterator state vector
-		my ( $select, $verify, @rr, $soa ) = $self->_axfr_start(@_);
+	my $request = $self->_make_query_packet( $zone, 'AXFR', @class );
+
+	return eval {
+		$self->_diag("axfr( $zone @class )");
+		my ( $select, $verify, @rr, $soa ) = $self->_axfr_start($request);
 
 		my $iterator = sub {	## iterate over RRs
 			my $rr = shift(@rr);
@@ -715,7 +716,7 @@
 			if ( ref($rr) eq 'Net::DNS::RR::SOA' ) {
 				if ($soa) {
 					$select = undef;
-					return if $rr->encode eq $soa->encode;
+					return if $rr->canonical eq $soa->canonical;
 					croak $self->errorstring('mismatched final SOA');
 				}
 				$soa = $rr;
@@ -743,33 +744,31 @@
 
 
 sub axfr_start {			## historical
-	_deprecate('prefer  $iterator = $self->axfr(...)');	# uncoverable pod
-	my $self = shift;
-	return defined( $self->{axfr_iter} = $self->axfr(@_) );
+	my ( $self, @argument ) = @_;				# uncoverable pod
+	$self->_deprecate('prefer  $iterator = $self->axfr(...)');
+	my $iterator = $self->axfr(@argument);
+	( $self->{axfr_iter} ) = grep {defined} ( $iterator, sub {} );
+	return defined($iterator);
 }
 
 
 sub axfr_next {				## historical
-	_deprecate('prefer  $iterator->()');			# uncoverable pod
-	return shift->{axfr_iter}->();
+	my $self = shift;					# uncoverable pod
+	$self->_deprecate('prefer  $iterator->()');
+	return $self->{axfr_iter}->();
 }
 
 
 sub _axfr_start {
-	my $self  = shift;
-	my $dname = scalar(@_) ? shift : $self->domain;
-	my @class = @_;
-
-	my $request = $self->_make_query_packet( $dname, 'AXFR', @class );
+	my ( $self, $request ) = @_;
 	my $content = $request->data;
 	my $TCP_msg = pack 'n a*', length($content), $content;
 
-	$self->_diag("axfr( $dname @class )");
-
 	my ( $select, $reply, $rcode );
 	foreach my $ns ( $self->nameservers ) {
 		$self->_diag("axfr send $ns");
 
+		local $self->{persistent_tcp};
 		my $socket = $self->_create_tcp_socket($ns);
 		$self->errorstring($!);
 		$select = IO::Select->new( $socket || next );
@@ -793,7 +792,7 @@
 
 	my $verifyok = $reply->verify($verify);
 	croak $self->errorstring( $reply->verifyerr ) unless $verifyok;
-	croak $self->errorstring unless $rcode eq 'NOERROR';
+	croak $self->errorstring if $rcode ne 'NOERROR';
 	return ( $select, $verifyok, $reply->answer );
 }
 
@@ -830,7 +829,7 @@
 	my $size = unpack 'n', pack( 'a*a*@2', $s1, $s2 );
 
 	my $buffer = '';
-	for (;;) {
+	for ( ; ; ) {
 		my $fragment;
 		$socket->recv( $fragment, $size - length($buffer) );
 		last unless length( $buffer .= $fragment || last ) < $size;
@@ -851,12 +850,10 @@
 
 
 sub _create_tcp_socket {
-	my $self = shift;
-	my $ip	 = shift;
+	my ( $self, $ip ) = @_;
 
-	my $sock_key = "TCP$ip";
 	my $socket;
-
+	my $sock_key = "TCP$ip";
 	if ( $socket = $self->{persistent}{$sock_key} ) {
 		$self->_diag( 'using persistent socket', $sock_key );
 		return $socket if $socket->connected;
@@ -864,7 +861,6 @@
 	}
 
 	my $ip6_addr = IPv6 && _ipv6($ip);
-
 	$socket = IO::Socket::IP->new(
 		LocalAddr => $ip6_addr ? $self->{srcaddr6} : $self->{srcaddr4},
 		LocalPort => $self->{srcport},
@@ -887,20 +883,19 @@
 				unless $ip6_addr;
 	}
 
-	$self->{persistent}{$sock_key} = $self->{persistent_tcp} ? $socket : undef;
+	$self->{persistent}{$sock_key} = $socket if $self->{persistent_tcp};
 	return $socket;
 }
 
 
 sub _create_udp_socket {
-	my $self = shift;
-	my $ip	 = shift;
+	my ( $self, $ip ) = @_;
 
-	my $ip6_addr = IPv6 && _ipv6($ip);
-	my $sock_key = IPv6 && $ip6_addr ? 'UDP/IPv6' : 'UDP/IPv4';
 	my $socket;
+	my $sock_key = "UDP$ip";
 	return $socket if $socket = $self->{persistent}{$sock_key};
 
+	my $ip6_addr = IPv6 && _ipv6($ip);
 	$socket = IO::Socket::IP->new(
 		LocalAddr => $ip6_addr ? $self->{srcaddr6} : $self->{srcaddr4},
 		LocalPort => $self->{srcport},
@@ -919,7 +914,7 @@
 				unless $ip6_addr;
 	}
 
-	$self->{persistent}{$sock_key} = $self->{persistent_udp} ? $socket : undef;
+	$self->{persistent}{$sock_key} = $socket if $self->{persistent_udp};
 	return $socket;
 }
 
@@ -929,8 +924,18 @@
 	use constant AI_NUMERICHOST => Socket::AI_NUMERICHOST;
 	use constant IPPROTO_UDP    => Socket::IPPROTO_UDP;
 
-	my $ip4 = {family => AF_INET,  flags => AI_NUMERICHOST, protocol => IPPROTO_UDP, socktype => SOCK_DGRAM};
-	my $ip6 = {family => AF_INET6, flags => AI_NUMERICHOST, protocol => IPPROTO_UDP, socktype => SOCK_DGRAM};
+	my $ip4 = {
+		family	 => AF_INET,
+		flags	 => AI_NUMERICHOST,
+		protocol => IPPROTO_UDP,
+		socktype => SOCK_DGRAM
+		};
+	my $ip6 = {
+		family	 => AF_INET6,
+		flags	 => AI_NUMERICHOST,
+		protocol => IPPROTO_UDP,
+		socktype => SOCK_DGRAM
+		};
 
 	sub _create_dst_sockaddr {	## create UDP destination sockaddr structure
 		my ( $self, $ip, $port ) = @_;
@@ -957,7 +962,7 @@
 
 sub _ipv6 {
 	for (shift) {
-		last unless m/:.*:/;				# must contain two colons
+		last	 unless m/:.*:/;			# must contain two colons
 		return 1 unless m/^:0-9A-Fa-f/;		# colons and hexdigits only
 		return 1 if m/^:.0-9A-Fa-f+\%.+$/;		# RFC4007 scoped address
 		return m/^:0-9A-Fa-f+:.0-9+$/;		# prefix : dotted digits
@@ -967,15 +972,15 @@
 
 
 sub _make_query_packet {
-	my $self = shift;
+	my ( $self, @argument ) = @_;
 
-	my ($packet) = @_;
+	my ($packet) = @argument;
 	if ( ref($packet) ) {
 		my $edns = $packet->edns;			# advertise UDPsize for local stack
-		$edns->size( $self->{udppacketsize} ) unless defined $edns->{size};
+		$edns->udpsize( $self->{udppacketsize} ) unless defined $edns->{udpsize};
 	} else {
-		$packet = Net::DNS::Packet->new(@_);
-		$packet->edns->size( $self->{udppacketsize} );
+		$packet = Net::DNS::Packet->new(@argument);
+		$packet->edns->udpsize( $self->{udppacketsize} );
 
 		my $header = $packet->header;
 		$header->ad( $self->{adflag} );			# RFC6840, 5.7
@@ -993,58 +998,57 @@
 
 
 sub dnssec {
-	my $self = shift;
-
-	return $self->{dnssec} unless scalar @_;
-
-	# increase default udppacket size if flag set
-	$self->udppacketsize(2048) if $self->{dnssec} = shift;
-
+	my ( $self, @argument ) = @_;
+	for (@argument) {
+		$self->udppacketsize(1232);
+		$self->{dnssec} = $_;
+	}
 	return $self->{dnssec};
 }
 
 
 sub force_v6 {
-	my $self = shift;
-	my $value = scalar(@_) ? $_0 : $self->{force_v6};
-	return $self->{force_v6} = $value ? do { $self->{force_v4} = 0; 1 } : 0;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{force_v4} = 0 if $self->{force_v6} = $_ }
+	return $self->{force_v6} ? 1 : 0;
 }
 
 sub force_v4 {
-	my $self = shift;
-	my $value = scalar(@_) ? $_0 : $self->{force_v4};
-	return $self->{force_v4} = $value ? do { $self->{force_v6} = 0; 1 } : 0;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{force_v6} = 0 if $self->{force_v4} = $_ }
+	return $self->{force_v4} ? 1 : 0;
 }
 
 sub prefer_v6 {
-	my $self = shift;
-	my $value = scalar(@_) ? $_0 : $self->{prefer_v6};
-	return $self->{prefer_v6} = $value ? do { $self->{prefer_v4} = 0; 1 } : 0;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{prefer_v4} = 0 if $self->{prefer_v6} = $_ }
+	return $self->{prefer_v6} ? 1 : 0;
 }
 
 sub prefer_v4 {
-	my $self = shift;
-	my $value = scalar(@_) ? $_0 : $self->{prefer_v4};
-	return $self->{prefer_v4} = $value ? do { $self->{prefer_v6} = 0; 1 } : 0;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{prefer_v6} = 0 if $self->{prefer_v4} = $_ }
+	return $self->{prefer_v4} ? 1 : 0;
 }
 
-
 sub srcaddr {
-	my $self = shift;
-	for (@_) {
+	my ( $self, @value ) = @_;
+	for (@value) {
 		my $hashkey = _ipv6($_) ? 'srcaddr6' : 'srcaddr4';
 		$self->{$hashkey} = $_;
 	}
-	return shift;
+	return shift @value;
 }
 
 
 sub tsig {
-	my $self = shift;
+	my ( $self, $arg, @etc ) = @_;
 	$self->{tsig_rr} = eval {
+		return $arg unless $arg;
+		return $arg if ref($arg) eq 'Net::DNS::RR::TSIG';
 		local $SIG{__DIE__};
 		require Net::DNS::RR::TSIG;
-		Net::DNS::RR::TSIG->create(@_);
+		Net::DNS::RR::TSIG->create( $arg, @etc );
 	};
 	croak "${@}unable to create TSIG record" if $@;
 	return;
@@ -1060,8 +1064,8 @@
 }
 
 sub udppacketsize {
-	my $self = shift;
-	$self->{udppacketsize} = shift if scalar @_;
+	my ( $self, @value ) = @_;
+	for (@value) { $self->{udppacketsize} = $_ }
 	return $self->_packetsz;
 }
 
@@ -1070,7 +1074,7 @@
 # Keep this method around. Folk depend on it although it is neither documented nor exported.
 #
 sub make_query_packet {			## historical
-	_deprecate('see RT#37104');				# uncoverable pod
+	__PACKAGE__->_deprecate('see RT#37104');		# uncoverable pod
 	return &_make_query_packet;
 }
 
@@ -1089,13 +1093,13 @@
 		my @rr	= $dug->read;
 
 		my @auth = grep { $_->type eq 'NS' } @rr;
-		my %auth = map { lc $_->nsdname => 1 } @auth;
+		my %auth = map	{ lc $_->nsdname => 1 } @auth;
 		my %glue;
 		my @glue = grep { $auth{lc $_->name} } @rr;
 		foreach ( grep { $_->can('address') } @glue ) {
 			push @{$glue{lc $_->name}}, $_->address;
 		}
-		map { @$_ } values %glue;
+		map {@$_} values %glue;
 	};
 
 	my @ip;
@@ -1108,18 +1112,17 @@
 }
 
 
-our $AUTOLOAD;
-
 sub DESTROY { }				## Avoid tickling AUTOLOAD (in cleanup)
 
 sub AUTOLOAD {				## Default method
 	my ($self) = @_;
 
+	no strict 'refs';		## no critic ProhibitNoStrict
+	our $AUTOLOAD;
 	my $name = $AUTOLOAD;
 	$name =~ s/.*://;
 	croak qqunknown method "$name" unless $public_attr{$name};
 
-	no strict 'refs';		## no critic ProhibitNoStrict
 	*{$AUTOLOAD} = sub {
 		my $self = shift;
 		$self = $self->_defaults unless ref($self);
@@ -1127,7 +1130,7 @@
 		return $self->{$name};
 	};
 
-	goto &{$AUTOLOAD};
+	return &$AUTOLOAD;
 }
 
 
@@ -1198,7 +1201,7 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::Resolver>
+L<perl> L<Net::DNS> L<Net::DNS::Resolver>
 
 =cut
 
@@ -1207,64 +1210,65 @@
 
 __DATA__	## DEFAULT HINTS
 
-; <<>> DiG 9.11.4-RedHat-9.11.4-4.fc28 <<>> @b.root-servers.net . -t NS
+; <<>> DiG 9.18.8 <<>> @b.root-servers.net . -t NS
 ; (2 servers found)
 ;; global options: +cmd
 ;; Got answer:
-;; ->>HEADER<<- opcode: QUERY, status: NOERROR, id: 44111
+;; ->>HEADER<<- opcode: QUERY, status: NOERROR, id: 4847
 ;; flags: qr aa rd; QUERY: 1, ANSWER: 13, AUTHORITY: 0, ADDITIONAL: 27
 ;; WARNING: recursion requested but not available
 
 ;; OPT PSEUDOSECTION:
-; EDNS: version: 0, flags:; udp: 4096
+; EDNS: version: 0, flags:; udp: 1232
+; COOKIE: 93d86b753941ac2f0100000063c009ad51783c108e36cf16 (good)
 ;; QUESTION SECTION:
 ;.				IN	NS
 
 ;; ANSWER SECTION:
-.			518400	IN	NS	c.root-servers.net.
-.			518400	IN	NS	k.root-servers.net.
-.			518400	IN	NS	l.root-servers.net.
-.			518400	IN	NS	j.root-servers.net.
+.			518400	IN	NS	a.root-servers.net.
 .			518400	IN	NS	b.root-servers.net.
-.			518400	IN	NS	g.root-servers.net.
-.			518400	IN	NS	h.root-servers.net.
+.			518400	IN	NS	c.root-servers.net.
 .			518400	IN	NS	d.root-servers.net.
-.			518400	IN	NS	a.root-servers.net.
+.			518400	IN	NS	e.root-servers.net.
 .			518400	IN	NS	f.root-servers.net.
+.			518400	IN	NS	g.root-servers.net.
+.			518400	IN	NS	h.root-servers.net.
 .			518400	IN	NS	i.root-servers.net.
+.			518400	IN	NS	j.root-servers.net.
+.			518400	IN	NS	k.root-servers.net.
+.			518400	IN	NS	l.root-servers.net.
 .			518400	IN	NS	m.root-servers.net.
-.			518400	IN	NS	e.root-servers.net.
 
 ;; ADDITIONAL SECTION:
-a.root-servers.net.	3600000	IN	A	198.41.0.4
-b.root-servers.net.	3600000	IN	A	199.9.14.201
-c.root-servers.net.	3600000	IN	A	192.33.4.12
-d.root-servers.net.	3600000	IN	A	199.7.91.13
-e.root-servers.net.	3600000	IN	A	192.203.230.10
-f.root-servers.net.	3600000	IN	A	192.5.5.241
-g.root-servers.net.	3600000	IN	A	192.112.36.4
-h.root-servers.net.	3600000	IN	A	198.97.190.53
-i.root-servers.net.	3600000	IN	A	192.36.148.17
-j.root-servers.net.	3600000	IN	A	192.58.128.30
-k.root-servers.net.	3600000	IN	A	193.0.14.129
-l.root-servers.net.	3600000	IN	A	199.7.83.42
-m.root-servers.net.	3600000	IN	A	202.12.27.33
-a.root-servers.net.	3600000	IN	AAAA	2001:503:ba3e::2:30
-b.root-servers.net.	3600000	IN	AAAA	2001:500:200::b
-c.root-servers.net.	3600000	IN	AAAA	2001:500:2::c
-d.root-servers.net.	3600000	IN	AAAA	2001:500:2d::d
-e.root-servers.net.	3600000	IN	AAAA	2001:500:a8::e
-f.root-servers.net.	3600000	IN	AAAA	2001:500:2f::f
-g.root-servers.net.	3600000	IN	AAAA	2001:500:12::d0d
-h.root-servers.net.	3600000	IN	AAAA	2001:500:1::53
-i.root-servers.net.	3600000	IN	AAAA	2001:7fe::53
-j.root-servers.net.	3600000	IN	AAAA	2001:503:c27::2:30
-k.root-servers.net.	3600000	IN	AAAA	2001:7fd::1
-l.root-servers.net.	3600000	IN	AAAA	2001:500:9f::42
-m.root-servers.net.	3600000	IN	AAAA	2001:dc3::35
-
-;; Query time: 173 msec
-;; SERVER: 199.9.14.201#53(199.9.14.201)
-;; WHEN: Fri Aug 10 19:03:11 BST 2018
-;; MSG SIZE  rcvd: 811
+a.root-servers.net.	518400	IN	A	198.41.0.4
+a.root-servers.net.	518400	IN	AAAA	2001:503:ba3e::2:30
+b.root-servers.net.	518400	IN	A	199.9.14.201
+b.root-servers.net.	518400	IN	AAAA	2001:500:200::b
+c.root-servers.net.	518400	IN	A	192.33.4.12
+c.root-servers.net.	518400	IN	AAAA	2001:500:2::c
+d.root-servers.net.	518400	IN	A	199.7.91.13
+d.root-servers.net.	518400	IN	AAAA	2001:500:2d::d
+e.root-servers.net.	518400	IN	A	192.203.230.10
+e.root-servers.net.	518400	IN	AAAA	2001:500:a8::e
+f.root-servers.net.	518400	IN	A	192.5.5.241
+f.root-servers.net.	518400	IN	AAAA	2001:500:2f::f
+g.root-servers.net.	518400	IN	A	192.112.36.4
+g.root-servers.net.	518400	IN	AAAA	2001:500:12::d0d
+h.root-servers.net.	518400	IN	A	198.97.190.53
+h.root-servers.net.	518400	IN	AAAA	2001:500:1::53
+i.root-servers.net.	518400	IN	A	192.36.148.17
+i.root-servers.net.	518400	IN	AAAA	2001:7fe::53
+j.root-servers.net.	518400	IN	A	192.58.128.30
+j.root-servers.net.	518400	IN	AAAA	2001:503:c27::2:30
+k.root-servers.net.	518400	IN	A	193.0.14.129
+k.root-servers.net.	518400	IN	AAAA	2001:7fd::1
+l.root-servers.net.	518400	IN	A	199.7.83.42
+l.root-servers.net.	518400	IN	AAAA	2001:500:9f::42
+m.root-servers.net.	518400	IN	A	202.12.27.33
+m.root-servers.net.	518400	IN	AAAA	2001:dc3::35
+
+;; Query time: 15 msec
+;; SERVER: 199.9.14.201#53(b.root-servers.net) (UDP)
+;; WHEN: Thu Jan 12 13:22:53 GMT 2023
+;; MSG SIZE  rcvd: 1031

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/Resolver/Recurse.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/Resolver/Recurse.pm Changed

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-our $VERSION = (qw$Id: Recurse.pm 1856 2021-12-02 14:36:25Z willem $)2;
+our $VERSION = (qw$Id: Recurse.pm 1896 2023-01-30 12:59:25Z willem $)2;
 
 
 =head1 NAME
@@ -54,10 +54,10 @@
 my $root = ;
 
 sub hints {
-	shift;
-	return @hints unless scalar @_;
+	my ( undef, @argument ) = @_;
+	return @hints unless scalar @argument;
 	$root  = ;
-	@hints = @_;
+	@hints = @argument;
 	return;
 }
 
@@ -78,9 +78,9 @@
 =cut
 
 sub send {
-	my $self = shift;
+	my ( $self, @q ) = @_;
 	my @conf = ( recurse => 0, udppacketsize => 1024 );	# RFC8109
-	return bless( {persistent => {'.' => $root}, %$self, @conf}, ref($self) )->_send(@_);
+	return bless( {persistent => {'.' => $root}, %$self, @conf}, ref($self) )->_send(@q);
 }
 
 
@@ -92,8 +92,8 @@
 
 
 sub _send {
-	my $self  = shift;
-	my $query = $self->_make_query_packet(@_);
+	my ( $self, @q ) = @_;
+	my $query = $self->_make_query_packet(@q);
 
 	unless ( scalar(@$root) ) {
 		$self->_diag("resolver priming query");
@@ -169,15 +169,17 @@
 =cut
 
 sub callback {
-	my $self = shift;
-
-	( $self->{callback} ) = grep { ref($_) eq 'CODE' } @_;
+	my ( $self, @argument ) = @_;
+	for ( grep { ref($_) eq 'CODE' } @argument ) {
+		$self->{callback} = $_;
+	}
 	return;
 }
 
 sub _callback {
-	my $callback = shift->{callback};
-	$callback->(@_) if $callback;
+	my ( $self, @argument ) = @_;
+	my $callback = $self->{callback};
+	$callback->(@argument) if $callback;
 	return;
 }

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/Text.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/Text.pm Changed

@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-our $VERSION = (qw$Id: Text.pm 1855 2021-11-26 11:33:48Z willem $)2;
+our $VERSION = (qw$Id: Text.pm 1894 2023-01-12 10:59:08Z willem $)2;
 
 
 =head1 NAME
@@ -70,15 +70,13 @@
 
 sub new {
 	my $self = bless , shift;
-	croak 'argument undefined' unless defined $_0;
-
 	local $_ = &_encode_utf8;
 
 	s/^\042(.*)\042$/$1/s;					# strip paired quotes
 
-	s/\134\134/\134\060\071\062/g;				# disguise escaped escape
-	s/\134(\060-\071{3})/$unescape{$1}/eg;		# numeric escape
-	s/\134(.)/$1/g;						# character escape
+	s/\134(\060-\071{3})/$unescape{$1}/eg;		# restore numeric escapes
+	s/\134(^\134)/$1/g;					# restore character escapes
+	s/\134\134/\134/g;					# restore escaped escapes
 
 	while ( length $_ > 255 ) {
 		my $chunk = substr( $_, 0, 255 );		# carve into chunks
@@ -230,6 +228,7 @@
 
 sub _encode_utf8 {			## perl internal encoding to UTF-8
 	local $_ = shift;
+	croak 'argument undefined' unless defined $_;
 
 	# partial transliteration for non-ASCII character encodings
 	tr
@@ -323,7 +322,9 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, RFC1035, RFC3629, Unicode TR#16
+L<perl> L<Net::DNS>
+L<RFC1035|https://tools.ietf.org/html/rfc1035>
+L<RFC3629|https://tools.ietf.org/html/rfc3629>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/Update.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/Update.pm Changed

@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-our $VERSION = (qw$Id: Update.pm 1855 2021-11-26 11:33:48Z willem $)2;
+our $VERSION = (qw$Id: Update.pm 1895 2023-01-16 13:38:08Z willem $)2;
 
 
 =head1 NAME
@@ -93,15 +93,11 @@
 =cut
 
 sub push {
-	my $self = shift;
-	my $list = $self->_section(shift);
-	my @arg	 = grep { ref($_) } @_;
-
+	my ( $self, $section, @rr ) = @_;
 	my ($zone) = $self->zone;
 	my $zclass = $zone->zclass;
-	my @rr = grep { $_->class( $_->class =~ /ANY|NONE/ ? () : $zclass ) } @arg;
-
-	return CORE::push( @$list, @rr );
+	for (@rr) { $_->class( $_->class =~ /ANY|NONE/ ? () : $zclass ) }
+	return $self->SUPER::push( $section, @rr );
 }
 
 
@@ -124,17 +120,11 @@
 =cut
 
 sub unique_push {
-	my $self = shift;
-	my $list = $self->_section(shift);
-	my @arg	 = grep { ref($_) } @_;
-
+	my ( $self, $section, @rr ) = @_;
 	my ($zone) = $self->zone;
 	my $zclass = $zone->zclass;
-	my @rr = grep { $_->class( $_->class =~ /ANY|NONE/ ? () : $zclass ) } @arg;
-
-	my %unique = map { ( bless( {%$_, ttl => 0}, ref $_ )->canonical => $_ ) } ( @rr, @$list );
-
-	return scalar( @$list = values %unique );
+	for (@rr) { $_->class( $_->class =~ /ANY|NONE/ ? () : $zclass ) }
+	return $self->SUPER::unique_push( $section, @rr );
 }
 
 
@@ -274,8 +264,10 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::Packet>, L<Net::DNS::Header>,
-L<Net::DNS::RR>, L<Net::DNS::Resolver>, RFC 2136, RFC 2845
+L<perl> L<Net::DNS> L<Net::DNS::Packet> L<Net::DNS::Header>
+L<Net::DNS::RR> L<Net::DNS::Resolver>
+L<RFC2136|https://tools.ietf.org/html/rfc2136>
+L<RFC8945|https://tools.ietf.org/html/rfc8945>
 
 =cut

_service:tar_scm:Net-DNS-1.34.tar.gz/lib/Net/DNS/ZoneFile.pm -> _service:tar_scm:Net-DNS-1.38.tar.gz/lib/Net/DNS/ZoneFile.pm Changed

@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-our $VERSION = (qw$Id: ZoneFile.pm 1855 2021-11-26 11:33:48Z willem $)2;
+our $VERSION = (qw$Id: ZoneFile.pm 1910 2023-03-30 19:16:30Z willem $)2;
 
 
 =head1 NAME
@@ -88,8 +88,8 @@
 =cut
 
 sub new {
-	my $self = bless {fileopen => {}}, shift;
-	my ( $filename, $origin ) = @_;
+	my ( $class, $filename, $origin ) = @_;
+	my $self = bless {fileopen => {}}, $class;
 
 	$self->_origin($origin);
 
@@ -132,19 +132,22 @@
 
 	return &_read unless ref $self;				# compatibility interface
 
-	local $SIG{__DIE__};
-
 	if (wantarray) {
 		my @zone;					# return entire zone
 		eval {
-			my $rr;
-			push( @zone, $rr ) while $rr = $self->_getRR;
+			local $SIG{__DIE__};
+			while ( my $rr = $self->_getRR ) {
+				push( @zone, $rr );
+			}
 		};
 		croak join ' ', $@, ' file', $self->name, 'line', $self->line, "\n " if $@;
 		return @zone;
 	}
 
-	my $rr = eval { $self->_getRR };			# return single RR
+	my $rr = eval {
+		local $SIG{__DIE__};
+		$self->_getRR;					# return single RR
+		};
 	croak join ' ', $@, ' file', $self->name, 'line', $self->line, "\n " if $@;
 	return $rr;
 }
@@ -346,9 +349,10 @@
 
 sub parse {
 	my ($arg1) = @_;
-	shift if !ref($arg1) && $arg1 eq __PACKAGE__;
-	my $text = shift;
-	return &readfh( Net::DNS::ZoneFile::Text->new($text), @_ );
+	shift if $arg1 eq __PACKAGE__;
+	my $string  = shift;
+	my @include = grep {defined} shift;
+	return &readfh( Net::DNS::ZoneFile::Text->new($string), @include );
 }
 
 
@@ -621,8 +625,9 @@
 
 =head1 SEE ALSO
 
-L<perl>, L<Net::DNS>, L<Net::DNS::RR>,
-RFC1035 Section 5.1, RFC2308
+L<perl> L<Net::DNS> L<Net::DNS::RR>
+L<RFC1035(5.1)|https://tools.ietf.org/html/rfc1035>
+L<RFC2308(4)|https://tools.ietf.org/html/rfc2308>
 
 L<BIND Administrator Reference Manual|http://bind.isc.org/>

_service:tar_scm:Net-DNS-1.34.tar.gz/t/00-load.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/00-load.t Changed

@@ -1,34 +1,37 @@
 #!/usr/bin/perl
-# $Id: 00-load.t 1823 2020-11-16 16:29:45Z willem $	-*-perl-*-
+# $Id: 00-load.t 1896 2023-01-30 12:59:25Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
+use IO::File;
 use Test::More;
 
-my @module = qw(
-		Net::DNS
-		Digest::BubbleBabble
-		Digest::HMAC
-		Digest::MD5
-		Digest::SHA
-		Encode
-		File::Spec
-		IO::File
-		IO::Select
-		IO::Socket::IP
-		MIME::Base64
-		Net::LibIDN2
-		PerlIO
-		Scalar::Util
-		Time::Local
-		Win32::API
-		Win32::IPHelper
-		Win32::TieRegistry
-		);
+my @module = qw(Net::DNS);
+
+my %metadata;
+my $handle = IO::File->new('MYMETA.json') || IO::File->new('META.json');
+if ($handle) {
+	my $json = join '', (<$handle>);
+	for ($json) {
+		s/\s:\s/ => /g;					# Perl? en voilà!
+		my $hashref = eval $_;	## no critic
+		%metadata = %$hashref;
+	}
+	close $handle;
+}
+
+my %prerequisite;
+foreach ( values %{$metadata{prereqs}} ) {			# build, runtime, etc.
+	foreach ( values %$_ ) {				# requires
+		$prerequisite{$_}++ for keys %$_;
+	}
+	delete @prerequisite{@module};
+	delete $prerequisite{perl};
+}
 
 my @diag;
-foreach my $module (@module) {
+foreach my $module ( @module, sort keys %prerequisite ) {
 	eval "require $module";		## no critic
 	for ( eval { $module->VERSION || () } ) {
 		s/^(\d+\.\d)$/${1}0/;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/01-resolver-config.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/01-resolver-config.t Changed

@@ -1,11 +1,11 @@
 #!/usr/bin/perl
-# $Id: 01-resolver-config.t 1813 2020-10-08 21:58:40Z willem $	-*-perl-*-
+# $Id: 01-resolver-config.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
 use IO::File;
-use Test::More tests => 23;
+use Test::More tests => 21;
 
 use Net::DNS::Resolver;
 
@@ -24,96 +24,66 @@
 my $class    = ref($resolver);
 
 for (@Net::DNS::Resolver::ISA) {
-	diag $_ unless /:UNIX$/;
+	diag $_ unless /::UNIX$/;
 }
 
 ok( $resolver->isa('Net::DNS::Resolver'), 'new() created object' );
 
-ok( $class->new( debug => 1 )->_diag(@Net::DNS::Resolver::ISA), 'debug message' );
+ok( $class->new( debug => 1 )->_diag('_diag("debug message");'), 'debug message' );
 
 
-{					## check class methods
-	$class->nameservers(qw(127.0.0.1 ::1));
-	ok( scalar( $class->nameservers ), '$class->nameservers' );
-	$class->searchlist(qw(sub1.example.com sub2.example.com));
-	ok( scalar( $class->searchlist ), '$class->searchlist' );
-	$class->domain('example.com');
-	ok( $class->domain,	   '$class->domain' );
-	ok( $class->srcport(1234), '$class->srcport' );
-	ok( $class->string(),	   '$class->string' );
-}
-
-
-{					## check instance methods
-	ok( $resolver->domain('example.com'),	  '$resolver->domain' );
-	ok( $resolver->searchlist('example.com'), '$resolver->searchlist' );
-	$resolver->nameservers(qw(127.0.0.1 ::1));
-	ok( scalar( $resolver->nameservers() ), '$resolver->nameservers' );
-	$resolver->nameservers();
-	is( scalar( $resolver->nameservers() ), 0, 'delete nameservers' );
-}
+$class->nameservers(qw(127.0.0.1 ::1));				# check class methods
+ok( scalar( $class->nameservers ), '$class->nameservers' );
+$class->searchlist(qw(sub1.example.com sub2.example.com));
+ok( scalar( $class->searchlist ), '$class->searchlist' );
+$class->domain('example.com');
+ok( $class->domain,	   '$class->domain' );
+ok( $class->srcport(1234), '$class->srcport' );
+ok( $class->string(),	   '$class->string' );
 
 
-{
-	my $resolver = Net::DNS::Resolver->new();
-	$resolver->nameservers(qw(127.0.0.1 ::1 ::ffff:127.0.0.1 fe80::1234%1));
-	$resolver->force_v4(0);					# set by default if no IPv6
-	$resolver->prefer_v6(1);
-	my ($address) = $resolver->nameserver();
-	is( $address, '::1', '$resolver->prefer_v6(1)' );
-}
+ok( $resolver->domain('example.com'),	  '$resolver->domain' );       # check instance methods
+ok( $resolver->searchlist('example.com'), '$resolver->searchlist' );
+$resolver->nameservers(qw(127.0.0.1 ::1));
+ok( scalar( $resolver->nameservers() ), '$resolver->nameservers' );
+$resolver->nameservers();
+is( scalar( $resolver->nameservers() ), 0, 'delete nameservers' );
 
 
-{
-	my $resolver = Net::DNS::Resolver->new();
-	$resolver->nameservers(qw(127.0.0.1 ::1));
-	$resolver->force_v6(0);
-	$resolver->prefer_v4(1);
-	my ($address) = $resolver->nameserver();
-	is( $address, '127.0.0.1', '$resolver->prefer_v4(1)' );
-}
+$resolver->nameservers(qw(127.0.0.1 ::1 ::ffff:127.0.0.1 fe80::1234%1));
+$resolver->force_v4(0);						# set by default if no IPv6
+$resolver->prefer_v6(1);
+my ($IPv6) = $resolver->nameserver();
+is( $IPv6, '::1', '$resolver->prefer_v6(1)' );
 
 
-{
-	my $resolver = Net::DNS::Resolver->new();
-	$resolver->force_v6(1);
-	ok( !$resolver->nameservers(qw(127.0.0.1)), '$resolver->force_v6(1)' );
-	like( $resolver->errorstring, '/IPv4.+disabled/', 'errorstring: IPv4 disabled' );
-}
+$resolver->nameservers(qw(127.0.0.1 ::1));
+$resolver->force_v6(0);
+$resolver->prefer_v4(1);
+my ($address) = $resolver->nameserver();
+is( $address, '127.0.0.1', '$resolver->prefer_v4(1)' );
 
 
-{
-	my $resolver = Net::DNS::Resolver->new();
-	$resolver->force_v4(1);
-	ok( !$resolver->nameservers(qw(::)), '$resolver->force_v4(1)' );
-	like( $resolver->errorstring, '/IPv6.+disabled/', 'errorstring: IPv6 disabled' );
-}
+$resolver->force_v6(1);
+ok( !$resolver->nameservers(qw(127.0.0.1)), '$resolver->force_v6(1)' );
+like( $resolver->errorstring, '/IPv4.+disabled/', 'errorstring: IPv4 disabled' );
 
 
-{
-	my $resolver = Net::DNS::Resolver->new();
-	foreach my $ip (qw(127.0.0.1 ::1)) {
-		is( $resolver->srcaddr($ip), $ip, "\$resolver->srcaddr($ip)" );
-	}
-}
+$resolver->force_v4(1);
+ok( !$resolver->nameservers(qw(::)), '$resolver->force_v4(1)' );
+like( $resolver->errorstring, '/IPv6.+disabled/', 'errorstring: IPv6 disabled' );
 
 
-{					## check private methods callable
-	ok( $resolver->_hints(), 'parse defaults hints RRs' );
-	ok( $resolver->_hints(), 'defaults hints accessible' );
+foreach my $ip (qw(127.0.0.1 ::1)) {
+	is( $resolver->srcaddr($ip), $ip, "\$resolver->srcaddr($ip)" );
 }
 
 
-{					## check for exception on bogus AUTOLOAD method
-	eval { $resolver->bogus(); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "unknown method:\t$exception" );
-
-	is( $resolver->DESTROY, undef, 'DESTROY() exists to placate pre-5.18 AUTOLOAD' );
-}
+ok( $resolver->_hints(), 'parse defaults hints RRs' );		# check private methods callable
+ok( $resolver->_hints(), 'defaults hints accessible' );
 
 
-eval {					## exercise printing functions
+eval {					## no critic		# exercise printing functions
 	my $object = Net::DNS::Resolver->new();
 	my $file   = "01-resolver.tmp";
 	my $handle = IO::File->new( $file, '>' ) || die "Could not open $file for writing";
@@ -125,5 +95,3 @@
 
 exit;
 
-__END__
-

_service:tar_scm:Net-DNS-1.34.tar.gz/t/01-resolver-file.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/01-resolver-file.t Changed

@@ -1,11 +1,12 @@
 #!/usr/bin/perl
-# $Id: 01-resolver-file.t 1815 2020-10-14 21:55:18Z willem $
+# $Id: 01-resolver-file.t 1910 2023-03-30 19:16:30Z willem $
 #
 
 use strict;
 use warnings;
 use File::Spec;
 use Test::More tests => 16;
+use TestToolkit;
 
 use Net::DNS::Resolver;
 
@@ -19,9 +20,8 @@
 
 my $config = File::Spec->catfile(qw(t custom.txt));		# .txt to run on Windows
 
-{
-	$class->domain('domain.default');
-	my $resolver = $class->new( config_file => $config );
+
+for my $resolver ( $class->new( config_file => $config ) ) {
 	ok( $resolver->isa($class), "new( config_file => '$config' )" );
 
 	my @servers = $resolver->nameservers;
@@ -34,37 +34,31 @@
 	is( $search0, 'alt.net-dns.org', 'searchlist correct' );
 	is( $search1, 'ext.net-dns.org', 'searchlist correct' );
 
-	is( $resolver->domain, 'alt.net-dns.org', 'domain correct' );
+	is( $resolver->domain, $search0, 'domain correct' );
 
 	is( $class->domain, $resolver->domain, 'initial config sets defaults' );
 }
 
 
-{
-	$class->domain('domain.default');
-	my $resolver = $class->new( config_file => $config );
+$class->domain('domain.default');
+
+for my $resolver ( $class->new( config_file => $config ) ) {
 	ok( $resolver->isa($class), "new( config_file => $config )" );
 
 	my @servers = $resolver->nameservers;
 	ok( scalar(@servers), 'nameservers list populated' );
 
-	my $domain = 'alt.net-dns.org';
 	my @search = $resolver->searchlist;
 	ok( scalar(@search), 'searchlist populated' );
-	is( shift(@search), $domain, 'searchlist correct' );
+	is( $search0, 'alt.net-dns.org', 'searchlist correct' );
 
-	is( $resolver->domain, $domain, 'domain correct' );
+	is( $resolver->domain, $search0, 'domain correct' );
 
 	isnt( $class->domain, $resolver->domain, 'default config unchanged' );
 }
 
 
-{								# file presumed not to exist
-	eval { $class->new( config_file => 'nonexist.txt' ); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "new( config_file => ?\t$exception" );
-}
-
+exception( 'new( config_file => ?', sub { $class->new( config_file => 'nonexist.txt' ) } );
 
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/01-resolver-opt.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/01-resolver-opt.t Changed

_service:tar_scm:Net-DNS-1.34.tar.gz/t/01-resolver.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/01-resolver.t Changed

@@ -1,10 +1,11 @@
 #!/usr/bin/perl
-# $Id: 01-resolver.t 1847 2021-08-11 10:02:44Z willem $	-*-perl-*-
+# $Id: 01-resolver.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 29;
+use Test::More tests => 34;
+use TestToolkit;
 
 use Net::DNS::Resolver;
 use Net::DNS::Resolver::Recurse;
@@ -14,6 +15,8 @@
 
 my $resolver = Net::DNS::Resolver->new( retrans => 0, retry => 0 );
 
+$resolver->nameservers(@NOIP);
+
 my $recursive = Net::DNS::Resolver::Recurse->new( retrans => 0, retry => 0 );
 
 
@@ -71,9 +74,9 @@
 ok( !$resolver->send('.'), 'no TCP nameservers' );
 
 $resolver->nameservers(@NOIP);
-ok( !$resolver->send('.'),	  '$resolver->send   TCP socket error' );
-ok( !$resolver->bgsend('.'),	  '$resolver->bgsend TCP socket error' );
-ok( !scalar( $resolver->axfr() ), '$resolver->axfr   TCP socket error' );
+ok( !$resolver->send('.'),   '$resolver->send	TCP socket error' );
+ok( !$resolver->bgsend('.'), '$resolver->bgsend TCP socket error' );
+ok( !$resolver->axfr('.'),   '$resolver->axfr	TCP socket error' );
 
 
 $recursive->hints(@NOIP);
@@ -83,35 +86,22 @@
 ok( !$recursive->send( 'www.net-dns.org', 'A' ), 'fail if no reachable server' );
 
 
-sub warning {
-	my ( $test, $method ) = @_;
-	local $SIG{__WARN__} = sub { die @_ };
-	eval {&$method};
-	my ($warning) = split /\n/, "$@\n";
-	ok( $warning, "$test\t$warning" );
-	eval {&$method};
-}
-
-warning( 'unresolved nameserver warning', sub { $resolver->nameserver('bogus.example.com.') } );
-
-warning( 'deprecated bgisready() method', sub { $resolver->bgisready(undef) } );
-
-warning( 'deprecated axfr_start() method', sub { $resolver->axfr_start('net-dns.org') } );
+is( $resolver->DESTROY, undef, 'DESTROY() exists to placate pre-5.18 AUTOLOAD' );
+exception( 'AUTOLOAD: unrecognised method', sub { $resolver->unknown() } );
 
-warning('deprecated axfr_next() method',
-	sub {
-		$resolver->{axfr_iter} = sub { };
-		$resolver->axfr_next();
-	} );
+exception( 'new( config_file => ... )', sub { Net::DNS::Resolver->new( config_file => 'nonexist.txt' ) } );
 
-warning( 'deprecated query_dorecursion()', sub { $recursive->query_dorecursion( 'www.net-dns.org', 'A' ) } );
+exception( 'unresolved nameserver warning',   sub { $resolver->nameserver('bogus.example.com.') } );
+exception( 'unspecified axfr() zone name',    sub { $resolver->axfr(undef) } );
+exception( 'deprecated axfr_start() method',  sub { $resolver->axfr_start('net-dns.org') } );
+exception( 'deprecated axfr_next() method',   sub { $resolver->axfr_next() } );
+exception( 'deprecated query_dorecursion()',  sub { $recursive->query_dorecursion( 'www.net-dns.org', 'A' ) } );
+exception( 'deprecated recursion_callback()', sub { $recursive->recursion_callback(undef) } );
+exception( 'deprecated bgisready() method',   sub { $resolver->bgisready(undef) } );
 
-warning('deprecated recursion_callback()',
-	sub {
-		$recursive->recursion_callback( sub { } );
-	} );
-
-warning( 'deprecated make_query_packet()', sub { $resolver->make_query_packet('example.com') } );
+my $deprecated = sub { $resolver->make_query_packet('example.com') };
+exception( 'deprecated make_query_packet()', $deprecated );
+noexception( 'no repeated deprecation warning', $deprecated );
 
 exit;
 
@@ -120,6 +110,5 @@
 sub _create_tcp_socket {return}		## stub
 sub _create_udp_socket {return}		## stub
 
-
 __END__

_service:tar_scm:Net-DNS-1.34.tar.gz/t/02-IDN.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/02-IDN.t Changed

_service:tar_scm:Net-DNS-1.34.tar.gz/t/02-domain.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/02-domain.t Changed

@@ -1,21 +1,20 @@
 #!/usr/bin/perl
-# $Id: 02-domain.t 1841 2021-06-23 20:34:28Z willem $	-*-perl-*-
+# $Id: 02-domain.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
 use Test::More tests => 46;
+use TestToolkit;
 
 
 use_ok('Net::DNS::Domain');
 
 
-{
-	my $name   = 'example.com';
-	my $domain = Net::DNS::Domain->new($name);
+for my $domain ( Net::DNS::Domain->new('example.com') ) {
 	ok( $domain->isa('Net::DNS::Domain'), 'object returned by new() constructor' );
 
-	my $same = Net::DNS::Domain->new($name);
+	my $same = Net::DNS::Domain->new( $domain->name );
 	is( $same, $domain, "same name returns cached object" );
 
 	my %cache;
@@ -32,30 +31,15 @@
 }
 
 
-{
-	my $domain = eval { Net::DNS::Domain->new(); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "empty argument list\t$exception" );
-}
-
-
-{
-	my $domain = eval { Net::DNS::Domain->new(undef); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "argument undefined\t$exception" );
-}
-
-
-{
-	my $domain = Net::DNS::Domain->new('name');
+for my $domain ( Net::DNS::Domain->new('name') ) {
+	$domain->name;			## untestable optimisation: avoid returning name in void context
 	is( $domain->name,   'name',  '$domain->name() without trailing dot' );
 	is( $domain->fqdn,   'name.', '$domain->fqdn() with trailing dot' );
 	is( $domain->string, 'name.', '$domain->string() with trailing dot' );
 }
 
 
-{
-	my $root = Net::DNS::Domain->new('.');
+for my $root ( Net::DNS::Domain->new('.') ) {
 	is( $root->name,   '.', '$root->name() represented by single dot' );
 	is( $root->fqdn,   '.', '$root->fqdn() represented by single dot' );
 	is( $root->xname,  '.', '$root->xname() represented by single dot' );
@@ -63,8 +47,7 @@
 }
 
 
-{
-	my $domain = Net::DNS::Domain->new('example.com');
+for my $domain ( Net::DNS::Domain->new('example.com') ) {
 	my $labels = @{$domain->label};
 	is( $labels, 2, 'domain labels separated by dots' );
 }
@@ -149,76 +132,57 @@
 
 
 {
-	my $name	= 'LO-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-NG!';
-	my $domain	= eval { Net::DNS::Domain->new("$name") };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "long domain label\t$exception" );
-}
-
-
-{
-	my $domain = eval { Net::DNS::Domain->new('.example.com') };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "empty initial label\t$exception" );
-}
-
-
-{
-	my $domain = eval { Net::DNS::Domain->new("example..com"); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "empty interior label\t$exception" );
-}
-
-
-{
 	my $name   = 'example.com';
 	my $domain = Net::DNS::Domain->new("$name...");
 	is( $domain->name, $name, 'ignore gratuitous trailing dots' );
 }
 
 
-{
-	foreach my $case (
-		'\000\001\002\003\004\005\006\007\008\009\010\011\012\013\014\015',
-		'\016\017\018\019\020\021\022\023\024\025\026\027\028\029\030\031'
-		) {
-		my $domain = Net::DNS::Domain->new($case);
-		is( $domain->name, $case, "C0 controls:\t$case" );
-	}
+foreach my $case (
+	'\000\001\002\003\004\005\006\007\008\009\010\011\012\013\014\015',
+	'\016\017\018\019\020\021\022\023\024\025\026\027\028\029\030\031'
+	) {
+	my $domain = Net::DNS::Domain->new($case);
+	is( $domain->name, $case, "C0 controls:\t$case" );
 }
 
 
-{
-	foreach my $case (
-		'\032!\034#$%&\'*+,-\./',			#  32 .. 47
-		'0123456789:\;<=>?',				#  48 ..
-		'@ABCDEFGHIJKLMNO',				#  64 ..
-		'PQRSTUVWXYZ\092^_',				#  80 ..
-		'`abcdefghijklmno',				#  96 ..
-		'pqrstuvwxyz{|}~\127'				# 112 ..
-		) {
-		my $domain = Net::DNS::Domain->new($case);
-		is( $domain->name, $case, "G0 graphics:\t$case" );
-	}
+foreach my $case (
+	'\032!\034#$%&\'*+,-\./',				#  32 .. 47
+	'0123456789:\;<=>?',					#  48 ..
+	'@ABCDEFGHIJKLMNO',					#  64 ..
+	'PQRSTUVWXYZ\092^_',					#  80 ..
+	'`abcdefghijklmno',					#  96 ..
+	'pqrstuvwxyz{|}~\127'					# 112 ..
+	) {
+	my $domain = Net::DNS::Domain->new($case);
+	is( $domain->name, $case, "G0 graphics:\t$case" );
 }
 
 
-{
-	foreach my $case (
-		'\128\129\130\131\132\133\134\135\136\137\138\139\140\141\142\143',
-		'\144\145\146\147\148\149\150\151\152\153\154\155\156\157\158\159',
-		'\160\161\162\163\164\165\166\167\168\169\170\171\172\173\174\175',
-		'\176\177\178\179\180\181\182\183\184\185\186\187\188\189\190\191',
-		'\192\193\194\195\196\197\198\199\200\201\202\203\204\205\206\207',
-		'\208\209\210\211\212\213\214\215\216\217\218\219\220\221\222\223',
-		'\224\225\226\227\228\229\230\231\232\233\234\235\236\237\238\239',
-		'\240\241\242\243\244\245\246\247\248\249\250\251\252\253\254\255'
-		) {
-		my $domain = Net::DNS::Domain->new($case);
-		is( $domain->name, $case, "8-bit codes:\t$case" );
-	}
+foreach my $case (
+	'\128\129\130\131\132\133\134\135\136\137\138\139\140\141\142\143',
+	'\144\145\146\147\148\149\150\151\152\153\154\155\156\157\158\159',
+	'\160\161\162\163\164\165\166\167\168\169\170\171\172\173\174\175',
+	'\176\177\178\179\180\181\182\183\184\185\186\187\188\189\190\191',
+	'\192\193\194\195\196\197\198\199\200\201\202\203\204\205\206\207',
+	'\208\209\210\211\212\213\214\215\216\217\218\219\220\221\222\223',
+	'\224\225\226\227\228\229\230\231\232\233\234\235\236\237\238\239',
+	'\240\241\242\243\244\245\246\247\248\249\250\251\252\253\254\255'
+	) {
+	my $domain = Net::DNS::Domain->new($case);
+	is( $domain->name, $case, "8-bit codes:\t$case" );
 }
 
 
+exception( 'empty argument list', sub { Net::DNS::Domain->new() } );
+exception( 'argument undefined',  sub { Net::DNS::Domain->new(undef) } );
+
+exception( 'empty intial label',   sub { Net::DNS::Domain->new('..example.com') } );
+exception( 'empty interior label', sub { Net::DNS::Domain->new('..example.com') } );
+
+my $long = 'LO-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-O-NG!';
+exception( 'long domain label', sub { Net::DNS::Domain->new($long) } );
+
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/02-domainname.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/02-domainname.t Changed

@@ -1,17 +1,17 @@
 #!/usr/bin/perl
-# $Id: 02-domainname.t 1841 2021-06-23 20:34:28Z willem $	-*-perl-*-
+# $Id: 02-domainname.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
 use Test::More tests => 35;
+use TestToolkit;
 
 
 use_ok('Net::DNS::DomainName');
 
 
-{
-	my $domain = Net::DNS::DomainName->new('');
+for my $domain ( Net::DNS::DomainName->new('') ) {
 	is( $domain->name, '.', 'DNS root represented as single dot' );
 
 	my @label = $domain->_wire;
@@ -23,10 +23,8 @@
 }
 
 
-{
-	my $ldh	      = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz-0123456789';
-	my $domain    = Net::DNS::DomainName->new($ldh);
-	my $subdomain = Net::DNS::DomainName->new("sub.$ldh");
+my $ldh = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz-0123456789';
+for my $domain ( Net::DNS::DomainName->new($ldh) ) {
 	is( $domain->name, $ldh, '63 octet LDH character label' );
 
 	my @label = $domain->_wire;
@@ -39,84 +37,34 @@
 			. '2d30313233343536373839' . '00';
 	is( lc unpack( 'H*', $buffer ), $hex, 'simple wire-format encoding' );
 
-	my ( $decoded, $offset ) = decode Net::DNS::DomainName( \$buffer );
+	my ( $decoded, $offset ) = Net::DNS::DomainName->decode( \$buffer );
 	is( $decoded->name, $domain->name, 'simple wire-format decoding' );
 
-	is( decode Net::DNS::DomainName( \$subdomain->encode )->name, $subdomain->name, 'simple wire-format decoding' );
+	my $subdomain = Net::DNS::DomainName->new("sub.$ldh");
+	is( Net::DNS::DomainName->decode( \$subdomain->encode )->name, $subdomain->name,
+		'simple wire-format decoding' );
 
 	my $data = '03737562c000c000c000';
 	$buffer .= pack( 'H*', $data );
 
 	my $cache = {};
-	( $decoded, $offset ) = decode Net::DNS::DomainName( \$buffer, $offset, $cache );
+	( $decoded, $offset ) = Net::DNS::DomainName->decode( \$buffer, $offset, $cache );
 	is( $decoded->name, $subdomain->name, 'compressed wire-format decoding' );
 
 	my @labels = $decoded->_wire;
 	is( scalar(@labels), 2, "decoded name has two labels" );
 
-	$decoded = decode Net::DNS::DomainName( \$buffer, $offset, $cache );
+	$decoded = Net::DNS::DomainName->decode( \$buffer, $offset, $cache );
 	is( $decoded->name, $domain->name, 'compressed wire-format decoding' );
 }
 
 
-{
-	my $buffer = pack 'H*', '0200';
-	eval { my $domain = decode Net::DNS::DomainName( \$buffer ); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "corrupt wire-format\t$exception" );
-}
-
-
-{
-	my $buffer = pack 'H*', 'c002';
-	eval { my $domain = decode Net::DNS::DomainName( \$buffer ); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "bad compression pointer\t$exception" );
-}
-
-
-{
-	my $buffer = pack 'H*', 'c000';
-	eval { my $domain = decode Net::DNS::DomainName( \$buffer ); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "name compression loop\t$exception" );
-}
-
-
-{
-	my $hex = '40'
-			. '4142434445464748494a4b4c4d4e4f505152535455565758595a'
-			. '6162636465666768696a6b6c6d6e6f707172737475767778797a'
-			. '2d30313233343536373839ff' . '00';
-	my $buffer = pack 'H*', $hex;
-	eval { my $domain = decode Net::DNS::DomainName( \$buffer ); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "unsupported wire-format\t$exception" );
-}
-
-
-{
-	my $hex = '80'
-			. '4142434445464748494a4b4c4d4e4f505152535455565758595a'
-			. '6162636465666768696a6b6c6d6e6f707172737475767778797a'
-			. '2d30313233343536373839ff'
-			. '4142434445464748494a4b4c4d4e4f505152535455565758595a'
-			. '6162636465666768696a6b6c6d6e6f707172737475767778797a'
-			. '2d30313233343536373839ff' . '00';
-	my $buffer = pack 'H*', $hex;
-	eval { my $domain = decode Net::DNS::DomainName( \$buffer ); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "unsupported wire-format\t$exception" );
-}
-
-
-{
-	my $domain    = Net::DNS::DomainName->new( uc 'EXAMPLE.COM' );
+for my $domain ( Net::DNS::DomainName->new( uc 'EXAMPLE.COM' ) ) {
 	my $hash      = {};
 	my $data      = $domain->encode( 0,	       $hash );
 	my $compress  = $domain->encode( length $data, $hash );
 	my $canonical = $domain->encode( length $data );
-	my $decoded   = decode Net::DNS::DomainName( \$data );
+	my $decoded   = Net::DNS::DomainName->decode( \$data );
 	my $downcased = Net::DNS::DomainName->new( lc $domain->name )->encode( 0, {} );
 	ok( $domain->isa('Net::DNS::DomainName'),  'object returned by new() constructor' );
 	ok( $decoded->isa('Net::DNS::DomainName'), 'object returned by decode() constructor' );
@@ -127,8 +75,7 @@
 }
 
 
-{
-	my $domain    = Net::DNS::DomainName1035->new( uc 'EXAMPLE.COM' );
+for my $domain ( Net::DNS::DomainName1035->new( uc 'EXAMPLE.COM' ) ) {
 	my $hash      = {};
 	my $data      = $domain->encode( 0,	       $hash );
 	my $compress  = $domain->encode( length $data, $hash );
@@ -144,8 +91,7 @@
 }
 
 
-{
-	my $domain    = Net::DNS::DomainName2535->new( uc 'EXAMPLE.COM' );
+for my $domain ( Net::DNS::DomainName2535->new( uc 'EXAMPLE.COM' ) ) {
 	my $hash      = {};
 	my $data      = $domain->encode( 0,	       $hash );
 	my $compress  = $domain->encode( length $data, $hash );
@@ -161,5 +107,21 @@
 }
 
 
+my $truncated = pack 'H*', '0200';
+exception( 'truncated wire-format', sub { Net::DNS::DomainName->decode( \$truncated ) } );
+
+my $type1label = pack 'H*', join '', '40', '4142434445464748494a4b4c4d4e4f50' x 4, '00';
+exception( 'unsupported wire-format', sub { Net::DNS::DomainName->decode( \$type1label ) } );
+
+my $type2label = pack 'H*', join '', '80', '4142434445464748494a4b4c4d4e4f50' x 8, '00';
+exception( 'unsupported wire-format', sub { Net::DNS::DomainName->decode( \$type2label ) } );
+
+my $overreach = pack 'H*', 'c002';
+exception( 'bad compression pointer', sub { Net::DNS::DomainName->decode( \$overreach ) } );
+
+my $loop = pack 'H*', '0344454603414243c000';
+exception( 'compression loop', sub { Net::DNS::DomainName->decode( \$loop, 4 ) } );
+
+
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/02-mailbox.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/02-mailbox.t Changed

@@ -1,92 +1,58 @@
 #!/usr/bin/perl
-# $Id: 02-mailbox.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 02-mailbox.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 43;
+use Test::More tests => 40;
+use TestToolkit;
 
 
 use_ok('Net::DNS::Mailbox');
 
 
-{
-	my $name    = 'mbox@example.com';
-	my $mailbox = Net::DNS::Mailbox->new($name);
+for my $mailbox ( Net::DNS::Mailbox->new('mbox@example.com') ) {
 	ok( $mailbox->isa('Net::DNS::Mailbox'), 'object returned by new() constructor' );
+	$mailbox->address;		## untestable optimisation: avoid returning address in void context
+	ok( $mailbox->address, 'mailbox->address' );
 }
 
 
-{
-	my $mailbox	= eval { Net::DNS::Mailbox->new(); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "empty argument list\t$exception" );
+my %testcase = (
+	'.'				    => '<>',
+	'<>'				    => '<>',
+	'a'				    => 'a',
+	'a.b'				    => 'a@b',
+	'a.b.c'				    => 'a@b.c',
+	'a.b.c.d'			    => 'a@b.c.d',
+	'a@b'				    => 'a@b',
+	'a@b.c'				    => 'a@b.c',
+	'a@b.c.d'			    => 'a@b.c.d',
+	'a\.b.c.d'			    => 'a.b@c.d',
+	'a\.b@c.d'			    => 'a.b@c.d',
+	'empty <>'			    => '<>',
+	'fore <a.b@c.d> aft'		    => 'a.b@c.d',
+	'nested <<mailbox>>'		    => 'mailbox',
+	'obscure <<left><<<deep>>><right>>' => 'right',
+	'obsolete <@source;@route:mailbox>' => 'mailbox',
+	'quoted <"stuff@local"@domain>'	    => '"stuff@local"@domain',
+	);
+
+foreach my $test ( sort keys %testcase ) {
+	my $expect  = $testcase{$test};
+	my $mailbox = Net::DNS::Mailbox->new($test);
+	my $data    = $mailbox->encode;
+	my $decoded = Net::DNS::Mailbox->decode( \$data );
+	is( $decoded->address, $expect, "encode/decode mailbox	$test" );
 }
 
 
-{
-	my $mailbox	= eval { Net::DNS::Mailbox->new(undef); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "argument undefined\t$exception" );
-}
-
-
-{
-	my %testcase = (
-		'.'				    => '<>',
-		'<>'				    => '<>',
-		'a'				    => 'a',
-		'a.b'				    => 'a@b',
-		'a.b.c'				    => 'a@b.c',
-		'a.b.c.d'			    => 'a@b.c.d',
-		'a@b'				    => 'a@b',
-		'a@b.c'				    => 'a@b.c',
-		'a@b.c.d'			    => 'a@b.c.d',
-		'a\.b.c.d'			    => 'a.b@c.d',
-		'a\.b@c.d'			    => 'a.b@c.d',
-		'empty <>'			    => '<>',
-		'fore <a.b@c.d> aft'		    => 'a.b@c.d',
-		'nested <<address>>'		    => 'address',
-		'obscure <<left><<<deep>>><right>>' => 'right',
-		);
-
-	foreach my $test ( sort keys %testcase ) {
-		my $expect  = $testcase{$test};
-		my $mailbox = Net::DNS::Mailbox->new($test);
-		my $data    = $mailbox->encode;
-		my $decoded = decode Net::DNS::Mailbox( \$data );
-		is( $decoded->address, $expect, "encode/decode mailbox	$test" );
-	}
-}
-
-
-{
-	my %testcase = (
-		'"(a.b)"@c.d' => '"(a.b)"@c.d',
-		'"a.b"@c.d' => '"a.b"@c.d',
-		'"a,b"@c.d'   => '"a,b"@c.d',
-		'"a:b"@c.d'   => '"a:b"@c.d',
-		'"a;b"@c.d'   => '"a;b"@c.d',
-		'"a@b"@c.d'   => '"a@b"@c.d',
-		);
-
-	foreach my $test ( sort keys %testcase ) {
-		my $expect  = $testcase{$test};
-		my $mailbox = Net::DNS::Mailbox->new($test);
-		my $data    = $mailbox->encode;
-		my $decoded = decode Net::DNS::Mailbox( \$data );
-		is( $decoded->address, $expect, "encode/decode mailbox	$test" );
-	}
-}
-
-
-{
-	my $mailbox   = Net::DNS::Mailbox->new( uc 'MBOX.EXAMPLE.COM' );
+for my $mailbox ( Net::DNS::Mailbox->new( uc 'MBOX.EXAMPLE.COM' ) ) {
 	my $hash      = {};
 	my $data      = $mailbox->encode( 1,		$hash );
 	my $compress  = $mailbox->encode( length $data, $hash );
 	my $canonical = $mailbox->encode( length $data );
-	my $decoded   = decode Net::DNS::Mailbox( \$data );
+	my $decoded   = Net::DNS::Mailbox->decode( \$data );
 	my $downcased = Net::DNS::Mailbox->new( lc $mailbox->name )->encode( 0, {} );
 	ok( $mailbox->isa('Net::DNS::Mailbox'), 'object returned by Net::DNS::Mailbox->new()' );
 	ok( $decoded->isa('Net::DNS::Mailbox'), 'object returned by Net::DNS::Mailbox->decode()' );
@@ -97,8 +63,7 @@
 }
 
 
-{
-	my $mailbox   = Net::DNS::Mailbox1035->new( uc 'MBOX.EXAMPLE.COM' );
+for my $mailbox ( Net::DNS::Mailbox1035->new( uc 'MBOX.EXAMPLE.COM' ) ) {
 	my $hash      = {};
 	my $data      = $mailbox->encode( 1,		$hash );
 	my $compress  = $mailbox->encode( length $data, $hash );
@@ -114,8 +79,7 @@
 }
 
 
-{
-	my $mailbox   = Net::DNS::Mailbox2535->new( uc 'MBOX.EXAMPLE.COM' );
+for my $mailbox ( Net::DNS::Mailbox2535->new( uc 'MBOX.EXAMPLE.COM' ) ) {
 	my $hash      = {};
 	my $data      = $mailbox->encode( 1,		$hash );
 	my $compress  = $mailbox->encode( length $data, $hash );
@@ -131,5 +95,8 @@
 }
 
 
+exception( 'empty argument list', sub { Net::DNS::Mailbox->new() } );
+exception( 'argument undefined',  sub { Net::DNS::Mailbox->new(undef) } );
+
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/02-text.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/02-text.t Changed

@@ -1,184 +1,141 @@
 #!/usr/bin/perl
-# $Id: 02-text.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 02-text.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 37;
+use Test::More tests => 40;
+use TestToolkit;
 
 
 use_ok('Net::DNS::Text');
 
 
-{
-	my $string = 'example';
-	my $object = Net::DNS::Text->new($string);
+for my $object ( Net::DNS::Text->new( my $string = 'example' ) ) {
 	ok( $object->isa('Net::DNS::Text'), 'object returned by new() constructor' );
-	is( $object->value,  $string, 'expected object->value' );
-	is( $object->string, $string, 'expected object->string' );
+	$object->value;			## untestable optimisation: avoid returning value in void context
+	is( $object->value,   $string, 'expected object->value' );
+	is( $object->string,  $string, 'expected object->string' );
+	is( $object->unicode, $string, 'expected object->unicode' );
 }
 
 
-{
-	eval { my $object = Net::DNS::Text->new(); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "empty argument list\t$exception" );
-}
-
-
-{
-	eval { my $object = Net::DNS::Text->new(undef); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "argument undefined\t$exception" );
-}
-
-
-{
-	my $sample = '';
+for my $object ( Net::DNS::Text->new( my $sample = '' ) ) {
 	my $expect = '""';
-	my $result = Net::DNS::Text->new($sample)->string;
-	is( $result, $expect, 'null argument' );
+	is( $object->string,  $expect, 'quoted empty object->string' );
+	is( $object->unicode, $expect, 'quoted empty object->unicode' );
 }
 
 
-{
-	my $sample = 'example';
-	my $escape = '\e\x\a\m\p\l\e';
-	my $result = Net::DNS::Text->new($escape)->string;
-	is( $result, $sample, 'character escape' );
+for my $object ( Net::DNS::Text->new( my $sample = '\e\x\a\m\p\l\e' ) ) {
+	my $expect = 'example';
+	is( $object->string, $expect, 'character escape' );
 }
 
 
-{
-	my $sample = 'A';
-	my $escape = '\065';
-	my $result = Net::DNS::Text->new($escape)->string;
-	is( $result, $sample, 'numeric escape' );
+for my $object ( Net::DNS::Text->new( my $sample = '\065' ) ) {
+	my $expect = 'A';
+	is( $object->string, $expect, 'numeric escape' );
 }
 
 
-{
-	my $string = 'a' x 256;
-	my $object = Net::DNS::Text->new($string);
+for my $object ( Net::DNS::Text->new( my $string = 'a' x 256 ) ) {
 	is( scalar(@$object),	       2,		'new() splits long argument' );
 	is( length( $object->value ),  length($string), 'object->value reassembles string' );
 	is( length( $object->string ), length($string), 'object->string reassembles string' );
 }
 
 
-{
-	my $utf8   = '\192\160';
-	my $filler = 'a' x 254;
-	my $string = join '', $filler, $utf8;
-	my $object = Net::DNS::Text->new($string);
+for my $object ( Net::DNS::Text->new( join '', ( my $filler = 'a' x 254 ), '\192\160' ) ) {
+	is( scalar(@$object),	    2,		     'new() splits long UTF8 sequence' );
 	is( length( $object->0 ), length($filler), 'new() does not break UTF8 sequence' );
 }
 
 
-{
-	my $sample = 'x\000x\031x\127x\128x\159\160\255x';
+for my $object ( Net::DNS::Text->new( my $sample = 'x\000x\031x\127x\128x\159\160\255x' ) ) {
 	my $expect = '7800781f787f7880789fa0ff78';
 	my $length = sprintf '%02x', length pack( 'H*', $expect );
-	my $object = Net::DNS::Text->new($sample);
 	my $buffer = $object->encode;
 	is( unpack( 'H*', $buffer ),	  $length . $expect, 'encode() returns expected data' );
 	is( unpack( 'H*', $object->raw ), $expect,	     'raw() returns expected data' );
 }
 
 
-{
-	my $sample = 'example';
-	my $buffer = Net::DNS::Text->new($sample)->encode;
-	my $object = decode Net::DNS::Text( \$buffer );
-	ok( $object->isa('Net::DNS::Text'), 'object returned by decode() constructor' );
-	is( $object->string, $sample, 'object matches original data' );
-	my ( $x, $next ) = decode Net::DNS::Text( \$buffer );
+for my $object ( Net::DNS::Text->new( my $sample = 'example' ) ) {
+	my $buffer = $object->encode;
+	my $decode = Net::DNS::Text->decode( \$buffer );
+	ok( $decode->isa('Net::DNS::Text'), 'decode() constructor' );
+	is( $decode->string, $sample, 'decode matches original data' );
+	my ( $x, $next ) = Net::DNS::Text->decode( \$buffer );
 	is( $next, length $buffer, 'expected offset returned by decode()' );
 }
 
 
-{
-	my $sample = 'example';
-	my $buffer = Net::DNS::Text->new($sample)->encode;
-	my ( $object, $next ) = decode Net::DNS::Text( \$buffer, 1, length($buffer) - 1 );
-	is( $object->string, $sample,	     'decode() extracts arbitrary substring' );
+for my $object ( Net::DNS::Text->new( my $sample = 'example' ) ) {
+	my $buffer = $object->encode;
+	my ( $decode, $next ) = Net::DNS::Text->decode( \$buffer, 1, length($buffer) - 1 );
+	is( $decode->string, $sample,	     'decode() extracts arbitrary substring' );
 	is( $next,	     length $buffer, 'expected offset returned by decode()' );
 }
 
 
-{
-	my $sample = 'example';
-	my $buffer = substr Net::DNS::Text->new($sample)->encode, 0, 2;
-	eval { my $object = decode Net::DNS::Text( \$buffer ); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "corrupt wire-format\t$exception" );
+my %C0controls = (
+	'000102030405060708090a0b0c0d0e0f' => '\000\001\002\003\004\005\006\007\008\009\010\011\012\013\014\015',
+	'101112131415161718191a1b1c1d1e1f' => '\016\017\018\019\020\021\022\023\024\025\026\027\028\029\030\031',
+	);
+
+foreach my $hexcode ( sort keys %C0controls ) {
+	my $string  = $C0controls{$hexcode};
+	my $content = pack 'H*',   $hexcode;
+	my $buffer  = pack 'C a*', length $content, $content;
+	my $decoded = Net::DNS::Text->decode( \$buffer );
+	my $compare = $decoded->string;
+	is( $compare, qq($string), "C0 controls:\t$string" );
 }
 
 
-{
-	my %testcase = (
-		'000102030405060708090a0b0c0d0e0f' =>
-				'\000\001\002\003\004\005\006\007\008\009\010\011\012\013\014\015',
-		'101112131415161718191a1b1c1d1e1f' =>
-				'\016\017\018\019\020\021\022\023\024\025\026\027\028\029\030\031',
-				);
-
-	foreach my $hexcode ( sort keys %testcase ) {
-		my $string  = $testcase{$hexcode};
-		my $content = pack 'H*',   $hexcode;
-		my $buffer  = pack 'C a*', length $content, $content;
-		my $decoded = decode Net::DNS::Text( \$buffer );
-		my $compare = $decoded->string;
-		is( $compare, qq($string), "C0 controls:\t$string" );
-	}
+my %ASCIIprintable = (
+	'202122232425262728292a2b2c2d2e2f' => q|" !\034#$%&'()*+,-./"|,
+	'303132333435363738393a3b3c3d3e3f' => q|"0123456789:;<=>?"|,
+	'404142434445464748494a4b4c4d4e4f' => '@ABCDEFGHIJKLMNO',
+	'505152535455565758595a5b5c5d5e5f' => 'PQRSTUVWXYZ\092^_',
+	'606162636465666768696a6b6c6d6e6f' => '`abcdefghijklmno',
+	'707172737475767778797a7b7c7d7e7f' => 'pqrstuvwxyz{|}~\127'
+	);
+
+foreach my $hexcode ( sort keys %ASCIIprintable ) {
+	my $string  = $ASCIIprintable{$hexcode};
+	my $content = pack 'H*',   $hexcode;
+	my $buffer  = pack 'C a*', length $content, $content;
+	my $decoded = Net::DNS::Text->decode( \$buffer );
+	my $compare = $decoded->string;
+	is( $compare, qq($string), "G0 graphics:\t$string" );
 }
 
 
-{
-	my %testcase = (
-		'202122232425262728292a2b2c2d2e2f' => q|" !\034#$%&'()*+,-./"|,
-		'303132333435363738393a3b3c3d3e3f' => q|"0123456789:;<=>?"|,
-		'404142434445464748494a4b4c4d4e4f' => '@ABCDEFGHIJKLMNO',
-		'505152535455565758595a5b5c5d5e5f' => 'PQRSTUVWXYZ\092^_',
-		'606162636465666768696a6b6c6d6e6f' => '`abcdefghijklmno',
-		'707172737475767778797a7b7c7d7e7f' => 'pqrstuvwxyz{|}~\127'
-		);
-
-	foreach my $hexcode ( sort keys %testcase ) {
-		my $string  = $testcase{$hexcode};
-		my $content = pack 'H*',   $hexcode;
-		my $buffer  = pack 'C a*', length $content, $content;
-		my $decoded = decode Net::DNS::Text( \$buffer );
-		my $compare = $decoded->string;
-		is( $compare, qq($string), "G0 graphics:\t$string" );
-	}
+my %unprintable = (
+	'808182838485868788898a8b8c8d8e8f' => '\128\129\130\131\132\133\134\135\136\137\138\139\140\141\142\143',
+	'909192939495969798999a9b9c9d9e9f' => '\144\145\146\147\148\149\150\151\152\153\154\155\156\157\158\159',
+	'a0a1a2a3a4a5a6a7a8a9aaabacadaeaf' => '\160\161\162\163\164\165\166\167\168\169\170\171\172\173\174\175',
+	'b0b1b2b3b4b5b6b7b8b9babbbcbdbebf' => '\176\177\178\179\180\181\182\183\184\185\186\187\188\189\190\191',
+	'c0c1c2c3c4c5c6c7c8c9cacbcccdcecf' => '\192\193\194\195\196\197\198\199\200\201\202\203\204\205\206\207',
+	'd0d1d2d3d4d5d6d7d8d9dadbdcdddedf' => '\208\209\210\211\212\213\214\215\216\217\218\219\220\221\222\223',
+	'e0e1e2e3e4e5e6e7e8e9eaebecedeeef' => '\224\225\226\227\228\229\230\231\232\233\234\235\236\237\238\239',
+	'f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff' => '\240\241\242\243\244\245\246\247\248\249\250\251\252\253\254\255'
+	);
+
+foreach my $hexcode ( sort keys %unprintable ) {
+	my $string  = $unprintable{$hexcode};
+	my $encoded = Net::DNS::Text->new($string)->encode;
+	is( unpack( 'xH*', $encoded ), $hexcode, qq(8-bit codes:\t$string) );
 }
 
 
-{
-	my %testcase = (
-		'808182838485868788898a8b8c8d8e8f' =>
-				'\128\129\130\131\132\133\134\135\136\137\138\139\140\141\142\143',
-		'909192939495969798999a9b9c9d9e9f' =>
-				'\144\145\146\147\148\149\150\151\152\153\154\155\156\157\158\159',
-		'a0a1a2a3a4a5a6a7a8a9aaabacadaeaf' =>
-				'\160\161\162\163\164\165\166\167\168\169\170\171\172\173\174\175',
-		'b0b1b2b3b4b5b6b7b8b9babbbcbdbebf' =>
-				'\176\177\178\179\180\181\182\183\184\185\186\187\188\189\190\191',
-		'c0c1c2c3c4c5c6c7c8c9cacbcccdcecf' =>
-				'\192\193\194\195\196\197\198\199\200\201\202\203\204\205\206\207',
-		'd0d1d2d3d4d5d6d7d8d9dadbdcdddedf' =>
-				'\208\209\210\211\212\213\214\215\216\217\218\219\220\221\222\223',
-		'e0e1e2e3e4e5e6e7e8e9eaebecedeeef' =>
-				'\224\225\226\227\228\229\230\231\232\233\234\235\236\237\238\239',
-		'f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff' =>
-				'\240\241\242\243\244\245\246\247\248\249\250\251\252\253\254\255'
-				);
-
-	foreach my $hexcode ( sort keys %testcase ) {
-		my $string  = $testcase{$hexcode};
-		my $encoded = Net::DNS::Text->new($string)->encode;
-		is( unpack( 'xH*', $encoded ), $hexcode, qq(8-bit codes:\t$string) );
-	}
-}
+exception( 'empty argument list', sub { Net::DNS::Text->new() } );
+exception( 'argument undefined',  sub { Net::DNS::Text->new(undef) } );
+
+my $truncated = substr Net::DNS::Text->new('example')->encode, 0, 2;
+exception( 'corrupt wire-format', sub { Net::DNS::Text->decode( \$truncated ) } );
+
+exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/03-header.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/03-header.t Changed

@@ -1,26 +1,23 @@
 #!/usr/bin/perl
-# $Id: 03-header.t 1815 2020-10-14 21:55:18Z willem $
+# $Id: 03-header.t 1910 2023-03-30 19:16:30Z willem $
 #
 
 use strict;
 use warnings;
-use Test::More;
+use Test::More tests => 75;
+use TestToolkit;
 
 use Net::DNS::Packet;
 use Net::DNS::Parameters;
 
-plan tests => 72;
-
 
 my $packet = Net::DNS::Packet->new(qw(. NS IN));
 my $header = $packet->header;
 ok( $header->isa('Net::DNS::Header'), 'packet->header object' );
 
 
-sub waggle {
-	my $object    = shift;
-	my $attribute = shift;
-	my @sequence  = @_;
+sub toggle {
+	my ( $object, $attribute, @sequence ) = @_;
 	for my $value (@sequence) {
 		my $change = $object->$attribute($value);
 		my $stored = $object->$attribute();
@@ -30,19 +27,23 @@
 }
 
 
-my $newid = Net::DNS::Packet->new()->header->id;
-waggle( $header, 'id', $header->id, $newid, $header->id );
+my $newid = Net::DNS::Packet->new()->header->id(0);
+ok( $newid, 'expected non-zero packet ID' );
+
+toggle( $header, 'opcode', qw(QUERY UPDATE DSO) );
+toggle( $header, 'id',	   $header->id, 0, $header->id );	# Zero ID => DSO unidirectional
+toggle( $header, 'opcode', qw(QUERY) );
+toggle( $header, 'id',	   $header->id, $newid, $header->id );
 
-waggle( $header, 'opcode', qw(STATUS UPDATE QUERY) );
-waggle( $header, 'rcode',  qw(REFUSED FORMERR NOERROR) );
+toggle( $header, 'rcode', qw(REFUSED FORMERR NOERROR) );
 
-waggle( $header, 'qr', 1, 0, 1, 0 );
-waggle( $header, 'aa', 1, 0, 1, 0 );
-waggle( $header, 'tc', 1, 0, 1, 0 );
-waggle( $header, 'rd', 0, 1, 0, 1 );
-waggle( $header, 'ra', 1, 0, 1, 0 );
-waggle( $header, 'ad', 1, 0, 1, 0 );
-waggle( $header, 'cd', 1, 0, 1, 0 );
+toggle( $header, 'qr', 1, 0, 1, 0 );
+toggle( $header, 'aa', 1, 0, 1, 0 );
+toggle( $header, 'tc', 1, 0, 1, 0 );
+toggle( $header, 'rd', 0, 1, 0, 1 );
+toggle( $header, 'ra', 1, 0, 1, 0 );
+toggle( $header, 'ad', 1, 0, 1, 0 );
+toggle( $header, 'cd', 1, 0, 1, 0 );
 
 
 #
@@ -61,6 +62,9 @@
 like( $header->string, '/upcount = 0/',	    'string() has upcount correct' );
 like( $header->string, '/adcount = 0/',	    'string() has adcount correct' );
 
+$header->opcode('DSO');
+like( $header->string, '/opcode = DSO/', 'string() has DSO opcode' );
+
 
 #
 # Check that the aliases work
@@ -77,20 +81,6 @@
 is( $header->adcount, $header->arcount, 'adcount value matches arcount' );
 
 
-foreach my $method (qw(qdcount ancount nscount arcount)) {
-	local $Net::DNS::Header::warned;
-	local $SIG{__WARN__} = sub { die @_ };
-
-	eval { $header->$method(1) };
-	my ($warning) = split /\n/, "$@\n";
-	ok( $warning, "$method read-only:\t$warning" );
-
-	eval { $header->$method(1) };
-	my ($repeated) = split /\n/, "$@\n";
-	ok( !$repeated, "warning not repeated:\t$repeated" );
-}
-
-
 my $data = $packet->data;
 
 my $packet2 = Net::DNS::Packet->new( \$data );
@@ -107,19 +97,19 @@
 
 	skip( 'EDNS header extensions not supported', 10 ) unless $edns->isa('Net::DNS::RR::OPT');
 
-	waggle( $header, 'do', 0, 1, 0, 1 );
-	waggle( $header, 'rcode', qw(BADVERS BADMODE BADNAME FORMERR NOERROR) );
+	toggle( $header, 'do', 0, 1, 0, 1 );
+	toggle( $header, 'rcode', qw(BADVERS BADMODE BADNAME FORMERR NOERROR) );
 
 	my $packet = Net::DNS::Packet->new();			# empty EDNS size solicitation
 	my $udplim = 1280;
-	$packet->edns->size($udplim);
+	$packet->edns->UDPsize($udplim);
 	my $encoded = $packet->data;
 	my $decoded = Net::DNS::Packet->new( \$encoded );
-	is( $decoded->edns->size, $udplim, 'EDNS size request assembled correctly' );
+	is( $decoded->edns->UDPsize, $udplim, 'EDNS size request assembled correctly' );
 }
 
 
-eval {					## exercise printing functions
+eval {					## no critic		# exercise printing functions
 	require IO::File;
 	my $file   = "03-header.tmp";
 	my $handle = IO::File->new( $file, '>' ) || die "Could not open $file for writing";
@@ -129,5 +119,12 @@
 };
 
 
+exception( 'qdcount read-only', sub { $header->qdcount(0) } );
+exception( 'ancount read-only', sub { $header->ancount(0) } );
+exception( 'nscount read-only', sub { $header->nscount(0) } );
+exception( 'adcount read-only', sub { $header->adcount(0) } );
+
+noexception( 'warnings not repeated', sub { $header->qdcount(0) } );
+
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/03-parameters.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/03-parameters.t Changed

@@ -1,133 +1,85 @@
 #!/usr/bin/perl
-# $Id: 03-parameters.t 1865 2022-05-21 09:57:49Z willem $	-*-perl-*-
+# $Id: 03-parameters.t 1921 2023-05-08 18:39:59Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
+use Test::More;
+use TestToolkit;
 
 use Net::DNS::Parameters qw(:class :type :opcode :rcode :ednsoption :dsotype);
 
-use Test::More tests => ( 5 + scalar keys %Net::DNS::Parameters::classbyval ) +
-		( 3 + scalar keys %Net::DNS::Parameters::typebyval ) +
-		( 3 + scalar keys %Net::DNS::Parameters::opcodebyval ) +
+plan tests => ( 5 + scalar keys %Net::DNS::Parameters::classbyval ) +
+		( 4 + scalar keys %Net::DNS::Parameters::typebyval ) +
+		( 5 + scalar keys %Net::DNS::Parameters::opcodebyval ) +
 		( 3 + scalar keys %Net::DNS::Parameters::rcodebyval ) +
 		( 2 + scalar keys %Net::DNS::Parameters::ednsoptionbyval ) +
 		( 2 + scalar keys %Net::DNS::Parameters::dsotypebyval );
 
 
-{					## check class conversion functions
-	my $anon = 65500;
-	foreach ( sort { $a <=> $b } $anon, keys %Net::DNS::Parameters::classbyval ) {
-		my $name	= classbyval($_);
-		my $code	= eval { classbyname($name) };
-		my ($exception) = split /\n/, "$@\n";
-		is( $code, $_, "classbyname($name)\t$exception" );
-	}
-
-	my $large = 65536;
-	foreach my $testcase ( "BOGUS", "Bogus", "CLASS$large" ) {
-		eval { classbyname($testcase); };
-		my ($exception) = split /\n/, "$@\n";
-		ok( $exception, "classbyname($testcase)\t$exception" );
-	}
-
-	eval { classbyval($large); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "classbyval($large)\t$exception" );
+foreach ( sort { $a <=> $b } 32767, keys %Net::DNS::Parameters::classbyval ) {
+	my $name = classbyval($_);	## check class conversion functions
+	my $code = eval { classbyname($name) };
+	is( $code, $_, "classbyname($name)" );
 }
 
 
-{					## check type conversion functions
-	foreach ( sort { $a <=> $b } keys %Net::DNS::Parameters::typebyval ) {
-		my $name	= typebyval($_);
-		my $code	= eval { typebyname($name) };
-		my ($exception) = split /\n/, "$@\n";
-		is( $code, $_, "typebyname($name)\t$exception" );
-	}
-	is( typebyname('*'), typebyname('ANY'), "typebyname(*)" );
-
-	my $large = 65536;
-	foreach my $testcase ("TYPE$large") {
-		eval { typebyname($testcase); };
-		my ($exception) = split /\n/, "$@\n";
-		ok( $exception, "typebyname($testcase)\t$exception" );
-	}
-
-	eval { typebyval($large); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "typebyval($large)\t$exception" );
+foreach ( sort { $a <=> $b } 65535, keys %Net::DNS::Parameters::typebyval ) {
+	my $name = typebyval($_);	## check type conversion functions
+	my $code = eval { typebyname($name) };
+	is( $code, $_, "typebyname($name)" );
 }
+is( typebyname('*'), typebyname('ANY'), "typebyname(*)" );
 
 
-{					## check OPCODE type conversion functions
-	my $anon = 255;
-	foreach ( sort { $a <=> $b } $anon, keys %Net::DNS::Parameters::opcodebyval ) {
-		my $name	= opcodebyval($_);
-		my $code	= eval { opcodebyname($name) };
-		my ($exception) = split /\n/, "$@\n";
-		is( $code, $_, "opcodebyname($name)\t$exception" );
-	}
-	is( opcodebyname('NS_NOTIFY_OP'), opcodebyname('NOTIFY'), "opcodebyname(NS_NOTIFY_OP)" );
-
-	foreach my $testcase ('BOGUS') {
-		eval { opcodebyname($testcase); };
-		my ($exception) = split /\n/, "$@\n";
-		ok( $exception, "opcodebyname($testcase)\t$exception" );
-	}
+foreach ( sort { $a <=> $b } 255, keys %Net::DNS::Parameters::opcodebyval ) {
+	my $name = opcodebyval($_);	## check OPCODE type conversion functions
+	my $code = eval { opcodebyname($name) };
+	is( $code, $_, "opcodebyname($name)" );
 }
+is( opcodebyname('NS_NOTIFY_OP'), opcodebyname('NOTIFY'), "opcodebyname(NS_NOTIFY_OP)" );
 
 
-{					## check RCODE conversion functions
-	my $anon = 4095;
-	foreach ( sort { $a <=> $b } $anon, keys %Net::DNS::Parameters::rcodebyval ) {
-		my $name	= rcodebyval($_);
-		my $code	= eval { rcodebyname($name) };
-		my ($exception) = split /\n/, "$@\n";
-		is( $code, $_, "rcodebyname($name)\t$exception" );
-	}
-	is( rcodebyname('BADVERS'), rcodebyname('BADSIG'), "rcodebyname(BADVERS)" );
-
-	foreach my $testcase ('BOGUS') {
-		eval { rcodebyname($testcase); };
-		my ($exception) = split /\n/, "$@\n";
-		ok( $exception, "rcodebyname($testcase)\t$exception" );
-	}
+foreach ( sort { $a <=> $b } 4095, keys %Net::DNS::Parameters::rcodebyval ) {
+	my $name = rcodebyval($_);	## check RCODE conversion functions
+	my $code = eval { rcodebyname($name) };
+	is( $code, $_, "rcodebyname($name)" );
 }
+is( rcodebyname('BADVERS'), rcodebyname('BADSIG'), "rcodebyname(BADVERS)" );
 
 
-{					## check EDNS option conversion functions
-	my $anon = 65535;
-	foreach ( sort { $a <=> $b } $anon, keys %Net::DNS::Parameters::ednsoptionbyval ) {
-		my $name	= ednsoptionbyval($_);
-		my $code	= eval { ednsoptionbyname($name) };
-		my ($exception) = split /\n/, "$@\n";
-		is( $code, $_, "ednsoptionbyname($name)\t$exception" );
-	}
-
-	foreach my $testcase ('BOGUS') {
-		eval { ednsoptionbyname($testcase); };
-		my ($exception) = split /\n/, "$@\n";
-		ok( $exception, "ednsoptionbyname($testcase)\t$exception" );
-	}
+foreach ( sort { $a <=> $b } 65535, keys %Net::DNS::Parameters::ednsoptionbyval ) {
+	my $name = ednsoptionbyval($_);	## check EDNS option conversion functions
+	my $code = eval { ednsoptionbyname($name) };
+	is( $code, $_, "ednsoptionbyname($name)" );
 }
 
 
-{					## check DSO type conversion functions
-	my $anon = 65535;
-	foreach ( sort { $a <=> $b } $anon, keys %Net::DNS::Parameters::dsotypebyval ) {
-		my $name	= dsotypebyval($_);
-		my $code	= eval { dsotypebyname($name) };
-		my ($exception) = split /\n/, "$@\n";
-		is( $code, $_, "dsotypebyname($name)\t$exception" );
-	}
-
-	foreach my $testcase ('BOGUS') {
-		eval { dsotypebyname($testcase); };
-		my ($exception) = split /\n/, "$@\n";
-		ok( $exception, "dsotypebyname($testcase)\t$exception" );
-	}
+foreach ( sort { $a <=> $b } 65535, keys %Net::DNS::Parameters::dsotypebyval ) {
+	my $name = dsotypebyval($_);	## check DSO type conversion functions
+	my $code = eval { dsotypebyname($name) };
+	is( $code, $_, "dsotypebyname($name)" );
 }
 
 
+exception( 'classbyval',  sub { classbyval(65536) } );
+exception( 'classbyname', sub { classbyname(65536) } );
+exception( 'classbyname', sub { classbyname('CLASS65536') } );
+exception( 'classbyname', sub { classbyname('BOGUS') } );
+
+exception( 'typebyval',	 sub { typebyval(65536) } );
+exception( 'typebyname', sub { typebyname(65536) } );
+exception( 'typebyname', sub { typebyname('CLASS65536') } );
+exception( 'typebyname', sub { typebyname('BOGUS') } );
+
+exception( 'opcodebyname', sub { opcodebyname('BOGUS') } );
+
+exception( 'rcodebyname', sub { rcodebyname('BOGUS') } );
+
+exception( 'ednsoptionbyname', sub { ednsoptionbyname('BOGUS') } );
+
+exception( 'dsotypebyname', sub { dsotypebyname('BOGUS') } );
+
+
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/03-question.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/03-question.t Changed

@@ -1,27 +1,25 @@
 #!/usr/bin/perl
-# $Id: 03-question.t 1864 2022-04-14 15:18:49Z willem $	-*-perl-*-
+# $Id: 03-question.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
+use Test::More tests => 105;
+use TestToolkit;
 
 use Net::DNS::Question;
 use Net::DNS::Parameters;
 
-use Test::More tests => 105;
-
 
-{
-	my $name     = 'example.com';
-	my $question = Net::DNS::Question->new( $name, 'A', 'IN' );
+for my $question ( Net::DNS::Question->new( my $name = 'example.com', 'A', 'IN' ) ) {
 	ok( $question->isa('Net::DNS::Question'), 'object returned by new() constructor' );
 
 	is( $question->qname,  $name,		 '$question->qname returns expected value' );
 	is( $question->qtype,  'A',		 '$question->qtype returns expected value' );
 	is( $question->qclass, 'IN',		 '$question->qclass returns expected value' );
-	is( $question->name,   $question->qname, '$question->name returns expected value' );
+	is( $question->name,   $name,		 '$question->name returns expected value' );
 	is( $question->type,   $question->qtype, '$question->type returns expected value' );
-	is( $question->zname,  $question->qname, '$question->zname returns expected value' );
+	is( $question->zname,  $name,		 '$question->zname returns expected value' );
 	is( $question->ztype,  $question->qtype, '$question->ztype returns expected value' );
 	is( $question->zclass, $question->class, '$question->zclass returns expected value' );
 
@@ -39,165 +37,122 @@
 }
 
 
-{
+foreach my $class (qw(IN CLASS1 ANY)) {
 	my $test = 'new() arguments in zone file order';
 	my $fqdn = 'example.com.';
-	foreach my $class (qw(IN CLASS1 ANY)) {
-		foreach my $type (qw(A TYPE1 ANY)) {
-			my $testcase = Net::DNS::Question->new( $fqdn, $class, $type )->string;
-			my $expected = Net::DNS::Question->new( $fqdn, $type,  $class )->string;
-			is( $testcase, $expected, "$test\t( $fqdn,\t$class,\t$type\t)" );
-		}
+	foreach my $type (qw(A TYPE1 ANY)) {
+		my $testcase = Net::DNS::Question->new( $fqdn, $class, $type )->string;
+		my $expected = Net::DNS::Question->new( $fqdn, $type,  $class )->string;
+		is( $testcase, $expected, "$test\t( $fqdn,\t$class,\t$type\t)" );
 	}
 }
 
 
-{
-	my $question	= eval { Net::DNS::Question->new(undef); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "argument undefined\t$exception" );
-}
-
-
-{
-	foreach my $method (qw(qname qtype qclass name)) {
-		my $question	= eval { Net::DNS::Question->new('.')->$method('name'); };
-		my ($exception) = split /\n/, "$@\n";
-		ok( $exception, "$method read-only:\t$exception" );
-	}
-}
-
-
-{
-	my $wiredata	= pack 'H*', '000001';
-	my $question	= eval { decode Net::DNS::Question( \$wiredata ); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "corrupt wire-format\t$exception" );
-}
-
-
-{
+foreach my $class (qw(IN HS ANY)) {
 	my $test = 'decoded object matches encoded data';
-	foreach my $class (qw(IN HS ANY)) {
-		foreach my $type (qw(A AAAA MX NS SOA ANY)) {
-			my $question = Net::DNS::Question->new( 'example.com', $type, $class );
-			my $encoded  = $question->encode;
-			my $expected = $question->string;
-			my $decoded  = decode Net::DNS::Question( \$encoded );
-			is( $decoded->string, $expected, "$test\t$expected" );
-		}
+	foreach my $type (qw(A AAAA MX NS SOA ANY)) {
+		my $question = Net::DNS::Question->new( 'example.com', $type, $class );
+		my $encoded  = $question->encode;
+		my $expected = $question->string;
+		my $decoded  = Net::DNS::Question->decode( \$encoded );
+		is( $decoded->string, $expected, "$test\t$expected" );
 	}
 }
 
 
-{
-	my $question = Net::DNS::Question->new('example.com');
-	my $encoded  = $question->encode;
-	my ( $decoded, $offset ) = decode Net::DNS::Question( \$encoded );
+for my $question ( Net::DNS::Question->new('example.com') ) {
+	my $encoded = $question->encode;
+	my ( $decoded, $offset ) = Net::DNS::Question->decode( \$encoded );
 	is( $offset, length($encoded), 'returned offset has expected value' );
 }
 
 
-{
-	my @part = ( 1 .. 4 );
-	while (@part) {
-		my $test   = 'interpret IPv4 prefix as PTR query';
-		my $prefix = join '.', @part;
-		my $domain = Net::DNS::Question->new($prefix);
-		my $actual = $domain->qname;
-		my $invert = join '.', reverse 'in-addr.arpa', @part;
-		my $inaddr = Net::DNS::Question->new($invert);
-		my $expect = $inaddr->qname;
-		is( $actual, $expect, "$test\t$prefix" );
-		pop @part;
-	}
-}
-
-
-{
-	foreach my $type (qw(NS SOA ANY)) {
-		my $test     = "query $type in in-addr.arpa namespace";
-		my $question = Net::DNS::Question->new( '1.2.3.4', $type );
-		my $qtype    = $question->qtype;
-		my $string   = $question->string;
-		is( $qtype, $type, "$test\t$string" );
-	}
+my @IPv4part = ( 1 .. 4 );
+while (@IPv4part) {
+	my $test   = 'interpret IPv4 prefix as PTR query';
+	my $prefix = join '.', @IPv4part;
+	my $domain = Net::DNS::Question->new($prefix);
+	my $actual = $domain->qname;
+	my $invert = join '.', reverse 'in-addr.arpa', @IPv4part;
+	my $inaddr = Net::DNS::Question->new($invert);
+	my $expect = $inaddr->qname;
+	is( $actual, $expect, "$test\t$prefix" );
+	pop @IPv4part;
 }
 
 
-{
-	foreach my $n ( 32, 24, 16, 8 ) {
-		my $ip4	   = '1.2.3.4';
-		my $test   = "accept CIDR address/$n prefix syntax";
-		my $m	   = ( ( $n + 7 ) >> 3 ) << 3;
-		my $actual = Net::DNS::Question->new("$ip4/$n");
-		my $expect = Net::DNS::Question->new("$ip4/$m");
-		my $string = $expect->qname;
-		is( $actual->qname, $expect->qname, "$test\t$string" );
-	}
+foreach my $type (qw(NS SOA ANY)) {
+	my $test     = "query $type in in-addr.arpa namespace";
+	my $question = Net::DNS::Question->new( '1.2.3.4', $type );
+	my $qtype    = $question->qtype;
+	my $string   = $question->string;
+	is( $qtype, $type, "$test\t$string" );
 }
 
 
-{
-	is(	Net::DNS::Question->new('1:2:3:4:5:6:7:8')->string,
-		"8.0.0.0.7.0.0.0.6.0.0.0.5.0.0.0.4.0.0.0.3.0.0.0.2.0.0.0.1.0.0.0.ip6.arpa.\tIN\tPTR",
-		'interpret IPv6 address as PTR query in ip6.arpa namespace'
-		);
-	is(	Net::DNS::Question->new('::ffff:192.0.2.1')->string,
-		"1.2.0.192.in-addr.arpa.\tIN\tPTR",
-		'interpret IPv6 form of IPv4 address as query in in-addr.arpa'
-		);
-	is(	Net::DNS::Question->new('1:2:3:4:5:6:192.0.2.1')->string,
-		"1.0.2.0.0.0.0.c.6.0.0.0.5.0.0.0.4.0.0.0.3.0.0.0.2.0.0.0.1.0.0.0.ip6.arpa.\tIN\tPTR",
-		'interpret IPv6 + embedded IPv4 address as query in ip6.arpa'
-		);
-	is( Net::DNS::Question->new(':x:')->string,
-		":x:.\tIN\tA", 'non-address character precludes interpretation as PTR query' );
-	is( Net::DNS::Question->new(':.:')->string,
-		":.:.\tIN\tA", 'non-numeric character precludes interpretation as PTR query' );
+foreach my $n ( 32, 24, 16, 8 ) {
+	my $ip4	   = '1.2.3.4';
+	my $test   = "accept CIDR address/$n prefix syntax";
+	my $m	   = ( ( $n + 7 ) >> 3 ) << 3;
+	my $actual = Net::DNS::Question->new("$ip4/$n");
+	my $expect = Net::DNS::Question->new("$ip4/$m");
+	my $string = $expect->qname;
+	is( $actual->qname, $expect->qname, "$test\t$string" );
 }
 
 
-{
-	my @part = ( 1 .. 8 );
-	while (@part) {
-		my $n	   = 16 * scalar(@part);
-		my $test   = 'interpret IPv6 prefix as PTR query';
-		my $prefix = join ':', @part;
-		my $actual = Net::DNS::Question->new($prefix)->qname;
-		my $expect = Net::DNS::Question->new("$prefix/$n")->qname;
-		is( $actual, $expect, "$test\t$prefix" ) if $prefix =~ /:/;
-		pop @part;
-	}
+is(	Net::DNS::Question->new('1:2:3:4:5:6:7:8')->string,
+	"8.0.0.0.7.0.0.0.6.0.0.0.5.0.0.0.4.0.0.0.3.0.0.0.2.0.0.0.1.0.0.0.ip6.arpa.\tIN\tPTR",
+	'interpret IPv6 address as PTR query in ip6.arpa namespace'
+	);
+is(	Net::DNS::Question->new('::ffff:192.0.2.1')->string,
+	"1.2.0.192.in-addr.arpa.\tIN\tPTR",
+	'interpret IPv6 form of IPv4 address as query in in-addr.arpa'
+	);
+is(	Net::DNS::Question->new('1:2:3:4:5:6:192.0.2.1')->string,
+	"1.0.2.0.0.0.0.c.6.0.0.0.5.0.0.0.4.0.0.0.3.0.0.0.2.0.0.0.1.0.0.0.ip6.arpa.\tIN\tPTR",
+	'interpret IPv6 + embedded IPv4 address as query in ip6.arpa'
+	);
+is( Net::DNS::Question->new(':x:')->string,
+	":x:.\tIN\tA", 'non-address character precludes interpretation as PTR query' );
+is( Net::DNS::Question->new(':.:')->string,
+	":.:.\tIN\tA", 'non-numeric character precludes interpretation as PTR query' );
+
+
+my @IPv6part = ( 1 .. 8 );
+while (@IPv6part) {
+	my $n	   = 16 * scalar(@IPv6part);
+	my $test   = 'interpret IPv6 prefix as PTR query';
+	my $prefix = join ':', @IPv6part;
+	my $actual = Net::DNS::Question->new($prefix)->qname;
+	my $expect = Net::DNS::Question->new("$prefix/$n")->qname;
+	is( $actual, $expect, "$test\t$prefix" ) if $prefix =~ /:/;
+	pop @IPv6part;
 }
 
 
-{
-	foreach my $n ( 16, 12, 8, 4 ) {
-		my $ip6	   = '1234:5678:9012:3456:7890:1234:5678:9012';
-		my $test   = "accept IPv6 address/$n prefix syntax";
-		my $m	   = ( ( $n + 3 ) >> 2 ) << 2;
-		my $actual = Net::DNS::Question->new("$ip6/$n");
-		my $expect = Net::DNS::Question->new("$ip6/$m");
-		my $string = $expect->qname;
-		is( $actual->qname, $expect->qname, "$test\t$string" );
-	}
+foreach my $n ( 16, 12, 8, 4 ) {
+	my $ip6	   = '1234:5678:9012:3456:7890:1234:5678:9012';
+	my $test   = "accept IPv6 address/$n prefix syntax";
+	my $m	   = ( ( $n + 3 ) >> 2 ) << 2;
+	my $actual = Net::DNS::Question->new("$ip6/$n");
+	my $expect = Net::DNS::Question->new("$ip6/$m");
+	my $string = $expect->qname;
+	is( $actual->qname, $expect->qname, "$test\t$string" );
 }
 
 
-{
+foreach my $i ( reverse 0 .. 6 ) {
 	my $expected = length Net::DNS::Question->new('1:2:3:4:5:6:7:8')->qname;
-	foreach my $i ( reverse 0 .. 6 ) {
-		foreach my $j ( $i + 3 .. 9 ) {
-			my $ip6	 = join( ':', 1 .. $i ) . '::' . join( ':', $j .. 8 );
-			my $name = Net::DNS::Question->new("$ip6")->qname;
-			is( length $name, $expected, "check length of expanded IPv6 address\t$ip6" );
-		}
+	foreach my $j ( $i + 3 .. 9 ) {
+		my $ip6	 = join( ':', 1 .. $i ) . '::' . join( ':', $j .. 8 );
+		my $name = Net::DNS::Question->new("$ip6")->qname;
+		is( length $name, $expected, "check length of expanded IPv6 address\t$ip6" );
 	}
 }
 
 
-eval {					## exercise but do not test print
+eval {					## no critic		# exercise but do not test print
 	require IO::File;
 	my $object = Net::DNS::Question->new('example.com');
 	my $file   = '03-question.txt';
@@ -208,5 +163,12 @@
 };
 
 
+exception( 'argument undefined',  sub { Net::DNS::Question->new(undef) } );
+exception( 'corrupt wire-format', sub { my $wire = pack 'H*', '000001'; Net::DNS::Question->decode( \$wire ) } );
+
+foreach my $method (qw(qname qtype qclass name)) {
+	exception( "$method is read-only", sub { Net::DNS::Question->new('.')->$method('any') } );
+}
+
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/03-rr.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/03-rr.t Changed

@@ -1,57 +1,46 @@
 #!/usr/bin/perl
-# $Id: 03-rr.t 1864 2022-04-14 15:18:49Z willem $	-*-perl-*-
+# $Id: 03-rr.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 108;
+use Test::More tests => 106;
+use TestToolkit;
 
-use Net::DNS::RR;
 
+use_ok('Net::DNS::RR');
 
-{					## check exception raised for unparsable argument
-	foreach my $testcase ( undef, '', ' ', '. NULL x', '. OPT x', '. ATMA x', , {} ) {
-		my $test = defined $testcase ? "'$testcase'" : 'undef';
-		eval { Net::DNS::RR->new($testcase) };
-		my ($exception) = split /\n/, "$@\n";
-		ok( $exception, "Net::DNS::RR->new($test)\t$exception" );
-	}
-}
 
-
-{					## check plausible ways to create empty record
-	foreach my $testcase (
-		'example.com	A',
-		'example.com	IN',
-		'example.com	IN A',
-		'example.com	IN 123 A',
-		'example.com	123 A',
-		'example.com	123 IN A',
-		'example.com	123 In Aaaa',
-		'example.com	A \\# 0',
-		) {
-		my $rr = Net::DNS::RR->new("$testcase");
-		is( length( $rr->rdata ), 0, "Net::DNS::RR->new( $testcase )" );
-	}
+foreach my $testcase (			## check plausible ways to create empty record
+	'example.com	A',
+	'example.com	IN',
+	'example.com	IN A',
+	'example.com	IN 123 A',
+	'example.com	123 A',
+	'example.com	123 IN A',
+	'example.com	123 In Aaaa',
+	'example.com	A \\# 0',
+	) {
+	my $rr = Net::DNS::RR->new("$testcase");
+	is( length( $rr->rdata ), 0, "Net::DNS::RR->new( $testcase )" );
 }
 
 
-{					## check basic functions
-	my ( $name, $class, $ttl, $type, $rdata ) = qw(example.com IN 123 A 192.0.2.1);
-	my $rr	  = Net::DNS::RR->new("$name $ttl $class $type $rdata");
-	my $rdlen = length( $rr->rdata );
+my ( $name, $class, $ttl, $type, $rdata ) = qw(example.com IN 123 A 192.0.2.1);
+for my $rr ( Net::DNS::RR->new("$name $ttl $class $type $rdata") ) {
+	my $rdlen = length $rr->rdata;	## check basic functions
+	is( $rr->name,	   $name,  'expected value returned by $rr->name' );
 	is( $rr->owner,	   $name,  'expected value returned by $rr->owner' );
 	is( $rr->type,	   $type,  'expected value returned by $rr->type' );
 	is( $rr->class,	   $class, 'expected value returned by $rr->class' );
-	is( $rr->ttl,	   $ttl,   'expected value returned by $rr->ttl' );
+	is( $rr->TTL,	   $ttl,   'expected value returned by $rr->TTL' );
 	is( $rr->rdstring, $rdata, 'expected value returned by $rr->rdstring' );
 	is( $rr->rdlength, $rdlen, 'expected value returned by $rr->rdlength' );
 }
 
 
-{					## check basic parsing of all acceptable forms of A record
-	my $example  = Net::DNS::RR->new('example.com. 0 IN A 192.0.2.1');
-	my $expected = $example->string;
+for my $example ( Net::DNS::RR->new('example.com. 0 IN A 192.0.2.1') ) {
+	my $expect = $example->string;	## check basic parsing of all acceptable forms of A record
 	foreach my $testcase (
 		join( "\t", qw( example.com 0 IN A ), q(\# 4 c0 00 02 01) ),
 		join( "\t", qw( example.com 0 IN A ), q(\# 4 c0000201 ) ),
@@ -74,14 +63,13 @@
 		) {
 		my $rr = Net::DNS::RR->new("$testcase");
 		$rr->ttl( $example->ttl );			# TTL only shown if defined
-		is( $rr->string, $expected, "Net::DNS::RR->new( $testcase )" );
+		is( $rr->string, $expect, "Net::DNS::RR->new( $testcase )" );
 	}
 }
 
 
-{					## check parsing of comments, quotes and brackets
-	my $example  = Net::DNS::RR->new('example.com. 0 IN TXT "txt-data"');
-	my $expected = $example->string;
+for my $example ( Net::DNS::RR->new('example.com. 0 IN TXT "txt-data"') ) {
+	my $expect = $example->string;	## check parsing of comments, quotes and brackets
 	foreach my $testcase (
 		q(example.com 0 IN TXT txt-data ; space delimited),
 		q(example.com 0	   TXT txt-data),
@@ -102,204 +90,104 @@
 		) {
 		my $rr = Net::DNS::RR->new("$testcase");
 		$rr->ttl( $example->ttl );			# TTL only shown if defined
-		is( $rr->string, $expected, "Net::DNS::RR->new( $testcase )" );
-	}
-}
-
-
-{					## check parsing of implemented RR type with hexadecimal RDATA
-	my @common   = qw( example.com. 3600 IN TXT );
-	my $expected = join "\t", @common, q("two separate" "quoted strings");
-	my $testcase = join "\t", @common, q(\# 28 0c74776f2073657061726174650e71756f74656420737472696e6773);
-	my $rr	     = Net::DNS::RR->new("$testcase");
-	is( $rr->string, $expected, "Net::DNS::RR->new( $testcase )" );
-}
-
-
-{					## check for exception if RFC3597 format hexadecimal data inconsistent
-	foreach my $testcase ( '\# 0 c0 00 02 01', '\# 3 c0 00 02 01', '\# 5 c0 00 02 01' ) {
-		eval { Net::DNS::RR->new("example.com 3600 IN A $testcase") };
-		my ($exception) = split /\n/, "$@\n";
-		ok( $exception, "mismatched length: $testcase\t$exception" );
-	}
-}
-
-
-{					## check object construction from attribute list
-	foreach my $testcase ( type => 'A', address => '192.0.2.1', type => 'A', address => '192.0.2.1', ) {
-		my $rr = Net::DNS::RR->new(@$testcase);
-		is( length( $rr->rdata ), 4, "Net::DNS::RR->new( @$testcase )" );
-	}
-
-	foreach my $testcase (
-		type => 'A',		rdata => '',
-		name => 'example.com', type  => 'MX',
-		type => 'MX',		class => 'IN', ttl => 123,
-		) {
-		my $rr = Net::DNS::RR->new(@$testcase);
-		is( length( $rr->rdata ), 0, "Net::DNS::RR->new( @$testcase )" );
+		is( $rr->string, $expect, "Net::DNS::RR->new( $testcase )" );
 	}
 }
 
 
-{					## check for exception for nonexistent attribute
-	my $method = 'bogus-method';
-	foreach my $testcase ( type => 'A', type => 'ATMA', type => 'ATMA', unimplemented => 'x', ) {
-		eval { Net::DNS::RR->new(@$testcase)->$method('x') };
-		my ($exception) = split /\n/, "$@\n";
-		ok( $exception, "unknown method:\t$exception" );
-	}
-	my $rr = Net::DNS::RR->new( type => 'A' );
-	is( $rr->$method, undef, 'suppress repeated unknown method exception' );
-	is( $rr->DESTROY, undef, 'DESTROY() exists to placate pre-5.18 AUTOLOAD' );
-}
-
-
-{					## check for exception on bad class method
-	eval { xxxx Net::DNS::RR( type => 'X' ); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "unknown class method:\t$exception" );
-}
-
-
-{					## check for exception if RR name not recognised
-	eval { Net::DNS::RR->new('example.com. IN BOGUS') };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "unrecognised RR type:\t$exception" );
-}
-
-
-{					## check for exception when abusing $rr->type()
-	my $rr = Net::DNS::RR->new( type => 'A' );
-	eval { $rr->type('X'); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "cannot change type:\t$exception" );
-}
-
-
-{					## check for exception when abusing $rr->ttl()
-	my $rr = Net::DNS::RR->new( type => 'A' );
-	eval { $rr->ttl('1year'); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "unknown time unit:\t$exception" );
+foreach my $testcase (			## check object construction from attribute list
+	type => 'A', address => '192.0.2.1',
+	type => 'A', address => '192.0.2.1',
+	) {
+	my $rdata = Net::DNS::RR->new(@$testcase)->rdata;
+	my @array = map { ref($_) ? "@$_" : $_ } @$testcase;
+	is( length($rdata), 4, "Net::DNS::RR->new(@array)" );
 }
 
-
-{					## check for exception when abusing $rr->rdata()
-	my $rr = Net::DNS::RR->new( type => 'SOA' );
-	eval { $rr->rdata( pack 'H* H*', '00c000', '00000001' x 5 ); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "compressed rdata:\t$exception" );
+foreach my $testcase (
+	type => 'A',		rdata => '',
+	name => 'example.com', type  => 'MX',
+	type => 'MX',		class => 'IN', ttl => 123,
+	) {
+	my $rr = Net::DNS::RR->new(@$testcase);
+	is( length( $rr->rdstring ), 0, "Net::DNS::RR->new( @$testcase )" );
 }
 
 
-{					## check propagation of exception in string()
-					## (relies on bug that nobody cares enough to fix)
-	my $rr = Net::DNS::RR->new( type => 'MINFO', emailbx => '.' );
-	local $SIG{__WARN__} = sub { die @_ };
-	eval { $rr->string() };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "exception in string:\t$exception" );
-}
-
-
-{					## check propagation of exception in rdstring()
-					## (relies on bug that nobody cares enough to fix)
-	my $rr = Net::DNS::RR->new( type => 'MINFO', emailbx => '.' );
-	local $SIG{__WARN__} = sub { die @_ };
-	eval { $rr->rdatastr() };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "exception in rdstring:\t$exception" );
-}
-
-
-{					## check encode/decode functions
-	foreach my $testcase (
-		'example.com	A',
-		'example.com	IN',
-		'example.com	IN A',
-		'example.com	IN 123 A',
-		'example.com	123 A',
-		'example.com	123 IN A',
-		'example.com	A 192.0.2.1',
-		) {
-		my $rr	    = Net::DNS::RR->new("$testcase");
-		my $encoded = $rr->encode;
-		my $decoded = decode Net::DNS::RR( \$encoded );
-		$rr->ttl( $decoded->ttl ) unless $rr->ttl;
-		is( $decoded->string, $rr->string, "encode/decode $testcase" );
-	}
-
-	my $opt	    = Net::DNS::RR->new( type => 'OPT' );
-	my $encoded = $opt->encode;
-	my ( $decoded, $offset ) = decode Net::DNS::RR( \$encoded );
-	is( $decoded->string, $opt->string,	"encode/decode OPT RR" );
-	is( $offset,	      length($encoded), "decode returns offset of next RR" );
+foreach my $testcase (			## check encode/decode functions
+	'example.com	A',
+	'example.com	IN',
+	'example.com	IN A',
+	'example.com	IN 123 A',
+	'example.com	123 A',
+	'example.com	123 IN A',
+	'example.com	A 192.0.2.1',
+	'1.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.8.B.D.0.1.0.0.2.ip6.arpa	PTR example.com.'
+	) {
+	my $rr	    = Net::DNS::RR->new("$testcase");
+	my $encoded = $rr->encode;
+	my $decoded = Net::DNS::RR->decode( \$encoded );
+	$rr->ttl( $decoded->ttl ) unless $rr->ttl;
+	is( $decoded->string, $rr->string, "encode/decode $testcase" );
 }
 
 
-{					## check canonical encode function
-	foreach my $testcase ( 'example.com 123 IN A', 'EXAMPLE.com 123 A 192.0.2.1', ) {
-		my $rr	      = Net::DNS::RR->new("$testcase");
-		my $expected  = unpack 'H*', $rr->encode(0);
-		my $canonical = unpack 'H*', $rr->canonical;
-		is( $canonical, $expected, "canonical encode $testcase" );
-	}
+for my $rr ( Net::DNS::RR->new( type => 'OPT' ) ) {
+	my $encoded = $rr->encode;	## check OPT decode special case
+	my ( $decoded, $offset ) = Net::DNS::RR->decode( \$encoded );
+	is( $offset, length($encoded), 'decode OPT RR' );
 }
 
 
-{
-	foreach my $testcase ( '', '000001', '0000010001000000010004', ) {
-		my $wiredata	= pack 'H*', $testcase;
-		my $question	= eval { decode Net::DNS::RR( \$wiredata ); };
-		my ($exception) = split /\n/, "$@\n";
-		ok( $exception, "corrupt wire-format\t$exception" );
-	}
+foreach my $testcase (			## check canonical encode function
+	'example.com 0 IN A',
+	'EXAMPLE.com 123 A 192.0.2.1',
+	) {
+	my $rr	      = Net::DNS::RR->new("$testcase");
+	my $expected  = unpack 'H*', $rr->encode(0);
+	my $canonical = unpack 'H*', $rr->canonical;
+	is( $canonical, $expected, "canonical encode $testcase" );
 }
 
 
-{					## check plain and generic formats
-	my @testcase = (
-		owner => 'example.com.', type => 'A',
-		owner => 'example.com.', type => 'A', rdata => '',
-		'example.com.	IN	NS	a.iana-servers.net.',
-			'example.com.	IN	SOA	(
-				sns.dns.icann.org. noc.dns.icann.org.
-				2015082417	;serial
-				7200		;refresh
-				3600		;retry
-				1209600		;expire
-				3600		;minimum
-			)'
-			,
-		owner => 'example.com.', type => 'ATMA',	# unimplemented
-		owner => 'example.com.', type => 'ATMA', rdata => '',
-		owner => 'example.com.', type => 'ATMA', rdata => 'octets',
-		);
-	foreach my $testcase (@testcase) {
-		my $rr	  = Net::DNS::RR->new(@$testcase);
-		my $type  = $rr->type;
-		my $plain = Net::DNS::RR->new( $rr->plain );
-		is( $plain->string, $rr->string, "parse rr->plain format $type" );
-		my $rfc3597 = Net::DNS::RR->new( $rr->generic );
-		is( $rfc3597->string, $rr->string, "parse rr->generic format $type" );
-	}
+foreach my $testcase (			## check plain and generic formats
+	owner => 'example.com.', type => 'A',
+	owner => 'example.com.', type => 'A', rdata => '',
+	'example.com.	IN	NS	a.iana-servers.net.',
+		'example.com.	IN	SOA	(
+			sns.dns.icann.org. noc.dns.icann.org.
+			2015082417	;serial
+			7200		;refresh
+			3600		;retry
+			1209600		;expire
+			3600		;minimum
+		)'
+		,
+	owner => 'example.com.', type => 'ATMA',	## unimplemented
+	owner => 'example.com.', type => 'ATMA', rdata => '',
+	owner => 'example.com.', type => 'ATMA', rdata => 'octets',
+	) {
+	my $rr	  = Net::DNS::RR->new(@$testcase);
+	my $type  = $rr->type;
+	my $plain = Net::DNS::RR->new( $rr->plain );
+	is( $plain->string, $rr->string, "parse rr->plain format $type" );
+	my $rfc3597 = Net::DNS::RR->new( $rr->generic );
+	is( $rfc3597->string, $rr->string, "parse rr->generic format $type" );
 }
 
 
-{					## check RR sorting functions
-	foreach my $attr ( , 'preference', 'X' ) {
-		my $func = Net::DNS::RR::MX->get_rrsort_func(@$attr);
-		is( ref($func), 'CODE', "MX->get_rrsort_func(@$attr)" );
-	}
+foreach my $attr ( , 'preference', 'X' ) {	## check RR sorting functions
+	my $func = Net::DNS::RR::MX->get_rrsort_func(@$attr);
+	is( ref($func), 'CODE', "MX->get_rrsort_func(@$attr)" );
 }
 
 
-eval {					## exercise printing functions
+eval {					## no critic	# exercise printing functions
 	require Data::Dumper;
 	require IO::File;
 	local $Data::Dumper::Maxdepth;
 	local $Data::Dumper::Sortkeys;
+	local $Data::Dumper::Useqq;
 	my $object = Net::DNS::RR->new('example.com A 192.0.2.1');
 	my $file   = "03-rr.tmp";
 	my $handle = IO::File->new( $file, '>' ) || die "Could not open $file for writing";
@@ -307,6 +195,7 @@
 	select( ( select($handle), $object->dump )0 );
 	$Data::Dumper::Maxdepth = 6;
 	$Data::Dumper::Sortkeys = 1;
+	$Data::Dumper::Useqq	= 1;
 	select( ( select($handle), $object->dump )0 );
 	close($handle);
 	unlink($file);
@@ -315,5 +204,36 @@
 };
 
 
+is( Net::DNS::RR->new( type => 'A' )->DESTROY, undef, 'DESTROY() exists to placate pre-5.18 AUTOLOAD' );
+
+exception( 'unrecognised class method', sub { Net::DNS::RR->unknown() } );
+noexception( 'RR->unknown() returns undef', sub { die if defined Net::DNS::RR->unknown() } );
+
+exception( "unparsable RR->new(undef)", sub { Net::DNS::RR->new(undef) } );
+exception( "unparsable RR->new(  )",	sub { Net::DNS::RR->new(  ) } );
+exception( "unparsable RR->new( {} )",	sub { Net::DNS::RR->new( {} ) } );
+
+exception( "unparsable RR->new('()')",	      sub { Net::DNS::RR->new('()') } );
+exception( "unparsable RR->new('. NULL x')",  sub { Net::DNS::RR->new('. NULL x') } );
+exception( "unparsable RR->new('. ATMA x')",  sub { Net::DNS::RR->new('. ATMA x') } );
+exception( "unparsable RR->new('. BOGUS x')", sub { Net::DNS::RR->new('. BOGUS x') } );
+
+foreach ( '# 0 c0000201', '# 3 c0000201', '# 5 c0000201' ) {
+	exception( "mismatched length $_", sub { Net::DNS::RR->new(". A $_") } );
+}
+
+exception( 'RR type is immutable',   sub { Net::DNS::RR->new( type => 'AAAA' )->type('BOGUS') } );
+exception( 'unrecognised time unit', sub { Net::DNS::RR->new( type => 'AAAA' )->ttl('1y') } );
+exception( 'unrecognised method',    sub { Net::DNS::RR->new( type => 'AAAA',  bogus   => 0 ) } );
+exception( 'unimplemented RRtype',   sub { Net::DNS::RR->new( type => 'ATMA',  bogus   => 0 ) } );
+exception( 'RR->string warning',     sub { Net::DNS::RR->new( type => 'MINFO', emailbx => '.' )->string } );
+exception( 'RR->rdstring warning',   sub { Net::DNS::RR->new( type => 'MINFO', emailbx => '.' )->rdstring } );
+
+foreach ( '', '0841424344454647480001', '0000010001000000010004', ) {
+	exception( 'decode(corrupt data)', sub { Net::DNS::RR->decode( \pack 'H*', $_ ) } );
+}
+
+exception( 'rdatastr deprecation warning', sub { Net::DNS::RR->new( type => 'AAAA' )->rdatastr for ( 1 .. 2 ) } );
+
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/04-packet-truncate.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/04-packet-truncate.t Changed

@@ -1,5 +1,5 @@
 #!/usr/bin/perl
-# $Id: 04-packet-truncate.t 1815 2020-10-14 21:55:18Z willem $ -*-perl-*-
+# $Id: 04-packet-truncate.t 1910 2023-03-30 19:16:30Z willem $ -*-perl-*-
 #
 
 use strict;
@@ -13,8 +13,7 @@
 
 my @rr = $source->read;
 
-{
-	my $packet = Net::DNS::Packet->new('query.example.');
+for my $packet ( Net::DNS::Packet->new('query.example.') ) {
 	$packet->push( answer	  => @rr );
 	$packet->push( authority  => @rr );
 	$packet->push( additional => @rr );
@@ -32,8 +31,7 @@
 }
 
 
-{
-	my $packet = Net::DNS::Packet->new('query.example.');
+for my $packet ( Net::DNS::Packet->new('query.example.') ) {
 	$packet->push( answer	  => @rr );
 	$packet->push( authority  => @rr );
 	$packet->push( additional => @rr );
@@ -51,8 +49,7 @@
 }
 
 
-{
-	my $packet = Net::DNS::Packet->new('query.example.');
+for my $packet ( Net::DNS::Packet->new('query.example.') ) {
 	$packet->push( answer	  => @rr );
 	$packet->push( authority  => @rr );
 	$packet->push( additional => @rr );
@@ -77,12 +74,11 @@
 }
 
 
-{
-	my $packet = Net::DNS::Packet->new('query.example.');
-	my @auth   = map { Net::DNS::RR->new( type => 'NS', nsdname => $_->name ) } @rr;
+for my $packet ( Net::DNS::Packet->new('query.example.') ) {
+	my @auth = map { Net::DNS::RR->new( type => 'NS', nsdname => $_->name ) } @rr;
 	$packet->unique_push( authority => @auth );
 	$packet->push( additional => @rr );
-	$packet->edns->size(2048);				# + all bells and whistles
+	$packet->edns->UDPsize(2048);				# + all bells and whistles
 	my $unlimited = length $packet->data;
 	my %before    = map { ( $_, scalar $packet->$_ ) } qw(answer authority additional);
 	my $truncated = length $packet->truncate;
@@ -103,8 +99,7 @@
 }
 
 
-{
-	my $packet = Net::DNS::Packet->new('query.example.');
+for my $packet ( Net::DNS::Packet->new('query.example.') ) {
 	$packet->push( additional => @rr, @rr );		# two of everything
 	my $unlimited = length $packet->data;
 	my $truncated = length $packet->truncate( $unlimited >> 1 );

_service:tar_scm:Net-DNS-1.34.tar.gz/t/04-packet.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/04-packet.t Changed

@@ -1,14 +1,16 @@
 #!/usr/bin/perl
-# $Id: 04-packet.t 1856 2021-12-02 14:36:25Z willem $	-*-perl-*-
+# $Id: 04-packet.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 103;
+use Test::More tests => 102;
+use TestToolkit;
 
 
 use_ok('Net::DNS::Packet');
 
+
 #	new() class constructor method must return object of appropriate class
 my $object = Net::DNS::Packet->new();
 ok( $object->isa('Net::DNS::Packet'), 'new() object' );
@@ -20,6 +22,9 @@
 ok( $object->edns->isa('Net::DNS::RR::OPT'), 'edns() returns OPT RR object' );
 
 like( $object->string, '/HEADER/', 'string() returns representation of packet' );
+$object->header->do(1);
+$object->encode();
+like( $object->string, '/EDNS/', 'string() contains representation of EDNS' );
 $object->header->opcode('UPDATE');
 like( $object->string, '/UPDATE/', 'string() returns representation of update' );
 
@@ -68,18 +73,6 @@
 ok( Net::DNS::Packet->new( \$dso_packet )->string, 'decoded DSO packet' );
 
 
-#	new(\$data) class constructor captures exception text when data truncated
-my @data = unpack 'C*', $packet->data;
-while (@data) {
-	pop(@data);
-	my $truncated	= pack 'C*', @data;
-	my $length	= length $truncated;
-	my $object	= Net::DNS::Packet->new( \$truncated );
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "truncated ($length octets):\t$exception" );
-}
-
-
 #	Use push() to add RRs to each section
 my $update = Net::DNS::Packet->new('.');
 my $index;
@@ -152,6 +145,12 @@
 }
 
 
+for my $packet ( Net::DNS::Packet->new('example.com') ) {
+	my $case1 = $packet->pop('');	## check tolerance of invalid pop
+	my $case2 = $packet->pop('bogus');
+}
+
+
 #	Test using a predefined answer.
 #	This is an answer that was generated by a bind server, with an option munged on the end.
 
@@ -166,69 +165,37 @@
 is( $bind->header->nscount, 1, 'check authority count in synthetic packet header' );
 is( $bind->header->adcount, 1, 'check additional count in synthetic packet header' );
 
-my ($rr) = $bind->additional;
-
-is( $rr->type, 'OPT',  'Additional section packet is EDNS0 type' );
-is( $rr->size, '4096', 'EDNS0 packet size correct' );
-
-
-{					## check tolerance of invalid pop
-	my $packet = Net::DNS::Packet->new('example.com');
-	my $case1  = $packet->pop('');
-	my $case2  = $packet->pop('bogus');
-}
-
-
-{					## check $packet->reply()
-	my $packet = Net::DNS::Packet->new('example.com');
-	my $reply  = $packet->reply();
+for my $packet ( Net::DNS::Packet->new('example.com') ) {
+	my $reply = $packet->reply();	## check $packet->reply()
 	ok( $reply->isa('Net::DNS::Packet'), '$packet->reply() returns packet' );
-	eval { $reply->reply(); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "reply->reply()\t$exception" );
+
 	my $udpmax = 2048;
-	$packet->edns->size($udpmax);
+	$packet->edns->udpsize($udpmax);
 	$packet->data;
-	is( $packet->reply($udpmax)->edns->size(), $udpmax, 'packet->reply() supports EDNS' );
+	is( $packet->reply($udpmax)->edns->udpsize(), $udpmax, 'packet->reply() supports EDNS' );
 }
 
 
-{					## check $packet->sigrr
-	my $packet = Net::DNS::Packet->new();
-	is( $packet->sigrr(), undef, 'sigrr() undef for empty packet' );
-	$packet->push( additional => Net::DNS::RR->new( type => 'OPT' ) );
+for my $packet ( Net::DNS::Packet->new() ) {	## check $packet->sigrr
+	my $sigrr = Net::DNS::RR->new( type => 'TSIG' );
+	my $other = Net::DNS::RR->new( type => 'AAAA' );
+	$packet->unique_push( 'additional' => $other );
 	is( $packet->sigrr(),  undef, 'sigrr() undef for unsigned packet' );
 	is( $packet->verify(), undef, 'verify() fails for unsigned packet' );
 	ok( $packet->verifyerr(), 'verifyerr() returned for unsigned packet' );
+	is( ref( $packet->sign_tsig($sigrr) ), ref($sigrr), 'sign_tsig() returns TSIG record' );
+	is( $packet->verifyerr(),	       '',	    'verifyerr() returns empty string' );
+	$packet->push( 'additional' => $sigrr );
+	is( ref( $packet->sigrr() ), ref($sigrr), 'sigrr() returns TSIG record' );
 }
 
 
-{					## go through the motions of SIG0
-	my $packet = Net::DNS::Packet->new('example.com');
-	my $sig	   = Net::DNS::RR->new( type => 'SIG' );
-	ok( $packet->sign_sig0($sig), 'sign_sig0() returns SIG0 record' );
-	is( ref( $packet->sigrr() ), ref($sig), 'sigrr() returns SIG RR' );
-
-	eval { $packet->sign_sig0(  ); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "sign_sig0()\t$exception" );
-}
-
-
-{					## check exception raised for bad TSIG
-	my $packet = Net::DNS::Packet->new('example.com');
-	my $bogus  = Net::DNS::RR->new( type => 'NULL' );
-	eval { $packet->sign_tsig($bogus); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "sign_tsig()\t$exception" );
-}
-
-
-eval {					## exercise dump and debug diagnostics
+eval {					## no critic		# exercise dump and debug diagnostics
 	require IO::File;
 	require Data::Dumper;
 	local $Data::Dumper::Maxdepth;
 	local $Data::Dumper::Sortkeys;
+	local $Data::Dumper::Useqq;
 	my $packet  = Net::DNS::Packet->new();
 	my $buffer  = $packet->data;
 	my $corrupt = substr $buffer, 0, 10;
@@ -237,6 +204,7 @@
 	select( ( select($handle), $packet->dump )0 );
 	$Data::Dumper::Maxdepth = 6;
 	$Data::Dumper::Sortkeys = 1;
+	$Data::Dumper::Useqq	= 1;
 	select( ( select($handle), $packet->dump )0 );
 	select( ( select($handle), Net::DNS::Packet->new( \$buffer,  1 )->dump )0 );
 	select( ( select($handle), Net::DNS::Packet->new( \$corrupt, 1 ) )0 );
@@ -245,5 +213,20 @@
 };
 
 
+for my $packet ( Net::DNS::Packet->new(qw(example.com. A IN)) ) {
+	my $wire = $packet->data;
+	while ( length($wire) ) {
+		chop($wire);
+		my $n = length($wire);	## Note: need to re-raise exception trapped by constructor
+		exception( "decode truncated ($n octets)", sub { Net::DNS::Packet->decode( \$wire ); die } );
+	}
+
+	my $sig = Net::DNS::RR->new( type => 'SIG' );
+	exception( 'reply->reply()', sub { $packet->reply->reply } );
+	exception( 'sign_tsig(...)', sub { $packet->sign_tsig($packet) } );
+	exception( 'sign_sig0(...)', sub { $packet->sign_sig0($packet) } );
+	exception( 'sig0 verify()',  sub { $packet->sign_sig0($sig); $packet->verify } );
+}
+
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-A.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-A.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-A.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-A.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 12;
+use Test::More tests => 9;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = 'c0000201';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,37 +40,26 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my %testcase = (
-		'1.2.3.4' => '1.2.3.4',
-		'1.2.4'	  => '1.2.0.4',
-		'1.4'	  => '1.0.0.4',
-		);
+my %IPv4completion = (
+	'1.2.3.4' => '1.2.3.4',
+	'1.2.4'	  => '1.2.0.4',
+	'1.4'	  => '1.0.0.4',
+	);
 
-	foreach my $address ( sort keys %testcase ) {
-		my $expect = $testcase{$address};
-		my $rr	   = Net::DNS::RR->new( name => $name, type => $type, address => $address );
-		is( $rr->address, $expect, "address completion:\t$address" );
-	}
+foreach my $address ( sort keys %IPv4completion ) {
+	my $expect = $IPv4completion{$address};
+	my $rr	   = Net::DNS::RR->new( name => $name, type => $type, address => $address );
+	is( $rr->address, $expect, "address completion:\t$address" );
 }

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-AAAA.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-AAAA.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-AAAA.t 1857 2021-12-07 13:38:02Z willem $	-*-perl-*-
+# $Id: 05-AAAA.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 136;
+use Test::More tests => 133;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = '000102030405060708090a0b0c0d0e0f';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,123 +40,110 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my %testcase = (
-		'0:0:0:0:0:0:0:0' => '::',
-		'0:0:0:0:0:0:0:8' => '::8',
-		'0:0:0:0:0:0:7:0' => '::7:0',
-		'0:0:0:0:0:6:0:0' => '::6:0:0',
-		'0:0:0:0:0:6:0:8' => '::6:0:8',
-		'0:0:0:0:5:0:0:0' => '::5:0:0:0',
-		'0:0:0:0:5:0:0:8' => '::5:0:0:8',
-		'0:0:0:0:5:0:7:0' => '::5:0:7:0',
-		'0:0:0:4:0:0:0:0' => '0:0:0:4::',
-		'0:0:0:4:0:0:0:8' => '::4:0:0:0:8',
-		'0:0:0:4:0:0:7:0' => '::4:0:0:7:0',
-		'0:0:0:4:0:6:0:0' => '::4:0:6:0:0',
-		'0:0:0:4:0:6:0:8' => '::4:0:6:0:8',
-		'0:0:3:0:0:0:0:0' => '0:0:3::',
-		'0:0:3:0:0:0:0:8' => '0:0:3::8',
-		'0:0:3:0:0:0:7:0' => '0:0:3::7:0',
-		'0:0:3:0:0:6:0:0' => '::3:0:0:6:0:0',
-		'0:0:3:0:0:6:0:8' => '::3:0:0:6:0:8',
-		'0:0:3:0:5:0:0:0' => '0:0:3:0:5::',
-		'0:0:3:0:5:0:0:8' => '::3:0:5:0:0:8',
-		'0:0:3:0:5:0:7:0' => '::3:0:5:0:7:0',
-		'0:2:0:0:0:0:0:0' => '0:2::',
-		'0:2:0:0:0:0:0:8' => '0:2::8',
-		'0:2:0:0:0:0:7:0' => '0:2::7:0',
-		'0:2:0:0:0:6:0:0' => '0:2::6:0:0',
-		'0:2:0:0:0:6:0:8' => '0:2::6:0:8',
-		'0:2:0:0:5:0:0:0' => '0:2:0:0:5::',
-		'0:2:0:0:5:0:0:8' => '0:2::5:0:0:8',
-		'0:2:0:0:5:0:7:0' => '0:2::5:0:7:0',
-		'0:2:0:4:0:0:0:0' => '0:2:0:4::',
-		'0:2:0:4:0:0:0:8' => '0:2:0:4::8',
-		'0:2:0:4:0:0:7:0' => '0:2:0:4::7:0',
-		'0:2:0:4:0:6:0:0' => '0:2:0:4:0:6::',
-		'0:2:0:4:0:6:0:8' => '0:2:0:4:0:6:0:8',
-		'1:0:0:0:0:0:0:0' => '1::',
-		'1:0:0:0:0:0:0:8' => '1::8',
-		'1:0:0:0:0:0:7:0' => '1::7:0',
-		'1:0:0:0:0:6:0:0' => '1::6:0:0',
-		'1:0:0:0:0:6:0:8' => '1::6:0:8',
-		'1:0:0:0:5:0:0:0' => '1::5:0:0:0',
-		'1:0:0:0:5:0:0:8' => '1::5:0:0:8',
-		'1:0:0:0:5:0:7:0' => '1::5:0:7:0',
-		'1:0:0:4:0:0:0:0' => '1:0:0:4::',
-		'1:0:0:4:0:0:0:8' => '1:0:0:4::8',
-		'1:0:0:4:0:0:7:0' => '1::4:0:0:7:0',
-		'1:0:0:4:0:6:0:0' => '1::4:0:6:0:0',
-		'1:0:0:4:0:6:0:8' => '1::4:0:6:0:8',
-		'1:0:3:0:0:0:0:0' => '1:0:3::',
-		'1:0:3:0:0:0:0:8' => '1:0:3::8',
-		'1:0:3:0:0:0:7:0' => '1:0:3::7:0',
-		'1:0:3:0:0:6:0:0' => '1:0:3::6:0:0',
-		'1:0:3:0:0:6:0:8' => '1:0:3::6:0:8',
-		'1:0:3:0:5:0:0:0' => '1:0:3:0:5::',
-		'1:0:3:0:5:0:0:8' => '1:0:3:0:5::8',
-		'1:0:3:0:5:0:7:0' => '1:0:3:0:5:0:7:0',
-		);
-
-	foreach my $address ( sort keys %testcase ) {
-		my $compact = $testcase{$address};
-		my $rr1	    = Net::DNS::RR->new( name => $name, type => $type, address => $address );
-		is( $rr1->address_short, $compact, "address compression:\t$address" );
-		my $rr2 = Net::DNS::RR->new( name => $name, type => $type, address => $compact );
-		is( $rr2->address_long, $address, "address expansion:\t$compact" );
-	}
+my %IPv6compression = (
+	'0:0:0:0:0:0:0:0' => '::',
+	'0:0:0:0:0:0:0:8' => '::8',
+	'0:0:0:0:0:0:7:0' => '::7:0',
+	'0:0:0:0:0:6:0:0' => '::6:0:0',
+	'0:0:0:0:0:6:0:8' => '::6:0:8',
+	'0:0:0:0:5:0:0:0' => '::5:0:0:0',
+	'0:0:0:0:5:0:0:8' => '::5:0:0:8',
+	'0:0:0:0:5:0:7:0' => '::5:0:7:0',
+	'0:0:0:4:0:0:0:0' => '0:0:0:4::',
+	'0:0:0:4:0:0:0:8' => '::4:0:0:0:8',
+	'0:0:0:4:0:0:7:0' => '::4:0:0:7:0',
+	'0:0:0:4:0:6:0:0' => '::4:0:6:0:0',
+	'0:0:0:4:0:6:0:8' => '::4:0:6:0:8',
+	'0:0:3:0:0:0:0:0' => '0:0:3::',
+	'0:0:3:0:0:0:0:8' => '0:0:3::8',
+	'0:0:3:0:0:0:7:0' => '0:0:3::7:0',
+	'0:0:3:0:0:6:0:0' => '::3:0:0:6:0:0',
+	'0:0:3:0:0:6:0:8' => '::3:0:0:6:0:8',
+	'0:0:3:0:5:0:0:0' => '0:0:3:0:5::',
+	'0:0:3:0:5:0:0:8' => '::3:0:5:0:0:8',
+	'0:0:3:0:5:0:7:0' => '::3:0:5:0:7:0',
+	'0:2:0:0:0:0:0:0' => '0:2::',
+	'0:2:0:0:0:0:0:8' => '0:2::8',
+	'0:2:0:0:0:0:7:0' => '0:2::7:0',
+	'0:2:0:0:0:6:0:0' => '0:2::6:0:0',
+	'0:2:0:0:0:6:0:8' => '0:2::6:0:8',
+	'0:2:0:0:5:0:0:0' => '0:2:0:0:5::',
+	'0:2:0:0:5:0:0:8' => '0:2::5:0:0:8',
+	'0:2:0:0:5:0:7:0' => '0:2::5:0:7:0',
+	'0:2:0:4:0:0:0:0' => '0:2:0:4::',
+	'0:2:0:4:0:0:0:8' => '0:2:0:4::8',
+	'0:2:0:4:0:0:7:0' => '0:2:0:4::7:0',
+	'0:2:0:4:0:6:0:0' => '0:2:0:4:0:6::',
+	'0:2:0:4:0:6:0:8' => '0:2:0:4:0:6:0:8',
+	'1:0:0:0:0:0:0:0' => '1::',
+	'1:0:0:0:0:0:0:8' => '1::8',
+	'1:0:0:0:0:0:7:0' => '1::7:0',
+	'1:0:0:0:0:6:0:0' => '1::6:0:0',
+	'1:0:0:0:0:6:0:8' => '1::6:0:8',
+	'1:0:0:0:5:0:0:0' => '1::5:0:0:0',
+	'1:0:0:0:5:0:0:8' => '1::5:0:0:8',
+	'1:0:0:0:5:0:7:0' => '1::5:0:7:0',
+	'1:0:0:4:0:0:0:0' => '1:0:0:4::',
+	'1:0:0:4:0:0:0:8' => '1:0:0:4::8',
+	'1:0:0:4:0:0:7:0' => '1::4:0:0:7:0',
+	'1:0:0:4:0:6:0:0' => '1::4:0:6:0:0',
+	'1:0:0:4:0:6:0:8' => '1::4:0:6:0:8',
+	'1:0:3:0:0:0:0:0' => '1:0:3::',
+	'1:0:3:0:0:0:0:8' => '1:0:3::8',
+	'1:0:3:0:0:0:7:0' => '1:0:3::7:0',
+	'1:0:3:0:0:6:0:0' => '1:0:3::6:0:0',
+	'1:0:3:0:0:6:0:8' => '1:0:3::6:0:8',
+	'1:0:3:0:5:0:0:0' => '1:0:3:0:5::',
+	'1:0:3:0:5:0:0:8' => '1:0:3:0:5::8',
+	'1:0:3:0:5:0:7:0' => '1:0:3:0:5:0:7:0',
+	);
+
+foreach my $address ( sort keys %IPv6compression ) {
+	my $compact = $IPv6compression{$address};
+	my $rr1	    = Net::DNS::RR->new( name => $name, type => $type, address => $address );
+	is( $rr1->address_short, $compact, "address compression:\t$address" );
+	my $rr2 = Net::DNS::RR->new( name => $name, type => $type, address => $compact );
+	is( $rr2->address_long, $address, "address expansion:\t$compact" );
 }
 
 
-{
-	my %testcase = (
-		'1'		 => '1:0:0:0:0:0:0:0',
-		'1:'		 => '1:0:0:0:0:0:0:0',
-		'1:2'		 => '1:2:0:0:0:0:0:0',
-		'1:2:'		 => '1:2:0:0:0:0:0:0',
-		'1:2:3'		 => '1:2:3:0:0:0:0:0',
-		'1:2:3:'	 => '1:2:3:0:0:0:0:0',
-		'1:2:3:4'	 => '1:2:3:4:0:0:0:0',
-		'1:2:3:4:'	 => '1:2:3:4:0:0:0:0',
-		'1:2:3:4:5'	 => '1:2:3:4:5:0:0:0',
-		'1:2:3:4:5:'	 => '1:2:3:4:5:0:0:0',
-		'1:2:3:4:5:6'	 => '1:2:3:4:5:6:0:0',
-		'1:2:3:4:5:6:'	 => '1:2:3:4:5:6:0:0',
-		'1:2:3:4:5:6:7'	 => '1:2:3:4:5:6:7:0',
-		'1:2:3:4:5:6:7:' => '1:2:3:4:5:6:7:0',
-		'::ffff:1.2.3.4' => '0:0:0:0:0:ffff:102:304',
-		'::ffff:1.2.4'	 => '0:0:0:0:0:ffff:102:4',
-		'::ffff:1.4'	 => '0:0:0:0:0:ffff:100:4',
-		);
-
-	foreach my $address ( sort keys %testcase ) {
-		my $expect = Net::DNS::RR->new(
-			name	=> $name,
-			type	=> $type,
-			address => $testcase{$address} );
-		my $rr = Net::DNS::RR->new( name => $name, type => $type, address => $address );
-		is( $rr->address, $expect->address, "address completion:\t$address" );
-	}
+my %IPv6completion = (
+	'1'		 => '1:0:0:0:0:0:0:0',
+	'1:'		 => '1:0:0:0:0:0:0:0',
+	'1:2'		 => '1:2:0:0:0:0:0:0',
+	'1:2:'		 => '1:2:0:0:0:0:0:0',
+	'1:2:3'		 => '1:2:3:0:0:0:0:0',
+	'1:2:3:'	 => '1:2:3:0:0:0:0:0',
+	'1:2:3:4'	 => '1:2:3:4:0:0:0:0',
+	'1:2:3:4:'	 => '1:2:3:4:0:0:0:0',
+	'1:2:3:4:5'	 => '1:2:3:4:5:0:0:0',
+	'1:2:3:4:5:'	 => '1:2:3:4:5:0:0:0',
+	'1:2:3:4:5:6'	 => '1:2:3:4:5:6:0:0',
+	'1:2:3:4:5:6:'	 => '1:2:3:4:5:6:0:0',
+	'1:2:3:4:5:6:7'	 => '1:2:3:4:5:6:7:0',
+	'1:2:3:4:5:6:7:' => '1:2:3:4:5:6:7:0',
+	'::ffff:1.2.3.4' => '0:0:0:0:0:ffff:102:304',
+	'::ffff:1.2.4'	 => '0:0:0:0:0:ffff:102:4',
+	'::ffff:1.4'	 => '0:0:0:0:0:ffff:100:4',
+	);
+
+foreach my $address ( sort keys %IPv6completion ) {
+	my $expect = Net::DNS::RR->new(
+		name	=> $name,
+		type	=> $type,
+		address => $IPv6completion{$address} );
+	my $rr = Net::DNS::RR->new( name => $name, type => $type, address => $address );
+	is( $rr->address, $expect->address, "address completion:\t$address" );
 }

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-AFSDB.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-AFSDB.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-AFSDB.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-AFSDB.t 1911 2023-04-17 12:30:59Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 15;
+use Test::More tests => 9;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = '303904686f7374076578616d706c6503636f6d00';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,39 +40,17 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
-}
-
-
-{
-	my $lc		= Net::DNS::RR->new( lc ". $type @data" );
-	my $rr		= Net::DNS::RR->new( uc ". $type @data" );
-	my $hash	= {};
-	my $predecessor = $rr->encode( 0,		    $hash );
-	my $compressed	= $rr->encode( length $predecessor, $hash );
-	ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' );
-	isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' );
-	is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-AMTRELAY.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-AMTRELAY.t Changed

@@ -1,10 +1,11 @@
 #!/usr/bin/perl
-# $Id: 05-AMTRELAY.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-AMTRELAY.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 32;
+use Test::More tests => 26;
+use TestToolkit;
 
 use Net::DNS;
 
@@ -18,20 +19,14 @@
 
 my $wire = '0a8309616d7472656c617973076578616d706c6503636f6d00';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,39 +41,17 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
-}
-
-
-{
-	my $lc		= Net::DNS::RR->new( lc ". $type @data" );
-	my $rr		= Net::DNS::RR->new( uc ". $type @data" );
-	my $hash	= {};
-	my $predecessor = $rr->encode( 0,		    $hash );
-	my $compressed	= $rr->encode( length $predecessor, $hash );
-	ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' );
-	isnt( $rr->encode,    $lc->encode, 'encoded RDATA names not downcased' );
-	isnt( $rr->canonical, $lc->encode, 'canonical RDATA names not downcased' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new("$name $type @data");
+for my $rr ( Net::DNS::RR->new("$name $type @data") ) {
 	foreach ( undef, qw(192.0.2.38 2001:db8:0:8002:0:0:2000:1 relay.example.com) ) {
 		my $relay = $_ || '.';
 		$rr->D( !$rr->D );				# toggle D-bit
@@ -93,26 +66,16 @@
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "$_ attribute of empty RR undefined" );
 	}
-}
-
 
-{
-	my $rr = eval { Net::DNS::RR->new( type => $type, relay => 'X' ); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "unrecognised relay type\t$exception" );
+	exception( 'unrecognised relay ttype', sub { $rr->relay('X') } );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new("$name $type @data");
-	$rr->print;
-}
+Net::DNS::RR->new("$name $type @data")->print;
 
 exit;
 
-

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-APL.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-APL.t Changed

@@ -1,10 +1,11 @@
 #!/usr/bin/perl
-# $Id: 05-APL.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-APL.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 31;
+use Test::More tests => 28;
+use TestToolkit;
 
 use Net::DNS;
 
@@ -18,20 +19,14 @@
 
 my $wire = '00010401e000021001ff00011c83c0a8260001000000020000';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -44,8 +39,7 @@
 }
 
 
-{
-	my $rr = Net::DNS::RR->new("$name $type @data");
+for my $rr ( Net::DNS::RR->new("$name $type @data") ) {
 	foreach my $item ( $rr->aplist ) {
 		foreach (@also) {
 			ok( defined( $item->$_ ), "aplist item->$_() attribute" );
@@ -54,40 +48,23 @@
 }
 
 
-{
-	my $rr	    = Net::DNS::RR->new("$name $type @data");
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
+for my $rr ( Net::DNS::RR->new("$name $type @data") ) {
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
-
-	my @wire = unpack 'C*', $encoded;
-	$wirelength($empty) - 1--;
-	my $wireformat = pack 'C*', @wire;
-	eval { Net::DNS::RR->decode( \$wireformat ); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "corrupt wire-format\t$exception" );
-}
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 
-
-{
-	eval { Net::DNS::RR->new("$name $type 0:0::0/0"); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "unknown address family\t$exception" );
+	my $emptyrr = Net::DNS::RR->new("$name $type")->encode;
+	my $corrupt = pack 'a*X2na*', $emptyrr, $decoded->rdlength - 1, $rr->rdata;
+	exception( 'corrupt wire-format', sub { Net::DNS::RR->decode( \$corrupt ) } );
 }
 
 
+exception( 'unknown address family', sub { Net::DNS::RR->new("$name $type 0:0::0/0") } );
+
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-CAA.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-CAA.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-CAA.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-CAA.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 17;
+use Test::More tests => 14;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = '800569737375656578616d706c652e6e6574';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -47,27 +41,17 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}
@@ -77,11 +61,7 @@
 }
 
 
-{
-	my $rr = Net::DNS::RR->new("$name $type @data");
-	$rr->print;
-}
-
+Net::DNS::RR->new("$name $type @data")->print;
 
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-CDNSKEY.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-CDNSKEY.t Changed

@@ -1,5 +1,5 @@
 #!/usr/bin/perl
-# $Id: 05-CDNSKEY.t 1857 2021-12-07 13:38:02Z willem $	-*-perl-*-
+# $Id: 05-CDNSKEY.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
@@ -18,7 +18,7 @@
 	exit;
 }
 
-plan tests => 35;
+plan tests => 34;
 
 
 my $name = 'CDNSKEY.example';
@@ -26,6 +26,9 @@
 my $code = 60;
 my @attr = qw( flags protocol algorithm publickey );
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
+
 my @data = (
 	256, 3, 5, join '', qw(
 			AQPSKmynfzW4kyBv015MUG2DeIQ3
@@ -45,19 +48,10 @@
 		7D5468DBEFE3 );
 
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
-
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
+my $hash = {};
+@{$hash}{@attr} = @data;
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -72,28 +66,20 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $empty   = Net::DNS::RR->new("$name NULL");
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = uc unpack 'H*', $decoded->encode;
 	my $hex2    = uc unpack 'H*', $encoded;
-	my $hex3    = uc unpack 'H*', substr( $encoded, length $empty->encode );
+	my $hex3    = uc unpack 'H*', $rr->rdata;
 	is( $hex1, $hex2, 'encode/decode transparent' );
 	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach ( @attr, qw(keylength keytag rdstring) ) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}
-}
-
-
-{
-	my $rr = Net::DNS::RR->new(". $type");
 
 	$rr->algorithm(255);
 	is( $rr->algorithm(), 255, 'algorithm number accepted' );
@@ -104,40 +90,25 @@
 }
 
 
-{
-	my @arg = qw(0 3 0 AA==);				# per RFC8078(4), erratum 5049
-	my $rr	= Net::DNS::RR->new("$name. $type @arg");
-	ok( ref($rr), "DNSKEY delete: $name. $type @arg" );
+for my $rr ( Net::DNS::RR->new("$name. $type 0 3 0 AA==") ) {	# per RFC8078(4), erratum 5049
+	ok( ref($rr), "DNSKEY delete: $name. $type 0 3 0 AA==" );
 	is( $rr->flags(),     0, 'DNSKEY delete: flags 0' );
 	is( $rr->protocol(),  3, 'DNSKEY delete: protocol 3' );
 	is( $rr->algorithm(), 0, 'DNSKEY delete: algorithm 0' );
 
-	is( $rr->string(), "$name.\tIN\t$type\t@arg", 'DNSKEY delete: presentation format' );
-
 	my $rdata = unpack 'H*', $rr->rdata();
 	is( $rdata, '0000030000', 'DNSKEY delete: rdata wire-format' );
-}
 
-
-{
-	my @arg = qw(0 3 0 0);					# per RFC8078(4) as published
-	my $rr	= Net::DNS::RR->new("$name. $type @arg");
-	is( $rr->rdstring(), '0 3 0 AA==', 'DNSKEY delete: accept old format' );
+	is( $rr->rdstring(), '0 3 0 AA==', 'DNSKEY delete: presentation format' );
 }
 
 
-{
-	my @arg = qw(0 0 0 -);					# unexpected empty field
-	my $rr	= Net::DNS::RR->new("$name. $type @arg");
-	is( $rr->rdstring(), '0 3 0 -', 'DNSKEY delete: represent empty key' );
+for my $rr ( Net::DNS::RR->new("$name. $type 0 3 0 0") ) {	# per RFC8078(4) as published
+	is( $rr->rdstring(), '0 3 0 AA==', 'DNSKEY delete: accept old format' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new("$name $type @data");
-	$rr->print;
-}
-
+Net::DNS::RR->new("$name $type @data")->print;
 
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-CDS.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-CDS.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-CDS.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-CDS.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 31;
+use Test::More tests => 30;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = join '', qw( EC45 05 01 2BB183AF5F22588179A53B0A98631FAD1A292118 );
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,28 +40,20 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $empty   = Net::DNS::RR->new("$name $type");
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = uc unpack 'H*', $decoded->encode;
 	my $hex2    = uc unpack 'H*', $encoded;
-	my $hex3    = uc unpack 'H*', substr( $encoded, length $empty->encode );
+	my $hex3    = uc unpack 'H*', $rr->rdata;
 	is( $hex1, $hex2, 'encode/decode transparent' );
 	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach ( @attr, 'rdstring' ) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}
-}
-
-
-{
-	my $rr = Net::DNS::RR->new(". $type");
 
 	$rr->algorithm(255);
 	is( $rr->algorithm(), 255, 'algorithm number accepted' );
@@ -83,39 +69,25 @@
 }
 
 
-{
-	my @arg = qw(0 0 0 00);					# per RFC8078(4), erratum 5049
-	my $rr	= Net::DNS::RR->new("$name. $type @arg");
-	ok( ref($rr), "DS delete: $name. $type @arg" );
+for my $rr ( Net::DNS::RR->new("$name. $type 0 0 0 00") ) {	# per RFC8078(4), erratum 5049
+	ok( ref($rr), "DS delete: $name. $type 0 0 0 00" );
 	is( $rr->keytag(),    0, 'DS delete: keytag 0' );
 	is( $rr->algorithm(), 0, 'DS delete: algorithm 0' );
 	is( $rr->digtype(),   0, 'DS delete: digtype 0' );
 
-	is( $rr->string(), "$name.\tIN\t$type\t@arg", 'DS delete: presentation format' );
-
 	my $rdata = unpack 'H*', $rr->rdata();
 	is( $rdata, '0000000000', 'DS delete: rdata wire-format' );
-}
-
 
-{
-	my @arg = qw(0 0 0 0);					# per RFC8078(4) as published
-	my $rr	= Net::DNS::RR->new("$name. $type @arg");
-	is( $rr->rdstring(), '0 0 0 00', 'DS delete: accept old format' );
+	is( $rr->rdstring(), '0 0 0 00', 'DS delete: presentation format' );
 }
 
 
-{
-	my @arg = qw(0 0 0 -);					# unexpected empty field
-	my $rr	= Net::DNS::RR->new("$name. $type @arg");
-	is( $rr->rdstring(), '0 0 0 -', 'DS delete: represent empty digest' );
+for my $rr ( Net::DNS::RR->new("$name. $type 0 0 0 0") ) {	# per RFC8078(4) as published
+	is( $rr->rdstring(), '0 0 0 00', 'DS delete: accept old format' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new("$name $type @data");
-	$rr->print;
-}
+Net::DNS::RR->new("$name $type @data")->print;
 
 
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-CERT.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-CERT.t Changed

@@ -1,10 +1,11 @@
 #!/usr/bin/perl
-# $Id: 05-CERT.t 1856 2021-12-02 14:36:25Z willem $	-*-perl-*-
+# $Id: 05-CERT.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
 use Test::More;
+use TestToolkit;
 
 use Net::DNS;
 
@@ -18,7 +19,7 @@
 	exit;
 }
 
-plan tests => 24;
+plan tests => 21;
 
 
 my $name = 'CERT.example';
@@ -30,20 +31,14 @@
 
 my $wire = '00010002033132333435363738396162636465666768696a6b6c6d6e6f707172737475767778797a';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -59,52 +54,31 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	is( Net::DNS::RR->new("foo IN CERT 0 2 3 foo=")->certtype,  0,	'certtype may be zero' );
-	is( Net::DNS::RR->new("foo IN CERT 1 0 3 foo=")->keytag,    0,	'keytag may be zero' );
-	is( Net::DNS::RR->new("foo IN CERT 1 2 0 foo=")->algorithm, 0,	'algorithm may be zero' );
-	is( Net::DNS::RR->new("foo IN CERT 1 2 3 ''  ")->cert,	    '', 'cert may be empty' );
-}
-
-
-{
-	my $rr = Net::DNS::RR->new("foo IN CERT 1 2 3 foo=");
+for my $rr ( Net::DNS::RR->new('foo IN CERT 1 2 3 foo=') ) {
 	is( $rr->algorithm('MNEMONIC'), 'DSA', 'algorithm mnemonic' );
 	$rr->algorithm(255);
 	is( $rr->algorithm('MNEMONIC'), 255, 'algorithm with no mnemonic' );
+	exception( 'unknown algorithm mnemonic', sub { $rr->algorithm('X') } );
 
-	eval { $rr->algorithm('X'); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "unknown mnemonic\t$exception" );
+	noexception( 'valid certtype mnemonic', sub { $rr->certtype('PKIX') } );
+	exception( 'unknown certtype mnemonic', sub { $rr->certtype('X') } );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new("foo IN CERT 1 2 3 foo=");
-	is( $rr->certtype('PKIX'), 1, 'valid certtype mnemonic' );
-	eval { $rr->certtype('X'); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "unknown mnemonic\t$exception" );
-}
+is( Net::DNS::RR->new('foo IN CERT 0 2 3 foo=')->certtype,  0,	'certtype may be zero' );
+is( Net::DNS::RR->new('foo IN CERT 1 0 3 foo=')->keytag,    0,	'keytag may be zero' );
+is( Net::DNS::RR->new('foo IN CERT 1 2 0 foo=')->algorithm, 0,	'algorithm may be zero' );
+is( Net::DNS::RR->new('foo IN CERT 1 2 3 ""  ')->cert,	    "", 'cert may be empty' );
 
 
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-CNAME.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-CNAME.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-CNAME.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-CNAME.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 13;
+use Test::More tests => 7;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = '076578616d706c6503636f6d00';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,39 +40,17 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
-}
-
-
-{
-	my $lc		= Net::DNS::RR->new( lc ". $type @data" );
-	my $rr		= Net::DNS::RR->new( uc ". $type @data" );
-	my $hash	= {};
-	my $predecessor = $rr->encode( 0,		    $hash );
-	my $compressed	= $rr->encode( length $predecessor, $hash );
-	ok( length $compressed < length $predecessor, 'encoded RDATA compressible' );
-	isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' );
-	is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-CSYNC.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-CSYNC.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-CSYNC.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-CSYNC.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 20;
+use Test::More tests => 17;
 
 use Net::DNS;
 
@@ -19,20 +19,14 @@
 
 my $wire = '000000420003000460000008';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @hash;
 
-	my $hash = {};
-	@{$hash}{@attr} = @hash;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -49,27 +43,17 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}
@@ -82,11 +66,7 @@
 }
 
 
-{
-	my $rr = Net::DNS::RR->new("$name $type @data");
-	$rr->print;
-}
-
+Net::DNS::RR->new("$name $type @data")->print;
 
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-DHCID.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-DHCID.t Changed

@@ -1,5 +1,5 @@
 #!/usr/bin/perl
-# $Id: 05-DHCID.t 1857 2021-12-07 13:38:02Z willem $	-*-perl-*-
+# $Id: 05-DHCID.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
@@ -18,7 +18,7 @@
 	exit;
 }
 
-plan tests => 15;
+plan tests => 12;
 
 
 my $name = 'DHCID.example';
@@ -30,20 +30,14 @@
 
 my $wire = '0002014f6266757363617465644964656e7469747944617461';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -58,45 +52,24 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}
 }
 
 
-{
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
-	$rr->print;
-}
-
+Net::DNS::RR->new( name => $name, type => $type, %$hash )->print;
 
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-DNAME.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-DNAME.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-DNAME.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-DNAME.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 14;
+use Test::More tests => 8;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = '076578616d706c6503636f6d00';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,39 +40,17 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
-}
-
-
-{
-	my $lc		= Net::DNS::RR->new( lc ". $type @data" );
-	my $rr		= Net::DNS::RR->new( uc ". $type @data" );
-	my $hash	= {};
-	my $predecessor = $rr->encode( 0,		    $hash );
-	my $compressed	= $rr->encode( length $predecessor, $hash );
-	ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' );
-	isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' );
-	is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-DNSKEY.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-DNSKEY.t Changed

@@ -1,10 +1,11 @@
 #!/usr/bin/perl
-# $Id: 05-DNSKEY.t 1856 2021-12-02 14:36:25Z willem $	-*-perl-*-
+# $Id: 05-DNSKEY.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
 use Test::More;
+use TestToolkit;
 
 use Net::DNS;
 
@@ -18,7 +19,7 @@
 	exit;
 }
 
-plan tests => 33;
+plan tests => 49;
 
 
 my $name = 'DNSKEY.example';
@@ -44,20 +45,14 @@
 		F36BA644CCE2413B3B72BE18CBEF8DA253F4E93D2103866D9234A2E28DF529A6
 		7D5468DBEFE3 );
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -72,30 +67,34 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $empty   = Net::DNS::RR->new("$name NULL");
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = uc unpack 'H*', $decoded->encode;
 	my $hex2    = uc unpack 'H*', $encoded;
-	my $hex3    = uc unpack 'H*', substr( $encoded, length $empty->encode );
+	my $hex3    = uc unpack 'H*', $rr->rdata;
 	is( $hex1, $hex2, 'encode/decode transparent' );
 	is( $hex3, $wire, 'encoded RDATA matches example' );
+
+	$rr->keybin('');
+	ok( $rr->rdstring, '$rr->rdstring with empty key field' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach ( @attr, qw(keylength keytag rdstring) ) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}
-}
 
+	toggle( $rr, 'zone',   1, 0, 1, 0 );
+	toggle( $rr, 'revoke', 0, 1, 0, 1 );
+	toggle( $rr, 'sep',    1, 0, 1, 0 );
 
-{
-	my $rr	  = Net::DNS::RR->new(". $type @data");
 	my $class = ref($rr);
 
+	is( $class->algorithm('RSASHA256'), 8,		 'class method algorithm("RSASHA256")' );
+	is( $class->algorithm(8),	    'RSASHA256', 'class method algorithm(8)' );
+	is( $class->algorithm(255),	    255,	 'class method algorithm(255)' );
+
 	$rr->algorithm(255);
 	is( $rr->algorithm(), 255, 'algorithm number accepted' );
 	$rr->algorithm('RSASHA1');
@@ -103,36 +102,36 @@
 	is( $rr->algorithm('MNEMONIC'), 'RSASHA1', 'rr->algorithm("MNEMONIC") returns mnemonic' );
 	is( $rr->algorithm(),		5,	   'rr->algorithm("MNEMONIC") preserves value' );
 
-	eval { $rr->algorithm('X'); };
-	my ($exception1) = split /\n/, "$@\n";
-	ok( $exception1, "unknown mnemonic\t$exception1" );
+	exception( 'unknown algorithm', sub { $rr->algorithm('X') } );
 
-	eval { $rr->algorithm(0); };
-	my ($exception2) = split /\n/, "$@\n";
-	ok( $exception2, "disallowed algorithm 0\t$exception2" );
-
-	is( $class->algorithm('RSASHA256'), 8,		 'class method algorithm("RSASHA256")' );
-	is( $class->algorithm(8),	    'RSASHA256', 'class method algorithm(8)' );
-	is( $class->algorithm(255),	    255,	 'class method algorithm(255)' );
+	exception( 'disallowed algorithm 0', sub { $rr->algorithm(0) } );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(
-		type	  => $type,
-		algorithm => 1,
-		keybin	  => pack( 'H*', '0000000000123456' ),
-		);
+for my $rr ( Net::DNS::RR->new( type => $type, algorithm => 1, keybin => pack 'H*', '0000000000123456' ) ) {
 	my $expect = unpack 'n', pack 'H*', '1234';
 	is( $rr->keytag, $expect, 'Historic keytag, per RFC4034 Appendix B.1' );
-}
-
 
-{
-	my $rr = Net::DNS::RR->new("$name $type @data");
-	$rr->print;
+	for my $algorithm ( 3, 8, 13 ) {
+		$rr->algorithm($algorithm);
+		my $mnemonic = $rr->algorithm('mnemonic');
+		ok( defined( $rr->keylength ), "keylength $mnemonic" );
+	}
 }
 
 
+Net::DNS::RR->new("$name $type @data")->print;
+
 exit;
 
+
+sub toggle {
+	my ( $object, $attribute, @sequence ) = @_;
+	for my $value (@sequence) {
+		my $change = $object->$attribute($value);
+		my $stored = $object->$attribute();
+		is( $stored, $change, "expected value after $attribute($value)" );
+	}
+	return;
+}
+

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-DS.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-DS.t Changed

@@ -1,10 +1,11 @@
 #!/usr/bin/perl
-# $Id: 05-DS.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-DS.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 37;
+use Test::More tests => 38;
+use TestToolkit;
 
 use Net::DNS;
 
@@ -18,20 +19,14 @@
 
 my $wire = join '', qw( EC45 05 01 2BB183AF5F22588179A53B0A98631FAD1A292118 );
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,30 +41,30 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $empty   = Net::DNS::RR->new("$name $type");
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = uc unpack 'H*', $decoded->encode;
 	my $hex2    = uc unpack 'H*', $encoded;
-	my $hex3    = uc unpack 'H*', substr( $encoded, length $empty->encode );
+	my $hex3    = uc unpack 'H*', $rr->rdata;
 	is( $hex1, $hex2, 'encode/decode transparent' );
 	is( $hex3, $wire, 'encoded RDATA matches example' );
+
+	$rr->digest('');
+	ok( $rr->rdstring, '$rr->rdstring with empty digest field' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach ( @attr, 'rdstring' ) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}
-}
-
 
-{
-	my $rr	  = Net::DNS::RR->new(". $type @data");
 	my $class = ref($rr);
 
+	is( $class->algorithm('RSASHA256'), 8,		 'class method algorithm("RSASHA256")' );
+	is( $class->algorithm(8),	    'RSASHA256', 'class method algorithm(8)' );
+	is( $class->algorithm(255),	    255,	 'class method algorithm(255)' );
+
 	$rr->algorithm(255);
 	is( $rr->algorithm(), 255, 'algorithm number accepted' );
 	$rr->algorithm('RSASHA1');
@@ -77,84 +72,37 @@
 	is( $rr->algorithm('MNEMONIC'), 'RSASHA1', 'rr->algorithm("MNEMONIC") returns mnemonic' );
 	is( $rr->algorithm(),		5,	   'rr->algorithm("MNEMONIC") preserves value' );
 
-	eval { $rr->algorithm('X'); };
-	my ($exception1) = split /\n/, "$@\n";
-	ok( $exception1, "unknown mnemonic\t$exception1" );
+	exception( 'unknown algorithm', sub { $rr->algorithm('X') } );
 
-	eval { $rr->algorithm(0); };
-	my ($exception2) = split /\n/, "$@\n";
-	ok( $exception2, "disallowed algorithm 0\t$exception2" );
+	exception( 'disallowed algorithm 0', sub { $rr->algorithm(0) } );
 
-	is( $class->algorithm('RSASHA256'), 8,		 'class method algorithm("RSASHA256")' );
-	is( $class->algorithm(8),	    'RSASHA256', 'class method algorithm(8)' );
-	is( $class->algorithm(255),	    255,	 'class method algorithm(255)' );
-}
-
-
-{
-	my $rr	  = Net::DNS::RR->new(". $type @data");
-	my $class = ref($rr);
+	is( $class->digtype('SHA256'), 2,	  'class method digtype("SHA256")' );
+	is( $class->digtype(2),	       'SHA-256', 'class method digtype(2)' );
+	is( $class->digtype(255),      255,	  'class method digtype(255)' );
 
 	$rr->digtype('SHA256');
 	is( $rr->digtype(),	      2,	 'digest type mnemonic accepted' );
 	is( $rr->digtype('MNEMONIC'), 'SHA-256', 'rr->digtype("MNEMONIC") returns mnemonic' );
 	is( $rr->digtype(),	      2,	 'rr->digtype("MNEMONIC") preserves value' );
 
-	eval { $rr->digtype(0); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "disallowed digtype 0\t$exception" );
-
-	is( $class->digtype('SHA256'), 2,	  'class method digtype("SHA256")' );
-	is( $class->digtype(2),	       'SHA-256', 'class method digtype(2)' );
-	is( $class->digtype(255),      255,	  'class method digtype(255)' );
-}
-
+	exception( 'disallowed digtype 0', sub { $rr->digtype(0) } );
 
-{
-	my $rr = Net::DNS::RR->new(". $type @data");
-	eval { $rr->digest('123456789XBCDEF'); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "corrupt hexadecimal\t$exception" );
-}
+	exception( 'corrupt hexadecimal', sub { $rr->digest('123456789XBCDEF') } );
 
 
-{
 	my $keyrr = Net::DNS::RR->new( type => 'DNSKEY', keybin => '' );
-	eval { create Net::DNS::RR::DS( $keyrr, ( 'digtype' => 255 ) ); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "create: wrong digtype\t$exception" );
-}
-
-
-{
-	my $keyrr = Net::DNS::RR->new( type => 'DNSKEY', protocol => 0 );
-	eval { create Net::DNS::RR::DS($keyrr); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "create: non-DNSSEC key\t$exception" );
-}
 
+	exception( 'create: wrong digtype', sub { $class->create( $keyrr, ( 'digtype' => 255 ) ) } );
 
-{
-	my $keyrr = Net::DNS::RR->new( type => 'DNSKEY', zone => 0 );
-	eval { create Net::DNS::RR::DS($keyrr); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "create: non-zone key\t$exception" );
-}
+	exception( 'create: revoked key', sub { $keyrr->flags(0x80); $class->create($keyrr) } );
 
+	exception( 'create: non-zone key', sub { $keyrr->flags(0); $class->create($keyrr) } );
 
-{
-	my $keyrr = Net::DNS::RR->new( type => 'DNSKEY', revoke => 1 );
-	eval { create Net::DNS::RR::DS($keyrr); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "create: revoked key\t$exception" );
+	exception( 'create: non-DNSSEC key', sub { $keyrr->protocol(0); $class->create($keyrr) } );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new("$name $type @data");
-	$rr->print;
-}
-
+Net::DNS::RR->new("$name $type @data")->print;
 
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-EUI48.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-EUI48.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-EUI48.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-EUI48.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 9;
+use Test::More tests => 6;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = '5eef1000002a';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,22 +40,13 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-EUI64.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-EUI64.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-EUI64.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-EUI64.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 9;
+use Test::More tests => 6;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = '00005eef1000002a';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,22 +40,13 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-HINFO.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-HINFO.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-HINFO.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-HINFO.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 12;
+use Test::More tests => 9;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = '0a5641582d31312f37353003564d53';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,27 +40,17 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-HIP.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-HIP.t Changed

@@ -1,10 +1,11 @@
 #!/usr/bin/perl
-# $Id: 05-HIP.t 1857 2021-12-07 13:38:02Z willem $	-*-perl-*-
+# $Id: 05-HIP.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
 use Test::More;
+use TestToolkit;
 
 use Net::DNS;
 
@@ -18,7 +19,7 @@
 	exit;
 }
 
-plan tests => 22;
+plan tests => 19;
 
 
 my $name = 'HIP.example';
@@ -39,19 +40,14 @@
 		616d706c6503636f6d000472767332076578616d706c6503636f6d00
 		);
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -74,71 +70,36 @@
 }
 
 
-{
-	my $rr	    = Net::DNS::RR->new("$name $type @data");
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
+for my $rr ( Net::DNS::RR->new("$name $type @data") ) {
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
-
-	my @wire = unpack 'C*', $encoded;
-	$wirelength($empty) - 1--;
-	my $wireformat = pack 'C*', @wire;
-	eval { Net::DNS::RR->decode( \$wireformat ); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "corrupt wire-format\t$exception" );
-}
-
-
-{
-	my $rr = Net::DNS::RR->new(". $type @data");
-	eval { $rr->hit('123456789XBCDEF'); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "corrupt hexadecimal\t$exception" );
-}
-
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 
-{
-	my $lc		= Net::DNS::RR->new( lc ". $type @data" );
-	my $rr		= Net::DNS::RR->new( uc ". $type @data" );
-	my $hash	= {};
-	my $predecessor = $rr->encode( 0,		    $hash );
-	my $compressed	= $rr->encode( length $predecessor, $hash );
-	ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' );
-	isnt( $rr->encode,    $lc->encode, 'encoded RDATA names not downcased' );
-	isnt( $rr->canonical, $lc->encode, 'canonical RDATA names not downcased' );
+	my $emptyrr = Net::DNS::RR->new("$name $type")->encode;
+	my $corrupt = pack 'a*X2na*', $emptyrr, $decoded->rdlength - 1, $rr->rdata;
+	exception( 'corrupt wire-format', sub { Net::DNS::RR->decode( \$corrupt ) } );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}
-}
 
+	exception( 'corrupt hexadecimal', sub { $rr->hit('123456789XBCDEF') } );
 
-{
-	my $rr = Net::DNS::RR->new("$name $type @data");
-	local $SIG{__WARN__} = sub { };				# suppress deprecation warning
-	eval { $rr->pkalgorithm() };				# historical
-	eval { $rr->pubkey() };					# historical
-	eval { $rr->rendezvousservers() };			# historical
+	noexception( 'deprecate pkalgorithm',	    sub { $rr->pkalgorithm	 for ( 1 .. 2 ) } );
+	noexception( 'deprecate pubkey',	    sub { $rr->pubkey		 for ( 1 .. 2 ) } );
+	noexception( 'deprecate rendezvousservers', sub { $rr->rendezvousservers for ( 1 .. 2 ) } );
 
-	$rr->print;
 }
 
 
+Net::DNS::RR->new("$name $type @data")->print;
+
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-HTTPS.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-HTTPS.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-HTTPS.t 1857 2021-12-07 13:38:02Z willem $	-*-perl-*-
+# $Id: 05-HTTPS.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 15;
+use Test::More tests => 9;
 
 use Net::DNS;
 
@@ -17,20 +17,14 @@
 
 my $wire = '000004706f6f6c03737663076578616d706c6500';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -45,47 +39,24 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
-}
-
-
-{
-	my $lc		= Net::DNS::RR->new( lc ". $type @data" );
-	my $rr		= Net::DNS::RR->new( uc ". $type @data" );
-	my $hash	= {};
-	my $predecessor = $rr->encode( 0,		    $hash );
-	my $compressed	= $rr->encode( length $predecessor, $hash );
-	ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' );
-	isnt( $rr->encode,    $lc->encode, 'encoded RDATA names not downcased' );
-	isnt( $rr->canonical, $lc->encode, 'canonical RDATA names not downcased' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}
 }
 
 
-{
-	my $rr = Net::DNS::RR->new( <<'END' );
+Net::DNS::RR->new( <<'END' )->print;
 blog.cloudflare.com.	300	IN	HTTPS	( 1 .
 	key1=\005h3-29\005h3-28\005h3-27\002h2
 	key4=h\018\026.h\018\027.
@@ -94,9 +65,5 @@
 	)
 END
 
-	$rr->print;
-}
-
-
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-IPSECKEY.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-IPSECKEY.t Changed

@@ -1,10 +1,11 @@
 #!/usr/bin/perl
-# $Id: 05-IPSECKEY.t 1857 2021-12-07 13:38:02Z willem $	-*-perl-*-
+# $Id: 05-IPSECKEY.t 1911 2023-04-17 12:30:59Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
 use Test::More;
+use TestToolkit;
 
 use Net::DNS;
 
@@ -18,7 +19,7 @@
 	exit;
 }
 
-plan tests => 39;
+plan tests => 31;
 
 
 my $name = '38.2.0.192.in-addr.arpa';
@@ -31,24 +32,17 @@
 my $wire =
 '0a03020767617465776179076578616d706c6503636f6d00010351537986ed35533b6064478eeeb27b5bd74dae149b6e81ba3a0521af82ab7801';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
-	is( $rr2->string, $string, 'new/string transparent' );
-
+	is( $rr2->string, $string,     'new/string transparent' );
 	is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' );
 
 	foreach (@attr) {
@@ -59,39 +53,17 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
-}
-
-
-{
-	my $lc		= Net::DNS::RR->new( lc ". $type @data" );
-	my $rr		= Net::DNS::RR->new( uc ". $type @data" );
-	my $hash	= {};
-	my $predecessor = $rr->encode( 0,		    $hash );
-	my $compressed	= $rr->encode( length $predecessor, $hash );
-	ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' );
-	isnt( $rr->encode,    $lc->encode, 'encoded RDATA names not downcased' );
-	isnt( $rr->canonical, $lc->encode, 'canonical RDATA names not downcased' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new("$name $type @data");
+for my $rr ( Net::DNS::RR->new("$name $type @data") ) {
 	foreach ( undef, qw(192.0.2.38 2001:db8:0:8002:0:0:2000:1 gateway.example.com) ) {
 		my $gateway = $_ || '.';
 		$rr->gateway($gateway);
@@ -105,50 +77,19 @@
 }
 
 
-{
-	my $rr = eval { Net::DNS::RR->new( type => $type, gateway => 'X' ); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "unrecognised gateway type\t$exception" );
-}
-
-
-{
-	my $rr = eval { Net::DNS::RR->new(". $type \\# 3 01ff05"); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "exception raised in decode\t$exception" );
-}
-
-
-{
-	my $rr = Net::DNS::RR->new(". $type @data");
-	$rr->{gatetype} = 255;
-	eval { $rr->encode };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "exception raised in encode\t$exception" );
-}
-
-
-{
-	my $rr = Net::DNS::RR->new(". $type @data");
-	$rr->{gatetype} = 255;
-	eval { my $gateway = $rr->gateway; };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "exception raised in gateway\t$exception" );
-}
-
-
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "$_ attribute of empty RR undefined" );
 	}
 }
 
 
-{
-	my $rr = Net::DNS::RR->new("$name $type @data");
-	$rr->print;
-}
+exception( 'exception raised in decode', sub { Net::DNS::RR->new(". $type \\# 3 01ff05") } );
+
+exception( 'exception raised in gateway', sub { Net::DNS::RR->new( type => $type )->gateway('X') } );
+
+
+Net::DNS::RR->new("$name $type @data")->print;
 
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-ISDN.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-ISDN.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-ISDN.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-ISDN.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 13;
+use Test::More tests => 10;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = '0f31353038363230323830303332313703303034';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,27 +40,17 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-KEY.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-KEY.t Changed

@@ -1,5 +1,5 @@
 #!/usr/bin/perl
-# $Id: 05-KEY.t 1857 2021-12-07 13:38:02Z willem $	-*-perl-*-
+# $Id: 05-KEY.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
@@ -42,20 +42,14 @@
 		F36BA644CCE2413B3B72BE18CBEF8DA253F4E93D2103866D9234A2E28DF529A6
 		7D5468DBEFE3 );
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -70,13 +64,11 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $empty   = Net::DNS::RR->new("$name NULL");
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = uc unpack 'H*', $decoded->encode;
 	my $hex2    = uc unpack 'H*', $encoded;
-	my $hex3    = uc unpack 'H*', substr( $encoded, length $empty->encode );
+	my $hex3    = uc unpack 'H*', $rr->rdata;
 	is( $hex1, $hex2, 'encode/decode transparent' );
 	is( $hex3, $wire, 'encoded RDATA matches example' );
 }

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-KX.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-KX.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-KX.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-KX.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 15;
+use Test::More tests => 9;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = '000a026b78076578616d706c6503636f6d00';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,39 +40,17 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
-}
-
-
-{
-	my $lc		= Net::DNS::RR->new( lc ". $type @data" );
-	my $rr		= Net::DNS::RR->new( uc ". $type @data" );
-	my $hash	= {};
-	my $predecessor = $rr->encode( 0,		    $hash );
-	my $compressed	= $rr->encode( length $predecessor, $hash );
-	ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' );
-	isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' );
-	is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-L32.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-L32.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-L32.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-L32.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 12;
+use Test::More tests => 9;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = '000a0a010200';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,27 +40,17 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-L64.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-L64.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-L64.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-L64.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 12;
+use Test::More tests => 9;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = '000a20010db811401000';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,27 +40,17 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-LOC.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-LOC.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-LOC.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-LOC.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 24;
+use Test::More tests => 21;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = '002513138916cb3c70c310df00988550';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 
@@ -47,27 +41,17 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-LP.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-LP.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-LP.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-LP.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 17;
+use Test::More tests => 11;
 
 use Net::DNS;
 
@@ -18,19 +18,14 @@
 
 my $wire = join '', qw( 000a076c6f6361746f72076578616d706c6503636f6d00 );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -44,43 +39,18 @@
 	foreach (@also) {
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
-}
-
 
-{
-	my $rr	    = Net::DNS::RR->new("$name $type @data");
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
-}
-
-
-{
-	my $lc		= Net::DNS::RR->new( lc ". $type @data" );
-	my $rr		= Net::DNS::RR->new( uc ". $type @data" );
-	my $hash	= {};
-	my $predecessor = $rr->encode( 0,		    $hash );
-	my $compressed	= $rr->encode( length $predecessor, $hash );
-	ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' );
-	isnt( $rr->encode,    $lc->encode, 'encoded RDATA names not downcased' );
-	isnt( $rr->canonical, $lc->encode, 'canonical RDATA names not downcased' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-MINFO.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-MINFO.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-MINFO.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-MINFO.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 15;
+use Test::More tests => 9;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = '027270076578616d706c6503636f6d00027270076578616d706c65036e657400';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,39 +40,17 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
-}
-
-
-{
-	my $lc		= Net::DNS::RR->new( lc ". $type @data" );
-	my $rr		= Net::DNS::RR->new( uc ". $type @data" );
-	my $hash	= {};
-	my $predecessor = $rr->encode( 0,		    $hash );
-	my $compressed	= $rr->encode( length $predecessor, $hash );
-	ok( length $compressed < length $predecessor, 'encoded RDATA compressible' );
-	isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' );
-	is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-MX.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-MX.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-MX.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-MX.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 18;
+use Test::More tests => 12;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = '000a026d78076578616d706c6503636f6d00';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,46 +40,25 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
-}
-
-
-{
-	my $lc		= Net::DNS::RR->new( lc ". $type @data" );
-	my $rr		= Net::DNS::RR->new( uc ". $type @data" );
-	my $hash	= {};
-	my $predecessor = $rr->encode( 0,		    $hash );
-	my $compressed	= $rr->encode( length $predecessor, $hash );
-	ok( length $compressed < length $predecessor, 'encoded RDATA compressible' );
-	isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' );
-	is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{					## incomplete RR (specimen test for widely used constructs)
-	my $empty = Net::DNS::RR->new( type => $type );
+for my $empty ( Net::DNS::RR->new( type => $type ) ) {
 	is( $empty->preference, 0,     'unspecified integer returns 0 (not default value)' );
 	is( $empty->exchange,	undef, 'unspecified domain name returns undefined' );
+}
 
-	my $part = Net::DNS::RR->new( type => $type, exchange => 'mx.example' );
-	is( $part->preference, 10, 'unspecified integer returns default value' );
-	ok( $part->exchange, 'domain name defined as expected' );
-	is( $part->preference(0), 0, 'zero integer replaces default value' );
+for my $rr ( Net::DNS::RR->new( type => $type, exchange => 'mx.example' ) ) {
+	is( $rr->preference, 10, 'unspecified integer returns default value' );
+	ok( $rr->exchange, 'domain name defined as expected' );
+	is( $rr->preference(0), 0, 'zero integer replaces default value' );
 }

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-NAPTR.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-NAPTR.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-NAPTR.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-NAPTR.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 23;
+use Test::More tests => 17;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = '0064000a0175077369702b4532551e215e2e2a24217369703a696e666f726d6174696f6e40666f6f2e7365216900';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,39 +40,17 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
-}
-
-
-{
-	my $lc		= Net::DNS::RR->new('. NAPTR 100 50 "s" "http+N2L+N2C+N2R" "" www.example.com.');
-	my $rr		= Net::DNS::RR->new('. NAPTR 100 50 "s" "http+N2L+N2C+N2R" "" WWW.EXAMPLE.COM.');
-	my $hash	= {};
-	my $predecessor = $rr->encode( 0,		    $hash );
-	my $compressed	= $rr->encode( length $predecessor, $hash );
-	ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' );
-	isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' );
-	is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-NID.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-NID.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-NID.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-NID.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 12;
+use Test::More tests => 9;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = '000a00144fffff20ee64';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,27 +40,17 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-NS.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-NS.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-NS.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-NS.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 13;
+use Test::More tests => 7;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = '026e73076578616d706c6503636f6d00';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,39 +40,17 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
-}
-
-
-{
-	my $lc		= Net::DNS::RR->new( lc ". $type @data" );
-	my $rr		= Net::DNS::RR->new( uc ". $type @data" );
-	my $hash	= {};
-	my $predecessor = $rr->encode( 0,		    $hash );
-	my $compressed	= $rr->encode( length $predecessor, $hash );
-	ok( length $compressed < length $predecessor, 'encoded RDATA compressible' );
-	isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' );
-	is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-NSEC.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-NSEC.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-NSEC.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-NSEC.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 15;
+use Test::More tests => 9;
 
 use Net::DNS;
 
@@ -19,20 +19,14 @@
 
 my $wire = '04686f7374076578616d706c6503636f6d000006620000000003';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @hash;
 
-	my $hash = {};
-	@{$hash}{@attr} = @hash;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -49,55 +43,31 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $lc		= Net::DNS::RR->new( lc ". $type @data" );
-	my $rr		= Net::DNS::RR->new( uc ". $type @data" );
-	my $hash	= {};
-	my $predecessor = $rr->encode( 0,		    $hash );
-	my $compressed	= $rr->encode( length $predecessor, $hash );
-	ok( !length $compressed < length $predecessor, 'encoded RDATA not compressible' );
-	isnt( $rr->encode,    $lc->encode, 'encoded RDATA names not downcased' );
-	isnt( $rr->canonical, $lc->encode, 'canonical RDATA names not downcased' );
-}
-
-
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}
 }
 
 
-{
-	my $rr = Net::DNS::RR->new("$name $type @data");
+for my $rr ( Net::DNS::RR->new("$name $type @data") ) {
 	local $SIG{__WARN__} = sub { };				# suppress deprecation warning
 	eval { $rr->covered('example.') };			# historical
 	eval { $rr->typebm('') };				# historical
-	eval { $rr->typebm() };					# historical
-
-	$rr->print;
 }
 
 
+Net::DNS::RR->new("$name $type @data")->print;
+
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-NSEC3.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-NSEC3.t Changed

@@ -1,10 +1,11 @@
 #!/usr/bin/perl
-# $Id: 05-NSEC3.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-NSEC3.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 25;
+use Test::More tests => 23;
+use TestToolkit;
 
 use Net::DNS;
 
@@ -19,24 +20,17 @@
 
 my $wire = '0101000c04aabbccdd14174eb2409fe28bcb4887a1836f957f0a8425e27b000722010000000290';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @hash;
 
-	my $hash = {};
-	@{$hash}{@attr} = @hash;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
-	is( $rr2->string, $string, 'new/string transparent' );
-
+	is( $rr2->string, $string,     'new/string transparent' );
 	is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' );
 
 	foreach (@attr) {
@@ -49,28 +43,24 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
+}
+
+
+for my $rr ( Net::DNS::RR->new(". $type 1 1 12 - 2t7b4g4vsa5smi47k61mv5bv1a22bojr A") ) {
+	is( $rr->salt, '', 'parse RR with salt field placeholder' );
+	like( $rr->rdstring, '/^1 1 12 - /', 'placeholder denotes empty salt field' );
+	exception( 'corrupt hexadecimal', sub { $rr->salt('123456789XBCDEF') } );
 }
 
 
-{
-	my @rdata = qw(1 1 12 - 2t7b4g4vsa5smi47k61mv5bv1a22bojr A);
-	my $rr	  = Net::DNS::RR->new(". $type @rdata");
+for my $rr ( Net::DNS::RR->new(". $type @data") ) {
 	my $class = ref($rr);
 
 	$rr->algorithm('SHA-1');
@@ -80,32 +70,12 @@
 	is( $class->algorithm(1),	'SHA-1', "class method algorithm(1)" );
 	is( $class->algorithm(255),	255,	 "class method algorithm(255)" );
 
-	eval { $rr->algorithm('X'); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "unknown mnemonic\t$exception" );
+	exception( 'unknown mnemonic',	sub { $rr->algorithm('X') } );
+	exception( 'invalid algorithm', sub { Net::DNS::RR::NSEC3::name2hash( 0, 1, '' ) } );
 }
 
 
-{
-	my @rdata = qw(1 1 12 - 2t7b4g4vsa5smi47k61mv5bv1a22bojr A);
-	my $rr	  = Net::DNS::RR->new(". $type @rdata");
-	is( $rr->salt,	   '',	     'parse RR with salt field placeholder' );
-	is( $rr->rdstring, "@rdata", 'placeholder denotes empty salt field' );
-
-	eval { $rr->salt('123456789XBCDEF'); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "corrupt hexadecimal\t$exception" );
-}
-
-
-{
-	my $rr = Net::DNS::RR->new("$name $type @data");
-	local $SIG{__WARN__} = sub { };				# suppress deprecation warning
-	eval { Net::DNS::RR::NSEC3::name2hash( 0, 1, '' ) };	# invalid algorithm
-	eval { $rr->match('example.') };			# historical
-
-	$rr->print;
-}
+Net::DNS::RR->new("$name $type @data")->print;
 
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-NSEC3PARAM.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-NSEC3PARAM.t Changed

@@ -1,10 +1,11 @@
 #!/usr/bin/perl
-# $Id: 05-NSEC3PARAM.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-NSEC3PARAM.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 22;
+use Test::More tests => 17;
+use TestToolkit;
 
 use Net::DNS;
 
@@ -18,20 +19,14 @@
 
 my $wire = '0101000c04aabbccdd';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,49 +41,32 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}
 }
 
 
-{
-	# check parsing of RR with null salt (RT#95034)
-	my $string = 'nosalt.example.	IN	NSEC3PARAM	2 0 12 -';
-	my $rr	   = eval { Net::DNS::RR->new($string) };
-	diag $@ if $@;
-	ok( $rr, 'NSEC3PARAM created with null salt' );
-	is( $rr->salt,			  '',	   'NSEC3PARAM null salt value' );
-	is( unpack( 'H*', $rr->saltbin ), '',	   'NSEC3PARAM null salt binary value' );
-	is( $rr->string,		  $string, 'NSEC3PARAM null salt binary value' );
+for my $rr ( Net::DNS::RR->new(<<'END') ) {	## RR with null salt (RT#95034)
+nosalt.example.	IN	NSEC3PARAM	2 0 12 -
+END
+	ok( $rr->string, 'NSEC3PARAM created' );
+	is( unpack( 'H*', $rr->saltbin ), '', 'NSEC3PARAM null salt value' );
 }
 
 
-{
-	my $rr = eval { Net::DNS::RR->new('corrupt.example NSEC3PARAM 2 0 12 aabbccfs') };
-	ok( !$rr, 'NSEC3PARAM not created with corrupt hex data' );
-}
+exception( 'NSEC3PARAM with corrupt salt', sub { Net::DNS::RR->new('corrupt NSEC3PARAM 2 0 12 aabbccfs') } );
 
 
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-NULL.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-NULL.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-NULL.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-NULL.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 10;
+use Test::More tests => 6;
 
 use Net::DNS;
 
@@ -18,21 +18,14 @@
 
 my $wire = '61626364';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name  => $name,
-		type  => $type,
-		rdata => 'arbitrary data',
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,26 +39,11 @@
 	foreach (@also) {
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
-}
-
 
-{
-	my $rr	    = Net::DNS::RR->new("$name $type @data");
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
+	$rr->ttl(1234);
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
-	my $hex1    = unpack 'H*', $encoded;
-	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
+	is( $decoded->string, $rr->string, 'encode/decode transparent' );
 }

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-OPENPGPKEY.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-OPENPGPKEY.t Changed

@@ -1,5 +1,5 @@
 #!/usr/bin/perl
-# $Id: 05-OPENPGPKEY.t 1857 2021-12-07 13:38:02Z willem $	-*-perl-*-
+# $Id: 05-OPENPGPKEY.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
@@ -38,20 +38,14 @@
 		F36BA644CCE2413B3B72BE18CBEF8DA253F4E93D2103866D9234A2E28DF529A6
 		7D5468DBEFE3 );
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -66,30 +60,24 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = uc unpack 'H*', $decoded->encode;
 	my $hex2    = uc unpack 'H*', $encoded;
-	my $hex3    = uc unpack 'H*', substr( $encoded, length $empty );
+	my $hex3    = uc unpack 'H*', $rr->rdata;
 	is( $hex1, $hex2, 'encode/decode transparent' );
 	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}
 }
 
 
-{
-	my $rr = Net::DNS::RR->new("$name $type @data");
-	$rr->print;
-}
+Net::DNS::RR->new("$name $type @data")->print;
 
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-OPT.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-OPT.t Changed

@@ -1,117 +1,64 @@
 #!/usr/bin/perl
-# $Id: 05-OPT.t 1864 2022-04-14 15:18:49Z willem $	-*-perl-*-
+# $Id: 05-OPT.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More;
+use Test::More tests => 82;
+use TestToolkit;
 
 use Net::DNS;
 use Net::DNS::Parameters;
 
+use constant UTIL => scalar eval { require Scalar::Util; Scalar::Util->can('isdual') };	## no critic
 
-plan tests => 33 + scalar( keys %Net::DNS::Parameters::ednsoptionbyval );
 
-
-my $name = '.';
-my $type = 'OPT';
 my $code = 41;
-my @attr = qw( size rcode flags );
-my @data = qw( 1280 0 32768 );
-my @also = qw( version );
-
-my $wire = '0000290500000080000000';
-
-
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new( name => '.', type => $type )->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
-
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
+my $type = 'OPT';
+my @attr = qw( version udpsize rcode flags );
+my $wire = '0000290000000000000000';
 
-	foreach (@attr) {
-		is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" );
-	}
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-	foreach (@also) {
-		my $value = $rr->$_;
-		ok( defined $rr->$_, "additional attribute rr->$_()" );
-	}
 
-	my $encoded = $rr->encode;
+for my $edns ( Net::DNS::Packet->new()->edns ) {
+	my $encoded = $edns->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = uc unpack 'H*', $encoded;
 	my $hex2    = uc unpack 'H*', $decoded->encode;
 	is( $hex1, $hex2, 'encode/decode transparent' );
 	is( $hex1, $wire, 'encoded RDATA matches example' );
 
-	$rr->option( 10, 'rawbytes' );
-	like( $rr->string, '/EDNS/', 'string method works' );
-}
+	like( $edns->string, '/EDNS-VERSION/', '$edns->string works' );
+
+	$edns->rdata( pack 'H*', '00040002beef' );
+	like( $edns->plain, '/TYPE41/', '$edns->generic works' );    # join token(generic)
 
+	$edns->version(1);
+	like( $edns->string, '/EDNS-VERSION/', '$edns->string (version 1)' );
 
-{
-	my $rr = Net::DNS::RR->new( name => '.', type => $type );
 	foreach (@attr) {
-		my $initial = 0x5A5;
-		my $changed = 0xA5A;
-		$rr->{$_} = $initial;
-		is( $rr->$_($changed), $changed, "rr->$_(x) returns function argument" );
-		is( $rr->$_(),	       $changed, "rr->$_(x) changes attribute value" );
+		my $changed = 0xbeef;
+		is( $edns->$_($changed), $changed, "edns->$_(x) returns function argument" );
+		is( $edns->$_(),	 $changed, "edns->$_()	returns changed value" );
+		$edns->$_(0);
 	}
-}
-
-
-foreach my $method (qw(class ttl)) {
-	my $rr = Net::DNS::RR->new( name => '.', type => $type );
-	local $SIG{__WARN__} = sub { die @_ };
-
-	eval { $rr->$method(512) };
-	my ($warning) = split /\n/, "$@\n";
-	ok( 1, "deprecated $method method:\t$warning" );	# warning may, or may not, be first
-
-	eval { $rr->$method(512) };
-	my ($repeated) = split /\n/, "$@\n";
-	ok( !$repeated, "warning not repeated\t$repeated" );
-}
-
-
-{
-	my $rr = Net::DNS::RR->new( type => $type, version => 1, rcode => 16 );
-	$rr->{rdlength} = 0;					# inbound OPT RR only
-	like( $rr->string, '/BADVER/', 'opt->rcode(16)' );
-}
 
-
-{
-	my $rr = Net::DNS::RR->new( name => '.', type => $type, rcode => 1 );
-	like( $rr->string, '/NOERROR/', 'opt->rcode(1)' );
+	foreach my $method (qw(class ttl size)) {
+		exception( "deprecated $method method", sub { $edns->$method(512) } );
+		noexception( "$method warning not repeated", sub { $edns->$method(512) } );
+	}
 }
 
 
-{
-	my $edns = Net::DNS::RR->new( name => '.', type => $type );
-
-	ok( ref($edns), 'new OPT RR created' );
-
+for my $edns ( Net::DNS::Packet->new()->edns ) {
 	is( scalar( $edns->options ), 0, 'EDNS option list initially empty' );
 
-	ok( !$edns->_format_option(0), 'format non-existent option(0)' );
-
 	my $non_existent = $edns->option(0);
-	is( $non_existent, undef, '$undef = option(0)' );
-
-	my @non_existent = $edns->option(0);
-	is( scalar(@non_existent), 0, '@empty = option(0)' );
+	is( $non_existent, undef, 'non-existent option(0) returns undef' );
 
-	ok( !$edns->_specified, 'state unmodified by existence probes' );
+	ok( !$edns->_specified, 'state unmodified by existence probe' );
 
 	$edns->option( 0 => '' );
 	is( scalar( $edns->options ), 1, 'insert EDNS option' );
@@ -119,63 +66,133 @@
 	$edns->option( 0 => undef );
 	is( scalar( $edns->options ), 0, 'delete EDNS option' );
 
+	ok( !$edns->_specified, 'state unmodified following delete' );
 
-	foreach my $option ( keys %Net::DNS::Parameters::ednsoptionbyval ) {
-		$edns->option( $option => 'rawbytes' );
+	my @transgression = ( {8 => {"FAMILY" => 99}}, {8 => {"BASE16" => '00990000'}}, {65001 => } );
+	foreach (@transgression) {
+		my @test = _presentable($_);
+		my ($option) = keys %$_;
+		exception( "compose(@test)", sub { $edns->option(%$_); my @value = $edns->option($option) } );
 	}
+}
 
 
-	$edns->option( 4 => '' );
-	is( length( $edns->option(4) ), 0, "option 4 => ''" );
-
-	$edns->option( DAU => 8, 10, 13, 14, 15, 16 );
-	is( length( $edns->option(5) ), 6, "option DAU =>  ... " );
-
-	$edns->option( 10 => {'CLIENT-COOKIE' => 'rawbytes'} );
-	is( length( $edns->option(10) ), 8, "option 10 => {CLIENT-COOKIE => ... }" );
+my $edns = Net::DNS::Packet->new()->edns;
 
+foreach my $option ( keys %Net::DNS::Parameters::ednsoptionbyval ) {
+	$edns->option( $option => {'BASE16' => '076578616d706c6500'} );
+}
 
-	$edns->option( 6 => pack 'H*', '010204' );
 
-	$edns->option( 7 => pack 'H*', '01' );
+my @testcase = (
+	"LLQ" => {"BASE16" => "000100000000000000000000000000000000"},
+	"NSID" => {"OPTION-DATA" => "rawbytes"}, "NSID" => {"IDENTIFIER" => "7261776279746573"},
+	"4"		 => {"OPTION-DATA" => ""},
+	"DAU"		 => ( 8, 10, 13, 14, 15, 16 ),
+	"DHU"		 => ( 1, 2,  4 ),
+	"N3U"		 => 1,
+	"CLIENT-SUBNET" => ( "FAMILY" => 1, "ADDRESS" => "192.0.2.1", "SOURCE-PREFIX" => 24 ),
+	"CLIENT-SUBNET" => {"BASE16" => "0002380020010db8fd1342"},
+	"EXPIRE"	 => 604800,
+	"COOKIE" => "7261776279746573", "", "COOKIE" => "7261776279746573",
+	"TCP-KEEPALIVE" => 200,
+	"PADDING" => {"OPTION-DATA" => ""}, "PADDING" => 0, "PADDING" => "",
+	"PADDING"	  => {"OPTION-DATA" => "rawbytes"},
+	"PADDING"	  => 100,
+	"CHAIN"	  => {"BASE16" => "076578616d706c6500"},
+	"KEY-TAG"	  => ( 29281, 30562, 31092, 25971 ),
+	"EXTENDED-ERROR" => ( "INFO-CODE" => 0, "EXTRA-TEXT" => '{"JSON":"EXAMPLE"}' ),
+	"EXTENDED-ERROR" => ( "INFO-CODE" => 0, "EXTRA-TEXT" => '{JSON: unparsable}' ),
+	"EXTENDED-ERROR" => ( "INFO-CODE" => 123 ),
+	"65023"	  => {"BASE16" => "076578616d706c6500"},
+	);
+
+foreach (@testcase) {
+	my ( $canonical, @alternative ) = ref( $$_0 ) eq 'ARRAY' ? @$_ : $_;
+	my ( $option,	 @value )	= @$canonical;
+	my @presentable = _presentable(@value);
+	$edns->option( $option => @value );
+	my $result = $edns->option($option);
+	ok( defined($result), qqcompose( "$option" => @presentable ) );
+	my $expect	   = defined($result) ? unpack( 'H*', $result ) : $result;
+	my @interpretation = $edns->option($option);		# check option interpretation
+
+	foreach ( $option => @interpretation, @alternative ) {
+		my ( $option, @value ) = @$_;
+		my @presentable = _presentable(@value);
+		$edns->option( $option, @value );
+		my $value  = $edns->option($option);
+		my $result = defined($value) ? unpack( 'H*', $value ) : $value;
+		is( $result, $expect, qqcompose( "$option" => @presentable ) );
+	}
+}
 
-	$edns->option( 8 => pack 'H*', '000117007b7b7a' );
 
-	$edns->option( 9 => pack 'H*', '00093A80' );
+is( Net::DNS::RR::OPT::_JSONify(undef),	  'null',      '_JSONify undef' );
+is( Net::DNS::RR::OPT::_JSONify(1234567), '1234567',   '_JSONify integer' );
+is( Net::DNS::RR::OPT::_JSONify('12345'), '12345',     '_JSONify string integer' );
+is( Net::DNS::RR::OPT::_JSONify('1.234'), '1.234',     '_JSONify string non-integer' );
+is( Net::DNS::RR::OPT::_JSONify('1e+20'), '1e+20',     '_JSONify string with exponent' );
+is( Net::DNS::RR::OPT::_JSONify('abcde'), '"abcde"',   '_JSONify non-numeric string' );
+is( Net::DNS::RR::OPT::_JSONify('\\092'), '"\\\\092"', '_JSONify escape character' );
 
-	$edns->option( 10 => pack 'H*', '010000005EC233441122334455667788' );
+my @json = Net::DNS::RR::OPT::_JSONify( {'BASE16' => '1234'} );
+is( "@json", qq{"BASE16": "1234"}, 'short BASE16 string' );
 
-	$edns->option( 11 => pack 'H*', '00C8' );
 
-	$edns->option( 12 => pack 'x100' );
+$edns->print;
 
-	$edns->option( 13 => pack 'H*', '03636F6D00' );
+my $options = $edns->options;
+my $encoded = $edns->encode;
+my $decoded = Net::DNS::RR->decode( \$encoded );
+my @result  = $decoded->options;
+is( scalar(@result), $options, "expected number of options ($options)" );
 
-	$edns->option( 15 => pack 'H*', '007B' );
+exit;
 
 
-	foreach my $option ( sort { $a <=> $b } keys %Net::DNS::Parameters::ednsoptionbyval ) {
-		my @interpretation = $edns->option($option);	# check option interpretation
-		$edns->option( $option => (@interpretation) );
-		my @reconstitution = $edns->option($option);
-		is( "@reconstitution", "@interpretation", "compose/decompose option $option" );
+sub _presentable {
+	my ( $value, @list ) = @_;
+	if ( scalar @list ) {		## unstructured argument list
+		my @token = _presentable( $value, @list );
+		pop @token;
+		shift @token;
+		return @token;
 	}
 
+	if ( ref($value) eq 'HASH' ) {
+		my @tags = keys %$value;
+		my $tail = pop @tags;
+		my @body = map {
+			my ( $a, @z ) = _presentable( $$value{$_} );
+			unshift @z, qq("$_" => $a);
+			$z-1 .= ',';
+			@z;
+		} @tags;
+		my ( $a, @tail ) = _presentable( $$value{$tail} );
+		unshift @tail, qq("$tail" => $a);
+		return ( '{', @body, @tail, '}' );
+	}
 
-	eval { $edns->option( 65001 => ( '', '' ) ) };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "unable to compose option:\t$exception" );
-
-
-	my $options = $edns->options;
-	my $encoded = $edns->encode;
-	my $decoded = Net::DNS::RR->decode( \$encoded );
-	my @result  = $decoded->options;
-	is( scalar(@result), $options, 'expected number of options' );
+	if ( ref($value) eq 'ARRAY' ) {
+		my @array = @$value;
+		return qq( ) unless scalar @array;
+		my @tail = _presentable( pop @array );
+		my @body = map { my @x = _presentable($_); $x-1 .= ','; @x } @array;
+		return ( '', @body, @tail, '' );
+	}
 
-	$edns->print;
+	my $string = "$value";		## stringify, then use isdual() as discriminant
+	return $string if UTIL && Scalar::Util::isdual($value); # native integer
+	for ($string) {
+		unless ( utf8::is_utf8($value) ) {
+			return $_ if /^-?\d{1,10}$/;		# integer (string representation)
+			return $_ if /^-?\d+\.\d+$/;		# non-integer
+			return $_ if /^-?\d(\.\d*)?e+-\d\d?$/;
+		}
+		s/^"(.*)"$/$1/;					# strip enclosing quotes
+		s/"/\\"/g;					# escape interior quotes
+	}
+	return qq("$string");
 }
 
-
-exit;
-

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-PTR.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-PTR.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-PTR.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-PTR.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 13;
+use Test::More tests => 7;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = '076578616d706c6503636f6d00';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,39 +40,17 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
-}
-
-
-{
-	my $lc		= Net::DNS::RR->new( lc ". $type @data" );
-	my $rr		= Net::DNS::RR->new( uc ". $type @data" );
-	my $hash	= {};
-	my $predecessor = $rr->encode( 0,		    $hash );
-	my $compressed	= $rr->encode( length $predecessor, $hash );
-	ok( length $compressed < length $predecessor, 'encoded RDATA compressible' );
-	isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' );
-	is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-PX.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-PX.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-PX.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-PX.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 17;
+use Test::More tests => 11;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = '000a046e657432026974000950524d442d6e6574320541444d446204432d697400';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,39 +40,17 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
-}
-
-
-{
-	my $lc		= Net::DNS::RR->new( lc ". $type @data" );
-	my $rr		= Net::DNS::RR->new( uc ". $type @data" );
-	my $hash	= {};
-	my $predecessor = $rr->encode( 0,		    $hash );
-	my $compressed	= $rr->encode( length $predecessor, $hash );
-	ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' );
-	isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' );
-	is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-RP.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-RP.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-RP.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-RP.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 15;
+use Test::More tests => 9;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = '027270076578616d706c6503636f6d0003747874076578616d706c65036e657400';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,39 +40,17 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
-}
-
-
-{
-	my $lc		= Net::DNS::RR->new( lc ". $type @data" );
-	my $rr		= Net::DNS::RR->new( uc ". $type @data" );
-	my $hash	= {};
-	my $predecessor = $rr->encode( 0,		    $hash );
-	my $compressed	= $rr->encode( length $predecessor, $hash );
-	ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' );
-	isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' );
-	is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-RRSIG.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-RRSIG.t Changed

@@ -1,10 +1,11 @@
 #!/usr/bin/perl
-# $Id: 05-RRSIG.t 1856 2021-12-02 14:36:25Z willem $	-*-perl-*-
+# $Id: 05-RRSIG.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
 use Test::More;
+use TestToolkit;
 
 use Net::DNS;
 
@@ -19,7 +20,7 @@
 	exit;
 }
 
-plan tests => 71;
+plan tests => 67;
 
 
 my $name = 'net-dns.org';
@@ -38,20 +39,11 @@
 my $wire =
 '0002070200000E1052346FD7520CE2D7EDED076E65742D646E73036F7267002119428D83590A475D8E8170E941B10206BF12FC6010D97E2044AEC911FDBE5AF2B32AA77B480FA5C942FBEADA3F7FB2440FA00C81EB324230B0BB9DAA87788AEA00EF7330D4DC444D2EA59B67904C33732D263A767271641A97CA90B739FEDB17752647F18D85C1484E1B95FEA16AF86B3E8344C9E9EC8C17AC9D6218D2DF59';
 
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
-
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -66,42 +58,24 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $empty   = Net::DNS::RR->new("$name $type");
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = uc unpack 'H*', $decoded->encode;
 	my $hex2    = uc unpack 'H*', $encoded;
-	my $hex3    = uc unpack 'H*', substr( $encoded, length $empty->encode );
+	my $hex3    = uc unpack 'H*', $rr->rdata;
 	is( $hex1, $hex2, 'encode/decode transparent' );
 	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my @rdata	= @data;
-	my $sig		= pop @rdata;
-	my $lc		= Net::DNS::RR->new( lc(". $type @rdata ") . $sig );
-	my $rr		= Net::DNS::RR->new( uc(". $type @rdata ") . $sig );
-	my $hash	= {};
-	my $predecessor = $rr->encode( 0,		    $hash );
-	my $compressed	= $rr->encode( length $predecessor, $hash );
-	ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' );
-	is( $rr->encode,    $lc->encode, 'encoded RDATA names downcased' );
-	is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' );
-}
-
-
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach ( @attr, 'rdstring' ) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}
 }
 
 
-{
-	my $rr	  = Net::DNS::RR->new(". $type @data");
+for my $rr ( Net::DNS::RR->new(". $type @data") ) {
 	my $class = ref($rr);
 
 	$rr->algorithm(255);
@@ -118,30 +92,17 @@
 	is( $class->algorithm('RSASHA256'), 8,		 'class method algorithm("RSASHA256")' );
 	is( $class->algorithm(8),	    'RSASHA256', 'class method algorithm(8)' );
 	is( $class->algorithm(255),	    255,	 'class method algorithm(255)' );
-}
 
+	my $object = Net::DNS::RR->new(". $type");
+	my $scalar = '';
+	$object->{algorithm} = 0;	## methods callable with invalid arguments
 
-{
-	my $object   = Net::DNS::RR->new(". $type");
-	my $class    = ref($object);
-	my $scalar   = '';
-	my %testcase = (		## methods callable with invalid arguments
-		'_CreateSig'	 => $object, $scalar, $object,
-		'_CreateSigData' => $object, $object,
-		'_VerifySig'	 => $object, $object, $object,
-		'create'	 => $class,  $scalar, $object,
-		'verify'	 => $object, $object, $object,
-		);
+	noexception( '_CreateSig callable',	sub { $object->_CreateSig( $scalar, $object ) } );
+	noexception( '_CreateSigData callable', sub { $object->_CreateSigData($object) } );
+	noexception( '_VerifySig callable',	sub { $object->_VerifySig( $object, $object ) } );
 
-	$object->{algorithm} = 0;				# induce exception
-
-	foreach my $method ( sort keys %testcase ) {
-		my $arglist = $testcase{$method};
-		my ( $object, @arglist ) = @$arglist;
-		eval { $object->$method(@arglist) };
-		my ($exception) = split /\n/, "$@\n";
-		ok( defined $exception, "$method method callable\t$exception" );
-	}
+	exception( 'create callable', sub { $class->create( $scalar, $object ) } );
+	exception( 'verify callable', sub { $object->verify( $object, $object ) } );
 }
 
 
@@ -189,10 +150,7 @@
 }
 
 
-{
-	my $rr = Net::DNS::RR->new("$name $type @data");
-	$rr->print;
-}
+Net::DNS::RR->new("$name $type @data")->print;
 
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-RT.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-RT.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-RT.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-RT.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 15;
+use Test::More tests => 9;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = '005a0572656c6179057072696d6503636f6d00';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,39 +40,17 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
-}
-
-
-{
-	my $lc		= Net::DNS::RR->new( lc ". $type @data" );
-	my $rr		= Net::DNS::RR->new( uc ". $type @data" );
-	my $hash	= {};
-	my $predecessor = $rr->encode( 0,		    $hash );
-	my $compressed	= $rr->encode( length $predecessor, $hash );
-	ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' );
-	isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' );
-	is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-SIG.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-SIG.t Changed

@@ -1,10 +1,11 @@
 #!/usr/bin/perl
-# $Id: 05-SIG.t 1856 2021-12-02 14:36:25Z willem $	-*-perl-*-
+# $Id: 05-SIG.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
 use Test::More;
+use TestToolkit;
 
 use Net::DNS;
 
@@ -19,7 +20,7 @@
 	exit;
 }
 
-plan tests => 73;
+plan tests => 70;
 
 
 my $name = '.';
@@ -38,20 +39,14 @@
 my $wire =
 '000001000000000055CE309755CE2F6B0B37067273616D6435076578616D706C650018E8EC228D895F3D8048295185D6C3E56F88624ABE128E6217D97747E2D84BFD7841FC6A5F633D6073EFB8B7F3E4E440767AB2B8A2538B7FCBB2B1E617F714CF063750C6490DE19C7BBED689426547DDD544A6787D3B3FC0F3FB247C60008861958141E31B2F21266BFED82F6E5C70252A5AE292486A152E8AD7DA8A28C5C10C';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
-
-	my $hash = {};
-	@{$hash}{@attr} = @data;
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -66,47 +61,24 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $empty   = Net::DNS::RR->new("$name $type");
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = uc unpack 'H*', $decoded->encode;
 	my $hex2    = uc unpack 'H*', $encoded;
-	my $hex3    = uc unpack 'H*', substr( $encoded, length $empty->encode );
+	my $hex3    = uc unpack 'H*', $rr->rdata;
 	is( $hex1, $hex2, 'encode/decode transparent' );
 	is( $hex3, $wire, 'encoded RDATA matches example' );
 
 	my $wireformat = pack 'a* x', $encoded;
-	eval { Net::DNS::RR->decode( \$wireformat ); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "misplaced SIG RR\t$exception" );
+	exception( 'misplaced SIG RR', sub { Net::DNS::RR->decode( \$wireformat ) } );
 }
 
 
-{
-	my @rdata	= @data;
-	my $sig		= pop @rdata;
-	my $lc		= Net::DNS::RR->new( lc(". $type @rdata ") . $sig );
-	my $rr		= Net::DNS::RR->new( uc(". $type @rdata ") . $sig );
-	my $hash	= {};
-	my $predecessor = $rr->encode( 0,		    $hash );
-	my $compressed	= $rr->encode( length $predecessor, $hash );
-	ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' );
-	is( $rr->encode,    $lc->encode, 'encoded RDATA names downcased' );
-	is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' );
-}
-
-
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach ( @attr, 'rdstring' ) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}
-}
-
 
-{
-	my $rr	  = Net::DNS::RR->new(". $type @data");
 	my $class = ref($rr);
 
 	$rr->algorithm(255);
@@ -116,37 +88,22 @@
 	is( $rr->algorithm('MNEMONIC'), 'RSASHA1', 'rr->algorithm("MNEMONIC") returns mnemonic' );
 	is( $rr->algorithm(),		5,	   'rr->algorithm("MNEMONIC") preserves value' );
 
-	eval { $rr->algorithm('X'); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "unknown mnemonic\t$exception" );
+	exception( 'unknown mnemonic', sub { $rr->algorithm('X') } );
 
 	is( $class->algorithm('RSASHA256'), 8,		 'class method algorithm("RSASHA256")' );
 	is( $class->algorithm(8),	    'RSASHA256', 'class method algorithm(8)' );
 	is( $class->algorithm(255),	    255,	 'class method algorithm(255)' );
-}
-
 
-{
-	my $object   = Net::DNS::RR->new(". $type");
-	my $class    = ref($object);
-	my $scalar   = '';
-	my %testcase = (		## methods callable with invalid arguments
-		'_CreateSig'	 => $object, $scalar, $object,
-		'_CreateSigData' => $object, $object,
-		'_VerifySig'	 => $object, $object, $object,
-		'create'	 => $class,  $scalar, $object,
-		'verify'	 => $object, $object, $object,
-		);
+	my $object = Net::DNS::RR->new(". $type");
+	my $scalar = '';
+	$object->{algorithm} = 0;	## methods callable with invalid arguments
 
-	$object->{algorithm} = 0;				# induce exception
+	noexception( '_CreateSig callable',	sub { $object->_CreateSig( $scalar, $object ) } );
+	noexception( '_CreateSigData callable', sub { $object->_CreateSigData($object) } );
+	noexception( '_VerifySig callable',	sub { $object->_VerifySig( $object, $object ) } );
 
-	foreach my $method ( sort keys %testcase ) {
-		my $arglist = $testcase{$method};
-		my ( $object, @arglist ) = @$arglist;
-		eval { $object->$method(@arglist) };
-		my ($exception) = split /\n/, "$@\n";
-		ok( defined $exception, "$method method callable\t$exception" );
-	}
+	exception( 'create callable', sub { $class->create( $scalar, $object ) } );
+	exception( 'verify callable', sub { $object->verify( $object, $object ) } );
 }
 
 
@@ -178,27 +135,21 @@
 }
 
 
-{
-	ok( Net::DNS::RR::SIG::_ordered( undef,	      0 ),	    '_ordered( undef, 0 )' );
-	ok( Net::DNS::RR::SIG::_ordered( 0,	      1 ),	    '_ordered( 0, 1 )' );
-	ok( Net::DNS::RR::SIG::_ordered( 0x7fffffff,  0x80000000 ), '_ordered( 0x7fffffff, 0x80000000 )' );
-	ok( Net::DNS::RR::SIG::_ordered( 0xffffffff,  0 ),	    '_ordered( 0xffffffff, 0 )' );
-	ok( Net::DNS::RR::SIG::_ordered( -2,	      -1 ),	    '_ordered( -2, -1 )' );
-	ok( Net::DNS::RR::SIG::_ordered( -1,	      0 ),	    '_ordered( -1, 0 )' );
-	ok( !Net::DNS::RR::SIG::_ordered( undef,      undef ),	    '!_ordered( undef, undef )' );
-	ok( !Net::DNS::RR::SIG::_ordered( 0,	      undef ),	    '!_ordered( 0, undef )' );
-	ok( !Net::DNS::RR::SIG::_ordered( 0x80000000, 0x7fffffff ), '!_ordered( 0x80000000, 0x7fffffff )' );
-	ok( !Net::DNS::RR::SIG::_ordered( 0,	      0xffffffff ), '!_ordered( 0, 0xffffffff )' );
-	ok( !Net::DNS::RR::SIG::_ordered( -1,	      -2 ),	    '!_ordered( -1, -2 )' );
-	ok( !Net::DNS::RR::SIG::_ordered( 0,	      -1 ),	    '!_ordered( 0, -1 )' );
-}
+ok( Net::DNS::RR::SIG::_ordered( undef,	      0 ),	    '_ordered( undef, 0 )' );
+ok( Net::DNS::RR::SIG::_ordered( 0,	      1 ),	    '_ordered( 0, 1 )' );
+ok( Net::DNS::RR::SIG::_ordered( 0x7fffffff,  0x80000000 ), '_ordered( 0x7fffffff, 0x80000000 )' );
+ok( Net::DNS::RR::SIG::_ordered( 0xffffffff,  0 ),	    '_ordered( 0xffffffff, 0 )' );
+ok( Net::DNS::RR::SIG::_ordered( -2,	      -1 ),	    '_ordered( -2, -1 )' );
+ok( Net::DNS::RR::SIG::_ordered( -1,	      0 ),	    '_ordered( -1, 0 )' );
+ok( !Net::DNS::RR::SIG::_ordered( undef,      undef ),	    '!_ordered( undef, undef )' );
+ok( !Net::DNS::RR::SIG::_ordered( 0,	      undef ),	    '!_ordered( 0, undef )' );
+ok( !Net::DNS::RR::SIG::_ordered( 0x80000000, 0x7fffffff ), '!_ordered( 0x80000000, 0x7fffffff )' );
+ok( !Net::DNS::RR::SIG::_ordered( 0,	      0xffffffff ), '!_ordered( 0, 0xffffffff )' );
+ok( !Net::DNS::RR::SIG::_ordered( -1,	      -2 ),	    '!_ordered( -1, -2 )' );
+ok( !Net::DNS::RR::SIG::_ordered( 0,	      -1 ),	    '!_ordered( 0, -1 )' );
 
 
-{
-	my $rr = Net::DNS::RR->new("$name $type @data");
-	$rr->print;
-}
+Net::DNS::RR->new("$name $type @data")->print;
 
 exit;
 
-

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-SMIMEA.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-SMIMEA.t Changed

@@ -1,10 +1,11 @@
 #!/usr/bin/perl
-# $Id: 05-SMIMEA.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-SMIMEA.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 19;
+use Test::More tests => 16;
+use TestToolkit;
 
 use Net::DNS;
 
@@ -18,20 +19,14 @@
 
 my $wire = qw( 010101d2abde240d7cd3ee6b4b28c54df034b97983a1d16e8a410e4561cb106618e971 );
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,46 +41,26 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' )
-}
-
-
-{
-	my $rr = Net::DNS::RR->new(". $type @data");
-	eval { $rr->certificate('123456789XBCDEF'); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "corrupt hexadecimal\t$exception" );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}
-}
 
-
-{
-	my $rr = Net::DNS::RR->new("$name $type @data");
-	$rr->print;
+	exception( 'corrupt hexadecimal', sub { $rr->certificate('123456789XBCDEF') } );
 }
 
 
+Net::DNS::RR->new("$name $type @data")->print;
+
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-SOA.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-SOA.t Changed

@@ -1,11 +1,11 @@
 #!/usr/bin/perl
-# $Id: 05-SOA.t 1819 2020-10-19 08:07:24Z willem $	-*-perl-*-
+# $Id: 05-SOA.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
 use integer;
-use Test::More tests => 41;
+use Test::More tests => 35;
 
 use Net::DNS;
 
@@ -19,20 +19,14 @@
 
 my $wire = '026e73076578616d706c65036e657400027270076578616d706c6503636f6d0000000000000038400000070800093a8000001c20';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -47,48 +41,30 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $lc		= Net::DNS::RR->new( lc ". $type @data" );
-	my $rr		= Net::DNS::RR->new( uc ". $type @data" );
-	my $hash	= {};
-	my $predecessor = $rr->encode( 0,		    $hash );
-	my $compressed	= $rr->encode( length $predecessor, $hash );
-	ok( length $compressed < length $predecessor, 'encoded RDATA compressible' );
-	isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' );
-	is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' );
+for my $rr ( Net::DNS::RR->new(". $type") ) {
+	foreach (@attr) {
+		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
+	}
 }
 
 
-{
+for my $rr ( Net::DNS::RR->new("name SOA mname rname 0") ) {
 	use integer;			## exercise 32-bit compatibility code on 64-bit hardware
-	my $rr = Net::DNS::RR->new("name SOA mname rname 0");
 	ok( $rr->serial(-1), 'ordering function 32-bit compatibility' );
-}
-
 
-{
 	my $initial = 0;		## test serial number partial ordering function
 	foreach my $serial ( 2E9, 3E9, 4E9, 1E9, 2E9, 4E9, 1E9, 3E9 ) {
-		my $rr = Net::DNS::RR->new("name SOA mname rname $initial");
+		$rr->serial($initial);
 		is(	sprintf( '%u', $rr->serial($serial) ),
 			sprintf( '%u', $serial ),
 			"rr->serial($serial) steps from $initial to $serial"
@@ -98,8 +74,7 @@
 }
 
 
-{
-	my $rr	    = Net::DNS::RR->new('name SOA mname rname 1');
+for my $rr ( Net::DNS::RR->new('name SOA mname rname 1') ) {
 	my $initial = $rr->serial;
 	is( $rr->serial(SEQUENTIAL), ++$initial, 'rr->serial(SEQUENTIAL) increments existing serial number' );
 
@@ -121,8 +96,7 @@
 }
 
 
-{
-	my $rr	     = Net::DNS::RR->new('name SOA mname rname 2000000000');
+for my $rr ( Net::DNS::RR->new('name SOA mname rname 2000000000') ) {
 	my $predate  = $rr->serial;
 	my $postdate = YYYYMMDDxx;
 	my $postincr = $postdate + 1;
@@ -131,30 +105,20 @@
 }
 
 
-{
+for my $rr ( Net::DNS::RR->new('name SOA mname rname') ) {
 	my $pretime  = time() - 10;
-	my $rr	     = Net::DNS::RR->new("name SOA mname rname $pretime");
 	my $posttime = UNIXTIME;
 	my $postincr = $posttime + 1;
+	$rr->serial($pretime);
 	is( $rr->serial($posttime), $posttime, "rr->serial(UNIXTIME) steps from $pretime to $posttime" );
 	is( $rr->serial($posttime), $postincr, "rr->serial(UNIXTIME) increments $posttime to $postincr" );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
-	foreach (@attr) {
-		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
-	}
-}
-
-
-{
-	my $rr = Net::DNS::RR->new("$name $type @data");
+for my $rr ( Net::DNS::RR->new("$name $type @data") ) {
 	$rr->serial(YYYYMMDDxx);
 	$rr->print;
 }
 
-
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-SPF.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-SPF.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-SPF.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-SPF.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 10;
+use Test::More tests => 7;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = '25763d73706631202b6d7820613a636f6c6f2e6578616d706c652e636f6d2f3238202d616c6c';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -49,22 +43,13 @@
 		is( $r2, $r1, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-SRV.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-SRV.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-SRV.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-SRV.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 19;
+use Test::More tests => 13;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = '0001000300090466617374076578616d706c6503636f6d00';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,39 +40,17 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
-}
-
-
-{
-	my $lc		= Net::DNS::RR->new( lc ". $type @data" );
-	my $rr		= Net::DNS::RR->new( uc ". $type @data" );
-	my $hash	= {};
-	my $predecessor = $rr->encode( 0,		    $hash );
-	my $compressed	= $rr->encode( length $predecessor, $hash );
-	ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' );
-	isnt( $rr->encode, $lc->encode, 'encoded RDATA names not downcased' );
-	is( $rr->canonical, $lc->encode, 'canonical RDATA names downcased' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-SSHFP.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-SSHFP.t Changed

@@ -1,10 +1,11 @@
 #!/usr/bin/perl
-# $Id: 05-SSHFP.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-SSHFP.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 18;
+use Test::More tests => 15;
+use TestToolkit;
 
 use Net::DNS;
 
@@ -18,20 +19,14 @@
 
 my $wire = '0201123456789abcdef67890123456789abcdef67890';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,46 +41,26 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
-}
-
-
-{
-	my $rr = Net::DNS::RR->new(". $type @data");
-	eval { $rr->fp('123456789XBCDEF'); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "corrupt hexadecimal\t$exception" );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}
-}
 
-
-{
-	my $rr = Net::DNS::RR->new("$name $type @data");
-	$rr->print;
+	exception( 'corrupt hexadecimal', sub { $rr->fp('123456789XBCDEF') } );
 }
 
 
+Net::DNS::RR->new("$name $type @data")->print;
+
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-SVCB.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-SVCB.t Changed

@@ -1,5 +1,5 @@
 #!/usr/bin/perl
-# $Id: 05-SVCB.t 1847 2021-08-11 10:02:44Z willem $	-*-perl-*-
+# $Id: 05-SVCB.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
@@ -8,15 +8,16 @@
 use Net::DNS::ZoneFile;
 
 use Test::More;
+use TestToolkit;
 
 exit( plan skip_all => 'unresolved AUTOLOAD regression	perl #120694' )
 		if ( $ == 5.018000 )
 		or ( $ == 5.018001 );
 
-plan tests => 49;
+plan tests => 44;
 
 
-my $name = 'alias.example';
+my $name = 'SVCB.example';
 my $type = 'SVCB';
 my $code = 64;
 my @attr = qw( svcpriority targetname port );
@@ -25,20 +26,14 @@
 
 my $wire = '000104706f6f6c03737663076578616d706c65000003000204d2';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -49,79 +44,55 @@
 		is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
-}
-
-
-{
-	my @rdata	= qw(0 svc.example.net);
-	my $lc		= Net::DNS::RR->new( lc ". $type @rdata" );
-	my $rr		= Net::DNS::RR->new( uc ". $type @rdata" );
-	my $hash	= {};
-	my $predecessor = $rr->encode( 0,		    $hash );
-	my $compressed	= $rr->encode( length $predecessor, $hash );
-	ok( length $compressed == length $predecessor, 'encoded RDATA not compressible' );
-	isnt( $rr->encode,    $lc->encode, 'encoded RDATA names not downcased' );
-	isnt( $rr->canonical, $lc->encode, 'canonical RDATA names not downcased' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach ( qw(TargetName), @also ) {
 		is( $rr->$_(), undef, "empty RR has undefined $_" );
 	}
-}
-
 
-{
-	my $l0 = length( Net::DNS::RR->new(". $type 1 .")->encode );
-	my $rr = Net::DNS::RR->new(". $type 1 . port=1234");
+	$rr->svcpriority(1);
+	$rr->targetname('.');
+	my $l0 = length $rr->encode;
+	$rr->key3(1234);
 	$rr->key3(undef);
 	is( length( $rr->encode ), $l0, 'delete SvcParams key' );
 }
 
 
-END {
-	Net::DNS::RR->new( <<'END' )->print;
+Net::DNS::RR->new( <<'END' )->print;
 example.com.	SVCB	16 foo.example.org.	( mandatory=alpn alpn=h2,h3-19
 			no-default-alpn port=1234 ipv4hint=192.0.2.1
-			ech=Li4u ipv6hint=2001:db8::1 )
+			ech=Li4u ipv6hint=2001:db8::1
+			dohpath=/dns-query{?dns}
+			)
 END
-}
 
 
 ####	Test Vectors
 
-my $zonefile = new Net::DNS::ZoneFile( \*DATA );
+my $zonefile = Net::DNS::ZoneFile->new( \*DATA );
 
 sub testcase {
 	my $ident  = shift;
 	my $vector = $zonefile->read;
 	my $expect = $zonefile->read;
 	is( $vector->string, $expect->string, $ident );
+	return;
 }
 
 sub failure {
 	my $ident = shift;
-	eval { $zonefile->read };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "$ident\t$exception" );
+	exception( "$ident", sub { $zonefile->read } );
+	return;
 }
 
 
@@ -134,8 +105,11 @@
 testcase('two IPv6 hints in quoted presentation format');
 testcase('single IPv6 hint in IPv4 mapped IPv6 format');
 testcase('unsorted SvcParams and mandatory key list');
-testcase('alpn with escaped escape and escaped comma');
-testcase('alpn with numeric escape and escaped comma');
+
+failure('alpn with escaped escape and escaped comma');		# Appendix A not implemented
+$zonefile->read();
+failure('alpn with numeric escape and escaped comma');
+$zonefile->read();
 
 failure('key already defined');
 
@@ -152,6 +126,7 @@
 failure('alpn not specified');
 
 failure('unrecognised key name');
+failure('invalid SvcParam key');
 failure('non-numeric port value');
 failure('corrupt wire format');
 
@@ -300,6 +275,7 @@
 
 
 example.com.	SVCB	1 foo.example.com. mandatory=bogus
+example.com.	SVCB	1 foo.example.com. key65535=invalid
 example.com.	SVCB	1 foo.example.com. port=1234X5
 
 example.com.	SVCB	( \# 25 0001		; 1

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-TKEY.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-TKEY.t Changed

@@ -1,10 +1,11 @@
 #!/usr/bin/perl
-# $Id: 05-TKEY.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-TKEY.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 24;
+use Test::More tests => 21;
+use TestToolkit;
 
 use Net::DNS;
 
@@ -19,20 +20,14 @@
 
 my $wire = '03616c67076578616d706c6500558567665585676600010011000564756d6d79000564756d6d79';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -47,34 +42,21 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
-
-	my @wire = unpack 'C*', $encoded;
-	$wirelength($empty) - 1--;
-	my $wireformat = pack 'C*', @wire;
-	eval { Net::DNS::RR->decode( \$wireformat ); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "corrupt wire-format\t$exception" );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
+
+	my $emptyrr = Net::DNS::RR->new("$name $type")->encode;
+	my $corrupt = pack 'a*X2na*', $emptyrr, $decoded->rdlength - 1, $rr->rdata;
+	exception( 'corrupt wire-format', sub { Net::DNS::RR->decode( \$corrupt ) } );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-TLSA.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-TLSA.t Changed

@@ -1,10 +1,11 @@
 #!/usr/bin/perl
-# $Id: 05-TLSA.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-TLSA.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 19;
+use Test::More tests => 16;
+use TestToolkit;
 
 use Net::DNS;
 
@@ -20,20 +21,14 @@
 my $wire =
 '01010292003ba34942dc74152e2f2c408d29eca5a520e7f2e06bb944f4dca346baf63c1b177615d466f6c4b71c216a50292bd58c9ebdd2f74e38fe51ffd48c43326cbc';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
-
-	my $hash = {};
-	@{$hash}{@attr} = @data;
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -48,30 +43,13 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' )
-}
-
-
-{
-	my $rr = Net::DNS::RR->new(". $type @data");
-	eval { $rr->certificate('123456789XBCDEF'); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "corrupt hexadecimal\t$exception" );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
@@ -80,6 +58,8 @@
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}
+
+	exception( 'corrupt hexadecimal', sub { $rr->certificate('123456789XBCDEF') } );
 }

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-TSIG.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-TSIG.t Changed

@@ -1,10 +1,11 @@
 #!/usr/bin/perl
-# $Id: 05-TSIG.t 1856 2021-12-02 14:36:25Z willem $	-*-perl-*-
+# $Id: 05-TSIG.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
 use Test::More;
+use TestToolkit;
 
 use Net::DNS;
 
@@ -21,7 +22,7 @@
 	exit;
 }
 
-plan tests => 65;
+plan tests => 63;
 
 
 sub mysign {
@@ -41,22 +42,14 @@
 
 my $wire = '0466616b6503616c67000000000186a102580010a5d31d3ce3b7122b4a598c225d9c3f2a04d200000000';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-my $hash = {};
+my $hash = {keybin => pack( 'H*', '66616b65206b6579' )};
 @{$hash}{@attr} = @data;
 
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash,
-		keybin => pack( 'H*', '66616b65206b6579' ),
-		);
-
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	like( $rr->string, "/$$hash{algorithm}/", 'got expected rr->string' );
 
@@ -68,63 +61,47 @@
 		ok( defined $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null   = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty  = Net::DNS::RR->new("$name $type")->encode;
-	my $buffer = $empty;		## Note: TSIG RR gets destroyed by decoder
-	my $rxbin  = Net::DNS::RR->decode( \$buffer )->encode;
 	my $packet = Net::DNS::Packet->new( $name, 'TKEY', 'IN' );
 	$packet->header->id(1234);				# fix packet id
 	$packet->header->rd(1);
+	my $buffer;
 	my $encoded = $buffer = $rr->encode( 0, {}, $packet );
 	my $decoded = Net::DNS::RR->decode( \$buffer );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	    $hex1,	   'encode/decode transparent' );
-	is( $hex3,	    $wire,	   'encoded RDATA matches example' );
-	is( length($empty), length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin), length($null), 'decoded RDATA can be empty' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 
 	my $wireformat = pack 'a* x', $encoded;
-	eval { Net::DNS::RR->decode( \$wireformat ); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "misplaced $type RR\t$exception" );
+	exception( "misplaced $type RR", sub { Net::DNS::RR->decode( \$wireformat ) } );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new( type => 'TSIG', key => '' );
+for my $rr ( Net::DNS::RR->new( type => 'TSIG', key => '' ) ) {
 	ok( !$rr->verify(),	'verify fails on empty TSIG' );
 	ok( $rr->vrfyerrstr(),	'vrfyerrstr() reports failure' );
 	ok( !$rr->other(),	'other undefined' );
 	ok( $rr->time_signed(), 'time_signed() defined' );
-	my $key		= eval { $rr->key(); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "key attribute write-only\t$exception" );
+	exception( "TSIG key write-only", sub { $rr->key() } );
 }
 
 
-{
+foreach my $method (qw(mac request_mac prior_mac)) {
 	my $mac = 'kpRyejY4uxwT9I74FYv8nQ==';
-	foreach my $method (qw(mac request_mac prior_mac)) {
-		my $rr = Net::DNS::RR->new( type => 'TSIG', $method => $mac );
-		is( $rr->$method(), $mac, "correct $method" );
-	}
+	my $rr	= Net::DNS::RR->new( type => 'TSIG', $method => $mac );
+	is( $rr->$method(), $mac, "correct $method" );
 }
 
 
-{
-	# Check default signing function using test cases from RFC2202, section 2.
-
-	my $expected = Net::DNS::RR->new( type => 'TSIG', algorithm => 'HMAC-MD5.SIG-ALG.REG.INT' );
-
-	my $tsig      = Net::DNS::RR->new( type => 'TSIG', fudge => 300 );
+for my $tsig ( Net::DNS::RR->new( type => 'TSIG', fudge => 300 ) ) {
 	my $function  = $tsig->sig_function;			# default signing function
 	my $algorithm = $tsig->algorithm;			# default algorithm
 
-	is( $algorithm, $expected->algorithm, 'Check algorithm correctly identified' );
+	my $expected = 'HMAC-MD5.SIG-ALG.REG.INT';
+	is( $algorithm, $expected, 'Check algorithm correctly identified' );
 
+	# Check default signing function using test cases from RFC2202, section 2.
 	{
 		my $data   = pack 'H*', '4869205468657265';
 		my $key	   = "\x0b" x 16;
@@ -184,15 +161,13 @@
 }
 
 
-{
-	# Check HMAC-SHA1 signing function using test cases from RFC2202, section 3.
-
-	my $tsig      = Net::DNS::RR->new( type => 'TSIG', algorithm => 'HMAC-SHA' );	 # alias HMAC-SHA1
+for my $tsig ( Net::DNS::RR->new( type => 'TSIG', algorithm => 'HMAC-SHA' ) ) {	   # alias HMAC-SHA1
 	my $algorithm = $tsig->algorithm;
 	my $function  = $tsig->sig_function;
 
 	is( $algorithm, 'HMAC-SHA1', 'Check algorithm correctly identified' );
 
+	# Check HMAC-SHA1 signing function using test cases from RFC2202, section 3.
 	{
 		my $data   = pack 'H*', '4869205468657265';
 		my $key	   = "\x0b" x 20;
@@ -252,15 +227,13 @@
 }
 
 
-{
-	# Check HMAC-SHA224 signing function using test cases from RFC4634, section 8.4.
-
-	my $tsig      = Net::DNS::RR->new( type => 'TSIG', algorithm => 162 );	  # alias HMAC-SHA224
+for my $tsig ( Net::DNS::RR->new( type => 'TSIG', algorithm => 162 ) ) {    # alias HMAC-SHA224
 	my $algorithm = $tsig->algorithm;
 	my $function  = $tsig->sig_function;
 
 	is( $algorithm, 'HMAC-SHA224', 'Check algorithm correctly identified' );
 
+	# Check HMAC-SHA224 signing function using test cases from RFC4634, section 8.4.
 	{
 		my $data   = pack 'H*', '4869205468657265';
 		my $key	   = "\x0b" x 20;
@@ -325,13 +298,11 @@
 }
 
 
-{
-	# Check HMAC-SHA256 signing function using test cases from RFC4634, section 8.4.
-
-	my $tsig      = Net::DNS::RR->new( type => 'TSIG', algorithm => 'HMAC-SHA256' );
+for my $tsig ( Net::DNS::RR->new( type => 'TSIG', algorithm => 'HMAC-SHA256' ) ) {
 	my $algorithm = $tsig->algorithm;
 	my $function  = $tsig->sig_function;
 
+	# Check HMAC-SHA256 signing function using test cases from RFC4634, section 8.4.
 	{
 		my $data   = pack 'H*', '4869205468657265';
 		my $key	   = "\x0b" x 20;
@@ -396,13 +367,11 @@
 }
 
 
-{
-	# Check HMAC-SHA384 signing function using test cases from RFC4634, section 8.4.
-
-	my $tsig      = Net::DNS::RR->new( type => 'TSIG', algorithm => 'HMAC-SHA384' );
+for my $tsig ( Net::DNS::RR->new( type => 'TSIG', algorithm => 'HMAC-SHA384' ) ) {
 	my $algorithm = $tsig->algorithm;
 	my $function  = $tsig->sig_function;
 
+	# Check HMAC-SHA384 signing function using test cases from RFC4634, section 8.4.
 	{
 		my $data   = pack 'H*', '4869205468657265';
 		my $key	   = "\x0b" x 20;
@@ -485,13 +454,11 @@
 }
 
 
-{
-	# Check HMAC-SHA512 signing function using test cases from RFC4634, section 8.4.
-
-	my $tsig      = Net::DNS::RR->new( type => 'TSIG', algorithm => 'HMAC-SHA512' );
+for my $tsig ( Net::DNS::RR->new( type => 'TSIG', algorithm => 'HMAC-SHA512' ) ) {
 	my $algorithm = $tsig->algorithm;
 	my $function  = $tsig->sig_function;
 
+	# Check HMAC-SHA512 signing function using test cases from RFC4634, section 8.4.
 	{
 		my $data   = pack 'H*', '4869205468657265';
 		my $key	   = "\x0b" x 20;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-TXT.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-TXT.t Changed

@@ -1,10 +1,11 @@
 #!/usr/bin/perl
-# $Id: 05-TXT.t 1857 2021-12-07 13:38:02Z willem $	-*-perl-*-
+# $Id: 05-TXT.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 52;
+use Test::More tests => 50;
+use TestToolkit;
 
 use Net::DNS;
 
@@ -14,23 +15,18 @@
 my $code = 16;
 my @attr = qw( txtdata );
 my @data = qw( arbitrary_text );
+my @also = qw( char_str_list );
 
 my $wire = '0e6172626974726172795f74657874';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
-
-	my $hash = {};
-	@{$hash}{@attr} = @data;
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -41,29 +37,28 @@
 		is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" );
 	}
 
+	foreach (@also) {
+		ok( $rr->$_, "additional attribute rr->$_()" );
+	}
 
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
-
-	my @wire = unpack 'C*', $encoded;
-	$wirelength($empty) - 1--;
-	my $wireformat = pack 'C*', @wire;
-	eval { Net::DNS::RR->decode( \$wireformat ); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "corrupt wire-format\t$exception" );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
+
+	my $emptyrr = Net::DNS::RR->new("$name $type")->encode;
+	my $corrupt = pack 'a*X2na*', $emptyrr, $decoded->rdlength - 1, $rr->rdata;
+	exception( 'corrupt wire-format', sub { Net::DNS::RR->decode( \$corrupt ) } );
+}
+
+
+for my $rr ( Net::DNS::RR->new(". $type") ) {
+	foreach (@attr) {
+		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
+	}
 }
 
 
@@ -91,14 +86,6 @@
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
-	foreach (@attr) {
-		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
-	}
-}
-
-
 exit;
 
 __END__

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-URI.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-URI.t Changed

@@ -1,5 +1,5 @@
 #!/usr/bin/perl
-# $Id: 05-URI.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-URI.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
@@ -18,20 +18,14 @@
 
 my $wire = '000A00016674703A2F2F667470312E6578616D706C652E636F6D2F7075626C6963';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,21 +40,17 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $empty   = Net::DNS::RR->new("$name $type");
-	my $nodata  = $empty->string;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = uc unpack 'H*', $decoded->encode;
 	my $hex2    = uc unpack 'H*', $encoded;
-	my $hex3    = uc unpack 'H*', substr( $encoded, length $empty->encode );
+	my $hex3    = uc unpack 'H*', $rr->rdata;
 	is( $hex1, $hex2, 'encode/decode transparent' );
 	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-X25.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-X25.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 05-X25.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-X25.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 11;
+use Test::More tests => 8;
 
 use Net::DNS;
 
@@ -18,20 +18,14 @@
 
 my $wire = '0c333131303631373030393536';
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $hash = {};
-	@{$hash}{@attr} = @data;
-
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -46,27 +40,17 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $null    = Net::DNS::RR->new("$name NULL")->encode;
-	my $empty   = Net::DNS::RR->new("$name $type")->encode;
-	my $rxbin   = Net::DNS::RR->decode( \$empty )->encode;
-	my $txtext  = Net::DNS::RR->new("$name $type")->string;
-	my $rxtext  = Net::DNS::RR->new($txtext)->encode;
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = unpack 'H*', $encoded;
 	my $hex2    = unpack 'H*', $decoded->encode;
-	my $hex3    = unpack 'H*', substr( $encoded, length $null );
-	is( $hex2,	     $hex1,	    'encode/decode transparent' );
-	is( $hex3,	     $wire,	    'encoded RDATA matches example' );
-	is( length($empty),  length($null), 'encoded RDATA can be empty' );
-	is( length($rxbin),  length($null), 'decoded RDATA can be empty' );
-	is( length($rxtext), length($null), 'string RDATA can be empty' );
+	my $hex3    = unpack 'H*', $rr->rdata;
+	is( $hex2, $hex1, 'encode/decode transparent' );
+	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach (@attr) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}

_service:tar_scm:Net-DNS-1.34.tar.gz/t/05-ZONEMD.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/05-ZONEMD.t Changed

@@ -1,10 +1,12 @@
 #!/usr/bin/perl
-# $Id: 05-ZONEMD.t 1815 2020-10-14 21:55:18Z willem $	-*-perl-*-
+# $Id: 05-ZONEMD.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
 use Test::More tests => 20;
+use TestToolkit;
+
 use Net::DNS;
 
 
@@ -17,20 +19,14 @@
 
 my $wire = join '', qw( 00003039 01 01 2BB183AF5F22588179A53B0A98631FAD1A292118 );
 
+my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode;
+is( $typecode, $code, "$type RR type code = $code" );
 
-{
-	my $typecode = unpack 'xn', Net::DNS::RR->new(". $type")->encode;
-	is( $typecode, $code, "$type RR type code = $code" );
-
-	my $hash = {};
-	@{$hash}{@attr} = @data;
+my $hash = {};
+@{$hash}{@attr} = @data;
 
-	my $rr = Net::DNS::RR->new(
-		name => $name,
-		type => $type,
-		%$hash
-		);
 
+for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) {
 	my $string = $rr->string;
 	my $rr2	   = Net::DNS::RR->new($string);
 	is( $rr2->string, $string, 'new/string transparent' );
@@ -45,28 +41,26 @@
 		is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" );
 	}
 
-
-	my $empty   = Net::DNS::RR->new("$name $type");
 	my $encoded = $rr->encode;
 	my $decoded = Net::DNS::RR->decode( \$encoded );
 	my $hex1    = uc unpack 'H*', $decoded->encode;
 	my $hex2    = uc unpack 'H*', $encoded;
-	my $hex3    = uc unpack 'H*', substr( $encoded, length $empty->encode );
+	my $hex3    = uc unpack 'H*', $rr->rdata;
 	is( $hex1, $hex2, 'encode/decode transparent' );
 	is( $hex3, $wire, 'encoded RDATA matches example' );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new(". $type");
+for my $rr ( Net::DNS::RR->new(". $type") ) {
 	foreach ( @attr, @also, 'rdstring' ) {
 		ok( !$rr->$_(), "'$_' attribute of empty RR undefined" );
 	}
+
+	exception( 'corrupt hexadecimal', sub { $rr->digest('123456789XBCDEF') } );
 }
 
 
-{
-	my $rr = Net::DNS::RR->new( type => $type, scheme => 1 );
+for my $rr ( Net::DNS::RR->new( type => $type, scheme => 1 ) ) {
 	ok( $rr->string, 'string method with default values' );
 	is( $rr->string, Net::DNS::RR->new( $rr->string )->string, 'parse $rr->string' );
 	$rr->digestbin('');
@@ -74,12 +68,5 @@
 }
 
 
-{
-	my $rr = Net::DNS::RR->new( type => $type );
-	eval { $rr->digest('123456789XBCDEF'); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "corrupt hexadecimal\t$exception" );
-}
-
 exit;

_service:tar_scm:Net-DNS-1.38.tar.gz/t/06-update-unique-push.t Added

@@ -0,0 +1,106 @@
+#!/usr/bin/perl
+# $Id: 06-update-unique-push.t 1895 2023-01-16 13:38:08Z willem $
+#
+
+use strict;
+use warnings;
+use Test::More tests => 45;
+
+use_ok('Net::DNS');
+
+
+# Matching of RR name is not case sensitive
+my $domain = 'example.com';
+my $method = 'unique_push';
+my $packet = Net::DNS::Update->new($domain);
+
+my $rr_1 = Net::DNS::RR->new('bla.foo 100 IN TXT "text" ;lower case');
+my $rr_2 = Net::DNS::RR->new('bla.Foo 100 IN Txt "text" ;mixed case');
+my $rr_3 = Net::DNS::RR->new('bla.foo 100 IN TXT "mixed CASE"');
+my $rr_4 = Net::DNS::RR->new('bla.foo 100 IN TXT "MIXED case"');
+
+$packet->$method( "answer", $rr_1 );
+$packet->$method( "answer", $rr_2 );
+is( $packet->header->ancount, 1, "$method case sensitivity test 1" );
+
+$packet->$method( "answer", $rr_3 );
+$packet->$method( "answer", $rr_4 );
+is( $packet->header->ancount, 3, "$method case sensitivity test 2" );
+
+
+my %sections = (
+	answer	   => 'ancount',
+	authority  => 'nscount',
+	additional => 'arcount',
+	);
+
+my @tests = (
+		1,
+		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'),
+		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'),
+		,
+		2,
+		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'),
+		Net::DNS::RR->new('bar.example.com 60 IN A 192.0.2.1'),
+		,
+		1,
+		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'),
+		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'),
+		Net::DNS::RR->new('foo.example.com 90 IN A 192.0.2.1'),
+		,
+		3,
+		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'),
+		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.2'),
+		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.3'),
+		,
+		3,
+		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'),
+		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.2'),
+		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.3'),
+		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'),
+		,
+		3,
+		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'),
+		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.2'),
+		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.1'),
+		Net::DNS::RR->new('foo.example.com 60 IN A 192.0.2.4'),
+		Net::DNS::RR->new('foo.example.com 60 HS A 192.0.2.4'),
+		,
+		3,						# without RDATA
+		Net::DNS::RR->new('foo.example.com IN A'),
+		Net::DNS::RR->new('foo.example.com ANY A'),
+		Net::DNS::RR->new('foo.example.com NONE A'),
+		,
+	);
+
+
+foreach my $test (@tests) {
+	my ( $expect, @rrs ) = @$test;
+
+	while ( my ( $section, $count_meth ) = each %sections ) {
+
+		my $packet = Net::DNS::Update->new($domain);
+
+		$packet->$method( $section => @rrs );
+
+		my $count = $packet->header->$count_meth();
+		is( $count, $expect, "$method  $section	=> RR, RR, ..." );
+
+	}
+
+	#
+	# Now do it again, pushing each RR individually.
+	#
+	while ( my ( $section, $count_meth ) = each %sections ) {
+
+		my $packet = Net::DNS::Update->new($domain);
+
+		foreach my $rr (@rrs) {
+			$packet->$method( $section => $rr );
+		}
+
+		my $count = $packet->header->$count_meth();
+		is( $count, $expect, "$method  $section	=> RR" );
+	}
+}
+

_service:tar_scm:Net-DNS-1.34.tar.gz/t/06-update.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/06-update.t Changed

@@ -1,10 +1,10 @@
 #!/usr/bin/perl
-# $Id: 06-update.t 1856 2021-12-02 14:36:25Z willem $  -*-perl-*-
+# $Id: 06-update.t 1910 2023-03-30 19:16:30Z willem $  -*-perl-*-
 #
 
 use strict;
 use warnings;
-use Test::More tests => 85;
+use Test::More tests => 84;
 
 use Net::DNS;
 
@@ -34,35 +34,25 @@
 my $ttl	   = 43200;
 my $rdata  = "10.1.2.3";
 
+my $default = Net::DNS::Resolver->domain('example.org');	# resolver default domain
+
 #------------------------------------------------------------------------------
 # Packet creation.
 #------------------------------------------------------------------------------
 
-{
-	my $packet = Net::DNS::Update->new( $zone, $class );
-	my ($z) = $packet->zone;
-
+for my $packet ( Net::DNS::Update->new( $zone, $class ) ) {	# specified domain
 	ok( $packet, 'new() returned packet' );
 	is( $packet->header->opcode, 'UPDATE', 'header opcode correct' );
-	is( $z->zname,		     $zone,    'zname from explicit argument' );
-	is( $z->zclass,		     $class,   'zclass correct' );
-	is( $z->ztype,		     'SOA',    'ztype correct' );
-}
-
-
-{
-	Net::DNS::Resolver->domain($zone);			# overides config files
-	my $packet = Net::DNS::Update->new();
 	my ($z) = $packet->zone;
-	is( $z->zname, $zone, 'zname from resolver defaults' );
+	is( $z->zname,	$zone, 'zname from explicit argument' );
+	is( $z->zclass,	$class,'zclass correct' );
+	is( $z->ztype,	'SOA', 'ztype correct' );
 }
 
 
-{
-	Net::DNS::Resolver->searchlist();			# overides config files
-	my $packet	= eval { Net::DNS::Update->new(undef); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "argument undefined\t$exception" );
+for my $packet ( Net::DNS::Update->new() ) {
+	my ($z) = $packet->zone;
+	is( $z->zname, $default, 'zname from resolver defaults' );
 }
 
 
@@ -70,11 +60,9 @@
 # RRset exists (value-independent).
 #------------------------------------------------------------------------------
 
-{
-	my $arg = "$name $ttl $class $type";
-	my $rr	= yxrrset($arg);
+for my $rr ( yxrrset( my $arg = "$name $ttl $class $type" ) ) {
+	ok( $rr, "yxrrset($arg)" );
 
-	ok( $rr, "yxrrset($arg)" );				#9
 	is( $rr->name,	$name, 'yxrrset - right name' );
 	is( $rr->ttl,	0,     'yxrrset - ttl	0' );
 	is( $rr->class, 'ANY', 'yxrrset - class ANY' );
@@ -82,15 +70,14 @@
 	ok( is_empty( $rr->rdstring ), 'yxrrset - data empty' );
 }
 
+
 #------------------------------------------------------------------------------
 # RRset exists (value-dependent).
 #------------------------------------------------------------------------------
 
-{
-	my $arg = "$name $ttl $class $type $rdata";
-	my $rr	= yxrrset($arg);
-
+for my $rr ( yxrrset( my $arg = "$name $ttl $class $type $rdata" ) ) {
 	ok( $rr, "yxrrset($arg)" );
+
 	is( $rr->name,	   $name,  'yxrrset - right name' );
 	is( $rr->ttl,	   0,	   'yxrrset - ttl   0' );
 	is( $rr->class,	   $class, "yxrrset - class $class" );
@@ -103,11 +90,9 @@
 # RRset does not exist.
 #------------------------------------------------------------------------------
 
-{
-	my $arg = "$name $ttl $class $type $rdata";
-	my $rr	= nxrrset($arg);
+for my $rr ( nxrrset( my $arg = "$name $ttl $class $type $rdata" ) ) {
+	ok( $rr, "nxrrset($arg)" );
 
-	ok( $rr, "nxrrset($arg)" );				#21
 	is( $rr->name,	$name,	'nxrrset - right name' );
 	is( $rr->ttl,	0,	'nxrrset - ttl	 0' );
 	is( $rr->class, 'NONE', 'nxrrset - class NONE' );
@@ -120,11 +105,9 @@
 # Name is in use.
 #------------------------------------------------------------------------------
 
-{
-	my @arg = "$name";
-	my $rr	= yxdomain(@arg);
+for my $rr ( yxdomain( my $arg = "$name" ) ) {
+	ok( $rr, "yxdomain($arg)" );
 
-	ok( $rr, "yxdomain(@arg)" );				#27
 	is( $rr->name,	$name, 'yxdomain - right name' );
 	is( $rr->ttl,	0,     'yxdomain - ttl	 0' );
 	is( $rr->class, 'ANY', 'yxdomain - class ANY' );
@@ -132,11 +115,9 @@
 	ok( is_empty( $rr->rdstring ), 'yxdomain - data empty' );
 }
 
-{
-	my @arg = ( name => $name );
-	my $rr	= yxdomain(@arg);
-
+for my $rr ( yxdomain( my @arg = ( name => $name ) ) ) {
 	ok( $rr, "yxdomain(@arg)" );
+
 	is( $rr->name,	$name, 'yxdomain - right name' );
 	is( $rr->ttl,	0,     'yxdomain - ttl	 0' );
 	is( $rr->class, 'ANY', 'yxdomain - class ANY' );
@@ -149,11 +130,9 @@
 # Name is not in use.
 #------------------------------------------------------------------------------
 
-{
-	my @arg = "$name";
-	my $rr	= nxdomain(@arg);
+for my $rr ( nxdomain( my $arg = "$name" ) ) {
+	ok( $rr, "nxdomain($arg)" );
 
-	ok( $rr, "nxdomain(@arg)" );				#39
 	is( $rr->name,	$name,	'nxdomain - right name' );
 	is( $rr->ttl,	0,	'nxdomain - ttl	  0' );
 	is( $rr->class, 'NONE', 'nxdomain - class NONE' );
@@ -161,11 +140,9 @@
 	ok( is_empty( $rr->rdstring ), 'nxdomain - data empty' );
 }
 
-{
-	my @arg = ( name => $name );
-	my $rr	= nxdomain(@arg);
-
+for my $rr ( nxdomain( my @arg = ( name => $name ) ) ) {
 	ok( $rr, "nxdomain(@arg)" );
+
 	is( $rr->name,	$name,	'nxdomain - right name' );
 	is( $rr->ttl,	0,	'nxdomain - ttl	  0' );
 	is( $rr->class, 'NONE', 'nxdomain - class NONE' );
@@ -178,11 +155,9 @@
 # Add to an RRset.
 #------------------------------------------------------------------------------
 
-{
-	my $arg = "$name $ttl $class $type $rdata";
-	my $rr	= rr_add($arg);
+for my $rr ( rr_add( my $arg = "$name $ttl $class $type $rdata" ) ) {
+	ok( $rr, "rr_add($arg)" );
 
-	ok( $rr, "rr_add($arg)" );				#51
 	is( $rr->name,	   $name,  'rr_add - right name' );
 	is( $rr->ttl,	   $ttl,   "rr_add - ttl   $ttl" );
 	is( $rr->class,	   $class, "rr_add - class $class" );
@@ -190,8 +165,7 @@
 	is( $rr->rdstring, $rdata, 'rr_add - right data' );
 }
 
-{
-	my $arg = "$name      $class $type $rdata";
+for my $rr ( rr_add( my $arg = "$name $class $type $rdata" ) ) {
 	my $rr	= rr_add($arg);
 
 	ok( $rr, "rr_add($arg)" );
@@ -207,11 +181,9 @@
 # Delete an RRset.
 #------------------------------------------------------------------------------
 
-{
-	my $arg = "$name $class $type";
-	my $rr	= rr_del($arg);
+for my $rr ( rr_del( my $arg = "$name $class $type" ) ) {
+	ok( $rr, "rr_del($arg)" );
 
-	ok( $rr, "rr_del($arg)" );				#63
 	is( $rr->name,	$name, 'rr_del - right name' );
 	is( $rr->ttl,	0,     'rr_del - ttl   0' );
 	is( $rr->class, 'ANY', 'rr_del - class ANY' );
@@ -223,11 +195,9 @@
 # Delete All RRsets From A Name.
 #------------------------------------------------------------------------------
 
-{
-	my $arg = "$name";
-	my $rr	= rr_del($arg);
-
+for my $rr ( rr_del( my $arg = "$name" ) ) {
 	ok( $rr, "rr_del($arg)" );
+
 	is( $rr->name,	$name, 'rr_del - right name' );
 	is( $rr->ttl,	0,     'rr_del - ttl   0' );
 	is( $rr->class, 'ANY', 'rr_del - class ANY' );
@@ -240,11 +210,9 @@
 # Delete An RR From An RRset.
 #------------------------------------------------------------------------------
 
-{
-	my $arg = "$name $class $type $rdata";
-	my $rr	= rr_del($arg);
-
+for my $rr ( rr_del( my $arg = "$name $class $type $rdata" ) ) {
 	ok( $rr, "rr_del($arg)" );
+
 	is( $rr->name,	   $name,  'rr_del - right name' );
 	is( $rr->ttl,	   0,	   'rr_del - ttl   0' );
 	is( $rr->class,	   'NONE', 'rr_del - class NONE' );
@@ -258,9 +226,8 @@
 # the class is NONE or ANY.
 #------------------------------------------------------------------------------
 
-{
-	my $packet = Net::DNS::Update->new( $zone, $class );
-	ok( $packet, 'packet created' );			#81
+for my $packet ( Net::DNS::Update->new( $zone, $class ) ) {
+	ok( $packet, 'packet created' );
 
 	$packet->push( "pre", yxrrset("$name $class $type $rdata") );
 	$packet->push( "pre", yxrrset("$name $class2 $type $rdata") );

_service:tar_scm:Net-DNS-1.34.tar.gz/t/07-zonefile.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/07-zonefile.t Changed

@@ -1,12 +1,13 @@
 #!/usr/bin/perl
-# $Id: 07-zonefile.t 1855 2021-11-26 11:33:48Z willem $	-*-perl-*-
+# $Id: 07-zonefile.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
 use IO::File;
 
-use Test::More tests => 91;
+use Test::More tests => 88;
+use TestToolkit;
 
 ## vvv	verbatim from Domain.pm
 use constant ASCII => ref eval {
@@ -35,7 +36,8 @@
 };
 
 
-use_ok('Net::DNS::ZoneFile');
+my $class = 'Net::DNS::ZoneFile';
+use_ok($class);
 
 
 my @file;
@@ -45,6 +47,7 @@
 	unlink $_ foreach @file;
 }
 
+
 sub source {				## zone file builder
 	my ( $text, @args ) = @_;
 
@@ -59,36 +62,20 @@
 	print $handle $text;
 	close $handle;
 
-	return Net::DNS::ZoneFile->new( $file, @args );
+	return $class->new( $file, @args );
 }
 
 
+my $misdirect = join ' ', '$INCLUDE zone0.txt	; presumed not to exist';
 my $recursive = join ' ', '$INCLUDE', source('$INCLUDE zone1.txt')->name;
 
 
-{
-	eval { Net::DNS::ZoneFile->new(undef); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "new(): invalid argument\t$exception" );
-}
-
-
-{
-	eval { Net::DNS::ZoneFile->new(  ); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "new(): not a file handle\t$exception" );
-}
-
-
-{
-	eval { Net::DNS::ZoneFile->new('zone0.txt'); };		# presumed not to exist
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "new(): non-existent file\t$exception" );
-}
+exception( 'new(): invalid  argument', sub { $class->new(undef) } );
+exception( 'new(): not a file handle', sub { $class->new(  ) } );
+exception( 'new(): non-existent file', sub { $class->new('zone0.txt') } );
 
 
-{					## public methods
-	my $zonefile = source('');
+for my $zonefile ( source('') ) {	## public methods
 	ok( $zonefile->isa('Net::DNS::ZoneFile'), 'new ZoneFile object' );
 
 	ok( defined $zonefile->name,   'zonefile->name always defined' );
@@ -103,77 +90,32 @@
 }
 
 
-{					## initial origin
-	my $tld	     = 'test';
-	my $absolute = source( '', "$tld." );
-	is( $absolute->origin, "$tld.", 'new ZoneFile with absolute origin' );
+for my $origin ('example') {		## initial origin
+	my $absolute = source( '', "$origin." );
+	is( $absolute->origin, "$origin.", 'new ZoneFile with absolute origin' );
 
-	my $relative = source( '', "$tld" );
-	is( $relative->origin, "$tld.", 'new ZoneFile->origin always absolute' );
+	my $relative = source( '', "$origin" );
+	is( $relative->origin, "$origin.", 'new ZoneFile->origin always absolute' );
 }
 
 
-{					## line numbering
-	my $lines    = 10;
-	my $zonefile = source( "\n" x $lines );
+for my $zonefile ( source( "\n" x 10 ) ) {	## line numbering
 	is( $zonefile->line, 0, 'zonefile->line zero before calling read()' );
 	my @rr = $zonefile->read;
-	is( $zonefile->line, $lines, 'zonefile->line number incremented by read()' );
+	is( $zonefile->line, 10, 'zonefile->line number incremented by read()' );
 }
 
 
-{
-	my $zonefile = source <<'EOF';
-$TTL
-EOF
-	eval { $zonefile->read; };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "exception:\t$exception" );
-}
-
-
-{
-	my $zonefile = source <<'EOF';
-$INCLUDE
-EOF
-	eval { $zonefile->read; };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "exception:\t$exception" );
-}
+exception( 'incomplete $TTL directive',	     sub { source('$TTL')->read } );
+exception( 'incomplete $INCLUDE directive',  sub { source('$INCLUDE')->read } );
+exception( 'incomplete $ORIGIN directive',   sub { source('$ORIGIN')->read } );
+exception( 'incomplete $GENERATE directive', sub { source('$GENERATE')->read } );
+exception( 'unrecognised $BOGUS directive',  sub { source('$BOGUS')->read } );
+exception( 'non-existent include file',	     sub { source("$misdirect")->read } );
+exception( 'recursive include directive',    sub { my @zone = source("$recursive")->read } );
 
 
-{
-	my $zonefile = source <<'EOF';
-$ORIGIN
-EOF
-	eval { $zonefile->read; };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "exception:\t$exception" );
-}
-
-
-{
-	my $zonefile = source <<'EOF';
-$GENERATE
-EOF
-	eval { $zonefile->read; };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "exception:\t$exception" );
-}
-
-
-{
-	my $zonefile = source <<'EOF';
-$BOGUS
-EOF
-	eval { $zonefile->read; };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "exception:\t$exception" );
-}
-
-
-{					## $TTL directive at start of zone file
-	my $zonefile = source <<'EOF';
+for my $zonefile ( source <<'EOF' ) {	## $TTL directive at start of zone file
 $TTL 54321
 rr0		SOA	mname rname 99 6h 1h 1w 12345
 EOF
@@ -181,8 +123,7 @@
 }
 
 
-{					## $TTL directive following implicit default
-	my $zonefile = source <<'EOF';
+for my $zonefile ( source <<'EOF' ) {	## $TTL directive following implicit default
 rr0		SOA	mname rname 99 6h 1h 1w 12345
 rr1		NULL
 $TTL 54321
@@ -197,19 +138,14 @@
 }
 
 
-{					## $INCLUDE directive
-	my $include = source <<'EOF';
+for my $include ( source <<'EOF' ) {	## $INCLUDE directive
 rr2	NULL
 EOF
-
 	my $directive = join ' ', '$INCLUDE', $include->name, '.';
-	my $misdirect = join ' ', '$INCLUDE zone0.txt	; presumed not to exist';
 	my $zonefile  = source <<"EOF";
 rr1	NULL
 $directive
 rr3	NULL
-$recursive
-$misdirect
 EOF
 
 	my $fn1 = $zonefile->name;
@@ -229,26 +165,10 @@
 	is( $rr3->name,	     'rr3', 'zonefile->read expected record' );
 	is( $zonefile->name, $fn1,  'zonefile->name identifies file' );
 	is( $zonefile->line, 3,	    'zonefile->line identifies record' );
-
-	{
-		my @rr = eval { $zonefile->read };
-		my ($exception) = split /\n/, "$@\n";
-		ok( $exception, "recursive include\t$exception" );
-	}
-
-	{
-		my @rr = eval { $zonefile->read };
-		my ($exception) = split /\n/, "$@\n";
-		ok( $exception, "non-existent include\t$exception" );
-	}
-	is( $zonefile->name, $fn1, 'zonefile->name identifies file' );
-	is( $zonefile->line, 5,	   'zonefile->line identifies directive' );
 }
 
 
-my $zonefile;
-{					## $ORIGIN directive
-	my $nested = source <<'EOF';
+for my $nested ( source <<'EOF' ) {	## $ORIGIN directive
 nested	NULL
 EOF
 
@@ -264,11 +184,10 @@
 @	NULL
 EOF
 
-	my $outer = join ' ', '$INCLUDE', $include->name;
-	$zonefile = source <<"EOF";
+	my $outer    = join ' ', '$INCLUDE', $include->name;
+	my $zonefile = source <<"EOF";
 $outer 
 outer	NULL
-
 $ORIGIN $origin
 	NULL
 EOF
@@ -290,8 +209,7 @@
 }
 
 
-{					## $GENERATE directive
-	my $zonefile = source <<'EOF';
+for my $zonefile ( source <<'EOF' ) {	## $GENERATE directive
 $GENERATE 10-30/10	"@	TXT	$"	; BIND expects template to be quoted
 $GENERATE 30-10/10	@	TXT	$
 $GENERATE 123-123	@	TXT	${,,}
@@ -320,14 +238,12 @@
 	is( $zonefile->read->rdstring, '107B',		   'generate TXT ${4096,4,X}' );
 	is( $zonefile->read->rdstring, 'f.e.d.',	   'generate TXT ${0,6,n}' );
 	is( $zonefile->read->rdstring, 'F.E.D.C.B.A.0.0.', 'generate TXT ${0,16,N}' );
-	eval { $zonefile->read; };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "unknown format:\t$exception" );
+
+	exception( 'unknown generator format', sub { $zonefile->read } );
 }
 
 
-{
-	my $zonefile = source <<'EOF';
+for my $zonefile ( source <<'EOF' ) {	## multi-line parsing
 $TTL 1234
 $ORIGIN example.
 hosta	A	192.0.2.1
@@ -365,7 +281,7 @@
 	is( $zonefile->read->rdstring, 'string',		    'redundant brackets ignored' );
 	is( $zonefile->read->rdstring, '"(string)"',		    'quoted brackets protected' );
 	is( $zonefile->read->rdstring, '"no;comment"',		    'quoted semicolon protected' );
-	is( $zonefile->read->rdstring, 'quoted\"quote',		    'quoted quote protected' );
+	is( $zonefile->read->rdstring, 'quoted\034quote',	    'quoted quote protected' );
 	is( $zonefile->read->rdstring, 'multiline resource record', 'multiline RR parsed correctly' );
 	is( $zonefile->read->rdstring, 'contiguousstring',	    'contiguous string reassembled' );
 	like( $zonefile->read->rdstring, '/quoted.*string$/', 'multiline string reassembled' );
@@ -373,8 +289,7 @@
 }
 
 
-{					## CLASS coersion
-	my $zonefile = source <<'EOF';
+for my $zonefile ( source <<'EOF' ) {	## CLASS coersion
 rr0	CH	NULL
 rr1	CLASS1	NULL
 rr2	CLASS2	NULL
@@ -387,98 +302,44 @@
 }
 
 
-{					## compatibility with defunct Net::DNS::ZoneFile 1.04 distro
-	my $listref = Net::DNS::ZoneFile->read( $zonefile->name );
-	ok( scalar(@$listref), 'read(): entire zone file' );
-}
-
-
-{
-	my $listref = Net::DNS::ZoneFile->read( $zonefile->name, '.' );
-	ok( scalar(@$listref), 'read(): zone file via path' );
-}
-
-
-{
-	eval {
-		local $SIG{__WARN__} = sub { };			# presumed not to exist
-		my $listref = Net::DNS::ZoneFile->read( '/zone0.txt', '.' );
-	};
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "read(): non-existent file\t$exception" );
-}
-
-
-{
-	eval {
-		local $SIG{__WARN__} = sub { };			# presumed not to exist
-		my $listref = Net::DNS::ZoneFile->read( 'zone0.txt', 't' );
-	};
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "read(): non-existent file\t$exception" );
-}
-
-
-{
-	my $listref = Net::DNS::ZoneFile::read( $zonefile->name, '.' );
-	ok( scalar(@$listref), 'read(): direct subroutine call (not object-oriented)' );
-}
-
+for my $zonefile ( source <<'EOF' ) {	## compatibility with defunct Net::DNS::ZoneFile 1.04 distro
+$ORIGIN example.com
+@	SOA	mname rname 99 6h 1h 1w 12345
+	NS	ns
+ns	AAAA	2001:DB8::add
+EOF
+	my $filename = $zonefile->name;
 
-{
-	my $string  = "";
-	my $listref = Net::DNS::ZoneFile::parse( \$string );
-	is( scalar(@$listref), 0, 'parse(): direct subroutine call (not object-oriented)' );
-}
+	my @array = $class->read($filename);
+	ok( scalar(@array), 'class->read( filename )' );
 
+	my $listref = $class->read( $filename, '.' );
+	ok( scalar(@$listref), 'class->read( filename, path )' );
 
-{
-	my $string = <<'EOF';
-a1.example A 192.0.2.1
-a2.example A 192.0.2.2
-EOF
-	my $listref = Net::DNS::ZoneFile->parse( \$string );	# this also tests readfh()
-	is( scalar(@$listref), 2, 'parse(): RR string' );
-}
+	exception( 'class->read( /nxfile, dir )', sub { $class->read( '/zone0.txt', '.' ) } );
 
+	exception( 'class->read( nxfile, dir )', sub { $class->read( 'zone0.txt', 't' ) } );
 
-{
-	my $string = <<'EOF';
-a1.example A 192.0.2.1
-$BOGUS
-a2.example A 192.0.2.2
-EOF
-	local $SIG{__WARN__} = sub { };
-	my $listref = Net::DNS::ZoneFile->parse( \$string );
-	is( $listref, undef, 'parse(): erroneous string' );
+	ok( scalar( Net::DNS::ZoneFile::read($filename) ),
+		'class::read( filename ) subroutine call (not object-oriented)' );
 }
 
 
-{
-	my $string = <<'EOF';
+for my $string ( <<'EOF' ) {
 a1.example A 192.0.2.1
 a2.example A 192.0.2.2
 EOF
-	my @list = Net::DNS::ZoneFile->parse($string);
-	is( scalar(@list), 2, 'parse(): RR string into array' );
-}
+	my @list = $class->parse($string);			# this also tests readfh()
+	is( scalar(@list), 2, 'class->parse( $string )' );
 
+	my $listref = $class->parse( \$string );
+	is( scalar(@$listref), 2, 'class->parse( \$string )' );
 
-{
-	my $string = <<'EOF';
-a1.example A 192.0.2.1
-$BOGUS
-a2.example A 192.0.2.2
-EOF
-	local $SIG{__WARN__} = sub { };
-	my @list = Net::DNS::ZoneFile->parse($string);
-	is( scalar(@list), 1, 'parse(): erroneous string into array' );
-}
-
+	exception( 'class->parse( erroneous )', sub { scalar( $class->parse('$BOGUS') ) } );
+	exception( '@list = class->parse( ) )', sub { my @x = $class->parse('$BOGUS') } );
 
-{
-	my $listref = Net::DNS::ZoneFile::parse('a.example. A 192.0.2.1');
-	ok( scalar(@$listref), 'parse(): called as subroutine (not object-oriented)' );
+	ok( scalar( Net::DNS::ZoneFile::parse($string) ),
+		'class::parse( string ) subroutine call (not object-oriented)' );
 }
 
 
@@ -488,7 +349,7 @@
 	my $greek = pack 'C*', 103, 114, 9, 84, 88, 84, 9, 229, 224, 241, 231, 234, 225, 10;
 	my $file1 = source($greek);
 	my $fh1	  = IO::File->new( $file1->name, '<:encoding(ISO8859-7)' );    # Greek
-	my $zone1 = Net::DNS::ZoneFile->new($fh1);
+	my $zone1 = $class->new($fh1);
 	my $txtgr = $zone1->read;
 	my $text  = pack 'U*', 949, 944, 961, 951, 954, 945;
 	is( $txtgr->txtdata, $text, 'ISO8859-7 TXT rdata' );
@@ -497,7 +358,7 @@
 	my $jptxt = join "\n", <DATA>;
 	my $file2 = source($jptxt);
 	my $fh2	  = IO::File->new( $file2->name, '<:utf8' );	# UTF-8 character encoding
-	my $zone2 = Net::DNS::ZoneFile->new($fh2);
+	my $zone2 = $class->new($fh2);
 	my $txtrr = $zone2->read;				# TXT RR with kanji RDATA
 	my @rdata = $txtrr->txtdata;
 	my $rdata = $txtrr->txtdata;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/08-IPv4.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/08-IPv4.t Changed

@@ -1,15 +1,11 @@
 #!/usr/bin/perl
-# $Id: 08-IPv4.t 1865 2022-05-21 09:57:49Z willem $ -*-perl-*-
+# $Id: 08-IPv4.t 1908 2023-03-15 07:28:50Z willem $ -*-perl-*-
 #
 
 use strict;
 use warnings;
 use Test::More;
-
-BEGIN {
-	local @INC = ( @INC, qw(t) );
-	require NonFatal;
-}
+use TestToolkit;
 
 use Net::DNS;
 use IO::Select;
@@ -73,7 +69,7 @@
 Net::DNS::Resolver->debug($debug);
 
 
-plan tests => 65;
+plan tests => 64;
 
 NonFatalBegin();
 
@@ -325,14 +321,11 @@
 	is( ref($soa), 'Net::DNS::RR::SOA', '$iterator->() returns initial SOA RR' );
 
 	my $iterations;
-	eval {
-		$soa->serial(undef) if $soa;			# force SOA mismatch
-		while ( $iterator->() ) { $iterations++; }
-	};
-	my ($exception) = split /\n/, "$@\n";
+	$soa->serial(undef) if $soa;				# force SOA mismatch
+	exception( 'mismatched SOA serial', sub { $iterations++ while $iterator->() } );
+
 	ok( $iterations, '$iterator->() iterates through remaining RRs' );
 	is( $iterator->(), undef, '$iterator->() returns undef after last RR' );
-	ok( $exception, "iterator exception\t$exception" );
 }
 
 
@@ -355,10 +348,6 @@
 	my @unverifiable = $resolver->axfr();
 	my $errorstring	 = $resolver->errorstring;
 	ok( !scalar(@unverifiable), "mismatched key\t$errorstring" );
-
-	eval { $resolver->tsig(undef) };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "undefined TSIG\t$exception" );
 }
 
 
@@ -380,42 +369,34 @@
 }
 
 
-{					## exercise exceptions in _axfr_next()
+{					## exercise error paths in _axfr_next()
 	my $resolver = Net::DNS::Resolver->new( nameservers => $IP );
-	$resolver->domain('net-dns.org');
-	eval { $resolver->tsig($tsig_key) };
 	$resolver->tcp_timeout(10);
+	exception( 'TCP time out', sub { $resolver->_axfr_next( IO::Select->new ) } );
 
-	{
-		my $select = IO::Select->new();
-		eval { $resolver->_axfr_next($select); };
-		my ($exception) = split /\n/, "$@\n";
-		ok( $exception, "TCP time out\t$exception" );
-	}
+	my $packet = Net::DNS::Packet->new(qw(net-dns.org SOA));
+	my $socket = $resolver->_bgsend_tcp( $packet, $packet->data );
+	my $select = IO::Select->new($socket);
+	while ( $resolver->bgbusy($socket) ) { sleep 1 }
+	my $discarded = '';		## sizeidstatus	qdcount...
+	$socket->recv( $discarded, 6 ) if $socket;
+	exception( 'corrupt data', sub { $resolver->_axfr_next($select) } );
+}
 
-	{
-		my $packet = Net::DNS::Packet->new(qw(net-dns.org SOA));
-		my $socket = $resolver->_bgsend_tcp( $packet, $packet->data );
-		my $select = IO::Select->new($socket);
-		while ( $resolver->bgbusy($socket) ) { sleep 1 }
-		my $discarded = '';	## sizeidstatus	qdcount...
-		$socket->recv( $discarded, 6 ) if $socket;
-		eval { $resolver->_axfr_next($select); };
-		my ($exception) = split /\n/, "$@\n";
-		ok( $exception, "corrupt data\t$exception" );
-	}
 
 SKIP: {
-		my $packet = $resolver->_make_query_packet(qw(net-dns.org SOA));
-		my $socket = $resolver->_bgsend_tcp( $packet, $packet->data );
-		my $tsigrr = $packet->sigrr;
-		skip( 'verify fail', 1 ) unless $tsigrr;
-
-		my $select = IO::Select->new($socket);
-		eval { $resolver->_axfr_next( $select, $tsigrr ); };
-		my ($exception) = split /\n/, "$@\n";
-		ok( $exception, "verify fail\t$exception" );
-	}
+	my $resolver = Net::DNS::Resolver->new( nameservers => $IP );
+	$resolver->domain('net-dns.org');
+	eval { $resolver->tsig($tsig_key) };
+	$resolver->tcp_timeout(10);
+
+	my $packet = $resolver->_make_query_packet(qw(net-dns.org SOA));
+	my $socket = $resolver->_bgsend_tcp( $packet, $packet->data );
+	my $tsigrr = $packet->sigrr;
+	skip( 'verify fail', 1 ) unless $tsigrr;
+
+	my $select = IO::Select->new($socket);
+	exception( 'verify fail', sub { $resolver->_axfr_next( $select, $tsigrr ) } );
 }

_service:tar_scm:Net-DNS-1.34.tar.gz/t/08-IPv6.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/08-IPv6.t Changed

@@ -1,15 +1,11 @@
 #!/usr/bin/perl
-# $Id: 08-IPv6.t 1865 2022-05-21 09:57:49Z willem $ -*-perl-*-
+# $Id: 08-IPv6.t 1908 2023-03-15 07:28:50Z willem $ -*-perl-*-
 #
 
 use strict;
 use warnings;
 use Test::More;
-
-BEGIN {
-	local @INC = ( @INC, qw(t) );
-	require NonFatal;
-}
+use TestToolkit;
 
 use Net::DNS;
 use IO::Select;
@@ -76,7 +72,7 @@
 Net::DNS::Resolver->debug($debug);
 
 
-plan tests => 65;
+plan tests => 64;
 
 NonFatalBegin();
 
@@ -328,14 +324,11 @@
 	is( ref($soa), 'Net::DNS::RR::SOA', '$iterator->() returns initial SOA RR' );
 
 	my $iterations;
-	eval {
-		$soa->serial(undef) if $soa;			# force SOA mismatch
-		while ( $iterator->() ) { $iterations++; }
-	};
-	my ($exception) = split /\n/, "$@\n";
+	$soa->serial(undef) if $soa;				# force SOA mismatch
+	exception( 'mismatched SOA serial', sub { $iterations++ while $iterator->() } );
+
 	ok( $iterations, '$iterator->() iterates through remaining RRs' );
 	is( $iterator->(), undef, '$iterator->() returns undef after last RR' );
-	ok( $exception, "iterator exception\t$exception" );
 }
 
 
@@ -358,10 +351,6 @@
 	my @unverifiable = $resolver->axfr();
 	my $errorstring	 = $resolver->errorstring;
 	ok( !scalar(@unverifiable), "mismatched key\t$errorstring" );
-
-	eval { $resolver->tsig(undef) };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "undefined TSIG\t$exception" );
 }
 
 
@@ -383,42 +372,34 @@
 }
 
 
-{					## exercise exceptions in _axfr_next()
+{					## exercise error paths in _axfr_next()
 	my $resolver = Net::DNS::Resolver->new( nameservers => $IP );
-	$resolver->domain('net-dns.org');
-	eval { $resolver->tsig($tsig_key) };
 	$resolver->tcp_timeout(10);
+	exception( 'TCP time out', sub { $resolver->_axfr_next( IO::Select->new ) } );
 
-	{
-		my $select = IO::Select->new();
-		eval { $resolver->_axfr_next($select); };
-		my ($exception) = split /\n/, "$@\n";
-		ok( $exception, "TCP time out\t$exception" );
-	}
+	my $packet = Net::DNS::Packet->new(qw(net-dns.org SOA));
+	my $socket = $resolver->_bgsend_tcp( $packet, $packet->data );
+	my $select = IO::Select->new($socket);
+	while ( $resolver->bgbusy($socket) ) { sleep 1 }
+	my $discarded = '';		## sizeidstatus	qdcount...
+	$socket->recv( $discarded, 6 ) if $socket;
+	exception( 'corrupt data', sub { $resolver->_axfr_next($select) } );
+}
 
-	{
-		my $packet = Net::DNS::Packet->new(qw(net-dns.org SOA));
-		my $socket = $resolver->_bgsend_tcp( $packet, $packet->data );
-		my $select = IO::Select->new($socket);
-		while ( $resolver->bgbusy($socket) ) { sleep 1 }
-		my $discarded = '';	## sizeidstatus	qdcount...
-		$socket->recv( $discarded, 6 ) if $socket;
-		eval { $resolver->_axfr_next($select); };
-		my ($exception) = split /\n/, "$@\n";
-		ok( $exception, "corrupt data\t$exception" );
-	}
 
 SKIP: {
-		my $packet = $resolver->_make_query_packet(qw(net-dns.org SOA));
-		my $socket = $resolver->_bgsend_tcp( $packet, $packet->data );
-		my $tsigrr = $packet->sigrr;
-		skip( 'verify fail', 1 ) unless $tsigrr;
-
-		my $select = IO::Select->new($socket);
-		eval { $resolver->_axfr_next( $select, $tsigrr ); };
-		my ($exception) = split /\n/, "$@\n";
-		ok( $exception, "verify fail\t$exception" );
-	}
+	my $resolver = Net::DNS::Resolver->new( nameservers => $IP );
+	$resolver->domain('net-dns.org');
+	eval { $resolver->tsig($tsig_key) };
+	$resolver->tcp_timeout(10);
+
+	my $packet = $resolver->_make_query_packet(qw(net-dns.org SOA));
+	my $socket = $resolver->_bgsend_tcp( $packet, $packet->data );
+	my $tsigrr = $packet->sigrr;
+	skip( 'verify fail', 1 ) unless $tsigrr;
+
+	my $select = IO::Select->new($socket);
+	exception( 'verify fail', sub { $resolver->_axfr_next( $select, $tsigrr ) } );
 }

_service:tar_scm:Net-DNS-1.34.tar.gz/t/08-recurse.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/08-recurse.t Changed

_service:tar_scm:Net-DNS-1.34.tar.gz/t/36-NSEC3-covered.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/36-NSEC3-covered.t Changed

@@ -1,5 +1,5 @@
 #!/usr/bin/perl
-# $Id: 36-NSEC3-covered.t 1856 2021-12-02 14:36:25Z willem $	-*-perl-*-
+# $Id: 36-NSEC3-covered.t 1910 2023-03-30 19:16:30Z willem $	-*-perl-*-
 #
 
 use strict;
@@ -47,33 +47,33 @@
 	"0p9mhaveqvm6t7vbl5lop2u3t2rp3tom.example. NSEC3 1 1 12 aabbccdd (
 	2t7b4g4vsa5smi47k61mv5bv1a22bojr MX DNSKEY NS SOA NSEC3PARAM RRSIG )"
 	);
-ok( $rr1->covered('a.c.x.w.example'), 'B.1(1):	NSEC3 covers "next closer" name (c.x.w.example.)' );	# Name Error
+ok( $rr1->covers('a.c.x.w.example'), 'B.1(1):	NSEC3 covers "next closer" name (c.x.w.example.)' );	# Name Error
 
 my $rr2 = Net::DNS::RR->new(
 	"b4um86eghhds6nea196smvmlo4ors995.example. NSEC3 1 1 12 aabbccdd (
 	gjeqe526plbf1g8mklp59enfd789njgi MX RRSIG )"
 	);
-ok( !$rr2->covered('a.c.x.w.example'), 'B.1(2):	NSEC3 matches closest encloser (x.w.example.)' );
+ok( !$rr2->covers('a.c.x.w.example'), 'B.1(2):	NSEC3 matches closest encloser (x.w.example.)' );
 
 my $rr3 = Net::DNS::RR->new(
 	"35mthgpgcu1qg68fab165klnsnk3dpvl.example. NSEC3 1 1 12 aabbccdd (
 	b4um86eghhds6nea196smvmlo4ors995 NS DS RRSIG )"
 	);
-ok( $rr3->covered('*.x.w.example'), 'B.1(3):	NSEC3 covers wildcard at closest encloser (*.x.w.example.)' );
+ok( $rr3->covers('*.x.w.example'), 'B.1(3):	NSEC3 covers wildcard at closest encloser (*.x.w.example.)' );
 
 
 my $rr4 = Net::DNS::RR->new(
 	"2t7b4g4vsa5smi47k61mv5bv1a22bojr.example. NSEC3 1 1 12 aabbccdd (
 	2vptu5timamqttgl4luu9kg21e0aor3s A RRSIG )"
 	);
-ok( !$rr4->covered('ns1.example'), 'B.2:	NSEC3 matches QNAME (ns1.example.) proving MX and CNAME absent' )
+ok( !$rr4->covers('ns1.example'), 'B.2:	NSEC3 matches QNAME (ns1.example.) proving MX and CNAME absent' )
 		;						# No Data Error
 
 my $rr5 = Net::DNS::RR->new(
 	"ji6neoaepv8b5o6k4ev33abha8ht9fgc.example. NSEC3 1 1 12 aabbccdd (
 	k8udemvp1j2f7eg6jebps17vp3n8i58h )"
 	);
-ok( !$rr5->covered('y.w.example'), 'B.2.1:	NSEC3 matches QNAME (y.w.example.) proving A absent' )
+ok( !$rr5->covers('y.w.example'), 'B.2.1:	NSEC3 matches QNAME (y.w.example.) proving A absent' )
 		;						# No Data, Empty Non-Terminal
 
 
@@ -81,75 +81,75 @@
 	"35mthgpgcu1qg68fab165klnsnk3dpvl.example. NSEC3 1 1 12 aabbccdd (
 	b4um86eghhds6nea196smvmlo4ors995 NS DS RRSIG )"
 	);
-ok( $rr6->covered('mc.c.example'), 'B.3(1):	NSEC3 covers "next closer" name (c.example.)' )
+ok( $rr6->covers('mc.c.example'), 'B.3(1):	NSEC3 covers "next closer" name (c.example.)' )
 		;						# Referral to an Opt_Out Unsigned Zone
 
 my $rr7 = Net::DNS::RR->new(
 	"0p9mhaveqvm6t7vbl5lop2u3t2rp3tom.example. NSEC3 1 1 12 aabbccdd (
 	2t7b4g4vsa5smi47k61mv5bv1a22bojr MX DNSKEY NS SOA NSEC3PARAM RRSIG )"
 	);
-ok( !$rr7->covered('mc.c.example'), 'B.3(2):	NSEC3 matches closest provable encloser (example.)' );
+ok( !$rr7->covers('mc.c.example'), 'B.3(2):	NSEC3 matches closest provable encloser (example.)' );
 
 
 my $rr8 = Net::DNS::RR->new(
 	"q04jkcevqvmu85r014c7dkba38o0ji5r.example. NSEC3 1 1 12 aabbccdd (
 	r53bq7cc2uvmubfu5ocmm6pers9tk9en A RRSIG )"
 	);
-ok( $rr8->covered('a.z.w.example'), 'B.4:	NSEC3 covers "next closer" name (z.w.example.)' );    # Wildcard Expansion
+ok( $rr8->covers('a.z.w.example'), 'B.4:	NSEC3 covers "next closer" name (z.w.example.)' );    # Wildcard Expansion
 
 
 my $rr9 = Net::DNS::RR->new(
 	"k8udemvp1j2f7eg6jebps17vp3n8i58h.example. NSEC3 1 1 12 aabbccdd (
 	kohar7mbb8dc2ce8a9qvl8hon4k53uhi )"
 	);
-ok( !$rr9->covered('a.z.w.example'), 'B.5(1):	NSEC3 matches closest encloser (w.example.)' );	  # Wildcard No Data Error
+ok( !$rr9->covers('a.z.w.example'), 'B.5(1):	NSEC3 matches closest encloser (w.example.)' );	  # Wildcard No Data Error
 
 my $rr10 = Net::DNS::RR->new(
 	"q04jkcevqvmu85r014c7dkba38o0ji5r.example. NSEC3 1 1 12 aabbccdd (
 	r53bq7cc2uvmubfu5ocmm6pers9tk9en A RRSIG )"
 	);
-ok( $rr10->covered('a.z.w.example'), 'B.5(2):	NSEC3 covers "next closer" name (z.w.example.)' );
+ok( $rr10->covers('a.z.w.example'), 'B.5(2):	NSEC3 covers "next closer" name (z.w.example.)' );
 
 my $rr11 = Net::DNS::RR->new(
 	"r53bq7cc2uvmubfu5ocmm6pers9tk9en.example. NSEC3 1 1 12 aabbccdd (
 	t644ebqk9bibcna874givr6joj62mlhv MX RRSIG )"
 	);
-ok( !$rr11->covered('*.w.example'), 'B.5(3):	NSEC3 matches wildcard at closest encloser (*.w.example)' );
+ok( !$rr11->covers('*.w.example'), 'B.5(3):	NSEC3 matches wildcard at closest encloser (*.w.example)' );
 
 
 my $rr12 = Net::DNS::RR->new(
 	"0p9mhaveqvm6t7vbl5lop2u3t2rp3tom.example. NSEC3 1 1 12 aabbccdd (
 	2t7b4g4vsa5smi47k61mv5bv1a22bojr MX DNSKEY NS SOA NSEC3PARAM RRSIG )"
 	);
-ok( !$rr12->covered('example'), 'B.6:	NSEC3 matches QNAME (example.) DS type bit not set' )
+ok( !$rr12->covers('example'), 'B.6:	NSEC3 matches QNAME (example.) DS type bit not set' )
 		;						# DS Child Zone No Data Error
 
 
-## covered() returns false for hashed name not strictly between ownerhash and nexthash
+## covers() returns false for hashed name not strictly between ownerhash and nexthash
 
 my $rr13 = Net::DNS::RR->new(
 	"0p9mhaveqvm6t7vbl5lop2u3t2rp3tom.example. NSEC3 1 1 12 aabbccdd (
 	2t7b4g4vsa5smi47k61mv5bv1a22bojr A RRSIG )"
 	);
-ok( !$rr13->covered('.'), 'ancestor name not covered (.)' );	# too few matching labels
+ok( !$rr13->covers('.'), 'ancestor name not covered (.)' );	# too few matching labels
 
 my $rr14 = Net::DNS::RR->new(
 	"q04jkcevqvmu85r014c7dkba38o0ji5r.example. NSEC3 1 1 12 aabbccdd (
 	53bq7cc2uvmubfu5ocmm6pers9tk9en A RRSIG )"
 	);
-ok( !$rr14->covered('unrelated.name'), 'name out of zone not covered (unrelated.name.)' );    # non-matching label
+ok( !$rr14->covers('unrelated.name'), 'name out of zone not covered (unrelated.name.)' );    # non-matching label
 
 my $rr15 = Net::DNS::RR->new(
 	"0p9mhaveqvm6t7vbl5lop2u3t2rp3tom.example. NSEC3 1 1 12 aabbccdd (
 	2t7b4g4vsa5smi47k61mv5bv1a22bojr )"
 	);
-ok( !$rr15->covered('example'), 'owner name not covered (example.)' );
+ok( !$rr15->covers('example'), 'owner name not covered (example.)' );
 
 my $rr16 = Net::DNS::RR->new(
 	"0p9mhaveqvm6t7vbl5lop2u3t2rp3tom.example. NSEC3 1 1 12 aabbccdd (
 	2t7b4g4vsa5smi47k61mv5bv1a22bojr )"
 	);
-ok( !$rr16->covered('ns1.example'), 'next hashed name not covered (ns1.example.)' );
+ok( !$rr16->covers('ns1.example'), 'next hashed name not covered (ns1.example.)' );
 
 exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/37-NSEC3-encloser.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/37-NSEC3-encloser.t Changed

_service:tar_scm:Net-DNS-1.34.tar.gz/t/71-TSIG-create.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/71-TSIG-create.t Changed

@@ -1,16 +1,17 @@
 #!/usr/bin/perl
-# $Id: 71-TSIG-create.t 1856 2021-12-02 14:36:25Z willem $	-*-perl-*-
+# $Id: 71-TSIG-create.t 1909 2023-03-23 11:36:16Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
 use IO::File;
 use Test::More;
+use TestToolkit;
+
 use Net::DNS;
 
 my @prerequisite = qw(
 		Digest::HMAC
-		Digest::MD5
 		Digest::SHA
 		MIME::Base64
 		);
@@ -21,19 +22,23 @@
 	exit;
 }
 
-plan tests => 22;
+plan tests => 18;
 
 
 my $tsig  = Net::DNS::RR->new( type => 'TSIG' );
 my $class = ref($tsig);
 
 
-my $tsigkey = 'HMAC-SHA256.key';
+my $tsigkey = 'tsigkey.txt';
 END { unlink($tsigkey) if defined $tsigkey; }
 
 my $fh_tsigkey = IO::File->new( $tsigkey, '>' ) || die "$tsigkey $!";
 print $fh_tsigkey <<'END';
-key "HMAC-SHA256.example." {
+
+Algorithm: name		; BIND dnssec-keygen private key
+Key:	secret		; syntax check only
+
+key "host1-host2.example." {	; BIND tsig-keygen key
 	algorithm hmac-sha256;
 	secret "f+JImRXRzLpKseG+bP+W9Vwb2QAgtFuIlRU80OA3NU8=";
 };
@@ -41,113 +46,59 @@
 close($fh_tsigkey);
 
 
-my $keyrr = Net::DNS::RR->new( <<'END' );			# dnssec-keygen key pair
-HMAC-SHA256.example. IN KEY 512 3 163 f+JImRXRzLpKseG+bP+W9Vwb2QAgtFuIlRU80OA3NU8='
-END
-
-my $privatekey = $keyrr->privatekeyname;
-END { unlink($privatekey) if defined $privatekey; }
-
-my $publickey;
-( $publickey = $privatekey ) =~ s/\.private$/\.key/;
-END { unlink($publickey) if defined $publickey; }
-
-my $fh_bindpublic = IO::File->new( $publickey, '>' ) || die "$publickey $!";
-print $fh_bindpublic $keyrr->plain;
-close($fh_bindpublic);
-
-
-my $fh_bindprivate = IO::File->new( $privatekey, '>' ) || die "$privatekey $!";
-print $fh_bindprivate <<'END';
-Private-key-format: v1.2
-Algorithm: 163 (HMAC_SHA256)
-Key: f+JImRXRzLpKseG+bP+W9Vwb2QAgtFuIlRU80OA3NU8=
-END
-close($fh_bindprivate);
-
-
-SKIP: {
-	my $tsig = $class->create($tsigkey);
-	skip( 'TSIG attribute test', 2 )
-			unless is( ref($tsig), $class, 'create TSIG from BIND tsig key' );
-	is( $tsig->name, $keyrr->name, 'TSIG key name' );
-	my $algorithm = $tsig->algorithm;
-	is( $algorithm, $tsig->algorithm( $keyrr->algorithm ), 'TSIG algorithm' );
+for my $tsig ( $class->create($tsigkey) ) {
+	is( ref($tsig), $class, 'create TSIG from BIND tsig-keygen key' );
+	ok( $tsig->name,      'TSIG key name' );
+	ok( $tsig->algorithm, 'TSIG algorithm' );
 }
 
 
-SKIP: {
-	my $tsig = $class->create($privatekey);
-	skip( 'TSIG attribute test', 2 )
-			unless is( ref($tsig), $class, 'create TSIG from BIND dnssec private key' );
-	is( $tsig->name, lc( $keyrr->name ), 'TSIG key name' );
-	my $algorithm = $tsig->algorithm;
-	is( $algorithm, $tsig->algorithm( $keyrr->algorithm ), 'TSIG algorithm' );
-}
+for my $packet ( Net::DNS::Packet->new('query.example') ) {
+	$packet->sign_tsig($tsigkey);
+	$packet->data;
 
-
-SKIP: {
-	my $tsig = $class->create($publickey);
-	skip( 'TSIG attribute test', 2 )
-			unless is( ref($tsig), $class, 'create TSIG from BIND dnssec public key' );
-	is( $tsig->name, $keyrr->name, 'TSIG key name' );
-	my $algorithm = $tsig->algorithm;
-	is( $algorithm, $tsig->algorithm( $keyrr->algorithm ), 'TSIG algorithm' );
+	my $tsig = $class->create($packet);
+	is( ref($tsig),	      $class,			 'create TSIG from packet->sigrr' );
+	is( $tsig->name,      $packet->sigrr->name,	 'TSIG key name' );
+	is( $tsig->algorithm, $packet->sigrr->algorithm, 'TSIG algorithm' );
 }
 
 
-SKIP: {
-	my $tsig = $class->create($keyrr);
-	skip( 'TSIG attribute test', 2 )
-			unless is( ref($tsig), $class, 'create TSIG from KEY RR' );
-	is( $tsig->name, $keyrr->name, 'TSIG key name' );
-	my $algorithm = $tsig->algorithm;
-	is( $algorithm, $tsig->algorithm( $keyrr->algorithm ), 'TSIG algorithm' );
+for my $chain ( $class->create($tsig) ) {
+	is( ref($chain), $class, 'create successor to existing TSIG' );
 }
 
 
-{
-	my $packet = Net::DNS::Packet->new('query.example');
-	$packet->sign_tsig($privatekey);
-	my $tsig = $class->create($packet);
-	is( ref($tsig), $class, 'create TSIG from signed packet' );
-}
-
+my $keyrr = Net::DNS::RR->new( <<'END' );			# BIND dnssec-keygen public key
+host1-host2.example.	IN KEY	512 3 163 mvojlAdUskQEtC7J8OTXU5LNvt0=
+END
 
-{
-	my $chain = eval { $class->create($tsig); };
-	is( ref($chain), $class, 'create successor to existing TSIG' );
-}
+my $dnsseckey = 'Khmac-sha256.example.+163+52011.key';
+END { unlink($dnsseckey) if defined $dnsseckey; }
 
+my $fh_dnsseckey = IO::File->new( $dnsseckey, '>' ) || die "$dnsseckey $!";
+print $fh_dnsseckey $keyrr->string, "\n";
+close($fh_dnsseckey);
 
-{
-	eval { $class->create(); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "empty argument list\t$exception" );
+for my $tsig ( $class->create($dnsseckey) ) {
+	is( ref($tsig), $class, 'create TSIG from BIND dnssec public key' );
+	ok( $tsig->name,      'TSIG key name' );
+	ok( $tsig->algorithm, 'TSIG algorithm' );
 }
 
 
-{
-	eval { $class->create(undef); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "argument undefined\t$exception" );
-}
+exception( 'empty argument list', sub { $class->create() } );
+exception( 'argument undefined',  sub { $class->create(undef) } );
 
 
-{
-	my $null = Net::DNS::RR->new( type => 'NULL' );
-	eval { $class->create($null); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "unexpected argument\t$exception" );
-}
+my $null = Net::DNS::RR->new( type => 'NULL' );
+exception( 'unexpected argument', sub { $class->create($null) } );
 
+exception( '2-argument create', sub { $class->create( $keyrr->owner, $keyrr->key ) } );
 
-{
-	my $packet = Net::DNS::Packet->new('query.example');
-	eval { $class->create($packet); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "no TSIG in packet\t$exception" );
-}
+
+my $packet = Net::DNS::Packet->new('query.example');
+exception( 'no TSIG in packet', sub { $class->create($packet) } );
 
 
 my $dnskey = 'Kbad.example.+161+39562.key';
@@ -159,11 +110,7 @@
 END
 close($fh_dnskey);
 
-{
-	eval { $class->create($dnskey); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "unrecognised key format\t$exception" );
-}
+exception( 'unrecognised key format', sub { $class->create($dnskey) } );
 
 
 my $renamedBINDkey = 'arbitrary.key';
@@ -175,6 +122,9 @@
 END
 close($fh_renamed);
 
+exception( 'renamed BIND public key', sub { $class->create($renamedBINDkey) } );
+
+
 my $corruptBINDkey = 'Kcorrupt.example.+161+13198.key';		# unmatched keytag
 END { unlink($corruptBINDkey) if defined $corruptBINDkey; }
 
@@ -185,32 +135,7 @@
 END
 close($fh_corrupt);
 
-{
-	my @warning;
-	local $SIG{__WARN__} = sub { @warning = @_ };
-	$class->create($renamedBINDkey);
-	my ($warning) = split /\n/, "@warning\n";
-	ok( $warning, "renamed BIND public key\t$warning" );
-}
-
-
-{
-	my @warning;
-	local $SIG{__WARN__} = sub { @warning = @_ };
-	$class->create($corruptBINDkey);
-	my ($warning) = split /\n/, "@warning\n";
-	ok( $warning, "corrupt BIND public key\t$warning" );
-}
-
-
-{
-	my @warning;
-	local $SIG{__WARN__} = sub { @warning = @_ };
-	$class->create( $keyrr->owner, $keyrr->key );
-	my ($warning) = split /\n/, "@warning\n";
-	ok( $warning, "2-argument create\t$warning" );
-}
-
+exception( 'corrupt BIND public key', sub { $class->create($corruptBINDkey) } );
 
-__END__
+exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/72-TSIG-verify.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/72-TSIG-verify.t Changed

@@ -1,11 +1,13 @@
 #!/usr/bin/perl
-# $Id: 72-TSIG-verify.t 1856 2021-12-02 14:36:25Z willem $	-*-perl-*-
+# $Id: 72-TSIG-verify.t 1909 2023-03-23 11:36:16Z willem $	-*-perl-*-
 #
 
 use strict;
 use warnings;
 use IO::File;
 use Test::More;
+use TestToolkit;
+
 use Net::DNS;
 
 my @prerequisite = qw(
@@ -21,78 +23,66 @@
 	exit;
 }
 
-plan tests => 28;
+plan tests => 26;
 
 
 my $tsig  = Net::DNS::RR->new( type => 'TSIG' );
 my $class = ref($tsig);
 
 
-my $privatekey = 'Khmac-sha1.example.+161+39562.private';
-END { unlink($privatekey) if defined $privatekey; }
+my $tsigkey = 'tsigkey.txt';
+END { unlink($tsigkey) if defined $tsigkey; }
 
-my $fh_private = IO::File->new( $privatekey, '>' ) || die "$privatekey $!";
-print $fh_private <<'END';
-Private-key-format: v1.2
-Algorithm: 161 (HMAC_SHA1)
-Key: xdX9m8UtQNbJUzUgQ4xDtUNZAmU=
+my $fh_tsigkey = IO::File->new( $tsigkey, '>' ) || die "$tsigkey $!";
+print $fh_tsigkey <<'END';
+key "host1-host2.example." {
+	algorithm hmac-sha256;
+	secret "f+JImRXRzLpKseG+bP+W9Vwb2QAgtFuIlRU80OA3NU8=";
+};
 END
-close($fh_private);
-
+close($fh_tsigkey);
 
-my $publickey = 'Khmac-md5.example.+157+53335.key';
-END { unlink($publickey) if defined $publickey; }
-
-my $fh_public = IO::File->new( $publickey, '>' ) || die "$publickey $!";
-print $fh_public <<'END';
-HMAC-MD5.example. IN KEY 512 3 157 ARDJZgtuTDzAWeSGYPAu9uJUkX0=
-END
-close($fh_public);
 
-
-{
-	my $packet = Net::DNS::Packet->new('query.example');
-	$packet->sign_tsig($privatekey);
+for my $packet ( Net::DNS::Packet->new('query.example') ) {
+	$packet->sign_tsig($tsigkey);
 	$packet->data;
 
-	my $verified = $packet->verify();
-	ok( $verified, 'verify signed packet' );
-	is( ref($verified),	$class,	   'packet->verify returns TSIG' );
-	is( $packet->verifyerr, 'NOERROR', 'observe packet->verifyerr' );
+	my $verified  = $packet->verify();
+	my $verifyerr = $packet->verifyerr();
+	ok( $verified, "verify signed packet	$verifyerr" );
+	is( ref($verified), $class, 'packet->verify returns TSIG' );
 }
 
 
-{
-	my $packet = Net::DNS::Packet->new('query.example');
-	$packet->sign_tsig($privatekey);
+for my $packet ( Net::DNS::Packet->new('query.example') ) {
+	$packet->sign_tsig($tsigkey);
 	$packet->data;
 	$packet->push( update => rr_add( type => 'NULL' ) );
 
-	my $verified = $packet->verify();
-	ok( !$verified, 'unverifiable signed packet' );
-	is( $verified,		undef,	  'failed packet->verify returns undef' );
-	is( $packet->verifyerr, 'BADSIG', 'observe packet->verifyerr' );
+	my $verified  = $packet->verify();
+	my $verifyerr = $packet->verifyerr();
+	ok( !$verified, "verify corrupt packet	$verifyerr" );
+	is( $verified, undef, 'packet->verify returns undef' );
 }
 
 
-{
-	my $query = Net::DNS::Packet->new('query.example');
-	$query->sign_tsig($privatekey);
+for my $query ( Net::DNS::Packet->new('query.example') ) {
+	$query->sign_tsig($tsigkey);
 	$query->data;
 
 	my $reply = $query->reply;
 	$reply->sign_tsig($query);
 	$reply->data;
 
-	my $verified = $reply->verify($query);
-	ok( $verified, 'verify reply packet' );
-	is( $reply->verifyerr, 'NOERROR', 'observe packet->verifyerr' );
+	my $verified  = $reply->verify($query);
+	my $verifyerr = $reply->verifyerr();
+	ok( $verified, "verify reply packet	$verifyerr" );
 }
 
 
 {
-	my @packet = map { Net::DNS::Packet->new($_) } 0 .. 3;
-	my $signed = $privatekey;
+	my @packet = map { Net::DNS::Packet->new($_) } ( 0 .. 3 );
+	my $signed = $tsigkey;
 	foreach my $packet (@packet) {
 		$signed = $packet->sign_tsig($signed);
 		$packet->data;
@@ -101,25 +91,26 @@
 
 	my @verified;
 	foreach my $packet (@packet) {
-		my ($verified) = $packet->verify(@verified);
-		@verified = ($verified);
-		ok( $verified, 'verify multi-packet' );
+		@verified = $packet->verify(@verified);
+		my ($verified) = @verified;
+		my $verifyerr = $packet->verifyerr();
+		ok( $verified, "verify multi-packet	$verifyerr" );
 	}
 
-	my @state;
+	my @unverifiable;
 	$packet2->sigrr->fudge(0);
 	foreach my $packet (@packet) {
-		my $tsig = $packet->verify(@state);
-		@state = ($tsig);
-		my $result = $packet->verifyerr;
-		ok( $result, "unverifiable multi-packet: $result" );
+		@unverifiable = $packet->verify(@unverifiable);
+		my $verifyerr = $packet->verifyerr();
+		ok( 1, "verify corrupt multi-packet	$verifyerr" );
 	}
+	my ($verified) = @unverifiable;
+	is( $verified, undef, 'final packet->verify returns undef' );
 }
 
 
-{
-	my $packet = Net::DNS::Packet->new('query.example');
-	$packet->sign_tsig( $privatekey, fudge => 0 );
+for my $packet ( Net::DNS::Packet->new('query.example') ) {
+	$packet->sign_tsig( $tsigkey, fudge => 0 );
 	my $encoded = $packet->data;
 	sleep 2;						# guarantee one complete second delay
 
@@ -129,9 +120,8 @@
 }
 
 
-{
-	my $packet = Net::DNS::Packet->new();
-	$packet->sign_tsig($privatekey);
+for my $packet ( Net::DNS::Packet->new() ) {
+	$packet->sign_tsig($tsigkey);
 	$packet->sigrr->error('BADTIME');
 	my $encoded = $packet->data;
 	my $decoded = Net::DNS::Packet->new( \$encoded );
@@ -139,40 +129,36 @@
 }
 
 
-{
-	my $query = Net::DNS::Packet->new('query.example');
-	$query->sign_tsig($privatekey);
+for my $query ( Net::DNS::Packet->new('query.example') ) {
+	$query->sign_tsig($tsigkey);
 	$query->data;
 
 	my $reply = $query->reply;
-	$reply->sign_tsig($publickey);
+	$reply->sign_tsig($query);
 	$reply->data;
+	$reply->sigrr->algorithm('hmac-sha1');
 
-	my $verified = $reply->verify($query);
-	is( $reply->verifyerr, 'BADKEY', 'unverifiable reply packet: BADKEY' );
+	my $verified  = $reply->verify($query);
+	my $verifyerr = $reply->verifyerr();
+	ok( !$verified, "mismatched verify keys	$verifyerr" );
 }
 
 
-{
-	my $packet0 = Net::DNS::Packet->new();
-	my $chain   = $packet0->sign_tsig($privatekey);
-	$packet0->data;
-	my $packet1 = Net::DNS::Packet->new();
-	$packet1->sign_tsig($chain);
-	$packet1->data;
-
-	my $packetx = Net::DNS::Packet->new();
-	$packetx->sign_tsig($publickey);
-	$packetx->data;
-	my $tsig     = $packetx->verify();
-	my $verified = $packet1->verify($tsig);
-	is( $packet1->verifyerr, 'BADKEY', 'unverifiable multi-packet: BADKEY' );
+for my $packet ( Net::DNS::Packet->new('query.example') ) {
+	$packet->sign_tsig($tsigkey);
+	$packet->data;
+
+	my $tsig = $packet->reply->sign_tsig($tsigkey);
+	$tsig->algorithm('hmac-sha1');
+
+	my $verified  = $packet->verify($tsig);
+	my $verifyerr = $packet->verifyerr();
+	ok( !$verified, "mismatched verify keys	$verifyerr" );
 }
 
 
-{
-	my $packet = Net::DNS::Packet->new();
-	$packet->sign_tsig($publickey);
+for my $packet ( Net::DNS::Packet->new() ) {
+	$packet->sign_tsig($tsigkey);
 	$packet->data;
 	$packet->sigrr->macbin( substr $packet->sigrr->macbin, 0, 9 );
 
@@ -181,9 +167,8 @@
 }
 
 
-{
-	my $packet = Net::DNS::Packet->new();
-	$packet->sign_tsig($publickey);
+for my $packet ( Net::DNS::Packet->new() ) {
+	$packet->sign_tsig($tsigkey);
 	$packet->data;
 	my $macbin = $packet->sigrr->macbin;
 	$packet->sigrr->macbin( join '', $packet->sigrr->macbin, 'x' );
@@ -193,27 +178,13 @@
 }
 
 
-{
-	my $packet = Net::DNS::Packet->new();
-	$packet->sign_tsig($privatekey);
-
+for my $packet ( Net::DNS::Packet->new() ) {
+	$packet->sign_tsig($tsigkey);
 	my $null = Net::DNS::RR->new( type => 'NULL' );
-	eval { $packet->sigrr->verify($null); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "unexpected argument\t$exception" );
-}
-
-
-{
-	my $packet = Net::DNS::Packet->new();
-	$packet->sign_tsig($privatekey);
 
-	my $null = Net::DNS::RR->new( type => 'NULL' );
-	eval { $packet->sigrr->verify( $packet, $null ); };
-	my ($exception) = split /\n/, "$@\n";
-	ok( $exception, "unexpected argument\t$exception" );
+	exception( 'unexpected argument', sub { $packet->sigrr->verify($null) } );
+	exception( 'unexpected argument', sub { $packet->sigrr->verify( $packet, $null ) } );
 }
 
-
-__END__
+exit;

_service:tar_scm:Net-DNS-1.34.tar.gz/t/99-cleanup.t -> _service:tar_scm:Net-DNS-1.38.tar.gz/t/99-cleanup.t Changed

_service:tar_scm:Net-DNS-1.38.tar.gz/t/TestToolkit.pm Added

@@ -0,0 +1,116 @@
+# $Id: TestToolkit.pm 1908 2023-03-15 07:28:50Z willem $	-*-perl-*-
+
+package TestToolkit;
+
+=head1 NAME
+
+TestToolkit - Convenient tools to simplify test script construction.
+
+=cut
+
+use strict;
+use warnings;
+use Carp;
+use Test::Builder;
+use Test::More;
+
+use base qw(Exporter);
+our @EXPORT = qw(exception noexception NonFatalBegin NonFatalEnd);
+
+
+=head1 exception noexception
+
+	noexception( 'test description', sub { code fragment } );
+
+Executes the supplied code fragment and reports a raised exception or
+warning using the Test::More ok() mechanism.
+
+=cut
+
+sub exception {
+	my ( $name, $code ) = @_;
+
+	my $exception = _execute($code);
+	my $boolean   = $exception ? 1 : 0;
+
+	my $tb = Test::Builder->new;
+	return $tb->ok( $boolean, "$name\t$exception" );
+}
+
+sub noexception {
+	my ( $name, $code ) = @_;
+
+	my $exception = _execute($code);
+	my $boolean   = $exception ? 0 : 1;
+
+	my $tb = Test::Builder->new;
+	return $tb->ok( $boolean, $exception ? "$name\t$exception" : $name );
+}
+
+sub _execute {
+	my $code = shift;
+	my @warning;
+	local $SIG{__WARN__} = sub { push @warning, "@_" };
+	local ( $@, $!, $SIG{__DIE__} );	## isolate eval
+	eval {
+		&$code;
+		croak shift(@warning) if @warning;
+	};
+	my ($exception) = split /\r\n+/, "$@\n";
+	return $exception;
+}
+
+
+########################################
+#
+# Test::More test functions all eventually call Test::Builder::ok
+# (on the (singular) builder instance) to report the status.
+# The NonFatal package defines a subclass derived from Test::Builder,
+# with a redefined ok method that overrides the completion status
+# seen by the test harness.
+#
+# Note: Modified behaviour is enabled by the 't/online.nonfatal' file.
+#
+
+=head1 NonFatalBegin NonFatalEnd
+
+Tests that are between these functions will always appear to succeed.
+The failure report itself is not suppressed.
+
+=cut
+
+sub NonFatalBegin { return bless Test::Builder->new, qw(NonFatal) }
+
+sub NonFatalEnd { return bless Test::Builder->new, qw(Test::Builder) }
+
+
+package NonFatal;
+use base qw(Test::Builder);
+
+my $enabled = eval { -e 't/online.nonfatal' };
+my @failed;
+
+sub ok {
+	my ( $self, $test, @name ) = @_;
+	return $self->SUPER::ok( $test, @name ) if $test;
+
+	if ($enabled) {
+		my $number = $self->current_test + 1;
+		push @failed, join( "\t", $number, @name );
+		@name = "NOT OK (tolerating failure)	@name";
+	}
+
+	return $self->SUPER::ok( $enabled, @name );
+}
+
+END {
+	my $n  = scalar(@failed) || return;
+	my $s  = ( $n == 1 ) ? '' : 's';
+	my $tb = __PACKAGE__->SUPER::new();
+	$tb->diag( join "\n", "\nDisregarding $n failed sub-test$s", @failed );
+}
+
+1;
+
+__END__
+