File: archive.tcl

package info (click to toggle)
db 2%3A2.4.14-2.7.7.1.c
  • links: PTS
  • area: main
  • in suites: potato
  • size: 12,716 kB
  • ctags: 9,382
  • sloc: ansic: 35,556; tcl: 8,564; cpp: 4,890; sh: 2,075; makefile: 1,723; java: 1,632; sed: 419; awk: 153; asm: 41
file content (230 lines) | stat: -rw-r--r-- 6,466 bytes parent folder | download | duplicates (6)
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
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1996, 1997, 1998
#	Sleepycat Software.  All rights reserved.
#
#	@(#)archive.tcl	10.10 (Sleepycat) 10/28/98
#
# Options are:
# -checkrec <checkpoint frequency"
# -dir <dbhome directory>
# -maxfilesize <maxsize of log file>
# -stat
proc archive_usage {} {
	puts "archive -checkrec <checkpt freq> -dir <directory> \
	    -maxfilesize <max size of log files>"
}
proc archive_command { args } {
	source ./include.tcl
global is_windows_test
	if { $is_windows_test != 1 } {
		eval exec ./db_archive $args
	} else {
		# On Windows, convert all filenames to use forward slashes
		eval exec ./db_archive $args | $TR \\\\ /
	}
}
proc archive { args } {
	source ./include.tcl

# Set defaults
global alphabet
	set maxfile [expr 1024 * 20]
	set dostat 0
	set checkrec 500
	for { set i 0 } { $i < [llength $args] } {incr i} {
		switch -regexp -- [lindex $args $i] {
			-c.* { incr i; set checkrec [lindex $args $i] }
			-d.* { incr i; set testdir [lindex $args $i] }
			-m.* { incr i; set maxfile [lindex $args $i] }
			-s.* { set dostat 1 }
			default {
				archive_usage
				return
			}

		}
	}
	if { [file exists $testdir] != 1 } {
		exec $MKDIR $testdir
	} elseif { [file isdirectory $testdir ] != 1 } {
		error "$testdir is not a directory"
	}

	# Clean out old log if it existed
	puts "Unlinking log: error message OK"
	cleanup $testdir

	# Now run the various functionality tests
	set dbenv [dbenv -dbhome $testdir -maxsize $maxfile -dbflags \
	    [expr $DB_CREATE | $DB_INIT_MPOOL | $DB_INIT_LOCK | \
	    $DB_INIT_LOG | $DB_INIT_TXN]]
	error_check_bad dbenv $dbenv NULL
	error_check_good dbenv [is_substr $dbenv env] 1

	# Open the log
	set lp [ log "" 0 0 -maxsize $maxfile -dbenv $dbenv]
	error_check_bad log:$testdir $lp NULL
	error_check_good log:$testdir [is_substr $lp log] 1

	# Open/Create the lock region
	set txn [txn "" 0 0 -dbenv $dbenv]
	error_check_bad txn $txn NULL
	error_check_good txn [is_substr $txn mgr] 1

	# The basic test structure here is that we write a lot of log
	# records (enough to fill up 100 log files; each log file it
	# small).  We take periodic checkpoints.  Between each pair
	# of checkpoints, we refer to 2 files, overlapping them each
	# checkpoint.  We also start transactions and let them overlap
	# checkpoints as well.  The pattern that we try to create is:
	# ---- write log records----|||||--- write log records ---
	# -T1 T2 T3 --- D1 D2 ------CHECK--- CT1 --- D2 D3 CD1 ----CHECK
	# where TX is begin transaction, CTx is commit transaction, DX is
	# open data file and CDx is close datafile.

	set baserec "1:$alphabet:2:$alphabet:3:$alphabet:4:$alphabet"
	puts "Archive.a: Writing log records; checkpoint every $checkrec records"
	set nrecs $maxfile
	set rec 0:$baserec
	# Begin transaction and write a log record
	set t1 [$txn begin]
	set l1 [lindex [$lp put $rec 0] 1]
	set lsnlist [list $l1]

	set t2 [$txn begin]
	set l1 [lindex [$lp put $rec 0] 1]
	lappend lsnlist $l1

	set t3 [$txn begin]
	set l1 [lindex [$lp put $rec 0] 1]
	lappend lsnlist $l1

	set txnlist [list $t1 $t2 $t3]
	set db1 [dbopen ar1 $DB_CREATE 0644 DB_HASH -dbenv $dbenv]
	set db2 [dbopen ar2 $DB_CREATE 0644 DB_BTREE -dbenv $dbenv]
	set dbcount 3
	set dblist [list $db1 $db2]
	for { set i 1 } { $i <= $nrecs } { incr i } {
		set rec $i:$baserec
		set lsn [$lp put $rec 0]
		error_check_bad log_put [is_substr $lsn log_cmd] 1

		if { [expr $i % $checkrec] == 0 } {
			# Take a checkpoint
			$txn check
			set ckp_file [lindex [$lp last] 0]

			catch { archive_command -h $testdir -a } res_log_full
			if { [string first db_archive $res_log_full] == 0 } {
				set res_log_full ""
			}
			catch { archive_command -h $testdir } res_log
			if { [string first db_archive $res_log] == 0 } {
				set res_log ""
			}
			catch { archive_command -h $testdir -l } res_alllog
			catch { archive_command -h $testdir -a -s } \
			    res_data_full
			catch { archive_command -h $testdir -s } res_data

			error_check_good nlogfiles [llength $res_alllog] \
			    [lindex [$lp last] 0]
			error_check_good logs_match [llength $res_log_full] \
			    [llength $res_log]
			error_check_good data_match [llength $res_data_full] \
			    [llength $res_data]

			# Check right number of log files
			error_check_good nlogs [llength $res_log] \
			    [expr [lindex $lsnlist 0] - 1]

			# Check that the relative names are a subset of the
			# full names
			set n 0
			foreach x $res_log {
				error_check_bad log_name_match:$res_log \
				    [string first $x \
				    [lindex $res_log_full $n]] -1
				incr n
			}

			set n 0
			foreach x $res_data {
				error_check_bad log_name_match:$res_data \
				    [string first $x \
				    [lindex $res_data_full $n]] -1
				incr n
			}

			# Begin/commit any transactions
			set t [lindex $txnlist 0]
			if { [string length $t] != 0 } {
				error_check_good txn_commit:$t [$t commit] 0
				set txnlist [lrange $txnlist 1 end]
			}
			set lsnlist [lrange $lsnlist 1 end]

			if { [llength $txnlist] == 0 } {
				set t1 [$txn begin]
				error_check_bad tx_begin $t1 NULL
				error_check_good tx_begin [is_substr $t1 $txn] 1
				set l1 [lindex [$lp put $rec 0] 1]
				lappend lsnlist [min $l1 $ckp_file]

				set t2 [$txn begin]
				error_check_bad tx_begin $t2 NULL
				error_check_good tx_begin [is_substr $t2 $txn] 1
				set l1 [lindex [$lp put $rec 0] 1]
				lappend lsnlist [min $l1 $ckp_file]

				set t3 [$txn begin]
				error_check_bad tx_begin $t3 NULL
				error_check_good tx_begin [is_substr $t3 $txn] 1
				set l1 [lindex [$lp put $rec 0] 1]
				lappend lsnlist [min $l1 $ckp_file]

				set txnlist [list $t1 $t2 $t3]
			}

			# Open/close some DB files
			if { [expr $dbcount % 2] == 0 } {
				set type DB_HASH
			} else {
				set type DB_BTREE
			}
			set db [dbopen ar$dbcount \
			    $DB_CREATE 0644 $type -dbenv $dbenv]
			error_check_bad db_open:$dbcount $db NULL
			error_check_good db_open:$dbcount [is_substr $db db] 1
			incr dbcount

			lappend dblist $db
			set db [lindex $dblist 0]
			error_check_good db_close:$db [$db close] 0
			set dblist [lrange $dblist 1 end]

		}
	}

	# Commit any transactions still running.
	foreach t $txnlist {
		error_check_good txn_commit:$t [$t commit] 0
	}

	# Close any files that are still open.
	foreach d $dblist {
		error_check_good db_close:$db [$d close] 0
	}

	# Close and unlink the file
	reset_env $dbenv
}

proc min { a b } {
	if {$a < $b} {
		return $a
	} else {
		return $b
	}
}