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;
34 if (defined $configfile) {
35 $config_from_file = eval {
36 $class->get_config_from_file($configfile);
39 die $@ unless $@ =~ /Specified configfile '\Q$configfile\E' does not exist/;
44 $config_from_file = $class->get_config_from_file($configfile);
48 my $constructor_params = ( @params == 1 ? $params[0] : {@params} );
50 Carp::croak("Single parameters to new_with_options() must be a HASH ref")
51 unless ref($constructor_params) eq 'HASH';
53 my %processed = $class->_parse_argv(
55 $class->_attrs_to_options( $config_from_file )
57 params => $constructor_params,
60 my $params = $config_from_file ? { %$config_from_file, %{$processed{params}} } : $processed{params};
62 # did the user request usage information?
63 if ( $processed{usage} && ($params->{'?'} or $params->{help} or $params->{usage}) )
65 $processed{usage}->die();
69 ARGV => $processed{argv_copy},
70 extra_argv => $processed{argv},
71 %$constructor_params, # explicit params to ->new
72 %$params, # params from CLI
77 my ( $class, %params ) = @_;
79 local @ARGV = @{ $params{params}{argv} || \@ARGV };
81 my ( $opt_spec, $name_to_init_arg ) = ( HAVE_GLD ? $class->_gld_spec(%params) : $class->_traditional_spec(%params) );
83 # Get a clean copy of the original @ARGV
84 my $argv_copy = [ @ARGV ];
88 my ( $parsed_options, $usage ) = eval {
89 local $SIG{__WARN__} = sub { push @err, @_ };
92 return Getopt::Long::Descriptive::describe_options($class->_usage_format(%params), @$opt_spec);
95 Getopt::Long::GetOptions(\%options, @$opt_spec);
96 return ( \%options, undef );
100 die join "", grep { defined } @err, $@ if @err or $@;
102 # Get a copy of the Getopt::Long-mangled @ARGV
103 my $argv_mangled = [ @ARGV ];
105 my %constructor_args = (
107 $name_to_init_arg->{$_} => $parsed_options->{$_}
108 } keys %$parsed_options,
112 params => \%constructor_args,
113 argv_copy => $argv_copy,
114 argv => $argv_mangled,
115 ( defined($usage) ? ( usage => $usage ) : () ),
120 return "usage: %c %o";
123 sub _traditional_spec {
124 my ( $class, %params ) = @_;
126 my ( @options, %name_to_init_arg, %options );
128 foreach my $opt ( @{ $params{options} } ) {
129 push @options, $opt->{opt_string};
131 my $identifier = $opt->{name};
132 $identifier =~ s/\W/_/g; # Getopt::Long does this to all option names
134 $name_to_init_arg{$identifier} = $opt->{init_arg};
137 return ( \@options, \%name_to_init_arg );
141 my ( $class, %params ) = @_;
143 my ( @options, %name_to_init_arg );
145 my $constructor_params = $params{params};
147 foreach my $opt ( @{ $params{options} } ) {
150 $opt->{doc} || ' ', # FIXME new GLD shouldn't need this hack
152 ( ( $opt->{required} && !exists($constructor_params->{$opt->{init_arg}}) ) ? (required => $opt->{required}) : () ),
154 # remove this 'feature' because it didn't work
155 # all the time, and so is better to not bother
156 # since Moose will handle the defaults just
159 #( exists $opt->{default} ? (default => $opt->{default}) : () ),
163 my $identifier = $opt->{name};
164 $identifier =~ s/\W/_/g; # Getopt::Long does this to all option names
166 $name_to_init_arg{$identifier} = $opt->{init_arg};
169 return ( \@options, \%name_to_init_arg );
172 sub _compute_getopt_attrs {
175 $_->does("MooseX::Getopt::Meta::Attribute::Trait")
179 !$_->does('MooseX::Getopt::Meta::Attribute::Trait::NoGetopt')
180 } $class->meta->get_all_attributes
183 sub _get_cmd_flags_for_attr {
184 my ( $class, $attr ) = @_;
186 my $flag = $attr->name;
190 if ($attr->does('MooseX::Getopt::Meta::Attribute::Trait')) {
191 $flag = $attr->cmd_flag if $attr->has_cmd_flag;
192 @aliases = @{ $attr->cmd_aliases } if $attr->has_cmd_aliases;
195 return ( $flag, @aliases );
198 sub _attrs_to_options {
200 my $config_from_file = shift || {};
204 foreach my $attr ($class->_compute_getopt_attrs) {
205 my ( $flag, @aliases ) = $class->_get_cmd_flags_for_attr($attr);
207 my $opt_string = join(q{|}, $flag, @aliases);
209 if ($attr->name eq 'configfile') {
212 elsif ($attr->has_type_constraint) {
213 my $type = $attr->type_constraint;
214 if (MooseX::Getopt::OptionTypeMap->has_option_type($type)) {
215 $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type)
221 init_arg => $attr->init_arg,
222 opt_string => $opt_string,
223 required => $attr->is_required && !$attr->has_default && !$attr->has_builder && !exists $config_from_file->{$attr->name},
225 # this "feature" was breaking because
226 # Getopt::Long::Descriptive would return
227 # the default value as if it was a command
228 # line flag, which would then override the
229 # one passed into a constructor.
230 # See 100_gld_default_bug.t for an example
232 #( ( $attr->has_default && ( $attr->is_default_a_coderef xor $attr->is_lazy ) ) ? ( default => $attr->default({}) ) : () ),
233 ( $attr->has_documentation ? ( doc => $attr->documentation ) : () ),
248 MooseX::Getopt - A Moose role for processing command line options
256 with 'MooseX::Getopt';
258 has 'out' => (is => 'rw', isa => 'Str', required => 1);
259 has 'in' => (is => 'rw', isa => 'Str', required => 1);
261 # ... rest of the class here
268 my $app = My::App->new_with_options();
269 # ... rest of the script here
271 ## on the command line
272 % perl my_app_script.pl -in file.input -out file.dump
276 This is a role which provides an alternate constructor for creating
277 objects using parameters passed in from the command line.
279 This module attempts to DWIM as much as possible with the command line
280 params by introspecting your class's attributes. It will use the name
281 of your attribute as the command line option, and if there is a type
282 constraint defined, it will configure Getopt::Long to handle the option
285 You can use the trait L<MooseX::Getopt::Meta::Attribute::Trait> or the
286 attribute metaclass L<MooseX::Getopt::Meta::Attribute> to get non-default
287 commandline option names and aliases.
289 You can use the trait L<MooseX::Getopt::Meta::Attribute::Trait::NoGetopt>
290 or the attribute metaclass L<MooseX::Getopt::Meta::Attribute::NoGetopt>
291 to have C<MooseX::Getopt> ignore your attribute in the commandline options.
293 By default, attributes which start with an underscore are not given
294 commandline argument support, unless the attribute's metaclass is set
295 to L<MooseX::Getopt::Meta::Attribute>. If you don't want your accessors
296 to have the leading underscore in their name, you can do this:
298 # for read/write attributes
299 has '_foo' => (accessor => 'foo', ...);
301 # or for read-only attributes
302 has '_bar' => (reader => 'bar', ...);
304 This will mean that Getopt will not handle a --foo param, but your
305 code can still call the C<foo> method.
307 If your class also uses a configfile-loading role based on
308 L<MooseX::ConfigFromFile>, such as L<MooseX::SimpleConfig>,
309 L<MooseX::Getopt>'s C<new_with_options> will load the configfile
310 specified by the C<--configfile> option (or the default you've
311 given for the configfile attribute) for you.
313 Options specified in multiple places follow the following
314 precendence order: commandline overrides configfile, which
315 overrides explicit new_with_options parameters.
317 =head2 Supported Type Constraints
323 A I<Bool> type constraint is set up as a boolean option with
324 Getopt::Long. So that this attribute description:
326 has 'verbose' => (is => 'rw', isa => 'Bool');
328 would translate into C<verbose!> as a Getopt::Long option descriptor,
329 which would enable the following command line options:
331 % my_script.pl --verbose
332 % my_script.pl --noverbose
334 =item I<Int>, I<Float>, I<Str>
336 These type constraints are set up as properly typed options with
337 Getopt::Long, using the C<=i>, C<=f> and C<=s> modifiers as appropriate.
341 An I<ArrayRef> type constraint is set up as a multiple value option
342 in Getopt::Long. So that this attribute description:
347 default => sub { [] }
350 would translate into C<includes=s@> as a Getopt::Long option descriptor,
351 which would enable the following command line options:
353 % my_script.pl --include /usr/lib --include /usr/local/lib
357 A I<HashRef> type constraint is set up as a hash value option
358 in Getopt::Long. So that this attribute description:
363 default => sub { {} }
366 would translate into C<define=s%> as a Getopt::Long option descriptor,
367 which would enable the following command line options:
369 % my_script.pl --define os=linux --define vendor=debian
373 =head2 Custom Type Constraints
375 It is possible to create custom type constraint to option spec
376 mappings if you need them. The process is fairly simple (but a
377 little verbose maybe). First you create a custom subtype, like
380 subtype 'ArrayOfInts'
382 => where { scalar (grep { looks_like_number($_) } @$_) };
384 Then you register the mapping, like so:
386 MooseX::Getopt::OptionTypeMap->add_option_type_to_map(
387 'ArrayOfInts' => '=i@'
390 Now any attribute declarations using this type constraint will
391 get the custom option spec. So that, this:
395 isa => 'ArrayOfInts',
396 default => sub { [0] }
399 Will translate to the following on the command line:
401 % my_script.pl --nums 5 --nums 88 --nums 199
403 This example is fairly trivial, but more complex validations are
404 easily possible with a little creativity. The trick is balancing
405 the type constraint validations with the Getopt::Long validations.
407 Better examples are certainly welcome :)
409 =head2 Inferred Type Constraints
411 If you define a custom subtype which is a subtype of one of the
412 standard L</Supported Type Constraints> above, and do not explicitly
413 provide custom support as in L</Custom Type Constraints> above,
414 MooseX::Getopt will treat it like the parent type for Getopt
417 For example, if you had the same custom C<ArrayOfInts> subtype
418 from the examples above, but did not add a new custom option
419 type for it to the C<OptionTypeMap>, it would be treated just
420 like a normal C<ArrayRef> type for Getopt purposes (that is,
427 =item B<new_with_options (%params)>
429 This method will take a set of default C<%params> and then collect
430 params from the command line (possibly overriding those in C<%params>)
431 and then return a newly constructed object.
433 The special parameter C<argv>, if specified should point to an array
434 reference with an array to use instead of C<@ARGV>.
436 If L<Getopt::Long/GetOptions> fails (due to invalid arguments),
437 C<new_with_options> will throw an exception.
439 If L<Getopt::Long::Descriptive> is installed and any of the following
440 command line params are passed, the program will exit with usage
441 information. You can add descriptions for each option by including a
442 B<documentation> option for each attribute to document.
448 If you have L<Getopt::Long::Descriptive> the C<usage> param is also passed to
453 This accessor contains a reference to a copy of the C<@ARGV> array
454 as it originally existed at the time of C<new_with_options>.
458 This accessor contains an arrayref of leftover C<@ARGV> elements that
459 L<Getopt::Long> did not parse. Note that the real C<@ARGV> is left
464 This returns the role meta object.
470 All complex software has bugs lurking in it, and this module is no
471 exception. If you find a bug please either email me, or add the bug
476 Stevan Little E<lt>stevan@iinteractive.comE<gt>
478 Brandon L. Black, E<lt>blblack@gmail.comE<gt>
480 Yuval Kogman, E<lt>nothingmuch@woobling.orgE<gt>
484 Ryan D Johnson, E<lt>ryan@innerfence.comE<gt>
486 Drew Taylor, E<lt>drew@drewtaylor.comE<gt>
488 =head1 COPYRIGHT AND LICENSE
490 Copyright 2007-2008 by Infinity Interactive, Inc.
492 L<http://www.iinteractive.com>
494 This library is free software; you can redistribute it and/or modify
495 it under the same terms as Perl itself.