Index: openacs-4/packages/acs-kernel/sql/postgresql/postgresql.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-kernel/sql/postgresql/postgresql.sql,v diff -u -r1.13 -r1.14 --- openacs-4/packages/acs-kernel/sql/postgresql/postgresql.sql 1 Sep 2001 16:41:07 -0000 1.13 +++ openacs-4/packages/acs-kernel/sql/postgresql/postgresql.sql 15 Sep 2001 00:32:45 -0000 1.14 @@ -603,3 +603,46 @@ return 1; end;' language 'plpgsql'; +-- Returns an english-language description of the trigger type. Used by the +-- schema browser + +create function trigger_type (integer) returns varchar as ' +declare + tgtype alias for $1; + description varchar; + sep varchar; +begin + + if tgtype & 2 then + description := ''BEFORE ''; + else + description := ''AFTER ''; + end if; + + sep := ''''; + + if tgtype & 4 then + description := description || ''INSERT ''; + sep := ''OR ''; + end if; + + if tgtype & 8 then + description := description || sep || ''DELETE ''; + sep := ''OR ''; + end if; + + if tgtype & 16 then + description := description || sep || ''UPDATE ''; + sep := ''OR ''; + end if; + + if tgtype & 1 then + description := description || ''FOR EACH ROW''; + else + description := description || ''STATEMENT''; + end if; + + return description; + +end;' language 'plpgsql'; + Index: openacs-4/packages/acs-tcl/tcl/apm-file-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/apm-file-procs.tcl,v diff -u -r1.7 -r1.8 --- openacs-4/packages/acs-tcl/tcl/apm-file-procs.tcl 29 May 2001 01:46:29 -0000 1.7 +++ openacs-4/packages/acs-tcl/tcl/apm-file-procs.tcl 15 Sep 2001 00:32:45 -0000 1.8 @@ -280,6 +280,7 @@ foreach file_info $files { util_unlist $file_info package_key path + if { $force_reload_p || ![nsv_exists apm_library_mtime packages/$package_key/$path] } { if { [file exists "[acs_root_dir]/packages/$package_key/$path"] } { apm_callback_and_log $callback "Loading packages/$package_key/$path..." Index: openacs-4/packages/acs-tcl/tcl/apm-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/apm-procs.tcl,v diff -u -r1.13 -r1.14 --- openacs-4/packages/acs-tcl/tcl/apm-procs.tcl 26 Aug 2001 22:57:00 -0000 1.13 +++ openacs-4/packages/acs-tcl/tcl/apm-procs.tcl 15 Sep 2001 00:32:45 -0000 1.14 @@ -280,6 +280,7 @@ # Scan the package directory for files to source. set files [list] foreach package $packages { + set base "[acs_root_dir]/packages/$package/" set base_len [string length $base] set dirs [list \ @@ -290,9 +291,11 @@ foreach dir $dirs { if {$procs_p} { set paths [concat $paths [glob -nocomplain "$dir/*procs.tcl"]] + set paths [concat $paths [glob -nocomplain "$dir/*procs-[db_type].tcl"]] } if {$init_p} { set paths [concat $paths [glob -nocomplain "$dir/*init.tcl"]] + set paths [concat $paths [glob -nocomplain "$dir/*init-[db_type].tcl"]] } } Index: openacs-4/packages/schema-browser/schema-browser.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/schema-browser/schema-browser.info,v diff -u -r1.1 -r1.2 --- openacs-4/packages/schema-browser/schema-browser.info 20 Apr 2001 20:51:22 -0000 1.1 +++ openacs-4/packages/schema-browser/schema-browser.info 15 Sep 2001 00:32:45 -0000 1.2 @@ -1,9 +1,10 @@ - + Schema Browser Schema Browsers + f t @@ -21,10 +22,16 @@ - + + + + + + + Index: openacs-4/packages/schema-browser/tcl/schema-browser-procs-oracle.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/schema-browser/tcl/schema-browser-procs-oracle.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/schema-browser/tcl/schema-browser-procs-oracle.tcl 15 Sep 2001 00:32:45 -0000 1.1 @@ -0,0 +1,431 @@ +ad_library { + Took these defs out of the /www/doc/schema-browser/index.tcl file. +} + +ad_proc sb_get_tables_list {} {} { + + set tables "" + + db_foreach schema_browser_index_get_tables "select table_name + from user_tables order by table_name" { + lappend tables $table_name + } + + db_release_unused_handles + return $tables + +} + +ad_proc sb_get_tables { selected_table_name } {} { + + set n_columns 4 + set return_string "" + + set tables [util_memoize "sb_get_tables_list"] + + set n_rows [expr ([llength $tables] - 1) / $n_columns + 1] + + append return_string "" + for { set row 0 } { $row < $n_rows } { incr row } { + append return_string "" + for {set column 0} {$column < $n_columns} {incr column} { + set i_element [expr $n_rows * $column + $row] + if { $i_element < [llength $tables] } { + set table_name [lindex $tables $i_element] + if { $table_name == $selected_table_name } { + append return_string "" + } else { + append return_string "" + } + } + + } + append return_string "" + } + + append return_string "
[string tolower $table_name][string tolower $table_name]
" + + return $return_string + +} + +ad_proc sb_get_triggers { table_name } {} { + set return_string "\n-- $table_name triggers:" + db_foreach sb_get_triggers_select_1 " + select + trigger_name, + trigger_type, + triggering_event, + status + from + user_triggers + where + table_name = upper(:table_name) + " { + append return_string "\n--\t$trigger_name $triggering_event $trigger_type $status" + } if_no_rows { + append return_string "\n--\tnone" + } + + return $return_string +} + +ad_proc sb_get_child_tables { table_name {html_anchor_p "f"} } {} { + + # + # child tables -- put in comments about each child table that references this one + # + + set return_string "" + + # this takes about 8 minutes to run -- for one table! + # set selection [ns_db select $db " + # select + # childcon.constraint_name, + # parentcol.column_name as parent_column, + # childcol.column_name as child_column, + # childcol.table_name as child_table, + # parentcol.table_name as parent_table + # from + # user_constraints childcon, + # user_cons_columns parentcol, + # user_cons_columns childcol + # where + # childcon.r_constraint_name = parentcol.constraint_name and + # childcon.constraint_name = childcol.constraint_name and + # childcon.constraint_type = 'R' and + # parentcol.table_name = '$table_name' + # "] + + # since the above is so slow, forget about joining in user_cons_columns for the child table, so we won't know the + # column names of the child table involved. + append return_string "\n-- child tables:" + set child_count 1 + db_foreach schema_browser_index_get_user_constraints " + select distinct + childcon.constraint_name, + childcon.r_constraint_name, + childcon.table_name as child_table + from + user_constraints childcon, + user_cons_columns parentcol + where + childcon.r_constraint_name = parentcol.constraint_name and + childcon.constraint_type = 'R' and + parentcol.table_name = upper(:table_name) + order by child_table + " { + if { [expr (($child_count % 3) == 0)] } { + append return_string "\n--" + } + if { $html_anchor_p == "t" } { + append return_string " [string tolower $child_table]" + } else { + append return_string " [string tolower $child_table]" + } + append return_string "($r_constraint_name)" + incr child_count + } if_no_rows { + append return_string "\n--\t none" + } + + return $return_string + +} + +ad_proc add_column_constraint { column_list column_constraint } {} { + +# +# adds a column constraint to the column list +# +# column_list := list of column_info +# column_constraint := constraint_info ns_set +# +# + + set i 0 + set found_p "f" + + # + # iterate through the columns in the list, finding the one with a name that matches the one in the constraint + # + + while { $i < [llength $column_list] && $found_p != "t" } { + if { [ns_set get $column_constraint "constraint_columns"] == [ns_set get [lindex $column_list $i] "column_name"] } { + set column_info_set [lindex $column_list $i] + set column_constraint_list [ns_set get $column_info_set "constraint_list"] + lappend column_constraint_list $column_constraint + ns_set update $column_info_set "constraint_list" $column_constraint_list + #set column_list [lreplace $column_list $i $i $column_info_set] + set found_p "t" + } + incr i + } + + return $column_list + +} + +ad_proc sb_get_indexes { table_name { html_anchors_p "f" } } {} { + + + set return_string "" + + # + # create statements for non-unique indices + # + + set prev_index "" + + db_foreach sb_get_indexes_select_1 " + select + i.index_name, + i.index_type, + i.uniqueness, + c.column_name + from + user_indexes i, user_ind_columns c + where + i.index_name = c.index_name and + i.table_name = upper(:table_name) + order by + i.index_name, + c.column_position" { + + if { $uniqueness == "NONUNIQUE" } { + # unique indices are written out as constraints + if { $index_name != $prev_index } { + if { $prev_index != "" } { + append return_string ");" + } + append return_string "\nCREATE INDEX [string tolower $index_name] ON [string tolower $table_name]\(" + } else { + append return_string "," + } + append return_string "[string tolower $column_name]" + set prev_index $index_name + } + } + + if { $prev_index != "" } { + append return_string ");" + } + + return $return_string + +} + +ad_proc sb_get_table_description { table_name } {} { + + set html "" + append html "
"
+    append html "\nCREATE TABLE [string tolower $table_name] ("
+ 
+    set column_list [list]
+    set column_info_set [ns_set create]
+    db_foreach schema_browser_index_get_user_table_data "
+        select
+            user_tab_columns.column_name,
+            data_type,
+            data_length,
+            user_col_comments.comments as column_comments,
+            user_tab_columns.data_default,
+            decode(nullable,'N','NOT NULL','') as nullable
+        from
+            user_tab_columns,
+            user_tables,
+            user_col_comments
+        where
+            user_tables.table_name = upper(:table_name) and
+            user_tab_columns.table_name = upper(:table_name) and
+            user_col_comments.table_name(+) =  upper(:table_name) and
+            user_col_comments.column_name(+) = user_tab_columns.column_name
+        order by
+            column_id
+    " -column_set column_info_set {
+
+        lappend column_list [ns_set copy $column_info_set]
+    }
+    ns_set free $column_info_set
+
+    append html "  -- num of columns = [llength $column_list]"
+
+    #
+    # find the column and table constraints
+    #
+    # table_constraint_list -- a list of constraint_info_sets for all constraints involving more than one column
+    set table_constraint_list [list]     
+    
+
+    # current_contraint_info -- a constraint_info_set for the constraint being processed in the loop below
+    set constraint_info [ns_set new]        
+
+    db_foreach schema_browser_index_get_subselect "
+    select  columns.constraint_name,
+            columns.column_name,
+            columns.constraint_type,
+            columns.search_condition,
+            columns.r_constraint_name,
+            decode(columns.constraint_type,'P',0,'U',1,'R',2,'C',3,4) as constraint_type_ordering,
+            parent_columns.table_name as foreign_table_name,
+            parent_columns.column_name as foreign_column_name
+    from    (   
+               select 
+                   col.table_name,
+                   con.constraint_name, 
+                   column_name, 
+                   constraint_type, 
+                   search_condition, 
+                   r_constraint_name,
+                   position 
+               from
+                   user_constraints con,
+                   user_cons_columns col
+               where
+                   con.constraint_name = col.constraint_name
+            ) columns, 
+            user_cons_columns parent_columns
+    where   columns.table_name = upper(:table_name) and
+            constraint_type in ('P','U','C','R') and
+            columns.r_constraint_name = parent_columns.constraint_name(+) and
+            columns.position = parent_columns.position(+)
+    order by
+            constraint_type_ordering,
+            constraint_name,
+            columns.position
+    " {
+	
+	if { $constraint_name != [ns_set get $constraint_info  "constraint_name"] } {
+	    if { [ns_set get $constraint_info "constraint_name"] != "" } {
+		# we've reached a new constraint, so finish processing the old one
+		if { [llength [ns_set get $constraint_info "constraint_columns"]] > 1 } {
+		    # this is a table constraint -- involves more than one column, so add it to the table constraint list
+		    lappend table_constraint_list $constraint_info
+		} else {
+		    # single-column constraint
+		    set column_list [add_column_constraint $column_list $constraint_info]
+		}
+	    }
+	    set constraint_info [ns_set new]
+	    ns_set put $constraint_info "constraint_name" $constraint_name
+	    ns_set put $constraint_info "constraint_type" $constraint_type
+	    ns_set put $constraint_info "constraint_columns" [list $column_name]
+	    ns_set put $constraint_info "search_condition" $search_condition
+	    ns_set put $constraint_info "foreign_columns" $foreign_column_name
+	    ns_set put $constraint_info "foreign_table" $foreign_table_name
+	    ns_set put $constraint_info "r_constraint_name" $r_constraint_name
+	} else {
+	    # same constraint -- add the column to the constraint_column_list
+	    set constraint_columns [ns_set get $constraint_info "constraint_columns"]
+	    lappend constraint_columns $column_name
+	    ns_set update $constraint_info "constraint_columns" $constraint_columns
+	    if { $foreign_column_name != "" } {
+		set foreign_columns [ns_set get $constraint_info "foreign_columns"] 
+		lappend foreign_columns $foreign_column_name
+		ns_set put $constraint_info "constraint_columns" $foreign_columns
+	    }
+	}
+    }
+    
+    # we've run out of rows, but need to flush out the open current_constraint
+    if { [ns_set get $constraint_info "constraint_name"] != "" } {
+	if { [llength [ns_set get $constraint_info "constraint_columns"]] > 1 } {
+	    lappend table_constraint_list $constraint_info
+	} else {
+	    set column_list [add_column_constraint $column_list $constraint_info]
+	}
+    }
+
+    #
+    # write out the columns with associated constraints
+    #
+    
+    set n_column 0
+    set hanging_comment ""
+
+    foreach column $column_list {
+	if { $n_column > 0 } {
+	    append html ","
+	    # flush out a comment on the previous column, if needed
+	    # delayed until after the comma
+	    if { $hanging_comment != "" } {
+		append html " -- $hanging_comment"
+		set hanging_comment ""
+	    }
+	}
+	append html "\n"
+	set column_comments [ns_set get $column "column_comments"]
+	if {$column_comments != ""} {
+	    if { [string length $column_comments] > 40 } {
+		append html "\t-- [string range $column_comments 0 36]..."
+	    } else {
+		append html "\t-- $column_comments"
+	    }
+	}
+	append html "\t[string tolower [ns_set get $column "column_name"]]\t [ns_set get $column "data_type"]([ns_set get $column "data_length"])"
+	if { [ns_set get $column "data_default"] != "" } {
+	    append html " DEFAULT [util_convert_plaintext_to_html [ns_set get $column "data_default"]]"
+	}
+        if { [ns_set get $column "nullable"] != "" } {
+	    append html " [ns_set get $column "nullable"]"
+	}
+        set constraint_list [ns_set get $column "constraint_list"]
+        foreach constraint $constraint_list {
+            set constraint_type [ns_set get $constraint "constraint_type"]
+            if { $constraint_type == "P" } {
+                append html " PRIMARY KEY"
+	    } elseif { $constraint_type == "U" } {
+                append html " UNIQUE"
+	    } elseif { $constraint_type == "R" } {
+                set foreign_table [string tolower [ns_set get $constraint "foreign_table"]]
+                append html " REFERENCES $foreign_table([string tolower [ns_set get $constraint "foreign_columns"]])"
+                set hanging_comment [ns_set get $constraint "constraint_name"]
+	    } elseif { $constraint_type == "C" } {
+                # check constraint  ignore not-null checks
+                # because we already handled them
+                if { [string first "NOT NULL" [ns_set get $constraint "search_condition"]] == -1 } { 
+                    append html "\n\t\tCHECK [ns_set get $constraint "constraint_name"]([ns_set get $constraint "search_condition"])"
+                }
+            } 
+	}
+        incr n_column
+    }
+    if { $hanging_comment != "" } {
+        append html " -- $hanging_comment"
+        set hanging_comment ""
+    }
+
+    #
+    # write out the table-level constraints in the table_constraint_list
+    #
+    
+    foreach constraint $table_constraint_list {
+        set constraint_type [ns_set get $constraint "constraint_type"]
+        set constraint_name [ns_set get $constraint "constraint_name"]
+        set constraint_columns [ns_set get $constraint "constraint_columns"]
+        set foreign_table [string tolower [ns_set get $constraint "foreign_table"]]
+        set foreign_columns [ns_set get $constraint "foreign_columns"]
+        if { $constraint_type == "P" } {
+            append html ",\n\tPRIMARY KEY [ns_set get $constraint "constraint_name"]("
+            append html "[string tolower [join [ns_set get $constraint "constraint_columns"] ","]])"
+	} elseif { $constraint_type == "U"} {
+            append html ",\n\tUNIQUE [ns_set get $constraint "constraint_name"]("
+            append html "[string tolower [join [ns_set get $constraint "constraint_columns"] ","]])"
+        } elseif { $constraint_type == "R"} {
+            append html ",\n\tFOREIGN KEY $constraint_name ("
+            append html "[string tolower [join $constraint_columns ","]])"
+            append html " REFERENCES [string tolower $foreign_table]("
+            append html "[string tolower [join $foreign_columns ","]])"
+	}
+    }
+    
+    append html "\n);"
+    append html [sb_get_indexes $table_name]
+    append html [sb_get_triggers $table_name]
+    append html [sb_get_child_tables $table_name "t"]
+    append html "
" + + return $html + +} + Index: openacs-4/packages/schema-browser/tcl/schema-browser-procs-postgresql.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/schema-browser/tcl/schema-browser-procs-postgresql.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/schema-browser/tcl/schema-browser-procs-postgresql.tcl 15 Sep 2001 00:32:45 -0000 1.1 @@ -0,0 +1,459 @@ +ad_library { + Took these defs out of the /www/doc/schema-browser/index.tcl file. +} + +ad_proc sb_get_tables_list {} { + Get all tables that belong to the current user. +} { + + set tables "" + + db_foreach schema_browser_index_get_tables " + select + pg_class.relname as table_name + from pg_class, pg_user + where pg_user.usename = session_user and + pg_user.usesysid = pg_class.relowner and + pg_class.relkind = 'r' + order by relname + " { + lappend tables $table_name + } + + db_release_unused_handles + return $tables + +} + +ad_proc sb_get_tables { selected_table_name } { + Build an HTML table of all PG tables belonging to the current user. Each PG table + name is returned as a hyperlink to a page which displays the table's structure. +} { + + set n_columns 4 + set return_string "" + + set tables [sb_get_tables_list] + + set n_rows [expr ([llength $tables] - 1) / $n_columns + 1] + + append return_string "" + for { set row 0 } { $row < $n_rows } { incr row } { + append return_string "" + for {set column 0} {$column < $n_columns} {incr column} { + set i_element [expr $n_rows * $column + $row] + if { $i_element < [llength $tables] } { + set table_name [lindex $tables $i_element] + if { $table_name == $selected_table_name } { + append return_string "" + } else { + append return_string "" + } + } + + } + append return_string "" + } + + append return_string "
[string tolower $table_name][string tolower $table_name]
" + + return $return_string + +} + +ad_proc sb_get_triggers { table_name } { + Get all non-RI triggers on the table. +} { + set return_string "\n" + db_foreach sb_get_triggers_select_1 " + select + tgname as trigger_name, + trigger_type(tgtype) as trigger_type, + case tgenabled when 't' then '' else '(disabled)' end as status, + proname, + tgfoid + from + pg_trigger t join (select oid from pg_class where relname = lower(:table_name)) c + on (c.oid = t.tgrelid) + join pg_proc p on (p.oid = t.tgfoid) + where not tgisconstraint + " { + append return_string "\nCREATE TRIGGER $trigger_name $trigger_type EXECUTE PROCEDURE $proname $status" + } if_no_rows { + set return_string "" + } + return $return_string +} + +ad_proc sb_get_child_tables { table_name {html_anchor_p "f"} } { + Build an HTML snippet listing all tables which have at least one foreign key + referring to table_name. +} { + + set return_string "\n\n-- Tables with foreign keys that refer to $table_name:" + db_foreach schema_browser_get_referencess " + select distinct r1.relname as child_table, + t.tgconstrname as constraint_name + from + pg_trigger t, + pg_class r, + pg_class r1, + pg_proc p + where + lower(r.relname) = lower(:table_name) and + r.oid = t.tgconstrrelid and + r1.oid = t.tgrelid and + t.tgisconstraint and + t.tgfoid = p.oid and + p.proname = 'RI_FKey_check_ins' + " { + if { $html_anchor_p == "t" } { + append return_string "\n--[string tolower $child_table]" + } else { + append return_string "\n--[string tolower $child_table]" + } + if { ![string equal $constraint_name ""] } { + append return_string "($constraint_name)" + } + } if_no_rows { + set return_string "" + } + return $return_string +} + +ad_proc sb_get_indexes { table_name { html_anchors_p "f" } } { + Create statements for indexes on table_name. +} { + + + set return_string "\n" + set prev_index "" + + set indexes [db_list_of_lists sb_get_indexes_select_1 " + select + relname as index_name, + case when indisunique then ' UNIQUE' else NULL end as uniqueness, + amname as index_type, + indkey + from + pg_index i join (select oid from pg_class where relname = lower(:table_name)) c + on (i.indrelid = c.oid) + join pg_class index_class on (index_class.oid = i.indexrelid and not i.indisprimary) + join pg_am a on (index_class.relam = a.oid) + order by index_name"] + + foreach index $indexes { + foreach {index_name uniqueness index_type indkey} $index {} + + set index_clause "([join [split $indkey " "] ","])" + + append return_string "\nCREATE$uniqueness INDEX [string tolower $index_name] ON [string tolower $table_name] (" + set sep "" + + db_foreach sb_get_indexes_select_2 " + select + a.attname as column_name + from + (select oid from pg_class where relname = lower(:table_name)) c + join pg_attribute a on (c.oid = a.attrelid) + where a.attnum in $index_clause + " { + append return_string $sep$column_name + set sep ", " + } + append return_string ");" + } + + return $return_string +} + +ad_proc sb_get_foreign_keys { table_name } { + + @author Don Baccus (though he hates to admit to writing such ugly code) + + Build a list describing all foreign keys on table_name and their actions. + We ignore MATCH conditions because Oracle doesn't support them, therefore + OpenACS doesn't use them. Same is true of SET NULL and SET DEFAULT actions + hung on ON DELETE/ON UPDATE subclauses, but since Oracle *does* support + CASCADE as an action I had figure out how to grab this info from the system + catalog anyway. + + This code is *horribly* convoluted, mostly a result of the non-obvious way + that the needed information is organized in the PG system catalogs. + + Feel free to clean this up if you want! + +} { + set complex_foreign_keys [list] + db_foreach schema_browser_get_referencess " + select t.tgargs as constraint_args, + t.tgconstrname as constraint_name, + 'NOACTION' as action, + 'CHECK' as trigger_kind, + r1.relname as refer_table, + t.oid as oid, + 0 as sort_key + from + pg_trigger t, + pg_class r, + pg_class r1, + pg_proc p + where + lower(r.relname) = lower(:table_name) and + r.oid = t.tgrelid and + r1.oid = t.tgconstrrelid and + t.tgisconstraint and + t.tgfoid = p.oid and + p.proname = 'RI_FKey_check_ins' + union all + select t.tgargs as constraint_args, + t.tgconstrname as constraint_name, + case + when p.proname like '%noaction%' then 'NOACTION' + when p.proname like '%cascade%' then 'CASCADE' + when p.proname like '%setnull%' then 'SET NULL' + when p.proname like '%setdefault%' then 'SET DEFAULT' + end as action, + case + when p.proname like '%upd' then 'ON UPDATE' + when p.proname like '%del' then 'ON DELETE' + end as trigger_kind, + r1.relname as refer_table, + t.oid as oid, + 1 as sort_key + from + pg_trigger t, + pg_class r, + pg_class r1, + pg_proc p + where + lower(r.relname) = lower(:table_name) and + r.oid = t.tgconstrrelid and + r1.oid = t.tgrelid and + t.tgisconstraint and + t.tgfoid = p.oid and + not p.proname like 'RI%_check_%' + order by oid, sort_key + " { + set one_ri_datum [list] + set arg_start 0 + while { ![empty_string_p $constraint_args] } { + set arg_end [expr [string first "\\000" $constraint_args] - 1] + lappend one_ri_datum [string range $constraint_args $arg_start $arg_end] + set constraint_args [string range $constraint_args [expr $arg_end+5] end] + } + switch $trigger_kind { + CHECK { + if { [info exists foreign_key_sql] } { + if { $arg_count == 1 } { + set references($on_var) $foreign_key_sql + } else { + lappend complex_foreign_keys $foreign_key_sql + } + } + if { [string equal $constraint_name ""] } { + set foreign_key_sql "" + } else { + set foreign_key_sql "CONSTRAINT $constraint_name " + } + set on_var_part "" + set refer_var_part "" + set sep "" + set arg_count 0 + foreach { on_var refer_var } [lrange $one_ri_datum 4 end] { + append refer_var_part "$sep$refer_var" + append on_var_part "$sep$on_var" + set sep ", " + incr arg_count + } + if { $arg_count > 1 } { + append foreign_key_sql "FOREIGN KEY ($on_var_part) " + } + append foreign_key_sql "REFERENCES $refer_table ($refer_var_part)" + } + default { + if { ![string equal $action "NOACTION"] } { + append foreign_key_sql " $trigger_kind $action" + } + } + } + } + if { [info exists foreign_key_sql] } { + if { $arg_count == 1 } { + set references($on_var) $foreign_key_sql + } else { + lappend complex_foreign_keys $foreign_key_sql + } + } + return [list [array get references] $complex_foreign_keys] +} + +ad_proc sb_get_table_description { table_name } {} { + + set foreign_keys [sb_get_foreign_keys $table_name] + array set references [lindex $foreign_keys 0] + set complex_foreign_keys [lindex $foreign_keys 1] + + set html "
"
+    append html "\nCREATE TABLE [string tolower $table_name] ("
+
+    if { [db_0or1row sb_get_primary_key "
+            select
+              indkey as primary_key_array
+            from
+              pg_index i join (select oid from pg_class where relname = lower(:table_name)) c
+                on (i.indrelid = c.oid)
+              join pg_class index_class on (index_class.oid = i.indexrelid and i.indisprimary)
+              join pg_am a on (index_class.relam = a.oid)"] } {
+        set primary_key_columns [split $primary_key_array " "]
+    } else {
+        set primary_key_columns [list]
+    }
+
+    set column_list [list]
+    set column_info_set [ns_set create]
+
+    # DRB: This changes some PG internal types into SQL92 standard types for readability's
+    # sake.
+
+    db_foreach schema_browser_index_get_user_table_data "
+        select
+            a.attname as column_name,
+            case when t.typlen = -1 and t.typname <> 'numeric'
+              then a.atttypmod - 4
+              else NULL
+            end as data_length,
+            case when t.typname = 'numeric'
+              then a.atttypmod::int4 & 65535 - 4
+              else NULL
+            end as scale,
+            case
+              when t.typname = 'numeric'
+              then (a.atttypmod::int4 >> 16) & 65535
+              else NULL
+            end as precision,
+            case t.typname
+              when 'int4' then 'integer'
+              when 'bpchar' then 'char'
+              else t.typname 
+            end as data_type,
+            d.description as column_comments,
+            ad.adsrc as data_default,
+            substr(lower(:table_name),1,15) || '_' || substr(lower(a.attname),1,15) as column_constraint_key,
+            case a.attnotnull when true then 'NOT NULL' else '' end as nullable,
+            a.attnum as column_number
+        from (select oid from pg_class where relname=lower(:table_name)) c
+             join pg_attribute a on (c.oid = a.attrelid and a.attnum > 0)
+             join pg_type t on (a.atttypid = t.oid)
+             left join pg_attrdef ad on (a.attrelid = ad.adrelid and a.attnum = ad.adnum)
+             left join pg_description d on (a.oid = d.objoid)
+        order by a.attnum" -column_set column_info_set {
+
+        lappend column_list [ns_set copy $column_info_set]
+    }
+    ns_set free $column_info_set
+
+    # current_contraint_info -- a constraint_info_set for the constraint being processed in the loop below
+    set check_constraint_set [ns_set create]
+    db_foreach schema_browser_index_get_subselect "
+        select
+          rcname as constraint_name,
+          rcsrc as constraint_source
+        from
+         pg_relcheck r join (select oid from pg_class where relname = lower(:table_name)) c
+           on (c.oid = r.rcrelid)
+        order by constraint_name
+    " {
+        ns_set put $check_constraint_set $constraint_name $constraint_source
+    }
+
+    #
+    # write out the columns with associated constraints
+    #
+    
+    set n_column 0
+
+    foreach column $column_list {
+	if { $n_column > 0 } {
+	    append html ","
+	}
+	set column_comments [ns_set get $column "column_comments"]
+	if {$column_comments != ""} {
+            set comment_list [split $column_comments "\n"]
+            append html "\n\t--[join $comment_list "\n\t-- "]"
+	}
+	append html "\n"
+	append html "\t[string tolower [ns_set get $column column_name]]\t [ns_set get $column data_type]"
+        if { ![empty_string_p [ns_set get $column data_length]] } {
+            append html "([ns_set get $column data_length])"
+        }
+        if { ![empty_string_p [ns_set get $column precision]] } {
+            append html "([ns_set get $column precision], [ns_set get $column scale])"
+        }
+        if { [llength $primary_key_columns] == 1 && [lindex $primary_key_columns 0] == [ns_set get $column column_number] } {
+            append html " PRIMARY KEY"
+        }
+	if { [ns_set get $column "data_default"] != "" } {
+	    append html " DEFAULT [util_convert_plaintext_to_html [ns_set get $column "data_default"]]"
+	}
+        if { [ns_set get $column "nullable"] != "" } {
+	    append html " [ns_set get $column "nullable"]"
+	}
+
+        if { [info exists references([ns_set get $column column_name])] } {
+            append html " $references([ns_set get $column column_name])"
+        }
+
+        if { ![empty_string_p [ns_set get $check_constraint_set [ns_set get $column column_constraint_key]]] } {
+            append html "\n\t\t\tCHECK [ns_set get $check_constraint_set [ns_set get $column column_constraint_key]]"
+            ns_set delkey $check_constraint_set [ns_set get $column column_constraint_key]
+        }
+
+        incr n_column
+    }
+
+    #
+    # write out the table-level constraints in the table_constraint_list
+    #
+    
+    for { set i 0 } { $i < [ns_set size $check_constraint_set] } { incr i } {
+        if { ![empty_string_p [ns_set value $check_constraint_set $i]] } {
+            append html ",\n	"
+            if { [string first "\$" [ns_set key $check_constraint_set $i]] == -1 } {
+                append html "CONSTRAINT [ns_set key $check_constraint_set $i]\n	"
+            }
+            append html "CHECK [ns_set value $check_constraint_set $i]"
+        }
+    }
+    
+    if { [llength $primary_key_columns] > 1 } {
+        append html ",\n\tPRIMARY KEY ("
+        set sep ""
+    
+        db_foreach sb_get_primary_key_select_2 "
+            select
+              a.attname as column_name 
+            from
+              (select oid from pg_class where relname = lower(:table_name)) c
+              join pg_attribute a on (c.oid = a.attrelid)
+              where a.attnum in ([join $primary_key_columns ","])
+        " {
+            append html $sep$column_name
+            set sep ", "
+        }
+        append html ")"
+    }
+
+    foreach complex_foreign_key $complex_foreign_keys {
+        append html ",\n\t$complex_foreign_key"
+    }
+
+    append html "\n);"
+    append html [sb_get_indexes $table_name]
+    append html [sb_get_triggers $table_name]
+    append html [sb_get_child_tables $table_name "t"]
+    append html "
" + + return $html + +} Fisheye: Tag 1.2 refers to a dead (removed) revision in file `openacs-4/packages/schema-browser/tcl/schema-browser-procs.tcl'. Fisheye: No comparison available. Pass `N' to diff? Index: openacs-4/packages/schema-browser/www/column-comments-2-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/schema-browser/www/column-comments-2-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/schema-browser/www/column-comments-2-oracle.xql 15 Sep 2001 00:32:45 -0000 1.1 @@ -0,0 +1,12 @@ + + +oracle8.1.6 + + + + comment on column ${table_name}.$column_name is :comments + + + + + Index: openacs-4/packages/schema-browser/www/column-comments-2-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/schema-browser/www/column-comments-2-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/schema-browser/www/column-comments-2-postgresql.xql 15 Sep 2001 00:32:45 -0000 1.1 @@ -0,0 +1,12 @@ + + +postgresql7.1 + + + + comment on column ${table_name}.$column_name is :comments + + + + + Index: openacs-4/packages/schema-browser/www/function-body-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/schema-browser/www/function-body-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/schema-browser/www/function-body-postgresql.xql 15 Sep 2001 00:32:45 -0000 1.1 @@ -0,0 +1,18 @@ + + +postgresql7.1 + + + + + select + prosrc + from + pg_proc + where + oid = :oid + + + + + Index: openacs-4/packages/schema-browser/www/function-body.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/schema-browser/www/function-body.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/schema-browser/www/function-body.tcl 15 Sep 2001 00:32:45 -0000 1.1 @@ -0,0 +1,31 @@ +ad_page_contract { + This is file /www/doc/schema-browser/function-body.tcl. Currently + it only handles Postgres function bodies, and is called on to + expand function bodies referenced by triggers. + + @param oid The oid of the pg_proc entry + + @author Don Baccus + @creation-date September, 2001 + +} { + oid:notnull,integer +} + + +set html "[ad_header "[ad_system_name] One Trigger's Function Body "] + +

[ad_system_name] Schema Browser

+[ad_context_bar_ws [list index.tcl "Schema Browser"] "One Trigger's Function Body"] +" + + +db_1row function_body "" + +append html " +
+
$prosrc
+[ad_footer] +" + +doc_return 200 text/html $html Index: openacs-4/packages/schema-browser/www/trigger-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/schema-browser/www/Attic/trigger-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/schema-browser/www/trigger-oracle.xql 15 Sep 2001 00:32:45 -0000 1.1 @@ -0,0 +1,24 @@ + + +oracle8.1.6 + + + + + + + select + table_name, + trigger_type, + triggering_event, + status, + trigger_body + from + user_triggers + where + trigger_name = upper(:trigger_name) + + + + + Index: openacs-4/packages/schema-browser/www/trigger-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/schema-browser/www/Attic/trigger-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/schema-browser/www/trigger-postgresql.xql 15 Sep 2001 00:32:45 -0000 1.1 @@ -0,0 +1,22 @@ + + +postgresql7.1 + + + + + select + table_name, + trigger_type, + triggering_event, + status, + trigger_body + from + user_triggers + where + trigger_name = upper(:trigger_name) + + + + +