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>.
 118
 119 =head2 Supported Type Constraints
 120
 121 =over 4
 122
 123 =item I<Bool>
 124
 125 A I<Bool> type constraint is set up as a boolean option with
 126 Getopt::Long. So that this attribute description:
 127
 128   has 'verbose' => (is => 'rw', isa => 'Bool');
 129
 130 would translate into C<verbose!> as a Getopt::Long option descriptor,
 131 which would enable the following command line options:
 132
 133   % my_script.pl --verbose
 134   % my_script.pl --noverbose
 135
 136 =item I<Int>, I<Float>, I<Str>
 137
 138 These type constraints are set up as properly typed options with
 139 Getopt::Long, using the C<=i>, C<=f> and C<=s> modifiers as appropriate.
 140
 141 =item I<ArrayRef>
 142
 143 An I<ArrayRef> type constraint is set up as a multiple value option
 144 in Getopt::Long. So that this attribute description:
 145
 146   has 'include' => (
 147       is      => 'rw',
 148       isa     => 'ArrayRef',
 149       default => sub { [] }
 150   );
 151
 152 would translate into C<includes=s@> as a Getopt::Long option descriptor,
 153 which would enable the following command line options:
 154
 155   % my_script.pl --include /usr/lib --include /usr/local/lib
 156
 157 =item I<HashRef>
 158
 159 A I<HashRef> type constraint is set up as a hash value option
 160 in Getopt::Long. So that this attribute description:
 161
 162   has 'define' => (
 163       is      => 'rw',
 164       isa     => 'HashRef',
 165       default => sub { {} }
 166   );
 167
 168 would translate into C<define=s%> as a Getopt::Long option descriptor,
 169 which would enable the following command line options:
 170
 171   % my_script.pl --define os=linux --define vendor=debian
 172
 173 =back
 174
 175 =head2 Custom Type Constraints
 176
 177 It is possible to create custom type constraint to option spec
 178 mappings if you need them. The process is fairly simple (but a
 179 little verbose maybe). First you create a custom subtype, like
 180 so:
 181
 182   subtype 'ArrayOfInts'
 183       => as 'ArrayRef'
 184       => where { scalar (grep { looks_like_number($_) } @$_)  };
 185
 186 Then you register the mapping, like so:
 187
 188   MooseX::Getopt::OptionTypeMap->add_option_type_to_map(
 189       'ArrayOfInts' => '=i@'
 190   );
 191
 192 Now any attribute declarations using this type constraint will
 193 get the custom option spec. So that, this:
 194
 195   has 'nums' => (
 196       is      => 'ro',
 197       isa     => 'ArrayOfInts',
 198       default => sub { [0] }
 199   );
 200
 201 Will translate to the following on the command line:
 202
 203   % my_script.pl --nums 5 --nums 88 --nums 199
 204
 205 This example is fairly trivial, but more complex validations are
 206 easily possible with a little creativity. The trick is balancing
 207 the type constraint validations with the Getopt::Long validations.
 208
 209 Better examples are certainly welcome :)
 210
 211 =head1 METHODS
 212
 213 =over 4
 214
 215 =item B<new_with_options (%params)>
 216
 217 This method will take a set of default C<%params> and then collect
 218 params from the command line (possibly overriding those in C<%params>)
 219 and then return a newly constructed object.
 220
 221 =item B<ARGV>
 222
 223 This accessor contains a reference to a copy of the C<@ARGV> array
 224 which was copied before L<Getopt::Long> mangled it, in case you want
 225 to see your original options.
 226
 227 =item B<meta>
 228
 229 This returns the role meta object.
 230
 231 =back
 232
 233 =head1 BUGS
 234
 235 All complex software has bugs lurking in it, and this module is no
 236 exception. If you find a bug please either email me, or add the bug
 237 to cpan-RT.
 238
 239 =head1 AUTHOR
 240
 241 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 242
 243 Brandon L. Black, E<lt>blblack@gmail.comE<gt>
 244
 245 =head1 COPYRIGHT AND LICENSE
 246
 247 Copyright 2007 by Infinity Interactive, Inc.
 248
 249 L<http://www.iinteractive.com>
 250
 251 This library is free software; you can redistribute it and/or modify
 252 it under the same terms as Perl itself.
 253
 254 =cut