1 package MooseX::Getopt::Basic;
4 use MooseX::Getopt::OptionTypeMap;
5 use MooseX::Getopt::Meta::Attribute;
6 use MooseX::Getopt::Meta::Attribute::NoGetopt;
9 use Getopt::Long (); # GLD uses it anyway, doesn't hurt
11 our $VERSION = '0.20';
12 our $AUTHORITY = 'cpan:STEVAN';
14 has ARGV => (is => 'rw', isa => 'ArrayRef', metaclass => "NoGetopt");
15 has extra_argv => (is => 'rw', isa => 'ArrayRef', metaclass => "NoGetopt");
17 # _getopt_spec() and _getoptions() are overrided by MooseX::Getopt::GLD.
20 my ($class, %params) = @_;
21 return $class->_traditional_spec(%params)
25 my ($class, undef, $opt_spec) = @_;
27 Getopt::Long::GetOptions(\%options, @$opt_spec);
28 return ( \%options, undef );
31 sub new_with_options {
32 my ($class, @params) = @_;
35 if($class->meta->does_role('MooseX::ConfigFromFile')) {
39 my $opt_parser = Getopt::Long::Parser->new( config => [ qw( pass_through ) ] );
40 $opt_parser->getoptions( "configfile=s" => \$configfile );
42 if(!defined $configfile) {
43 my $cfmeta = $class->meta->find_attribute_by_name('configfile');
44 $configfile = $cfmeta->default if $cfmeta->has_default;
47 if(defined $configfile) {
48 $config_from_file = $class->get_config_from_file($configfile);
52 my $constructor_params = ( @params == 1 ? $params[0] : {@params} );
54 Carp::croak("Single parameters to new_with_options() must be a HASH ref")
55 unless ref($constructor_params) eq 'HASH';
57 my %processed = $class->_parse_argv(
59 $class->_attrs_to_options( $config_from_file )
61 params => $constructor_params,
64 my $params = $config_from_file ? { %$config_from_file, %{$processed{params}} } : $processed{params};
66 # did the user request usage information?
67 if ( $processed{usage} && ($params->{'?'} or $params->{help} or $params->{usage}) )
69 $processed{usage}->die();
73 ARGV => $processed{argv_copy},
74 extra_argv => $processed{argv},
75 %$constructor_params, # explicit params to ->new
76 %$params, # params from CLI
81 my ( $class, %params ) = @_;
83 local @ARGV = @{ $params{params}{argv} || \@ARGV };
85 my ( $opt_spec, $name_to_init_arg ) = $class->_getopt_spec(%params);
87 # Get a clean copy of the original @ARGV
88 my $argv_copy = [ @ARGV ];
92 my ( $parsed_options, $usage ) = eval {
93 local $SIG{__WARN__} = sub { push @err, @_ };
95 return $class->_get_options(\%params, $opt_spec);
98 die join "", grep { defined } @err, $@ if @err or $@;
100 # Get a copy of the Getopt::Long-mangled @ARGV
101 my $argv_mangled = [ @ARGV ];
103 my %constructor_args = (
105 $name_to_init_arg->{$_} => $parsed_options->{$_}
106 } keys %$parsed_options,
110 params => \%constructor_args,
111 argv_copy => $argv_copy,
112 argv => $argv_mangled,
113 ( defined($usage) ? ( usage => $usage ) : () ),
118 return "usage: %c %o";
121 sub _traditional_spec {
122 my ( $class, %params ) = @_;
124 my ( @options, %name_to_init_arg, %options );
126 foreach my $opt ( @{ $params{options} } ) {
127 push @options, $opt->{opt_string};
129 my $identifier = $opt->{name};
130 $identifier =~ s/\W/_/g; # Getopt::Long does this to all option names
132 $name_to_init_arg{$identifier} = $opt->{init_arg};
135 return ( \@options, \%name_to_init_arg );
139 my ( $class, %params ) = @_;
141 my ( @options, %name_to_init_arg );
143 my $constructor_params = $params{params};
145 foreach my $opt ( @{ $params{options} } ) {
148 $opt->{doc} || ' ', # FIXME new GLD shouldn't need this hack
150 ( ( $opt->{required} && !exists($constructor_params->{$opt->{init_arg}}) ) ? (required => $opt->{required}) : () ),
152 # remove this 'feature' because it didn't work
153 # all the time, and so is better to not bother
154 # since Moose will handle the defaults just
157 #( exists $opt->{default} ? (default => $opt->{default}) : () ),
161 my $identifier = $opt->{name};
162 $identifier =~ s/\W/_/g; # Getopt::Long does this to all option names
164 $name_to_init_arg{$identifier} = $opt->{init_arg};
167 return ( \@options, \%name_to_init_arg );
170 sub _compute_getopt_attrs {
173 $_->does("MooseX::Getopt::Meta::Attribute::Trait")
177 !$_->does('MooseX::Getopt::Meta::Attribute::Trait::NoGetopt')
178 } $class->meta->get_all_attributes
181 sub _get_cmd_flags_for_attr {
182 my ( $class, $attr ) = @_;
184 my $flag = $attr->name;
188 if ($attr->does('MooseX::Getopt::Meta::Attribute::Trait')) {
189 $flag = $attr->cmd_flag if $attr->has_cmd_flag;
190 @aliases = @{ $attr->cmd_aliases } if $attr->has_cmd_aliases;
193 return ( $flag, @aliases );
196 sub _attrs_to_options {
198 my $config_from_file = shift || {};
202 foreach my $attr ($class->_compute_getopt_attrs) {
203 my ( $flag, @aliases ) = $class->_get_cmd_flags_for_attr($attr);
205 my $opt_string = join(q{|}, $flag, @aliases);
207 if ($attr->name eq 'configfile') {
210 elsif ($attr->has_type_constraint) {
211 my $type = $attr->type_constraint;
212 if (MooseX::Getopt::OptionTypeMap->has_option_type($type)) {
213 $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type)
219 init_arg => $attr->init_arg,
220 opt_string => $opt_string,
221 required => $attr->is_required && !$attr->has_default && !$attr->has_builder && !exists $config_from_file->{$attr->name},
223 # this "feature" was breaking because
224 # Getopt::Long::Descriptive would return
225 # the default value as if it was a command
226 # line flag, which would then override the
227 # one passed into a constructor.
228 # See 100_gld_default_bug.t for an example
230 #( ( $attr->has_default && ( $attr->is_default_a_coderef xor $attr->is_lazy ) ) ? ( default => $attr->default({}) ) : () ),
231 ( $attr->has_documentation ? ( doc => $attr->documentation ) : () ),
246 MooseX::Getopt::Basic - role to implement the basic functionality of
247 L<MooseX::Getopt> without GLD.
255 with 'MooseX::Getopt';
257 has 'out' => (is => 'rw', isa => 'Str', required => 1);
258 has 'in' => (is => 'rw', isa => 'Str', required => 1);
260 # ... rest of the class here
267 my $app = My::App->new_with_options();
268 # ... rest of the script here
270 ## on the command line
271 % perl my_app_script.pl -in file.input -out file.dump
275 This is a role which provides an alternate constructor for creating
276 objects using parameters passed in from the command line.
278 This module attempts to DWIM as much as possible with the command line
279 params by introspecting your class's attributes. It will use the name
280 of your attribute as the command line option, and if there is a type
281 constraint defined, it will configure Getopt::Long to handle the option
284 You can use the trait L<MooseX::Getopt::Meta::Attribute::Trait> or the
285 attribute metaclass L<MooseX::Getopt::Meta::Attribute> to get non-default
286 commandline option names and aliases.
288 You can use the trait L<MooseX::Getopt::Meta::Attribute::Trait::NoGetopt>
289 or the attribute metaclass L<MooseX::Getopt::Meta::Attribute::NoGetopt>
290 to have C<MooseX::Getopt> ignore your attribute in the commandline options.
292 By default, attributes which start with an underscore are not given
293 commandline argument support, unless the attribute's metaclass is set
294 to L<MooseX::Getopt::Meta::Attribute>. If you don't want you accessors
295 to have the leading underscore in thier name, you can do this:
297 # for read/write attributes
298 has '_foo' => (accessor => 'foo', ...);
300 # or for read-only attributes
301 has '_bar' => (reader => 'bar', ...);
303 This will mean that Getopt will not handle a --foo param, but your
304 code can still call the C<foo> method.
306 If your class also uses a configfile-loading role based on
307 L<MooseX::ConfigFromFile>, such as L<MooseX::SimpleConfig>,
308 L<MooseX::Getopt>'s C<new_with_options> will load the configfile
309 specified by the C<--configfile> option (or the default you've
310 given for the configfile attribute) for you.
312 Options specified in multiple places follow the following
313 precendence order: commandline overrides configfile, which
314 overrides explicit new_with_options parameters.
316 =head2 Supported Type Constraints
322 A I<Bool> type constraint is set up as a boolean option with
323 Getopt::Long. So that this attribute description:
325 has 'verbose' => (is => 'rw', isa => 'Bool');
327 would translate into C<verbose!> as a Getopt::Long option descriptor,
328 which would enable the following command line options:
330 % my_script.pl --verbose
331 % my_script.pl --noverbose
333 =item I<Int>, I<Float>, I<Str>
335 These type constraints are set up as properly typed options with
336 Getopt::Long, using the C<=i>, C<=f> and C<=s> modifiers as appropriate.
340 An I<ArrayRef> type constraint is set up as a multiple value option
341 in Getopt::Long. So that this attribute description:
346 default => sub { [] }
349 would translate into C<includes=s@> as a Getopt::Long option descriptor,
350 which would enable the following command line options:
352 % my_script.pl --include /usr/lib --include /usr/local/lib
356 A I<HashRef> type constraint is set up as a hash value option
357 in Getopt::Long. So that this attribute description:
362 default => sub { {} }
365 would translate into C<define=s%> as a Getopt::Long option descriptor,
366 which would enable the following command line options:
368 % my_script.pl --define os=linux --define vendor=debian
372 =head2 Custom Type Constraints
374 It is possible to create custom type constraint to option spec
375 mappings if you need them. The process is fairly simple (but a
376 little verbose maybe). First you create a custom subtype, like
379 subtype 'ArrayOfInts'
381 => where { scalar (grep { looks_like_number($_) } @$_) };
383 Then you register the mapping, like so:
385 MooseX::Getopt::OptionTypeMap->add_option_type_to_map(
386 'ArrayOfInts' => '=i@'
389 Now any attribute declarations using this type constraint will
390 get the custom option spec. So that, this:
394 isa => 'ArrayOfInts',
395 default => sub { [0] }
398 Will translate to the following on the command line:
400 % my_script.pl --nums 5 --nums 88 --nums 199
402 This example is fairly trivial, but more complex validations are
403 easily possible with a little creativity. The trick is balancing
404 the type constraint validations with the Getopt::Long validations.
406 Better examples are certainly welcome :)
408 =head2 Inferred Type Constraints
410 If you define a custom subtype which is a subtype of one of the
411 standard L</Supported Type Constraints> above, and do not explicitly
412 provide custom support as in L</Custom Type Constraints> above,
413 MooseX::Getopt will treat it like the parent type for Getopt
416 For example, if you had the same custom C<ArrayOfInts> subtype
417 from the examples above, but did not add a new custom option
418 type for it to the C<OptionTypeMap>, it would be treated just
419 like a normal C<ArrayRef> type for Getopt purposes (that is,
426 =item B<new_with_options (%params)>
428 This method will take a set of default C<%params> and then collect
429 params from the command line (possibly overriding those in C<%params>)
430 and then return a newly constructed object.
432 The special parameter C<argv>, if specified should point to an array
433 reference with an array to use instead of C<@ARGV>.
435 If L<Getopt::Long/GetOptions> fails (due to invalid arguments),
436 C<new_with_options> will throw an exception.
438 If L<Getopt::Long::Descriptive> is installed and any of the following
439 command line params are passed, the program will exit with usage
440 information. You can add descriptions for each option by including a
441 B<documentation> option for each attribute to document.
447 If you have L<Getopt::Long::Descriptive> a the C<usage> param is also passed to
452 This accessor contains a reference to a copy of the C<@ARGV> array
453 as it originally existed at the time of C<new_with_options>.
457 This accessor contains an arrayref of leftover C<@ARGV> elements that
458 L<Getopt::Long> did not parse. Note that the real C<@ARGV> is left
463 This returns the role meta object.
469 All complex software has bugs lurking in it, and this module is no
470 exception. If you find a bug please either email me, or add the bug
475 Stevan Little E<lt>stevan@iinteractive.comE<gt>
477 Brandon L. Black, E<lt>blblack@gmail.comE<gt>
479 Yuval Kogman, E<lt>nothingmuch@woobling.orgE<gt>
483 Ryan D Johnson, E<lt>ryan@innerfence.comE<gt>
485 Drew Taylor, E<lt>drew@drewtaylor.comE<gt>
487 =head1 COPYRIGHT AND LICENSE
489 Copyright 2007-2008 by Infinity Interactive, Inc.
491 L<http://www.iinteractive.com>
493 This library is free software; you can redistribute it and/or modify
494 it under the same terms as Perl itself.