1#!./perl -w
2
3use strict ; 
4
5BEGIN {
6    unless(grep /blib/, @INC) {
7        chdir 't' if -d 't';
8        @INC = '../lib' if -d '../lib';
9    }
10}
11
12use lib 't';
13use BerkeleyDB; 
14use Test::More;
15use util(1);
16
17plan tests => 7;
18
19my $Dfile = "dbhash.tmp";
20my $Dfile2 = "dbhash2.tmp";
21my $Dfile3 = "dbhash3.tmp";
22unlink $Dfile;
23
24umask(0) ;
25
26my $redirect = "xyzt" ;
27
28
29{
30my $x = $BerkeleyDB::Error;
31my $redirect = "xyzt" ;
32 {
33    my $redirectObj = new Redirect $redirect ;
34
35    use strict ;
36    use BerkeleyDB ;
37    use vars qw( %h $k $v ) ;
38    
39    my $filename = "fruit" ;
40    unlink $filename ;
41    tie %h, "BerkeleyDB::Hash", 
42                -Filename => $filename, 
43		-Flags    => DB_CREATE
44        or die "Cannot open file $filename: $! $BerkeleyDB::Error\n" ;
45
46    # Add a few key/value pairs to the file
47    $h{"apple"} = "red" ;
48    $h{"orange"} = "orange" ;
49    $h{"banana"} = "yellow" ;
50    $h{"tomato"} = "red" ;
51    
52    # Check for existence of a key
53    print "Banana Exists\n\n" if $h{"banana"} ;
54    
55    # Delete a key/value pair.
56    delete $h{"apple"} ;
57    
58    # print the contents of the file
59    while (($k, $v) = each %h)
60      { print "$k -> $v\n" }
61      
62    untie %h ;
63    unlink $filename ;
64 }
65
66  #print "[" . docat($redirect) . "]" ;
67  is(docat_del($redirect), <<'EOM') ;
68Banana Exists
69
70orange -> orange
71tomato -> red
72banana -> yellow
73EOM
74
75
76}
77
78{
79my $redirect = "xyzt" ;
80 {
81
82    my $redirectObj = new Redirect $redirect ;
83
84    use strict ;
85    use BerkeleyDB ;
86    
87    my $filename = "fruit" ;
88    unlink $filename ;
89    my $db = new BerkeleyDB::Hash 
90                -Filename => $filename, 
91		-Flags    => DB_CREATE
92        or die "Cannot open file $filename: $! $BerkeleyDB::Error\n" ;
93
94    # Add a few key/value pairs to the file
95    $db->db_put("apple", "red") ;
96    $db->db_put("orange", "orange") ;
97    $db->db_put("banana", "yellow") ;
98    $db->db_put("tomato", "red") ;
99    
100    # Check for existence of a key
101    print "Banana Exists\n\n" if $db->db_get("banana", $v) == 0;
102    
103    # Delete a key/value pair.
104    $db->db_del("apple") ;
105    
106    # print the contents of the file
107    my ($k, $v) = ("", "") ;
108    my $cursor = $db->db_cursor() ;
109    while ($cursor->c_get($k, $v, DB_NEXT) == 0)
110      { print "$k -> $v\n" }
111      
112    undef $cursor ;
113    undef $db ;
114    unlink $filename ;
115 }
116
117  #print "[" . docat($redirect) . "]" ;
118  is(docat_del($redirect), <<'EOM') ;
119Banana Exists
120
121orange -> orange
122tomato -> red
123banana -> yellow
124EOM
125
126}
127
128{
129my $redirect = "xyzt" ;
130 {
131
132    my $redirectObj = new Redirect $redirect ;
133
134    use strict ;
135    use BerkeleyDB ;
136
137    my $filename = "tree" ;
138    unlink $filename ;
139    my %h ;
140    tie %h, 'BerkeleyDB::Btree', 
141    		-Filename   => $filename, 
142	        -Flags      => DB_CREATE
143      or die "Cannot open $filename: $! $BerkeleyDB::Error\n" ;
144
145    # Add a key/value pair to the file
146    $h{'Wall'} = 'Larry' ;
147    $h{'Smith'} = 'John' ;
148    $h{'mouse'} = 'mickey' ;
149    $h{'duck'}  = 'donald' ;
150
151    # Delete
152    delete $h{"duck"} ;
153
154    # Cycle through the keys printing them in order.
155    # Note it is not necessary to sort the keys as
156    # the btree will have kept them in order automatically.
157    foreach (keys %h)
158      { print "$_\n" }
159
160    untie %h ;
161    unlink $filename ;
162 }
163
164  #print "[" . docat($redirect) . "]\n" ;
165  is(docat_del($redirect), <<'EOM') ;
166Smith
167Wall
168mouse
169EOM
170
171}
172
173{
174my $redirect = "xyzt" ;
175 {
176
177    my $redirectObj = new Redirect $redirect ;
178
179    use strict ;
180    use BerkeleyDB ;
181
182    my $filename = "tree" ;
183    unlink $filename ;
184    my %h ;
185    tie %h, 'BerkeleyDB::Btree', 
186    		-Filename   => $filename, 
187	        -Flags      => DB_CREATE,
188		-Compare    => sub { lc $_[0] cmp lc $_[1] }
189      or die "Cannot open $filename: $!\n" ;
190
191    # Add a key/value pair to the file
192    $h{'Wall'} = 'Larry' ;
193    $h{'Smith'} = 'John' ;
194    $h{'mouse'} = 'mickey' ;
195    $h{'duck'}  = 'donald' ;
196
197    # Delete
198    delete $h{"duck"} ;
199
200    # Cycle through the keys printing them in order.
201    # Note it is not necessary to sort the keys as
202    # the btree will have kept them in order automatically.
203    foreach (keys %h)
204      { print "$_\n" }
205
206    untie %h ;
207    unlink $filename ;
208 }
209
210  #print "[" . docat($redirect) . "]\n" ;
211  is(docat_del($redirect), <<'EOM') ;
212mouse
213Smith
214Wall
215EOM
216
217}
218
219{
220my $redirect = "xyzt" ;
221 {
222
223    my $redirectObj = new Redirect $redirect ;
224
225    use strict ;
226    use BerkeleyDB ;
227
228    my %hash ;
229    my $filename = "filt.db" ;
230    unlink $filename ;
231
232    my $db = tie %hash, 'BerkeleyDB::Hash', 
233    		-Filename   => $filename, 
234	        -Flags      => DB_CREATE
235      or die "Cannot open $filename: $!\n" ;
236
237    # Install DBM Filters
238    $db->filter_fetch_key  ( sub { s/\0$//    } ) ;
239    $db->filter_store_key  ( sub { $_ .= "\0" } ) ;
240    $db->filter_fetch_value( sub { s/\0$//    } ) ;
241    $db->filter_store_value( sub { $_ .= "\0" } ) ;
242
243    $hash{"abc"} = "def" ;
244    my $a = $hash{"ABC"} ;
245    # ...
246    undef $db ;
247    untie %hash ;
248    $db = tie %hash, 'BerkeleyDB::Hash', 
249    		-Filename   => $filename, 
250	        -Flags      => DB_CREATE
251      or die "Cannot open $filename: $!\n" ;
252    while (($k, $v) = each %hash)
253      { print "$k -> $v\n" }
254    undef $db ;
255    untie %hash ;
256
257    unlink $filename ;
258 }
259
260  #print "[" . docat($redirect) . "]\n" ;
261  is(docat_del($redirect), <<"EOM") ;
262abc\x00 -> def\x00
263EOM
264
265}
266
267{
268my $redirect = "xyzt" ;
269 {
270
271    my $redirectObj = new Redirect $redirect ;
272
273    use strict ;
274    use BerkeleyDB ;
275    my %hash ;
276    my $filename = "filt.db" ;
277    unlink $filename ;
278
279
280    my $db = tie %hash, 'BerkeleyDB::Btree', 
281    		-Filename   => $filename, 
282	        -Flags      => DB_CREATE
283      or die "Cannot open $filename: $!\n" ;
284
285    $db->filter_fetch_key  ( sub { $_ = unpack("i", $_) } ) ;
286    $db->filter_store_key  ( sub { $_ = pack ("i", $_) } ) ;
287    $hash{123} = "def" ;
288    # ...
289    undef $db ;
290    untie %hash ;
291    $db = tie %hash, 'BerkeleyDB::Btree', 
292    		-Filename   => $filename, 
293	        -Flags      => DB_CREATE
294      or die "Cannot Open $filename: $!\n" ;
295    while (($k, $v) = each %hash)
296      { print "$k -> $v\n" }
297    undef $db ;
298    untie %hash ;
299
300    unlink $filename ;
301 }
302
303  my $val = pack("i", 123) ;
304  #print "[" . docat($redirect) . "]\n" ;
305  is(docat_del($redirect), <<"EOM") ;
306$val -> def
307EOM
308
309}
310
311{
312my $redirect = "xyzt" ;
313 {
314
315    my $redirectObj = new Redirect $redirect ;
316
317    if ($FA) {
318    use strict ;
319    use BerkeleyDB ;
320
321    my $filename = "text" ;
322    unlink $filename ;
323
324    my @h ;
325    tie @h, 'BerkeleyDB::Recno', 
326    		-Filename   => $filename, 
327	        -Flags      => DB_CREATE,
328		-Property   => DB_RENUMBER
329      or die "Cannot open $filename: $!\n" ;
330
331    # Add a few key/value pairs to the file
332    $h[0] = "orange" ;
333    $h[1] = "blue" ;
334    $h[2] = "yellow" ;
335
336    push @h, "green", "black" ;
337
338    my $elements = scalar @h ;
339    print "The array contains $elements entries\n" ;
340
341    my $last = pop @h ;
342    print "popped $last\n" ;
343
344    unshift @h, "white" ;
345    my $first = shift @h ;
346    print "shifted $first\n" ;
347
348    # Check for existence of a key
349    print "Element 1 Exists with value $h[1]\n" if $h[1] ;
350
351    untie @h ;
352    unlink $filename ;
353    } else {
354    use strict ;
355    use BerkeleyDB ;
356
357    my $filename = "text" ;
358    unlink $filename ;
359
360    my @h ;
361    my $db = tie @h, 'BerkeleyDB::Recno', 
362    		-Filename   => $filename, 
363	        -Flags      => DB_CREATE,
364		-Property   => DB_RENUMBER
365      or die "Cannot open $filename: $!\n" ;
366
367    # Add a few key/value pairs to the file
368    $h[0] = "orange" ;
369    $h[1] = "blue" ;
370    $h[2] = "yellow" ;
371
372    $db->push("green", "black") ;
373
374    my $elements = $db->length() ;
375    print "The array contains $elements entries\n" ;
376
377    my $last = $db->pop ;
378    print "popped $last\n" ;
379
380    $db->unshift("white") ;
381    my $first = $db->shift ;
382    print "shifted $first\n" ;
383
384    # Check for existence of a key
385    print "Element 1 Exists with value $h[1]\n" if $h[1] ;
386
387    undef $db ;
388    untie @h ;
389    unlink $filename ;
390    }
391
392 }
393
394  #print "[" . docat($redirect) . "]\n" ;
395  is(docat_del($redirect), <<"EOM") ;
396The array contains 5 entries
397popped black
398shifted white
399Element 1 Exists with value blue
400EOM
401
402}
403
404