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