From: Brian Cassidy <bricas@cpan.org>
Date: Wed, 12 Nov 2008 14:44:22 +0000 (+0000)
Subject:  r37256@bricas-laptop (orig r8347):  bricas | 2008-09-03 10:53:01 -0300
X-Git-Tag: v0.15~1
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FConfig-Any.git;a=commitdiff_plain;h=dcfb1d1d1a544d27a82cb174168df23abc539acb

 r37256@bricas-laptop (orig r8347):  bricas | 2008-09-03 10:53:01 -0300
 branch for new feature
 r37257@bricas-laptop (orig r8348):  bricas | 2008-09-03 10:55:06 -0300
 when use_ext is true, we will check to see if there are no supported modules for a particular file. instead of the file being skipped, an error will be thrown.
 officially support multiple loaders per extension.
 add a Config::Any::Base for all loaders to inherit from, plus add a new dependency mechanism: requires_any_of() and requires_all_of().
 r37293@bricas-laptop (orig r8354):  bricas | 2008-09-04 10:52:33 -0300
 when use_ext is true, a fatal error will be thrown if there are no loaders available that understand the file extension
 r40211@bricas-laptop (orig r8589):  bricas | 2008-11-12 10:36:43 -0400
 filter out loaders that don't inherit from Config::Any::Base (RT #40830)
 r40212@bricas-laptop (orig r8590):  bricas | 2008-11-12 10:40:32 -0400
 add RT number
---

diff --git a/Changes b/Changes
index 77710e8..b2ca3d5 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,16 @@
 Revision history for Config-Any
 
