From 7bb481fda9ecb134804b49c2ce77ca28f7eea583 Mon Sep 17 00:00:00 2001
From: Hans-Christoph Steiner <hans@eds.org>
Date: Fri, 30 Mar 2012 20:42:12 -0400
Subject: Imported Upstream version 2.0.3

---
 tool/fragck.tcl | 149 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 149 insertions(+)
 create mode 100644 tool/fragck.tcl

(limited to 'tool/fragck.tcl')

diff --git a/tool/fragck.tcl b/tool/fragck.tcl
new file mode 100644
index 0000000..35e76f4
--- /dev/null
+++ b/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
-- 
cgit v1.2.3