Listing 2. Tkl Procedure for Database Changes

#!/usr/bin/pgtksh
proc doClear {} {
    global field1 field2 field3 field4 field5
    for {set j 1} {$j <= 5} {incr j} {
        set field$j ""
    }
}

proc doNext {} {
    global  conn res loid curoid
    global  field1 field2 field3 field4 field5
    set x [llength $loid]
    incr x -1
    set j [lsearch -exact $loid $curoid]
    if {$j >= $x } {
        set j $x
    } else {
        incr j
    }
    set curoid [lindex $loid $j]
    set res [pg_exec $conn "select *,oid from schedule where oid = $curoid"]
    set list [pg_result $res -getTuple 0]
    pg_result $res -clear
    for { set i 1} {$i <= 5} {incr i} {
        set j $i
        set j [incr j -1]
        set field$i [lindex $list $j]
    }
    set curoid [lindex $list 5]
}

proc doLast {} {
    global  conn res loid curoid
    global  field1 field2 field3 field4 field5
    set x [llength $loid]
    set j [lsearch -exact $loid $curoid]
    if {$j <= 0 } {
        set j 0
    } else {
        incr j -1
    }
    set curoid [lindex $loid $j]
    set res [pg_exec $conn "select *,oid from schedule where oid = $curoid"]
    set list [pg_result $res -getTuple 0]
    pg_result $res -clear
    for { set i 1} {$i <= 5} {incr i} {
        set j $i
        set j [incr j -1]
        set field$i [lindex $list $j]
    }
    set curoid [lindex $list 5]
}

proc doExit {} {
    global conn

    pg_disconnect $conn
    exit
}

proc doQuery {} {
    global  conn loid curoid
    global  field1 field2 field3 field4 field5

    if {[string length $field3] > 0 } {
        set res [pg_exec $conn "select *,oid from schedule where program = \'$field3\'"]
    } else {
        set res [pg_exec $conn "select *,oid from schedule where oid = [lindex $loid 0]" ]
    }
        set list [pg_result $res -getTuple 0]
        pg_result $res -clear
        for { set i 1} {$i <= 5} {incr i} {
                set j $i
                set j [incr j -1]
                set field$i [lindex $list $j]
        }
        set curoid [lindex $list 5]
    }

proc openSocket {} {
    global conn
    set conn [pg_connect -conninfo "host=crabapple dbname=jim user=jim"]
}

proc doDelete {} {
    global conn curoid
    set res [pg_exec $conn "delete from schedule where oid = $curoid" ]
    pg_result $res -clear
    doClear
    Initialize
}

proc doUpdate {} {
    global conn curoid
    global field1 field2 field3 field4 field5
    set res [pg_exec $conn "update schedule set days = \'$field1\', \
             time = \'$field2\',program = \'$field3\',checkprog = \'$field4\', \
             didrun = \'$field5\' where oid = $curoid "]
    pg_result $res -clear
}	

proc Initialize {} {
    global conn loid
    set res [pg_exec $conn "select oid from schedule"]
    set ntups [pg_result $res -numTuples]
    catch [unset loid] result
    for {set i 0} {$i < $ntups } {incr i} {
        lappend loid [pg_result $res -getTuple $i]
    }
    set curoid [lindex $loid 0]
    pg_result $res -clear
    
}

proc doAdd {} {
    global conn field1 field2 field3 field4 field5
    set res [pg_exec $conn "insert into schedule values (\'$field1\', \
             \'$field2\',\'$field3\',\'$field4\',\'$field5\') "]
    pg_result $res -clear
    Initialize
}
    
proc makeWindow {} {
    global conn

    set fo1 -*-fixed-bold-r-*-*-16-*-*-*-*-*-*-*
    set fo2 -*-courier-bold-r-*-*-16-*-*-*-*-*-*-*
    set colour grey

    frame .f1
    pack .f1 -anchor nw
    label .f1.l1 -text "         Days" -font $fo1
    entry .f1.e1 -width 7 -relief sunken -bd 2 -textvariable field1 -font $fo2
    pack .f1.l1 .f1.e1 -side left
    frame .f2
    pack .f2 -anchor nw
    label .f2.l2 -text "         Time" -font $fo1
    entry .f2.e2 -width 5 -relief sunken -bd 2 -textvariable field2 -font $fo2
    pack .f2.l2 .f2.e2 -side left
    frame .f3
    pack .f3 -anchor nw
    label .f3.l2 -text "      Program" -font $fo1
    entry .f3.e2 -width 50 -relief sunken -bd 2 -textvariable field3 -font $fo2
    pack .f3.l2 .f3.e2 -side left
    frame .f4
    pack .f4 -anchor nw
    label .f4.l2 -text "Check Program" -font $fo1
    entry .f4.e2 -width 50 -relief sunken -bd 2 -textvariable field4 -font $fo2
    pack .f4.l2 .f4.e2 -side left
    frame .f5
    pack .f5 -anchor nw
    label .f5.l2 -text "       Didrun" -font $fo1
    entry .f5.e2 -width 1 -relief sunken -bd 2 -textvariable field5 -font $fo2
    pack .f5.l2 .f5.e2 -side left
    frame .f6
    pack .f6 -anchor nw
    button .f6.b1 -text "Query" -command doQuery
    button .f6.b2 -text "Next" -command doNext
    button .f6.b3 -text "Previous" -command doLast
    button .f6.b4 -text "Add" -command doAdd
    button .f6.b5 -text "Delete" -command doDelete
    button .f6.b6 -text "Update" -command doUpdate
    button .f6.b7 -text "Clear" -command doClear
    button .f6.b8 -text "Exit" -command doExit
    pack .f6.b1 .f6.b2 .f6.b3 .f6.b4 .f6.b5 .f6.b6 .f6.b7 .f6.b8 -side left
}

###################
# Main proc
###################

wm title . "Schedule  Maintenance"
wm geometry . 500x200+10+10
openSocket
Initialize
makeWindow