8
unless(grep /blib/, @INC) {
10
@INC = '../lib' if -d '../lib';
17
if ($BerkeleyDB::db_ver < 2.005002)
19
print "1..0 # Skip: join needs Berkeley DB 2.5.2 or later\n" ;
26
my $Dfile1 = "dbhash1.tmp";
27
my $Dfile2 = "dbhash2.tmp";
28
my $Dfile3 = "dbhash3.tmp";
29
unlink $Dfile1, $Dfile2, $Dfile3 ;
35
my $lex = new LexFile $Dfile1, $Dfile2, $Dfile3 ;
41
ok 1, my $db1 = tie %hash1, 'BerkeleyDB::Hash',
44
-DupCompare => sub { $_[0] lt $_[1] },
45
-Property => DB_DUP|DB_DUPSORT ;
48
eval '$cursor = $db1->db_join() ;' ;
49
ok 2, $@ =~ /Usage: \$db->BerkeleyDB::Common::db_join\Q([cursors], flags=0)/;
52
eval '$cursor = $db1->db_join([]) ;' ;
53
ok 3, $@ =~ /db_join: No cursors in parameter list/;
55
# cursor list, isn't a []
56
eval '$cursor = $db1->db_join({}) ;' ;
57
ok 4, $@ =~ /cursors is not an array reference at/ ;
59
eval '$cursor = $db1->db_join(\1) ;' ;
60
ok 5, $@ =~ /cursors is not an array reference at/ ;
65
# test a 2-way & 3-way join
67
my $lex = new LexFile $Dfile1, $Dfile2, $Dfile3 ;
75
ok 6, my $lexD = new LexDir($home);
76
ok 7, my $env = new BerkeleyDB::Env -Home => $home,
77
-Flags => DB_CREATE|DB_INIT_TXN
79
#|DB_INIT_MPOOL| DB_INIT_LOCK;
80
ok 8, my $txn = $env->txn_begin() ;
81
ok 9, my $db1 = tie %hash1, 'BerkeleyDB::Hash',
84
-DupCompare => sub { $_[0] cmp $_[1] },
85
-Property => DB_DUP|DB_DUPSORT,
90
ok 10, my $db2 = tie %hash2, 'BerkeleyDB::Hash',
93
-DupCompare => sub { $_[0] cmp $_[1] },
94
-Property => DB_DUP|DB_DUPSORT,
98
ok 11, my $db3 = tie %hash3, 'BerkeleyDB::Btree',
101
-DupCompare => sub { $_[0] cmp $_[1] },
102
-Property => DB_DUP|DB_DUPSORT,
107
ok 12, addData($db1, qw( apple Convenience
116
ok 13, addData($db2, qw( red apple
124
ok 14, addData($db3, qw( expensive apple
130
reasonable blueberry)) ;
132
ok 15, my $cursor2 = $db2->db_cursor() ;
135
ok 16, $cursor2->c_get($k, $v, DB_SET) == 0 ;
138
ok 17, my $cursor1 = $db1->db_join([$cursor2]) ;
140
my %expected = qw( apple Convenience
146
while ($cursor1->c_get($k, $v) == 0) {
148
if defined $expected{$k} && $expected{$k} eq $v ;
149
#print "[$k] [$v]\n" ;
151
ok 18, keys %expected == 0 ;
152
ok 19, $cursor1->status() == DB_NOTFOUND ;
155
ok 20, $cursor2 = $db2->db_cursor() ;
158
ok 21, $cursor2->c_get($k, $v, DB_SET) == 0 ;
160
ok 22, my $cursor3 = $db3->db_cursor() ;
163
ok 23, $cursor3->c_get($k, $v, DB_SET) == 0 ;
164
ok 24, $cursor1 = $db1->db_join([$cursor2, $cursor3]) ;
166
%expected = qw( apple Convenience
171
while ($cursor1->c_get($k, $v) == 0) {
173
if defined $expected{$k} && $expected{$k} eq $v ;
174
#print "[$k] [$v]\n" ;
176
ok 25, keys %expected == 0 ;
177
ok 26, $cursor1->status() == DB_NOTFOUND ;
181
ok 27, $cursor2 = $db2->db_cursor() ;
184
ok 28, $cursor2->c_get($k, $v, DB_SET) == 0 ;
186
ok 29, $cursor3 = $db3->db_cursor() ;
189
ok 30, $cursor3->c_get($k, $v, DB_SET) == 0 ;
190
ok 31, $cursor1 = $db1->db_join([$cursor2, $cursor3]) ;
192
%expected = qw( apple 1
199
while ($cursor1->c_get($k, $v, DB_JOIN_ITEM) == 0) {
201
if defined $expected{$k} ;
204
ok 32, keys %expected == 0 ;
205
ok 33, $cursor1->status() == DB_NOTFOUND ;
207
ok 34, $cursor1->c_close() == 0 ;
208
ok 35, $cursor2->c_close() == 0 ;
209
ok 36, $cursor3->c_close() == 0 ;
211
ok 37, ($status = $txn->txn_commit) == 0;
225
print "# at the end\n";