db-table-info.tcl

Location:
/packages/acs-subsite/www/admin/system/db-table-info.tcl
Author:

peter.alberer@wu.wien.ac.at

Created:

2004-02-05
File Contents

ad_page_contract {

  @author peter.alberer@wu.wien.ac.at
  @creation-date 2004-02-05
} {
  table:notnull
} -validate {    
    table_exists -requires {table:notnull} {
        if {![regexp {^(.*?)\.(.*)$} $table _ namespace table]} {
            set namespace "public"
            set table $table
        } 
        
        set sql {
            select
                c.oid,
                c.relname,
                n.nspname
            from pg_class c inner join pg_namespace n on c.relnamespace = n.oid
            where n.nspname=:namespace and c.relname=:table and c.relkind in ('r','v')
        }
        
        if {![db_0or1row check_table $sql]} {
            ad_complain "Table $table not found"
            return
        }
    }
}

Class SQL_Analyzer -parameter { incoming_sql sql textarea_rows textarea_cols }
Class SQL_Analyzer::Element -parameter { color bold toupper underline italic }
Class SQL_Analyzer::Unknown -superclass SQL_Analyzer::Element -parameter { candidates }

SQL_Analyzer::Element instproc unknown args  {
    [:info parent] instvar mode
    :$mode $args
}

SQL_Analyzer::Element instproc exists args  {
    [:info parent] instvar mode
    :$mode exists
}

SQL_Analyzer::Unknown instproc highlight { label }  {
    #ns_log Notice "SEARCHING: $label -> [:info parent] exists tables($label)"
    if { [[:info parent] exists tables($label)] } {
        set label "<a href='table-info?table=$label'>$label</a>"
        #ns_log Notice "FOUND TABLE: $label"
        return [next $label]
    }
    return $label
}

SQL_Analyzer::Element instproc highlight { label } {
    :instvar color bold toupper underline italic
    set output $label
    if { $toupper == 1 } { set output [string toupper $output] }
    set output "<font color='$color'>$output</font>"
    if { $bold == 1 } { set output "<b>$output</b>" }
    if { $underline == 1 } { set output "<u>$output</u>" }
    if { $italic == 1 } { set output "<i>$output</i>" }
    return $output
}

SQL_Analyzer instproc init {} {
    # create subobjects for the processing of sql substrings
    
    # sql commands
    SQL_Analyzer::Element [self]::Command \
        -color "black" -bold 1 -toupper 1 -underline 0 -italic 0
    
    # sql keywords
    SQL_Analyzer::Element [self]::Keyword \
        -color "black" -bold 1 -toupper 1 -underline 0 -italic 0
    
    # sql operators
    SQL_Analyzer::Element [self]::Operator \
        -color "red" -bold 1 -toupper 0 -underline 0 -italic 0
    
    # sql fields
    SQL_Analyzer::Element [self]::Field \
        -color "blue" -bold 0 -toupper 0 -underline 0 -italic 0
    
    # fixed values
    SQL_Analyzer::Element [self]::FixedValue \
        -color "green" -bold 0 -toupper 0 -underline 1 -italic 0
        
    # fixed values
    SQL_Analyzer::Element [self]::Function \
        -color "purple" -bold 0 -toupper 0 -underline 0 -italic 1

    # unknown values
    SQL_Analyzer::Unknown [self]::Unknown \
        -color "darkred" -bold 1 -toupper 0 -underline 1 -italic 0
        
    # postgres special values
    SQL_Analyzer::Element [self]::PostgresSpecial \
        -color "green" -bold 0 -toupper 0 -underline 1 -italic 0
}

