in reply to Re^2: Enforce single hyphen for single character options in Getopt::Long
in thread Enforce single hyphen for single character options in Getopt::Long
sub parse_option( @conf ) { ... my $option; ... try { # Use incremented value type to count number of times options ma +tched. GetOptions( 'option|o+' => \$option ) or die $!; $show_progress and warn qq[option set: $option]; } catch { warn qq[Option parsing failed of @arg: $_]; ## CHANGED. # Need to set so as death of "GetOptions" does not. $option = undef; } ; return $option; }
With above change, the 3 sets of options now also behave the same for both inputs of --o & -o --o.
# getopt-test-combination.pl use v5.32; use warnings; use feature q[signatures]; # Intermix debug output with standard output. $|++; use Algorithm::Combinatorics qw[ combinations ]; use Getopt::Long; use List::Util qw[ any ]; use Try::Tiny; use Test2::V0 qw[ like done_testing ]; my $Getopt_debug = 0; my $show_progress = 0; my $indent_2 = q[ ] x 2; my $indent_4 = q[ ] x 4; # Keys are split on space to set @ARGV for "GetOptions" sub. my %expected = ( # Options => [ expected value(s) ]. # # XXX: Reason for value being an array ref, not a plain scalar: # The long option with "--" prefix should be always be parse +d as valid # with "long_prefix_pattern=--" configuration option. # # Tolerate the long option with "-" prefix as valid IFF that + makes # single letter option with "--" prefix as invalid. q[-o] => [ 1 ], q[--o] => [ undef ], q[-o --o] => [ undef ], q[-option] => [ undef, 1], q[--option] => [ 1 ], q[-o --option] => [ 2 ], q[-o -option] => [ undef, 2 ], q[-o -option --option] => [ undef, 3 ] ); # Option inputs, same as above keys. my @order = ( q[-o], q[-o --o], q[--o], # Uncomment to test as needed. #q[-option], #q[--option], #q[-o --option], #q[-o -option], #q[-o -option --option] ); # To Iterate over combinations of Getopt::Long configuration options. my @conf_opt = qw[ prefix=- long_prefix_pattern=-- posix_default no_posix_default getopt_compat no_getopt_compat gnu_compat no_gnu_compat ]; my $conf_opt_size = scalar @conf_opt; for my $k ( 0..$conf_opt_size ) { for my $conf ( combinations( \@conf_opt, $k ) ) { run_conf_test( @{ $conf } ); } } done_testing(); exit; sub account_for_undef( $val ) { return $val // q[<undef>]; } sub list_as_string( @list ) { return q[( ] . join( q[, ], map( account_for_undef( $_ ), @list ) ) . q[ )] ; } # To match any value in "$need" array ref. sub match_expected( $val, $need ) { if ( ! defined $val ) { return any { ! defined } @{ $need }; } return any { defined $_ && $val == $_ } @{ $need }; } sub run_conf_test( @conf ) { my $conf_str = list_as_string( @conf ); $show_progress and warn qq[> Configuration: $conf_str]; for my $input ( @order ) { my $need = $expected{ $input }; my $need_str = list_as_string( @{ $need } ); @ARGV = split q[ ], $input; my $val = parse_option( @conf ); my $test_id = sprintf( qq[input: %s; parsed: %s; conf: %s], $input, account_for_undef( $val ), $conf_str ); my @test_diag = ( qq[need any: $need_str] ); my $matched; like( $val, sub { $matched = match_expected( $_, $need ); $matched }, $test_id, @test_diag ); if ( $show_progress ) { warn sprintf qq[>> %s%s; %s\n>> %sas expected? %s], $indent_2, $test_id, list_as_string( @test_diag ), $indent_4, account_for_undef( $matched ) ; warn qq[\n\n]; } } } sub parse_option( @conf ) { if ( ! grep { defined } @conf ) { @conf = (); } if ( $Getopt_debug ) { push @conf, q[debug] ; } #warn list_as_string( @conf ); Getopt::Long::Configure( @conf ); # For error message. my @arg = @ARGV; my $option; try { $show_progress and warn qq[** in-try, parsing: @ARGV ...]; # Use incrementing value type to count number of times options m +atched. GetOptions( 'option|o+' => \$option ) or die $!; $show_progress and warn qq[post-die, option set: ], account_for_undef( $opti +on ); } catch { warn qq[in-catch, option parsing failed for @arg]; $option = undef; } ; $show_progress and warn qq[post-try, option set: ], account_for_undef( $option +); return $option; }
|
|---|