view release on metacpan or  search on metacpan

t/V1/15-spec-from-hash-or-mod.t  view on Meta::CPAN

      bar => { # the spec for this is here, implementation in module Bar
         help        => 'sub-command bar',
         description => 'first-level sub-command bar',
         options     => [],
         execute     => 'Bar',
      },
   },
};

subtest 'help' => sub {
   test_run($app, ['help'], {}, undef)->no_exceptions->stdout_like(
      qr{(?mxs:
         example \s+ command .*?
         An \s+ example \s+ command .*?
         --foo .*
         GALOOK_BAR .*?
         help .*?
         commands .*?
      )}, 'output of help command'
   )->stdout_like(qr{sub-command foo})->stdout_like(qr{sub-command bar});
};

subtest 'foo help' => sub {
   test_run($app, ['foo', 'help'], {}, undef)->no_exceptions->stdout_like(
      qr{(?mxs:
         sub-command \s+ foo .*?
         first-level \s+ sub-command \s+ foo .*?
         --hey .*
         help .*?
         commands .*?
      )}, 'output of help command'
   )->stdout_like(qr{sub-sub-command baz});
};

subtest 'help foo' => sub {
   test_run($app, ['help', 'foo'], {}, undef)->no_exceptions->stdout_like(
      qr{(?mxs:
         sub-command \s+ foo .*?
         first-level \s+ sub-command \s+ foo .*?
         --hey .*
         help .*?
         commands .*?
      )}, 'output of help command'
   )->stdout_like(qr{sub-sub-command baz});
};

subtest 'foo help baz' => sub {
   test_run($app, ['foo', 'help', 'baz'], {}, undef)
     ->no_exceptions->stdout_like(
      qr{(?mxs:
         sub-sub-command \s+ baz .*?
         second-level \s+ sub-command \s+ baz .*?
         --last .*
      )}, 'output of help command'
   )->stdout_like(qr{sub-sub-command baz});
};

subtest 'foo baz 1' => sub {
   test_run($app, ['foo', 'baz'], {}, 'baz')
     ->no_exceptions->result_is('BAZ')->stdout_like(qr{baz on out})
     ->stderr_like(qr{baz on err});
};

subtest 'foo baz 2' => sub {
   test_run($app, [qw< --foo foo --hey you baz --last 12 FP >], {}, 'baz')
     ->no_exceptions->result_is('BAZ')
     ->conf_is({foo => 1, bar => 'buzz', hey => 'you', last => 12})
     ->args_are(['FP'])->stdout_like(qr{baz on out})
     ->stderr_like(qr{baz on err});
};

subtest 'foo (leveraging default sub-child)' => sub {
   test_run($app, ['foo'], {}, 'baz')->no_exceptions->result_is('BAZ')
     ->stdout_like(qr{baz on out})->stderr_like(qr{baz on err});
};

subtest 'Foo (uppercase, leveraging default sub-child)' => sub {
   test_run($app, ['Foo'], {}, 'baz')->no_exceptions->result_is('BAZ')
     ->stdout_like(qr{baz on out})->stderr_like(qr{baz on err});
};

subtest 'Foo commands (note uppercase)' => sub {
   test_run($app, [qw< Foo commands >], {}, undef)
     ->no_exceptions->stdout_like(qr{(?mxs:help: .*? commands:)});
};

subtest 'bar' => sub {
   test_run($app, ['bar'], {}, 'bar')->no_exceptions->result_is('Bar')
     ->stdout_like(qr{bar on out})->stderr_like(qr{bar on err});
};

subtest 'help bar' => sub {
   test_run($app, ['help', 'bar'], {}, undef)->no_exceptions->stdout_like(
      qr{(?mxs:
         sub-command \s+ bar .*?
         first-level \s+ sub-command \s+ bar .*?
         has \s+ no \s+ options
      )}, 'output of help command'
   );
};

subtest 'bar help (help is ignored)' => sub {
   test_run($app, [qw< bar help >], {}, undef)
     ->no_exceptions->stdout_like(qr{bar on out})
     ->stderr_like(qr{bar on err});
};

done_testing();


package Foo;
sub spec {
   return {
      help        => 'sub-command foo',
      description => 'first-level sub-command foo',
      supports    => ['foo', 'Foo'],
      options     => [
         {
            getopt => 'hey|h=s',
         },
      ],
      children        => ['Baz'],
      'default-child' => 'Baz',
   };
}

package Bar;
sub execute ($main, $conf, $args) {
   print {*STDOUT} 'bar on out';
   print {*STDERR} 'bar on err';
   return 'Bar';
};

package Baz;
sub spec {
   return {
      help        => 'sub-sub-command baz',
      description => 'second-level sub-command baz',
      supports    => ['baz'],
      options     => [
         {
            getopt => 'last|l=i',
         },
      ],
      execute => 'Baz',
   };
}
sub execute {
   LocalTester::command_execute(baz => @_);
   print {*STDOUT} 'baz on out';
   print {*STDERR} 'baz on err';
   return 'BAZ';
}

1;