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