From 6fc11a5a264f6d56983ecc3e61caaa2694f86fdb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20P=C3=A4iv=C3=A4rinta?= Date: Mon, 28 Apr 2025 11:46:54 +0200 Subject: [PATCH 01/32] Migrate CI from Travis to Github Action Travis no longer offers a free tier but Github Actions does. --- .github/workflows/ci.yml | 112 +++++++++++++++++++++++++++++++++++++++ .travis.yml | 73 ------------------------- 2 files changed, 112 insertions(+), 73 deletions(-) create mode 100644 .github/workflows/ci.yml delete mode 100644 .travis.yml diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml new file mode 100644 index 00000000..e46949db --- /dev/null +++ b/.github/workflows/ci.yml @@ -0,0 +1,112 @@ +--- +name: CI + +on: + push: + branches: + - develop + - master + - 'release/**' + pull_request: + branches: + - develop + - master + - 'release/**' + +jobs: + run-tests: + strategy: + matrix: + compatibility: + - develop + # - latest + perl: + - '5.38' + - '5.34' + - '5.26' + runner: + - ubuntu-22.04 + + runs-on: ${{ matrix.runner }} + + steps: + - uses: actions/checkout@v2 + + - uses: shogo82148/actions-setup-perl@v1 + with: + perl-version: ${{ matrix.perl }} + + - name: Install binary dependencies + run: | + # * These were taken from the installation instruction. + # * Gettext was added so we can run cpanm . on the Engine sources. + # * The Perl modules were left out because I couldn't get all of them + # to work with custom Perl versions. + # * Cpanminus was left out because actions-setup-perl installs it. + sudo apt-get install -y \ + autoconf \ + automake \ + build-essential \ + gettext \ + libidn2-dev \ + libssl-dev \ + libtool \ + m4 \ + + - name: Install Zonemaster dependencies (latest) + if: ${{ matrix.compatibility == 'latest' }} + run: | + cpanm --sudo --notest \ + Module::Install \ + ExtUtils::PkgConfig \ + Zonemaster::Engine + + - name: Install Zonemaster dependencies (develop) + if: ${{ matrix.compatibility == 'develop' }} + run: | + cpanm --sudo --notest \ + Devel::CheckLib \ + Module::Install \ + ExtUtils::PkgConfig \ + Module::Install::XSUtil + git clone --branch=develop --depth=1 \ + https://github.com/zonemaster/zonemaster-ldns.git + perl Makefile.PL # Generate MYMETA.yml to appease cpanm . + ( cd zonemaster-ldns ; cpanm --sudo --notest . ) + rm -rf zonemaster-ldns + git clone --branch=develop --depth=1 \ + https://github.com/zonemaster/zonemaster-engine.git + perl Makefile.PL # Generate MYMETA.yml to appease cpanm . + ( cd zonemaster-engine ; cpanm --sudo --notest . ) + rm -rf zonemaster-engine + + # Installing Zonemaster::Engine requires root privileges, because of a + # bug in Mail::SPF preventing normal installation with cpanm as + # non-root user (see link below [1]). + # + # The alternative, if one still wishes to install Zonemaster::Engine + # as non-root user, is to install Mail::SPF first with a command like: + # + # % cpanm --notest \ + # --install-args="--install_path sbin=$HOME/.local/sbin" \ + # Mail::SPF + # + # For the sake of consistency, other Perl packages installed from CPAN + # are also installed as root. + # + # [1]: https://rt.cpan.org/Public/Bug/Display.html?id=34768 + - name: Install remaining dependencies + run: | + cpanm --sudo --verbose --notest --installdeps . + + - name: Install Zonemaster::CLI + run: | + cpanm --sudo --verbose --notest . + + - name: Show content of log files + if: ${{ failure() }} + run: cat /home/runner/.cpanm/work/*/build.log + + - name: Test + run: | + prove -lv t diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index fbdaaa01..00000000 --- a/.travis.yml +++ /dev/null @@ -1,73 +0,0 @@ -dist: jammy -group: previous - -language: perl - -perl: - - "5.38" - - "5.34" - - "5.26" - -addons: - apt: - packages: - # From Zonemaster Engine installation instruction for Ubuntu - - autoconf - - automake - - build-essential - - cpanminus - - libclone-perl - - libdevel-checklib-perl - - libextutils-pkgconfig-perl - - libfile-sharedir-perl - - libfile-slurp-perl - - libidn2-dev - - libintl-perl - - libjson-pp-perl - - liblist-compare-perl - - liblist-moreutils-perl - - liblocale-msgfmt-perl - - libmail-rfc822-address-perl - - libmail-spf-perl - - libmodule-find-perl - - libnet-ip-perl - - libpod-coverage-perl - - libreadonly-xs-perl - - libssl-dev - - libtest-differences-perl - - libtest-exception-perl - - libtest-fatal-perl - - libtest-pod-perl - - libtext-csv-perl - - libtool - - m4 - # From Zonemaster CLI installation instruction for Ubuntu - # libmodule-install-perl, see cpan-install below - - libtry-tiny-perl - -before_install: - # Help Perl find modules installed from OS packages -- export PERL5LIB=/usr/share/perl5 - - # Provide cpanm helper - # quoting preserves newlines in the script and then avoid error if the script contains comments -- eval "$(curl https://travis-perl.github.io/init)" --auto - - # Zonemaster LDNS needs a newer version of Module::Install -- cpan-install Module::Install Module::Install::XSUtil - - # IO::Socket::INET6 can't find Socket6 installed from OS package -- cpan-install Socket6 IO::Socket::INET6 - - # Install Zonemaster LDNS -- git clone --depth=1 --branch=$TRAVIS_BRANCH https://github.com/zonemaster/zonemaster-ldns.git -- ( cd zonemaster-ldns && cpanm --verbose --notest --configure-args="--no-ed25519" . ) && rm -rf zonemaster-ldns - - # Install Zonemaster Engine -- git clone --depth=1 --branch=$TRAVIS_BRANCH https://github.com/zonemaster/zonemaster-engine.git -- ( cd zonemaster-engine && cpanm --verbose --notest . ) && rm -rf zonemaster-engine - - # Fix Header files location issue -- if [[ ! -e /usr/include/sys/ ]]; then sudo mkdir /usr/include/sys/; fi -- if [[ ! -e /usr/include/bits/ && -e /usr/include/x86_64-linux-gnu/bits/ ]]; then sudo ln -s /usr/include/x86_64-linux-gnu/bits/ /usr/include/bits; fi -- if [[ ! -e /usr/include/sys/socket.h ]]; then sudo ln -s /usr/include/bits/socket.h /usr/include/sys/socket.h; fi From 5a6c402019ab7465d3a85a90128d990f71ac4464 Mon Sep 17 00:00:00 2001 From: Marc van der Wal Date: Mon, 27 Jan 2025 10:35:45 +0100 Subject: [PATCH 02/32] Slow down the spinner a bit MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The console output of zonemaster-cli includes an optional spinner, looping over four frames, with each frame being advanced whenever Zonemaster::Engine outputs a message, even if it isn’t shown. However, over the course of a single domain test, Zonemaster::Engine outputs thousands of messages of level DEBUG1 or lower. As a result, the spinner’s animation is far too fast to be enjoyable and a lot of strain is put on the user’s terminal. This change simply ensures that no frame is shown for less than 0.1 seconds. The animation looks smoother and doesn’t run the risk overloading the terminal. --- lib/Zonemaster/CLI.pm | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/lib/Zonemaster/CLI.pm b/lib/Zonemaster/CLI.pm index 905c4ccd..c8a22eb6 100644 --- a/lib/Zonemaster/CLI.pm +++ b/lib/Zonemaster/CLI.pm @@ -26,6 +26,7 @@ use Pod::Usage; use POSIX qw[setlocale LC_MESSAGES LC_CTYPE]; use Readonly; use Scalar::Util qw[blessed]; +use Time::HiRes; use Try::Tiny; use Zonemaster::LDNS; use Zonemaster::Engine; @@ -400,9 +401,11 @@ sub run { print_spinner() if $show_progress; - $counter{ uc $entry->level } += 1; + my $entry_level = $entry->level; - if ( $numeric{ uc $entry->level } >= $numeric{$opt_level} ) { + $counter{ uc $entry_level } += 1; + + if ( $numeric{ uc $entry_level } >= $numeric{$opt_level} ) { $printed_something = 1; if ( $opt_json and $opt_json_stream ) { @@ -412,8 +415,8 @@ sub run { $r{module} = $entry->module if $opt_show_module; $r{testcase} = $entry->testcase if $opt_show_testcase; $r{tag} = $entry->tag; - $r{level} = $entry->level if $opt_show_level; - $r{args} = $entry->args if $entry->args; + $r{level} = $entry_level if $opt_show_level; + $r{args} = $entry->args if $entry->args; $r{message} = $translator->translate_tag( $entry ) unless $opt_raw; say $JSON->encode( \%r ); @@ -430,7 +433,7 @@ sub run { if ( $opt_show_level ) { $prefix .= $opt_raw ? $entry->level : translate_severity( $entry->level ); my $space_l10n = - ${ field_width { level } } - length( decode_utf8( translate_severity( $entry->level ) ) ) + 1; + ${ field_width { level } } - length( decode_utf8( translate_severity( $entry_level ) ) ) + 1; $prefix .= ' ' x $space_l10n; } @@ -454,7 +457,7 @@ sub run { } } else { - if ( $entry->level eq q{DEBUG3} and scalar( keys %{$entry->args} ) == 1 and defined $entry->args->{packet} ) { + if ( $entry_level eq q{DEBUG3} and scalar( keys %{$entry->args} ) == 1 and defined $entry->args->{packet} ) { my $packet = $entry->args->{packet}; my $padding = q{ } x length $prefix; $entry->args->{packet} = q{}; @@ -852,10 +855,13 @@ my @spinner_strings = ( ' | ', ' / ', ' - ', ' \\ ' ); sub print_spinner { state $counter = 0; + state $last_spin = [0, 0]; - printf "%s\r", $spinner_strings[ $counter++ % 4 ]; - - return; + my $time = [Time::HiRes::gettimeofday()]; + if ( Time::HiRes::tv_interval($last_spin, $time) > 0.1 ) { + $last_spin = $time; + printf "%s\r", $spinner_strings[ $counter++ % 4 ]; + } } sub print_test_list { From 1167e74628d5317f93f3f2c23d764962b994973e Mon Sep 17 00:00:00 2001 From: "[Thomas Green]" Date: Tue, 25 Feb 2025 19:37:37 +0100 Subject: [PATCH 03/32] Expand --count option - Add a count of each message tag for each severity level --- lib/Zonemaster/CLI.pm | 20 +++++++++++++++++++- script/zonemaster-cli | 2 +- 2 files changed, 20 insertions(+), 2 deletions(-) diff --git a/lib/Zonemaster/CLI.pm b/lib/Zonemaster/CLI.pm index c8a22eb6..3f170668 100644 --- a/lib/Zonemaster/CLI.pm +++ b/lib/Zonemaster/CLI.pm @@ -675,7 +675,25 @@ sub run { say __( "\n\n Level\tNumber of log entries" ); say " =====\t====================="; foreach my $level ( sort { $numeric{$b} <=> $numeric{$a} } keys %counter ) { - printf __( "%8s\t%5d entries.\n" ), translate_severity( $level ), $counter{$level}; + printf __( "%8s\t%21d\n" ), translate_severity( $level ), $counter{$level}; + } + + my %entries; + my $max = 1; + foreach my $e ( @{ Zonemaster::Engine->logger->entries } ) { + $entries{$e->level}{$e->tag} += 1; + $max = length $e->tag if length $e->tag > $max; + } + + print "\n"; + printf __("%s \t%${max}s %s\n"), ' Level', 'Message tag', ' Count'; + printf "%s \t%${max}s %s\n", ' =====', '=' x $max, ' ====='; + foreach my $level ( sort { $numeric{$b} <=> $numeric{$a} } keys %entries ) { + foreach my $tag ( sort keys %{ $entries{$level} } ) { + printf "%8s\t", $level; + printf "%${max}s ", $tag; + printf "%8s\n", $entries{$level}{$tag}; + } } } } diff --git a/script/zonemaster-cli b/script/zonemaster-cli index 0cfd7cc0..0c2266ce 100755 --- a/script/zonemaster-cli +++ b/script/zonemaster-cli @@ -250,7 +250,7 @@ Print the name of the test case (test case identifier) which produced the messag =item B<--[no-]count> Print a summary, at the end of a run, of the numbers of messages for each severity -level that were logged during the run. +level that were logged during the run, as well as a count of each message tag. (default: disabled) =item B<--[no-]nstimes> From 4701c9cfe7ffb9322284a043c9ce59b125f1fd9e Mon Sep 17 00:00:00 2001 From: "[Thomas Green]" Date: Thu, 24 Apr 2025 18:35:44 +0200 Subject: [PATCH 04/32] Update --count option - Fixes translation of strings - Dynamically format the tables as to support translated strings - Refactoring --- lib/Zonemaster/CLI.pm | 36 +++++++++++++++++++++++++----------- 1 file changed, 25 insertions(+), 11 deletions(-) diff --git a/lib/Zonemaster/CLI.pm b/lib/Zonemaster/CLI.pm index 3f170668..c17dcc45 100644 --- a/lib/Zonemaster/CLI.pm +++ b/lib/Zonemaster/CLI.pm @@ -672,27 +672,41 @@ sub run { } } else { - say __( "\n\n Level\tNumber of log entries" ); - say " =====\t====================="; + my $header1 = __( 'Level' ); + my $header2 = __( 'Number of log entries' ); + my $max1 = length $header1; + my $max2 = length $header2; + + foreach my $level ( sort { $numeric{$b} <=> $numeric{$a} } keys %counter ) { + my $len = length translate_severity( $level ); + $max1 = $len if $len > $max1; + } + + printf "\n\n%${max1}s\t%${max2}s", $header1, $header2; + printf "\n%s\t%s\n", '=' x $max1, '=' x $max2; + foreach my $level ( sort { $numeric{$b} <=> $numeric{$a} } keys %counter ) { - printf __( "%8s\t%21d\n" ), translate_severity( $level ), $counter{$level}; + printf "%${max1}s\t%${max2}d\n", translate_severity( $level ), $counter{$level}; } + my $header3 = __( 'Message tag' ); + my $max3 = length $header3; + my %entries; - my $max = 1; foreach my $e ( @{ Zonemaster::Engine->logger->entries } ) { $entries{$e->level}{$e->tag} += 1; - $max = length $e->tag if length $e->tag > $max; + my $len = length $e->tag; + $max3 = $len if $len > $max3; } - print "\n"; - printf __("%s \t%${max}s %s\n"), ' Level', 'Message tag', ' Count'; - printf "%s \t%${max}s %s\n", ' =====', '=' x $max, ' ====='; + my $header4 = __( 'Count' ); + my $max4 = max map { length "$_" } ( ( map { values %{ $_ } } ( values %entries ) ), $header4 ); + + printf "\n%${max1}s\t%${max3}s\t%${max4}s", $header1, $header3, $header4; + printf "\n%${max1}s\t%${max3}s\t%${max4}s\n", '=' x $max1, '=' x $max3, '=' x $max4; foreach my $level ( sort { $numeric{$b} <=> $numeric{$a} } keys %entries ) { foreach my $tag ( sort keys %{ $entries{$level} } ) { - printf "%8s\t", $level; - printf "%${max}s ", $tag; - printf "%8s\n", $entries{$level}{$tag}; + printf "%${max1}s\t%${max3}s\t%${max4}s\n", $level, $tag, $entries{$level}{$tag}; } } } From 9d8ace6a447117867ae03cce16d97579f9a724ab Mon Sep 17 00:00:00 2001 From: "[Thomas Green]" Date: Thu, 24 Apr 2025 18:53:41 +0200 Subject: [PATCH 05/32] Also update json output of --count option --- lib/Zonemaster/CLI.pm | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/lib/Zonemaster/CLI.pm b/lib/Zonemaster/CLI.pm index c17dcc45..54dccb68 100644 --- a/lib/Zonemaster/CLI.pm +++ b/lib/Zonemaster/CLI.pm @@ -665,16 +665,27 @@ sub run { my $json_output = {}; if ( $opt_count ) { + my %entries; + foreach my $e ( @{ Zonemaster::Engine->logger->entries } ) { + $entries{$e->level}{$e->tag} += 1; + } + if ( $opt_json ) { $json_output->{count} = {}; foreach my $level ( sort { $numeric{$b} <=> $numeric{$a} } keys %counter ) { - $json_output->{count}{$level} = $counter{$level}; + $json_output->{count}{by_level}{$level} = $counter{$level}; + } + + foreach my $level ( sort { $numeric{$b} <=> $numeric{$a} } keys %entries ) { + foreach my $tag ( sort keys %{ $entries{$level} } ) { + $json_output->{count}{by_message_tag}{$level}{$tag} = $entries{$level}{$tag}; + } } } else { my $header1 = __( 'Level' ); - my $header2 = __( 'Number of log entries' ); my $max1 = length $header1; + my $header2 = __( 'Number of log entries' ); my $max2 = length $header2; foreach my $level ( sort { $numeric{$b} <=> $numeric{$a} } keys %counter ) { @@ -690,15 +701,7 @@ sub run { } my $header3 = __( 'Message tag' ); - my $max3 = length $header3; - - my %entries; - foreach my $e ( @{ Zonemaster::Engine->logger->entries } ) { - $entries{$e->level}{$e->tag} += 1; - my $len = length $e->tag; - $max3 = $len if $len > $max3; - } - + my $max3 = max map { length "$_" } ( ( map { keys %{ $_ } } ( values %entries ) ), $header3 );; my $header4 = __( 'Count' ); my $max4 = max map { length "$_" } ( ( map { values %{ $_ } } ( values %entries ) ), $header4 ); From 5ee387e1383aa127e1292158ca975321788ef16c Mon Sep 17 00:00:00 2001 From: "[Thomas Green]" Date: Tue, 3 Jun 2025 14:09:30 +0200 Subject: [PATCH 06/32] Update unit test for --count option --- lib/Zonemaster/CLI.pm | 2 +- t/usage.t | 5 +++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/lib/Zonemaster/CLI.pm b/lib/Zonemaster/CLI.pm index 54dccb68..4ded8225 100644 --- a/lib/Zonemaster/CLI.pm +++ b/lib/Zonemaster/CLI.pm @@ -701,7 +701,7 @@ sub run { } my $header3 = __( 'Message tag' ); - my $max3 = max map { length "$_" } ( ( map { keys %{ $_ } } ( values %entries ) ), $header3 );; + my $max3 = max map { length "$_" } ( ( map { keys %{ $_ } } ( values %entries ) ), $header3 ); my $header4 = __( 'Count' ); my $max4 = max map { length "$_" } ( ( map { values %{ $_ } } ( values %entries ) ), $header4 ); diff --git a/t/usage.t b/t/usage.t index fdfa4bcb..090a5a7a 100644 --- a/t/usage.t +++ b/t/usage.t @@ -369,6 +369,11 @@ do { INFO \s+ \d+ .* DEBUG \s+ \d+ + .* + Level \s+ \QMessage tag\E \s+ \QCount\E + .* + INFO \s+ \w+ \s+ \d+ + .* }msx, json => { type => "object", From 44173eb1ef6ca34a4a17e98d51d7b75e936d359e Mon Sep 17 00:00:00 2001 From: Mats Dufberg Date: Thu, 5 Jun 2025 16:40:39 +0200 Subject: [PATCH 07/32] Updates perl versions in CI --- .github/workflows/ci.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index e46949db..10309049 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -21,9 +21,9 @@ jobs: - develop # - latest perl: - - '5.38' - - '5.34' - - '5.26' + - '5.40' + - '5.36' + - '5.32' runner: - ubuntu-22.04 From 3bbdac92c2f54f5e27c7f35b46f7ece88da69353 Mon Sep 17 00:00:00 2001 From: Mats Dufberg Date: Mon, 9 Jun 2025 14:13:16 +0200 Subject: [PATCH 08/32] Update after review comment --- .github/workflows/ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 10309049..2ae3719e 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -23,7 +23,7 @@ jobs: perl: - '5.40' - '5.36' - - '5.32' + - '5.26' runner: - ubuntu-22.04 From 1b37345672b0a1983f0d94b1649e071a8c7459e8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20P=C3=A4iv=C3=A4rinta?= Date: Tue, 11 Mar 2025 13:19:48 +0100 Subject: [PATCH 09/32] Tidy --- lib/Zonemaster/CLI.pm | 172 +++++++++++++++++++++++------------------- 1 file changed, 95 insertions(+), 77 deletions(-) diff --git a/lib/Zonemaster/CLI.pm b/lib/Zonemaster/CLI.pm index 4ded8225..7301bf24 100644 --- a/lib/Zonemaster/CLI.pm +++ b/lib/Zonemaster/CLI.pm @@ -34,7 +34,7 @@ use Zonemaster::Engine::Exception; use Zonemaster::Engine::Normalization qw[normalize_name]; use Zonemaster::Engine::Logger::Entry; use Zonemaster::Engine::Translator; -use Zonemaster::Engine::Util qw[parse_hints]; +use Zonemaster::Engine::Util qw[parse_hints]; use Zonemaster::Engine::Validation qw[validate_ipv4 validate_ipv6]; our %numeric = Zonemaster::Engine::Logger::Entry->levels; @@ -142,10 +142,11 @@ sub run { 'test=s' => \@opt_test, 'time!' => \$opt_time, 'version!' => \$opt_version, - ) or do { + ) + or do { my_pod2usage( verbosity => 0, output => \*STDERR ); return 2; - }; + }; } if ( $opt_help ) { @@ -168,17 +169,19 @@ sub run { $ENV{LC_ALL} = $opt_locale; } - # Set LC_MESSAGES and LC_CTYPE separately (https://www.gnu.org/software/gettext/manual/html_node/Triggering.html#Triggering) +# Set LC_MESSAGES and LC_CTYPE separately (https://www.gnu.org/software/gettext/manual/html_node/Triggering.html#Triggering) if ( not defined setlocale( LC_MESSAGES, "" ) ) { - my $locale = ($ENV{LANGUAGE} || $ENV{LC_ALL} || $ENV{LC_MESSAGES}); - say STDERR __x( "Warning: setting locale category LC_MESSAGES to {locale} failed -- is it installed on this system?\n\n", - locale => $locale) + my $locale = ( $ENV{LANGUAGE} || $ENV{LC_ALL} || $ENV{LC_MESSAGES} ); + say STDERR __x( + "Warning: setting locale category LC_MESSAGES to {locale} failed -- is it installed on this system?\n\n", + locale => $locale ); } - + if ( not defined setlocale( LC_CTYPE, "" ) ) { - my $locale = ($ENV{LC_ALL} || $ENV{LC_CTYPE}); - say STDERR __x( "Warning: setting locale category LC_CTYPE to {locale} failed -- is it installed on this system?\n\n", - locale => $locale) + my $locale = ( $ENV{LC_ALL} || $ENV{LC_CTYPE} ); + say STDERR __x( + "Warning: setting locale category LC_CTYPE to {locale} failed -- is it installed on this system?\n\n", + locale => $locale ); } if ( $opt_version ) { @@ -203,7 +206,8 @@ sub run { if ( defined $opt_json_translate ) { unless ( $opt_json or $opt_json_stream ) { - printf STDERR __( "Warning: --json-translate has no effect without either --json or --json-stream." ) . "\n"; + printf STDERR __( "Warning: --json-translate has no effect without either --json or --json-stream." ) + . "\n"; } if ( $opt_json_translate ) { printf STDERR __( "Warning: deprecated --json-translate, use --no-raw instead." ) . "\n"; @@ -257,15 +261,16 @@ sub run { my @testing_suite; if ( @opt_test ) { - my %existing_tests = Zonemaster::Engine->all_methods; + my %existing_tests = Zonemaster::Engine->all_methods; my @existing_test_modules = keys %existing_tests; - my @existing_test_cases = map { @{ $existing_tests{$_} } } @existing_test_modules; + my @existing_test_cases = map { @{ $existing_tests{$_} } } @existing_test_modules; foreach my $t ( @opt_test ) { # There should be at most one slash character if ( $t =~ tr/\/// > 1 ) { - say STDERR __x( "Error: Invalid input '{cli_arg}' in --test. There must be at most one slash ('/') character.", - cli_arg => $t); + say STDERR __x( + "Error: Invalid input '{cli_arg}' in --test. There must be at most one slash ('/') character.", + cli_arg => $t ); return $EXIT_USAGE_ERROR; } @@ -273,43 +278,45 @@ sub run { $t = lc( $t ); my ( $module, $method ); - # Fully qualified module and test case (e.g. Example/example12), or just a test case (e.g. example12). Note the different capturing order. - if ( ( ($module, $method) = $t =~ m#^ ( [a-z]+ ) / ( [a-z]+[0-9]{2} ) $#ix ) - or - ( ($method, $module) = $t =~ m#^ ( ( [a-z]+ ) [0-9]{2} ) $#ix ) ) +# Fully qualified module and test case (e.g. Example/example12), or just a test case (e.g. example12). Note the different capturing order. + if ( ( ( $module, $method ) = $t =~ m#^ ( [a-z]+ ) / ( [a-z]+[0-9]{2} ) $#ix ) + or ( ( $method, $module ) = $t =~ m#^ ( ( [a-z]+ ) [0-9]{2} ) $#ix ) ) { # Check that test module exists - if ( grep( /^$module$/, map { lc($_) } @existing_test_modules ) ) { + if ( grep( /^$module$/, map { lc( $_ ) } @existing_test_modules ) ) { # Check that test case exists if ( grep( /^$method$/, @existing_test_cases ) ) { push @testing_suite, "$module/$method"; } else { - say STDERR __x( "Error: Unrecognized test case '{testcase}' in --test. Use --list-tests for a list of valid choices.", - testcase => $method ); + say STDERR __x( +"Error: Unrecognized test case '{testcase}' in --test. Use --list-tests for a list of valid choices.", + testcase => $method + ); return $EXIT_USAGE_ERROR; } } else { - say STDERR __x( "Error: Unrecognized test module '{module}' in --test. Use --list-tests for a list of valid choices.", - module => $module ); + say STDERR __x( +"Error: Unrecognized test module '{module}' in --test. Use --list-tests for a list of valid choices.", + module => $module + ); return $EXIT_USAGE_ERROR; } - } + } ## end if ( ( ( $module, $method...))) # Just a module name (e.g. Example) or something invalid. else { $t =~ s{/$}{}; # Check that test module exists - if ( grep( /^$t$/, map { lc($_) } @existing_test_modules ) ) { + if ( grep( /^$t$/, map { lc( $_ ) } @existing_test_modules ) ) { push @testing_suite, $t; } else { - say STDERR __x( "Error: Invalid input '{cli_arg}' in --test.", - cli_arg => $t); + say STDERR __x( "Error: Invalid input '{cli_arg}' in --test.", cli_arg => $t ); return $EXIT_USAGE_ERROR; } } - } + } ## end foreach my $t ( @opt_test ) # Start with all profile-enabled test cases my @actual_test_cases = @{ Zonemaster::Engine::Profile->effective->get( 'test_cases' ) }; @@ -324,11 +331,12 @@ sub run { # Check if more test cases need to be included in the profile foreach my $t ( @testing_suite ) { # Either a module/method, or just a module - my ( $module, $method ) = split('/', $t); + my ( $module, $method ) = split( '/', $t ); if ( $method ) { # Test case in not already in the profile, we add it explicitly and notify the user if ( not grep( /^$method$/, @actual_test_cases ) ) { - say $fh_diag __x( "Notice: Engine does not have test case '{testcase}' enabled in the profile. Forcing...", + say $fh_diag __x( + "Notice: Engine does not have test case '{testcase}' enabled in the profile. Forcing...", testcase => $method ); push @actual_test_cases, $method; } @@ -342,11 +350,11 @@ sub run { push @actual_test_cases, @{ $existing_tests{$module} }; } } - } + } ## end foreach my $t ( @testing_suite) # Configure Engine to include all of the required test cases in the profile Zonemaster::Engine::Profile->effective->set( 'test_cases', [ uniq sort @actual_test_cases ] ); - } + } ## end if ( @opt_test ) # These two must come after any profile from command line has been loaded # to make any IPv4/IPv6 option override the profile setting. @@ -391,7 +399,7 @@ sub run { module => 12, testcase => 14 ); - my %header_names = (); + my %header_names = (); my %remaining_space = (); # Callback defined here so it closes over the setup above. @@ -427,29 +435,29 @@ sub run { else { my $prefix = q{}; if ( $opt_time ) { - $prefix .= sprintf "%*.2f ", ${field_width{seconds}}, $entry->timestamp; + $prefix .= sprintf "%*.2f ", ${ field_width { seconds } }, $entry->timestamp; } if ( $opt_show_level ) { $prefix .= $opt_raw ? $entry->level : translate_severity( $entry->level ); my $space_l10n = - ${ field_width { level } } - length( decode_utf8( translate_severity( $entry_level ) ) ) + 1; + ${ field_width { level } } - length( decode_utf8( translate_severity( $entry_level ) ) ) + 1; $prefix .= ' ' x $space_l10n; } if ( $opt_show_module ) { - $prefix .= sprintf "%-*s ", ${field_width{module}}, $entry->module; + $prefix .= sprintf "%-*s ", ${ field_width { module } }, $entry->module; } if ( $opt_show_testcase ) { - $prefix .= sprintf "%-*s ", ${field_width{testcase}}, $entry->testcase; + $prefix .= sprintf "%-*s ", ${ field_width { testcase } }, $entry->testcase; } if ( $opt_raw ) { $prefix .= $entry->tag; my $message = $entry->argstr; - my @lines = split /\n/, $message; + my @lines = split /\n/, $message; printf "%s%s %s\n", $prefix, ' ', @lines ? shift @lines : ''; for my $line ( @lines ) { @@ -457,8 +465,11 @@ sub run { } } else { - if ( $entry_level eq q{DEBUG3} and scalar( keys %{$entry->args} ) == 1 and defined $entry->args->{packet} ) { - my $packet = $entry->args->{packet}; + if ( $entry_level eq q{DEBUG3} + and scalar( keys %{ $entry->args } ) == 1 + and defined $entry->args->{packet} ) + { + my $packet = $entry->args->{packet}; my $padding = q{ } x length $prefix; $entry->args->{packet} = q{}; printf "%s%s\n", $prefix, $translator->translate_tag( $entry ); @@ -470,10 +481,14 @@ sub run { printf "%s%s\n", $prefix, $translator->translate_tag( $entry ); } } - } - } + } ## end else [ if ( $opt_json and $opt_json_stream)] + } ## end if ( $numeric{ uc $entry_level...}) if ( $opt_stop_level and $numeric{ uc $entry->level } >= $numeric{$opt_stop_level} ) { - die( Zonemaster::Engine::Exception::NormalExit->new( { message => "Saw message at level " . $entry->level } ) ); + die( + Zonemaster::Engine::Exception::NormalExit->new( + { message => "Saw message at level " . $entry->level } + ) + ); } }; @@ -487,7 +502,6 @@ sub run { } ); - if ( @argv > 1 ) { say STDERR __( "Only one domain can be given for testing. Did you forget to prepend an option with '--