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