2 package MooseX::Getopt;
5 use MooseX::Getopt::OptionTypeMap;
6 use MooseX::Getopt::Meta::Attribute;
7 use MooseX::Getopt::Meta::Attribute::NoGetopt;
9 use Getopt::Long (); # GLD uses it anyway, doesn't hurt
10 use constant HAVE_GLD => not not eval { require Getopt::Long::Descriptive };
12 our $VERSION = '0.12';
13 our $AUTHORITY = 'cpan:STEVAN';
15 has ARGV => (is => 'rw', isa => 'ArrayRef', metaclass => "NoGetopt");
16 has extra_argv => (is => 'rw', isa => 'ArrayRef', metaclass => "NoGetopt");
18 sub new_with_options {
19 my ($class, @params) = @_;
21 my %processed = $class->_parse_argv(
23 $class->_attrs_to_options( @params )
27 my $params = $processed{params};
29 if($class->meta->does_role('MooseX::ConfigFromFile')) {
32 if(defined $params->{configfile}) {
33 $configfile = $params->{configfile}
36 my $cfmeta = $class->meta->get_attribute('configfile');
37 $configfile = $cfmeta->default if $cfmeta->has_default;
40 if(defined $configfile) {
42 %{$class->get_config_from_file($configfile)},
49 ARGV => $processed{argv_copy},
50 extra_argv => $processed{argv},
51 @params, # explicit params to ->new
52 %$params, # params from CLI
57 my ( $class, %params ) = @_;
59 local @ARGV = @{ $params{argv} || \@ARGV };
61 my ( $opt_spec, $name_to_init_arg ) = ( HAVE_GLD ? $class->_gld_spec(%params) : $class->_traditional_spec(%params) );
63 # Get a clean copy of the original @ARGV
64 my $argv_copy = [ @ARGV ];
68 my ( $parsed_options, $usage ) = eval {
69 local $SIG{__WARN__} = sub { push @err, @_ };
72 return Getopt::Long::Descriptive::describe_options($class->_usage_format(%params), @$opt_spec);
75 Getopt::Long::GetOptions(\%options, @$opt_spec);
76 return ( \%options, undef );
80 die join "", grep { defined } @err, $@ if @err or $@;
82 # Get a copy of the Getopt::Long-mangled @ARGV
83 my $argv_mangled = [ @ARGV ];
85 my %constructor_args = (
87 $name_to_init_arg->{$_} => $parsed_options->{$_}
88 } keys %$parsed_options,
92 params => \%constructor_args,
93 argv_copy => $argv_copy,
94 argv => $argv_mangled,
95 ( defined($usage) ? ( usage => $usage ) : () ),
100 return "usage: %c %o";
103 sub _traditional_spec {
104 my ( $class, %params ) = @_;
106 my ( @options, %name_to_init_arg, %options );
108 foreach my $opt ( @{ $params{options} } ) {
109 push @options, $opt->{opt_string};
111 my $identifier = $opt->{name};
112 $identifier =~ s/\W/_/g; # Getopt::Long does this to all option names
114 $name_to_init_arg{$identifier} = $opt->{init_arg};
117 return ( \@options, \%name_to_init_arg );
121 my ( $class, %params ) = @_;
123 my ( @options, %name_to_init_arg );
125 foreach my $opt ( @{ $params{options} } ) {
128 $opt->{doc} || ' ', # FIXME new GLD shouldn't need this hack
130 ( $opt->{required} ? (required => $opt->{required}) : () ),
131 ( exists $opt->{default} ? (default => $opt->{default}) : () ),
135 my $identifier = $opt->{name};
136 $identifier =~ s/\W/_/g; # Getopt::Long does this to all option names
138 $name_to_init_arg{$identifier} = $opt->{init_arg};
141 return ( \@options, \%name_to_init_arg );
144 sub _compute_getopt_attrs {
147 $_->does("MooseX::Getopt::Meta::Attribute::Trait")
151 !$_->does('MooseX::Getopt::Meta::Attribute::Trait::NoGetopt')
152 } $class->meta->compute_all_applicable_attributes
155 sub _get_cmd_flags_for_attr {
156 my ( $class, $attr ) = @_;
158 my $flag = $attr->name;
162 if ($attr->does('MooseX::Getopt::Meta::Attribute::Trait')) {
163 $flag = $attr->cmd_flag if $attr->has_cmd_flag;
164 @aliases = @{ $attr->cmd_aliases } if $attr->has_cmd_aliases;
167 return ( $flag, @aliases );
170 sub _attrs_to_options {
175 foreach my $attr ($class->_compute_getopt_attrs) {
176 my ( $flag, @aliases ) = $class->_get_cmd_flags_for_attr($attr);
178 my $opt_string = join(q{|}, $flag, @aliases);
180 if ($attr->has_type_constraint) {
181 my $type_name = $attr->type_constraint->name;
182 if (MooseX::Getopt::OptionTypeMap->has_option_type($type_name)) {
183 $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type_name)
189 init_arg => $attr->init_arg,
190 opt_string => $opt_string,
191 required => $attr->is_required && !$attr->has_default && !$attr->has_builder,
192 ( ( $attr->has_default && ( $attr->is_default_a_coderef xor $attr->is_lazy ) ) ? ( default => $attr->default({}) ) : () ),
193 ( $attr->has_documentation ? ( doc => $attr->documentation ) : () ),
208 MooseX::Getopt - A Moose role for processing command line options
216 with 'MooseX::Getopt';
218 has 'out' => (is => 'rw', isa => 'Str', required => 1);
219 has 'in' => (is => 'rw', isa => 'Str', required => 1);
221 # ... rest of the class here
228 my $app = My::App->new_with_options();
229 # ... rest of the script here
231 ## on the command line
232 % perl my_app_script.pl -in file.input -out file.dump
236 This is a role which provides an alternate constructor for creating
237 objects using parameters passed in from the command line.
239 This module attempts to DWIM as much as possible with the command line
240 params by introspecting your class's attributes. It will use the name
241 of your attribute as the command line option, and if there is a type
242 constraint defined, it will configure Getopt::Long to handle the option
245 You can use the attribute metaclass L<MooseX::Getopt::Meta::Attribute>
246 to get non-default commandline option names and aliases.
248 You can use the attribute metaclass L<MooseX::Getopt::Meta::Attribute::NoGetOpt>
249 to have C<MooseX::Getopt> ignore your attribute in the commandline options.
251 By default, attributes which start with an underscore are not given
252 commandline argument support, unless the attribute's metaclass is set
253 to L<MooseX::Getopt::Meta::Attribute>. If you don't want you accessors
254 to have the leading underscore in thier name, you can do this:
256 # for read/write attributes
257 has '_foo' => (accessor => 'foo', ...);
259 # or for read-only attributes
260 has '_bar' => (reader => 'bar', ...);
262 This will mean that Getopt will not handle a --foo param, but your
263 code can still call the C<foo> method.
265 If your class also uses a configfile-loading role based on
266 L<MooseX::ConfigFromFile>, such as L<MooseX::SimpleConfig>,
267 L<MooseX::Getopt>'s C<new_with_options> will load the configfile
268 specified by the C<--configfile> option (or the default you've
269 given for the configfile attribute) for you.
271 Options specified in multiple places follow the following
272 precendence order: commandline overrides configfile, which
273 overrides explicit new_with_options parameters.
275 =head2 Supported Type Constraints
281 A I<Bool> type constraint is set up as a boolean option with
282 Getopt::Long. So that this attribute description:
284 has 'verbose' => (is => 'rw', isa => 'Bool');
286 would translate into C<verbose!> as a Getopt::Long option descriptor,
287 which would enable the following command line options:
289 % my_script.pl --verbose
290 % my_script.pl --noverbose
292 =item I<Int>, I<Float>, I<Str>
294 These type constraints are set up as properly typed options with
295 Getopt::Long, using the C<=i>, C<=f> and C<=s> modifiers as appropriate.
299 An I<ArrayRef> type constraint is set up as a multiple value option
300 in Getopt::Long. So that this attribute description:
305 default => sub { [] }
308 would translate into C<includes=s@> as a Getopt::Long option descriptor,
309 which would enable the following command line options:
311 % my_script.pl --include /usr/lib --include /usr/local/lib
315 A I<HashRef> type constraint is set up as a hash value option
316 in Getopt::Long. So that this attribute description:
321 default => sub { {} }
324 would translate into C<define=s%> as a Getopt::Long option descriptor,
325 which would enable the following command line options:
327 % my_script.pl --define os=linux --define vendor=debian
331 =head2 Custom Type Constraints
333 It is possible to create custom type constraint to option spec
334 mappings if you need them. The process is fairly simple (but a
335 little verbose maybe). First you create a custom subtype, like
338 subtype 'ArrayOfInts'
340 => where { scalar (grep { looks_like_number($_) } @$_) };
342 Then you register the mapping, like so:
344 MooseX::Getopt::OptionTypeMap->add_option_type_to_map(
345 'ArrayOfInts' => '=i@'
348 Now any attribute declarations using this type constraint will
349 get the custom option spec. So that, this:
353 isa => 'ArrayOfInts',
354 default => sub { [0] }
357 Will translate to the following on the command line:
359 % my_script.pl --nums 5 --nums 88 --nums 199
361 This example is fairly trivial, but more complex validations are
362 easily possible with a little creativity. The trick is balancing
363 the type constraint validations with the Getopt::Long validations.
365 Better examples are certainly welcome :)
367 =head2 Inferred Type Constraints
369 If you define a custom subtype which is a subtype of one of the
370 standard L</Supported Type Constraints> above, and do not explicitly
371 provide custom support as in L</Custom Type Constraints> above,
372 MooseX::Getopt will treat it like the parent type for Getopt
375 For example, if you had the same custom C<ArrayOfInts> subtype
376 from the examples above, but did not add a new custom option
377 type for it to the C<OptionTypeMap>, it would be treated just
378 like a normal C<ArrayRef> type for Getopt purposes (that is,
385 =item B<new_with_options (%params)>
387 This method will take a set of default C<%params> and then collect
388 params from the command line (possibly overriding those in C<%params>)
389 and then return a newly constructed object.
391 If L<Getopt::Long/GetOptions> fails (due to invalid arguments),
392 C<new_with_options> will throw an exception.
394 If you have L<Getopt::Long::Descriptive> a the C<usage> param is also passed to
399 This accessor contains a reference to a copy of the C<@ARGV> array
400 as it originally existed at the time of C<new_with_options>.
404 This accessor contains an arrayref of leftover C<@ARGV> elements that
405 L<Getopt::Long> did not parse. Note that the real C<@ARGV> is left
410 This returns the role meta object.
416 All complex software has bugs lurking in it, and this module is no
417 exception. If you find a bug please either email me, or add the bug
422 Stevan Little E<lt>stevan@iinteractive.comE<gt>
424 Brandon L. Black, E<lt>blblack@gmail.comE<gt>
426 =head1 COPYRIGHT AND LICENSE
428 Copyright 2007-2008 by Infinity Interactive, Inc.
430 L<http://www.iinteractive.com>
432 This library is free software; you can redistribute it and/or modify
433 it under the same terms as Perl itself.