+0.15 XXX
+    - when use_ext is true, we will check to see if there are no supported
+      modules for a particular file. instead of the file being skipped, an
+      error will be thrown (RT #38927).
+    - also, when use_ext is true, a fatal error will be thrown if there are
+      no loaders available that understand the file extension.
+    - officially support multiple loaders per extension
+    - add a Config::Any::Base for all loaders to inherit from, plus add
+      a new dependency mechanism: requires_any_of() and requires_all_of().
+    - filter out loaders that don't inherit from Config::Any::Base (RT #40830)
+
 0.14 Wed 06 Aug 2008
     - skip xml failure tests if XML::LibXML < 1.59 is installed, it seems
       to parse anything you throw at it (Matt S. Trout)
diff --git a/lib/Config/Any.pm b/lib/Config/Any.pm
index c4de85b..ef3430b 100644
--- a/lib/Config/Any.pm
+++ b/lib/Config/Any.pm
@@ -6,7 +6,7 @@ use warnings;
 use Carp;
 use Module::Pluggable::Object ();
 
-our $VERSION = '0.14';
+our $VERSION = '0.15';
 
 =head1 NAME
 
@@ -149,7 +149,10 @@ sub _load {
     my $use_ext_lut = !$force && $args->{ use_ext };
     if ( $use_ext_lut ) {
         for my $plugin ( @plugins ) {
-            $extension_lut{ $_ } = $plugin for $plugin->extensions;
+            for ( $plugin->extensions ) {
+                $extension_lut{ $_ } ||= [];
+                push @{ $extension_lut{ $_ } }, $plugin;
+            }
         }
 
         $extension_re = join( '|', keys %extension_lut );
@@ -174,12 +177,21 @@ sub _load {
 
         if ( $use_ext_lut ) {
             $filename =~ m{\.($extension_re)\z};
-            next unless $1;
-            @try_plugins = $extension_lut{ $1 };
+
+            if( !$1 ) {
+                $filename =~ m{\.([^.]+)\z};
+                croak "There are no loaders available for .${1} files";
+            }
+
+            @try_plugins = @{ $extension_lut{ $1 } };
         }
 
+        # not using use_ext means we try all plugins anyway, so we'll
+        # ignore it for the "unsupported" error
+        my $supported = $use_ext_lut ? 0 : 1;
         for my $loader ( @try_plugins ) {
             next unless $loader->is_supported;
+            $supported = 1;
             my @configs
                 = eval { $loader->load( $filename, $loader_args{ $loader } ); };
 
@@ -196,6 +208,12 @@ sub _load {
                 { $filename => @configs == 1 ? $configs[ 0 ] : \@configs };
             last;
         }
+
+        if ( !$supported ) {
+            croak
+                "Cannot load $filename: required support modules are not available.\nPlease install "
+                . join( " OR ", map { _support_error( $_ ) } @try_plugins );
+        }
     }
 
     if ( defined $args->{ flatten_to_hash } ) {
@@ -206,6 +224,17 @@ sub _load {
     return \@results;
 }
 
+sub _support_error {
+    my $module = shift;
+    if ( $module->can( 'requires_all_of' ) ) {
+        return join( ' and ',
+            map { ref $_ ? join( ' ', @$_ ) : $_ } $module->requires_all_of );
+    }
+    if ( $module->can( 'requires_any_of' ) ) {
+        return 'one of ' . join( ' or ', $module->requires_any_of );
+    }
+}
+
 =head2 finder( )
 
 The C<finder()> classmethod returns the 
@@ -219,6 +248,7 @@ sub finder {
     my $class  = shift;
     my $finder = Module::Pluggable::Object->new(
         search_path => [ __PACKAGE__ ],
+        except      => [ __PACKAGE__ . '::Base' ],
         require     => 1
     );
     return $finder;
@@ -233,7 +263,8 @@ found by L<Module::Pluggable::Object|Module::Pluggable::Object>.
 
 sub plugins {
     my $class = shift;
-    return $class->finder->plugins;
+    # filter out things that don't look like our plugins
+    return grep { $_->isa( 'Config::Any::Base' ) } $class->finder->plugins;
 }
 
 =head2 extensions( )
diff --git a/lib/Config/Any/Base.pm b/lib/Config/Any/Base.pm
new file mode 100644
index 0000000..84ad932
--- /dev/null
+++ b/lib/Config/Any/Base.pm
@@ -0,0 +1,85 @@
+package Config::Any::Base;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+Config::Any::Base - Base class for loaders
+
+=head1 DESCRIPTION
+
+This is a base class for all loaders. It currently handles the specification
+of dependencies in order to ensure the subclass can load the config file
+format.
+
+=head1 METHODS
+
+=head2 is_supported( )
+
+Allows us to determine if the file format can be loaded. The can be done via
+one of two subclass methds:
+
+=over 4
+
+=item * C<requires_all_of()> - returns an array of items that must all be present in order to work
+
+=item * C<requires_any_of()> - returns an array of items in which at least one must be present
+
+=back
+
+You can specify a module version by passing an array reference in the return.
+
+    sub requires_all_of { [ 'My::Module', '1.1' ], 'My::OtherModule' }
+
+Lack of specifying these subs will assume you require no extra modules to function.
+
+=cut
+
+sub is_supported {
+    my ( $class ) = shift;
+    if ( $class->can( 'requires_all_of' ) ) {
+        eval join( '', map { _require_line( $_ ) } $class->requires_all_of );
+        return $@ ? 0 : 1;
+    }
+    if ( $class->can( 'requires_any_of' ) ) {
+        for ( $class->requires_any_of ) {
+            eval _require_line( $_ );
+            return 1 unless $@;
+        }
+        return 0;
+    }
+
+    # requires nothing!
+    return 1;
+}
+
+sub _require_line {
+    my ( $input ) = shift;
+    my ( $module, $version ) = ( ref $input ? @$input : $input );
+    return "require $module;"
+        . ( $version ? "${module}->VERSION('${version}');" : '' );
+}
+
+=head1 AUTHOR
+
+Brian Cassidy E<lt>bricas@cpan.orgE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2008 by Brian Cassidy
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself. 
+
+=head1 SEE ALSO
+
+=over 4 
+
+=item * L<Config::Any>
+
+=back
+
+=cut
+
+1;
diff --git a/lib/Config/Any/General.pm b/lib/Config/Any/General.pm
index 6aceb98..749b3c4 100644
--- a/lib/Config/Any/General.pm
+++ b/lib/Config/Any/General.pm
@@ -3,6 +3,8 @@ package Config::Any::General;
 use strict;
 use warnings;
 
+use base 'Config::Any::Base';
+
 =head1 NAME
 
 Config::Any::General - Load Config::General files
@@ -68,16 +70,13 @@ sub _test_perl {
     return defined $is_perl_src;
 }
 
-=head2 is_supported( )
+=head2 requires_all_of( )
 
-Returns true if L<Config::General> is available.
+Specifies that this module requires L<Config::General> in order to work.
 
 =cut
 
-sub is_supported {
-    eval { require Config::General; };
-    return $@ ? 0 : 1;
-}
+sub requires_all_of { 'Config::General' }
 
 =head1 AUTHOR
 
diff --git a/lib/Config/Any/INI.pm b/lib/Config/Any/INI.pm
index e0d7215..132f079 100644
--- a/lib/Config/Any/INI.pm
+++ b/lib/Config/Any/INI.pm
@@ -3,6 +3,8 @@ package Config::Any::INI;
 use strict;
 use warnings;
 
+use base 'Config::Any::Base';
+
 our $MAP_SECTION_SPACE_TO_NESTED_KEY = 1;
 
 =head1 NAME
@@ -66,16 +68,13 @@ sub load {
     return $out;
 }
 
-=head2 is_supported( )
+=head2 requires_all_of( )
 
-Returns true if L<Config::Tiny> is available.
+Specifies that this module requires L<Config::Tiny> in order to work.
 
 =cut
 
-sub is_supported {
-    eval { require Config::Tiny; };
-    return $@ ? 0 : 1;
-}
+sub requires_all_of { 'Config::Tiny' }
 
 =head1 PACKAGE VARIABLES
 
diff --git a/lib/Config/Any/JSON.pm b/lib/Config/Any/JSON.pm
index 6c6eb6e..6e39d63 100644
--- a/lib/Config/Any/JSON.pm
+++ b/lib/Config/Any/JSON.pm
@@ -3,6 +3,8 @@ package Config::Any::JSON;
 use strict;
 use warnings;
 
+use base 'Config::Any::Base';
+
 =head1 NAME
 
 Config::Any::JSON - Load JSON config files
@@ -58,18 +60,14 @@ sub load {
     }
 }
 
-=head2 is_supported( )
+=head2 requires_any_of( )
 
-Returns true if either L<JSON::Syck> or L<JSON> is available.
+Specifies that this modules requires one of L<JSON::Syck> or L<JSON> in 
+order to work.
 
 =cut
 
-sub is_supported {
-    eval { require JSON::Syck; };
-    return 1 unless $@;
-    eval { require JSON; };
-    return $@ ? 0 : 1;
-}
+sub requires_any_of { 'JSON::Syck', 'JSON' }
 
 =head1 AUTHOR
 
diff --git a/lib/Config/Any/Perl.pm b/lib/Config/Any/Perl.pm
index 936efab..2798d87 100644
--- a/lib/Config/Any/Perl.pm
+++ b/lib/Config/Any/Perl.pm
@@ -3,6 +3,8 @@ package Config::Any::Perl;
 use strict;
 use warnings;
 
+use base 'Config::Any::Base';
+
 my %cache;
 
 =head1 NAME
@@ -54,16 +56,6 @@ sub load {
     return $content;
 }
 
-=head2 is_supported( )
-
-Returns true.
-
-=cut
-
-sub is_supported {
-    return 1;
-}
-
 =head1 AUTHOR
 
 Brian Cassidy E<lt>bricas@cpan.orgE<gt>
diff --git a/lib/Config/Any/XML.pm b/lib/Config/Any/XML.pm
index ca2d55b..ed48589 100644
--- a/lib/Config/Any/XML.pm
+++ b/lib/Config/Any/XML.pm
@@ -3,6 +3,8 @@ package Config::Any::XML;
 use strict;
 use warnings;
 
+use base 'Config::Any::Base';
+
 =head1 NAME
 
 Config::Any::XML - Load XML config files
@@ -73,16 +75,13 @@ sub _coerce {
     $out;
 }
 
-=head2 is_supported( )
+=head2 requires_all_of( )
 
-Returns true if L<XML::Simple> is available.
+Specifies that this module requires L<XML::Simple> in order to work.
 
 =cut
 
-sub is_supported {
-    eval { require XML::Simple; };
-    return $@ ? 0 : 1;
-}
+sub requires_all_of { 'XML::Simple' }
 
 =head1 CAVEATS
 
diff --git a/lib/Config/Any/YAML.pm b/lib/Config/Any/YAML.pm
index 31f0e8a..2e800be 100644
--- a/lib/Config/Any/YAML.pm
+++ b/lib/Config/Any/YAML.pm
@@ -3,6 +3,8 @@ package Config::Any::YAML;
 use strict;
 use warnings;
 
+use base 'Config::Any::Base';
+
 =head1 NAME
 
 Config::Any::YAML - Load YAML config files
@@ -54,18 +56,14 @@ sub load {
     }
 }
 
-=head2 is_supported( )
+=head2 requires_any_of( )
 
-Returns true if either L<YAML::Syck> or L<YAML> is available.
+Specifies that this modules requires one of L<YAML::Syck> (0.70) or L<YAML> in 
+order to work.
 
 =cut
 
-sub is_supported {
-    eval { require YAML::Syck; YAML::Syck->VERSION( '0.70' ) };
-    return 1 unless $@;
-    eval { require YAML; };
-    return $@ ? 0 : 1;
-}
+sub requires_any_of { [ 'YAML::Syck', '0.70' ], 'YAML' }
 
 =head1 AUTHOR
 
diff --git a/t/10-branches.t b/t/10-branches.t
index 8368bcc..b211876 100644
--- a/t/10-branches.t
+++ b/t/10-branches.t
@@ -38,7 +38,8 @@ use_ok( 'Config::Any' );
     );
 }
 
-my @files = glob( "t/conf/conf.*" );
+# grep out files we don't understand for these tests
+my @files = grep { !m{\.(foo|unsupported)$} } glob( "t/conf/conf.*" );
 my $filter = sub { return };
 ok( Config::Any->load_files( { files => \@files, use_ext => 0 } ),
     "use_ext 0 works" );
diff --git a/t/50-general.t b/t/50-general.t
index 59b3f35..c73c68a 100644
--- a/t/50-general.t
+++ b/t/50-general.t
@@ -30,5 +30,5 @@ else {
     my $config = eval { Config::Any::General->load( $file ) };
 
     ok( !$config, 'config load failed' );
-    ok( $@, "error thrown ($@)" );
+    ok( $@,       "error thrown ($@)" );
 }
diff --git a/t/51-ini.t b/t/51-ini.t
index eb8e788..1fea544 100644
--- a/t/51-ini.t
+++ b/t/51-ini.t
@@ -53,5 +53,5 @@ else {
     my $config = eval { Config::Any::INI->load( $file ) };
 
     ok( !$config, 'config load failed' );
-    ok( $@, "error thrown ($@)" );
+    ok( $@,       "error thrown ($@)" );
 }
diff --git a/t/52-json.t b/t/52-json.t
index 0dd65f4..65c6099 100644
--- a/t/52-json.t
+++ b/t/52-json.t
@@ -23,5 +23,5 @@ else {
     my $config = eval { Config::Any::JSON->load( $file ) };
 
     ok( !$config, 'config load failed' );
-    ok( $@, "error thrown ($@)" );
+    ok( $@,       "error thrown ($@)" );
 }
diff --git a/t/53-perl.t b/t/53-perl.t
index 35a5cf6..5ad0468 100644
--- a/t/53-perl.t
+++ b/t/53-perl.t
@@ -22,5 +22,5 @@ use Config::Any::Perl;
     my $config = eval { Config::Any::Perl->load( $file ) };
 
     ok( !$config, 'config load failed' );
-    ok( $@, "error thrown ($@)" );
+    ok( $@,       "error thrown ($@)" );
 }
diff --git a/t/54-xml.t b/t/54-xml.t
index 41376ac..e2badee 100644
--- a/t/54-xml.t
+++ b/t/54-xml.t
@@ -19,13 +19,14 @@ else {
 
 # test invalid config
 SKIP: {
-    my $broken_libxml = eval { require XML::LibXML; XML::LibXML->VERSION lt '1.59'; };
+    my $broken_libxml
+        = eval { require XML::LibXML; XML::LibXML->VERSION lt '1.59'; };
     skip 'XML::LibXML < 1.58 has issues', 2 if $broken_libxml;
 
-    local $SIG{__WARN__} = sub {}; # squash warnings from XML::Simple
+    local $SIG{ __WARN__ } = sub { };    # squash warnings from XML::Simple
     my $file = 't/invalid/conf.xml';
     my $config = eval { Config::Any::XML->load( $file ) };
 
     ok( !$config, 'config load failed' );
-    ok( $@, "error thrown ($@)" );
+    ok( $@,       "error thrown ($@)" );
 }
diff --git a/t/55-yaml.t b/t/55-yaml.t
index 2eb8d4e..5a020bb 100644
--- a/t/55-yaml.t
+++ b/t/55-yaml.t
@@ -23,5 +23,5 @@ else {
     my $config = eval { Config::Any::YAML->load( $file ) };
 
     ok( !$config, 'config load failed' );
-    ok( $@, "error thrown ($@)" );
+    ok( $@,       "error thrown ($@)" );
 }
diff --git a/t/61-features.t b/t/61-features.t
index e754a56..f8557ef 100644
--- a/t/61-features.t
+++ b/t/61-features.t
@@ -59,7 +59,7 @@ SKIP: {
             }
         );
 
-        ok( $result, 'load file with parser forced, flatten to hash' );
+        ok( $result,     'load file with parser forced, flatten to hash' );
         ok( ref $result, 'load_files hashref contains a ref' );
 
         my $ref = blessed $result ? reftype $result : ref $result;
diff --git a/t/63-unsupported.t b/t/63-unsupported.t
new file mode 100644
index 0000000..3af69f1
--- /dev/null
+++ b/t/63-unsupported.t
@@ -0,0 +1,22 @@
+use strict;
+use warnings;
+
+use Test::More tests => 3;
+
+use lib 't/lib';
+use Config::Any;
+
+{
+    my $result = eval {
+        Config::Any->load_files(
+            { files => [ 't/conf/conf.unsupported' ], use_ext => 1 } );
+    };
+
+    ok( !defined $result, 'empty result' );
+    ok( $@,               'error thrown' );
+    like(
+        $@,
+        qr/required support modules are not available/,
+        'error message'
+    );
+}
diff --git a/t/64-extfail.t b/t/64-extfail.t
new file mode 100644
index 0000000..d6cace8
--- /dev/null
+++ b/t/64-extfail.t
@@ -0,0 +1,21 @@
+use strict;
+use warnings;
+
+use Test::More tests => 3;
+
+use Config::Any;
+
+{
+    my $result = eval {
+        Config::Any->load_files(
+            { files => [ 't/conf/conf.unsupported' ], use_ext => 1 } );
+    };
+
+    ok( !defined $result, 'empty result' );
+    ok( $@,               'error thrown' );
+    like(
+        $@,
+        qr/There are no loaders available for \.unsupported files/,
+        'error message'
+    );
+}
diff --git a/t/conf/conf.unsupported b/t/conf/conf.unsupported
new file mode 100644
index 0000000..e69de29
diff --git a/t/lib/Config/Any/Unsupported.pm b/t/lib/Config/Any/Unsupported.pm
new file mode 100644
index 0000000..58d1533
--- /dev/null
+++ b/t/lib/Config/Any/Unsupported.pm
@@ -0,0 +1,17 @@
+package Config::Any::Unsupported;
+
+use strict;
+use warnings;
+
+use base 'Config::Any::Base';
+
+sub extensions {
+    return qw( unsupported );
+}
+
+sub load {
+}
+
+sub requires_all_of { 'My::Module::DoesNotExist' }
+
+1;