2 package MooseX::Getopt;
5 use Getopt::Long::Descriptive ();
7 use MooseX::Getopt::OptionTypeMap;
8 use MooseX::Getopt::Meta::Attribute;
9 use MooseX::Getopt::Meta::Attribute::NoGetopt;
11 our $VERSION = '0.08';
12 our $AUTHORITY = 'cpan:STEVAN';
14 has ARGV => (is => 'rw', isa => 'ArrayRef');
15 has extra_argv => (is => 'rw', isa => 'ArrayRef');
17 sub new_with_options {
18 my ($class, @params) = @_;
20 my %processed = $class->_parse_argv(
22 $class->_attrs_to_options( @params )
26 my $params = $processed{params};
28 if($class->meta->does_role('MooseX::ConfigFromFile')
29 && defined $params->{configfile}) {
31 %{$class->get_config_from_file($params->{configfile})},
37 ARGV => $processed{argv_copy},
38 extra_argv => $processed{argv},
39 @params, # explicit params to ->new
40 %$params, # params from CLI
45 my ( $class, %params ) = @_;
47 local @ARGV = @{ $params{argv} || \@ARGV };
49 my ( @options, %name_to_init_arg );
51 foreach my $opt ( @{ $params{options} } ) {
56 ( $opt->{required} ? (required => $opt->{required}) : () ),
57 ( exists $opt->{default} ? (default => $opt->{default}) : () ),
61 $name_to_init_arg{ $opt->{name} } = $opt->{init_arg};
64 # Get a clean copy of the original @ARGV
65 my $argv_copy = [ @ARGV ];
69 my ( $parsed_options, $usage ) = eval {
70 local $SIG{__WARN__} = sub { push @err, @_ };
71 Getopt::Long::Descriptive::describe_options("usage: %c %o", @options)
74 die join "", grep { defined } @err, $@ if @err or $@;
76 # Get a copy of the Getopt::Long-mangled @ARGV
77 my $argv_mangled = [ @ARGV ];
80 argv_copy => $argv_copy,
81 argv => $argv_mangled,
84 $name_to_init_arg{$_} => $parsed_options->{$_}
85 } keys %$parsed_options,
90 sub _compute_getopt_attrs {
93 $_->isa("MooseX::Getopt::Meta::Attribute")
97 !$_->isa('MooseX::Getopt::Meta::Attribute::NoGetopt')
98 } $class->meta->compute_all_applicable_attributes
101 sub _attrs_to_options {
106 foreach my $attr ($class->_compute_getopt_attrs) {
107 my $name = $attr->name;
111 if ($attr->isa('MooseX::Getopt::Meta::Attribute')) {
112 $name = $attr->cmd_flag if $attr->has_cmd_flag;
113 $aliases = $attr->cmd_aliases if $attr->has_cmd_aliases;
116 my $opt_string = $aliases
117 ? join(q{|}, $name, @$aliases)
120 if ($attr->has_type_constraint) {
121 my $type_name = $attr->type_constraint->name;
122 if (MooseX::Getopt::OptionTypeMap->has_option_type($type_name)) {
123 $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type_name)
129 init_arg => $attr->init_arg,
130 opt_string => $opt_string,
131 required => $attr->is_required,
132 ( ( $attr->has_default && ( $attr->is_default_a_coderef xor $attr->is_lazy ) ) ? ( default => $attr->default({}) ) : () ),
133 ( $attr->has_documentation ? ( doc => $attr->documentation ) : () ),
148 MooseX::Getopt - A Moose role for processing command line options
156 with 'MooseX::Getopt';
158 has 'out' => (is => 'rw', isa => 'Str', required => 1);
159 has 'in' => (is => 'rw', isa => 'Str', required => 1);
161 # ... rest of the class here
168 my $app = My::App->new_with_options();
169 # ... rest of the script here
171 ## on the command line
172 % perl my_app_script.pl -in file.input -out file.dump
176 This is a role which provides an alternate constructor for creating
177 objects using parameters passed in from the command line.
179 This module attempts to DWIM as much as possible with the command line
180 params by introspecting your class's attributes. It will use the name
181 of your attribute as the command line option, and if there is a type
182 constraint defined, it will configure Getopt::Long to handle the option
185 You can use the attribute metaclass L<MooseX::Getopt::Meta::Attribute>
186 to get non-default commandline option names and aliases.
188 You can use the attribute metaclass L<MooseX::Getopt::Meta::Attribute::NoGetOpt>
189 to have C<MooseX::Getopt> ignore your attribute in the commandline options.
191 By default, attributes which start with an underscore are not given
192 commandline argument support, unless the attribute's metaclass is set
193 to L<MooseX::Getopt::Meta::Attribute>. If you don't want you accessors
194 to have the leading underscore in thier name, you can do this:
196 # for read/write attributes
197 has '_foo' => (accessor => 'foo', ...);
199 # or for read-only attributes
200 has '_bar' => (reader => 'bar', ...);
202 This will mean that Getopt will not handle a --foo param, but your
203 code can still call the C<foo> method.
205 If your class also uses a configfile-loading role based on
206 L<MooseX::ConfigFromFile>, such as L<MooseX::SimpleConfig>,
207 L<MooseX::Getopt>'s C<new_with_options> will load the configfile
208 specified by the C<--configfile> option for you.
210 =head2 Supported Type Constraints
216 A I<Bool> type constraint is set up as a boolean option with
217 Getopt::Long. So that this attribute description:
219 has 'verbose' => (is => 'rw', isa => 'Bool');
221 would translate into C<verbose!> as a Getopt::Long option descriptor,
222 which would enable the following command line options:
224 % my_script.pl --verbose
225 % my_script.pl --noverbose
227 =item I<Int>, I<Float>, I<Str>
229 These type constraints are set up as properly typed options with
230 Getopt::Long, using the C<=i>, C<=f> and C<=s> modifiers as appropriate.
234 An I<ArrayRef> type constraint is set up as a multiple value option
235 in Getopt::Long. So that this attribute description:
240 default => sub { [] }
243 would translate into C<includes=s@> as a Getopt::Long option descriptor,
244 which would enable the following command line options:
246 % my_script.pl --include /usr/lib --include /usr/local/lib
250 A I<HashRef> type constraint is set up as a hash value option
251 in Getopt::Long. So that this attribute description:
256 default => sub { {} }
259 would translate into C<define=s%> as a Getopt::Long option descriptor,
260 which would enable the following command line options:
262 % my_script.pl --define os=linux --define vendor=debian
266 =head2 Custom Type Constraints
268 It is possible to create custom type constraint to option spec
269 mappings if you need them. The process is fairly simple (but a
270 little verbose maybe). First you create a custom subtype, like
273 subtype 'ArrayOfInts'
275 => where { scalar (grep { looks_like_number($_) } @$_) };
277 Then you register the mapping, like so:
279 MooseX::Getopt::OptionTypeMap->add_option_type_to_map(
280 'ArrayOfInts' => '=i@'
283 Now any attribute declarations using this type constraint will
284 get the custom option spec. So that, this:
288 isa => 'ArrayOfInts',
289 default => sub { [0] }
292 Will translate to the following on the command line:
294 % my_script.pl --nums 5 --nums 88 --nums 199
296 This example is fairly trivial, but more complex validations are
297 easily possible with a little creativity. The trick is balancing
298 the type constraint validations with the Getopt::Long validations.
300 Better examples are certainly welcome :)
302 =head2 Inferred Type Constraints
304 If you define a custom subtype which is a subtype of one of the
305 standard L</Supported Type Constraints> above, and do not explicitly
306 provide custom support as in L</Custom Type Constraints> above,
307 MooseX::Getopt will treat it like the parent type for Getopt
310 For example, if you had the same custom C<ArrayOfInts> subtype
311 from the examples above, but did not add a new custom option
312 type for it to the C<OptionTypeMap>, it would be treated just
313 like a normal C<ArrayRef> type for Getopt purposes (that is,
320 =item B<new_with_options (%params)>
322 This method will take a set of default C<%params> and then collect
323 params from the command line (possibly overriding those in C<%params>)
324 and then return a newly constructed object.
326 If L<Getopt::Long/GetOptions> fails (due to invalid arguments),
327 C<new_with_options> will throw an exception.
331 This accessor contains a reference to a copy of the C<@ARGV> array
332 as it originally existed at the time of C<new_with_options>.
336 This accessor contains an arrayref of leftover C<@ARGV> elements that
337 L<Getopt::Long> did not parse. Note that the real C<@ARGV> is left
342 This returns the role meta object.
348 All complex software has bugs lurking in it, and this module is no
349 exception. If you find a bug please either email me, or add the bug
354 Stevan Little E<lt>stevan@iinteractive.comE<gt>
356 Brandon L. Black, E<lt>blblack@gmail.comE<gt>
358 =head1 COPYRIGHT AND LICENSE
360 Copyright 2007 by Infinity Interactive, Inc.
362 L<http://www.iinteractive.com>
364 This library is free software; you can redistribute it and/or modify
365 it under the same terms as Perl itself.