1use strict; 2use warnings FATAL => 'all', NONFATAL => 'redefine'; 3 4use File::Spec; 5use Test::More 'tests' => 30; 6 7BEGIN { use_ok('Config::Merge'); } 8 9my $config; 10ok( $config = Config::Merge->new( get_path('empty') ), 11 'OO - Load empty dir' ); 12 13ok( $config = Config::Merge->new( get_path('perl') ), 14 'OO - Load perl dir' ); 15 16is( $config->C('global.domain'), 17 'www.test.com', 18 'OO - Simple lookup' ); 19 20is( $config->('global.domain'), 21 'www.test.com', 22 'OO - Overload lookup' ); 23 24is_deeply( scalar $config->C('global.db.hosts.session'), 25 [qw(host1 host2 host3)], 26 'OO - Array ref lookup' ); 27 28is_deeply( [ $config->C('global.db.hosts.session') ], 29 [qw(host1 host2 host3)], 30 'OO - Array lookup' ); 31 32is( $config->C('global.db.hosts.image.1'), 33 'host5', 34 'OO - Array element lookup' ); 35 36ok( $config = Config::Merge->new( get_path('perlmulti') ), 37 'OO - Load perl dir' ); 38 39my @list; 40ok( @list = $config->C('global.testsub'), 41 'OO - Retrieve code'); 42is( scalar @list, 43 1, 44 'OO - CODE ref list context'); 45 46is( ref $list[0], 47 'CODE', 48 'OO - CODE ref'); 49 50is( ref scalar $config->C('global.testsub'), 51 'CODE', 52 'OO - CODE ref scalar context'); 53 54ok( @list = $config->C('global.testregex'), 55 'OO - Retrieve regepx'); 56is( scalar @list, 57 1, 58 'OO - Regexp ref list context'); 59 60is( ref $list[0], 61 'Regexp', 62 'OO - Regexp ref'); 63 64is( ref scalar $config->C('global.testregex'), 65 'Regexp', 66 'OO - Regexp ref scalar context'); 67 68ok( @list = $config->C('global.testobj'), 69 'OO - Retrieve object'); 70is( scalar @list, 71 1, 72 'OO - Object list context'); 73 74is( ref $list[0], 75 'ABC', 76 'OO - Object ref'); 77 78is( ref scalar $config->C('global.testobj'), 79 'ABC', 80 'OO - Object scalar context'); 81 82is( $config->C('global.db.hosts.image.1'), 83 'host5', 84 'OO - Directory lookup' ); 85 86is( $config->C('global.db.hosts.image.1'), 87 'host5', 88 'OO - Directory lookup' ); 89 90is( defined eval{$config->C('global.db3.hosts.image.1')} ? 1 : 0, 91 0, 92 'OO - Directory lookup - fail overwritten' ); 93 94is( $config->C('global.db3.different'), 95 'data', 96 'OO - Directory lookup - succeed overwritten' ); 97 98is( $config->C('global.engine'), 99 'Oracle', 100 'OO - Local override' ); 101 102is( $config->C('global.db2.hosts.session.0'), 103 'local1', 104 'OO - Local override deep' ); 105 106$config->clear_cache(); 107my $data = $config->C('global.db.hosts'); 108$data->{session} = '123'; 109is( $config->C('global.db.hosts.session'), 110 '123', 111 'OO - Overwrite original' ); 112 113$data = $config->clone('global.db.hosts'); 114$data->{image} = '123'; 115isnt( $config->C('global.db.hosts.image'), 116 '123', 117 'OO - Overwrite clone' ); 118 119$config->load_config(); 120isnt( $config->C('global.db.hosts.session'), 121 '123', 122 'OO - Reload data' ); 123 124 125#=================================== 126sub get_path { 127#=================================== 128 my ($vol,$path) = File::Spec->splitpath( 129 File::Spec->rel2abs($0) 130 ); 131 $path = File::Spec->catdir( 132 File::Spec->splitdir($path), 133 'data',@_ 134 ); 135 return File::Spec->catpath($vol,$path,''); 136} 137