150 lines
4.2 KiB
Tcl
150 lines
4.2 KiB
Tcl
# Run this TCL script using "testfixture" to get a report that shows
|
|
# the sequence of database pages used by a particular table or index.
|
|
# This information is used for fragmentation analysis.
|
|
#
|
|
|
|
# Get the name of the database to analyze
|
|
#
|
|
|
|
if {[llength $argv]!=2} {
|
|
puts stderr "Usage: $argv0 database-name table-or-index-name"
|
|
exit 1
|
|
}
|
|
set file_to_analyze [lindex $argv 0]
|
|
if {![file exists $file_to_analyze]} {
|
|
puts stderr "No such file: $file_to_analyze"
|
|
exit 1
|
|
}
|
|
if {![file readable $file_to_analyze]} {
|
|
puts stderr "File is not readable: $file_to_analyze"
|
|
exit 1
|
|
}
|
|
if {[file size $file_to_analyze]<512} {
|
|
puts stderr "Empty or malformed database: $file_to_analyze"
|
|
exit 1
|
|
}
|
|
set objname [lindex $argv 1]
|
|
|
|
# Open the database
|
|
#
|
|
sqlite3 db [lindex $argv 0]
|
|
set DB [btree_open [lindex $argv 0] 1000 0]
|
|
|
|
# This proc is a wrapper around the btree_cursor_info command. The
|
|
# second argument is an open btree cursor returned by [btree_cursor].
|
|
# The first argument is the name of an array variable that exists in
|
|
# the scope of the caller. If the third argument is non-zero, then
|
|
# info is returned for the page that lies $up entries upwards in the
|
|
# tree-structure. (i.e. $up==1 returns the parent page, $up==2 the
|
|
# grandparent etc.)
|
|
#
|
|
# The following entries in that array are filled in with information retrieved
|
|
# using [btree_cursor_info]:
|
|
#
|
|
# $arrayvar(page_no) = The page number
|
|
# $arrayvar(entry_no) = The entry number
|
|
# $arrayvar(page_entries) = Total number of entries on this page
|
|
# $arrayvar(cell_size) = Cell size (local payload + header)
|
|
# $arrayvar(page_freebytes) = Number of free bytes on this page
|
|
# $arrayvar(page_freeblocks) = Number of free blocks on the page
|
|
# $arrayvar(payload_bytes) = Total payload size (local + overflow)
|
|
# $arrayvar(header_bytes) = Header size in bytes
|
|
# $arrayvar(local_payload_bytes) = Local payload size
|
|
# $arrayvar(parent) = Parent page number
|
|
#
|
|
proc cursor_info {arrayvar csr {up 0}} {
|
|
upvar $arrayvar a
|
|
foreach [list a(page_no) \
|
|
a(entry_no) \
|
|
a(page_entries) \
|
|
a(cell_size) \
|
|
a(page_freebytes) \
|
|
a(page_freeblocks) \
|
|
a(payload_bytes) \
|
|
a(header_bytes) \
|
|
a(local_payload_bytes) \
|
|
a(parent) \
|
|
a(first_ovfl) ] [btree_cursor_info $csr $up] break
|
|
}
|
|
|
|
# Determine the page-size of the database. This global variable is used
|
|
# throughout the script.
|
|
#
|
|
set pageSize [db eval {PRAGMA page_size}]
|
|
|
|
# Find the root page of table or index to be analyzed. Also find out
|
|
# if the object is a table or an index.
|
|
#
|
|
if {$objname=="sqlite_master"} {
|
|
set rootpage 1
|
|
set type table
|
|
} else {
|
|
db eval {
|
|
SELECT rootpage, type FROM sqlite_master
|
|
WHERE name=$objname
|
|
} break
|
|
if {![info exists rootpage]} {
|
|
puts stderr "no such table or index: $objname"
|
|
exit 1
|
|
}
|
|
if {$type!="table" && $type!="index"} {
|
|
puts stderr "$objname is something other than a table or index"
|
|
exit 1
|
|
}
|
|
if {![string is integer -strict $rootpage]} {
|
|
puts stderr "invalid root page for $objname: $rootpage"
|
|
exit 1
|
|
}
|
|
}
|
|
|
|
# The cursor $csr is pointing to an entry. Print out information
|
|
# about the page that $up levels above that page that contains
|
|
# the entry. If $up==0 use the page that contains the entry.
|
|
#
|
|
# If information about the page has been printed already, then
|
|
# this is a no-op.
|
|
#
|
|
proc page_info {csr up} {
|
|
global seen
|
|
cursor_info ci $csr $up
|
|
set pg $ci(page_no)
|
|
if {[info exists seen($pg)]} return
|
|
set seen($pg) 1
|
|
|
|
# Do parent pages first
|
|
#
|
|
if {$ci(parent)} {
|
|
page_info $csr [expr {$up+1}]
|
|
}
|
|
|
|
# Find the depth of this page
|
|
#
|
|
set depth 1
|
|
set i $up
|
|
while {$ci(parent)} {
|
|
incr i
|
|
incr depth
|
|
cursor_info ci $csr $i
|
|
}
|
|
|
|
# print the results
|
|
#
|
|
puts [format {LEVEL %d: %6d} $depth $pg]
|
|
}
|
|
|
|
|
|
|
|
|
|
# Loop through the object and print out page numbers
|
|
#
|
|
set csr [btree_cursor $DB $rootpage 0]
|
|
for {btree_first $csr} {![btree_eof $csr]} {btree_next $csr} {
|
|
page_info $csr 0
|
|
set i 1
|
|
foreach pg [btree_ovfl_info $DB $csr] {
|
|
puts [format {OVFL %3d: %6d} $i $pg]
|
|
incr i
|
|
}
|
|
}
|
|
exit 0
|