Applify

 view release on metacpan or  search on metacpan

lib/Applify.pm  view on Meta::CPAN

our $PERLDOC       = 'perldoc';
our $SUBCMD_PREFIX = 'command';
our $VERSION = '0.23';
my $ANON = 0;

sub app {
  my $self = shift;
  $self->{app} = shift if @_;

  # Activate sub command
  local @ARGV = @ARGV;
  shift @ARGV if $self->_subcommand_activate($ARGV[0]);

  my (%argv, @spec);
  $self->_run_hook(before_options_parsing => \@ARGV);

  for my $option (@{$self->options}, @{$self->_default_options}) {
    push @spec, $self->_calculate_option_spec($option);
    $argv{$option->{name}} = $option->{n_of} ? [] : undef;
  }

t/alias.t  view on Meta::CPAN

is_deeply(run(qw(-i 42)),    undef, 'alias -i not defined');
is_deeply(run(qw(--age 43)), 43,    'but --age is defined');

$script->{options}[0]{alias} = ['i'];
is_deeply(run(qw(-i 44)), 44, 'alias -i defined');

done_testing;

sub run {
  local @ARGV = @_;
  return $script->app->age;
}

t/exits.t  view on Meta::CPAN

version '1';
app { 0 };
HERE

{
  my $exited = 0;
  local *CORE::GLOBAL::exit = sub (;$) { $exited = 1; };
  ## eval bakes in exit as overridden above
  my $app = eval "$code" or die $@;
  is $exited, 0, 'no exit yet';
  local @ARGV = ('-help');
  my $return = $app->_script->app->run;
  is $return, 0, 'returned zero';
  is $exited, 1, 'print_help';

  *CORE::GLOBAL::exit = *CORE::exit;
}

{
  my $exited = 0;
  local *CORE::GLOBAL::exit = sub (;$) { $exited = 1; };
  my $app = eval "$code" or die $@;
  is $exited, 0, 'no exit yet';
  local @ARGV = ('-man');
  my $return = $app->_script->app->run;
  is $return, 0, 'returned zero';
  is $exited, 1, 'man';

  *CORE::GLOBAL::exit = *CORE::exit;
}

{
  my $exited = 0;
  local *CORE::GLOBAL::exit = sub (;$) { $exited = 1; };
  my $app = eval "$code" or die $@;
  is $exited, 0, 'no exit yet';
  local @ARGV = ('-version');
  my $return = $app->_script->app->run;
  is $return, 0, 'returned zero';
  is $exited, 1, 'version';

  *CORE::GLOBAL::exit = *CORE::exit;
}

{
  my $exited = 0;
  local *CORE::GLOBAL::exit = sub (;$) { $exited = 5 * shift; };
  my $app = eval <<'HERE' or die $@;
package main;
use Applify;
app { shift->_script->_exit(5) };
HERE
  is $exited, 0, 'no exit yet';
  local @ARGV = ('-version');
  my $return = $app->_script->app->run;
  is $return, 25, 'returned zero';
  is $exited, 25, 'exited!';

  *CORE::GLOBAL::exit = *CORE::exit;
}

done_testing;

=pod

t/file-dir.t  view on Meta::CPAN

option file => output => 'output file', default => 'example/output.txt', isa => 'TestApp::File';
option file => path_string => 'path as a string only';
option file => failsafe => 'path as a string only - spurious class', isa => 'Not::Existing';
option str => check => 'simple';
app {};
HERE

my $script = $app->_script;

{
  local @ARGV = ('--directory', '.', '--path', 'bin', '--failsafe', '/tmp');
  my $app = $script->app;
  isa_ok $app->directory, 'TestApp::File', 'directory option';
  isa_ok $app->output,    'TestApp::File', 'default';
  is $app->output,           'example/output.txt', 'output file default';
  is ref($app->path_string), '',                   'path is a string not one of those objects';
  is ref($app->failsafe),    '',                   'failsafe is a string not one of those objects';
}

{
  local @ARGV = ('--directory', 'example');
  my $app = $script->app;
  isa_ok $app->directory, 'TestApp::File', 'directory option';
  ok -d $app->directory, 'directory exists and is a directory';
}

{
  local @ARGV = ('--config', 'example/moo.pl');
  my $app = $script->app;
  isa_ok $app->config_file, 'TestApp::File', 'config option';
  ok -e $app->config_file, '"config file" exists';
}

{
  local @ARGV = ('--file', 'example/moo.pl');
  my $app = $script->app;
  isa_ok $app->file_list, 'ARRAY', 'file list option';
  is @{$app->file_list}, 1, 'correct # of files';
  my ($first) = @{$app->file_list};
  ok -e $first, 'file exists';
}

{
  local @ARGV = ('--file', 'example/moo.pl', '--file', 'example/test1.pl');
  my $app = $script->app;
  isa_ok $app->file_list, 'ARRAY', 'file list option ';
  ok -e $_, 'file exists' for @{$app->file_list};
  is @{$app->file_list}, 2, 'correct # of files';
  isa_ok $_, 'TestApp::File', 'file is a TestApp::File' for @{$app->file_list};
}


is_deeply(run('--directory' => 'example', '--check' => 'this'), ['example', undef], 'undef');

is_deeply(run('--directory' => 'example', '--config' => 'test'), ['example', 'test'], 'this test');

is_deeply(run('--directory' => 'example', '--file' => 'test1', '--file' => 'test2'), ['example', undef], 'this test');

done_testing;

sub run {
  local @ARGV = @_;
  my $app = $script->app;
  return [$app->directory, $app->config_file];
}

t/hook.t  view on Meta::CPAN

app {$ENV{TEST_EXIT_CODE}};
HERE

$ENV{TEST_EXIT_CODE} = 42;
my $script = $app->_script;

ok_option_parser_config([qw(no_auto_help no_auto_version pass_through)], 'original option_parser config');

eval {
  local @ARGV = qw(a b c);
  $script->app;
  ok 0, 'should never come to this';
} or do {
  like $@, qr{^before_exit:42}, 'before_exit';
  is $ENV{TEST_OPTIONS}, 'a:b:c', 'before_options_parsing argv';
  ok_option_parser_config([qw(no_auto_help no_auto_version bundling no_pass_through)], 'modified option_parser config');
};

done_testing;

t/moose.t  view on Meta::CPAN

    package My::Class;
    use Moose;
    has exit_value => (is => 'ro', default => 123);
    has o_foo => (is => 'ro', lazy_build => 1);
    sub _build_foo { -1 }
    sub do_stuff { print "some stuff...\n" }
    __PACKAGE__->meta->make_immutable;
    $INC{'My/Class.pm'} = 'MOCK';
  ] or die $@;

  local @ARGV = qw(--o-bar 24 --o-foo 42);
  my $app = eval q[
    use Applify;
    extends 'My::Class';
    option int => o_foo => 'Some option';
    option int => o_bar => 'Some option';
    app {
      my $self = shift;
      $self->do_stuff;
      return $self->exit_value;
    };

t/n_of.t  view on Meta::CPAN

  'both --arr and --file again'
);

