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';

  stderr_like(
    sub {
      exits_ok { CLI::Simple->new( commands => { foo => \&foo }, option_specs => \@options ), 1, 'called exit' }
    },
    qr/bad-option/xsmi
  );

};

########################################################################
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

  close $stdout
    or die "Could not close scalar filehandle: $OS_ERROR";

  return $output;
}

########################################################################
subtest 'USAGE is used for default help' => sub {
########################################################################
  local @ARGV;

  my $cli = CLISimpleHelpUsage->new(
    commands     => { foo => \&CLISimpleHelpUsage::cmd_foo },
    option_specs => [],
  );

  my $output = capture_usage( $cli, 'CLISimpleHelpUsage.pm' );

  like( $output, qr/LEGACY USAGE TEXT/sm, 'USAGE content displayed', );

  return;
};

########################################################################
subtest 'SYNOPSIS is used for default help' => sub {
########################################################################
  local @ARGV;

  my $cli = CLISimpleHelpSynopsis->new(
    commands     => { foo => \&CLISimpleHelpSynopsis::cmd_foo },
    option_specs => [],
  );

  my $output = capture_usage( $cli, 'CLISimpleHelpSynopsis.pm' );

  like( $output, qr/SYNOPSIS TEXT/sm, 'SYNOPSIS content displayed', );

  return;
};
########################################################################
subtest 'USAGE takes precedence over SYNOPSIS' => sub {
########################################################################
  local @ARGV;

  my $cli = CLISimpleHelpBoth->new(
    commands     => { foo => \&CLISimpleHelpBoth::cmd_foo },
    option_specs => [],
  );

  my $output = capture_usage( $cli, 'CLISimpleHelpBoth.pm' );

  like( $output, qr/LEGACY USAGE TEXT/sm, 'USAGE content displayed', );

  unlike( $output, qr/SYNOPSIS TEXT/sm, 'SYNOPSIS content suppressed', );

  return;
};