SQL_Analyzer instproc regex {} {
    :instvar incoming_sql sql
    # clean the sql string, remove adjacent white spaces
    regsub -all {[[:blank:]]+} $incoming_sql { } sql
    # now apply some regular expressions, that insert commands into the sql text
    # those commands are used for substing the whole text later on
    regsub -all -nocase {\m(and|or|on|in|not|like|on|as|inner|join|by|is|desc|exists|null)\M} $sql {[[self]::Keyword \1]} sql
    regsub -all -nocase {\m(select|from|where|order|having|group|union|distinct)\M} $sql {[[self]::Command \1]} sql
    regsub -all -nocase {\m(current_timestamp|offset|limit|)\M} $sql {[[self]::PostgresSpecial \1]} sql
    regsub -all {(=|<>|<|>)} $sql {[[self]::Operator \1]} sql
    regsub -all {('[[:alnum:][:blank:]_\-:]*')} $sql {[[self]::FixedValue \1]} sql
    regsub -all {\m([[:digit:]]+)\M(?!')} $sql {[[self]::FixedValue \1]} sql
    regsub -all {([[:alnum:]_]+\.[[:alnum:]_]+)} $sql {[[self]::Field \1]} sql
    regsub -all {\m([[:alnum:]_]+)\M\(} $sql {[[self]::Function \1](} sql
    regsub -all { \m([[:alnum:]_]+)\M([[:blank:],\n])} $sql { [[self]::Unknown \1]\2} sql
}

SQL_Analyzer instproc get_table_list {} {
    # get a list of all tables in the database
    db_foreach get_data {
        SELECT c.relname,
        CASE c.relkind WHEN 'r' THEN 'table' WHEN 'v' THEN 'view' END as type
        FROM pg_catalog.pg_class c
        LEFT JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace
        WHERE c.relkind IN ('r','v')
        AND n.nspname NOT IN ('pg_catalog', 'pg_toast')
        AND pg_catalog.pg_table_is_visible(c.oid)
        ORDER BY 1,2;
    } {
        set :tables($relname) $type
    }
}

SQL_Analyzer instproc process { mode } {
    set :mode $mode
    return [subst [:sql]]
}

SQL_Analyzer instproc analyze { sql } {
    set :incoming_sql $sql
    :regex
    :get_table_list
    return [:process "highlight"]
}

SQL_Analyzer proc analyze { sql } {
    #set s [:new -childof [self] -volatile]
    set s [:new -childof [self]]
    return [$s analyze $sql]
}

set table "^${table}\$"

# get name of table and schema
# db_1row get_data {
#     SELECT c.oid,
#       n.nspname,
#       c.relname
#     FROM pg_catalog.pg_class c
#          LEFT JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace
#     WHERE pg_catalog.pg_table_is_visible(c.oid)
#           AND c.relname ~ :table
#     ORDER BY 2, 3;
# }


# get the description for this table

set database_object_description [db_string db_obj_description "select obj_description(:oid,'pg_class')" -default ""]

# details about table (has indices..)
db_1row get_data {
    SELECT relhasindex, relkind, relchecks, relhastriggers, relhasrules,
    relhasoids , reltablespace
    FROM pg_catalog.pg_class WHERE oid = :oid
}

# get the definition of the view
if { $relkind eq "v" } {
    set view_def [db_string get_data "SELECT pg_catalog.pg_get_viewdef(:oid::pg_catalog.oid, true)"]
    set show_view_def [SQL_Analyzer analyze $view_def]
}

# get the columns of the table
db_multirow columns get_data {
    SELECT a.attname,
      pg_catalog.format_type(a.atttypid, a.atttypmod),
      (SELECT substring(d.adsrc for 128) FROM pg_catalog.pg_attrdef d
       WHERE d.adrelid = a.attrelid AND d.adnum = a.attnum AND a.atthasdef) as default,
      a.attnotnull, a.attnum,
       col_description(:oid,a.attnum) as col_description 
    FROM pg_catalog.pg_attribute a
    WHERE a.attrelid = :oid AND a.attnum > 0 AND NOT a.attisdropped
    ORDER BY a.attnum
}

# get the indices of the table
db_multirow indices get_data {
    SELECT c2.relname, i.indisprimary, i.indisunique, i.indisclustered, pg_catalog.pg_get_indexdef(i.indexrelid, 0, true)
    FROM pg_catalog.pg_class c, pg_catalog.pg_class c2, pg_catalog.pg_index i
    WHERE c.oid = :oid AND c.oid = i.indrelid AND i.indexrelid = c2.oid
    ORDER BY c2.relname
}

# get the triggers for the table
db_multirow triggers get_data {
    SELECT t.tgname, pg_catalog.pg_get_triggerdef(t.oid)
    FROM pg_catalog.pg_trigger t
    WHERE t.tgrelid = :oid AND (not tgisinternal  OR NOT EXISTS  (SELECT 1 FROM pg_catalog.pg_depend d    JOIN pg_catalog.pg_constraint c ON (d.refclassid = c.tableoid AND d.refobjid = c.oid)    WHERE d.classid = t.tableoid AND d.objid = t.oid AND d.deptype = 'i' AND c.contype = 'f'))
} {
    regsub {([^\s]*?)\(\)$} $pg_get_triggerdef { <a href='/api-doc/plsql-subprogram-one?type=FUNCTION\&name=\1'>\1()</a>} pg_get_triggerdef
}

# # get the foreign key references for the table
# db_multirow foreigns get_data {
#     SELECT conname,
#       pg_catalog.pg_get_constraintdef(oid, true) as condef
#     FROM pg_catalog.pg_constraint r
#     WHERE r.conrelid = :oid AND r.contype = 'f'
# }

# get all other table constraints
db_multirow table_constraints get_data {
    SELECT conname,
        r.contype,
      pg_catalog.pg_get_constraintdef(oid, true) as condef
    FROM pg_catalog.pg_constraint r
    WHERE r.conrelid = :oid
    order by r.contype, conname
} {
    if {$contype == "f"} {
        regsub {\s{1}([^\s(]+)\(} $condef { <a href='db-table-info?table=\1'>\1</a>(} condef
    }

}
 
# get all foreign keys that reference this table
db_multirow foreign_keys get_data {
    SELECT conname,
      pg_catalog.pg_get_constraintdef(oid, true) as condef,
      (select relname from pg_class p where p.oid = r.conrelid) as table_name
    FROM pg_catalog.pg_constraint r
    WHERE r.confrelid = :oid and r.contype='f'
    order by table_name, conname
} 
# get the statistics for this table
db_multirow stats get_stat_data {
    select * from  pg_stats where tablename ~ :table
}

# get the data from the statistics collector for this table
db_multirow collector_stats get_data {
    select * from pg_stat_all_tables where schemaname=:nspname and relname=:relname
}

list::create \
    -name "collector_stats" \
    -multirow "collector_stats" \
    -no_data "Keine Daten vorhanden" \
    -page_flush_p t \
    -elements {
        schemaname {label "schemaname"}
        relname {label "relname"}
        seq_scan {label "seq_scan"}
        seq_tup_read {label seq_tup_read}
        idx_scan {label "idx_scan"}
        idx_tup_fetch {label "idx_tup_fetch"}
        n_tup_ins {label "n_tup_ins"}
        n_tup_upd {label "n_tup_upd"}
        n_tup_del {label "n_tup_del"}
        last_vacuum {label "last_vacuum"}
        last_autovacuum {label "last_autovacuum"}
        last_analyze {label "last_analyze"}
        last_autoanalyze {label "last_autoanalyze"}
    }

# disk usage

db_multirow disk_usage get_disk_usage {
    select relname,
           relpages,
           pg_size_pretty(pg_relation_size(oid))
    from pg_class
    where oid=:oid
}
# TOAST disk usage

db_multirow -append disk_usage get_toast_disk_usage {
    SELECT relname, 
           relpages, 
           pg_size_pretty(pg_relation_size(oid))
    FROM pg_class,
         (SELECT reltoastrelid FROM pg_class
          WHERE oid = :oid) ss
    WHERE oid = ss.reltoastrelid
       OR oid = (SELECT reltoastidxid FROM pg_class
                 WHERE oid = ss.reltoastrelid)
    ORDER BY relname}

list::create \
    -name "disk_usage" \
    -multirow "disk_usage" \
    -no_data "Keine Daten vorhanden" \
    -page_flush_p t \
    -elements {
        relname {label "relname"}
        relpages {label "relpages"}
        pg_size_pretty {label "pg_size_pretty"}
    }    

    
ad_return_template
db-table-info.tcl

Related Files

File Contents
