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