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