From: Joel Bernstein 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 Ebricas@cpan.orgE +=item * Joel Bernstein Erataxis@cpan.orgE + =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 Ebricas@cpan.orgE +=item * Joel Bernstein Erataxis@cpan.orgE + =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();