Return to fragck.tcl CVS log

Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / sqlite3 / tool

sqlite3

    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