CLI-Simple

 view release on metacpan or  search on metacpan

t/01-cli-simple.t  view on Meta::CPAN

my @options = qw(
  foo
  bar=s
);

########################################################################
subtest 'happy path' => sub {
########################################################################

  local @ARGV = qw(--foo --bar=buz foo);

  my $app = CLI::Simple->new( commands => { foo => \&foo }, option_specs => \@options );

  ok( $app->get_foo,          'foo set' );
  ok( $app->get_bar eq 'buz', 'bar set' );
};

########################################################################
subtest 'bad option' => sub {
########################################################################

  local @ARGV = '--bad-option foo';

  exits_ok { CLI::Simple->new( commands => { foo => \&foo }, option_specs => \@options ), 1, 'called exit' };
};

########################################################################
subtest 'option alias' => sub {
########################################################################

  local @ARGV = qw(--foo --bar=buz foo);

  my $app = CLI::Simple->new(
    commands     => { foo     => \&foo },
    alias        => { options => { biz => 'bar' } },
    option_specs => \@options
  );

  ok( $app->get_foo,          'foo set' );
  ok( $app->get_bar eq 'buz', 'bar set' );
  ok( $app->get_biz eq 'buz', 'biz set' );

  local @ARGV = qw(--foo --biz=buz foo);

  $app = CLI::Simple->new(
    commands     => { foo     => \&foo },
    alias        => { options => { biz => 'bar' } },
    option_specs => \@options
  );

  ok( $app->get_foo,          'foo set' );
  ok( $app->get_bar eq 'buz', 'bar set' );
  ok( $app->get_biz eq 'buz', 'biz set' );
};

########################################################################
subtest 'run' => sub {
########################################################################
  local @ARGV = qw(--foo --bar=buz foo);

  my $app = CLI::Simple->new(
    commands     => { foo     => \&foo },
    alias        => { options => { biz => 'bar' } },
    option_specs => \@options
  );

  stdout_is( sub { $app->run() }, 'Hello World!' );
};

########################################################################
subtest 'alias precedence and symmetry' => sub {
########################################################################
  local @ARGV = qw(--bar=2 --biz=9 go);  # biz is alias for bar

  my $got;

  my $app = CLI::Simple->new(
    commands     => { go      => sub { $got = \%ENV } },  # or capture parsed opts via a hook
    alias        => { options => { biz => 'bar' } },
    option_specs => ['bar=i'],
  );

  # however you surface parsed options, assert both entries reflect last value
  is( $app->get_bar, 2, 'canonical reflects first' );
  is( $app->get_biz, 2, 'alias mirrors canonical' );
};

########################################################################
subtest 'command alias' => sub {
########################################################################
  local @ARGV = qw(--foo --bar=buz fiz);

  my $app = CLI::Simple->new(
    commands     => { foo     => \&foo },
    alias        => { options => { biz => 'bar' }, commands => { fiz => 'foo' } },
    option_specs => \@options
  );

  stdout_is( sub { $app->run() }, 'Hello World!' );
};

########################################################################
subtest 'command abbreviations' => sub {
########################################################################
  local @ARGV = qw(--foo --bar=buz fuzz);

  my $app = CLI::Simple->new(
    commands      => { fuzzball => \&foo },
    alias         => { options  => { biz => 'bar' } },
    option_specs  => \@options,
    abbreviations => 1,
  );

  stdout_is( sub { $app->run() }, 'Hello World!' );

  local @ARGV = qw(--foo --bar=buz fuzz);

  eval {
    CLI::Simple->new(
      commands => {
        fuzzball => \&foo,
        buzzball => sub { return 0; },
      },
      alias        => { options => { biz => 'bar' } },
      option_specs => \@options
    )->run();
  };

  my $err = $EVAL_ERROR // q{};

  like( $err, qr/unknown\s+command/xsmi, 'bad command' );
};

########################################################################
subtest 'ambiguous abbrev croaks' => sub {
########################################################################
  local @ARGV = qw(run);  # both runit and runner exist

  eval {
    CLI::Simple->new(
      commands      => { runit => sub { }, runner => sub { } },
      abbreviations => 1,
      option_specs  => [],
    )->run;
  };

  my $err = $EVAL_ERROR;

t/02-cli-simple-logging.t  view on Meta::CPAN

my @options = qw(
  foo
  bar=s
);

########################################################################
subtest 'logging' => sub {
########################################################################
  CLI::Simple->use_log4perl(level => 'info');

  local @ARGV = qw(--foo --bar=buz foo);

  my $app = CLI::Simple->new( commands => { foo => \&foo }, option_specs => \@options );

  stderr_like(sub { $app->get_logger->info('hello world') }, qr/hello\sworld/xsm);
};

done_testing;

1;

t/03-cli-simple-types.t  view on Meta::CPAN

use Test::More;
use Test::Exit;
use Test::Output;

use_ok(qw(CLI::Simple));

########################################################################
subtest 'type mismatch croaks' => sub {
########################################################################
  local @ARGV = qw(--count foo go);

  stderr_like(
    sub {
      exits_ok {
        CLI::Simple->new(
          commands     => { go => sub { } },
          option_specs => ['count=i'],
        )->run,
        1,
        'exits on option error'
      }
    },
    qr/invalid\sfor\soption\scount/xsmi
  );
};

########################################################################
subtest 'multi options accumulate' => sub {
########################################################################
  local @ARGV = qw(--tag a --tag b go);

  my $seen;

  CLI::Simple->new(
    commands => {
      go => sub {
        my ($self) = @_;
        $seen = $self->get_tag;
      }
    },

t/04-cli-simple-help.t  view on Meta::CPAN

 blah blah

=cut

package main;

use strict;
use warnings;

local @ARGV = qw(--help);

local $ENV{PAGER}   = q{};
local $ENV{PERLDOC} = q{};

########################################################################
subtest 'help' => sub {
########################################################################
  stdout_like(
    sub {
      exits_ok {

t/05-cli-simple-args.t  view on Meta::CPAN

my @options = qw(
  foo
  bar=s
);

########################################################################
subtest 'get_args' => sub {
########################################################################

  local @ARGV = qw(foo bar biz buz);

  my $app = CLI::Simple->new(
    commands     => { foo => sub { return 0 } },
    option_specs => \@options
  );

  my @args = $app->get_args();

  # - get list of all args
  ok( 3 == @args,                        'got three args' );

t/06-cli-simple-default.t  view on Meta::CPAN

my @options = qw(
  foo
  bar=s
);

########################################################################
subtest 'one command' => sub {
########################################################################

  local @ARGV = qw();

  my $app = CLI::Simple->new( commands => { foo => sub { print "Hello World\n"; return 0; } } );

  stdout_like( sub { $app->run(); }, qr/hello/xsmi, 'defaults to only command' );
};

########################################################################
subtest 'one command w/args' => sub {
########################################################################

  local @ARGV = qw(bar biz);

  my $app = CLI::Simple->new( commands => { foo => sub { print join q{,}, $_[0]->get_args; return 0; } } );

  stdout_like( sub { $app->run(); }, qr/bar,biz/xsmi, 'defaults to only command' );
};

########################################################################
subtest 'default' => sub {
########################################################################

  local @ARGV = qw();

  my $app = CLI::Simple->new(
    commands => {
      bar => sub { return 0; },
      foo => sub { print "Hello World\n"; return 0; }
    }
  );

  stdout_like(
    sub {