MouseX-Getopt
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
lib/MouseX/Getopt/Basic.pm view on Meta::CPAN
use Getopt::Long 2.37 ();
has ARGV => (is => 'rw', isa => 'ArrayRef', metaclass => "NoGetopt");
has extra_argv => (is => 'rw', isa => 'ArrayRef', metaclass => "NoGetopt");
sub new_with_options {
my ($class, @params) = @_;
my $config_from_file;
if($class->meta->does_role('MouseX::ConfigFromFile')) {
local @ARGV = @ARGV;
# just get the configfile arg now; the rest of the args will be
# fetched later
my $configfile;
my $opt_parser = Getopt::Long::Parser->new( config => [ qw( no_auto_help pass_through ) ] );
$opt_parser->getoptions( "configfile=s" => \$configfile );
if(!defined $configfile) {
my $cfmeta = $class->meta->find_attribute_by_name('configfile');
$configfile = $cfmeta->default if $cfmeta->has_default;
t/002_custom_option_type.t view on Meta::CPAN
has 'nums' => (
is => 'ro',
isa => 'ArrayOfInts',
default => sub { [0] }
);
}
{
local @ARGV = ();
my $app = App->new_with_options;
isa_ok($app, 'App');
is_deeply($app->nums, [0], '... nums is [0] as expected');
}
{
local @ARGV = ('--nums', 3, '--nums', 5);
my $app = App->new_with_options;
isa_ok($app, 'App');
is_deeply($app->nums, [3, 5], '... nums is [3, 5] as expected');
}
# Make sure it really used our =i@, instead of falling back
# to =s@ via the type system, and test that exceptions work
# while we're at it.
eval {
local @ARGV = ('--nums', 3, '--nums', 'foo');
my $app = App->new_with_options;
};
like($@, qr/Value "foo" invalid/, 'Numeric constraint enforced');
t/003_inferred_option_type.t view on Meta::CPAN
has 'nums' => (
is => 'ro',
isa => 'ArrayOfInts',
default => sub { [0] }
);
}
{
local @ARGV = ();
my $app = App->new_with_options;
isa_ok($app, 'App');
is_deeply($app->nums, [0], '... nums is [0] as expected');
}
{
local @ARGV = ('--nums', 3, '--nums', 5);
my $app = App->new_with_options;
isa_ok($app, 'App');
is_deeply($app->nums, [3, 5], '... nums is [3, 5] as expected');
}
t/004_nogetop.t view on Meta::CPAN
metaclass => 'Getopt',
is => 'ro',
isa => 'Int',
default => 832,
cmd_flag => 'p',
);
}
{
local @ARGV = ();
my $app = App->new_with_options;
isa_ok( $app, 'App' );
ok( !$app->verbose, '... verbosity is off as expected' );
is( $app->length, 24, '... length is 24 as expected' );
is( $app->data, 'file.dat', '... data is file.dat as expected' );
is_deeply( $app->libs, [], '... libs is [] as expected' );
is_deeply( $app->details, {}, '... details is {} as expected' );
is($app->private_stuff, 713, '... private stuff is 713 as expected');
}
{
local @ARGV = (qw/--private_stuff 317/);
throws_ok { App->new_with_options } qr/Unknown option: private_stuff/;
}
t/005_strict.t view on Meta::CPAN
);
has 'private_stuff' => (
is => 'ro',
isa => 'Int',
default => 713
);
}
{
local @ARGV = ();
my $app = App->new_with_options;
isa_ok( $app, 'App' );
ok( !$app->verbose, '... verbosity is off as expected' );
is( $app->length, 24, '... length is 24 as expected' );
is( $app->data, 'file.dat', '... data is file.dat as expected' );
is_deeply( $app->libs, [], '... libs is [] as expected' );
is_deeply( $app->details, {}, '... details is {} as expected' );
is($app->private_stuff, 713, '... private stuff is 713 as expected');
}
{
local @ARGV = (qw/--private_stuff 317/);
throws_ok { App->new_with_options } qr/Unknown option: private_stuff/;
}
{
local @ARGV = (qw/--length 100/);
throws_ok { App->new_with_options } qr/Unknown option: length/;
}
t/006_metaclass_traits.t view on Meta::CPAN
foreach my $attr_name (qw(data cow horse _private_stuff_cmdline)) {
my $attr = App->meta->get_attribute($attr_name);
isa_ok($attr, 'Mouse::Meta::Attribute');
does_ok($attr, 'MouseX::Getopt::Meta::Attribute::Trait');
can_ok($attr, 'cmd_flag');
can_ok($attr, 'cmd_aliases');
}
{
local @ARGV = ();
my $app = App->new_with_options;
isa_ok($app, 'App');
ok(!$app->verbose, '... verbosity is off as expected');
is($app->length, 24, '... length is 24 as expected');
is($app->data, 'file.dat', '... data is file.dat as expected');
is_deeply($app->libs, [], '... libs is [] as expected');
is_deeply($app->details, {}, '... details is {} as expected');
}
{
local @ARGV = ('--verbose', '--length', 50);
my $app = App->new_with_options;
isa_ok($app, 'App');
ok($app->verbose, '... verbosity is turned on as expected');
is($app->length, 50, '... length is 50 as expected');
is($app->data, 'file.dat', '... data is file.dat as expected');
is_deeply($app->libs, [], '... libs is [] as expected');
is_deeply($app->details, {}, '... details is {} as expected');
}
{
local @ARGV = ('--verbose', '-f', 'foo.txt');
my $app = App->new_with_options;
isa_ok($app, 'App');
ok($app->verbose, '... verbosity is turned on as expected');
is($app->length, 24, '... length is 24 as expected');
is($app->data, 'foo.txt', '... data is foo.txt as expected');
is_deeply($app->libs, [], '... libs is [] as expected');
is_deeply($app->details, {}, '... details is {} as expected');
}
{
local @ARGV = ('--verbose', '--libs', 'libs/', '--libs', 'includes/lib');
my $app = App->new_with_options;
isa_ok($app, 'App');
ok($app->verbose, '... verbosity is turned on as expected');
is($app->length, 24, '... length is 24 as expected');
is($app->data, 'file.dat', '... data is foo.txt as expected');
is_deeply($app->libs,
['libs/', 'includes/lib'],
'... libs is [libs/, includes/lib] as expected');
is_deeply($app->details, {}, '... details is {} as expected');
}
{
local @ARGV = ('--details', 'os=mac', '--details', 'name=foo');
my $app = App->new_with_options;
isa_ok($app, 'App');
ok(!$app->verbose, '... verbosity is turned on as expected');
is($app->length, 24, '... length is 24 as expected');
is($app->data, 'file.dat', '... data is foo.txt as expected');
is_deeply($app->libs, [], '... libs is [] as expected');
is_deeply($app->details,
{ os => 'mac', name => 'foo' },
'... details is { os => mac, name => foo } as expected');
}
{
# Test negation on booleans too ...
local @ARGV = ('--noverbose');
my $app = App->new_with_options;
isa_ok($app, 'App');
ok(!$app->verbose, '... verbosity is turned off as expected');
is($app->length, 24, '... length is 24 as expected');
is($app->data, 'file.dat', '... file is file.dat as expected');
is_deeply($app->libs, [], '... libs is [] as expected');
is_deeply($app->details, {}, '... details is {} as expected');
}
# Test cmd_alias without cmd_flag
{
local @ARGV = ('--cow', '42');
my $app = App->new_with_options;
isa_ok($app, 'App');
is($app->cow, 42, 'cmd_alias, but not using it');
}
{
local @ARGV = ('--moocow', '88');
my $app = App->new_with_options;
isa_ok($app, 'App');
is($app->cow, 88, 'cmd_alias, using long one');
}
{
local @ARGV = ('-c', '99');
my $app = App->new_with_options;
isa_ok($app, 'App');
is($app->cow, 99, 'cmd_alias, using short one');
}
# Test cmd_alias + cmd_flag
{
local @ARGV = ('--horsey', '123');
my $app = App->new_with_options;
isa_ok($app, 'App');
is($app->horse, 123, 'cmd_alias+cmd_flag, using flag');
}
{
local @ARGV = ('-x', '321');
my $app = App->new_with_options;
isa_ok($app, 'App');
is($app->horse, 321, 'cmd_alias+cmd_flag, using alias');
}
# Test _foo + cmd_flag
{
local @ARGV = ('-p', '666');
my $app = App->new_with_options;
isa_ok($app, 'App');
is($app->_private_stuff_cmdline, 666, '_foo + cmd_flag');
}
# Test ARGV support
{
my @args = ('-p', 12345, '-c', 99, '-');
local @ARGV = @args;
my $app = App->new_with_options;
isa_ok($app, 'App');
is_deeply($app->ARGV, \@args, 'ARGV accessor');
is_deeply(\@ARGV, \@args, '@ARGV unmangled');
is_deeply($app->extra_argv, ['-'], 'extra_argv accessor');
}
t/007_nogetopt_trait.t view on Meta::CPAN
traits => ['Getopt'],
is => 'ro',
isa => 'Int',
default => 832,
cmd_flag => 'p',
);
}
{
local @ARGV = ();
my $app = App->new_with_options;
isa_ok( $app, 'App' );
ok( !$app->verbose, '... verbosity is off as expected' );
is( $app->length, 24, '... length is 24 as expected' );
is( $app->data, 'file.dat', '... data is file.dat as expected' );
is_deeply( $app->libs, [], '... libs is [] as expected' );
is_deeply( $app->details, {}, '... details is {} as expected' );
is($app->private_stuff, 713, '... private stuff is 713 as expected');
}
{
local @ARGV = (qw/--private_stuff 317/);
throws_ok { App->new_with_options } qr/Unknown option: private_stuff/;
}
t/008_configfromfile.t view on Meta::CPAN
use Mouse;
extends 'App';
has '+configfile' => (
default => sub { return File::Spec->canonpath('/notused/default') },
);
}
# No config specified
{
local @ARGV = qw( --required_from_argv 1 );
throws_ok { App->new_with_options } qr/Mandatory parameter 'required_from_config' missing/;
{
my $app = App::DefaultConfigFile->new_with_options;
isa_ok( $app, 'App::DefaultConfigFile' );
app_ok( $app );
ok( !$app->config_from_override,
'... config_from_override false as expected' );
is( $app->configfile, File::Spec->canonpath('/notused/default'),
'... configfile is /notused/default as expected' );
}
}
# No config specified
{
local @ARGV = qw( --required_from_argv 1 );
{
my $app = App::DefaultConfigFileCodeRef->new_with_options;
isa_ok( $app, 'App::DefaultConfigFileCodeRef' );
app_ok( $app );
ok( !$app->config_from_override,
'... config_from_override false as expected' );
is( $app->configfile, File::Spec->canonpath('/notused/default'),
'... configfile is /notused/default as expected' );
}
}
# Config specified
{
local @ARGV = qw( --configfile /notused --required_from_argv 1 );
{
my $app = App->new_with_options;
isa_ok( $app, 'App' );
app_ok( $app );
}
{
my $app = App::DefaultConfigFile->new_with_options;
isa_ok( $app, 'App::DefaultConfigFile' );
t/102_basic_basic.t view on Meta::CPAN
foreach my $attr_name (qw(data cow horse _private_stuff_cmdline)) {
my $attr = App->meta->get_attribute($attr_name);
isa_ok($attr, 'Mouse::Meta::Attribute');
isa_ok($attr, 'MouseX::Getopt::Meta::Attribute');
can_ok($attr, 'cmd_flag');
can_ok($attr, 'cmd_aliases');
}
{
local @ARGV = ();
my $app = App->new_with_options;
isa_ok($app, 'App');
ok(!$app->verbose, '... verbosity is off as expected');
is($app->length, 24, '... length is 24 as expected');
is($app->data, 'file.dat', '... data is file.dat as expected');
is_deeply($app->libs, [], '... libs is [] as expected');
is_deeply($app->details, {}, '... details is {} as expected');
}
{
local @ARGV = ('--verbose', '--length', 50);
my $app = App->new_with_options;
isa_ok($app, 'App');
ok($app->verbose, '... verbosity is turned on as expected');
is($app->length, 50, '... length is 50 as expected');
is($app->data, 'file.dat', '... data is file.dat as expected');
is_deeply($app->libs, [], '... libs is [] as expected');
is_deeply($app->details, {}, '... details is {} as expected');
}
{
local @ARGV = ('--verbose', '-f', 'foo.txt');
my $app = App->new_with_options;
isa_ok($app, 'App');
ok($app->verbose, '... verbosity is turned on as expected');
is($app->length, 24, '... length is 24 as expected');
is($app->data, 'foo.txt', '... data is foo.txt as expected');
is_deeply($app->libs, [], '... libs is [] as expected');
is_deeply($app->details, {}, '... details is {} as expected');
}
{
local @ARGV = ('--verbose', '--libs', 'libs/', '--libs', 'includes/lib');
my $app = App->new_with_options;
isa_ok($app, 'App');
ok($app->verbose, '... verbosity is turned on as expected');
is($app->length, 24, '... length is 24 as expected');
is($app->data, 'file.dat', '... data is foo.txt as expected');
is_deeply($app->libs,
['libs/', 'includes/lib'],
'... libs is [libs/, includes/lib] as expected');
is_deeply($app->details, {}, '... details is {} as expected');
}
{
local @ARGV = ('--details', 'os=mac', '--details', 'name=foo');
my $app = App->new_with_options;
isa_ok($app, 'App');
ok(!$app->verbose, '... verbosity is turned on as expected');
is($app->length, 24, '... length is 24 as expected');
is($app->data, 'file.dat', '... data is foo.txt as expected');
is_deeply($app->libs, [], '... libs is [] as expected');
is_deeply($app->details,
{ os => 'mac', name => 'foo' },
'... details is { os => mac, name => foo } as expected');
}
{
# Test negation on booleans too ...
local @ARGV = ('--noverbose');
my $app = App->new_with_options;
isa_ok($app, 'App');
ok(!$app->verbose, '... verbosity is turned off as expected');
is($app->length, 24, '... length is 24 as expected');
is($app->data, 'file.dat', '... file is file.dat as expected');
is_deeply($app->libs, [], '... libs is [] as expected');
is_deeply($app->details, {}, '... details is {} as expected');
}
# Test cmd_alias without cmd_flag
{
local @ARGV = ('--cow', '42');
my $app = App->new_with_options;
isa_ok($app, 'App');
is($app->cow, 42, 'cmd_alias, but not using it');
}
{
local @ARGV = ('--moocow', '88');
my $app = App->new_with_options;
isa_ok($app, 'App');
is($app->cow, 88, 'cmd_alias, using long one');
}
{
local @ARGV = ('-c', '99');
my $app = App->new_with_options;
isa_ok($app, 'App');
is($app->cow, 99, 'cmd_alias, using short one');
}
# Test cmd_alias + cmd_flag
{
local @ARGV = ('--horsey', '123');
my $app = App->new_with_options;
isa_ok($app, 'App');
is($app->horse, 123, 'cmd_alias+cmd_flag, using flag');
}
{
local @ARGV = ('-x', '321');
my $app = App->new_with_options;
isa_ok($app, 'App');
is($app->horse, 321, 'cmd_alias+cmd_flag, using alias');
}
# Test _foo + cmd_flag
{
local @ARGV = ('-p', '666');
my $app = App->new_with_options;
isa_ok($app, 'App');
is($app->_private_stuff_cmdline, 666, '_foo + cmd_flag');
}
# Test ARGV support
{
my @args = ('-p', 12345, '-c', 99, '-');
local @ARGV = @args;
my $app = App->new_with_options;
isa_ok($app, 'App');
is_deeply($app->ARGV, \@args, 'ARGV accessor');
is_deeply(\@ARGV, \@args, '@ARGV unmangled');
is_deeply($app->extra_argv, ['-'], 'extra_argv accessor');
}
t/103_uc_bug.t view on Meta::CPAN
isa => 'Str',
);
has 'otherparam' => (
is => 'rw',
isa => 'Str',
);
}
{
local @ARGV = ('--TrackingNumber','1Z1234567812345670','--otherparam','foo');
my $app = App->new_with_options;
isa_ok($app, 'App');
is($app->TrackingNumber, '1Z1234567812345670', '... TrackingNumber is as expected');
is($app->otherparam, 'foo', '... otherparam is as expected');
}
t/104_override_usage.t view on Meta::CPAN
our $usage = 0;
before _getopt_full_usage => sub { $usage++; };
our @warnings;
before _getopt_spec_warnings => sub { shift; push(@warnings, @_) };
our @exception;
before _getopt_spec_exception => sub { shift; push(@exception, @{ shift() }, shift()) };
}
{
local $MyScript::usage; local @MyScript::warnings; local @MyScript::exception;
local @ARGV = ('--foo', '1');
my $i = MyScript->new_with_options;
ok $i;
is $i->foo, 1;
is $MyScript::usage, undef;
}
{
local $MyScript::usage; local @MyScript::warnings; local @MyScript::exception;
local @ARGV = ('--help');
throws_ok { MyScript->new_with_options } qr/A foo/;
is $MyScript::usage, 1;
}
{
local $MyScript::usage; local @MyScript::warnings; local @MyScript::exception;
local @ARGV = ('-q'); # Does not exist
throws_ok { MyScript->new_with_options } qr/A foo/;
is_deeply \@MyScript::warnings, [
'Unknown option: q
'
];
my $exp = [
'Unknown option: q
',
$Getopt::Long::Descriptive::VERSION < 0.099 ?
qq{usage: 104_override_usage.t [-?] [long options...]
t/105_uc_bug_more.t view on Meta::CPAN
my $meta = Mouse::Meta::Class->create_anon_class(
superclasses => ['Mouse::Object'],
);
$meta->add_attribute('debug', traits => ['Getopt'], isa => 'Bool',
cmd_aliases => ['d'], is => 'ro');
$role->meta->apply($meta);
ok($meta->name->new_with_options({ argv => ['-d'] })->debug,
"debug was set for argv -d on $role");
{
local @ARGV = ('-d');
ok($meta->name->new_with_options()->debug,
"debug was set for ARGV on $role");
}
ok($meta->name->new_with_options({ argv => ['--debug'] })->debug,
"debug was set for argv --debug on $role");
ok($meta->name->new_with_options({ argv => ['--debug'] })->debug,
"debug was set for argv --debug on $role");
}
t/106_no_ignore_case.t view on Meta::CPAN
);
ok((! $obj->BigD), "BigD was not set for argv -d on $role");
ok($obj->SmallD, "SmallD was set for argv -d on $role");
}
ok($meta->name->new_with_options({ argv => ['-d'], no_ignore_case => 1})
->SmallD,
"SmallD was set for argv -d on $role");
{
local @ARGV = ('-d');
ok($meta->name->new_with_options()->SmallD,
"SmallD was set for ARGV on $role");
}
ok($meta->name->new_with_options({ argv => ['-D'], no_ignore_case => 1})
->BigD,
"BigD was set for argv -d on $role");
{
my $obj = $meta->name->new_with_options(
t/109_help_flag.t view on Meta::CPAN
# before fix, prints this on stderr:
#Unknown option: ?
#usage: test1.t
# after fix, prints this on stderr:
#usage: test1.t [-?] [long options...]
# -? --usage --help Prints this usage information.
foreach my $args ( ['--help'], ['--usage'], ['--?'], ['-?'] )
{
local @ARGV = @$args;
throws_ok { MyClass->new_with_options() }
qr/^usage: (?:[\d\w]+)\Q.t [-?] [long options...]\E.^\t\Q-? --\E(\[no-\])?usage --(\[no-\])?help\s+\QPrints this usage information.\E$/ms,
'Help request detected; usage information properly printed';
}
# now call again, and ensure we got the usage info.
my $obj = MyClass->new_with_options();
ok($obj->meta->has_attribute('usage'), 'class has usage attribute');
isa_ok($obj->usage, 'Getopt::Long::Descriptive::Usage');
view release on metacpan - search on metacpan
( run in 1.896 second using v1.00-cache-2.02-grep-82fe00e-cpan-da92000dfeb )