| |
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: |