use strict; use warnings; use File::Spec; use Test::More 'tests' => 80; BEGIN { use_ok('Config::Loader'); } my ($c,$C); my $path = get_path('skip'); ## SKIP ok($c = Config::Loader->new(path => $path, skip => qr{skip_\d}), 'new - skip - regex' ); $C=$c->(); ok( exists $C->{skip_not}, 'skip - dir - regex - 1' ); ok( ! exists $C->{skip_1}, 'skip - dir - regex - 2' ); ok( exists $C->{main}{skip_not}, 'skip - file - regex - 1' ); ok(! exists $C->{main}{skip_1}, 'skip - file - regex - 2' ); ok($c = Config::Loader->new(path => $path, skip => [qr{skip_1}, qr{skip_2}]), 'new - skip - regexen' ); $C=$c->(); ok( exists $C->{skip_not}, 'skip - dir - regexen - 1' ); ok( ! exists $C->{skip_1}, 'skip - dir - regexen - 2' ); ok( exists $C->{main}{skip_not}, 'skip - file - regexen - 1' ); ok(! exists $C->{main}{skip_1}, 'skip - file - regexen - 2' ); ok($c = Config::Loader->new(path => $path, skip => {'skip_1' => 1,'main.skip_1' => 1}), 'new - skip - hash' ); $C=$c->(); ok( exists $C->{skip_not}, 'skip - dir - hash - 1' ); ok( ! exists $C->{skip_1}, 'skip - dir - hash - 2' ); ok( exists $C->{main}{skip_not}, 'skip - file - hash - 1' ); ok(! exists $C->{main}{skip_1}, 'skip - file - hash - 2' ); ok($c = Config::Loader->new(path => $path, skip => sub { my ($self,$filename) = @_; return 1 if $filename=~/skip_1/; return 0; }), 'new - skip - sub' ); $C=$c->(); ok( exists $C->{skip_not}, 'skip - dir - sub - 1' ); ok( ! exists $C->{skip_1}, 'skip - dir - sub - 2' ); ok( exists $C->{main}{skip_not}, 'skip - file - sub - 1' ); ok(! exists $C->{main}{skip_1}, 'skip - file - sub - 2' ); ## LOAD_AS for main config $path = get_path('load_as'); ok($c = Config::Loader->new(path => $path), 'new - main load_as - none' ); is($c->C('file.a'), 1, 'main load_as - none - 1' ); is($c->C('file-(local).a'), 4, 'main load_as - none - 2' ); is($c->C('dir.file.a'), 1, 'main load_as - none - 3' ); is($c->C('dir-(local).file.a'), 4, 'main load_as - none - 4' ); is($c->C('sub.test.foo'), 'test', 'main load_as - none - 5' ); is($c->C('sub.test.bar'), 'test', 'main load_as - none - 6' ); is($c->C('sub.test-(aaa).foo'), 'test-(aaa)', 'main load_as - none - 7' ); is($c->C('sub.test-(bbb).foo'), 'test-(bbb)', 'main load_as - none - 8' ); is($c->C('sub.dir.test.foo'), 'test', 'main load_as - none - 9' ); is($c->C('sub.dir.test.bar'), 'test', 'main load_as - none - 10' ); is($c->C('sub.dir-(aaa).test.foo'), 'test-(aaa)', 'main load_as - none - 11' ); is($c->C('sub.dir-(bbb).test.foo'), 'test-(bbb)', 'main load_as - none - 12' ); ok($c = Config::Loader->new(path => $path, load_as => qr/(.*)-\(local\)/), 'new - load_as - regex' ); $C=$c->(); is($c->C('file.a'), '4', 'load_as - regex - 1' ); is($c->C('file.d'), '5', 'load_as - regex - 2' ); is($c->C('file.b'), '2', 'load_as - regex - 3' ); is($c->C('dir.file.a'), '4', 'load_as - regex - 4' ); is($c->C('dir.file.d'), '5', 'load_as - regex - 5' ); ok (!exists $C->{dir}{file}{b}, 'load_as - regex - 6' ); ok($c = Config::Loader->new(path => $path, load_as => sub { my ($self,$name) = @_; if ($name=~/(.*)-[(](\w+)[)]/) { return $2 eq 'aaa' ? $1 : undef; } return $name; }), 'new - load_as - sub' ); $C=$c->(); is($c->C('sub.test.foo'), 'test-(aaa)', 'load_as - sub - 1' ); is($c->C('sub.test.bar'), 'test', 'load_as - sub - 2' ); is($c->C('sub.dir.test.foo'), 'test-(aaa)', 'load_as - sub - 3' ); ok (!exists $C->{sub}{dir}{test}{bar}, 'load_as - sub - 4' ); ok (!exists $C->{sub}{'test-(aaa)'}, 'load_as - sub - 5' ); ok (!exists $C->{sub}{'test-(bbb)'}, 'load_as - sub - 6' ); ok (!exists $C->{sub}{'dir-(aaa)'}, 'load_as - sub - 7' ); ok (!exists $C->{sub}{'dir-(bbb)'}, 'load_as - sub - 7' ); ## SORT ok($c = Config::Loader->new(path => $path, load_as => qr/(.*)-\(local\)/, sort => sub {return [sort @{$_[1]}]}), 'new - load_as - regex' ); is($c->C('file.a'), '1', 'sort' ); ## IS_LOCAL $path=get_path('local'); ok($c = Config::Loader->new(path => $path), 'new - is_local - none' ); is ($c->C('main.db.servers.server1.host'), 'host1', 'is_local - none - 1' ); is ($c->C('main.db.servers.list.0'), 'server1', 'is_local - none - 2' ); ok($c = Config::Loader->new(path => $path, is_local => qr{override}), 'new - is_local - regex - ..' ); is ($c->C('main.db.servers.server1.host'), 'host4', 'is_local - regex - .. - 1' ); is ($c->C('main.db.servers.list.0'), 'server3', 'is_local - regex - .. - 2' ); ok($c = Config::Loader->new(path => $path, is_local => {override => 1}), 'new - is_local - hash - ..' ); is ($c->C('main.db.servers.server1.host'), 'host4', 'is_local - hash - .. - 1' ); is ($c->C('main.db.servers.list.0'), 'server3', 'is_local - hash - .. - 2' ); ok($c = Config::Loader->new(path => $path, is_local => sub { return $_[1] eq 'override'}), 'new - is_local - sub - ..' ); is ($c->C('main.db.servers.server1.host'), 'host4', 'is_local - sub - .. - 1' ); is ($c->C('main.db.servers.list.0'), 'server3', 'is_local - sub - .. - 2' ); ok($c = Config::Loader->new(path => $path, is_local => qr{-[(].+[)]}, load_as => qr{(.*)-[(].+[)]}), 'new - is_local - regex - key' ); is ($c->C('email.address.sig'), 'Us', 'is_local - regex - key - 1' ); is ($c->C('email.address.from'), 'dev@', 'is_local - regex - key - 2' ); is ($c->C('email.address.headers.0'), 'ddd', 'is_local - regex - key - 3' ); is ($c->C('email.address.subject'), 'DEV', 'is_local - regex - key - 4' ); ok($c = Config::Loader->new(path => $path, is_local => qr{-[(].+[)]}, load_as => sub { my $name = $_[1]; if ($name=~/(.*)-[(](.*)[)]/) { return $2 eq 'aaa' ? $1 : undef; } return $name;} ), 'new - is_local - sub - key' ); is ($c->C('email.address.sig'), 'Us', 'is_local - sub - key - 1' ); is ($c->C('email.address.from'), 'dev@', 'is_local - sub - key - 2' ); is ($c->C('email.address.headers.0'), 'ddd', 'is_local - sub - key - 3' ); is ($c->C('email.address.subject'), 'HELP', 'is_local - sub - key - 4' ); $path = get_path('array'); ok($c = Config::Loader->new(path => $path), 'new - array merge' ); is_deeply( scalar $c->C('main.foo'), [qw(a b d f h i Z k l m)], 'array merge - 1' ); is_deeply( scalar $c->C('main.bar'), [qw(a b Z d Y f h i j), undef, undef, 'X',undef, 'W'], 'array merge - 2' ); is_deeply( scalar $c->C('main.baz'), [qw(x y z)], 'array merge - 3' ); ## EXPLAIN my ($debug, $olderr); open $olderr, '>&', \*STDERR or die "Can't dup STDERR: $!"; close STDERR or die "Can't close STDERR : $!"; open STDERR, '>>', \$debug or die "Can't open STDERR to debug : $!"; ok($c = Config::Loader->new(path => $path, debug => 1), 'new - debug' ); open STDERR, '>&', $olderr or die "Can't dup OLDERR: $!"; like($debug, qr/Entering dir/, 'debug' ); #=================================== sub get_path { #=================================== my ($vol,$path) = File::Spec->splitpath( File::Spec->rel2abs($0) ); $path = File::Spec->catdir( File::Spec->splitdir($path), 'data',@_ ); return File::Spec->catpath($vol,$path,''); } 1;