########################################################################
subtest 'explicit help_sections are honored' => sub {
########################################################################
  local @ARGV;

  my $cli = CLISimpleHelpBoth->new(
    commands     => { foo => \&CLISimpleHelpBoth::cmd_foo },
    option_specs => [],
  );

  $cli->set_help_sections( [qw(SYNOPSIS USAGE)] );

  my $output = capture_usage( $cli, 'CLISimpleHelpBoth.pm' );

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();

  $AUTO_DEFAULT = 1;

  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);

  $AUTO_DEFAULT = 1;

  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 'AUTO_HELP' => sub {
########################################################################

  local @ARGV = qw();

  $AUTO_HELP = 1;

  stdout_like(
    sub {
      exits_ok(
        sub {
          CLI::Simple->new(
            commands => {
              bar => sub { return 0; },

t/08-option-provider-resolution.t  view on Meta::CPAN

Local::Boundaries::AllCLI->use_options(
  first => { 'Local::Boundaries::First' => [qw(token)] },
);

Local::Boundaries::Unrequested->use_options(
  bad => { 'Local::Boundaries::Bad' => [qw(token)] },
);

subtest 'skip initializer and resolver when CLI supplied every requested option' => sub {
  @CALLS = ();
  local @ARGV = qw(--token cli-value);
  my $app = Local::Boundaries::AllCLI->new(
    option_specs => [qw(token=s)],
    commands     => { noop => sub { return 0; } },
  );
  is( $app->get_token, q{cli-value}, q{CLI value retained} );
  is_deeply( \@CALLS, [], q{provider was never initialized or invoked} );
};

subtest 'reject provider output outside requested names' => sub {
  local @ARGV = ();
  my $ok = eval {
    Local::Boundaries::Unrequested->new(
      option_specs => [qw(token=s)],
      commands     => { noop => sub { return 0; } },
    );
    1;
  };
  ok( !$ok, q{constructor rejects unrequested name} );
  like( $@, qr/returned unrequested option 'unexpected'/, q{useful diagnostic} );
};

subtest 'registration belongs to its application class' => sub {
  @CALLS = ();
  local @ARGV = ();
  my $app = Local::Boundaries::Isolated->new(
    option_specs    => [qw(token=s)],
    default_options => { token => q{fallback} },
    commands        => { noop => sub { return 0; } },
  );
  is( $app->get_token, q{fallback}, q{unregistered class receives its default} );
  is_deeply( \@CALLS, [], q{another application's provider is not invoked} );
};

done_testing;

t/cli-simple-selective-roles.t  view on Meta::CPAN

    use parent qw(CLI::Simple);
  }

  my $manifest = write_manifest(<<'YAML');
---
roles:
  foo: Local::Role::Foo
  bar: Local::Role::Bar
YAML

  local @ARGV = qw(foo);

  CLI::Simple->_load_manifest( 'Local::App::Single', $manifest );

  is( Local::App::Single->main, 'foo', 'selective role command runs' );

  ok( Local::App::Single->can('cmd_foo'), 'selected role was composed' );

  ok( !Local::App::Single->can('cmd_bar'), 'unselected role was not composed' );

  return;

t/cli-simple-selective-roles.t  view on Meta::CPAN

  }

  my $manifest = write_manifest(<<'YAML');
---
roles:
  publish:
    - Local::Role::Publish
    - Local::Role::Packages
YAML

  local @ARGV = qw(publish);

  CLI::Simple->_load_manifest( 'Local::App::Multiple', $manifest );

  is( Local::App::Multiple->main, 'Foo-Bar', 'all roles required by command are composed' );

  ok( Local::App::Multiple->can('cmd_publish'), 'command role was composed' );

  ok( Local::App::Multiple->can('package_name'), 'supporting role was composed' );

  return;

t/cli-simple-selective-roles.t  view on Meta::CPAN

    use parent qw(CLI::Simple);
  }

  my $manifest = write_manifest(<<'YAML');
---
commands:
  foo: Local::Role::LegacyFoo
  bar: Local::Role::LegacyBar
YAML

  local @ARGV = qw(foo);

  CLI::Simple->_load_manifest( 'Local::App::Legacy', $manifest );

  ok( !Local::App::Legacy->can('cmd_foo'), 'legacy selected role not composed during manifest load', );

  ok( !Local::App::Legacy->can('cmd_bar'), 'legacy unselected role not composed during manifest load', );

  is( Local::App::Legacy->main, 'foo', 'legacy command still runs', );

  ok( Local::App::Legacy->can('cmd_foo'), 'legacy selected role composed after selecting legacy command', );

t/cli-simple-selective-roles.t  view on Meta::CPAN

    use parent qw(CLI::Simple);
  }

  my $manifest = write_manifest(<<'YAML');
---
roles:
  publish-to-cpan: Local::Role::PublishLong
abbreviations: 1
YAML

  local @ARGV = qw(publish-to);

  CLI::Simple->_load_manifest( 'Local::App::Abbreviation', $manifest );

  is( Local::App::Abbreviation->main, 'published', 'abbreviation resolves to selective command' );

  ok( Local::App::Abbreviation->can('cmd_publish_to_cpan'), 'canonical command role was composed' );

  return;
};

t/cli-simple-selective-roles.t  view on Meta::CPAN

  my $manifest = write_manifest(<<'YAML');
---
roles:
  publish-to-cpan: Local::Role::PublishAlias
alias:
  commands:
    pub: publish-to-cpan
YAML

  local @ARGV = qw(pub);

  CLI::Simple->_load_manifest( 'Local::App::Alias', $manifest );

  is( Local::App::Alias->main, 'published', 'alias dispatches to canonical selective command' );

  ok( Local::App::Alias->can('cmd_publish_to_cpan'), 'canonical command method was composed' );

  ok !Local::App::Alias->can('cmd_pub'), 'alias does not require a separate command method';

  return;

t/cli-simple-selective-roles.t  view on Meta::CPAN

    use parent qw(CLI::Simple);
  }

  my $manifest = write_manifest(<<'YAML');
---
roles:
  foo: Local::Role::NoCommand
YAML

  local @ARGV = qw(foo);

  CLI::Simple->_load_manifest( 'Local::App::MissingCommand', $manifest );

  eval { Local::App::MissingCommand->main; };

  like( $@, qr/roles for command 'foo' do not implement cmd_foo/, 'selected role set must provide command method' );

  return;
};

t/log-level-precedence.t  view on Meta::CPAN

  __PACKAGE__->use_log4perl( level => 'error' );
}

my $commands = {
  plain  => sub { return 0 },
  logged => [ sub { return 0 }, 'debug' ],
};

subtest 'application default' => sub {
  local @ARGV = ('plain');

  my $cli = Local::LogLevelTest->new(
    option_specs => ['log-level=s'],
    commands     => $commands,
  );

  is( $cli->get_log_level,     'error',               'application default selected' );
  is( $cli->get_logger->level, $Log::Log4perl::ERROR, 'logger uses application default' );
};

subtest 'command-specific level' => sub {
  local @ARGV = ('logged');

  my $cli = Local::LogLevelTest->new(
    option_specs => ['log-level=s'],
    commands     => $commands,
  );

  is( $cli->get_log_level,     'debug',               'command level overrides default' );
  is( $cli->get_logger->level, $Log::Log4perl::DEBUG, 'logger uses command level' );
};

subtest 'explicit CLI level' => sub {
  local @ARGV = ( '--log-level', 'warn', 'logged' );

  my $cli = Local::LogLevelTest->new(
    option_specs => ['log-level=s'],
    commands     => $commands,
  );

  is( $cli->get_log_level,     'warn',               'CLI level overrides command level' );
  is( $cli->get_logger->level, $Log::Log4perl::WARN, 'logger uses CLI level' );
};