From: Damien Krotkine Date: Tue, 29 Mar 2011 10:30:48 +0000 (+0200) Subject: transform MooseX::Getopt::GLD into a MooseX::Parameterized Role X-Git-Tag: 0.36~1^2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0611312e34f4d0e3668a2c9894df36dc945ffe74;p=gitmo%2FMooseX-Getopt.git transform MooseX::Getopt::GLD into a MooseX::Parameterized Role --- diff --git a/ChangeLog b/ChangeLog index 569338f..14d6cda 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,10 @@ Revision history for Perl extension MooseX-Getopt +{{NEXT}} + * MooseX::Getopt::GLD + - change it to a MooseX::Role::Parameterized, so that it accepts + 'getopt_conf' parameter (Damien Krotkine) + 0.35 Wed 09 Feb 2011 * Fix missed change from Test::Exception to Test::Fatal diff --git a/lib/MooseX/Getopt/GLD.pm b/lib/MooseX/Getopt/GLD.pm index 5edb937..97298e0 100644 --- a/lib/MooseX/Getopt/GLD.pm +++ b/lib/MooseX/Getopt/GLD.pm @@ -1,70 +1,84 @@ package MooseX::Getopt::GLD; # ABSTRACT: A Moose role for processing command line options with Getopt::Long::Descriptive -use Moose::Role; +use MooseX::Role::Parameterized; use Getopt::Long::Descriptive 0.081; with 'MooseX::Getopt::Basic'; -has usage => ( - is => 'rw', isa => 'Getopt::Long::Descriptive::Usage', - traits => ['NoGetopt'], +parameter getopt_conf => ( + isa => 'ArrayRef[Str]', + default => sub { [] }, ); -# captures the options: --help --usage --? -has help_flag => ( - is => 'ro', isa => 'Bool', - traits => ['Getopt'], - cmd_flag => 'help', - cmd_aliases => [ qw(usage ?) ], - documentation => 'Prints this usage information.', -); - -around _getopt_spec => sub { - shift; - shift->_gld_spec(@_); -}; - -around _getopt_get_options => sub { - shift; - my ($class, $params, $opt_spec) = @_; - return Getopt::Long::Descriptive::describe_options($class->_usage_format(%$params), @$opt_spec); -}; - -sub _gld_spec { - my ( $class, %params ) = @_; - - my ( @options, %name_to_init_arg ); - - my $constructor_params = $params{params}; - - foreach my $opt ( @{ $params{options} } ) { - push @options, [ - $opt->{opt_string}, - $opt->{doc} || ' ', # FIXME new GLD shouldn't need this hack - { - ( ( $opt->{required} && !exists($constructor_params->{$opt->{init_arg}}) ) ? (required => $opt->{required}) : () ), - # NOTE: - # remove this 'feature' because it didn't work - # all the time, and so is better to not bother - # since Moose will handle the defaults just - # fine anyway. - # - SL - #( exists $opt->{default} ? (default => $opt->{default}) : () ), - }, - ]; - - my $identifier = lc($opt->{name}); - $identifier =~ s/\W/_/g; # Getopt::Long does this to all option names - - $name_to_init_arg{$identifier} = $opt->{init_arg}; +role { + + my $p = shift; + my $getopt_conf = $p->getopt_conf; + + has usage => ( + is => 'rw', isa => 'Getopt::Long::Descriptive::Usage', + traits => ['NoGetopt'], + ); + + # captures the options: --help --usage --? + has help_flag => ( + is => 'ro', isa => 'Bool', + traits => ['Getopt'], + cmd_flag => 'help', + cmd_aliases => [ qw(usage ?) ], + documentation => 'Prints this usage information.', + ); + + around _getopt_spec => sub { + shift; + shift->_gld_spec(@_); + }; + + around _getopt_get_options => sub { + shift; + my ($class, $params, $opt_spec) = @_; + # Check if a special args hash were already passed, or create a new one + my $args = ref($opt_spec->[-1]) eq 'HASH' ? pop @$opt_spec : {}; + unshift @{$args->{getopt_conf}}, @$getopt_conf; + push @$opt_spec, $args; + return Getopt::Long::Descriptive::describe_options($class->_usage_format(%$params), @$opt_spec); + }; + + method _gld_spec => sub { + my ( $class, %params ) = @_; + + my ( @options, %name_to_init_arg ); + + my $constructor_params = $params{params}; + + foreach my $opt ( @{ $params{options} } ) { + push @options, [ + $opt->{opt_string}, + $opt->{doc} || ' ', # FIXME new GLD shouldn't need this hack + { + ( ( $opt->{required} && !exists($constructor_params->{$opt->{init_arg}}) ) ? (required => $opt->{required}) : () ), + # NOTE: + # remove this 'feature' because it didn't work + # all the time, and so is better to not bother + # since Moose will handle the defaults just + # fine anyway. + # - SL + #( exists $opt->{default} ? (default => $opt->{default}) : () ), + }, + ]; + + my $identifier = lc($opt->{name}); + $identifier =~ s/\W/_/g; # Getopt::Long does this to all option names + + $name_to_init_arg{$identifier} = $opt->{init_arg}; + } + + return ( \@options, \%name_to_init_arg ); } +}; - return ( \@options, \%name_to_init_arg ); -} - -no Moose::Role; 1; diff --git a/t/111_gld_pass_through.t b/t/111_gld_pass_through.t new file mode 100644 index 0000000..1a02861 --- /dev/null +++ b/t/111_gld_pass_through.t @@ -0,0 +1,55 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 5; + +use Test::Requires { + 'Getopt::Long::Descriptive' => 0.01, # skip all if not installed +}; + +use_ok('MooseX::Getopt::GLD'); + +{ + package Engine::Foo; + use Moose; + + with 'MooseX::Getopt::GLD' => { getopt_conf => [ 'pass_through' ] }; + + has 'foo' => ( + metaclass => 'Getopt', + is => 'ro', + isa => 'Int', + ); +} + +{ + package Engine::Bar; + use Moose; + + with 'MooseX::Getopt::GLD' => { getopt_conf => [ 'pass_through' ] };; + + has 'bar' => ( + metaclass => 'Getopt', + is => 'ro', + isa => 'Int', + ); +} + +local @ARGV = ('--foo=10', '--bar=42'); + +{ + my $foo = Engine::Foo->new_with_options(); + isa_ok($foo, 'Engine::Foo'); + is($foo->foo, 10, '... got the right value (10)'); +} + +{ + my $bar = Engine::Bar->new_with_options(); + isa_ok($bar, 'Engine::Bar'); + is($bar->bar, 42, '... got the right value (42)'); +} + + +