From: Stevan Little Date: Fri, 23 Nov 2007 21:58:08 +0000 (+0000) Subject: 0.06 X-Git-Tag: 0_07~1 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0f8232b66e0f72e35099ce203962a4efc23838cf;p=gitmo%2FMooseX-Getopt.git 0.06 --- diff --git a/ChangeLog b/ChangeLog index bdad45f..2128009 100644 --- a/ChangeLog +++ b/ChangeLog @@ -5,6 +5,18 @@ Revision history for Perl extension MooseX-Getopt - refactored &new_with_option some so that this will work better with other Getopt modules (nuffin) + + + MooseX::Getopt::Strict + - version of MooseX::Getopt which requires + you to specify which attributes you want + processed explicity + - added tests for this + + + MooseX::Getopt::Meta::Attribute::NoGetopt + - a custom meta-attribute which can be + used to specify that an attribute should + not be processed + - added tests for this 0.05 Tues. July 3, 2007 * MooseX::Getopt::OptionTypeMap diff --git a/MANIFEST b/MANIFEST index 74f4710..2e2c7c8 100644 --- a/MANIFEST +++ b/MANIFEST @@ -7,10 +7,14 @@ 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 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/pod.t t/pod_coverage.t diff --git a/lib/MooseX/Getopt.pm b/lib/MooseX/Getopt.pm index cdd78e7..6d1ab25 100644 --- a/lib/MooseX/Getopt.pm +++ b/lib/MooseX/Getopt.pm @@ -6,6 +6,7 @@ use Getopt::Long (); use MooseX::Getopt::OptionTypeMap; use MooseX::Getopt::Meta::Attribute; +use MooseX::Getopt::Meta::Attribute::NoGetopt; our $VERSION = '0.06'; our $AUTHORITY = 'cpan:STEVAN'; @@ -66,13 +67,12 @@ sub _parse_argv { sub _compute_getopt_attrs { my $class = shift; - grep { $_->isa("MooseX::Getopt::Meta::Attribute") or $_->name !~ /^_/ && - !$_->isa('MooseX::Getopt::Meta::NoGetopt') + !$_->isa('MooseX::Getopt::Meta::Attribute::NoGetopt') } $class->meta->compute_all_applicable_attributes } @@ -162,6 +162,9 @@ accordingly. You can use the attribute metaclass L to get non-default commandline option names and aliases. +You can use the attribute metaclass L +to have C ignore your attribute in the commandline options. + By default, attributes which start with an underscore are not given commandline argument support, unless the attribute's metaclass is set to L. If you don't want you accessors diff --git a/lib/MooseX/Getopt/Meta/NoGetopt.pm b/lib/MooseX/Getopt/Meta/Attribute/NoGetopt.pm similarity index 85% rename from lib/MooseX/Getopt/Meta/NoGetopt.pm rename to lib/MooseX/Getopt/Meta/Attribute/NoGetopt.pm index d0d859d..88f36e6 100644 --- a/lib/MooseX/Getopt/Meta/NoGetopt.pm +++ b/lib/MooseX/Getopt/Meta/Attribute/NoGetopt.pm @@ -1,7 +1,6 @@ -package MooseX::Getopt::Meta::NoGetopt; +package MooseX::Getopt::Meta::Attribute::NoGetopt; use Moose; -use Moose::Util::TypeConstraints; our $VERSION = '0.01'; our $AUTHORITY = 'cpan:STEVAN'; @@ -12,7 +11,7 @@ no Moose; # register this as a metaclass alias ... package Moose::Meta::Attribute::Custom::NoGetopt; -sub register_implementation { 'MooseX::Getopt::Meta::NoGetopt' } +sub register_implementation { 'MooseX::Getopt::Meta::Attribute::NoGetopt' } 1; @@ -22,7 +21,7 @@ __END__ =head1 NAME -MooseX::NoGetopt::Meta::Attribute - Optional meta attribute for custom option names +MooseX::Getopt::Meta::Attribute::NoGetOpt - Optional meta attribute for ignoring params =head1 SYNOPSIS diff --git a/lib/MooseX/Getopt/Strict.pm b/lib/MooseX/Getopt/Strict.pm index 990f6a8..33ca1e0 100644 --- a/lib/MooseX/Getopt/Strict.pm +++ b/lib/MooseX/Getopt/Strict.pm @@ -4,14 +4,15 @@ use Moose::Role; with 'MooseX::Getopt'; -sub _compute_getopt_attrs { +around '_compute_getopt_attrs' => sub { + my $next = shift; my ( $class, @args ) = @_; grep { $_->isa("MooseX::Getopt::Meta::Attribute") - } $class->MooseX::Getopt::_compute_getopt_attrs(@args); -} + } $class->$next(@args); +}; -__PACKAGE__; +1; __END__ @@ -20,21 +21,40 @@ __END__ =head1 NAME MooseX::Getopt::Strict - only make options for attrs with the Getopt metaclass + +=head1 DESCRIPTION -=head1 SYNOPSIS - - # see MooseX::Getopt +This is an stricter version of C which only processes the +attributes if they explicitly set as C attributes. All other attributes +are ignored by the command line handler. + +=head1 METHODS =over 4 =item meta -Is a section devoted to making the #!#%^ stupid pod coverage test pass. Stevan, I do -hope you're actually reading this. +=back -Love, -Yuval +=head1 BUGS -=back +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 + +Yuval Kogman C<< >> + +=head1 COPYRIGHT AND LICENSE + +Copyright 2007 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/t/004_nogetop.t b/t/004_nogetop.t index b0fa16d..78da66d 100644 --- a/t/004_nogetop.t +++ b/t/004_nogetop.t @@ -11,14 +11,13 @@ BEGIN { } { - package App; use Moose; with 'MooseX::Getopt'; has 'data' => ( - metaclass => 'MooseX::Getopt::Meta::Attribute', + metaclass => 'Getopt', is => 'ro', isa => 'Str', default => 'file.dat', @@ -34,7 +33,7 @@ BEGIN { ); has 'horse' => ( - metaclass => 'MooseX::Getopt::Meta::Attribute', + metaclass => 'Getopt', is => 'ro', isa => 'Str', default => 'bray', @@ -66,14 +65,14 @@ BEGIN { ); has 'private_stuff' => ( - metaclass => 'MooseX::Getopt::Meta::NoGetopt', + metaclass => 'NoGetopt', is => 'ro', isa => 'Int', default => 713 ); has '_private_stuff_cmdline' => ( - metaclass => 'MooseX::Getopt::Meta::Attribute', + metaclass => 'Getopt', is => 'ro', isa => 'Int', default => 832, diff --git a/t/005_strict.t b/t/005_strict.t index 096ace9..858437b 100644 --- a/t/005_strict.t +++ b/t/005_strict.t @@ -18,7 +18,7 @@ BEGIN { with 'MooseX::Getopt::Strict'; has 'data' => ( - metaclass => 'MooseX::Getopt::Meta::Attribute', + metaclass => 'Getopt', is => 'ro', isa => 'Str', default => 'file.dat', @@ -34,7 +34,7 @@ BEGIN { ); has 'horse' => ( - metaclass => 'MooseX::Getopt::Meta::Attribute', + metaclass => 'Getopt', is => 'ro', isa => 'Str', default => 'bray',