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