From: Stevan Little Date: Fri, 14 Mar 2008 15:47:10 +0000 (+0000) Subject: 0.12 X-Git-Tag: 0_15~16 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=adbe3e57810b57a425b78c327cc08ec3ab602a97;p=gitmo%2FMooseX-Getopt.git 0.12 --- diff --git a/Build.PL b/Build.PL index 1d91063..790dcab 100644 --- a/Build.PL +++ b/Build.PL @@ -6,10 +6,11 @@ my $build = Module::Build->new( module_name => 'MooseX::Getopt', license => 'perl', requires => { - 'Moose' => '0.19', + 'Moose' => '0.39', 'Getopt::Long' => '2.34', }, optional => { + 'Getopt::Long::Descriptive' => 0, }, build_requires => { 'Test::More' => '0.62', diff --git a/ChangeLog b/ChangeLog index f925121..8e14e30 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,19 +1,35 @@ Revision history for Perl extension MooseX-Getopt +0.12 Fri. March 14, 2008 + ~~ updated copyright dates ~~ + + - upped the Moose dependency to support + the custom metaclass traits + - added Getopt::Long::Descriptive as an + optional dependency + + * MooseX::Getopt + MooseX::Getopt::Meta::Attribute + MooseX::Getopt::Meta::Attribute::Trait + MooseX::Getopt::Meta::Attribute::NoGetopt + MooseX::Getopt::Meta::Attribute::Trait::NoGetopt + - added support for custom metaclass traits + - added tests for this + 0.11 Sun. Jan. 27, 2008 * MooseX::Getopt - - Commandline option shouldn't be required in the - case that the given "required" attribute has - a default or a builder method. + - Commandline option shouldn't be required in the + case that the given "required" attribute has + a default or a builder method. 0.10 Wed. Jan. 23, 2008 * MooseX::Getopt - - Support default configfile attribute when - used with MooseX::ConfigFromFile-based roles + - Support default configfile attribute when + used with MooseX::ConfigFromFile-based roles 0.09 Tues. Jan. 22, 2008 * MooseX::Getopt - - Use Getopt::Long::Descriptive if it's available + - Use Getopt::Long::Descriptive if it's available 0.08 Tues. Dec. 8, 2007 * MooseX::Getopt diff --git a/MANIFEST b/MANIFEST index 2e2c7c8..24d0d07 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,20 +1,23 @@ Build.PL ChangeLog -META.yml -Makefile.PL -MANIFEST -MANIFEST.SKIP -README lib/MooseX/Getopt.pm -lib/MooseX/Getopt/OptionTypeMap.pm -lib/MooseX/Getopt/Strict.pm lib/MooseX/Getopt/Meta/Attribute.pm lib/MooseX/Getopt/Meta/Attribute/NoGetopt.pm +lib/MooseX/Getopt/Meta/Attribute/Trait.pm +lib/MooseX/Getopt/Meta/Attribute/Trait/NoGetopt.pm +lib/MooseX/Getopt/OptionTypeMap.pm +lib/MooseX/Getopt/Strict.pm +Makefile.PL +MANIFEST +META.yml +README t/000_load.t t/001_basic.t t/002_custom_option_type.t t/003_inferred_option_type.t t/004_nogetop.t t/005_strict.t +t/006_metaclass_traits.t +t/007_nogetopt_trait.t t/pod.t t/pod_coverage.t diff --git a/README b/README index 0d82d8c..4bb56a0 100644 --- a/README +++ b/README @@ -1,4 +1,4 @@ -MooseX::Getopt version 0.07 +MooseX::Getopt version 0.12 =========================== See the individual module documentation for more information @@ -21,7 +21,7 @@ This module requires these other modules and libraries: COPYRIGHT AND LICENCE -Copyright (C) 2007 Infinity Interactive, Inc. +Copyright (C) 2007-2008 Infinity Interactive, Inc. http://www.iinteractive.com diff --git a/lib/MooseX/Getopt.pm b/lib/MooseX/Getopt.pm index 98a7221..a8ce4a3 100644 --- a/lib/MooseX/Getopt.pm +++ b/lib/MooseX/Getopt.pm @@ -9,7 +9,7 @@ use MooseX::Getopt::Meta::Attribute::NoGetopt; use Getopt::Long (); # GLD uses it anyway, doesn't hurt use constant HAVE_GLD => not not eval { require Getopt::Long::Descriptive }; -our $VERSION = '0.11'; +our $VERSION = '0.12'; our $AUTHORITY = 'cpan:STEVAN'; has ARGV => (is => 'rw', isa => 'ArrayRef', metaclass => "NoGetopt"); @@ -144,11 +144,11 @@ sub _gld_spec { sub _compute_getopt_attrs { my $class = shift; grep { - $_->isa("MooseX::Getopt::Meta::Attribute") + $_->does("MooseX::Getopt::Meta::Attribute::Trait") or $_->name !~ /^_/ - && - !$_->isa('MooseX::Getopt::Meta::Attribute::NoGetopt') + } grep { + !$_->does('MooseX::Getopt::Meta::Attribute::Trait::NoGetopt') } $class->meta->compute_all_applicable_attributes } @@ -159,7 +159,7 @@ sub _get_cmd_flags_for_attr { my @aliases; - if ($attr->isa('MooseX::Getopt::Meta::Attribute')) { + if ($attr->does('MooseX::Getopt::Meta::Attribute::Trait')) { $flag = $attr->cmd_flag if $attr->has_cmd_flag; @aliases = @{ $attr->cmd_aliases } if $attr->has_cmd_aliases; } @@ -425,7 +425,7 @@ Brandon L. Black, Eblblack@gmail.comE =head1 COPYRIGHT AND LICENSE -Copyright 2007 by Infinity Interactive, Inc. +Copyright 2007-2008 by Infinity Interactive, Inc. L diff --git a/lib/MooseX/Getopt/Meta/Attribute.pm b/lib/MooseX/Getopt/Meta/Attribute.pm index 22e4191..09f4e7a 100644 --- a/lib/MooseX/Getopt/Meta/Attribute.pm +++ b/lib/MooseX/Getopt/Meta/Attribute.pm @@ -3,31 +3,11 @@ package MooseX::Getopt::Meta::Attribute; use Moose; use Moose::Util::TypeConstraints; -our $VERSION = '0.04'; +our $VERSION = '0.05'; our $AUTHORITY = 'cpan:STEVAN'; extends 'Moose::Meta::Attribute'; # << Moose extending Moose :) - -has 'cmd_flag' => ( - is => 'rw', - isa => 'Str', - predicate => 'has_cmd_flag', -); - -# This subtype is to support scalar -> arrayref coercion -# without polluting the built-in types -subtype '_MooseX_Getopt_CmdAliases' => as 'ArrayRef'; - -coerce '_MooseX_Getopt_CmdAliases' - => from 'Str' - => via { [$_] }; - -has 'cmd_aliases' => ( - is => 'rw', - isa => '_MooseX_Getopt_CmdAliases', - predicate => 'has_cmd_aliases', - coerce => 1, -); + with 'MooseX::Getopt::Meta::Attribute::Trait'; no Moose; @@ -129,7 +109,7 @@ Brandon L. Black, Eblblack@gmail.comE =head1 COPYRIGHT AND LICENSE -Copyright 2007 by Infinity Interactive, Inc. +Copyright 2007-2008 by Infinity Interactive, Inc. L diff --git a/lib/MooseX/Getopt/Meta/Attribute/NoGetopt.pm b/lib/MooseX/Getopt/Meta/Attribute/NoGetopt.pm index 5222a50..7f6f0fe 100644 --- a/lib/MooseX/Getopt/Meta/Attribute/NoGetopt.pm +++ b/lib/MooseX/Getopt/Meta/Attribute/NoGetopt.pm @@ -2,10 +2,11 @@ package MooseX::Getopt::Meta::Attribute::NoGetopt; use Moose; -our $VERSION = '0.01'; +our $VERSION = '0.02'; our $AUTHORITY = 'cpan:STEVAN'; extends 'Moose::Meta::Attribute'; # << Moose extending Moose :) + with 'MooseX::Getopt::Meta::Attribute::Trait::NoGetopt'; no Moose; @@ -69,7 +70,7 @@ Chris Prather C<< >> =head1 COPYRIGHT AND LICENSE -Copyright 2007 by Infinity Interactive, Inc. +Copyright 2007-2008 by Infinity Interactive, Inc. L diff --git a/lib/MooseX/Getopt/Meta/Attribute/Trait.pm b/lib/MooseX/Getopt/Meta/Attribute/Trait.pm new file mode 100644 index 0000000..024cdd1 --- /dev/null +++ b/lib/MooseX/Getopt/Meta/Attribute/Trait.pm @@ -0,0 +1,124 @@ + +package MooseX::Getopt::Meta::Attribute::Trait; +use Moose::Role; +use Moose::Util::TypeConstraints; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +has 'cmd_flag' => ( + is => 'rw', + isa => 'Str', + predicate => 'has_cmd_flag', +); + +# This subtype is to support scalar -> arrayref coercion +# without polluting the built-in types +subtype '_MooseX_Getopt_CmdAliases' => as 'ArrayRef'; + +coerce '_MooseX_Getopt_CmdAliases' + => from 'Str' + => via { [$_] }; + +has 'cmd_aliases' => ( + is => 'rw', + isa => '_MooseX_Getopt_CmdAliases', + predicate => 'has_cmd_aliases', + coerce => 1, +); + +no Moose::Role; + +# register this as a metaclass alias ... +package # stop confusing PAUSE + Moose::Meta::Attribute::Custom::Trait::Getopt; +sub register_implementation { 'MooseX::Getopt::Meta::Attribute::Trait' } + +1; + +__END__ + +=pod + +=head1 NAME + +MooseX::Getopt::Meta::Attribute::Trait - Optional meta attribute trait for custom option names + +=head1 SYNOPSIS + + package App; + use Moose; + + with 'MooseX::Getopt'; + + has 'data' => ( + traits => [ 'Getopt' ], + is => 'ro', + isa => 'Str', + default => 'file.dat', + + # tells MooseX::Getopt to use --somedata as the + # command line flag instead of the normal + # autogenerated one (--data) + cmd_flag => 'somedata', + + # tells MooseX::Getopt to also allow --moosedata, + # -m, and -d as aliases for this same option on + # the commandline. + cmd_aliases => [qw/ moosedata m d /], + + # Or, you can use a plain scalar for a single alias: + cmd_aliases => 'm', + ); + +=head1 DESCRIPTION + +This is a custom attribute metaclass trait which can be used to +specify a the specific command line flag to use instead of the +default one which L will create for you. + +=head1 METHODS + +These methods are of little use to most users, they are used interally +within L. + +=over 4 + +=item B + +Changes the commandline flag to be this value, instead of the default, +which is the same as the attribute name. + +=item B + +Adds more aliases for this commandline flag, useful for short options +and such. + +=item B + +=item B + +=item B + +=back + +=head1 BUGS + +All complex software has bugs lurking in it, and this module is no +exception. If you find a bug please either email me, or add the bug +to cpan-RT. + +=head1 AUTHOR + +Stevan Little Estevan@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2007-2008 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/MooseX/Getopt/Meta/Attribute/Trait/NoGetopt.pm b/lib/MooseX/Getopt/Meta/Attribute/Trait/NoGetopt.pm new file mode 100644 index 0000000..4603936 --- /dev/null +++ b/lib/MooseX/Getopt/Meta/Attribute/Trait/NoGetopt.pm @@ -0,0 +1,75 @@ + +package MooseX::Getopt::Meta::Attribute::Trait::NoGetopt; +use Moose::Role; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +no Moose::Role; + +# register this as a metaclass alias ... +package # stop confusing PAUSE + Moose::Meta::Attribute::Custom::Trait::NoGetopt; +sub register_implementation { 'MooseX::Getopt::Meta::Attribute::Trait::NoGetopt' } + +1; + +__END__ + +=pod + +=head1 NAME + +MooseX::Getopt::Meta::Attribute::Trait::NoGetopt - Optional meta attribute trait for ignoring params + +=head1 SYNOPSIS + + package App; + use Moose; + + with 'MooseX::Getopt'; + + has 'data' => ( + traits => [ 'NoGetopt' ], # do not attempt to capture this param + is => 'ro', + isa => 'Str', + default => 'file.dat', + ); + +=head1 DESCRIPTION + +This is a custom attribute metaclass trait which can be used to +specify that a specific attribute should B be processed by +C. All you need to do is specify the C +metaclass trait. + + has 'foo' => (traits => [ 'NoGetopt', ... ], ... ); + +=head1 METHODS + +=over 4 + +=item B + +=back + +=head1 BUGS + +All complex software has bugs lurking in it, and this module is no +exception. If you find a bug please either email me, or add the bug +to cpan-RT. + +=head1 AUTHOR + +Stevan Little Estevan@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2007-2008 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/MooseX/Getopt/OptionTypeMap.pm b/lib/MooseX/Getopt/OptionTypeMap.pm index 3d94c78..9b94bcb 100644 --- a/lib/MooseX/Getopt/OptionTypeMap.pm +++ b/lib/MooseX/Getopt/OptionTypeMap.pm @@ -106,7 +106,7 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2007 by Infinity Interactive, Inc. +Copyright 2007-2008 by Infinity Interactive, Inc. L diff --git a/lib/MooseX/Getopt/Strict.pm b/lib/MooseX/Getopt/Strict.pm index 33ca1e0..f845d69 100644 --- a/lib/MooseX/Getopt/Strict.pm +++ b/lib/MooseX/Getopt/Strict.pm @@ -50,7 +50,7 @@ Yuval Kogman C<< >> =head1 COPYRIGHT AND LICENSE -Copyright 2007 by Infinity Interactive, Inc. +Copyright 2007-2008 by Infinity Interactive, Inc. L diff --git a/t/001_basic.t b/t/001_basic.t index 55cba23..6c1c1fa 100644 --- a/t/001_basic.t +++ b/t/001_basic.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 53; +use Test::More tests => 69; BEGIN { use_ok('MooseX::Getopt'); @@ -79,6 +79,14 @@ BEGIN { } +foreach my $attr_name (qw(data cow horse _private_stuff_cmdline)) { + my $attr = App->meta->get_attribute($attr_name); + isa_ok($attr, 'Moose::Meta::Attribute'); + isa_ok($attr, 'MooseX::Getopt::Meta::Attribute'); + can_ok($attr, 'cmd_flag'); + can_ok($attr, 'cmd_aliases'); +} + { local @ARGV = (); diff --git a/t/006_metaclass_traits.t b/t/006_metaclass_traits.t new file mode 100644 index 0000000..18c3011 --- /dev/null +++ b/t/006_metaclass_traits.t @@ -0,0 +1,226 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 69; +use Test::Moose; + +BEGIN { + use_ok('MooseX::Getopt'); +} + +{ + package App; + use Moose; + + with 'MooseX::Getopt'; + + has 'data' => ( + traits => [ 'MooseX::Getopt::Meta::Attribute::Trait' ], + is => 'ro', + isa => 'Str', + default => 'file.dat', + cmd_flag => 'f', + ); + + has 'cow' => ( + traits => [ 'Getopt' ], + is => 'ro', + isa => 'Str', + default => 'moo', + cmd_aliases => [qw/ moocow m c /], + ); + + has 'horse' => ( + traits => [ 'Getopt' ], + is => 'ro', + isa => 'Str', + default => 'bray', + cmd_flag => 'horsey', + cmd_aliases => 'x', + ); + + has 'length' => ( + is => 'ro', + isa => 'Int', + default => 24 + ); + + has 'verbose' => ( + is => 'ro', + isa => 'Bool', + ); + + has 'libs' => ( + is => 'ro', + isa => 'ArrayRef', + default => sub { [] }, + ); + + has 'details' => ( + is => 'ro', + isa => 'HashRef', + default => sub { {} }, + ); + + has '_private_stuff' => ( + is => 'ro', + isa => 'Int', + default => 713 + ); + + has '_private_stuff_cmdline' => ( + traits => [ 'Getopt' ], + is => 'ro', + isa => 'Int', + default => 832, + cmd_flag => 'p', + ); + +} + +foreach my $attr_name (qw(data cow horse _private_stuff_cmdline)) { + my $attr = App->meta->get_attribute($attr_name); + isa_ok($attr, 'Moose::Meta::Attribute'); + does_ok($attr, 'MooseX::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'); +} diff --git a/t/007_nogetopt_trait.t b/t/007_nogetopt_trait.t new file mode 100644 index 0000000..5ccef57 --- /dev/null +++ b/t/007_nogetopt_trait.t @@ -0,0 +1,102 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 9; +use Test::Exception; + +BEGIN { + use_ok('MooseX::Getopt'); +} + +{ + package App; + use Moose; + + with 'MooseX::Getopt'; + + has 'data' => ( + traits => ['Getopt'], + is => 'ro', + isa => 'Str', + default => 'file.dat', + cmd_flag => 'f', + ); + + has 'cow' => ( + traits => ['Getopt'], + is => 'ro', + isa => 'Str', + default => 'moo', + cmd_aliases => [qw/ moocow m c /], + ); + + has 'horse' => ( + traits => ['Getopt'], + is => 'ro', + isa => 'Str', + default => 'bray', + cmd_flag => 'horsey', + cmd_aliases => 'x', + ); + + has 'length' => ( + is => 'ro', + isa => 'Int', + default => 24 + ); + + has 'verbose' => ( + is => 'ro', + isa => 'Bool', + ); + + has 'libs' => ( + is => 'ro', + isa => 'ArrayRef', + default => sub { [] }, + ); + + has 'details' => ( + is => 'ro', + isa => 'HashRef', + default => sub { {} }, + ); + + has 'private_stuff' => ( + traits => ['NoGetopt'], + is => 'ro', + isa => 'Int', + default => 713 + ); + + has '_private_stuff_cmdline' => ( + 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/; +}