Pragana's Tcl Guide

Old notes

• 01Dec98  accessing the web
• 23Nov98  creating widgets
• 12Nov98  subst command

Integrating with a database

We are going to look this week at a simple use for the pgtcl interface. Let us leave pl/tcl to another time.

Programming with pgtcl is very easy. We begin opening a connection to our postgres server at the default port 5432., (proc changeDB) and saving the return code (something like a file handle in open). Of course, if another connection was in use, we close it before opening the new connection. (We could have several connections at a time, anyway)

All queries go through pg_exec with the connection and the text of the query as arguments. This function returns a result that can be analysed further with pg_result in several ways. In our example, we process the query result only with -numTuples to get how many tuples we got back from the server, and -getTuple to read one tuple  at a time.
There are functions to retrieve everything as a tcl array,  to execute a tcl procedure with each tuple returned, and more. Please check the documents in the PostgreSQL release to find out.

To get all tables and fields available is a matter of query the system catalogs. This is done in the procedure showTables.
If you want to go further, please look for my program sqlforms at Sunsite. It allows you visually design a form with entries and labels (also lines, rectangles and other items) and assign table attributes to each entry.

#!/usr/local/pgsql/bin/pgtksh -f

set conn ""

pack [frame .ft] [frame .fm] [frame .fb] -side top
pack [label .ft.l -font {Helvetica 14 bold} -text database] \
    [entry .ft.e -font {Helvetica 14 bold} -width 40 -textvariable newdb] \
    [button .ft.tabelas -font {Helvetica 14 bold} -text tabelas -command showTa
    [button .ft.clear -font {Helvetica 14 bold} -text limpa -command {
        .fb.t delete 0.0 end}] \
    [button .ft.exit -font {Helvetica 14 bold} -text exit -command {
        if {$conn != ""} { pg_disconnect $conn } ;destroy . }] -side left
pack [label .fm.l -font {Helvetica 14 bold} -text query] \
    [entry .fm.e -font {Helvetica 14 bold} -width 60 -textvariable qry] -side l
pack [text .fb.t -width 90 -font {Courier 14 bold} -yscrollcommand {.fb.sb set}
    -fill both -side left -expand 1
pack [scrollbar .fb.sb -command {.fb.t yview}] -expand 1 -fill y
    
bind .ft.e <Return> changeDB
bind .fm.e <Return> {query $qry}

proc changeDB {} {
    global conn newdb
    if {$conn != ""} { pg_disconnect $conn }
    set conn [pg_connect $newdb]
    focus .fm.e
}
proc showTables {} {
    global conn
    set qry "select c.relname,a.attname,t.typname,a.attlen,c.oid,a.oid \
        from pg_class c, pg_attribute a, pg_type t \
        where c.relkind = 'r' \
            and c.relname !~ '^pg_' \
            and a.attnum > 0 \
            and a.attrelid = c.oid \
            and a.atttypid = t.oid \
        order by c.oid,a.oid"
    set res [pg_exec $conn $qry]
    set ntups [pg_result $res -numTuples]
    .fb.t insert end "\n     relname            attname             "
    .fb.t insert end "typname       attlen r(oid) a(oid)\n"
    .fb.t insert end "----------------------------------------------"
    .fb.t insert end "----------------------------------"
    for {set i 0} {$i < $ntups} {incr i} {

        set j 0
        foreach fld [pg_result $res -getTuple $i] {
            if {$j <= 2} {
                .fb.t insert end [format "%-20.20s" $fld]
            } {
                .fb.t insert end [format "%6.6s" $fld]
            }
            incr j
        }
        .fb.t insert end \n
    }
    .fb.t insert end "----------------------------------------------\n"
    .fb.t see end

}

proc query {qry} {
    global conn
    set res [pg_exec $conn $qry]
    set ntups [pg_result $res -numTuples]
    for {set i 0} {$i < $ntups} {incr i} {
        .fb.t insert end "Tupla $i:"
        .fb.t insert end [pg_result $res -getTuple $i]
        .fb.t insert end \n
    }
    .fb.t insert end "----------------------------------------------\n"
    .fb.t see end
}