CLI-Osprey

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

    };

};

t/basic.t  view on Meta::CPAN

            my ($option_name) = @_;
            my %attrs = %{ $options{$option_name} };
            my $getopt = CLI::Osprey::Role::_osprey_option_to_getopt($option_name, %attrs);
            note("$option_name getopt string: $getopt");
            return $getopt;
        };

        # Helper function: run yell command and capture output
        my $run_yell_command = sub {
            my (@args) = @_;
            local @ARGV = ('yell', @args);
            local *CORE::exit = sub { };  # Prevent exit() from terminating test process
            my ($stdout, $stderr, @result) = capture { MyTest::Class::Basic->new_with_options->run };
            return ($stdout, $stderr);
        };

        # Helper function: run yell command and test output
        my $test_yell_command = sub {
            my ($args, $stdout_pattern, $description) = @_;
            my ($stdout, $stderr) = $run_yell_command->(@$args);
            like($stdout, $stdout_pattern, $description);

t/basic.t  view on Meta::CPAN

            subtest "custom option + other options" => sub {
                $test_yell_command->([qw(-f xml --add-suffix), '[ZAP]', qw(--excitement-level 1)],
                                 qr{\Q<yell>HELLO WORLD!![ZAP]</yell>\E},
                                 "custom suffix combined with format and excitement");
            };
        };
    };

    subtest "inline subcommand" => sub {
        local @ARGV = qw ( whisper );
        local *CORE::exit = sub { };
        my ($stdout, $stderr) = capture { MyTest::Class::Basic->new_with_options->run };
        is ( $stdout, "hello world!\n", "message sent to stdout" );
        is ( $stderr, '', "empty stderr" );
    };

};

done_testing;