tool/fragck.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