X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FGetopt.pm;h=7011a5584e3e04ae46494d56a898a21a3ef20780;hb=6bb4cb66b12d95e6e9bb764eed6fb10cb55383ea;hp=6d1ab259d53bd5f405ac9689aefae29019e3d002;hpb=0f8232b66e0f72e35099ce203962a4efc23838cf;p=gitmo%2FMooseX-Getopt.git diff --git a/lib/MooseX/Getopt.pm b/lib/MooseX/Getopt.pm index 6d1ab25..7011a55 100644 --- a/lib/MooseX/Getopt.pm +++ b/lib/MooseX/Getopt.pm @@ -2,13 +2,13 @@ package MooseX::Getopt; use Moose::Role; -use Getopt::Long (); +use Getopt::Long::Descriptive (); use MooseX::Getopt::OptionTypeMap; use MooseX::Getopt::Meta::Attribute; use MooseX::Getopt::Meta::Attribute::NoGetopt; -our $VERSION = '0.06'; +our $VERSION = '0.08'; our $AUTHORITY = 'cpan:STEVAN'; has ARGV => (is => 'rw', isa => 'ArrayRef'); @@ -23,11 +23,21 @@ 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, + ); + } + $class->new( ARGV => $processed{argv_copy}, extra_argv => $processed{argv}, @params, # explicit params to ->new - %{ $processed{params} }, # params from CLI + %$params, # params from CLI ); } @@ -36,20 +46,32 @@ sub _parse_argv { local @ARGV = @{ $params{argv} || \@ARGV }; - my ( @options, %name_to_init_arg, %options ); + my ( @options, %name_to_init_arg ); foreach my $opt ( @{ $params{options} } ) { - push @options, $opt->{opt_string}; + push @options, [ + $opt->{opt_string}, + $opt->{doc} || ' ', + { + ( $opt->{required} ? (required => $opt->{required}) : () ), + ( exists $opt->{default} ? (default => $opt->{default}) : () ), + }, + ]; + $name_to_init_arg{ $opt->{name} } = $opt->{init_arg}; } # Get a clean copy of the original @ARGV my $argv_copy = [ @ARGV ]; - { - local $SIG{__WARN__} = sub { die $_[0] }; - Getopt::Long::GetOptions(\%options, @options); - } + my @err; + + my ( $parsed_options, $usage ) = eval { + local $SIG{__WARN__} = sub { push @err, @_ }; + Getopt::Long::Descriptive::describe_options("usage: %c %o", @options) + }; + + die join "", grep { defined } @err, $@ if @err or $@; # Get a copy of the Getopt::Long-mangled @ARGV my $argv_mangled = [ @ARGV ]; @@ -59,8 +81,8 @@ sub _parse_argv { argv => $argv_mangled, params => { map { - $name_to_init_arg{$_} => $options{$_} - } keys %options, + $name_to_init_arg{$_} => $parsed_options->{$_} + } keys %$parsed_options, } ); } @@ -97,8 +119,8 @@ sub _attrs_to_options { if ($attr->has_type_constraint) { my $type_name = $attr->type_constraint->name; - if (MooseX::Getopt::OptionTypeMap->has_option_type($type_name)) { - $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type_name); + if (MooseX::Getopt::OptionTypeMap->has_option_type($type_name)) { + $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type_name) } } @@ -107,6 +129,7 @@ sub _attrs_to_options { init_arg => $attr->init_arg, opt_string => $opt_string, required => $attr->is_required, + ( ( $attr->has_default && ( $attr->is_default_a_coderef xor $attr->is_lazy ) ) ? ( default => $attr->default({}) ) : () ), ( $attr->has_documentation ? ( doc => $attr->documentation ) : () ), } } @@ -179,6 +202,11 @@ to have the leading underscore in thier name, you can do this: This will mean that Getopt will not handle a --foo param, but your 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. + =head2 Supported Type Constraints =over 4