X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FGetopt.pm;h=d7898f779b86ae55198e0f81d7cd39657f866a5c;hb=b4a7905195bf50b95248815d2cfe5a762d8986b5;hp=4e3723848ddae6dd26d855f72b1d497a5c4040c0;hpb=0e71533653c75c9133989d19dad127a8861760cf;p=gitmo%2FMooseX-Getopt.git diff --git a/lib/MooseX/Getopt.pm b/lib/MooseX/Getopt.pm index 4e37238..d7898f7 100644 --- a/lib/MooseX/Getopt.pm +++ b/lib/MooseX/Getopt.pm @@ -2,17 +2,18 @@ package MooseX::Getopt; use Moose::Role; -use Getopt::Long::Descriptive (); - use MooseX::Getopt::OptionTypeMap; use MooseX::Getopt::Meta::Attribute; use MooseX::Getopt::Meta::Attribute::NoGetopt; -our $VERSION = '0.08'; +use Getopt::Long (); # GLD uses it anyway, doesn't hurt +use constant HAVE_GLD => not not eval { require Getopt::Long::Descriptive }; + +our $VERSION = '0.10'; our $AUTHORITY = 'cpan:STEVAN'; -has ARGV => (is => 'rw', isa => 'ArrayRef'); -has extra_argv => (is => 'rw', isa => 'ArrayRef'); +has ARGV => (is => 'rw', isa => 'ArrayRef', metaclass => "NoGetopt"); +has extra_argv => (is => 'rw', isa => 'ArrayRef', metaclass => "NoGetopt"); sub new_with_options { my ($class, @params) = @_; @@ -25,12 +26,23 @@ sub new_with_options { my $params = $processed{params}; - if($class->meta->does_role('MooseX::ConfigFromFile') - && defined $params->{configfile}) { - %$params = ( - %{$class->get_config_from_file($params->{configfile})}, - %$params, - ); + if($class->meta->does_role('MooseX::ConfigFromFile')) { + my $configfile; + + if(defined $params->{configfile}) { + $configfile = $params->{configfile} + } + else { + my $cfmeta = $class->meta->get_attribute('configfile'); + $configfile = $cfmeta->default if $cfmeta->has_default; + } + + if(defined $configfile) { + %$params = ( + %{$class->get_config_from_file($configfile)}, + %$params, + ); + } } $class->new( @@ -42,23 +54,11 @@ sub new_with_options { } sub _parse_argv { - my ( $class, @args ) = @_; - - my ( $params, $argv_copy, $argv_mangled ) = $class->_call_getopt(@args); - - return ( - argv_copy => $argv_copy, - argv => $argv_mangled, - params => $params, - ); -} - -sub _call_getopt { my ( $class, %params ) = @_; local @ARGV = @{ $params{argv} || \@ARGV }; - my ( $opt_spec, $name_to_init_arg ) = $class->_gld_spec(%params); + my ( $opt_spec, $name_to_init_arg ) = ( HAVE_GLD ? $class->_gld_spec(%params) : $class->_traditional_spec(%params) ); # Get a clean copy of the original @ARGV my $argv_copy = [ @ARGV ]; @@ -67,7 +67,14 @@ sub _call_getopt { my ( $parsed_options, $usage ) = eval { local $SIG{__WARN__} = sub { push @err, @_ }; - Getopt::Long::Descriptive::describe_options("usage: %c %o", @$opt_spec) + + if ( HAVE_GLD ) { + return Getopt::Long::Descriptive::describe_options($class->_usage_format(%params), @$opt_spec); + } else { + my %options; + Getopt::Long::GetOptions(\%options, @$opt_spec); + return ( \%options, undef ); + } }; die join "", grep { defined } @err, $@ if @err or $@; @@ -81,7 +88,29 @@ sub _call_getopt { } keys %$parsed_options, ); - return ( \%constructor_args, $argv_copy, $argv_mangled ); + return ( + params => \%constructor_args, + argv_copy => $argv_copy, + argv => $argv_mangled, + ( defined($usage) ? ( usage => $usage ) : () ), + ); +} + +sub _usage_format { + return "usage: %c %o"; +} + +sub _traditional_spec { + my ( $class, %params ) = @_; + + my ( @options, %name_to_init_arg, %options ); + + foreach my $opt ( @{ $params{options} } ) { + push @options, $opt->{opt_string}; + $name_to_init_arg{ $opt->{name} } = $opt->{init_arg}; + } + + return ( \@options, \%name_to_init_arg ); } sub _gld_spec { @@ -223,7 +252,12 @@ code can still call the C method. If your class also uses a configfile-loading role based on L, such as L, L's C will load the configfile -specified by the C<--configfile> option for you. +specified by the C<--configfile> option (or the default you've +given for the configfile attribute) for you. + +Options specified in multiple places follow the following +precendence order: commandline overrides configfile, which +overrides explicit new_with_options parameters. =head2 Supported Type Constraints @@ -344,6 +378,9 @@ and then return a newly constructed object. If L fails (due to invalid arguments), C will throw an exception. +If you have L a the C param is also passed to +C. + =item B This accessor contains a reference to a copy of the C<@ARGV> array