From: Jan Wieck <jwieck@debis.com>

    A few minutes ago I sent down the PL/Tcl  directory  to  this
    list.  Look at it and reuse anything that might help to build
    PL/perl.  I really hope that PL/perl and PL/Tcl appear in the
    6.3 distribution. I'll do whatever I can to make this happen.

src/pl/tcl/modules/README

+
+    The module support over the unknown command requires, that
+    the PL/Tcl call handler is compiled with -DPLTCL_UNKNOWN_SUPPORT.
+
+    Regular Tcl scripts of any size (over 8K :-) can be loaded into
+    the table pltcl_modules using the pltcl_loadmod script. The script
+    checks the modules that the procedure names don't overwrite
+    existing ones before doing anything. They also check for global
+    variables created at load time.
+
+    All procedures defined in the module files are automatically
+    added to the table pltcl_modfuncs. This table is used by the
+    unknown procedure to determine if an unknown command can be
+    loaded by sourcing a module. In that case the unknonw procedure
+    will silently source in the module and reexecute the original
+    command that invoked unknown.
+
+    I know, thist readme should be more explanatory - but time.
+
+
+Jan
+

src/pl/tcl/modules/pltcl_delmod

+#!/bin/sh
+# Start tclsh \
+exec tclsh "$0" $@
+
+#
+# Code still has to be documented
+#
+
+#load /usr/local/pgsql/lib/libpgtcl.so
+package require Pgtcl
+
+
+#
+# Check for minimum arguments
+#
+if {$argc < 1} {
+    puts stderr ""
+    puts stderr "usage: pltcl_delmod dbname \[options\] modulename \[...\]"
+    puts stderr ""
+    puts stderr "options:"
+    puts stderr "    -host hostname"
+    puts stderr "    -port portnumber"
+    puts stderr ""
+    exit 1
+}
+
+#
+# Remember database name and initialize options
+#
+set dbname [lindex $argv 0]
+set options ""
+set errors 0
+set opt ""
+set val ""
+
+set i 1
+while {$i < $argc} {
+    if {[string compare [string index [lindex $argv $i] 0] "-"] != 0} {
+        break;
+    }
+
+    set opt [lindex $argv $i]
+    incr i
+    if {$i >= $argc} {
+        puts stderr "no value given for option $opt"
+	incr errors
+	continue
+    }
+    set val [lindex $argv $i]
+    incr i
+
+    switch -- $opt {
+        -host {
+	    append options "-host \"$val\" "
+	}
+	-port {
+	    append options "-port $val "
+	}
+	default {
+	    puts stderr "unknown option '$opt'"
+	    incr errors
+	}
+    }
+}
+
+#
+# Final syntax check
+#
+if {$i >= $argc || $errors > 0} {
+    puts stderr ""
+    puts stderr "usage: pltcl_delmod dbname \[options\] modulename \[...\]"
+    puts stderr ""
+    puts stderr "options:"
+    puts stderr "    -host hostname"
+    puts stderr "    -port portnumber"
+    puts stderr ""
+    exit 1
+}
+
+proc delmodule {conn modname} {
+    set xname $modname
+    regsub -all {\\} $xname {\\} xname
+    regsub -all {'}  $xname {''} xname
+
+    set found 0
+    pg_select $conn "select * from pltcl_modules where modname = '$xname'" \
+    MOD {
+        set found 1
+	break;
+    }
+
+    if {!$found} {
+        puts "Module $modname not found in pltcl_modules"
+	puts ""
+	return
+    }
+
+    pg_result \
+        [pg_exec $conn "delete from pltcl_modules where modname = '$xname'"] \
+	-clear
+    pg_result \
+        [pg_exec $conn "delete from pltcl_modfuncs where modname = '$xname'"] \
+	-clear
+
+    puts "Module $modname removed"
+}
+
+set conn [eval pg_connect $dbname $options]
+
+while {$i < $argc} {
+    delmodule $conn [lindex $argv $i]
+    incr i
+}
+
+pg_disconnect $conn
+

src/pl/tcl/modules/pltcl_listmod

+#!/bin/sh
+# Start tclsh \
+exec tclsh "$0" $@
+
+#
+# Code still has to be documented
+#
+
+#load /usr/local/pgsql/lib/libpgtcl.so
+package require Pgtcl
+
+
+#
+# Check for minimum arguments
+#
+if {$argc < 1} {
+    puts stderr ""
+    puts stderr "usage: pltcl_listmod dbname \[options\] \[modulename \[...\]\]"
+    puts stderr ""
+    puts stderr "options:"
+    puts stderr "    -host hostname"
+    puts stderr "    -port portnumber"
+    puts stderr ""
+    exit 1
+}
+
+#
+# Remember database name and initialize options
+#
+set dbname [lindex $argv 0]
+set options ""
+set errors 0
+set opt ""
+set val ""
+
+set i 1
+while {$i < $argc} {
+    if {[string compare [string index [lindex $argv $i] 0] "-"] != 0} {
+        break;
+    }
+
+    set opt [lindex $argv $i]
+    incr i
+    if {$i >= $argc} {
+        puts stderr "no value given for option $opt"
+	incr errors
+	continue
+    }
+    set val [lindex $argv $i]
+    incr i
+
+    switch -- $opt {
+        -host {
+	    append options "-host \"$val\" "
+	}
+	-port {
+	    append options "-port $val "
+	}
+	default {
+	    puts stderr "unknown option '$opt'"
+	    incr errors
+	}
+    }
+}
+
+#
+# Final syntax check
+#
+if {$errors > 0} {
+    puts stderr ""
+    puts stderr "usage: pltcl_listmod dbname \[options\] \[modulename \[...\]\]"
+    puts stderr ""
+    puts stderr "options:"
+    puts stderr "    -host hostname"
+    puts stderr "    -port portnumber"
+    puts stderr ""
+    exit 1
+}
+
+proc listmodule {conn modname} {
+    set xname $modname
+    regsub -all {\\} $xname {\\} xname
+    regsub -all {'}  $xname {''} xname
+
+    set found 0
+    pg_select $conn "select * from pltcl_modules where modname = '$xname'" \
+    MOD {
+        set found 1
+	break;
+    }
+
+    if {!$found} {
+        puts "Module $modname not found in pltcl_modules"
+	puts ""
+	return
+    }
+
+    puts "Module $modname defines procedures:"
+    pg_select $conn "select funcname from pltcl_modfuncs \
+	    where modname = '$xname' order by funcname" FUNC {
+        puts "    $FUNC(funcname)"
+    }
+    puts ""
+}
+
+set conn [eval pg_connect $dbname $options]
+
+if {$i == $argc} {
+    pg_select $conn "select distinct modname from pltcl_modules	\
+    		order by modname"	\
+    		MOD {
+        listmodule $conn $MOD(modname)
+    }
+} else {
+    while {$i < $argc} {
+        listmodule $conn [lindex $argv $i]
+	incr i
+    }
+}
+
+pg_disconnect $conn
+

src/pl/tcl/modules/unknown.pltcl

+#---------------------------------------------------------------------
+# Support for unknown command
+#---------------------------------------------------------------------
+
+proc unknown {proname args} {
+    upvar #0	__PLTcl_unknown_support_plan_modname	p_mod
+    upvar #0	__PLTcl_unknown_support_plan_modsrc	p_src
+
+    #-----------------------------------------------------------
+    # On first call prepare the plans
+    #-----------------------------------------------------------
+    if {![info exists p_mod]} {
+        set p_mod [SPI_prepare 					\
+		"select modname from pltcl_modfuncs		\
+		 where funcname = \$1" name]
+        set p_src [SPI_prepare					\
+		"select modseq, modsrc from pltcl_modules	\
+		 where modname = \$1				\
+		 order by modseq" name]
+    }
+
+    #-----------------------------------------------------------
+    # Lookup the requested function in pltcl_modfuncs
+    #-----------------------------------------------------------
+    set n [SPI_execp -count 1 $p_mod [list [quote $proname]]]
+    if {$n != 1} {
+	#-----------------------------------------------------------
+	# Not found there either - now it's really unknown
+	#-----------------------------------------------------------
+        return -code error "unknown command '$proname'"
+    }
+
+    #-----------------------------------------------------------
+    # Collect the source pieces from pltcl_modules
+    #-----------------------------------------------------------
+    set src ""
+    SPI_execp $p_src [list [quote $modname]] {
+        append src $modsrc
+    }
+
+    #-----------------------------------------------------------
+    # Load the source into the interpreter
+    #-----------------------------------------------------------
+    if {[catch {
+            uplevel #0 "$src"
+        } msg]} {
+	elog NOTICE "pltcl unknown: error while loading module $modname"
+	elog WARN $msg
+    }
+
+    #-----------------------------------------------------------
+    # This should never happen
+    #-----------------------------------------------------------
+    if {[catch {info args $proname}]} {
+        return -code error \
+	    "unknown command '$proname' (still after loading module $modname)"
+    }
+
+    #-----------------------------------------------------------
+    # Finally simulate the initial procedure call
+    #-----------------------------------------------------------
+    return [uplevel 1 $proname $args]
+}
+
+