← Back to branch summary

~ubuntu-branches/ubuntu/edgy/rpm/edgy

« back to all changes in this revision

Viewing changes to db/test/sdbutils.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Joey Hess
  • Date: 2002-01-22 20:56:57 UTC
  • Revision ID: james.westby@ubuntu.com-20020122205657-l74j50mr9z8ofcl5
Tags: upstream-4.0.3
Import upstream version 4.0.3

Show diffs side-by-side

added added

removed removed

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