From: Joel Bernstein <joel@fysh.org>
Date: Tue, 22 Aug 2006 17:37:01 +0000 (+0000)
Subject: lots of Config::Any fixes, brought in C::Any testsuite (refactored, partly, from...
X-Git-Tag: v0.04~10
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e967a60fa6fb5adeb6ead013b0b60289b2a92e2e;p=p5sagit%2FConfig-Any.git
lots of Config::Any fixes, brought in C::Any testsuite (refactored, partly, from ConfigLoader)
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
--- 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
--- a/lib/Config/Any/General.pm
+++ b/lib/Config/Any/General.pm
@@ -42,7 +42,7 @@ sub load {
my $file = shift;
# work around bug (?) in Config::General
- return if $class->_test_perl($file);
+# return if $class->_test_perl($file);
require Config::General;
my $configfile = Config::General->new( $file );
diff --git a/lib/Config/Any/INI.pm b/lib/Config/Any/INI.pm
index 092362d..a091ba9 100644
--- a/lib/Config/Any/INI.pm
+++ b/lib/Config/Any/INI.pm
@@ -43,11 +43,23 @@ sub load {
require Config::Tiny;
my $config = Config::Tiny->read( $file );
- my $main = delete $config->{ _ };
-
- $config->{ $_ } = $main->{ $_ } for keys %$main;
- return $config;
+ my $main = delete $config->{ _ };
+ my $out;
+ $out->{$_} = $main->{$_} for keys %$main;
+
+ for my $k (keys %$config) {
+ my @keys = split /\s+/, $k;
+ my $ref = $config->{$k};
+
+ if (@keys > 1) {
+ my ($a, $b) = @keys[0,1];
+ $out->{$a}->{$b} = $ref;
+ } else {
+ $out->{$k} = $ref;
+ }
+ }
+ return $out;
}
=head1 AUTHOR
@@ -56,6 +68,8 @@ sub load {
=item * Brian Cassidy E<lt>bricas@cpan.orgE<gt>
+=item * Joel Bernstein E<lt>rataxis@cpan.orgE<gt>
+
=back
=head1 COPYRIGHT AND LICENSE
@@ -79,4 +93,4 @@ it under the same terms as Perl itself.
=cut
-1;
\ No newline at end of file
+1;
diff --git a/lib/Config/Any/Perl.pm b/lib/Config/Any/Perl.pm
index 6c179f5..ae7bd7b 100644
--- 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 {
my $class = shift;
my $file = shift;
-
return eval { require $file };
}
@@ -73,4 +72,4 @@ it under the same terms as Perl itself.
=cut
-1;
\ No newline at end of file
+1;
diff --git a/lib/Config/Any/XML.pm b/lib/Config/Any/XML.pm
index a37a2f2..42a8380 100644
--- a/lib/Config/Any/XML.pm
+++ b/lib/Config/Any/XML.pm
@@ -45,9 +45,29 @@ sub load {
require XML::Simple;
XML::Simple->import;
- my $config = XMLin( $file, ForceArray => [ qw( component model view controller ) ] );
+ my $config = XMLin(
+ $file,
+ ForceArray => [ qw( component model view controller ) ],
+ );
- return $config;
+ return $class->_coerce($config);
+}
+
+sub _coerce {
+ # coerce the XML-parsed config into the correct format
+ my $class = shift;
+ my $config = shift;
+ my $out;
+ for my $k (keys %$config) {
+ my $ref = $config->{$k};
+ my $name = ref $ref ? delete $ref->{name} : undef;
+ if (defined $name) {
+ $out->{$k}->{$name} = $ref;
+ } else {
+ $out->{$k} = $ref;
+ }
+ }
+ $out;
}
=head1 AUTHOR
@@ -56,6 +76,8 @@ sub load {
=item * Brian Cassidy E<lt>bricas@cpan.orgE<gt>
+=item * Joel Bernstein E<lt>rataxis@cpan.orgE<gt>
+
=back
=head1 COPYRIGHT AND LICENSE
@@ -79,4 +101,4 @@ it under the same terms as Perl itself.
=cut
-1;
\ No newline at end of file
+1;
diff --git a/t/20-parse.t b/t/20-parse.t
new file mode 100644
index 0000000..640bb79
--- /dev/null
+++ b/t/20-parse.t
@@ -0,0 +1,27 @@
+package MockApp;
+
+use Test::More tests => 54;
+use Scalar::Util qw(blessed reftype);
+use Config::Any;
+
+my @files = map { "t/conf/$_" }
+ qw(conf.conf conf.ini conf.json conf.pl conf.xml conf.yml);
+
+for my $f (@files) {
+ ok(my $c_arr = Config::Any->load_files({files=>[$f], use_ext=>1}), "load_files with use_ext works");
+ ok(my $c = $c_arr->[0], "load_files returns an arrayref");
+ ok(ref $c, "load_files arrayref contains a ref");
+ my $ref = blessed $c ? reftype $c : ref $c;
+ is(substr($ref,0,4), "HASH", "hashref");
+ my ($name, $cfg) = each %$c;
+ is($name, $f, "filename matches");
+ my $cfgref = blessed $cfg ? reftype $cfg : ref $cfg;
+ is(substr($cfgref,0,4), "HASH", "hashref cfg");
+
+ is( $cfg->{name}, 'TestApp', "appname parses" );
+ is( $cfg->{Component}{ "Controller::Foo" }->{ foo }, 'bar',
+ "component->cntrlr->foo = bar" );
+ is( $cfg->{Model}{ "Model::Baz" }->{ qux }, 'xyzzy',
+ "model->model::baz->qux = xyzzy" );
+}
+
diff --git a/t/perlcritic.t b/t/perlcritic.t
deleted file mode 100644
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();