Getopt::Long::Descriptive
[gitmo/MooseX-Getopt.git] / lib / MooseX / Getopt.pm
index 86c5904..7011a55 100644 (file)
 package MooseX::Getopt;
 use Moose::Role;
 
-use Getopt::Long;
+use Getopt::Long::Descriptive ();
 
 use MooseX::Getopt::OptionTypeMap;
 use MooseX::Getopt::Meta::Attribute;
+use MooseX::Getopt::Meta::Attribute::NoGetopt;
 
-our $VERSION   = '0.01';
+our $VERSION   = '0.08';
 our $AUTHORITY = 'cpan:STEVAN';
 
+has ARGV       => (is => 'rw', isa => 'ArrayRef');
+has extra_argv => (is => 'rw', isa => 'ArrayRef');
+
 sub new_with_options {
-    my ($class, %params) = @_;
+    my ($class, @params) = @_;
+
+    my %processed = $class->_parse_argv( 
+        options => [ 
+            $class->_attrs_to_options( @params ) 
+        ] 
+    );
+
+    my $params = $processed{params};
+
+    if($class->meta->does_role('MooseX::ConfigFromFile')
+       && defined $params->{configfile}) {
+        %$params = (
+            %{$class->get_config_from_file($params->{configfile})},
+            %$params,
+        );
+    }
+
+    $class->new(
+        ARGV       => $processed{argv_copy},
+        extra_argv => $processed{argv},
+        @params, # explicit params to ->new
+        %$params, # params from CLI
+    );
+}
+
+sub _parse_argv {
+    my ( $class, %params ) = @_;
+
+    local @ARGV = @{ $params{argv} || \@ARGV };
+
+    my ( @options, %name_to_init_arg );
+
+    foreach my $opt ( @{ $params{options} } ) {
+        push @options, [
+            $opt->{opt_string},
+            $opt->{doc} || ' ',
+            {
+                ( $opt->{required} ? (required => $opt->{required}) : () ),
+                ( exists $opt->{default}  ? (default  => $opt->{default})  : () ),
+            },
+        ];
+
+        $name_to_init_arg{ $opt->{name} } = $opt->{init_arg};
+    }
+
+    # Get a clean copy of the original @ARGV
+    my $argv_copy = [ @ARGV ];
+
+    my @err;
+
+    my ( $parsed_options, $usage ) = eval {
+        local $SIG{__WARN__} = sub { push @err, @_ };
+        Getopt::Long::Descriptive::describe_options("usage: %c %o", @options)
+    };
+
+    die join "", grep { defined } @err, $@ if @err or $@;
+
+    # Get a copy of the Getopt::Long-mangled @ARGV
+    my $argv_mangled = [ @ARGV ];
+
+    return (
+        argv_copy => $argv_copy,
+        argv      => $argv_mangled,
+        params    => {
+            map { 
+                $name_to_init_arg{$_} => $parsed_options->{$_} 
+            } keys %$parsed_options,   
+        }
+    );
+}
+
+sub _compute_getopt_attrs {
+    my $class = shift;
+    grep {
+        $_->isa("MooseX::Getopt::Meta::Attribute")
+            or
+        $_->name !~ /^_/
+            &&
+        !$_->isa('MooseX::Getopt::Meta::Attribute::NoGetopt')
+    } $class->meta->compute_all_applicable_attributes
+}
+
+sub _attrs_to_options {
+    my $class = shift;
 
-    my (@options, %name_to_init_arg);
-    foreach my $attr ($class->meta->compute_all_applicable_attributes) {
+    my @options;
+
+    foreach my $attr ($class->_compute_getopt_attrs) {
         my $name = $attr->name;
+
         my $aliases;
 
         if ($attr->isa('MooseX::Getopt::Meta::Attribute')) {
             $name = $attr->cmd_flag if $attr->has_cmd_flag;
             $aliases = $attr->cmd_aliases if $attr->has_cmd_aliases;
-        }          
-        
-        $name_to_init_arg{$name} = $attr->init_arg;        
-        
+        }
+
         my $opt_string = $aliases
             ? join(q{|}, $name, @$aliases)
             : $name;
 
         if ($attr->has_type_constraint) {
             my $type_name = $attr->type_constraint->name;
-            if (MooseX::Getopt::OptionTypeMap->has_option_type($type_name)) {                   
-                $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type_name);
+            if (MooseX::Getopt::OptionTypeMap->has_option_type($type_name)) {
+                $opt_string .= MooseX::Getopt::OptionTypeMap->get_option_type($type_name)
             }
         }
-        
-        push @options => $opt_string;
+
+        push @options, {
+            name       => $name,
+            init_arg   => $attr->init_arg,
+            opt_string => $opt_string,
+            required   => $attr->is_required,
+            ( ( $attr->has_default && ( $attr->is_default_a_coderef xor $attr->is_lazy ) ) ? ( default => $attr->default({}) ) : () ),
+            ( $attr->has_documentation ? ( doc => $attr->documentation ) : () ),
+        }
     }
 
-    my %options;
-    
-    GetOptions(\%options, @options);
-    
-    #use Data::Dumper;
-    #warn Dumper \@options;
-    #warn Dumper \%name_to_init_arg;
-    #warn Dumper \%options;
-    
-    $class->new(
-        %params, 
-        map { 
-            $name_to_init_arg{$_} => $options{$_} 
-        } keys %options
-    );
+    return @options;
 }
 
 no Moose::Role; 1;
