1 2use strict; 3use warnings; 4use Carp; 5 6require "../t/charset_tools.pl"; 7 8BEGIN 9{ 10 11 eval { require Encode; }; 12 13 if ($@) { 14 print "1..0 # Skip: Encode is not available\n"; 15 exit 0; 16 } 17} 18 19 20require "dbm_filter_util.pl"; 21 22use Test::More; 23 24BEGIN { use_ok('DBM_Filter') }; 25my $db_file; 26BEGIN { 27 use Config; 28 foreach (qw/SDBM_File ODBM_File NDBM_File GDBM_File DB_File/) { 29 if ($Config{extensions} =~ /\b$_\b/) { 30 $db_file = $_; 31 last; 32 } 33 } 34 use_ok($db_file); 35}; 36BEGIN { use_ok('Fcntl') }; 37BEGIN { use_ok('charnames', qw{greek})}; 38 39use charnames qw{greek}; 40 41unlink <encOp_dbmx*>; 42END { unlink <encOp_dbmx*>; } 43 44my %h1 = () ; 45my $db1 = tie(%h1, $db_file,'encOp_dbmx', O_RDWR|O_CREAT, 0640) ; 46 47ok $db1, "tied to $db_file"; 48 49eval { $db1->Filter_Push('encode' => 'blah') }; 50like $@, qr/^Encoding 'blah' is not available/, "push an illegal filter" ; 51 52eval { $db1->Filter_Push('encode') }; 53is $@, '', "push an 'encode' filter (default to utf-8)" ; 54 55 56{ 57 no warnings 'uninitialized'; 58 StoreData(\%h1, 59 { 60 undef() => undef(), 61 'alpha' => "\N{alpha}", 62 "\N{gamma}"=> "gamma", 63 "beta" => "\N{beta}", 64 }); 65 66} 67 68{ 69 local $TODO = "Currently broken on EBCDIC" if $::IS_EBCDIC; 70 VerifyData(\%h1, 71 { 72 'alpha' => "\N{alpha}", 73 "beta" => "\N{beta}", 74 "\N{gamma}"=> "gamma", 75 "" => "", 76 }); 77} 78 79eval { $db1->Filter_Pop() }; 80is $@, '', "pop the 'utf8' filter" ; 81 82SKIP: { 83 skip "Encode doesn't currently work for most filters on EBCDIC, including 8859-16", 11 if $::IS_EBCDIC || $::IS_EBCDIC; 84 # Actually the only thing failing below is the euro, because that's the 85 # only thing that's added in 8859-16. 86eval { $db1->Filter_Push('encode' => 'iso-8859-16') }; 87is $@, '', "push an 'encode' filter (specify iso-8859-16)" ; 88 89use charnames qw{:full}; 90StoreData(\%h1, 91 { 92 'euro' => "\N{EURO SIGN}", 93 }); 94 95undef $db1; 96{ 97 use warnings FATAL => 'untie'; 98 eval { untie %h1 }; 99 is $@, '', "untie without inner references" ; 100} 101 102# read the dbm file without the filter 103my %h2 = () ; 104my $db2 = tie(%h2, $db_file,'encOp_dbmx', O_RDWR|O_CREAT, 0640) ; 105 106ok $db2, "tied to $db_file"; 107 108VerifyData(\%h2, 109 { 110 'alpha' => byte_utf8a_to_utf8n("\xCE\xB1"), 111 'beta' => byte_utf8a_to_utf8n("\xCE\xB2"), 112 byte_utf8a_to_utf8n("\xCE\xB3") => "gamma", 113 'euro' => uni_to_native("\xA4"), 114 "" => "", 115 }); 116 117undef $db2; 118{ 119 use warnings FATAL => 'untie'; 120 eval { untie %h2 }; 121 is $@, '', "untie without inner references" ; 122} 123 124} 125 126done_testing(); 127