is_deeply(run(qw(--def 8 --def 7)), {def => [8, 7], arr => [], file => undef, rep => [], save => ''}, 'override --def');

is_deeply(run(qw(--rep 7 8)), {def => [9], arr => [], file => undef, rep => [7, 8], save => ''}, 'only --rep');

done_testing;

sub run {
  local @ARGV = @_;
  my $app = $script->app;
  return {map { ($_ => $app->$_) } qw(arr def file rep save)};
}

t/options.t  view on Meta::CPAN

is $instance->has_input_file, 1, 'Moose style';
is !$instance->has_iii,       1, 'does not exist';
ok !$instance->has_output_file, 'default does not exist yet';
$instance->output_file;
ok $instance->has_output_file, 'default applied';
is $instance->has_template, 0,       'has_template not replaced see _sub()';
is $instance->template,     'empty', 'default exists';

sub app_instance {
  my $script = shift;
  local @ARGV = @_;
  my $app = $script->app;
  return $app;
}

done_testing;

t/subcommand.t  view on Meta::CPAN

  documentation 'Applify';
  app {
    my ($self, @extra) = @_;
    return 0;
  };
};
app { return 1 };
HERE
  ok $app, 'not undef';

  local @ARGV = qw{disallow};
  run_method($app->_script, 'app');
  like "$@", qr/Looks like you have a typo/, 'confessions of a app happy coder.';
}

{
  my $app = eval_script($code, 'list', '--save', '--long', 1);
  isa_ok $app, 'MyListing', 'correct inheritance';
  is $app->save, 1, 'global option set';
  is $app->long, 1, 'long list option set';

 view all matches for this distribution
 view release on metacpan -  search on metacpan