gustafn
committed
on 30 Jul 24
improved spelling
/tcl/schema-browser-procs-postgresql.tcl (+17 -15)
1 1 ad_library {
2 2     Took these defs out of the /www/doc/schema-browser/index.tcl file.
3 3 }
4 4
5   ad_proc sb_get_tables_list {} {
  5 namespace eval sb {}
  6
  7 ad_proc sb::get_tables_list {} {
6 8    Get all tables that belong to the current user.
7 9 } {
8 10     return [db_list schema_browser_index_get_tables {
9 11         select
10 12           pg_class.relname as table_name
11 13         from pg_class, pg_user
12 14         where pg_user.usename = session_user and
13 15           pg_user.usesysid = pg_class.relowner and
14 16           pg_class.relkind = 'r'
15 17         order by relname
16 18     }]
17 19 }
18 20
19   ad_proc sb_get_tables { selected_table_name } {
  21 ad_proc sb::get_tables { selected_table_name } {
20 22    Build an HTML table of all PG tables belonging to the current user.  Each PG table
21 23    name is returned as a hyperlink to a page which displays the table's structure.
22 24 } {
23 25
24 26     set n_columns 4
25 27     set return_string ""
26 28
27       set tables [sb_get_tables_list]
  29     set tables [sb::get_tables_list]
28 30     if {[llength $tables] == 0} {
29 31         return {No tables found. Make sure the owner of the tables in the
30 32                 database matches the user-id used by the web server to connect
31 33                 to the database.}
32 34     }
33 35
34 36     set n_rows [expr {([llength $tables] - 1) / $n_columns + 1}]
35 37
36 38     append return_string "<table>"
37 39     for { set row 0 } { $row < $n_rows } { incr row } {
38 40          append return_string "<tr>"
39 41          for {set column 0} {$column < $n_columns} {incr column} {
40 42              set i_element [expr {$n_rows * $column + $row}]
41 43              if { $i_element < [llength $tables] } {
42 44                  set table_name [lindex $tables $i_element]
43 45                  if { $table_name == $selected_table_name } {
44 46                      append return_string "<td><b>[string tolower $table_name]</b></td>"
45 47                  } else {
46 48                      set href [export_vars -base index {table_name}]
47 49                      append return_string [subst {<td><a href="[ns_quotehtml $href]">[string tolower $table_name]</a></td>}]
48 50
49 51                  }
50 52              }
51 53
52 54          }
53 55      append return_string "</tr>"
54 56     }
55 57
56 58     append return_string "</table>"
57 59
58 60     return $return_string
59 61
60 62 }
61 63
62   ad_proc sb_get_triggers { table_name } {
  64 ad_proc sb::get_triggers { table_name } {
63 65    Get all non-RI triggers on the table.
64 66 } {
65 67     set return_string "\n"
66 68     db_foreach sb_get_triggers_select_1 {
67 69         select
68 70           tgname as trigger_name,
69 71           trigger_type(tgtype) as trigger_type,
70 72           case tgenabled when 't' then '' else '(disabled)' end as status,
71 73           proname,
72 74           tgfoid
73 75         from
74 76           pg_trigger t join (select oid from pg_class where relname = lower(:table_name)) c
75 77             on (c.oid = t.tgrelid)
76 78           join pg_proc p on (p.oid = t.tgfoid)
77 79         where true
78 80     } {
79 81         append return_string "\nCREATE TRIGGER $trigger_name</a> $trigger_type EXECUTE PROCEDURE <a href=\"function-body?oid=$tgfoid\">$proname</a> $status"
80 82     } if_no_rows {
81 83         set return_string ""
82 84     }
83 85     return $return_string
84 86 }
85 87
86   ad_proc sb_get_child_tables { table_name {html_anchor_p "f"} } {
  88 ad_proc sb::get_child_tables { table_name {html_anchor_p "f"} } {
87 89     Build an HTML snippet listing all tables which have at least one foreign key
88 90     referring to table_name.
89 91 } {
90 92
91 93     set return_string "\n\n-- Tables with foreign keys that refer to $table_name:"
92 94     db_foreach schema_browser_get_referencess {
93 95          select distinct r1.relname as child_table,
94 96              conname as constraint_name
95 97          from
96 98              pg_trigger t,
97 99              pg_class r,
98 100              pg_class r1,
99 101              pg_proc p,
100 102              pg_constraint c
101 103          where
102 104              lower(r.relname) = lower(:table_name) and
103 105              r.oid = t.tgconstrrelid and
104 106              r1.oid = t.tgrelid and
105 107              t.tgfoid = p.oid and
106 108              c.conrelid  = r.oid and
107 109              p.proname = 'RI_FKey_check_ins'
108 110     } {
109 111         if { $html_anchor_p == "t" } {
110 112             append return_string "\n--<a href=\"index?table_name=$child_table\">[string tolower $child_table]</a>"
111 113         } else {
112 114             append return_string "\n--[string tolower $child_table]"
113 115         }
114 116         if { $constraint_name ne "<unnamed>" } {
115 117             append return_string "($constraint_name)"
116 118         }
117 119     } if_no_rows {
118 120         set return_string ""
119 121     }
120 122     return $return_string
121 123 }
122 124
123   ad_proc sb_get_indexes { table_name { html_anchors_p "f" } {pki {}}} {
  125 ad_proc sb::get_indexes { table_name { html_anchors_p "f" } {pki {}}} {
124 126     Create statements for indexes on table_name.
125 127 } {
126 128
127 129
128 130     set return_string "\n"
129 131     set prev_index ""
130 132
131 133     set indexes [db_list_of_lists sb_get_indexes_select_1 {
132 134         select
133 135           relname as index_name,
134 136           case when indisunique then ' UNIQUE' else NULL end as uniqueness,
135 137           amname as index_type,
136 138           indkey
137 139         from
138 140           pg_index i join (select oid from pg_class where relname = lower(:table_name)) c
139 141             on (i.indrelid = c.oid)
140 142           join pg_class index_class on (index_class.oid = i.indexrelid and not i.indisprimary)
141 143           join pg_am a on (index_class.relam = a.oid)
142 144         order by index_name}]
143 145
 
164 166               join pg_attribute a on (c.oid = a.attrelid)
165 167             where a.attnum in $index_clause
166 168         " {
167 169             set cname($attnum) $column_name
168 170         }
169 171
170 172
171 173         foreach indid [split $indkey " "] {
172 174             if {[info exists cname($indid)]} {
173 175                 append return_string $sep$cname($indid)
174 176                 set sep ", "
175 177             }
176 178         }
177 179         append return_string ");"
178 180         unset -nocomplain cname
179 181     }
180 182
181 183     return $return_string
182 184 }
183 185
184   ad_proc sb_get_foreign_keys { table_name } {
  186 ad_proc sb::get_foreign_keys { table_name } {
185 187     Build a list describing all foreign keys on table_name and their actions.
186 188     We ignore MATCH conditions because Oracle doesn't support them, therefore,
187 189     OpenACS doesn't use them.  Same is true of SET NULL and SET DEFAULT actions
188 190     hung on ON DELETE/ON UPDATE subclauses, but since Oracle *does* support
189 191     CASCADE as an action I had figure out how to grab this info from the system
190 192     catalog anyway.
191 193
192 194     This code is *horribly* convoluted, mostly a result of the non-obvious way
193 195     that the needed information is organized in the PG system catalogs.
194 196 g
195 197     Feel free to clean this up if you want!
196 198
197 199     @author Don Baccus, though he hates to admit to writing such ugly code (dhogaza@pacifier.com)
198 200
199 201 } {
200 202     set complex_foreign_keys [list]
201 203     db_foreach schema_browser_get_referencess {
202 204          select t.tgargs as constraint_args,
203 205              conname as constraint_name,
204 206              'NOACTION' as action,
 
287 289                  append foreign_key_sql "REFERENCES <a href=\"index?table_name=$refer_table\">$refer_table</a> ($refer_var_part)"
288 290             }
289 291             default {
290 292                 if { $action ne "NOACTION" } {
291 293                     append foreign_key_sql " $trigger_kind $action"
292 294                 }
293 295             }
294 296         }
295 297     }
296 298     if { [info exists foreign_key_sql] } {
297 299         if { $arg_count == 1 } {
298 300             set references($on_var) $foreign_key_sql
299 301         } else {
300 302             lappend complex_foreign_keys $foreign_key_sql
301 303         }
302 304     }
303 305     return [list [array get references] $complex_foreign_keys]
304 306 }
305 307
306 308
307   ad_proc -public sb_get_table_size {
  309 ad_proc -public sb::get_table_size {
308 310         {-table_name:required}
309 311         {-namespace {public}}
310 312         {-block_size {8192}}
311 313 } {
312 314         Returns the size of the table on disk. This information is only updated
313 315         by the commands VACUUM, ANALYZE, and CREATE INDEX. Thus, if you have
314 316         been changing your table, run ANALYZE on the table before running this
315 317         proc.
316 318
317 319         @param table_name The table name
318 320         @param namespace The database namespace that contains the table
319 321         @param block_size Size of BLCKSZ (in bytes) used by the database
320 322
321 323         @return This procedure returns a list with 2 items:
322 324                 <ol>
323 325                 <li> Size of the table on disk (in bytes), or -1 if the table was not found
324 326                 <li> Number of rows in the table, or -1 if the table was not found
325 327                 </ol>
326 328
327 329         @author Gabriel Burca (gburca-openacs@ebixio.com)
328 330         @creation-date 2004-06-27
329 331 } {
330 332     set res [db_0or1row sb_get_table_size {
331 333         select relpages * :block_size as size_in_bytes, reltuples as table_rows
332 334         from pg_class
333 335         where relnamespace = (select oid from pg_namespace where nspname = :namespace)
334 336         and relname = :table_name
335 337     }]
336 338     if {$res} {
337 339         return [list $size_in_bytes $table_rows]
338 340     } else {
339 341         # No such table in the namespace?
340 342         return [list -1 -1]
341 343     }
342 344 }
343 345
344 346
345   ad_proc sb_get_table_description { table_name } {
  347 ad_proc sb::get_table_description { table_name } {
346 348     @return table description as HTML
347 349 } {
348 350
349       set foreign_keys [sb_get_foreign_keys $table_name]
  351     set foreign_keys [sb::get_foreign_keys $table_name]
350 352     array set references [lindex $foreign_keys 0]
351 353     set complex_foreign_keys [lindex $foreign_keys 1]
352 354
353 355     set html "<pre>"
354 356
355 357     # get table comments
356 358     if { [db_0or1row sb_get_table_comment {
357 359         select d.description
358 360         from pg_class c, pg_description d
359 361         where c.relname = lower(:table_name)
360 362         and d.objoid = c.oid and objsubid = 0}] } {
361 363         append html "\n--[join [split $description "\n"] "\n-- "]"
362 364     }
363 365
364 366     append html "\nCREATE TABLE [string tolower $table_name] ("
365 367
366 368     if { [db_0or1row sb_get_primary_key {
367 369             select
368 370               indkey as primary_key_array
369 371             from
 
492 494     }
493 495
494 496     if { [llength $primary_key_columns] > 1 } {
495 497         append html ",\n\tPRIMARY KEY ("
496 498         append html [join [db_list sb_get_primary_key_select_2 [subst {
497 499             select
498 500               a.attname as column_name
499 501             from
500 502               (select oid from pg_class where relname = lower(:table_name)) c
501 503               join pg_attribute a on (c.oid = a.attrelid)
502 504             where a.attnum in ([join $primary_key_columns ","])
503 505         }]] ","]
504 506         append html ")"
505 507     }
506 508
507 509     foreach complex_foreign_key $complex_foreign_keys {
508 510         append html ",\n\t$complex_foreign_key"
509 511     }
510 512
511 513     append html "\n);"
512       append html [sb_get_indexes $table_name]
513       append html [sb_get_triggers $table_name]
514       append html [sb_get_child_tables $table_name "t"]
  514     append html [sb::get_indexes $table_name]
  515     append html [sb::get_triggers $table_name]
  516     append html [sb::get_child_tables $table_name "t"]
515 517
516 518     if {[string match "pg_*" $table_name]} {
517           set table_size [sb_get_table_size -table_name $table_name -namespace "pg_catalog"]
  519         set table_size [sb::get_table_size -table_name $table_name -namespace "pg_catalog"]
518 520     } else {
519           set table_size [sb_get_table_size -table_name $table_name]
  521         set table_size [sb::get_table_size -table_name $table_name]
520 522     }
521 523     append html "\n\n-- Table size: [lc_numeric [lindex $table_size 0]] bytes\n"
522 524     append html "-- Table rows: [lc_numeric [lindex $table_size 1]]\n"
523 525
524 526     append html "</pre>"
525 527
526 528     return $html
527 529
528 530 }
529 531
530 532 #
531 533 # Local variables:
532 534 #    mode: tcl
533 535 #    tcl-indent-level: 4
534 536 #    indent-tabs-mode: nil
535 537 # End: