tool/fragck.tcl

   1 # Run this TCL script using "testfixture" to get a report that shows
   2 # the sequence of database pages used by a particular table or index.
   3 # This information is used for fragmentation analysis.
   4 #
   5
   6 # Get the name of the database to analyze
   7 #
   8
   9 if {[llength $argv]!=2} {
  10   puts stderr "Usage: $argv0 database-name table-or-index-name"
  11   exit 1
  12 }
  13 set file_to_analyze [lindex $argv 0]
  14 if {![file exists $file_to_analyze]} {
  15   puts stderr "No such file: $file_to_analyze"
  16   exit 1
  17 }
  18 if {![file readable $file_to_analyze]} {
  19   puts stderr "File is not readable: $file_to_analyze"
  20   exit 1
  21 }
  22 if {[file size $file_to_analyze]<512} {
  23   puts stderr "Empty or malformed database: $file_to_analyze"
  24   exit 1
  25 }
  26 set objname [lindex $argv 1]
  27
  28 # Open the database
  29 #
  30 sqlite3 db [lindex $argv 0]
  31 set DB [btree_open [lindex $argv 0] 1000 0]
  32
  33 # This proc is a wrapper around the btree_cursor_info command. The
  34 # second argument is an open btree cursor returned by [btree_cursor].
  35 # The first argument is the name of an array variable that exists in
  36 # the scope of the caller. If the third argument is non-zero, then
  37 # info is returned for the page that lies $up entries upwards in the
  38 # tree-structure. (i.e. $up==1 returns the parent page, $up==2 the
  39 # grandparent etc.)
  40 #
  41 # The following entries in that array are filled in with information retrieved
  42 # using [btree_cursor_info]:
  43 #
  44 #   $arrayvar(page_no)             =  The page number
  45 #   $arrayvar(entry_no)            =  The entry number
  46 #   $arrayvar(page_entries)        =  Total number of entries on this page
  47 #   $arrayvar(cell_size)           =  Cell size (local payload + header)
  48 #   $arrayvar(page_freebytes)      =  Number of free bytes on this page
  49 #   $arrayvar(page_freeblocks)     =  Number of free blocks on the page
  50 #   $arrayvar(payload_bytes)       =  Total payload size (local + overflow)
  51 #   $arrayvar(header_bytes)        =  Header size in bytes
  52 #   $arrayvar(local_payload_bytes) =  Local payload size
  53 #   $arrayvar(parent)              =  Parent page number
  54 #
  55 proc cursor_info {arrayvar csr {up 0}} {
  56   upvar $arrayvar a
  57   foreach [list a(page_no) \
  58                 a(entry_no) \
  59                 a(page_entries) \
  60                 a(cell_size) \
  61                 a(page_freebytes) \
  62                 a(page_freeblocks) \
  63                 a(payload_bytes) \
  64                 a(header_bytes) \
  65                 a(local_payload_bytes) \
  66                 a(parent) \
  67                 a(first_ovfl) ] [btree_cursor_info $csr $up] break
  68 }
  69
  70 # Determine the page-size of the database. This global variable is used
  71 # throughout the script.
  72 #
  73 set pageSize [db eval {PRAGMA page_size}]
  74
  75 # Find the root page of table or index to be analyzed.  Also find out
  76 # if the object is a table or an index.
  77 #
  78 if {$objname=="sqlite_master"} {
  79   set rootpage 1
  80   set type table
  81 } else {
  82   db eval {
  83     SELECT rootpage, type FROM sqlite_master
  84      WHERE name=$objname
  85   } break
  86   if {![info exists rootpage]} {
  87     puts stderr "no such table or index: $objname"
  88     exit 1
  89   }
  90   if {$type!="table" && $type!="index"} {
  91     puts stderr "$objname is something other than a table or index"
  92     exit 1
  93   }
  94   if {![string is integer -strict $rootpage]} {
  95     puts stderr "invalid root page for $objname: $rootpage"
  96     exit 1
  97   }
  98 }
  99
 100 # The cursor $csr is pointing to an entry.  Print out information
 101 # about the page that $up levels above that page that contains
 102 # the entry.  If $up==0 use the page that contains the entry.
 103 #
 104 # If information about the page has been printed already, then
 105 # this is a no-op.
 106 #
 107 proc page_info {csr up} {
 108   global seen
 109   cursor_info ci $csr $up
 110   set pg $ci(page_no)
 111   if {[info exists seen($pg)]} return
 112   set seen($pg) 1
 113
 114   # Do parent pages first
 115   #
 116   if {$ci(parent)} {
 117     page_info $csr [expr {$up+1}]
 118   }
 119
 120   # Find the depth of this page
 121   #
 122   set depth 1
 123   set i $up
 124   while {$ci(parent)} {
 125     incr i
 126     incr depth
 127     cursor_info ci $csr $i
 128   }
 129
 130   # print the results
 131   #
 132   puts [format {LEVEL %d:  %6d} $depth $pg]
 133 }
 134
 135
 136
 137
 138 # Loop through the object and print out page numbers
 139 #
 140 set csr [btree_cursor $DB $rootpage 0]
 141 for {btree_first $csr} {![btree_eof $csr]} {btree_next $csr} {
 142   page_info $csr 0
 143   set i 1
 144   foreach pg [btree_ovfl_info $DB $csr] {
 145     puts [format {OVFL %3d: %6d} $i $pg]
 146     incr i
 147   }
 148 }
 149 exit 0