@@ -99,7 +180,32 @@ This module attempts to DWIM as much as possible with the command line
 params by introspecting your class's attributes. It will use the name 
 of your attribute as the command line option, and if there is a type 
 constraint defined, it will configure Getopt::Long to handle the option
-accordingly. 
+accordingly.
+
+You can use the attribute metaclass L<MooseX::Getopt::Meta::Attribute>
+to get non-default commandline option names and aliases.
+
+You can use the attribute metaclass L<MooseX::Getopt::Meta::Attribute::NoGetOpt>
+to have C<MooseX::Getopt> ignore your attribute in the commandline options.
+
+By default, attributes which start with an underscore are not given
+commandline argument support, unless the attribute's metaclass is set
+to L<MooseX::Getopt::Meta::Attribute>. If you don't want you accessors
+to have the leading underscore in thier name, you can do this:
+
+  # for read/write attributes
+  has '_foo' => (accessor => 'foo', ...);
+  
+  # or for read-only attributes
+  has '_bar' => (reader => 'bar', ...);  
+
+This will mean that Getopt will not handle a --foo param, but your 
+code can still call the C<foo> method. 
+
+If your class also uses a configfile-loading role based on
+L<MooseX::ConfigFromFile>, such as L<MooseX::SimpleConfig>,
+L<MooseX::Getopt>'s C<new_with_options> will load the configfile
+specified by the C<--configfile> option for you.
 
 =head2 Supported Type Constraints
 
@@ -193,6 +299,20 @@ the type constraint validations with the Getopt::Long validations.
 
 Better examples are certainly welcome :)
 
+=head2 Inferred Type Constraints
+
+If you define a custom subtype which is a subtype of one of the
+standard L</Supported Type Constraints> above, and do not explicitly
+provide custom support as in L</Custom Type Constraints> above,
+MooseX::Getopt will treat it like the parent type for Getopt
+purposes.
+
+For example, if you had the same custom C<ArrayOfInts> subtype
+from the examples above, but did not add a new custom option
+type for it to the C<OptionTypeMap>, it would be treated just
+like a normal C<ArrayRef> type for Getopt purposes (that is,
+C<=s@>).
+
 =head1 METHODS
 
 =over 4
@@ -203,6 +323,20 @@ This method will take a set of default C<%params> and then collect
 params from the command line (possibly overriding those in C<%params>)
 and then return a newly constructed object.
 
+If L<Getopt::Long/GetOptions> fails (due to invalid arguments),
+C<new_with_options> will throw an exception.
+
+=item B<ARGV>
+
+This accessor contains a reference to a copy of the C<@ARGV> array
+as it originally existed at the time of C<new_with_options>.
+
+=item B<extra_argv>
+
+This accessor contains an arrayref of leftover C<@ARGV> elements that
+L<Getopt::Long> did not parse.  Note that the real C<@ARGV> is left
+un-mangled.
+
 =item B<meta>
 
 This returns the role meta object.
@@ -219,6 +353,8 @@ to cpan-RT.
 
 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 
+Brandon L. Black, E<lt>blblack@gmail.comE<gt>
+
 =head1 COPYRIGHT AND LICENSE
 
 Copyright 2007 by Infinity Interactive, Inc.