view release on metacpan or  search on metacpan

t/V2/22.custom-sources.t  view on Meta::CPAN

use LocalTester;

my $file_prefix = __FILE__ =~ s{\.t\z}{}rmxs;
my $json_config = "$file_prefix.json";

my $app = {
   aliases     => ['parent'],
   help        => 'example command',
   options     => [
      map {;
         {
            getopt      => "$_=s",
            environment => 1,
            default     => $_,

            custom_data => "whatever-$_",
         };
      } qw< one two three four five >,
   ],
   default_child => '-self',
   execute => \&execute,
   sources =>
      [
         qw< +CmdLine +Environment +Default=100 >,
         'Foo::custom_source_foo=50',
         [\&custom_source_main, 'first'],
         [\&custom_source_main, {priority => 45}, qw< second BAZ >],
      ],
};

subtest 'no args on cmd line' => sub {
   test_run($app, [], {}, 'parent')
      ->no_exceptions
      ->result_is(42)
      ->conf_is(
         {
            one => 'FIRST',
            two => 'two',
            three => 'BAZ',
            four => 'four',
            five => 'five',
            foo => 'custom_source_foo',
            bar => 'first',
            baz => 'second',
         }
      );
};

done_testing();

sub custom_source_main ($instance, $opts, $args) {
   my @opts = $opts->@*;
   my %retval = (baz => $opts[0]);
   $retval{bar} = $opts[0] unless $instance->config('bar');
   $retval{three} = $opts[1] if @opts > 1;
   return \%retval;
}

sub execute ($self) {
   LocalTester::command_execute($self);
   say 'whatever';
   return 42;
}


package Foo;
use v5.24;
sub custom_source_foo ($instance, $opts, $args) {
   return {
      one => 'FIRST',
      three => 'THIRD',
      foo => 'custom_source_foo',
      baz => 'custom_source_foo',
   };
}

__END__
# All tests should now apply to both the parent and the child
for my $who (qw< parent child >) {
   my %conf = map { $_ => $_ } qw< one two three four five >;
   my (@args, %env);

   if ($who eq 'child') { # add stuff for child command
      @args = 'child';
      $conf{six} = 'six';
   }

   subtest "$who, all defaults, baseline" => sub {
      test_run($app, \@args, \%env, $who)
         ->no_exceptions
         ->result_is(ucfirst $who)
         ->conf_is(\%conf)
         ->args_are([])
         ->stdout_like(qr{$who on out})
         ->stderr_like(qr{$who on err});
   };

   push @args, '--one', $conf{one} = 'cmdline-one';
   subtest "$who, cmdline on ONE", => sub {
      test_run($app, \@args, \%env, $who)->no_exceptions->conf_is(\%conf);
   };

   $env{ONE} = 'whatever, this does not go'; # cmdline overrides this
   $env{TWO} = $conf{two} = 'environment-two'; # this goes over default
   subtest "$who, cmdline on ONE, environment on ONE and TWO" => sub {
      test_run($app, \@args, \%env, $who)->no_exceptions->conf_is(\%conf);
   };

   # will read from JSON file and stuff will be added. one and two are
   # left unchanged because it's how precedence works
   %conf = (
      one => 'cmdline-one',                # cmdline wins over all
      two => 'environment-two',            # then environment
      three => 'jsonconf-three',           # then config file
      four => 'four',                      # then default
      five => 'five',                      # ditto
      six => 'jsonconf-six',               # additional stuff from file
      additional => 'jsonconf-additional', # cmdline
      config => $json_config,
   );