1#!/usr/bin/perl 2use strict; 3use warnings; 4 5use Test::More 'no_plan'; 6 7use File::Spec::Functions qw(catfile); 8 9# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 10my $class = 'ConfigReader::Simple'; 11my $method = 'get'; 12 13use_ok( $class ); 14can_ok( $class, $method ); 15 16# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 17my @Directives = qw( Test1 Test2 Test3 Test4 ); 18my $config = $class->new( "t/example.config", \@Directives ); 19isa_ok( $config, $class ); 20 21# get things that do exist 22is( $config->get( 'Test3' ), 'foo', 'Test3 has right value' ); 23is( $config->Test3, 'foo' ); 24 25is( $config->get( 'Test2' ), 'Test 2 value', 'Test2 has right value' ); 26is( $config->Test2, 'Test 2 value' ); 27 28# get things that do exist, but look like false values to perl 29is( $config->get( 'Zero' ), '0', 'Zero has right value as string' ); 30is( $config->get( 'Zero' ), 0,, 'Zero has right value as number' ); 31is( $config->get( 'Undef' ), '', 'Undef has right value (empty)' ); 32 33# get long lines 34is( $config->get( 'Test10' ), 'foo bar baz', 'Continuation line has right value'); 35is( $config->Test10, 'foo bar baz') ; 36 37# get things that do not exist 38# using get 39my $value = not defined $config->get( 'Test' ); 40ok( $value, 'Test has no value with get()' ); 41$value = not defined $config->Test; 42ok( $value, 'Test has no value with AUTOLOAD' ); 43 44$value = not defined $config->get( 'Test5' ); 45ok( $value, 'Test5 has no value with get()' ); 46$value = not defined $config->Test5; 47ok( $value, 'Test5 has no value with AUTOLOAD' ); 48 49# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 50# # # # # Now try it with multiple files 51$config = $class->new_multiple( 52 Files => [ qw( t/global.config t/example.config ) ] ); 53isa_ok( $config, $class ); 54 55# get things that do exist 56is( $config->get( 'Test3' ), 'foo', 57 'Test3 has right value with AUTOLOAD' ); 58is( $config->get( 'Scope' ), 'Global', 59 'Scope has right value with AUTOLOAD' ); 60is( $config->get( 'Test2' ), 'Test 2 value', 61 'Test2 has right value with AUTOLOAD' ); 62is( $config->get( 'Test10'), 'foo bar baz', 63 'Test10 has right value with AUTOLOAD' ); 64 65# try it one at a time 66{ 67my $config = $class->new( "t/example.config" ); 68 69is( $config->get( 'Test3' ), 'foo', 70 'Test3 has right value with get(), before global' ); 71is( $config->get( 'Test2' ), 'Test 2 value', 72 'Test2 has right value with get(), before global' ); 73is( $config->get( 'Test10' ), 'foo bar baz', 74 'Test10 has right value with get), before global' ); 75 76my $global = catfile( qw( t global.config ) ); 77ok( -e $global, "$global exists" ); 78ok( $config->add_config_file( $global), "Added $global" ); 79is( $config->get( 'Scope' ), 'Global', 80 "Scope has right value after adding $global" ); 81} 82 83# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 84# # # # # Now try it with multiple files with one missing 85$config = $class->new_multiple( 86 Files => [ qw( t/missing.config t/global.config ) ] ); 87isa_ok( $config, $class ); 88 89# get things that do exist 90is( $config->get( 'Scope' ), 'Global', 91 'Scope has right value with AUTOLOAD, missing file' ); 92 93# config should be undef 94$config = eval { 95 no strict 'refs'; 96 ${ "${class}::Die" } = 1; 97 $class->new_multiple( 98 Files => [ qw( t/missing.config t/example.config ) ] ); 99 }; 100like( $@, qr|\QCould not open configuration file [t/missing.config]| ); 101 102# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 103# # # # # Now try it with a string 104{ 105my $string = <<'STRING'; 106TestA Lear 107TestB MacBeth 108TestC Richard 109STRING 110 111$config = $class->new_string( 112 Strings => [ \$string ] ); 113isa_ok( $config, $class ); 114 115is( $config->get( 'TestA' ), 'Lear', 116 'TestA has right value (from string)' ); 117is( $config->get( 'TestB' ), 'MacBeth', 118 'TestB has right value (from string)' ); 119is( $config->get( 'TestC' ), 'Richard', 120 'TestC has right value (from string)' ); 121} 122 123# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 124# # # # # Now try it with a string with a continuation line 125{ 126my $string = <<'STRING'; 127TestA King \ 128Lear 129TestB MacBeth 130TestC Richard 131STRING 132 133$config = $class->new_string( 134 Strings => [ \$string ] ); 135isa_ok( $config, $class ); 136 137is( $config->get( 'TestA' ), 'King Lear', 138 'TestA has right value (from string)' ); 139is( $config->get( 'TestB' ), 'MacBeth', 140 'TestB has right value (from string)' ); 141is( $config->get( 'TestC' ), 'Richard', 142 'TestC has right value (from string)' ); 143} 144