Index: third_party/sqlite/sqlite-src-3070603/tool/fragck.tcl |
diff --git a/third_party/sqlite/sqlite-src-3070603/tool/fragck.tcl b/third_party/sqlite/sqlite-src-3070603/tool/fragck.tcl |
new file mode 100644 |
index 0000000000000000000000000000000000000000..35e76f482b6747fa2e70e31bc6acbea7280e2f60 |
--- /dev/null |
+++ b/third_party/sqlite/sqlite-src-3070603/tool/fragck.tcl |
@@ -0,0 +1,149 @@ |
+# 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 |