1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1999,2008 Oracle. All rights reserved. 4# 5# $Id: sdbutils.tcl,v 12.7 2008/01/08 20:58:53 bostic Exp $ 6# 7proc build_all_subdb { dbname methods psize dups {nentries 100} {dbargs ""}} { 8 set nsubdbs [llength $dups] 9 set mlen [llength $methods] 10 set savearg $dbargs 11 for {set i 0} {$i < $nsubdbs} { incr i } { 12 set m [lindex $methods [expr $i % $mlen]] 13 set dbargs $savearg 14 subdb_build $dbname $nentries [lindex $dups $i] \ 15 $i $m $psize sub$i.db $dbargs 16 } 17} 18 19proc subdb_build { name nkeys ndups dup_interval method psize subdb dbargs} { 20 source ./include.tcl 21 22 set dbargs [convert_args $method $dbargs] 23 set omethod [convert_method $method] 24 25 puts "Method: $method" 26 27 set txnenv 0 28 set eindex [lsearch -exact $dbargs "-env"] 29 if { $eindex != -1 } { 30 incr eindex 31 set env [lindex $dbargs $eindex] 32 set txnenv [is_txnenv $env] 33 } 34 # Create the database and open the dictionary 35 set oflags "-create -mode 0644 $omethod \ 36 -pagesize $psize $dbargs {$name} $subdb" 37 set db [eval {berkdb_open} $oflags] 38 error_check_good dbopen [is_valid_db $db] TRUE 39 set did [open $dict] 40 set count 0 41 if { $ndups >= 0 } { 42 puts "\tBuilding $method {$name} $subdb. \ 43 $nkeys keys with $ndups duplicates at interval of $dup_interval" 44 } 45 if { $ndups < 0 } { 46 puts "\tBuilding $method {$name} $subdb. \ 47 $nkeys unique keys of pagesize $psize" 48 # 49 # If ndups is < 0, we want unique keys in each subdb, 50 # so skip ahead in the dict by nkeys * iteration 51 # 52 for { set count 0 } \ 53 { $count < [expr $nkeys * $dup_interval] } { 54 incr count} { 55 set ret [gets $did str] 56 if { $ret == -1 } { 57 break 58 } 59 } 60 } 61 set txn "" 62 for { set count 0 } { [gets $did str] != -1 && $count < $nkeys } { 63 incr count} { 64 for { set i 0 } { $i < $ndups } { incr i } { 65 set data [format "%04d" [expr $i * $dup_interval]] 66 if { $txnenv == 1 } { 67 set t [$env txn] 68 error_check_good txn [is_valid_txn $t $env] TRUE 69 set txn "-txn $t" 70 } 71 set ret [eval {$db put} $txn {$str \ 72 [chop_data $method $data]}] 73 error_check_good put $ret 0 74 if { $txnenv == 1 } { 75 error_check_good txn [$t commit] 0 76 } 77 } 78 79 if { $txnenv == 1 } { 80 set t [$env txn] 81 error_check_good txn [is_valid_txn $t $env] TRUE 82 set txn "-txn $t" 83 } 84 if { $ndups == 0 } { 85 set ret [eval {$db put} $txn {$str \ 86 [chop_data $method NODUP]}] 87 error_check_good put $ret 0 88 } elseif { $ndups < 0 } { 89 if { [is_record_based $method] == 1 } { 90 global kvals 91 92 set num [expr $nkeys * $dup_interval] 93 set num [expr $num + $count + 1] 94 set ret [eval {$db put} $txn {$num \ 95 [chop_data $method $str]}] 96 set kvals($num) [pad_data $method $str] 97 error_check_good put $ret 0 98 } else { 99 set ret [eval {$db put} $txn \ 100 {$str [chop_data $method $str]}] 101 error_check_good put $ret 0 102 } 103 } 104 if { $txnenv == 1 } { 105 error_check_good txn [$t commit] 0 106 } 107 } 108 close $did 109 error_check_good close:$name [$db close] 0 110} 111 112proc do_join_subdb { db primary subdbs key oargs } { 113 source ./include.tcl 114 115 puts "\tJoining: $subdbs on $key" 116 117 # Open all the databases 118 set p [eval {berkdb_open -unknown} $oargs { $db } $primary] 119 error_check_good "primary open" [is_valid_db $p] TRUE 120 121 set dblist "" 122 set curslist "" 123 124 foreach i $subdbs { 125 set jdb [eval {berkdb_open -unknown} $oargs { $db } sub$i.db] 126 error_check_good "sub$i.db open" [is_valid_db $jdb] TRUE 127 128 lappend jlist [list $jdb $key] 129 lappend dblist $jdb 130 131 } 132 133 set join_res [eval {$p get_join} $jlist] 134 set ndups [llength $join_res] 135 136 # Calculate how many dups we expect. 137 # We go through the list of indices. If we find a 0, then we 138 # expect 0 dups. For everything else, we look at pairs of numbers, 139 # if the are relatively prime, multiply them and figure out how 140 # many times that goes into 50. If they aren't relatively prime, 141 # take the number of times the larger goes into 50. 142 set expected 50 143 set last 1 144 foreach n $subdbs { 145 if { $n == 0 } { 146 set expected 0 147 break 148 } 149 if { $last == $n } { 150 continue 151 } 152 153 if { [expr $last % $n] == 0 || [expr $n % $last] == 0 } { 154 if { $n > $last } { 155 set last $n 156 set expected [expr 50 / $last] 157 } 158 } else { 159 set last [expr $n * $last / [gcd $n $last]] 160 set expected [expr 50 / $last] 161 } 162 } 163 164 error_check_good number_of_dups:$subdbs $ndups $expected 165 166 # 167 # If we get here, we have the number expected, now loop 168 # through each and see if it is what we expected. 169 # 170 for { set i 0 } { $i < $ndups } { incr i } { 171 set pair [lindex $join_res $i] 172 set k [lindex $pair 0] 173 foreach j $subdbs { 174 error_check_bad valid_dup:$j:$subdbs $j 0 175 set kval [string trimleft $k 0] 176 if { [string length $kval] == 0 } { 177 set kval 0 178 } 179 error_check_good \ 180 valid_dup:$j:$subdbs [expr $kval % $j] 0 181 } 182 } 183 184 error_check_good close_primary [$p close] 0 185 foreach i $dblist { 186 error_check_good close_index:$i [$i close] 0 187 } 188} 189 190proc n_to_subname { n } { 191 if { $n == 0 } { 192 return null.db; 193 } else { 194 return sub$n.db; 195 } 196} 197