X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FGetopt.pm;h=5c72fcdf2c848ed1244160451ba4efeb860b21a8;hb=89543df300c7060f7b90c8a5e322271884c87da1;hp=d0dbb3f70180d36965c710be2403d73a7a1b902b;hpb=aa03fdad265261c3f67fdab12140ef2a3863a539;p=gitmo%2FMooseX-Getopt.git diff --git a/lib/MooseX/Getopt.pm b/lib/MooseX/Getopt.pm index d0dbb3f..5c72fcd 100644 --- a/lib/MooseX/Getopt.pm +++ b/lib/MooseX/Getopt.pm @@ -11,7 +11,7 @@ use Carp (); use Getopt::Long (); # GLD uses it anyway, doesn't hurt use constant HAVE_GLD => not not eval { require Getopt::Long::Descriptive }; -our $VERSION = '0.21'; +our $VERSION = '0.25'; our $AUTHORITY = 'cpan:STEVAN'; has ARGV => (is => 'rw', isa => 'ArrayRef', metaclass => "NoGetopt"); @@ -51,7 +51,7 @@ sub new_with_options { } my $constructor_params = ( @params == 1 ? $params[0] : {@params} ); - + Carp::croak("Single parameters to new_with_options() must be a HASH ref") unless ref($constructor_params) eq 'HASH'; @@ -88,10 +88,9 @@ sub _parse_argv { # Get a clean copy of the original @ARGV my $argv_copy = [ @ARGV ]; - my @err; - + my @warnings; my ( $parsed_options, $usage ) = eval { - local $SIG{__WARN__} = sub { push @err, @_ }; + local $SIG{__WARN__} = sub { push @warnings, @_ }; if ( HAVE_GLD ) { return Getopt::Long::Descriptive::describe_options($class->_usage_format(%params), @$opt_spec); @@ -102,7 +101,8 @@ sub _parse_argv { } }; - die join "", grep { defined } @err, $@ if @err or $@; + $class->_getopt_spec_warnings(@warnings) if @warnings; + $class->_getopt_spec_exception(\@warnings, $@) if $@; # Get a copy of the Getopt::Long-mangled @ARGV my $argv_mangled = [ @ARGV ]; @@ -121,6 +121,13 @@ sub _parse_argv { ); } +sub _getopt_spec_warnings { } + +sub _getopt_spec_exception { + my ($self, $warnings, $exception) = @_; + die @$warnings, $exception; +} + sub _usage_format { return "usage: %c %o"; } @@ -133,7 +140,7 @@ sub _traditional_spec { foreach my $opt ( @{ $params{options} } ) { push @options, $opt->{opt_string}; - my $identifier = $opt->{name}; + 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}; @@ -165,7 +172,7 @@ sub _gld_spec { }, ]; - my $identifier = $opt->{name}; + 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}; @@ -435,7 +442,7 @@ This method will take a set of default C<%params> and then collect params from the command line (possibly overriding those in C<%params>) and then return a newly constructed object. -The special parameter C, if specified should point to an array +The special parameter C, if specified should point to an array reference with an array to use instead of C<@ARGV>. If L fails (due to invalid arguments),