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