X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FGetopt.pm;h=cc265b5f5a9bd342d745a57a9a2384df8b3ae2ed;hb=035b1668f1af3262c54a6f6692b0dc50ab388020;hp=01904f30fcece7aa1cc159e5e95f957f1632e443;hpb=ef47fe440114bcfc790464f79e476ef7defb0a67;p=gitmo%2FMooseX-Getopt.git diff --git a/lib/MooseX/Getopt.pm b/lib/MooseX/Getopt.pm index 01904f3..cc265b5 100644 --- a/lib/MooseX/Getopt.pm +++ b/lib/MooseX/Getopt.pm @@ -11,14 +11,9 @@ 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.20'; +our $VERSION = '0.23'; our $AUTHORITY = 'cpan:STEVAN'; -my @roles = ('MooseX::Getopt::Basic'); -if (HAVE_GLD) { push @roles, 'MooseX::Getopt::GLD' } - -with @roles; - has ARGV => (is => 'rw', isa => 'ArrayRef', metaclass => "NoGetopt"); has extra_argv => (is => 'rw', isa => 'ArrayRef', metaclass => "NoGetopt"); @@ -36,15 +31,27 @@ sub new_with_options { if(!defined $configfile) { my $cfmeta = $class->meta->find_attribute_by_name('configfile'); $configfile = $cfmeta->default if $cfmeta->has_default; + if (ref $configfile eq 'CODE') { + # not sure theres a lot you can do with the class and may break some assumptions + # warn? + $configfile = &$configfile($class); + } + if (defined $configfile) { + $config_from_file = eval { + $class->get_config_from_file($configfile); + }; + if ($@) { + die $@ unless $@ =~ /Specified configfile '\Q$configfile\E' does not exist/; + } + } } - - if(defined $configfile) { + else { $config_from_file = $class->get_config_from_file($configfile); } } 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'; @@ -76,7 +83,7 @@ sub _parse_argv { local @ARGV = @{ $params{params}{argv} || \@ARGV }; - my ( $opt_spec, $name_to_init_arg ) = $class->_getopt_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 ]; @@ -86,7 +93,13 @@ sub _parse_argv { my ( $parsed_options, $usage ) = eval { local $SIG{__WARN__} = sub { push @err, @_ }; - return $class->_get_options(\%params, $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 $@; @@ -120,7 +133,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}; @@ -152,7 +165,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}; @@ -284,8 +297,8 @@ 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 -to have the leading underscore in thier name, you can do this: +to L. If you don't want your accessors +to have the leading underscore in their name, you can do this: # for read/write attributes has '_foo' => (accessor => 'foo', ...); @@ -422,12 +435,9 @@ 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>. -The paramater C, if specified and a true value will disable -the use of L . - If L fails (due to invalid arguments), C will throw an exception. @@ -440,7 +450,7 @@ B option for each attribute to document. --help --usage -If you have L a the C param is also passed to +If you have L the C param is also passed to C. =item B @@ -458,10 +468,6 @@ un-mangled. This returns the role meta object. -=item B - -A constant for internal use. - =back =head1 BUGS