Params passed to new_with_options are no longer required
Yuval Kogman [Thu, 5 Jun 2008 19:25:44 +0000 (19:25 +0000)]
lib/MooseX/Getopt.pm
t/009_gld_and_explicit_options.t

index 1c4a235..0455723 100644 (file)
@@ -6,6 +6,8 @@ use MooseX::Getopt::OptionTypeMap;
 use MooseX::Getopt::Meta::Attribute;
 use MooseX::Getopt::Meta::Attribute::NoGetopt;
 
+use Carp ();
+
 use Getopt::Long (); # GLD uses it anyway, doesn't hurt
 use constant HAVE_GLD => not not eval { require Getopt::Long::Descriptive };
 
@@ -36,10 +38,16 @@ sub new_with_options {
         }
     }
 
+    my $constructor_params = ( @params == 1 ? $params[0] : {@params} );
+    
+    Carp::croak("Single parameters to new_with_options() must be a HASH ref")
+        unless ref($constructor_params) eq 'HASH';
+
     my %processed = $class->_parse_argv(
         options => [
             $class->_attrs_to_options( $config_from_file )
-        ]
+        ],
+        params => $constructor_params,
     );
 
     my $params = $config_from_file ? { %$config_from_file, %{$processed{params}} } : $processed{params};
@@ -121,12 +129,14 @@ sub _gld_spec {
 
     my ( @options, %name_to_init_arg );
 
+    my $constructor_params = $params{params};
+
     foreach my $opt ( @{ $params{options} } ) {
         push @options, [
             $opt->{opt_string},
             $opt->{doc} || ' ', # FIXME new GLD shouldn't need this hack
             {
-                ( $opt->{required} ? (required => $opt->{required}) : () ),
+                ( ( $opt->{required} && !exists($constructor_params->{$opt->{init_arg}}) ) ? (required => $opt->{required}) : () ),
                 ( exists $opt->{default}  ? (default  => $opt->{default})  : () ),
             },
         ];
index e81b300..189a0c3 100644 (file)
@@ -3,15 +3,10 @@
 use strict;
 use warnings;
 
-use Test::More;
+use Test::More tests => 5;
 use Test::Exception;
 
-BEGIN {
-    eval "use Getopt::Long::Descriptive;";
-    plan skip_all => "Getopt::Long::Descriptive required for this test" if $@;
-    plan tests => 5;
-    use_ok('MooseX::Getopt');
-}
+BEGIN { use_ok('MooseX::Getopt') }
 
 {
     package Testing::Foo;
@@ -32,7 +27,7 @@ BEGIN {
     );    
 }
 
-our @ARGV = qw(bar 10);
+@ARGV = qw(--bar 10);
 
 my $foo;
 lives_ok {