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