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 01/11] 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 4ded822..7301bf2 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 '--