Return to fragck.tcl CVS log

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

Annotation of embedaddon/sqlite3/tool/fragck.tcl, revision 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