lib/MooseX/Getopt.pm

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