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