The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
use strict;
use warnings;
use Test::More;

use lib 'lib';

our $THIS_TEST_HAS_TESTS  = 17;
our $THIS_BLOCK_HAS_TESTS = 0;

plan( tests => $THIS_TEST_HAS_TESTS );


use Getopt::LL qw(getoptions);

my $argv = [qw( --jumps over -X --the lazy -dawg 10 the -f myfile.txt -- --quick brown -fox)];

print '__ARGV__[]: ', join(q{ }, map { "[$_]" } @{ $argv }), "\n";


my $option_X_is_set = 0;
my $out_to_stdout   = 0;

my $rules = {
    '--jumps'    => 'string',
    '--the'     => 'string', #{ type => 'string', default => 'monster' },
    '-d'     => 'flag',
    '-a'     => 'flag',
    '-w'     => 'flag',
    '-g'     => 'digit',
    '--quick'   => 'flag',
    '--try'     => { type => 'string', default => 'harder' },
    '-X'        => sub {
        $option_X_is_set = 1;
        is( $_[0]->get_prev_arg($_[1]), '--jumps', 'get_prev_arg' );
    },
    '-f'        => sub {
        my ($self, $node) = @_;
        is($self->peek_prev_arg($node), 'the', 'peek_prev_arg');
        my $next = $self->get_next_arg($node);
    
        is($next, 'myfile.txt', 'get_next_arg');
        is($self->peek_next_arg($node), '--', 'peek_next_arg');
        if ($next eq '-') {
            $out_to_stdout = 1;
        }

        return $next;
    }
            

};

my $getopt_options = {
   die_on_type_mismatch => 0,
   silent               => 1,
   style                => 'GNU',
   allow_unspecified    => 1,
};

my $result = getoptions($rules, $getopt_options, $argv);

ok( $option_X_is_set,  'option_X_is set. (rule -X => sub { })' );
ok(!$out_to_stdout,    'option -f != -'                        );
is($result->{'-f'},    'myfile.txt',
    '-f = myfile.txt'
);
is($result->{'--the'},  'lazy',
    '--the = lazy'
); 
is($result->{'-d'}, 1,
    '-d = 1'
);
is($result->{'-a'}, 1,
    '-a = 1'
);
is($result->{'-w'}, 1,
    '-w = 1'
);
is($result->{'-g'}, 10,
    '-g = 10'
);
is($result->{'--jumps'}, 'over',
    '--jumps = over'
);

is( $ARGV[0], 'the' ,  'ARGV[0] == the'  );
is( $ARGV[1], '--quick', 'ARGV[1] == --quick');
is( $ARGV[2], 'brown',   'ARGV[2] == brown'  );
is( $ARGV[3], '-fox',   'ARGV[2] == -fox'  );