2 package MooseX::Getopt;
5 use MooseX::Getopt::OptionTypeMap;
6 use MooseX::Getopt::Meta::Attribute;
7 use MooseX::Getopt::Meta::Attribute::NoGetopt;
11 use Getopt::Long (); # GLD uses it anyway, doesn't hurt
12 use constant HAVE_GLD => not not eval { require Getopt::Long::Descriptive };
14 our $VERSION = '0.20';
15 our $AUTHORITY = 'cpan:STEVAN';
17 has ARGV => (is => 'rw', isa => 'ArrayRef', metaclass => "NoGetopt");
18 has extra_argv => (is => 'rw', isa => 'ArrayRef', metaclass => "NoGetopt");
20 sub new_with_options {
21 my ($class, @params) = @_;
24 if($class->meta->does_role('MooseX::ConfigFromFile')) {
28 my $opt_parser = Getopt::Long::Parser->new( config => [ qw( pass_through ) ] );
29 $opt_parser->getoptions( "configfile=s" => \$configfile );
31 if(!defined $configfile) {
32 my $cfmeta = $class->meta->find_attribute_by_name('configfile');
33 $configfile = $cfmeta->default if $cfmeta->has_default;
36 if(defined $configfile) {
37 $config_from_file = $class->get_config_from_file($configfile);
41 my $constructor_params = ( @params == 1 ? $params[0] : {@params} );
43 Carp::croak("Single parameters to new_with_options() must be a HASH ref")
44 unless ref($constructor_params) eq 'HASH';
46 my %processed = $class->_parse_argv(
48 $class->_attrs_to_options( $config_from_file )
50 params => $constructor_params,
53 my $params = $config_from_file ? { %$config_from_file, %{$processed{params}} } : $processed{params};
55 # did the user request usage information?
56 if ( $processed{usage} && ($params->{'?'} or $params->{help} or $params->{usage}) )
58 $processed{usage}->die();
62 ARGV => $processed{argv_copy},
63 extra_argv => $processed{argv},
64 %$constructor_params, # explicit params to ->new
65 %$params, # params from CLI
70 my ( $class, %params ) = @_;
72 local @ARGV = @{ $params{params}{argv} || \@ARGV };
74 my $use_gld = (HAVE_GLD && !$params{params}{disable_gld});
76 my ( $opt_spec, $name_to_init_arg ) = ( $use_gld ? $class->_gld_spec(%params) : $class->_traditional_spec(%params) );
78 # Get a clean copy of the original @ARGV
79 my $argv_copy = [ @ARGV ];
83 my ( $parsed_options, $usage ) = eval {
84 local $SIG{__WARN__} = sub { push @err, @_ };
87 return Getopt::Long::Descriptive::describe_options($class->_usage_format(%params), @$opt_spec);
90 Getopt::Long::GetOptions(\%options, @$opt_spec);
91 return ( \%options, undef );
95 die join "", grep { defined } @err, $@ if @err or $@;
97 # Get a copy of the Getopt::Long-mangled @ARGV
98 my $argv_mangled = [ @ARGV ];
100 my %constructor_args = (
102 $name_to_init_arg->{$_} => $parsed_options->{$_}
103 } keys %$parsed_options,
107 params => \%constructor_args,
108 argv_copy => $argv_copy,
109 argv => $argv_mangled,
110 ( defined($usage) ? ( usage => $usage ) : () ),
115 return "usage: %c %o";
118 sub _traditional_spec {
119 my ( $class, %params ) = @_;
121 my ( @options, %name_to_init_arg, %options );
123 foreach my $opt ( @{ $params{options} } ) {
124 push @options, $opt->{opt_string};
126 my $identifier = $opt->{name};
127 $identifier =~ s/\W/_/g; # Getopt::Long does this to all option names
129 $name_to_init_arg{$identifier} = $opt->{init_arg};
132 return ( \@options, \%name_to_init_arg );
136 my ( $class, %params ) = @_;
138 my ( @options, %name_to_init_arg );
140 my $constructor_params = $params{params};
142 foreach my $opt ( @{ $params{options} } ) {
145 $opt->{doc} || ' ', # FIXME new GLD shouldn't need this hack
147 ( ( $opt->{required} && !exists($constructor_params->{$opt->{init_arg}}) ) ? (required => $opt->{required}) : () ),
149 # remove this 'feature' because it didn't work
150 # all the time, and so is better to not bother
151 # since Moose will handle the defaults just
154 #( exists $opt->{default} ? (default => $opt->{default}) : () ),
158 my $identifier = $opt->{name};
159 $identifier =~ s/\W/_/g; # Getopt::Long does this to all option names
161 $name_to_init_arg{$identifier} = $opt->{init_arg};
164 return ( \@options, \%name_to_init_arg );
167 sub _compute_getopt_attrs {
170 $_->does("MooseX::Getopt::Meta::Attribute::Trait")
174 !$_->does('MooseX::Getopt::Meta::Attribute::Trait::NoGetopt')
175 } $class->meta->get_all_attributes
178 sub _get_cmd_flags_for_attr {
179 my ( $class, $attr ) = @_;
181 my $flag = $attr->name;
185 if ($attr->does('MooseX::Getopt::Meta::Attribute::Trait')) {
186 $flag = $attr->cmd_flag if $attr->has_cmd_flag;
187 @aliases = @{ $attr->cmd_aliases } if $attr->has_cmd_aliases;
190 return ( $flag, @aliases );
193 sub _attrs_to_options {
195 my $config_from_file = shift || {};
199 foreach my $attr ($class->_compute_getopt_attrs) {
200 my ( $flag, @aliases ) = $class->_get_cmd_flags_for_attr($attr);
202 my $opt_string = join(q{|}, $flag, @aliases);
204 if ($attr->name eq 'configfile') {
207 elsif ($attr->has_type_constraint) {
208 my $type = $attr->type_constraint;
209 if (MooseX::Getopt::OptionTypeMap->has_option_type($type)) {
210 $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type)
216 init_arg => $attr->init_arg,
217 opt_string => $opt_string,
218 required => $attr->is_required && !$attr->has_default && !$attr->has_builder && !exists $config_from_file->{$attr->name},
220 # this "feature" was breaking because
221 # Getopt::Long::Descriptive would return
222 # the default value as if it was a command
223 # line flag, which would then override the
224 # one passed into a constructor.
225 # See 100_gld_default_bug.t for an example
227 #( ( $attr->has_default && ( $attr->is_default_a_coderef xor $attr->is_lazy ) ) ? ( default => $attr->default({}) ) : () ),
228 ( $attr->has_documentation ? ( doc => $attr->documentation ) : () ),
243 MooseX::Getopt - A Moose role for processing command line options
251 with 'MooseX::Getopt';
253 has 'out' => (is => 'rw', isa => 'Str', required => 1);
254 has 'in' => (is => 'rw', isa => 'Str', required => 1);
256 # ... rest of the class here
263 my $app = My::App->new_with_options();
264 # ... rest of the script here
266 ## on the command line
267 % perl my_app_script.pl -in file.input -out file.dump
271 This is a role which provides an alternate constructor for creating
272 objects using parameters passed in from the command line.
274 This module attempts to DWIM as much as possible with the command line
275 params by introspecting your class's attributes. It will use the name
276 of your attribute as the command line option, and if there is a type
277 constraint defined, it will configure Getopt::Long to handle the option
280 You can use the trait L<MooseX::Getopt::Meta::Attribute::Trait> or the
281 attribute metaclass L<MooseX::Getopt::Meta::Attribute> to get non-default
282 commandline option names and aliases.
284 You can use the trait L<MooseX::Getopt::Meta::Attribute::Trait::NoGetopt>
285 or the attribute metaclass L<MooseX::Getopt::Meta::Attribute::NoGetopt>
286 to have C<MooseX::Getopt> ignore your attribute in the commandline options.
288 By default, attributes which start with an underscore are not given
289 commandline argument support, unless the attribute's metaclass is set
290 to L<MooseX::Getopt::Meta::Attribute>. If you don't want you accessors
291 to have the leading underscore in thier name, you can do this:
293 # for read/write attributes
294 has '_foo' => (accessor => 'foo', ...);
296 # or for read-only attributes
297 has '_bar' => (reader => 'bar', ...);
299 This will mean that Getopt will not handle a --foo param, but your
300 code can still call the C<foo> method.
302 If your class also uses a configfile-loading role based on
303 L<MooseX::ConfigFromFile>, such as L<MooseX::SimpleConfig>,
304 L<MooseX::Getopt>'s C<new_with_options> will load the configfile
305 specified by the C<--configfile> option (or the default you've
306 given for the configfile attribute) for you.
308 Options specified in multiple places follow the following
309 precendence order: commandline overrides configfile, which
310 overrides explicit new_with_options parameters.
312 =head2 Supported Type Constraints
318 A I<Bool> type constraint is set up as a boolean option with
319 Getopt::Long. So that this attribute description:
321 has 'verbose' => (is => 'rw', isa => 'Bool');
323 would translate into C<verbose!> as a Getopt::Long option descriptor,
324 which would enable the following command line options:
326 % my_script.pl --verbose
327 % my_script.pl --noverbose
329 =item I<Int>, I<Float>, I<Str>
331 These type constraints are set up as properly typed options with
332 Getopt::Long, using the C<=i>, C<=f> and C<=s> modifiers as appropriate.
336 An I<ArrayRef> type constraint is set up as a multiple value option
337 in Getopt::Long. So that this attribute description:
342 default => sub { [] }
345 would translate into C<includes=s@> as a Getopt::Long option descriptor,
346 which would enable the following command line options:
348 % my_script.pl --include /usr/lib --include /usr/local/lib
352 A I<HashRef> type constraint is set up as a hash value option
353 in Getopt::Long. So that this attribute description:
358 default => sub { {} }
361 would translate into C<define=s%> as a Getopt::Long option descriptor,
362 which would enable the following command line options:
364 % my_script.pl --define os=linux --define vendor=debian
368 =head2 Custom Type Constraints
370 It is possible to create custom type constraint to option spec
371 mappings if you need them. The process is fairly simple (but a
372 little verbose maybe). First you create a custom subtype, like
375 subtype 'ArrayOfInts'
377 => where { scalar (grep { looks_like_number($_) } @$_) };
379 Then you register the mapping, like so:
381 MooseX::Getopt::OptionTypeMap->add_option_type_to_map(
382 'ArrayOfInts' => '=i@'
385 Now any attribute declarations using this type constraint will
386 get the custom option spec. So that, this:
390 isa => 'ArrayOfInts',
391 default => sub { [0] }
394 Will translate to the following on the command line:
396 % my_script.pl --nums 5 --nums 88 --nums 199
398 This example is fairly trivial, but more complex validations are
399 easily possible with a little creativity. The trick is balancing
400 the type constraint validations with the Getopt::Long validations.
402 Better examples are certainly welcome :)
404 =head2 Inferred Type Constraints
406 If you define a custom subtype which is a subtype of one of the
407 standard L</Supported Type Constraints> above, and do not explicitly
408 provide custom support as in L</Custom Type Constraints> above,
409 MooseX::Getopt will treat it like the parent type for Getopt
412 For example, if you had the same custom C<ArrayOfInts> subtype
413 from the examples above, but did not add a new custom option
414 type for it to the C<OptionTypeMap>, it would be treated just
415 like a normal C<ArrayRef> type for Getopt purposes (that is,
422 =item B<new_with_options (%params)>
424 This method will take a set of default C<%params> and then collect
425 params from the command line (possibly overriding those in C<%params>)
426 and then return a newly constructed object.
428 The special parameter C<argv>, if specified should point to an array
429 reference with an array to use instead of C<@ARGV>.
431 The paramater C<disable_gld>, if specified and a true value will disable
432 the use of L<Getopt::Long::Descriptive> .
434 If L<Getopt::Long/GetOptions> fails (due to invalid arguments),
435 C<new_with_options> will throw an exception.
437 If L<Getopt::Long::Descriptive> is installed and any of the following
438 command line params are passed, the program will exit with usage
439 information. You can add descriptions for each option by including a
440 B<documentation> option for each attribute to document.
446 If you have L<Getopt::Long::Descriptive> a the C<usage> param is also passed to
451 This accessor contains a reference to a copy of the C<@ARGV> array
452 as it originally existed at the time of C<new_with_options>.
456 This accessor contains an arrayref of leftover C<@ARGV> elements that
457 L<Getopt::Long> did not parse. Note that the real C<@ARGV> is left
462 This returns the role meta object.
468 All complex software has bugs lurking in it, and this module is no
469 exception. If you find a bug please either email me, or add the bug
474 Stevan Little E<lt>stevan@iinteractive.comE<gt>
476 Brandon L. Black, E<lt>blblack@gmail.comE<gt>
478 Yuval Kogman, E<lt>nothingmuch@woobling.orgE<gt>
482 Ryan D Johnson, E<lt>ryan@innerfence.comE<gt>
484 Drew Taylor, E<lt>drew@drewtaylor.comE<gt>
486 =head1 COPYRIGHT AND LICENSE
488 Copyright 2007-2008 by Infinity Interactive, Inc.
490 L<http://www.iinteractive.com>
492 This library is free software; you can redistribute it and/or modify
493 it under the same terms as Perl itself.