view release on metacpan or  search on metacpan

lib/CLI/Osprey/Role.pm  view on Meta::CPAN

);

has 'invoked_as' => (
  is => 'ro',
);

sub new_with_options {
  my ($class, %params) = @_;
  my %config = $class->_osprey_config;

  local @ARGV = @ARGV if $config{protect_argv};

  if (!defined $params{invoked_as}) {
    $params{invoked_as} = Getopt::Long::Descriptive::prog_name();
  }

  my ($parsed_params, $usage) = $class->parse_options(%params);

  if ($parsed_params->{h}) {
    return $class->osprey_usage(1, $usage);
  } elsif ($parsed_params->{help}) {

lib/CLI/Osprey/Role.pm  view on Meta::CPAN

}

sub osprey_usage {
  my ($class, $code, @messages) = @_;

  my $usage;

  if (@messages && blessed($messages[0]) && $messages[0]->isa('CLI::Osprey::Descriptive::Usage')) {
    $usage = shift @messages;
  } else {
    local @ARGV = ();
    (undef, $usage) = $class->parse_options(help => 1);
  }

  my $message;
  $message = join("\n", @messages, '') if @messages;
  $message .= $usage . "\n";

  if ($code) {
    CORE::warn $message;
  } else {
    print $message;
  }
  exit $code if defined $code;
  return;
}

sub osprey_help {
  my ($class, $code, $usage) = @_;

  unless (defined $usage && blessed($usage) && $usage->isa('CLI::Osprey::Descriptive::Usage')) {
    local @ARGV = ();
    (undef, $usage) = $class->parse_options(help => 1);
  }

  my $message = $usage->option_help . "\n";

  if ($code) {
    CORE::warn $message;
  } else {
    print $message;
  }
  exit $code if defined $code;
  return;
}

sub osprey_man {
  my ($class, $usage, $output) = @_;

  unless (defined $usage && blessed($usage) && $usage->isa('CLI::Osprey::Descriptive::Usage')) {
    local @ARGV = ();
    (undef, $usage) = $class->parse_options(man => 1);
  }

  my $tmpdir = Path::Tiny->tempdir;
  my $podfile = $tmpdir->child("help.pod");
  $podfile->spew_utf8($usage->option_pod);

  require Pod::Usage;
  Pod::Usage::pod2usage(
    -verbose => 2,

t/basic.t  view on Meta::CPAN

use Test::More;
use Capture::Tiny qw( capture );

use Test::Lib;
use MyTest::Class::Basic;

subtest 'command' => sub {

    subtest "default options" => sub {
	local @ARGV = ();
	my ( $stdout, $stderr, @result ) =
	   capture { MyTest::Class::Basic->new_with_options->run };

	is ( $stdout, "Hello world!\n", "message sent to stdout" );
	is ( $stderr, '', "empty stderr" );

    };

    subtest "command line options" => sub {
	local @ARGV = ( '--message', 'Hello Cleveland!' );
	my ( $stdout, $stderr, @result ) =
	   capture { MyTest::Class::Basic->new_with_options->run };

	is ( $stdout, "Hello Cleveland!\n", "message sent to stdout" );
	is ( $stderr, '', "empty stderr" );

    };

};

subtest 'subcommand' => sub {

    subtest "default options" => sub {
	local @ARGV = qw ( yell );
	my ( $stdout, $stderr, @result ) =
	   capture { MyTest::Class::Basic->new_with_options->run };

	is ( $stdout, "HELLO WORLD!\n", "message sent to stdout" );
	is ( $stderr, '', "empty stderr" );
    };

    subtest "hyphenated options" => sub {
	local @ARGV = qw ( yell --excitement-level 2 );
	my ( $stdout, $stderr, @result ) =
	   capture { MyTest::Class::Basic->new_with_options->run };

	is ( $stdout, "HELLO WORLD!!!\n", "message sent to stdout" );
	is ( $stderr, '', "empty stderr" );
    };

    subtest "inline" => sub {
	local @ARGV = qw ( whisper );
	my ( $stdout, $stderr, @result ) =
	   capture { MyTest::Class::Basic->new_with_options->run };

	is ( $stdout, "hello world!\n", "message sent to stdout" );
	is ( $stderr, '', "empty stderr" );
    };

};

done_testing;