Annotation of embedaddon/sqlite3/tool/fragck.tcl, revision 1.1.1.1

1.1       misho       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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>