lots of Config::Any fixes, brought in C::Any testsuite (refactored, partly, from...

fixed buggy ConfigLoader config files, added config coercion method to XML.pm, added config coercion code to INI.pm

diff --git a/lib/Config/Any.pm b/lib/Config/Any.pm
index c7580a2..b7b3ac0 100644 (file)
--- a/lib/Config/Any.pm
+++ b/lib/Config/Any.pm
@@ -134,16 +134,26 @@ sub _load {
 
     my $final_configs       = [];
     my $originally_loaded   = {};
+       my %files = map { $_ => 1 } @$files_ref;
 
     for my $loader ( $class->plugins ) {
+               last unless keys %files;
+#      warn "loader: $loader\n";
         my %ext = map { $_ => 1 } $loader->extensions;
         FILE:
-        for my $filename (@$files_ref) {
+        for my $filename (keys %files) {
             if (defined $use_ext) {
+#                      warn "using file extension to decide which loader to use for file $filename\n";
+                               my $matched_ext = 0;
+                EXT:
                 for my $e (keys %ext) {
-                    my ($fileext) = $filename =~ m{ \. $e \z }xms;
-                    next FILE unless exists $ext{$fileext};
+#                              warn "trying ext $e\n";
+                    next EXT  unless $filename =~ m{ \. $e \z }xms; 
+#                                      warn "filename $filename matched extension $e\n";
+                    next FILE unless exists $ext{$e};
+                                       $matched_ext = 1;
                 }
+                               next FILE unless $matched_ext;
             }
 
             my $config;
@@ -152,6 +162,8 @@ sub _load {
                        };
                        next if $EVAL_ERROR;
             next if !$config;
+                       delete $files{$filename};
+#                      warn "loader $loader loaded file $filename\n";
             $filter_cb->( $config ) if defined $filter_cb;
             push @$final_configs, { $filename => $config };
         }

diff --git a/lib/Config/Any/General.pm b/lib/Config/Any/General.pm
index 1951488..b453ca4 100644 (file)
--- a/lib/Config/Any/General.pm
+++ b/lib/Config/Any/General.pm
@@ -42,7 +42,7 @@ sub load {
     my $file  = shift;\r
 \r
     # work around bug (?) in Config::General\r
-    return if $class->_test_perl($file);\r
+#   return if $class->_test_perl($file);\r
 \r
     require Config::General;\r
     my $configfile = Config::General->new( $file );\r

diff --git a/lib/Config/Any/INI.pm b/lib/Config/Any/INI.pm
index 092362d..a091ba9 100644 (file)
--- a/lib/Config/Any/INI.pm
+++ b/lib/Config/Any/INI.pm
@@ -43,11 +43,23 @@ sub load {
 \r
     require Config::Tiny;\r
     my $config = Config::Tiny->read( $file );\r
-    my $main   = delete $config->{ _ };\r
-    \r
-    $config->{ $_ } = $main->{ $_ } for keys %$main;\r
 \r
-    return $config;\r
+    my $main   = delete $config->{ _ };\r
+       my $out;\r
+       $out->{$_} = $main->{$_} for keys %$main;\r
+\r
+       for my $k (keys %$config) {\r
+               my @keys = split /\s+/, $k;\r
+               my $ref = $config->{$k};\r
+\r
+               if (@keys > 1) {\r
+                       my ($a, $b) = @keys[0,1];\r
+                       $out->{$a}->{$b} = $ref;\r
+               } else {\r
+                       $out->{$k} = $ref;\r
+               }\r
+       }\r
+    return $out;\r
 }\r
 \r
 =head1 AUTHOR\r
@@ -56,6 +68,8 @@ sub load {
 \r
 =item * Brian Cassidy E<lt>bricas@cpan.orgE<gt>\r
 \r
+=item * Joel Bernstein E<lt>rataxis@cpan.orgE<gt>\r
+\r
 =back\r
 \r
 =head1 COPYRIGHT AND LICENSE\r
@@ -79,4 +93,4 @@ it under the same terms as Perl itself.
 \r
 =cut\r
 \r
-1;
\ No newline at end of file
+1;\r

diff --git a/lib/Config/Any/Perl.pm b/lib/Config/Any/Perl.pm
index 6c179f5..ae7bd7b 100644 (file)
--- a/lib/Config/Any/Perl.pm
+++ b/lib/Config/Any/Perl.pm
@@ -42,7 +42,6 @@ Attempts to load C<$file> as a Perl file.
 sub load {\r
     my $class = shift;\r
     my $file  = shift;\r
-\r
     return eval { require $file };\r
 }\r
 \r
@@ -73,4 +72,4 @@ it under the same terms as Perl itself.
 \r
 =cut\r
 \r
-1;
\ No newline at end of file
+1;\r

diff --git a/lib/Config/Any/XML.pm b/lib/Config/Any/XML.pm
index a37a2f2..42a8380 100644 (file)
--- a/lib/Config/Any/XML.pm
+++ b/lib/Config/Any/XML.pm
@@ -45,9 +45,29 @@ sub load {
 \r
     require XML::Simple;\r
     XML::Simple->import;\r
-    my $config = XMLin( $file, ForceArray => [ qw( component model view controller ) ] );\r
+    my $config = XMLin( \r
+               $file, \r
+               ForceArray => [ qw( component model view controller ) ],\r
+       );\r
 \r
-    return $config;\r
+       return $class->_coerce($config);\r
+}\r
+\r
+sub _coerce {\r
+       # coerce the XML-parsed config into the correct format\r
+       my $class = shift;\r
+       my $config = shift;\r
+       my $out;\r
+       for my $k (keys %$config) {\r
+               my $ref = $config->{$k};\r
+               my $name = ref $ref ? delete $ref->{name} : undef;\r
+               if (defined $name) {\r
+                       $out->{$k}->{$name} = $ref;     \r
+               } else {\r
+                       $out->{$k} = $ref;\r
+               }\r
+       }\r
+       $out;\r
 }\r
 \r
 =head1 AUTHOR\r
@@ -56,6 +76,8 @@ sub load {
 \r
 =item * Brian Cassidy E<lt>bricas@cpan.orgE<gt>\r
 \r
+=item * Joel Bernstein E<lt>rataxis@cpan.orgE<gt>\r
+\r
 =back\r
 \r
 =head1 COPYRIGHT AND LICENSE\r
@@ -79,4 +101,4 @@ it under the same terms as Perl itself.
 \r
 =cut\r
 \r
-1;
\ No newline at end of file
+1;\r

diff --git a/t/20-parse.t b/t/20-parse.t
new file mode 100644 (file)
index 0000000..640bb79
--- /dev/null
+++ b/t/20-parse.t
@@ -0,0 +1,27 @@
+package MockApp;\r
+\r
+use Test::More tests => 54;\r
+use Scalar::Util qw(blessed reftype);\r
+use Config::Any;\r
+\r
+my @files = map { "t/conf/$_" } \r
+       qw(conf.conf conf.ini conf.json conf.pl conf.xml conf.yml);\r
+\r
+for my $f (@files) {\r
+       ok(my $c_arr = Config::Any->load_files({files=>[$f], use_ext=>1}), "load_files with use_ext works");\r
+       ok(my $c = $c_arr->[0], "load_files returns an arrayref");\r
+       ok(ref $c, "load_files arrayref contains a ref");\r
+       my $ref = blessed $c ? reftype $c : ref $c;\r
+       is(substr($ref,0,4), "HASH", "hashref");\r
+       my ($name, $cfg) = each %$c;\r
+       is($name, $f, "filename matches");\r
+       my $cfgref = blessed $cfg ? reftype $cfg : ref $cfg;\r
+       is(substr($cfgref,0,4), "HASH", "hashref cfg");\r
+\r
+       is( $cfg->{name}, 'TestApp', "appname parses" );\r
+       is( $cfg->{Component}{ "Controller::Foo" }->{ foo }, 'bar',               \r
+               "component->cntrlr->foo = bar" );\r
+       is( $cfg->{Model}{ "Model::Baz" }->{ qux },              'xyzzy',                 \r
+               "model->model::baz->qux = xyzzy" );\r
+}\r
+\r

diff --git a/t/perlcritic.t b/t/perlcritic.t
deleted file mode 100644 (file)
index 7e7b210..0000000
--- a/t/perlcritic.t
+++ /dev/null
@@ -1,9 +0,0 @@
-#!perl
-
-if (!require Test::Perl::Critic) {
-    Test::More::plan(
-        skip_all => "Test::Perl::Critic required for testing PBP compliance"
-    );
-}
-
-Test::Perl::Critic::all_critic_ok();