1 2use strict; 3use warnings; 4use Carp; 5 6BEGIN 7{ 8 9 require "../t/charset_tools.pl"; 10 11 eval { require Encode; }; 12 13 if ($@) { 14 print "1..0 # Skip: Encode is not available\n"; 15 exit 0; 16 } 17} 18 19require "dbm_filter_util.pl"; 20 21use Test::More; 22 23BEGIN { use_ok('DBM_Filter') }; 24my $db_file; 25BEGIN { 26 use Config; 27 foreach (qw/SDBM_File ODBM_File NDBM_File GDBM_File DB_File/) { 28 if ($Config{extensions} =~ /\b$_\b/) { 29 $db_file = $_; 30 last; 31 } 32 } 33 use_ok($db_file); 34}; 35BEGIN { use_ok('Fcntl') }; 36BEGIN { use_ok('charnames', qw{greek})}; 37 38use charnames qw{greek}; 39 40unlink <utf8Op_dbmx*>; 41END { unlink <utf8Op_dbmx*>; } 42 43my %h1 = () ; 44my $db1 = tie(%h1, $db_file,'utf8Op_dbmx', O_RDWR|O_CREAT, 0640) ; 45 46ok $db1, "tied to $db_file"; 47 48eval { $db1->Filter_Push('utf8') }; 49is $@, '', "push a 'utf8' filter" ; 50 51{ 52 no warnings 'uninitialized'; 53 StoreData(\%h1, 54 { 55 undef() => undef(), 56 "beta" => "\N{beta}", 57 'alpha' => "\N{alpha}", 58 "\N{gamma}"=> "gamma", 59 }); 60 61} 62 63VerifyData(\%h1, 64 { 65 'alpha' => "\N{alpha}", 66 "beta" => "\N{beta}", 67 "\N{gamma}"=> "gamma", 68 "" => "", 69 }); 70 71undef $db1; 72{ 73 use warnings FATAL => 'untie'; 74 eval { untie %h1 }; 75 is $@, '', "untie without inner references" ; 76} 77 78# read the dbm file without the filter 79my %h2 = () ; 80my $db2 = tie(%h2, $db_file,'utf8Op_dbmx', O_RDWR|O_CREAT, 0640) ; 81 82ok $db2, "tied to $db_file"; 83 84VerifyData(\%h2, 85 { 86 'alpha' => byte_utf8a_to_utf8n("\xCE\xB1"), 87 'beta' => byte_utf8a_to_utf8n("\xCE\xB2"), 88 byte_utf8a_to_utf8n("\xCE\xB3")=> "gamma", 89 "" => "", 90 }); 91 92undef $db2; 93{ 94 use warnings FATAL => 'untie'; 95 eval { untie %h2 }; 96 is $@, '', "untie without inner references" ; 97} 98 99done_testing(); 100