Hello community,
here is the log from the commit of package perl-Net-DNS for openSUSE:Factory
checked in at 2018-01-09 14:34:33
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-Net-DNS (Old)
and /work/SRC/openSUSE:Factory/.perl-Net-DNS.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Net-DNS"
Tue Jan 9 14:34:33 2018 rev:50 rq:561819 version:1.14
Changes:
--------
--- /work/SRC/openSUSE:Factory/perl-Net-DNS/perl-Net-DNS.changes
2017-10-28 14:17:23.160981864 +0200
+++ /work/SRC/openSUSE:Factory/.perl-Net-DNS.new/perl-Net-DNS.changes
2018-01-09 14:34:34.196202367 +0100
@@ -1,0 +2,6 @@
+Sat Dec 16 06:37:48 UTC 2017 - co...@suse.com
+
+- updated to 1.14
+ see /usr/share/doc/packages/perl-Net-DNS/Changes
+
+-------------------------------------------------------------------
Old:
----
Net-DNS-1.13.tar.gz
New:
----
Net-DNS-1.14.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-Net-DNS.spec ++++++
--- /var/tmp/diff_new_pack.wm2aoA/_old 2018-01-09 14:34:34.940167468 +0100
+++ /var/tmp/diff_new_pack.wm2aoA/_new 2018-01-09 14:34:34.944167280 +0100
@@ -17,7 +17,7 @@
Name: perl-Net-DNS
-Version: 1.13
+Version: 1.14
Release: 0
%define cpan_name Net-DNS
Summary: Perl Interface to the Domain Name System
++++++ Net-DNS-1.13.tar.gz -> Net-DNS-1.14.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Net-DNS-1.13/Changes new/Net-DNS-1.14/Changes
--- old/Net-DNS-1.13/Changes 2017-10-18 11:00:36.000000000 +0200
+++ new/Net-DNS-1.14/Changes 2017-12-15 13:25:42.000000000 +0100
@@ -1,4 +1,16 @@
-$Id: Changes 1604 2017-10-18 09:00:29Z willem $
-*-text-*-
+$Id: Changes 1610 2017-12-15 12:25:33Z willem $
-*-text-*-
+
+
+**** 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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Net-DNS-1.13/MANIFEST new/Net-DNS-1.14/MANIFEST
--- old/Net-DNS-1.13/MANIFEST 2017-10-18 11:00:55.000000000 +0200
+++ new/Net-DNS-1.14/MANIFEST 2017-12-15 13:25:53.000000000 +0100
@@ -100,9 +100,9 @@
Makefile.PL
MANIFEST This list of files
README
+t/00-install.t
t/00-load.t
t/00-pod.t
-t/00-version.t
t/01-resolver-env.t
t/01-resolver-file.t
t/01-resolver-flags.t
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Net-DNS-1.13/META.json new/Net-DNS-1.14/META.json
--- old/Net-DNS-1.13/META.json 2017-10-18 11:00:55.000000000 +0200
+++ new/Net-DNS-1.14/META.json 2017-12-15 13:25:53.000000000 +0100
@@ -52,6 +52,6 @@
}
},
"release_status" : "stable",
- "version" : "1.13",
- "x_serialization_backend" : "JSON::PP version 2.27400"
+ "version" : "1.14",
+ "x_serialization_backend" : "JSON::PP version 2.27400_02"
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Net-DNS-1.13/META.yml new/Net-DNS-1.14/META.yml
--- old/Net-DNS-1.13/META.yml 2017-10-18 11:00:55.000000000 +0200
+++ new/Net-DNS-1.14/META.yml 2017-12-15 13:25:53.000000000 +0100
@@ -33,5 +33,5 @@
Test::More: '0.52'
Time::Local: '1.19'
perl: '5.006'
-version: '1.13'
-x_serialization_backend: 'CPAN::Meta::YAML version 0.011'
+version: '1.14'
+x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Net-DNS-1.13/Makefile.PL new/Net-DNS-1.14/Makefile.PL
--- old/Net-DNS-1.13/Makefile.PL 2017-10-18 11:00:36.000000000 +0200
+++ new/Net-DNS-1.14/Makefile.PL 2017-12-15 13:25:42.000000000 +0100
@@ -1,5 +1,5 @@
#
-# $Id: Makefile.PL 1599 2017-10-06 09:02:23Z willem $ -*-perl-*-
+# $Id: Makefile.PL 1608 2017-12-07 10:10:38Z willem $ -*-perl-*-
#
@@ -78,7 +78,7 @@
delete $optional{'Net::DNS::SEC'}; ## Note: MUST NOT be installed
automatically
-use constant USE_SOCKET_IP => defined eval 'use Socket 1.97; use
IO::Socket::IP 0.32; 1;';
+use constant USE_SOCKET_IP => defined eval 'use IO::Socket::IP 0.32; 1;';
use constant USE_SOCKET_INET6 => defined eval 'require IO::Socket::INET6';
@@ -240,9 +240,10 @@
}
eval 'require Net::DNS';
+ my @version = grep $_, ( 'version', $Net::DNS::VERSION );
my $nameregex = '\W+Net\WDNS.pm$';
- my @installed = grep m/$nameregex/io, values %INC;
+ my @installed = grep $_ && m/$nameregex/io, values %INC;
my %noinstall;
foreach (@installed) {
@@ -262,7 +263,7 @@
warn <<"AMEN";
##
## The install location for this version of Net::DNS differs
-## from the existing version $Net::DNS::VERSION in your perl library.
+## from the existing @version in your perl library.
## @installed
##
## The installation will be rendered ineffective because the
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Net-DNS-1.13/lib/Net/DNS/Domain.pm
new/Net-DNS-1.14/lib/Net/DNS/Domain.pm
--- old/Net-DNS-1.13/lib/Net/DNS/Domain.pm 2017-10-18 11:00:36.000000000
+0200
+++ new/Net-DNS-1.14/lib/Net/DNS/Domain.pm 2017-12-15 13:25:42.000000000
+0100
@@ -1,9 +1,9 @@
package Net::DNS::Domain;
#
-# $Id: Domain.pm 1603 2017-10-17 14:45:45Z willem $
+# $Id: Domain.pm 1605 2017-11-27 11:37:40Z willem $
#
-our $VERSION = (qw$LastChangedRevision: 1603 $)[1];
+our $VERSION = (qw$LastChangedRevision: 1605 $)[1];
=head1 NAME
@@ -399,7 +399,7 @@
=head1 SEE ALSO
-L<perl>, L<Net::LibIDN>, L<Net::DNS>, RFC1034, RFC1035, RFC5891,
+L<perl>, L<Net::LibIDN2>, L<Net::DNS>, RFC1034, RFC1035, RFC5891,
Unicode Technical Report #16
=cut
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Net-DNS-1.13/lib/Net/DNS/DomainName.pm
new/Net-DNS-1.14/lib/Net/DNS/DomainName.pm
--- old/Net-DNS-1.13/lib/Net/DNS/DomainName.pm 2017-10-18 11:00:36.000000000
+0200
+++ new/Net-DNS-1.14/lib/Net/DNS/DomainName.pm 2017-12-15 13:25:42.000000000
+0100
@@ -1,9 +1,9 @@
package Net::DNS::DomainName;
#
-# $Id: DomainName.pm 1558 2017-04-03 11:38:22Z willem $
+# $Id: DomainName.pm 1605 2017-11-27 11:37:40Z willem $
#
-our $VERSION = (qw$LastChangedRevision: 1558 $)[1];
+our $VERSION = (qw$LastChangedRevision: 1605 $)[1];
=head1 NAME
@@ -155,7 +155,7 @@
########################################
package Net::DNS::DomainName1035;
-use base qw(Net::DNS::DomainName);
+our @ISA = qw(Net::DNS::DomainName);
=head1 Net::DNS::DomainName1035
@@ -217,7 +217,7 @@
########################################
package Net::DNS::DomainName2535;
-use base qw(Net::DNS::DomainName);
+our @ISA = qw(Net::DNS::DomainName);
=head1 Net::DNS::DomainName2535
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Net-DNS-1.13/lib/Net/DNS/Mailbox.pm
new/Net-DNS-1.14/lib/Net/DNS/Mailbox.pm
--- old/Net-DNS-1.13/lib/Net/DNS/Mailbox.pm 2017-10-18 11:00:36.000000000
+0200
+++ new/Net-DNS-1.14/lib/Net/DNS/Mailbox.pm 2017-12-15 13:25:42.000000000
+0100
@@ -1,9 +1,9 @@
package Net::DNS::Mailbox;
#
-# $Id: Mailbox.pm 1527 2017-01-18 21:42:48Z willem $
+# $Id: Mailbox.pm 1605 2017-11-27 11:37:40Z willem $
#
-our $VERSION = (qw$LastChangedRevision: 1527 $)[1];
+our $VERSION = (qw$LastChangedRevision: 1605 $)[1];
=head1 NAME
@@ -107,15 +107,13 @@
=cut
package Net::DNS::Mailbox1035;
-
-use base qw(Net::DNS::Mailbox);
+our @ISA = qw(Net::DNS::Mailbox);
sub encode { &Net::DNS::DomainName1035::encode; }
package Net::DNS::Mailbox2535;
-
-use base qw(Net::DNS::Mailbox);
+our @ISA = qw(Net::DNS::Mailbox);
sub encode { &Net::DNS::DomainName2535::encode; }
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Net-DNS-1.13/lib/Net/DNS/Nameserver.pm
new/Net-DNS-1.14/lib/Net/DNS/Nameserver.pm
--- old/Net-DNS-1.13/lib/Net/DNS/Nameserver.pm 2017-10-18 11:00:36.000000000
+0200
+++ new/Net-DNS-1.14/lib/Net/DNS/Nameserver.pm 2017-12-15 13:25:42.000000000
+0100
@@ -1,9 +1,9 @@
package Net::DNS::Nameserver;
#
-# $Id: Nameserver.pm 1593 2017-09-04 14:23:26Z willem $
+# $Id: Nameserver.pm 1608 2017-12-07 10:10:38Z willem $
#
-our $VERSION = (qw$LastChangedRevision: 1593 $)[1];
+our $VERSION = (qw$LastChangedRevision: 1608 $)[1];
=head1 NAME
@@ -14,23 +14,32 @@
use Net::DNS::Nameserver;
- $nameserver = new Net::DNS::Nameserver(
- LocalAddr => ['::1' , '127.0.0.1' ],
- LocalPort => "5353",
- ReplyHandler => \&reply_handler,
- Verbose => 1,
- Truncate => 0
+ my $nameserver = new Net::DNS::Nameserver(
+ LocalAddr => ['::1' , '127.0.0.1'],
+ ZoneFile => "filename"
+ );
+
+ my $nameserver = new Net::DNS::Nameserver(
+ LocalAddr => '10.1.2.3',
+ LocalPort => 5353,
+ ReplyHandler => \&reply_handler
);
=head1 DESCRIPTION
-Instances of the C<Net::DNS::Nameserver> class represent DNS server
-objects. See L</EXAMPLE> for an example.
+Net::DNS::Nameserver offers a simple mechanism for instantiation of
+customised DNS server objects intended to provide test responses to
+queries emanating from a client resolver.
+
+It is not, nor will it ever be, a general-purpose DNS nameserver
+implementation.
+
+See L</EXAMPLE> for an example.
=cut
-use constant USE_SOCKET_IP => defined eval 'use Socket 1.97; use
IO::Socket::IP 0.32; 1;';
+use constant USE_SOCKET_IP => defined eval 'use IO::Socket::IP 0.32; 1;';
use constant USE_SOCKET_INET => defined eval 'require IO::Socket::INET';
@@ -42,8 +51,9 @@
use strict;
use warnings;
use integer;
-use Carp qw(cluck);
+use Carp;
use Net::DNS;
+use Net::DNS::ZoneFile;
use IO::Socket;
use IO::Select;
@@ -72,10 +82,9 @@
$self{ReplyHandler} = sub { $handler->( $self, @_ ); };
}
}
- unless ( ref $self{ReplyHandler} eq "CODE" ) {
- cluck "No reply handler!";
- return undef;
- }
+ 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
my $LocalAddr = $self{LocalAddr} || [DEFAULT_ADDR];
@@ -113,7 +122,7 @@
push @sock_tcp, $sock_tcp;
print "done.\n" if $self{Verbose};
} else {
- cluck "Couldn't create TCP socket: $!";
+ carp "Couldn't create TCP socket: $!";
}
#--------------------------------------------------------------------------
@@ -132,7 +141,7 @@
push @sock_udp, $sock_udp;
print "done.\n" if $self{Verbose};
} else {
- cluck "Couldn't create UDP socket: $!";
+ carp "Couldn't create UDP socket: $!";
}
}
@@ -155,6 +164,67 @@
return $self;
}
+
+#------------------------------------------------------------------------------
+# ReadZoneFile - Read zone file used by default reply handler
+#------------------------------------------------------------------------------
+
+sub ReadZoneFile {
+ my ( $self, $file ) = @_;
+ my $zonefile = new Net::DNS::ZoneFile($file);
+
+ my $RRhash = $self->{RRhash} = {};
+ my $RRlist = [];
+ while ( my $rr = $zonefile->read ) {
+ my ($leaf) = $rr->{owner}->label;
+ push @{$RRhash->{lc $leaf}}, $rr;
+
+ # Warning: Nasty trick abusing SOA to reference zone RR list
+ if ( $rr->type eq 'SOA' ) { $RRlist = $rr->{RRlist} = [] }
+ else { push @$RRlist, $rr }
+ }
+}
+
+
+#------------------------------------------------------------------------------
+# ReplyHandler - Default reply handler serving RRs from zone file
+#------------------------------------------------------------------------------
+
+sub ReplyHandler {
+ my ( $self, $qname, $qclass, $qtype, $peerhost, $query, $conn ) = @_;
+ my $opcode = $query->header->opcode;
+ my $rcode = 'NOERROR';
+ 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;
+
+ if ( $qtype eq 'AXFR' ) {
+ my ($soa) = grep $_->type eq 'SOA', @match;
+ if ($soa) { 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;
+ }
+ $rcode = 'NXDOMAIN' unless @match;
+ }
+ @ans = grep $_->type eq $qtype, @match;
+ }
+
+ return ( $rcode, \@ans, [], [], {aa => 1}, {} );
+}
+
+
#------------------------------------------------------------------------------
# inet_new - Calls the constructor in the correct module for making sockets.
#------------------------------------------------------------------------------
@@ -212,7 +282,7 @@
my $qclass = $qr->qclass;
my $id = $query->header->id;
- print "query $id : $qname $qclass $qtype - " if
$self->{Verbose};
+ print "query $id : $qname $qclass $qtype\n" if $self->{Verbose};
my ( $rcode, $ans, $auth, $add );
my @arglist = ( $qname, $qclass, $qtype, $peerhost, $query,
$conn );
@@ -364,10 +434,11 @@
delete $self->{_tcp}{$sock};
return;
}
- my $reply_data = $reply->data;
- my $len = length $reply_data;
- $self->{_tcp}{$sock}{outbuffer} = pack( "n", $len ) .
$reply_data;
- print "Queued ", length
$self->{_tcp}{$sock}{outbuffer}, " octets to $peer\n"
+ 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.
@@ -396,7 +467,7 @@
print "UDP connection from $peerhost:$peerport to $sockhost\n" if
$self->{Verbose};
- my $query = new Net::DNS::Packet(\$buf);
+ my $query = new Net::DNS::Packet( \$buf );
if ( my $err = $@ ) {
print "Error decoding query packet: $err\n" if $self->{Verbose};
undef $query; # force FORMERR
reply
@@ -551,46 +622,43 @@
=head2 new
- my $ns = new Net::DNS::Nameserver(
- LocalAddr => "10.1.2.3",
- LocalPort => "5353",
- ReplyHandler => \&reply_handler,
- Verbose => 1
+ $nameserver = new Net::DNS::Nameserver(
+ LocalAddr => ['::1' , '127.0.0.1'],
+ ZoneFile => "filename"
);
-
-
- my $ns = new Net::DNS::Nameserver(
- LocalAddr => ['::1' , '127.0.0.1' ],
- LocalPort => "5353",
+ $nameserver = new Net::DNS::Nameserver(
+ LocalAddr => '10.1.2.3',
+ LocalPort => 5353,
ReplyHandler => \&reply_handler,
Verbose => 1,
Truncate => 0
- );
-
+ );
Returns a Net::DNS::Nameserver object, or undef if the object
could not be created.
-Attributes are:
+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 53.
- ReplyHandler Reference to reply-handling
- subroutine Required.
+ LocalAddr IP address on which to listen Defaults to loopback
address
+ LocalPort Port on which to listen Defaults to 53
+ ZoneFile Name of file containing RRs
+ accessed using the default
+ reply-handling subroutine
+ ReplyHandler Reference to customised
+ reply-handling subroutine
NotifyHandler Reference to reply-handling
subroutine for queries with
opcode NOTIFY (RFC1996)
UpdateHandler Reference to reply-handling
subroutine for queries with
opcode UPDATE (RFC2136)
- Verbose Print info about received
- queries. Defaults to 0 (off).
+ Verbose Report internal activity Defaults to 0 (off)
Truncate Truncates UDP packets that
are too big for the reply Defaults to 1 (on)
IdleTimeout TCP clients are disconnected
if they are idle longer than
- this duration. Defaults to 120 (secs)
+ this duration Defaults to 120 (secs)
The LocalAddr attribute may alternatively be specified as a list of IP
addresses to listen to.
@@ -767,6 +835,8 @@
Portions Copyright (c)2005-2009 O.M, Kolkman, RIPE NCC.
+Portions Copyright (c)2017 Dick Franks.
+
All rights reserved.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Net-DNS-1.13/lib/Net/DNS/RR/OPT.pm
new/Net-DNS-1.14/lib/Net/DNS/RR/OPT.pm
--- old/Net-DNS-1.13/lib/Net/DNS/RR/OPT.pm 2017-10-18 11:00:36.000000000
+0200
+++ new/Net-DNS-1.14/lib/Net/DNS/RR/OPT.pm 2017-12-15 13:25:42.000000000
+0100
@@ -1,9 +1,9 @@
package Net::DNS::RR::OPT;
#
-# $Id: OPT.pm 1578 2017-06-20 12:49:23Z willem $
+# $Id: OPT.pm 1605 2017-11-27 11:37:40Z willem $
#
-our $VERSION = (qw$LastChangedRevision: 1578 $)[1];
+our $VERSION = (qw$LastChangedRevision: 1605 $)[1];
use strict;
@@ -230,10 +230,10 @@
package Net::DNS::RR::OPT::DHU; #
RFC6975
-use base qw(Net::DNS::RR::OPT::DAU);
+our @ISA = qw(Net::DNS::RR::OPT::DAU);
package Net::DNS::RR::OPT::N3U; #
RFC6975
-use base qw(Net::DNS::RR::OPT::DAU);
+our @ISA = qw(Net::DNS::RR::OPT::DAU);
package Net::DNS::RR::OPT::CLIENT_SUBNET; # RFC7871
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Net-DNS-1.13/lib/Net/DNS/RR.pm
new/Net-DNS-1.14/lib/Net/DNS/RR.pm
--- old/Net-DNS-1.13/lib/Net/DNS/RR.pm 2017-10-18 11:00:36.000000000 +0200
+++ new/Net-DNS-1.14/lib/Net/DNS/RR.pm 2017-12-15 13:25:42.000000000 +0100
@@ -1,9 +1,9 @@
package Net::DNS::RR;
#
-# $Id: RR.pm 1597 2017-09-22 08:04:02Z willem $
+# $Id: RR.pm 1606 2017-11-30 10:13:43Z willem $
#
-our $VERSION = (qw$LastChangedRevision: 1597 $)[1];
+our $VERSION = (qw$LastChangedRevision: 1606 $)[1];
=head1 NAME
@@ -36,7 +36,7 @@
use integer;
use Carp;
-use constant LIB => grep !ref($_), @INC;
+use constant LIB => grep $_ ne '.', grep !ref($_), @INC;
use Net::DNS::Parameters;
use Net::DNS::Domain;
@@ -546,10 +546,9 @@
return eval { $self->_empty ? '' : $self->_encode_rdata( 0x4000, {} );
} || '' unless @_;
- my $rdata = shift || '';
- my $rdlen = $self->{rdlength} = length $rdata;
- my $hash = {};
- $self->_decode_rdata( \$rdata, 0, $hash ) if $rdlen;
+ my $data = shift || '';
+ my $hash = {};
+ $self->_decode_rdata( \$data, 0, $hash ) if ( $self->{rdlength} =
length $data );
croak 'unexpected compression pointer in rdata' if keys %$hash;
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Net-DNS-1.13/lib/Net/DNS/Resolver/Base.pm
new/Net-DNS-1.14/lib/Net/DNS/Resolver/Base.pm
--- old/Net-DNS-1.13/lib/Net/DNS/Resolver/Base.pm 2017-10-18
11:00:36.000000000 +0200
+++ new/Net-DNS-1.14/lib/Net/DNS/Resolver/Base.pm 2017-12-15
13:25:42.000000000 +0100
@@ -1,9 +1,9 @@
package Net::DNS::Resolver::Base;
#
-# $Id: Base.pm 1595 2017-09-12 09:10:56Z willem $
+# $Id: Base.pm 1608 2017-12-07 10:10:38Z willem $
#
-our $VERSION = (qw$LastChangedRevision: 1595 $)[1];
+our $VERSION = (qw$LastChangedRevision: 1608 $)[1];
#
@@ -26,7 +26,7 @@
# [Revised March 2016]
-use constant USE_SOCKET_IP => defined eval 'use Socket 1.97; use
IO::Socket::IP 0.32; 1;';
+use constant USE_SOCKET_IP => defined eval 'use IO::Socket::IP 0.32; 1;';
use constant USE_SOCKET_INET => defined eval 'require IO::Socket::INET';
@@ -889,7 +889,7 @@
$socket = IO::Socket::INET->new(
LocalAddr => $self->{srcaddr4},
- LocalPort => $self->{srcport},
+ LocalPort => $self->{srcport} || undef,
PeerAddr => $ip,
PeerPort => $self->{port},
Proto => 'tcp',
@@ -932,7 +932,7 @@
$socket = IO::Socket::INET->new(
LocalAddr => $self->{srcaddr4},
- LocalPort => $self->{srcport},
+ LocalPort => $self->{srcport} || undef,
Proto => 'udp',
Type => SOCK_DGRAM
)
@@ -945,28 +945,31 @@
}
-my @udp = (
- flags => Socket::AI_NUMERICHOST,
- protocol => Socket::IPPROTO_UDP,
- socktype => SOCK_DGRAM
- )
- if USE_SOCKET_IP;
-
-my $ip4 = USE_SOCKET_IP ? {family => AF_INET, @udp} : {};
-my $ip6 = USE_SOCKET_IP ? {family => AF_INET6, @udp} : {};
-
-my $inet6 = USE_SOCKET_INET6 ? [AF_INET6, SOCK_DGRAM, 0,
Socket6::AI_NUMERICHOST()] : [];
-
-sub _create_dst_sockaddr { ## create UDP destination sockaddr
structure
- my ( $self, $ip, $port ) = @_;
+{
+ no strict qw(subs);
+ my @udp = (
+ flags => Socket::AI_NUMERICHOST,
+ protocol => Socket::IPPROTO_UDP,
+ socktype => SOCK_DGRAM
+ );
+
+ my $ip4 = USE_SOCKET_IP ? {family => AF_INET, @udp} : {};
+ my $ip6 = USE_SOCKET_IP ? {family => AF_INET6, @udp} : {};
+
+ my $inet6 = USE_SOCKET_INET6 ? [AF_INET6, SOCK_DGRAM, 0,
Socket6::AI_NUMERICHOST()] : [];
+
+ sub _create_dst_sockaddr { ## create UDP destination sockaddr
structure
+ my ( $self, $ip, $port ) = @_;
+
+ unless (USE_SOCKET_IP) {
+ return sockaddr_in( $port, inet_aton($ip) ) unless
_ipv6($ip);
+ return ( Socket6::getaddrinfo( $ip, $port, @$inet6 )
)[3]
+ if USE_SOCKET_INET6;
+ }
- unless (USE_SOCKET_IP) {
- return sockaddr_in( $port, inet_aton($ip) ) unless _ipv6($ip);
- return ( Socket6::getaddrinfo( $ip, $port, @$inet6 ) )[3] if
USE_SOCKET_INET6;
+ ( grep ref, Socket::getaddrinfo( $ip, $port, _ipv6($ip) ? $ip6
: $ip4 ), {} )[0]->{addr}
+ if USE_SOCKET_IP; # NB: errors
raised in socket->send
}
-
- ( grep ref, Socket::getaddrinfo( $ip, $port, _ipv6($ip) ? $ip6 : $ip4
), {} )[0]->{addr}
- if USE_SOCKET_IP; # NB: errors
raised in socket->send
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Net-DNS-1.13/lib/Net/DNS/ZoneFile.pm
new/Net-DNS-1.14/lib/Net/DNS/ZoneFile.pm
--- old/Net-DNS-1.13/lib/Net/DNS/ZoneFile.pm 2017-10-18 11:00:36.000000000
+0200
+++ new/Net-DNS-1.14/lib/Net/DNS/ZoneFile.pm 2017-12-15 13:25:42.000000000
+0100
@@ -1,9 +1,9 @@
package Net::DNS::ZoneFile;
#
-# $Id: ZoneFile.pm 1526 2017-01-16 09:17:54Z willem $
+# $Id: ZoneFile.pm 1605 2017-11-27 11:37:40Z willem $
#
-our $VERSION = (qw$LastChangedRevision: 1526 $)[1];
+our $VERSION = (qw$LastChangedRevision: 1605 $)[1];
=head1 NAME
@@ -92,7 +92,7 @@
}
$self->{filename} = $file ||= '';
- $self->{handle} = new IO::File($file) or croak qq($! "$file");
+ $self->{handle} = new IO::File($file) or croak "$! $file";
$self->{fileopen}{$file}++;
return $self;
}
@@ -524,7 +524,7 @@
croak qq(recursive \$INCLUDE $file) if $opened->{$file}++;
my @discipline = PERLIO ? ( join ':', '<', PerlIO::get_layers
$self->{handle} ) : ();
- my $handle = new IO::File( $file, @discipline ) or croak qq($! "$file");
+ my $handle = new IO::File( $file, @discipline ) or croak "$! $file";
delete $self->{latest}; # forget
previous owner
$self->{parent} = bless {%$self}, ref($self); # save state,
create link
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Net-DNS-1.13/lib/Net/DNS.pm
new/Net-DNS-1.14/lib/Net/DNS.pm
--- old/Net-DNS-1.13/lib/Net/DNS.pm 2017-10-18 11:00:36.000000000 +0200
+++ new/Net-DNS-1.14/lib/Net/DNS.pm 2017-12-15 13:25:42.000000000 +0100
@@ -1,13 +1,13 @@
package Net::DNS;
#
-# $Id: DNS.pm 1604 2017-10-18 09:00:29Z willem $
+# $Id: DNS.pm 1610 2017-12-15 12:25:33Z willem $
#
require 5.006;
our $VERSION;
-$VERSION = '1.13';
+$VERSION = '1.14';
$VERSION = eval $VERSION;
-our $SVNVERSION = (qw$LastChangedRevision: 1604 $)[1];
+our $SVNVERSION = (qw$LastChangedRevision: 1610 $)[1];
=head1 NAME
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Net-DNS-1.13/t/00-install.t
new/Net-DNS-1.14/t/00-install.t
--- old/Net-DNS-1.13/t/00-install.t 1970-01-01 01:00:00.000000000 +0100
+++ new/Net-DNS-1.14/t/00-install.t 2017-12-15 13:25:41.000000000 +0100
@@ -0,0 +1,94 @@
+# $Id: 00-install.t 1605 2017-11-27 11:37:40Z willem $ -*-perl-*-
+
+use strict;
+use Test::More;
+use File::Spec;
+use File::Find;
+use ExtUtils::MakeMaker;
+
+
+eval {
+ my %macro; # extract
Makefile macros
+ open MAKEFILE, 'Makefile' or die $!;
+ while (<MAKEFILE>) {
+ $macro{$1} = $2 if /^([A-Z_]+)\s+=\s+(.*)$/;
+ }
+ close MAKEFILE;
+
+ my %install_type = qw(perl INSTALLPRIVLIB site INSTALLSITELIB vendor
INSTALLVENDORLIB);
+ my $install_site = join '', '$(DESTDIR)$(',
$install_type{$macro{INSTALLDIRS}}, ')';
+ for ($install_site) {
+ s/\$\(([A-Z_]+)\)/$macro{$1}/eg while /\$\(/; # expand
Makefile macros
+ s|([/])[/]+|$1|g; # remove
gratuitous //s
+ }
+
+ local @INC = grep !m/\bblib\W(arch|lib)$/i, @INC;
+ eval 'require Net::DNS';
+ my @version = grep $_, ( 'version', $Net::DNS::VERSION );
+
+ my $nameregex = '\W+Net\WDNS.pm$';
+ my @installed = grep $_ && m/$nameregex/io, values %INC;
+ my %noinstall;
+
+ foreach (@installed) {
+ my $path = $1 if m/^(.+)$nameregex/i;
+ my %seen;
+ foreach (@INC) {
+ $seen{$_}++; # find $path in
@INC
+ last if $_ eq $path;
+ }
+ foreach ( grep !$seen{$_}, @INC ) {
+ $noinstall{$_}++; # mark hidden
libraries
+ }
+ }
+
+ warn <<"AMEN" if $noinstall{$install_site};
+
+##
+## The install location for this version of Net::DNS differs
+## from the existing @version in your perl library.
+## @installed
+##
+## The installation will be rendered ineffective because the
+## library search finds the existing version before reaching
+## $install_site
+##
+## Makefile has been generated to support build and test only.
+##
+AMEN
+
+};
+
+
+my @files;
+my $blib = File::Spec->catfile(qw(blib lib));
+
+find( sub { push( @files, $File::Find::name ) if /\.pm$/ && !/Template/ },
$blib );
+
+my %manifest;
+open MANIFEST, 'MANIFEST' or plan skip_all => "MANIFEST: $!";
+while (<MANIFEST>) {
+ chomp;
+ my ( $volume, $directory, $name ) = File::Spec->splitpath($_);
+ $manifest{lc $name}++ if $name;
+}
+close MANIFEST;
+
+plan skip_all => 'No versions from git checkouts' if -e '.git';
+
+plan skip_all => 'Not sure how to parse versions.' unless eval {
MM->can('parse_version') };
+
+plan tests => scalar @files;
+
+foreach my $file ( sort @files ) { # reconcile
files with MANIFEST
+ my $version = MM->parse_version($file);
+ ok( $version =~ /[\d.]{3}/, "file version: $version\t$file" );
+ my ( $volume, $directory, $name ) = File::Spec->splitpath($file);
+ diag("File not in MANIFEST: $file") unless $manifest{lc $name};
+}
+
+
+exit;
+
+__END__
+
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Net-DNS-1.13/t/00-load.t new/Net-DNS-1.14/t/00-load.t
--- old/Net-DNS-1.13/t/00-load.t 2017-10-18 11:00:36.000000000 +0200
+++ new/Net-DNS-1.14/t/00-load.t 2017-12-15 13:25:41.000000000 +0100
@@ -1,4 +1,4 @@
-# $Id: 00-load.t 1595 2017-09-12 09:10:56Z willem $ -*-perl-*-
+# $Id: 00-load.t 1606 2017-11-30 10:13:43Z willem $ -*-perl-*-
use strict;
use Test::More;
@@ -35,20 +35,18 @@
diag("\n\nThese tests were run using:\n");
foreach my $module (@module) {
- my $loaded = eval("require $module") || next;
- my $revnum = $loaded ? $module->VERSION : "\t\tn/a";
- diag sprintf "\t%-25s %s", $module, $revnum || '?';
+ eval "require $module";
+ my $version = eval { $module->VERSION } || next;
+ diag sprintf "\t%-25s %s", $module, $version;
}
-diag("set environment variable NET_DNS_DEBUG to get all versions\n\n");
-
plan tests => 20 + scalar(@Net::DNS::EXPORT);
use_ok('Net::DNS');
-is( Net::DNS->version, $Net::DNS::VERSION, 'Net::DNS->version');
+is( Net::DNS->version, $Net::DNS::VERSION, 'Net::DNS->version' );
#
@@ -90,3 +88,5 @@
exit;
+__END__
+
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Net-DNS-1.13/t/00-version.t
new/Net-DNS-1.14/t/00-version.t
--- old/Net-DNS-1.13/t/00-version.t 2017-10-18 11:00:36.000000000 +0200
+++ new/Net-DNS-1.14/t/00-version.t 1970-01-01 01:00:00.000000000 +0100
@@ -1,91 +0,0 @@
-# $Id: 00-version.t 1582 2017-07-07 21:45:14Z willem $ -*-perl-*-
-
-use strict;
-use Test::More;
-use File::Spec;
-use File::Find;
-use ExtUtils::MakeMaker;
-
-my @files;
-my $blib = File::Spec->catfile(qw(blib lib));
-
-find( sub { push( @files, $File::Find::name ) if /\.pm$/ && !/Template/ },
$blib );
-
-my %manifest;
-open MANIFEST, 'MANIFEST' or plan skip_all => "MANIFEST: $!";
-while (<MANIFEST>) {
- chomp;
- my ( $volume, $directory, $name ) = File::Spec->splitpath($_);
- $manifest{lc $name}++ if $name;
-}
-close MANIFEST;
-
-plan skip_all => 'No versions from git checkouts' if -e '.git';
-
-plan skip_all => 'Not sure how to parse versions.' unless eval {
MM->can('parse_version') };
-
-plan tests => scalar @files;
-
-foreach my $file ( sort @files ) { # reconcile
files with MANIFEST
- my $version = MM->parse_version($file);
- diag("$file\t=>\t$version") if $ENV{'NET_DNS_DEBUG'};
- ok( $version =~ /[\d.]{3}/, "file version: $version\t$file" );
- my ( $volume, $directory, $name ) = File::Spec->splitpath($file);
- diag("File not in MANIFEST: $file") unless $manifest{lc $name};
-}
-
-
-eval {
- my %macro; # extract
Makefile macros
- open MAKEFILE, 'Makefile' or die $!;
- while (<MAKEFILE>) {
- $macro{$1} = $2 if /^([A-Z_]+)\s+=\s+(.*)$/;
- }
- close MAKEFILE;
-
- my %install_type = qw(perl INSTALLPRIVLIB site INSTALLSITELIB vendor
INSTALLVENDORLIB);
- my $install_site = join '', '$(DESTDIR)$(',
$install_type{$macro{INSTALLDIRS}}, ')';
- for ($install_site) {
- s/\$\(([A-Z_]+)\)/$macro{$1}/eg while /\$\(/; # expand
Makefile macros
- s|([/])[/]+|$1|g; # remove
gratuitous //s
- }
-
- local @INC = grep !m/\bblib\W(arch|lib)$/i, @INC;
- eval 'require Net::DNS';
-
- my $nameregex = '\W+Net\WDNS.pm$';
- my @installed = grep m/$nameregex/io, values %INC;
- my %noinstall;
-
- foreach (@installed) {
- my $path = $1 if m/^(.+)$nameregex/i;
- my %seen;
- foreach (@INC) {
- $seen{$_}++; # find $path in
@INC
- last if $_ eq $path;
- }
- foreach ( grep !$seen{$_}, @INC ) {
- $noinstall{$_}++; # mark hidden
libraries
- }
- }
-
- warn <<"AMEN" if $noinstall{$install_site};
-
-##
-## The install location for this version of Net::DNS differs
-## from the existing version $Net::DNS::VERSION in your perl library.
-## @installed
-##
-## The installation will be rendered ineffective because the
-## library search finds the existing version before reaching
-## $install_site
-##
-## Makefile has been generated to support build and test only.
-##
-AMEN
-
-}
-
-
-__END__
-
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Net-DNS-1.13/t/08-IPv4.t new/Net-DNS-1.14/t/08-IPv4.t
--- old/Net-DNS-1.13/t/08-IPv4.t 2017-10-18 11:00:36.000000000 +0200
+++ new/Net-DNS-1.14/t/08-IPv4.t 2017-12-15 13:25:41.000000000 +0100
@@ -1,4 +1,4 @@
-# $Id: 08-IPv4.t 1603 2017-10-17 14:45:45Z willem $ -*-perl-*-
+# $Id: 08-IPv4.t 1608 2017-12-07 10:10:38Z willem $ -*-perl-*-
use strict;
use Test::More;
@@ -262,10 +262,12 @@
}
-{
+SKIP: {
my $resolver = Net::DNS::Resolver->new( nameservers => $IP );
$resolver->domain('net-dns.org');
eval { $resolver->tsig( $resolver->query(qw(tsig-md5 KEY))->answer ) };
+ skip( 'automatic TSIG tests', 3 ) if $@;
+
$resolver->igntc(1);
my $udp = $resolver->send(qw(net-dns.org SOA IN));
@@ -286,11 +288,12 @@
}
-{
+SKIP: {
my $resolver = Net::DNS::Resolver->new( nameservers => $IP );
$resolver->igntc(1);
eval { $resolver->tsig( 'MD5.example', 'MD5keyMD5keyMD5keyMD5keyMD5=' )
};
+ skip( 'failed TSIG tests', 3 ) if $@;
my $udp = $resolver->send(qw(net-dns.org SOA IN));
ok( !$udp, '$resolver->send(...) UDP + failed TSIG' );
@@ -436,13 +439,19 @@
ok( $axfr_start, '$resolver->axfr_start() (historical)' );
ok( eval { $resolver->axfr_next() }, '$resolver->axfr_next()
(historical)' );
ok( $resolver->answerfrom(), '$resolver->answerfrom() works' );
+
+ $resolver->srcport(-1);
+ my @badsocket = $resolver->axfr();
+ my $badsocket = $resolver->errorstring;
+ ok( !scalar(@badsocket), "bad AXFR socket\t[$badsocket]" );
}
-{
+SKIP: {
my $resolver = Net::DNS::Resolver->new( nameservers => $IP );
$resolver->domain('net-dns.org');
eval { $resolver->tsig( $resolver->query(qw(tsig-md5 KEY))->answer ) };
+ skip( 'TSIG AXFR tests', 4 ) if $@;
$resolver->tcp_timeout(10);
my @zone = $resolver->axfr();
@@ -460,17 +469,13 @@
eval { $resolver->tsig(undef) };
my ($exception) = split /\n/, "$@\n";
ok( $exception, "undefined TSIG\t[$exception]" );
-
- $resolver->srcport(-1);
- my @badsocket = $resolver->axfr();
- my $badsocket = $resolver->errorstring;
- ok( !scalar(@badsocket), "bad AXFR socket\t[$badsocket]" );
}
-{
+SKIP: {
my $resolver = Net::DNS::Resolver->new( nameservers => $NOIP );
eval { $resolver->tsig( 'MD5.example', 'MD5keyMD5keyMD5keyMD5keyMD5=' )
};
+ skip( 'TSIG AXFR tests', 2 ) if $@;
my $query = new Net::DNS::Packet(qw(. SOA IN));
ok( $resolver->bgsend($query), '$resolver->bgsend() + automatic TSIG' );
@@ -530,11 +535,14 @@
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 = new IO::Select($socket);
- eval { $resolver->_axfr_next( $select, $packet->sigrr ); };
+ eval { $resolver->_axfr_next( $select, $tsigrr ); };
my $exception = $1 if $@ =~ /^(.+)\n/;
ok( $exception ||= '', "verify fail\t[$exception]" );
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Net-DNS-1.13/t/08-IPv6.t new/Net-DNS-1.14/t/08-IPv6.t
--- old/Net-DNS-1.13/t/08-IPv6.t 2017-10-18 11:00:36.000000000 +0200
+++ new/Net-DNS-1.14/t/08-IPv6.t 2017-12-15 13:25:41.000000000 +0100
@@ -1,4 +1,4 @@
-# $Id: 08-IPv6.t 1603 2017-10-17 14:45:45Z willem $ -*-perl-*-
+# $Id: 08-IPv6.t 1608 2017-12-07 10:10:38Z willem $ -*-perl-*-
use strict;
use Test::More;
@@ -265,10 +265,12 @@
}
-{
+SKIP: {
my $resolver = Net::DNS::Resolver->new( nameservers => $IP );
$resolver->domain('net-dns.org');
eval { $resolver->tsig( $resolver->query(qw(tsig-md5 KEY))->answer ) };
+ skip( 'automatic TSIG tests', 3 ) if $@;
+
$resolver->igntc(1);
my $udp = $resolver->send(qw(net-dns.org SOA IN));
@@ -289,11 +291,12 @@
}
-{
+SKIP: {
my $resolver = Net::DNS::Resolver->new( nameservers => $IP );
$resolver->igntc(1);
eval { $resolver->tsig( 'MD5.example', 'MD5keyMD5keyMD5keyMD5keyMD5=' )
};
+ skip( 'failed TSIG tests', 3 ) if $@;
my $udp = $resolver->send(qw(net-dns.org SOA IN));
ok( !$udp, '$resolver->send(...) UDP + failed TSIG' );
@@ -439,13 +442,19 @@
ok( $axfr_start, '$resolver->axfr_start() (historical)' );
ok( eval { $resolver->axfr_next() }, '$resolver->axfr_next()
(historical)' );
ok( $resolver->answerfrom(), '$resolver->answerfrom() works' );
+
+ $resolver->srcport(-1);
+ my @badsocket = $resolver->axfr();
+ my $badsocket = $resolver->errorstring;
+ ok( !scalar(@badsocket), "bad AXFR socket\t[$badsocket]" );
}
-{
+SKIP: {
my $resolver = Net::DNS::Resolver->new( nameservers => $IP );
$resolver->domain('net-dns.org');
eval { $resolver->tsig( $resolver->query(qw(tsig-md5 KEY))->answer ) };
+ skip( 'TSIG AXFR tests', 4 ) if $@;
$resolver->tcp_timeout(10);
my @zone = $resolver->axfr();
@@ -463,17 +472,13 @@
eval { $resolver->tsig(undef) };
my ($exception) = split /\n/, "$@\n";
ok( $exception, "undefined TSIG\t[$exception]" );
-
- $resolver->srcport(-1);
- my @badsocket = $resolver->axfr();
- my $badsocket = $resolver->errorstring;
- ok( !scalar(@badsocket), "bad AXFR socket\t[$badsocket]" );
}
-{
+SKIP: {
my $resolver = Net::DNS::Resolver->new( nameservers => $NOIP );
eval { $resolver->tsig( 'MD5.example', 'MD5keyMD5keyMD5keyMD5keyMD5=' )
};
+ skip( 'TSIG AXFR tests', 2 ) if $@;
my $query = new Net::DNS::Packet(qw(. SOA IN));
ok( $resolver->bgsend($query), '$resolver->bgsend() + automatic TSIG' );
@@ -533,11 +538,14 @@
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 = new IO::Select($socket);
- eval { $resolver->_axfr_next( $select, $packet->sigrr ); };
+ eval { $resolver->_axfr_next( $select, $tsigrr ); };
my $exception = $1 if $@ =~ /^(.+)\n/;
ok( $exception ||= '', "verify fail\t[$exception]" );
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Net-DNS-1.13/t/NonFatal.pm
new/Net-DNS-1.14/t/NonFatal.pm
--- old/Net-DNS-1.13/t/NonFatal.pm 2017-10-18 11:00:36.000000000 +0200
+++ new/Net-DNS-1.14/t/NonFatal.pm 2017-12-15 13:25:41.000000000 +0100
@@ -1,4 +1,4 @@
-# $Id: NonFatal.pm 1381 2015-08-25 07:36:09Z willem $ -*-perl-*-
+# $Id: NonFatal.pm 1608 2017-12-07 10:10:38Z willem $ -*-perl-*-
# Test::More calls functions from Test::Builder. Those functions all eventually
# call Test::Builder::ok (on a builder instance) for reporting the status.
@@ -23,6 +23,15 @@
use constant NONFATAL => eval { -e 't/online.nonfatal' };
+my @failed;
+
+END {
+ my $n = scalar(@failed);
+ my $s = $n > 1 ? 's' : '';
+ diag( join "\n\t", "\tDisregarding $n failed sub-test$s", @failed ) if
$n;
+}
+
+
{
package Test::NonFatal;
@@ -31,11 +40,12 @@
sub ok {
my ( $self, $test, $name ) = ( @_, '' );
- $name = "NOT OK, but tolerating failure, $name" unless $test;
+ return $self->SUPER::ok( 1, $name ) if $test;
- $self->SUPER::ok( 1, $name );
+ $self->SUPER::ok( 1, "NOT OK, but tolerating failure, $name" );
- return $test ? 1 : 0;
+ push @failed, $name;
+ return $test;
}
}
