Add extra tests and changes for config_from file.

These are all from Alex Bowley.
At the moment I'm unsure if I'm happy about the tests changes as we're
throwing different error messages. I think those are likely to break
someone's code - if that's unavoidable then so be it, but I'd like to
see if we can convince the original error message back

diff --git a/Makefile.PL b/Makefile.PL
index d3b9e47..c086584 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -19,7 +19,7 @@ requires 'Getopt::Long' => '2.37';
 requires 'Getopt::Long::Descriptive' => '0.077';
 
 build_requires 'Test::Moose';
-build_requires 'Test::More'       => '0.62';
+build_requires 'Test::More'       => '0.88';
 build_requires 'Test::Exception'  => '0.21';
 
 author_requires 'Test::Pod' => 1.14;

diff --git a/lib/MooseX/Getopt/Basic.pm b/lib/MooseX/Getopt/Basic.pm
index 316b15c..98fb72f 100644 (file)
--- a/lib/MooseX/Getopt/Basic.pm
+++ b/lib/MooseX/Getopt/Basic.pm
@@ -12,16 +12,27 @@ use Getopt::Long ();
 has ARGV       => (is => 'rw', isa => 'ArrayRef', metaclass => "NoGetopt");
 has extra_argv => (is => 'rw', isa => 'ArrayRef', metaclass => "NoGetopt");
 
+sub _get_configfile_from_cli {
+    my $class = shift;
+    my $configfile;
+    my $opt_parser = Getopt::Long::Parser->new( config => [ qw( pass_through ) ] );
+    $opt_parser->getoptions( "configfile=s" => \$configfile );
+    return $configfile;
+}
+
 sub new_with_options {
     my ($class, @params) = @_;
 
-    my $config_from_file;
+    my $constructor_params = ( @params == 1 ? $params[0] : {@params} );
+
+    my ($config_from_file, $configfile);
     if($class->meta->does_role('MooseX::ConfigFromFile')) {
         local @ARGV = @ARGV;
 
-        my $configfile;
-        my $opt_parser = Getopt::Long::Parser->new( config => [ qw( pass_through ) ] );
-        $opt_parser->getoptions( "configfile=s" => \$configfile );
+        $configfile = $class->_get_configfile_from_cli;
+        if(!defined $configfile) {
+            $configfile = $constructor_params->{configfile};
+        }
 
         if(!defined $configfile) {
             my $cfmeta = $class->meta->find_attribute_by_name('configfile');
@@ -45,8 +56,6 @@ 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';
 
@@ -57,7 +66,7 @@ sub new_with_options {
         params => $constructor_params,
     );
 
-    my $params = $config_from_file ? { %$config_from_file, %{$processed{params}} } : $processed{params};
+    my $params = $config_from_file ? { configfile => $configfile, %$config_from_file, %{$processed{params}} } : $processed{params};
 
     # did the user request usage information?
     if ( $processed{usage} && ($params->{'?'} or $params->{help} or $params->{usage}) )

diff --git a/t/008_configfromfile.t b/t/008_configfromfile.t
index 62e6ed9..864d3e3 100644 (file)
--- a/t/008_configfromfile.t
+++ b/t/008_configfromfile.t
@@ -11,10 +11,6 @@ if ( !eval { require MooseX::ConfigFromFile } )
 {
     plan skip_all => 'Test requires MooseX::ConfigFromFile';
 }
-else
-{
-    plan tests => 37;
-}
 
 {
     package App;
@@ -87,11 +83,33 @@ else
     );
 }
 
+{
+    package App::ConfigFileFromProjectOption;
+
+    use Moose;
+    extends 'App';
+
+    has 'project' => (
+        is        => 'rw',
+        isa       => 'Str',
+        required  => 1,
+    );
+    has '+configfile' => ();
+
+    around _get_configfile_from_cli => sub {
+        my ($orig, $self) = @_;
+        my $project;
+        my $opt_parser = Getopt::Long::Parser->new( config => [ qw( pass_through ) ] );
+        $opt_parser->getoptions( "project=s" => \$project );
+        return "/notused/specific/$project/config";
+    };
+}
+
 # No config specified
 {
     local @ARGV = qw( --required_from_argv 1 );
 
-    throws_ok { App->new_with_options } qr/Required option missing: required_from_config/;
+    throws_ok { App->new_with_options } qr/(Required option missing: required_from_config|Attribute \(required_from_config\) is required)/;
 
     {
         my $app = App::DefaultConfigFile->new_with_options;
@@ -157,10 +175,50 @@ else
     }
 }
 
+# No config specified
+{
+    local @ARGV = qw( --required_from_argv 1 --project quux );
+
+    {
+        my $app = App::ConfigFileFromProjectOption->new_with_options;
+        isa_ok( $app, 'App::ConfigFileFromProjectOption' );
+        app_ok( $app );
+
+        ok( $app->config_from_override,
+            '... config_from_override true as expected' );
+
+        is( $app->project, 'quux',
+            '... project is quux as expected' );
+
+        is( $app->configfile, File::Spec->canonpath('/notused/specific/quux/config'),
+            '... configfile is /notused/specific/quux/config as expected' );
+    }
+}
+
+# Config specified
+{
+    local @ARGV = qw( --configfile /notused --required_from_argv 1 --project quux );
+
+    {
+        my $app = App::ConfigFileFromProjectOption->new_with_options;
+        isa_ok( $app, 'App::ConfigFileFromProjectOption' );
+        app_ok( $app );
+
+        ok( $app->config_from_override,
+             '... config_from_override true as expected' );
+
+        is( $app->project, 'quux',
+            '... project is quux as expected' );
+
+        is( $app->configfile, File::Spec->canonpath('/notused'),
+            '... configfile is /notused as expected' );
+    }
+}
+
 # Required arg not supplied from cmdline
 {
     local @ARGV = qw( --configfile /notused );
-    throws_ok { App->new_with_options } qr/Required option missing: required_from_argv/;
+    throws_ok { App->new_with_options } qr/(Required option missing: required_from_argv|Attribute \(required_from_argv\) is required)/;
 }
 
 # Config file value overriden from cmdline
@@ -224,3 +282,6 @@ sub app_ok {
     is( $app->required_from_argv, '1',
         '... required_from_argv is 1 as expected' );
 }
+
+done_testing;
+