* Add current $VERSION to all files.
[gitmo/MooseX-Getopt.git] / lib / MooseX / Getopt.pm
1
2 package MooseX::Getopt;
3
4 our $VERSION   = '0.150001';
5 our $AUTHORITY = 'cpan:STEVAN';
6
7 use Moose::Role;
8
9 use Moose::Util::TypeConstraints;
10
11 use MooseX::Getopt::OptionTypeMap;
12
13 use MooseX::Getopt::Session;
14
15 use MooseX::Getopt::Meta::Attribute;
16 use MooseX::Getopt::Meta::Attribute::NoGetopt;
17
18
19 use Getopt::Long ();
20
21
22 use constant _default_getopt_session => 'MooseX::Getopt::Session';
23
24
25 has getopt => (
26     is        => 'rw',
27     isa       => 'MooseX::Getopt::Session',
28     metaclass => 'NoGetopt',
29     handles   => [ 'ARGV', 'extra_argv' ],
30 );
31
32
33 sub new_with_options {
34     my $class = shift;
35
36     return $class->new( $class->get_options_from_argv(@_) );
37 };
38
39
40 sub get_options_from_argv {
41     my $class = shift;
42
43     Moose->throw_error(
44         "Single parameters to get_options_from_argv() must be a HASH ref"
45     ) if ref $_[0] and ref $_ ne 'HASH';
46
47     my $options = {
48         %{ $class->get_options_from_configfile },
49         @_ == 1 ? %{ $_[0] } : @_
50     };
51
52     my $getopt = defined $options->{getopt}
53                ? $options->{getopt}
54                : $class->_default_getopt_session->new(
55                      classes_filter => sub { $_ eq $class },
56                      options => $options,
57                );
58
59     # Call Getopt parser only once.
60     $getopt->build_options if not $getopt->has_status;
61
62     my $new_options = {
63         %$options,                # explicit options to ->new
64         %{ $getopt->options },    # options from CLI
65         getopt => $getopt,
66     };
67
68     return $new_options;
69 };
70
71
72 sub get_options_from_configfile {
73     my $class = shift;
74
75     my $options = {};
76
77     if ( $class->meta->does_role('MooseX::ConfigFromFile') ) {
78         local @ARGV = @ARGV;
79
80         my $configfile;
81         my $opt_parser = Getopt::Long::Parser->new( config => ['pass_through'] );
82         $opt_parser->getoptions( "configfile=s" => \$configfile );
83
84         if ( not defined $configfile ) {
85             my $cfmeta = $class->meta->find_attribute_by_name('configfile');
86             $configfile = $cfmeta->default if $cfmeta->has_default;
87         };
88
89         if ( defined $configfile ) {
90             $options = $class->get_config_from_file($configfile);
91         };
92     };
93
94     return $options;
95 };
96
97
98 sub _compute_getopt_attrs {
99     my $class = shift;
100
101     return grep {
102         $_->does('MooseX::Getopt::Meta::Attribute::Trait')
103         or $_->name !~ /^_/
104     } grep {
105         !$_->does('MooseX::Getopt::Meta::Attribute::Trait::NoGetopt')
106     } $class->meta->compute_all_applicable_attributes;
107 };
108
109
110 no Moose::Role; 1;
111
112
113 __END__
114
115 =pod
116
117 =head1 NAME
118
119 MooseX::Getopt - A Moose role for processing command line options
120
121 =head1 SYNOPSIS
122
123   ## In your class
124   package My::App;
125   use Moose;
126
127   with 'MooseX::Getopt';
128
129   has 'out' => (is => 'rw', isa => 'Str', required => 1);
130   has 'in'  => (is => 'rw', isa => 'Str', required => 1);
131
132   # ... rest of the class here
133
134   ## in your script
135   #!/usr/bin/perl
136
137   use My::App;
138
139   my $app = My::App->new_with_options();
140   # ... rest of the script here
141
142   ## on the command line
143   % perl my_app_script.pl -in file.input -out file.dump
144
145 =head1 DESCRIPTION
146
147 This is a role which provides an alternate constructor for creating
148 objects using parameters passed in from the command line.
149
150 This module attempts to DWIM as much as possible with the command line
151 params by introspecting your class's attributes. It will use the name
152 of your attribute as the command line option, and if there is a type
153 constraint defined, it will configure Getopt::Long to handle the option
154 accordingly.
155
156 You can use the trait L<MooseX::Getopt::Meta::Attribute::Trait> or the
157 attribute metaclass L<MooseX::Getopt::Meta::Attribute> to get non-default
158 commandline option names and aliases.
159
160 You can use the trait L<MooseX::Getopt::Meta::Attribute::Trait::NoGetopt>
161 or the attribute metaclass L<MooseX::Getopt::Meta::Attribute::NoGetopt>
162 to have C<MooseX::Getopt> ignore your attribute in the commandline options.
163
164 By default, attributes which start with an underscore are not given
165 commandline argument support, unless the attribute's metaclass is set
166 to L<MooseX::Getopt::Meta::Attribute>. If you don't want you accessors
167 to have the leading underscore in thier name, you can do this:
168
169   # for read/write attributes
170   has '_foo' => (accessor => 'foo', ...);
171
172   # or for read-only attributes
173   has '_bar' => (reader => 'bar', ...);
174
175 This will mean that Getopt will not handle a --foo param, but your
176 code can still call the C<foo> method.
177
178 If your class also uses a configfile-loading role based on
179 L<MooseX::ConfigFromFile>, such as L<MooseX::SimpleConfig>,
180 L<MooseX::Getopt>'s C<new_with_options> will load the configfile
181 specified by the C<--configfile> option (or the default you've
182 given for the configfile attribute) for you.
183
184 Options specified in multiple places follow the following
185 precendence order: commandline overrides configfile, which
186 overrides explicit new_with_options parameters.
187
188 =head2 Supported Type Constraints
189
190 =over 4
191
192 =item I<Bool>
193
194 A I<Bool> type constraint is set up as a boolean option with
195 Getopt::Long. So that this attribute description:
196
197   has 'verbose' => (is => 'rw', isa => 'Bool');
198
199 would translate into C<verbose!> as a Getopt::Long option descriptor,
200 which would enable the following command line options:
201
202   % my_script.pl --verbose
203   % my_script.pl --noverbose
204
205 =item I<Int>, I<Float>, I<Str>
206
207 These type constraints are set up as properly typed options with
208 Getopt::Long, using the C<=i>, C<=f> and C<=s> modifiers as appropriate.
209
210 =item I<Defined|Int>, I<Defined|Float>, I<Defined|Str>
211
212 These type constaints are set up as properly typed options with
213 Getopt::Long, using the C<:i>, C<:f> and C<:s> modifiers as appropriate.
214
215 =item I<ArrayRef>
216
217 An I<ArrayRef> type constraint is set up as a multiple value option
218 in Getopt::Long. So that this attribute description:
219
220   has 'include' => (
221       is      => 'rw',
222       isa     => 'ArrayRef',
223       default => sub { [] }
224   );
225
226 would translate into C<includes=s@> as a Getopt::Long option descriptor,
227 which would enable the following command line options:
228
229   % my_script.pl --include /usr/lib --include /usr/local/lib
230
231 =item I<HashRef>
232
233 A I<HashRef> type constraint is set up as a hash value option
234 in Getopt::Long. So that this attribute description:
235
236   has 'define' => (
237       is      => 'rw',
238       isa     => 'HashRef',
239       default => sub { {} }
240   );
241
242 would translate into C<define=s%> as a Getopt::Long option descriptor,
243 which would enable the following command line options:
244
245   % my_script.pl --define os=linux --define vendor=debian
246
247 =back
248
249 =head2 Custom Type Constraints
250
251 It is possible to create custom type constraint to option spec
252 mappings if you need them. The process is fairly simple (but a
253 little verbose maybe). First you create a custom subtype, like
254 so:
255
256   subtype 'ArrayOfInts'
257       => as 'ArrayRef'
258       => where { scalar (grep { looks_like_number($_) } @$_)  };
259
260 Then you register the mapping, like so:
261
262   MooseX::Getopt::OptionTypeMap->add_option_type_to_map(
263       'ArrayOfInts' => '=i@'
264   );
265
266 Now any attribute declarations using this type constraint will
267 get the custom option spec. So that, this:
268
269   has 'nums' => (
270       is      => 'ro',
271       isa     => 'ArrayOfInts',
272       default => sub { [0] }
273   );
274
275 Will translate to the following on the command line:
276
277   % my_script.pl --nums 5 --nums 88 --nums 199
278
279 This example is fairly trivial, but more complex validations are
280 easily possible with a little creativity. The trick is balancing
281 the type constraint validations with the Getopt::Long validations.
282
283 Better examples are certainly welcome :)
284
285 =head2 Inferred Type Constraints
286
287 If you define a custom subtype which is a subtype of one of the
288 standard L</Supported Type Constraints> above, and do not explicitly
289 provide custom support as in L</Custom Type Constraints> above,
290 MooseX::Getopt will treat it like the parent type for Getopt
291 purposes.
292
293 For example, if you had the same custom C<ArrayOfInts> subtype
294 from the examples above, but did not add a new custom option
295 type for it to the C<OptionTypeMap>, it would be treated just
296 like a normal C<ArrayRef> type for Getopt purposes (that is,
297 C<=s@>).
298
299 =head2 Session
300
301 L<MooseX::Getopt> can handle more than one class which contain
302 attributes filled from CLI.  In this case, you need to use explicite
303 L<MooseX::Getopt::Session> object and then the Getopt attributes will be
304 searched in any class which does L<MooseX::Getopt>.
305
306   package My::App;
307   use Moose;
308   with 'MooseX::Getopt';
309   has 'send' => (is => 'rw', predicate => 'has_send');
310
311   package My::App::Send;
312   use Moose;
313   with 'MooseX::Getopt';
314   has 'to' => (is => 'rw', isa => 'Str', default => 'localhost');
315   sub send { my $self = shift; warn "Sending mail to ", $self->to; }
316
317   # ... rest of the class here
318
319   ## in your script
320   #!/usr/bin/perl
321
322   my $getopt = MooseX::Getopt::Session->new;
323
324   my $app = My::App->new_with_options( getopt => $getopt );
325   if ($app->has_send) {
326       # Use the same command line
327       my $sender = My::App::Send->new_with_options( getopt => $getopt );
328       $sender->send;
329   }
330   # ... rest of the script here
331
332   ## on the command line
333   % perl my_app_script.pl --send --to server.example.net
334
335 =head1 METHODS
336
337 =over 4
338
339 =item B<new_with_options (%params)>
340
341 This method will take a set of default C<%params> and then collect
342 params from the command line (possibly overriding those in C<%params>)
343 and then return a newly constructed object.
344
345 If L<Getopt::Long/GetOptions> fails (due to invalid arguments),
346 C<new_with_options> will throw an exception.
347
348 If you have L<Getopt::Long::Descriptive> a the C<usage> param is also passed to
349 C<new>.
350
351 =item B<get_options_from_argv (%params)>
352
353 This method returns the list of parameters collected from command line
354 without creating the new object.
355
356 =item B<get_options_from_configfile>
357
358 This method returns the list of parameters collected with
359 L<MooseX::ConfigFromFile> mechanism.
360
361 =item B<ARGV>
362
363 This accessor contains a reference to a copy of the C<@ARGV> array as it
364 originally existed at the time of C<new_with_options>.
365
366 The C<ARGV> is delegated from L<MooseX::Getopt::Session> object.
367
368 =item B<extra_argv>
369
370 This accessor contains an arrayref of leftover C<@ARGV> elements that
371 L<Getopt::Long> did not parse.  Note that the real C<@ARGV> is left
372 un-mangled.
373
374 The C<extra_argv> is delegated from L<MooseX::Getopt::Session> object.
375
376 =item B<getopt>
377
378 This accessor contains a L<MooseX::Getopt::Session> object.  This object can
379 be shared between more than one class which does L<MooseX::Getopt>.  The new
380 object is created by default.
381
382 =item B<meta>
383
384 This returns the role meta object.
385
386 =back
387
388 =head1 SEE ALSO
389
390 =over 4
391
392 =item L<MooseX::Getopt::Strict>
393
394 =item L<MooseX::Getopt::Session>
395
396 =item L<MooseX::Getopt::Parser>
397
398 =back
399
400 =head1 BUGS
401
402 All complex software has bugs lurking in it, and this module is no
403 exception. If you find a bug please either email me, or add the bug
404 to cpan-RT.
405
406 =head1 AUTHOR
407
408 Stevan Little E<lt>stevan@iinteractive.comE<gt>
409
410 Brandon L. Black, E<lt>blblack@gmail.comE<gt>
411
412 Yuval Kogman, E<lt>nothingmuch@woobling.orgE<gt>
413
414 Piotr Roszatycki, E<lt>dexter@cpan.orgE<gt>
415
416 =head1 CONTRIBUTORS
417
418 Ryan D Johnson, E<lt>ryan@innerfence.comE<gt>
419
420 =head1 COPYRIGHT AND LICENSE
421
422 Copyright 2007-2008 by Infinity Interactive, Inc.
423
424 L<http://www.iinteractive.com>
425
426 This library is free software; you can redistribute it and/or modify
427 it under the same terms as Perl itself.
428
429 =cut