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