MouseX-Getopt

 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 all matches for this distribution
 view release on metacpan -  search on metacpan