summaryrefslogtreecommitdiff
path: root/tool/fragck.tcl
blob: 35e76f482b6747fa2e70e31bc6acbea7280e2f60 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
# 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