#
# Testcases for using perl hooks in Ini configuration files
# GCARLS 04/29/2005
#
use strict;
use Test;
BEGIN { $| = 1; plan tests => 13 }
use Config::IniFiles;
my $loaded = 1;
#Test 1
ok($loaded);
my $ini;
# Get files from the 't' directory, portably
chdir('t') if ( -d 't' );
# Test 2
# Create ini object with allowcode Option set to 1
$ini = new Config::IniFiles(-file => 'hook.ini',
-allowcode => 1);
ok($ini->{allowcode});
#Test 3
# check standard parameter access
ok($ini->val('hooksection', 'testval') eq 'ok');
#Test 4
#check perl hook - accessing environment variables from a hooks sub
$ENV{'HOOK'}='PERLHOOK';
ok($ini->val('hooksection', 'envhook') eq 'PERLHOOK');
#Test 5
# check if a global sub can be called from a hook
sub gethook {
my($arg)=@_;
return("HOOK($arg)");
}
ok($ini->val('hooksection', 'hooksub') eq 'HOOK(4711)');
#Test 6
#check if single elements of an array are evaluated
my(@hookary);
@hookary=$ini->val('hooksection', 'hookary');
ok($#hookary==3);
#Test 7
ok($hookary[0] eq 'hook1');
#Test 8
ok($hookary[1] eq 'PERLHOOK');
#Test 9
ok($hookary[2] eq 'HOOK(4711)');
#Test 10
ok($hookary[3] eq 'hook4');
#Test 11
# Rewrite File
$ini->WriteConfig('hook_2.ini');
$ENV{'HOOK'}='PERLHOOK_2';
# check if perl hook still exist in the written file
$ini = new Config::IniFiles(-file => 'hook_2.ini',
-allowcode => 1);
ok($ini->val('hooksection', 'envhook') eq 'PERLHOOK_2');
#Test 12
# check if perl hook in here document still exists
@hookary=$ini->val('hooksection', 'hookary');
ok($hookary[1] eq 'PERLHOOK_2');
#Test 13
# check if -allowcode => 0 prohibits perl code in ini files
$ini = new Config::IniFiles(-file => 'hook.ini',
-allowcode => 0);
eval{
$ini->val('hooksection', 'hooksub');
ok(0);
} or ok(1);
unlink 'hook_2.ini';