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