lib/MooseX/Getopt.pm

   1
   2 package MooseX::Getopt;
   3 use Moose::Role;
   4
   5 use Getopt::Long ();
   6
   7 use MooseX::Getopt::OptionTypeMap;
   8 use MooseX::Getopt::Meta::Attribute;
   9
  10 our $VERSION   = '0.05';
  11 our $AUTHORITY = 'cpan:STEVAN';
  12
  13 has ARGV       => (is => 'rw', isa => 'ArrayRef');
  14 has extra_argv => (is => 'rw', isa => 'ArrayRef');
  15
  16 sub new_with_options {
  17     my ($class, %params) = @_;
  18
  19     my %processed = $class->_parse_argv( options => [ $class->_attrs_to_options( %params ) ] );
  20
  21     $class->new(
  22         ARGV       => $processed{argv_copy},
  23         extra_argv => $processed{argv},
  24         %params, # explicit params to ->new
  25         %{ $processed{params} }, # params from CLI
  26     );
  27 }
  28
  29 sub _parse_argv {
  30     my ( $class, %params ) = @_;
  31
  32     local @ARGV = @{ $params{argv} || \@ARGV };
  33
  34     my ( @options, %name_to_init_arg, %options );
  35
  36     foreach my $opt ( @{ $params{options} } ) {
  37         push @options, $opt->{opt_string};
  38         $name_to_init_arg{ $opt->{name} } = $opt->{init_arg};
  39     }
  40
  41     # Get a clean copy of the original @ARGV
  42     my $argv_copy = [ @ARGV ];
  43
  44     {
  45         local $SIG{__WARN__} = sub { die $_[0] };
  46         Getopt::Long::GetOptions(\%options, @options);
  47     }
  48
  49     # Get a copy of the Getopt::Long-mangled @ARGV
  50     my $argv_mangled = [ @ARGV ];
  51
  52     return (
  53         argv_copy => $argv_copy,
  54         argv      => $argv_mangled,
  55         params    => {
  56             map {
  57                 $name_to_init_arg{$_} => $options{$_}
  58             } keys %options,
  59         }
  60     );
  61 }
  62
  63 sub _attrs_to_options {
  64     my $class = shift;
  65
  66     my @options;
  67
  68     foreach my $attr ($class->meta->compute_all_applicable_attributes) {
  69         my $name = $attr->name;
  70
  71         my $aliases;
  72
  73         if ($attr->isa('MooseX::Getopt::Meta::Attribute')) {
  74             $name = $attr->cmd_flag if $attr->has_cmd_flag;
  75             $aliases = $attr->cmd_aliases if $attr->has_cmd_aliases;
  76         }
  77         else {
  78             next if $name =~ /^_/;
  79         }
  80
  81         my $opt_string = $aliases
  82             ? join(q{|}, $name, @$aliases)
  83             : $name;
  84
  85         if ($attr->has_type_constraint) {
  86             my $type_name = $attr->type_constraint->name;
  87             if (MooseX::Getopt::OptionTypeMap->has_option_type($type_name)) {
  88                 $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type_name);
  89             }
  90         }
  91
  92         push @options, {
  93             name       => $name,
  94             init_arg   => $attr->init_arg,
  95             opt_string => $opt_string,
  96             required   => $attr->is_required,
  97             ( $attr->has_documentation ? ( doc => $attr->documentation ) : () ),
  98         }
  99     }
 100
 101     return @options;
 102 }
 103
 104 no Moose::Role; 1;
 105
 106 __END__
 107
 108 =pod
 109
 110 =head1 NAME
 111
 112 MooseX::Getopt - A Moose role for processing command line options
 113
 114 =head1 SYNOPSIS
 115
 116   ## In your class
 117   package My::App;
 118   use Moose;
 119
 120   with 'MooseX::Getopt';
 121
 122   has 'out' => (is => 'rw', isa => 'Str', required => 1);
 123   has 'in'  => (is => 'rw', isa => 'Str', required => 1);
 124
 125   # ... rest of the class here
 126
 127   ## in your script
 128   #!/usr/bin/perl
 129
 130   use My::App;
 131
 132   my $app = My::App->new_with_options();
 133   # ... rest of the script here
 134
 135   ## on the command line
 136   % perl my_app_script.pl -in file.input -out file.dump
 137
 138 =head1 DESCRIPTION
 139
 140 This is a role which provides an alternate constructor for creating
 141 objects using parameters passed in from the command line.
 142
 143 This module attempts to DWIM as much as possible with the command line
 144 params by introspecting your class's attributes. It will use the name
 145 of your attribute as the command line option, and if there is a type
 146 constraint defined, it will configure Getopt::Long to handle the option
 147 accordingly.
 148
 149 You can use the attribute metaclass L<MooseX::Getopt::Meta::Attribute>
 150 to get non-default commandline option names and aliases.
 151
 152 By default, attributes which start with an underscore are not given
 153 commandline argument support, unless the attribute's metaclass is set
 154 to L<MooseX::Getopt::Meta::Attribute>. If you don't want you accessors
 155 to have the leading underscore in thier name, you can do this:
 156
 157   # for read/write attributes
 158   has '_foo' => (accessor => 'foo', ...);
 159
 160   # or for read-only attributes
 161   has '_bar' => (reader => 'bar', ...);
 162
 163 This will mean that Getopt will not handle a --foo param, but your
 164 code can still call the C<foo> method.
 165
 166 =head2 Supported Type Constraints
 167
 168 =over 4
 169
 170 =item I<Bool>
 171
 172 A I<Bool> type constraint is set up as a boolean option with
 173 Getopt::Long. So that this attribute description:
 174
 175   has 'verbose' => (is => 'rw', isa => 'Bool');
 176
 177 would translate into C<verbose!> as a Getopt::Long option descriptor,
 178 which would enable the following command line options:
 179
 180   % my_script.pl --verbose
 181   % my_script.pl --noverbose
 182
 183 =item I<Int>, I<Float>, I<Str>
 184
 185 These type constraints are set up as properly typed options with
 186 Getopt::Long, using the C<=i>, C<=f> and C<=s> modifiers as appropriate.
 187
 188 =item I<ArrayRef>
 189
 190 An I<ArrayRef> type constraint is set up as a multiple value option
 191 in Getopt::Long. So that this attribute description:
 192
 193   has 'include' => (
 194       is      => 'rw',
 195       isa     => 'ArrayRef',
 196       default => sub { [] }
 197   );
 198
 199 would translate into C<includes=s@> as a Getopt::Long option descriptor,
 200 which would enable the following command line options:
 201
 202   % my_script.pl --include /usr/lib --include /usr/local/lib
 203
 204 =item I<HashRef>
 205
 206 A I<HashRef> type constraint is set up as a hash value option
 207 in Getopt::Long. So that this attribute description:
 208
 209   has 'define' => (
 210       is      => 'rw',
 211       isa     => 'HashRef',
 212       default => sub { {} }
 213   );
 214
 215 would translate into C<define=s%> as a Getopt::Long option descriptor,
 216 which would enable the following command line options:
 217
 218   % my_script.pl --define os=linux --define vendor=debian
 219
 220 =back
 221
 222 =head2 Custom Type Constraints
 223
 224 It is possible to create custom type constraint to option spec
 225 mappings if you need them. The process is fairly simple (but a
 226 little verbose maybe). First you create a custom subtype, like
 227 so:
 228
 229   subtype 'ArrayOfInts'
 230       => as 'ArrayRef'
 231       => where { scalar (grep { looks_like_number($_) } @$_)  };
 232
 233 Then you register the mapping, like so:
 234
 235   MooseX::Getopt::OptionTypeMap->add_option_type_to_map(
 236       'ArrayOfInts' => '=i@'
 237   );
 238
 239 Now any attribute declarations using this type constraint will
 240 get the custom option spec. So that, this:
 241
 242   has 'nums' => (
 243       is      => 'ro',
 244       isa     => 'ArrayOfInts',
 245       default => sub { [0] }
 246   );
 247
 248 Will translate to the following on the command line:
 249
 250   % my_script.pl --nums 5 --nums 88 --nums 199
 251
 252 This example is fairly trivial, but more complex validations are
 253 easily possible with a little creativity. The trick is balancing
 254 the type constraint validations with the Getopt::Long validations.
 255
 256 Better examples are certainly welcome :)
 257
 258 =head2 Inferred Type Constraints
 259
 260 If you define a custom subtype which is a subtype of one of the
 261 standard L</Supported Type Constraints> above, and do not explicitly
 262 provide custom support as in L</Custom Type Constraints> above,
 263 MooseX::Getopt will treat it like the parent type for Getopt
 264 purposes.
 265
 266 For example, if you had the same custom C<ArrayOfInts> subtype
 267 from the examples above, but did not add a new custom option
 268 type for it to the C<OptionTypeMap>, it would be treated just
 269 like a normal C<ArrayRef> type for Getopt purposes (that is,
 270 C<=s@>).
 271
 272 =head1 METHODS
 273
 274 =over 4
 275
 276 =item B<new_with_options (%params)>
 277
 278 This method will take a set of default C<%params> and then collect
 279 params from the command line (possibly overriding those in C<%params>)
 280 and then return a newly constructed object.
 281
 282 If L<Getopt::Long/GetOptions> fails (due to invalid arguments),
 283 C<new_with_options> will throw an exception.
 284
 285 =item B<ARGV>
 286
 287 This accessor contains a reference to a copy of the C<@ARGV> array
 288 as it originally existed at the time of C<new_with_options>.
 289
 290 =item B<extra_argv>
 291
 292 This accessor contains an arrayref of leftover C<@ARGV> elements that
 293 L<Getopt::Long> did not parse.  Note that the real C<@ARGV> is left
 294 un-mangled.
 295
 296 =item B<meta>
 297
 298 This returns the role meta object.
 299
 300 =back
 301
 302 =head1 BUGS
 303
 304 All complex software has bugs lurking in it, and this module is no
 305 exception. If you find a bug please either email me, or add the bug
 306 to cpan-RT.
 307
 308 =head1 AUTHOR
 309
 310 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 311
 312 Brandon L. Black, E<lt>blblack@gmail.comE<gt>
 313
 314 =head1 COPYRIGHT AND LICENSE
 315
 316 Copyright 2007 by Infinity Interactive, Inc.
 317
 318 L<http://www.iinteractive.com>
 319
 320 This library is free software; you can redistribute it and/or modify
 321 it under the same terms as Perl itself.
 322
 323 =cut