1
2use strict;
3use warnings;
4use Carp;
5
6BEGIN
7{
8    eval { require Compress::Zlib ; };
9    if ($@) {
10        print "1..0 # Skip: Compress::Zlib is not available\n";
11print "# $@\n";
12        exit 0;
13    }
14}
15require "dbm_filter_util.pl";
16
17use Test::More;
18
19BEGIN { use_ok('DBM_Filter') };
20my $db_file;
21BEGIN {
22    use Config;
23    foreach (qw/SDBM_File ODBM_File NDBM_File GDBM_File DB_File/) {
24        if ($Config{extensions} =~ /\b$_\b/) {
25            $db_file = $_;
26            last;
27        }
28    }
29    use_ok($db_file);
30};
31BEGIN { use_ok('Fcntl') };
32BEGIN { use_ok('Compress::Zlib') };
33
34unlink <cmpOp_dbmx*>;
35END { unlink <cmpOp_dbmx*>; }
36
37my %h1 = () ;
38my $db1 = tie(%h1, $db_file,'cmpOp_dbmx', O_RDWR|O_CREAT, 0640) ;
39
40ok $db1, "tied to $db_file";
41
42# store before adding the filter
43
44StoreData(\%h1,
45	{
46		1234	=> 5678,
47		-3	=> -5,
48		"22"	=> "88",
49		"-45"	=> "-88",
50		"fred"	=> "Joe",
51		"alpha"	=> "Alpha",
52		"Beta"	=> "beta",
53	});
54
55VerifyData(\%h1,
56	{
57		1234	=> 5678,
58		-3	=> -5,
59		"22"	=> "88",
60		"-45"	=> "-88",
61		"fred"	=> "Joe",
62		"alpha"	=> "Alpha",
63		"Beta"	=> "beta",
64	});
65
66
67eval { $db1->Filter_Push('compress') };
68is $@, '', "push a 'compress' filter" ;
69
70{
71    no warnings 'uninitialized';
72    StoreData(\%h1,
73	{
74		undef()	=> undef(),
75		"400"	=> "500",
76		0	=> 1,
77		1	=> 0,
78		"abc"	=> "de0",
79		"\x00\x01"	=> "\x03\xFF",
80	});
81
82}
83
84undef $db1;
85{
86    use warnings FATAL => 'untie';
87    eval { untie %h1 };
88    is $@, '', "untie without inner references" ;
89}
90
91# read the dbm file without the filter
92my %h2 = () ;
93my $db2 = tie(%h2, $db_file,'cmpOp_dbmx', O_RDWR|O_CREAT, 0640) ;
94
95ok $db2, "tied to $db_file";
96
97VerifyData(\%h2,
98	{
99		1234	=> 5678,
100		-3	=> -5,
101		"22"	=> "88",
102		"-45"	=> "-88",
103		"fred"	=> "Joe",
104		"alpha"	=> "Alpha",
105		"Beta"	=> "beta",
106
107		compress("")	=> compress(""),
108		compress("400")	=> compress("500"),
109		compress("0")	=> compress("1"),
110		compress("1")	=> compress("0"),
111		compress("abc")	=> compress("de0"),
112		compress("\x00\x01")	=> compress("\x03\xFF"),
113	});
114
115undef $db2;
116{
117    use warnings FATAL => 'untie';
118    eval { untie %h2 };
119    is $@, '', "untie without inner references" ;
120}
121
122done_testing();
123