1#!./perl -w
2
3
4use strict ;
5
6
7use lib 't' ;
8use BerkeleyDB; 
9use util ;
10use Test::More;
11
12BEGIN {
13    plan(skip_all => "this needs BerkeleyDB 3.3.x or better" )
14        if $BerkeleyDB::db_version < 3.3;
15
16    plan tests => 130;    
17}
18
19umask(0);
20
21{
22    # db->truncate
23
24    my $Dfile;
25    my $lex = new LexFile $Dfile ;
26    my %hash ;
27    my ($k, $v) ;
28    ok my $db = new BerkeleyDB::Hash -Filename => $Dfile, 
29				     -Flags    => DB_CREATE ;
30
31    # create some data
32    my %data =  (
33		"red"	=> 2,
34		"green"	=> "house",
35		"blue"	=> "sea",
36		) ;
37
38    my $ret = 0 ;
39    while (($k, $v) = each %data) {
40        $ret += $db->db_put($k, $v) ;
41    }
42    ok $ret == 0 ;
43
44    # check there are three records
45    is countRecords($db), 3 ;
46
47    # now truncate the database
48    my $count = 0;
49    ok $db->truncate($count) == 0 ;
50
51    is $count, 3 ;
52    ok countRecords($db) == 0 ;
53
54}
55
56{
57    # db->associate -- secondary keys
58
59    sub sec_key
60    {
61        #print "in sec_key\n";
62        my $pkey = shift ;
63        my $pdata = shift ;
64
65       $_[0] = $pdata ;
66        return 0;
67    }
68
69    my ($Dfile1, $Dfile2);
70    my $lex = new LexFile $Dfile1, $Dfile2 ;
71    my %hash ;
72    my $status;
73    my ($k, $v, $pk) = ('','','');
74
75    # create primary database
76    ok my $primary = new BerkeleyDB::Hash -Filename => $Dfile1, 
77				     -Flags    => DB_CREATE ;
78
79    # create secondary database
80    ok my $secondary = new BerkeleyDB::Hash -Filename => $Dfile2, 
81				     -Flags    => DB_CREATE ;
82
83    # associate primary with secondary
84    ok $primary->associate($secondary, \&sec_key) == 0;
85
86    # add data to the primary
87    my %data =  (
88		"red"	=> "flag",
89		"green"	=> "house",
90		"blue"	=> "sea",
91		) ;
92
93    my $ret = 0 ;
94    while (($k, $v) = each %data) {
95        my $r = $primary->db_put($k, $v) ;
96	#print "put $r $BerkeleyDB::Error\n";
97        $ret += $r;
98    }
99    ok $ret == 0 ;
100
101    # check the records in the secondary
102    is countRecords($secondary), 3 ;
103
104    ok $secondary->db_get("house", $v) == 0;
105    is $v, "house";
106
107    ok $secondary->db_get("sea", $v) == 0;
108    is $v, "sea";
109
110    ok $secondary->db_get("flag", $v) == 0;
111    is $v, "flag";
112
113    # pget to primary database is illegal
114    ok $primary->db_pget('red', $pk, $v) != 0 ;
115
116    # pget to secondary database is ok
117    ok $secondary->db_pget('house', $pk, $v) == 0 ;
118    is $pk, 'green';
119    is $v, 'house';
120
121    ok my $p_cursor = $primary->db_cursor();
122    ok my $s_cursor = $secondary->db_cursor();
123
124    # c_get from primary 
125    $k = 'green';
126    ok $p_cursor->c_get($k, $v, DB_SET) == 0;
127    is $k, 'green';
128    is $v, 'house';
129
130    # c_get from secondary
131    $k = 'sea';
132    ok $s_cursor->c_get($k, $v, DB_SET) == 0;
133    is $k, 'sea';
134    is $v, 'sea';
135
136    # c_pget from primary database should fail
137    $k = 1;
138    ok $p_cursor->c_pget($k, $pk, $v, DB_FIRST) != 0;
139
140    # c_pget from secondary database 
141    $k = 'flag';
142    ok $s_cursor->c_pget($k, $pk, $v, DB_SET) == 0;
143    is $k, 'flag';
144    is $pk, 'red';
145    is $v, 'flag';
146
147    # check put to secondary is illegal
148    ok $secondary->db_put("tom", "dick") != 0;
149    is countRecords($secondary), 3 ;
150
151    # delete from primary
152    ok $primary->db_del("green") == 0 ;
153    is countRecords($primary), 2 ;
154
155    # check has been deleted in secondary
156    ok $secondary->db_get("house", $v) != 0;
157    is countRecords($secondary), 2 ;
158
159    # delete from secondary
160    ok $secondary->db_del('flag') == 0 ;
161    is countRecords($secondary), 1 ;
162
163
164    # check deleted from primary
165    ok $primary->db_get("red", $v) != 0;
166    is countRecords($primary), 1 ;
167
168}
169
170
171    # db->associate -- multiple secondary keys
172
173
174    # db->associate -- same again but when DB_DUP is specified.
175
176
177{
178    # db->associate -- secondary keys, each with a user defined sort
179
180    sub sec_key2
181    {
182        my $pkey = shift ;
183        my $pdata = shift ;
184        #print "in sec_key2 [$pkey][$pdata]\n";
185
186        $_[0] = length $pdata ;
187        return 0;
188    }
189
190    my ($Dfile1, $Dfile2);
191    my $lex = new LexFile $Dfile1, $Dfile2 ;
192    my %hash ;
193    my $status;
194    my ($k, $v, $pk) = ('','','');
195
196    # create primary database
197    ok my $primary = new BerkeleyDB::Btree -Filename => $Dfile1, 
198				     -Compare  => sub { return $_[0] cmp $_[1]},
199				     -Flags    => DB_CREATE ;
200
201    # create secondary database
202    ok my $secondary = new BerkeleyDB::Btree -Filename => $Dfile2, 
203				     -Compare  => sub { return $_[0] <=> $_[1]},
204				     -Property => DB_DUP,
205				     -Flags    => DB_CREATE ;
206
207    # associate primary with secondary
208    ok $primary->associate($secondary, \&sec_key2) == 0;
209
210    # add data to the primary
211    my %data =  (
212		"red"	=> "flag",
213		"orange"=> "custard",
214		"green"	=> "house",
215		"blue"	=> "sea",
216		) ;
217
218    my $ret = 0 ;
219    while (($k, $v) = each %data) {
220        my $r = $primary->db_put($k, $v) ;
221	#print "put [$r] $BerkeleyDB::Error\n";
222        $ret += $r;
223    }
224    ok $ret == 0 ;
225    #print "ret $ret\n";
226
227    #print "Primary\n" ; dumpdb($primary) ;
228    #print "Secondary\n" ; dumpdb($secondary) ;
229
230    # check the records in the secondary
231    is countRecords($secondary), 4 ;
232
233    my $p_data = joinkeys($primary, " ");
234    #print "primary [$p_data]\n" ;
235    is $p_data, join " ", sort { $a cmp $b } keys %data ;
236    my $s_data = joinkeys($secondary, " ");
237    #print "secondary [$s_data]\n" ;
238    is $s_data, join " ", sort { $a <=> $b } map { length } values %data ;
239
240}
241
242{
243    # db->associate -- primary recno, secondary hash
244
245    sub sec_key3
246    {
247        #print "in sec_key\n";
248        my $pkey = shift ;
249        my $pdata = shift ;
250
251       $_[0] = $pdata ;
252        return 0;
253    }
254
255    my ($Dfile1, $Dfile2);
256    my $lex = new LexFile $Dfile1, $Dfile2 ;
257    my %hash ;
258    my $status;
259    my ($k, $v, $pk) = ('','','');
260
261    # create primary database
262    ok my $primary = new BerkeleyDB::Recno -Filename => $Dfile1, 
263				     -Flags    => DB_CREATE ;
264
265    # create secondary database
266    ok my $secondary = new BerkeleyDB::Hash -Filename => $Dfile2, 
267				     -Flags    => DB_CREATE ;
268
269    # associate primary with secondary
270    ok $primary->associate($secondary, \&sec_key3) == 0;
271
272    # add data to the primary
273    my %data =  (
274		0 => "flag",
275		1 => "house",
276		2 => "sea",
277		) ;
278
279    my $ret = 0 ;
280    while (($k, $v) = each %data) {
281        my $r = $primary->db_put($k, $v) ;
282	#print "put $r $BerkeleyDB::Error\n";
283        $ret += $r;
284    }
285    ok $ret == 0 ;
286
287    # check the records in the secondary
288    is countRecords($secondary), 3 ;
289
290    ok $secondary->db_get("flag", $v) == 0;
291    is $v, "flag";
292
293    ok $secondary->db_get("house", $v) == 0;
294    is $v, "house";
295
296    ok $secondary->db_get("sea", $v) == 0;
297    is $v, "sea" ;
298
299    # pget to primary database is illegal
300    ok $primary->db_pget(0, $pk, $v) != 0 ;
301
302    # pget to secondary database is ok
303    ok $secondary->db_pget('house', $pk, $v) == 0 ;
304    is $pk, 1 ;
305    is $v, 'house';
306
307    ok my $p_cursor = $primary->db_cursor();
308    ok my $s_cursor = $secondary->db_cursor();
309
310    # c_get from primary 
311    $k = 1;
312    ok $p_cursor->c_get($k, $v, DB_SET) == 0;
313    is $k, 1;
314    is $v, 'house';
315
316    # c_get from secondary
317    $k = 'sea';
318    ok $s_cursor->c_get($k, $v, DB_SET) == 0;
319    is $k, 'sea' 
320        or warn "# key [$k]\n";
321    is $v, 'sea';
322
323    # c_pget from primary database should fail
324    $k = 1;
325    ok $p_cursor->c_pget($k, $pk, $v, DB_FIRST) != 0;
326
327    # c_pget from secondary database 
328    $k = 'sea';
329    ok $s_cursor->c_pget($k, $pk, $v, DB_SET) == 0;
330    is $k, 'sea' ;
331    is $pk, 2 ;
332    is $v, 'sea';
333
334    # check put to secondary is illegal
335    ok $secondary->db_put("tom", "dick") != 0;
336    is countRecords($secondary), 3 ;
337
338    # delete from primary
339    ok $primary->db_del(2) == 0 ;
340    is countRecords($primary), 2 ;
341
342    # check has been deleted in secondary
343    ok $secondary->db_get("sea", $v) != 0;
344    is countRecords($secondary), 2 ;
345
346    # delete from secondary
347    ok $secondary->db_del('flag') == 0 ;
348    is countRecords($secondary), 1 ;
349
350
351    # check deleted from primary
352    ok $primary->db_get(0, $v) != 0;
353    is countRecords($primary), 1 ;
354
355}
356
357{
358    # db->associate -- primary hash, secondary recno
359
360    sub sec_key4
361    {
362        #print "in sec_key4\n";
363        my $pkey = shift ;
364        my $pdata = shift ;
365
366       $_[0] = length $pdata ;
367        return 0;
368    }
369
370    my ($Dfile1, $Dfile2);
371    my $lex = new LexFile $Dfile1, $Dfile2 ;
372    my %hash ;
373    my $status;
374    my ($k, $v, $pk) = ('','','');
375
376    # create primary database
377    ok my $primary = new BerkeleyDB::Hash -Filename => $Dfile1, 
378				     -Flags    => DB_CREATE ;
379
380    # create secondary database
381    ok my $secondary = new BerkeleyDB::Recno -Filename => $Dfile2, 
382                     #-Property => DB_DUP,
383				     -Flags    => DB_CREATE ;
384
385    # associate primary with secondary
386    ok $primary->associate($secondary, \&sec_key4) == 0;
387
388    # add data to the primary
389    my %data =  (
390		"red"	=> "flag",
391		"green"	=> "house",
392		"blue"	=> "sea",
393		) ;
394
395    my $ret = 0 ;
396    while (($k, $v) = each %data) {
397        my $r = $primary->db_put($k, $v) ;
398	#print "put $r $BerkeleyDB::Error\n";
399        $ret += $r;
400    }
401    ok $ret == 0 ;
402
403    # check the records in the secondary
404    is countRecords($secondary), 3 ;
405
406    ok $secondary->db_get(0, $v) != 0;
407    ok $secondary->db_get(1, $v) != 0;
408    ok $secondary->db_get(2, $v) != 0;
409    ok $secondary->db_get(3, $v) == 0;
410    ok $v eq "sea";
411
412    ok $secondary->db_get(4, $v) == 0;
413    is $v, "flag";
414
415    ok $secondary->db_get(5, $v) == 0;
416    is $v, "house";
417
418    # pget to primary database is illegal
419    ok $primary->db_pget(0, $pk, $v) != 0 ;
420
421    # pget to secondary database is ok
422    ok $secondary->db_pget(4, $pk, $v) == 0 ;
423    is $pk, 'red'
424        or warn "# $pk\n";;
425    is $v, 'flag';
426
427    ok my $p_cursor = $primary->db_cursor();
428    ok my $s_cursor = $secondary->db_cursor();
429
430    # c_get from primary 
431    $k = 'green';
432    ok $p_cursor->c_get($k, $v, DB_SET) == 0;
433    is $k, 'green';
434    is $v, 'house';
435
436    # c_get from secondary
437    $k = 3;
438    ok $s_cursor->c_get($k, $v, DB_SET) == 0;
439    is $k, 3 ;
440    is $v, 'sea';
441
442    # c_pget from primary database should fail
443    $k = 1;
444    ok $p_cursor->c_pget($k, $pk, $v, DB_SET) != 0;
445
446    # c_pget from secondary database 
447    $k = 5;
448    ok $s_cursor->c_pget($k, $pk, $v, DB_SET) == 0;
449    is $k, 5 ;
450    is $pk, 'green';
451    is $v, 'house';
452
453    # check put to secondary is illegal
454    ok $secondary->db_put(77, "dick") != 0;
455    is countRecords($secondary), 3 ;
456
457    # delete from primary
458    ok $primary->db_del("green") == 0 ;
459    is countRecords($primary), 2 ;
460
461    # check has been deleted in secondary
462    ok $secondary->db_get(5, $v) != 0;
463    is countRecords($secondary), 2 ;
464
465    # delete from secondary
466    ok $secondary->db_del(4) == 0 ;
467    is countRecords($secondary), 1 ;
468
469
470    # check deleted from primary
471    ok $primary->db_get("red", $v) != 0;
472    is countRecords($primary), 1 ;
473
474}
475