1#!./perl -w
2
3# ID: %I%, %G%   
4
5use strict ;
6
7use lib 't';
8use BerkeleyDB; 
9use util ;
10
11if ($BerkeleyDB::db_ver < 2.005002)
12{
13    print "1..0 # Skip: join needs Berkeley DB 2.5.2 or later\n" ;
14    exit 0 ;
15}
16
17
18print "1..42\n";
19
20my $Dfile1 = "dbhash1.tmp";
21my $Dfile2 = "dbhash2.tmp";
22my $Dfile3 = "dbhash3.tmp";
23unlink $Dfile1, $Dfile2, $Dfile3 ;
24
25umask(0) ;
26
27{
28    # error cases
29    my $lex = new LexFile $Dfile1, $Dfile2, $Dfile3 ;
30    my %hash1 ;
31    my $value ;
32    my $status ;
33    my $cursor ;
34
35    ok 1, my $db1 = tie %hash1, 'BerkeleyDB::Hash', 
36				-Filename => $Dfile1,
37                               	-Flags     => DB_CREATE,
38                                -DupCompare   => sub { $_[0] lt $_[1] },
39                                -Property  => DB_DUP|DB_DUPSORT ;
40
41    # no cursors supplied
42    eval '$cursor = $db1->db_join() ;' ;
43    ok 2, $@ =~ /Usage: \$db->BerkeleyDB::db_join\Q([cursors], flags=0)/;
44
45    # empty list
46    eval '$cursor = $db1->db_join([]) ;' ;
47    ok 3, $@ =~ /db_join: No cursors in parameter list/;
48
49    # cursor list, isn not a []
50    eval '$cursor = $db1->db_join({}) ;' ;
51    ok 4, $@ =~ /db_join: first parameter is not an array reference/;
52
53    eval '$cursor = $db1->db_join(\1) ;' ;
54    ok 5, $@ =~ /db_join: first parameter is not an array reference/;
55
56    my ($a, $b) = ("a", "b");
57    $a = bless [], "fred";
58    $b = bless [], "fred";
59    eval '$cursor = $db1->db_join($a, $b) ;' ;
60    ok 6, $@ =~ /db_join: first parameter is not an array reference/;
61
62}
63
64{
65    # test a 2-way & 3-way join
66
67    my $lex = new LexFile $Dfile1, $Dfile2, $Dfile3 ;
68    my %hash1 ;
69    my %hash2 ;
70    my %hash3 ;
71    my $value ;
72    my $status ;
73
74    my $home = "./fred7" ;
75    rmtree $home;
76    ok 7, ! -d $home;
77    ok 8, my $lexD = new LexDir($home);
78    ok 9, my $env = new BerkeleyDB::Env -Home => $home, @StdErrFile,
79				     -Flags => DB_CREATE|DB_INIT_TXN
80					  	|DB_INIT_MPOOL;
81					  	#|DB_INIT_MPOOL| DB_INIT_LOCK;
82    ok 10, my $txn = $env->txn_begin() ;
83    ok 11, my $db1 = tie %hash1, 'BerkeleyDB::Hash', 
84				-Filename => $Dfile1,
85                               	-Flags     => DB_CREATE,
86                                -DupCompare   => sub { $_[0] cmp $_[1] },
87                                -Property  => DB_DUP|DB_DUPSORT,
88			       	-Env 	   => $env,
89			    	-Txn	   => $txn  ;
90				;
91
92    ok 12, my $db2 = tie %hash2, 'BerkeleyDB::Hash', 
93				-Filename => $Dfile2,
94                               	-Flags     => DB_CREATE,
95                                -DupCompare   => sub { $_[0] cmp $_[1] },
96                                -Property  => DB_DUP|DB_DUPSORT,
97			       	-Env 	   => $env,
98			    	-Txn	   => $txn  ;
99
100    ok 13, my $db3 = tie %hash3, 'BerkeleyDB::Btree', 
101				-Filename => $Dfile3,
102                               	-Flags     => DB_CREATE,
103                                -DupCompare   => sub { $_[0] cmp $_[1] },
104                                -Property  => DB_DUP|DB_DUPSORT,
105			       	-Env 	   => $env,
106			    	-Txn	   => $txn  ;
107
108    
109    ok 14, addData($db1, qw( 	apple		Convenience
110    				peach		Shopway
111				pear		Farmer
112				raspberry	Shopway
113				strawberry	Shopway
114				gooseberry	Farmer
115				blueberry	Farmer
116    			));
117
118    ok 15, addData($db2, qw( 	red	apple
119    				red	raspberry
120    				red	strawberry
121				yellow	peach
122				yellow	pear
123				green	gooseberry
124				blue	blueberry)) ;
125
126    ok 16, addData($db3, qw( 	expensive	apple
127    				reasonable	raspberry
128    				expensive	strawberry
129				reasonable	peach
130				reasonable	pear
131				expensive	gooseberry
132				reasonable	blueberry)) ;
133
134    ok 17, my $cursor2 = $db2->db_cursor() ;
135    my $k = "red" ;
136    my $v = "" ;
137    ok 18, $cursor2->c_get($k, $v, DB_SET) == 0 ;
138
139    # Two way Join
140    ok 19, my $cursor1 = $db1->db_join([$cursor2]) ;
141
142    my %expected = qw( apple Convenience
143			raspberry Shopway
144			strawberry Shopway
145		) ;
146
147    # sequence forwards
148    while ($cursor1->c_get($k, $v) == 0) {
149	delete $expected{$k} 
150	    if defined $expected{$k} && $expected{$k} eq $v ;
151	#print "[$k] [$v]\n" ;
152    }
153    ok 20, keys %expected == 0 ;
154    ok 21, $cursor1->status() == DB_NOTFOUND ;
155
156    # Three way Join
157    ok 22, $cursor2 = $db2->db_cursor() ;
158    $k = "red" ;
159    $v = "" ;
160    ok 23, $cursor2->c_get($k, $v, DB_SET) == 0 ;
161
162    ok 24, my $cursor3 = $db3->db_cursor() ;
163    $k = "expensive" ;
164    $v = "" ;
165    ok 25, $cursor3->c_get($k, $v, DB_SET) == 0 ;
166    ok 26, $cursor1 = $db1->db_join([$cursor2, $cursor3]) ;
167
168    %expected = qw( apple Convenience
169			strawberry Shopway
170		) ;
171
172    # sequence forwards
173    while ($cursor1->c_get($k, $v) == 0) {
174	delete $expected{$k} 
175	    if defined $expected{$k} && $expected{$k} eq $v ;
176	#print "[$k] [$v]\n" ;
177    }
178    ok 27, keys %expected == 0 ;
179    ok 28, $cursor1->status() == DB_NOTFOUND ;
180
181    # test DB_JOIN_ITEM
182    # #################
183    ok 29, $cursor2 = $db2->db_cursor() ;
184    $k = "red" ;
185    $v = "" ;
186    ok 30, $cursor2->c_get($k, $v, DB_SET) == 0 ;
187 
188    ok 31, $cursor3 = $db3->db_cursor() ;
189    $k = "expensive" ;
190    $v = "" ;
191    ok 32, $cursor3->c_get($k, $v, DB_SET) == 0 ;
192    ok 33, $cursor1 = $db1->db_join([$cursor2, $cursor3]) ;
193 
194    %expected = qw( apple 1
195                        strawberry 1
196                ) ;
197 
198    # sequence forwards
199    $k = "" ;
200    $v = "" ;
201    while ($cursor1->c_get($k, $v, DB_JOIN_ITEM) == 0) {
202        delete $expected{$k}
203            if defined $expected{$k} ;
204        #print "[$k]\n" ;
205    }
206    ok 34, keys %expected == 0 ;
207    ok 35, $cursor1->status() == DB_NOTFOUND ;
208
209    ok 36, $cursor1->c_close() == 0 ;
210    ok 37, $cursor2->c_close() == 0 ;
211    ok 38, $cursor3->c_close() == 0 ;
212
213    ok 39, ($status = $txn->txn_commit()) == 0;
214
215    undef $txn ;
216
217    ok 40, my $cursor1a = $db1->db_cursor() ;
218    eval { $cursor1 = $db1->db_join([$cursor1a]) };
219    ok 41, $@ =~ /BerkeleyDB Aborting: attempted to do a self-join at/;
220    eval { $cursor1 = $db1->db_join([$cursor1]) } ;
221    ok 42, $@ =~ /BerkeleyDB Aborting: attempted to do a self-join at/;
222
223    undef $cursor1a;
224    #undef $cursor1;
225    #undef $cursor2;
226    #undef $cursor3;
227    undef $db1 ;
228    undef $db2 ;
229    undef $db3 ;
230    undef $env ;
231    untie %hash1 ;
232    untie %hash2 ;
233    untie %hash3 ;
234}
235
236print "# at the end\n";
237