</para>
</sect1>
- <sect1 id="pltcl-unknown">
- <title>Modules and the <function>unknown</> Command</title>
- <para>
- PL/Tcl has support for autoloading Tcl code when used.
- It recognizes a special table, <literal>pltcl_modules</>, which
- is presumed to contain modules of Tcl code. If this table
- exists, the module <literal>unknown</> is fetched from the table
- and loaded into the Tcl interpreter immediately before the first
- execution of a PL/Tcl function in a database session. (This
- happens separately for each Tcl interpreter, if more than one is
- used in a session; see <xref linkend="pltcl-global">.)
- </para>
- <para>
- While the <literal>unknown</> module could actually contain any
- initialization script you need, it normally defines a Tcl
- <function>unknown</> procedure that is invoked whenever Tcl does
- not recognize an invoked procedure name. <application>PL/Tcl</>'s standard version
- of this procedure tries to find a module in <literal>pltcl_modules</>
- that will define the required procedure. If one is found, it is
- loaded into the interpreter, and then execution is allowed to
- proceed with the originally attempted procedure call. A
- secondary table <literal>pltcl_modfuncs</> provides an index of
- which functions are defined by which modules, so that the lookup
- is reasonably quick.
- </para>
- <para>
- The <productname>PostgreSQL</productname> distribution includes
- support scripts to maintain these tables:
- <command>pltcl_loadmod</>, <command>pltcl_listmod</>,
- <command>pltcl_delmod</>, as well as source for the standard
- <literal>unknown</> module in <filename>share/unknown.pltcl</>. This module
- must be loaded
- into each database initially to support the autoloading mechanism.
- </para>
- <para>
- The tables <literal>pltcl_modules</> and <literal>pltcl_modfuncs</>
- must be readable by all, but it is wise to make them owned and
- writable only by the database administrator. As a security
- precaution, PL/Tcl will ignore <literal>pltcl_modules</> (and thus,
- not attempt to load the <literal>unknown</> module) unless it is
- owned by a superuser. But update privileges on this table can be
- granted to other users, if you trust them sufficiently.
- </para>
- </sect1>
-
<sect1 id="pltcl-procnames">
<title>Tcl Procedure Names</title>
all: all-lib
- $(MAKE) -C modules $@
# Force this dependency to be known even without dependency info built:
pltcl.o: pltclerrcodes.h
distprep: pltclerrcodes.h
install: all install-lib install-data
- $(MAKE) -C modules $@
installdirs: installdirs-lib
$(MKDIR_P) '$(DESTDIR)$(datadir)/extension'
- $(MAKE) -C modules $@
uninstall: uninstall-lib uninstall-data
- $(MAKE) -C modules $@
install-data: installdirs
$(INSTALL_DATA) $(addprefix $(srcdir)/, $(DATA)) '$(DESTDIR)$(datadir)/extension/'
ifeq ($(PORTNAME), win32)
rm -f $(tclwithver).def
endif
- $(MAKE) -C modules $@
maintainer-clean: distclean
rm -f pltclerrcodes.h
+++ /dev/null
-/pltcl_delmod
-/pltcl_listmod
-/pltcl_loadmod
+++ /dev/null
-# src/pl/tcl/modules/Makefile
-
-subdir = src/pl/tcl/modules
-top_builddir = ../../../..
-include $(top_builddir)/src/Makefile.global
-
-MODULES = pltcl_loadmod pltcl_delmod pltcl_listmod
-
-all: $(MODULES)
-
-$(MODULES): %: %.in $(top_builddir)/src/Makefile.global
- sed 's,@TCLSH@,$(TCLSH),g' $< >$@
- chmod a+x $@
-
-install: all installdirs
- $(INSTALL_SCRIPT) pltcl_loadmod '$(DESTDIR)$(bindir)/pltcl_loadmod'
- $(INSTALL_SCRIPT) pltcl_delmod '$(DESTDIR)$(bindir)/pltcl_delmod'
- $(INSTALL_SCRIPT) pltcl_listmod '$(DESTDIR)$(bindir)/pltcl_listmod'
- $(INSTALL_DATA) $(srcdir)/unknown.pltcl '$(DESTDIR)$(datadir)/unknown.pltcl'
-
-installdirs:
- $(MKDIR_P) '$(DESTDIR)$(bindir)' '$(DESTDIR)$(datadir)'
-
-uninstall:
- rm -f '$(DESTDIR)$(bindir)/pltcl_loadmod' '$(DESTDIR)$(bindir)/pltcl_delmod' '$(DESTDIR)$(bindir)/pltcl_listmod' '$(DESTDIR)$(datadir)/unknown.pltcl'
-
-clean distclean maintainer-clean:
- rm -f $(MODULES)
+++ /dev/null
-src/pl/tcl/modules/README
-
-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 unknown procedure
-will silently source in the module and reexecute the original
-command that invoked unknown.
-
-I know, this readme should be more explanatory - but time.
-
-Jan
+++ /dev/null
-#! /bin/sh
-# src/pl/tcl/modules/pltcl_delmod.in
-#
-# 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
+++ /dev/null
-#! /bin/sh
-# src/pl/tcl/modules/pltcl_listmod.in
-#
-# 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
+++ /dev/null
-#! /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 < 2} {
- puts stderr ""
- puts stderr "usage: pltcl_loadmod dbname \[options\] file \[...\]"
- 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_loadmod dbname \[options\] file \[...\]"
- puts stderr ""
- puts stderr "options:"
- puts stderr " -host hostname"
- puts stderr " -port portnumber"
- puts stderr ""
- exit 1
-}
-
-
-proc __PLTcl_loadmod_check_table {conn tabname expnames exptypes} {
- set attrs [expr [llength $expnames] - 1]
- set error 0
- set found 0
-
- pg_select $conn "select C.relname, A.attname, A.attnum, T.typname \
- from pg_catalog.pg_class C, pg_catalog.pg_attribute A, pg_catalog.pg_type T \
- where C.relname = '$tabname' \
- and A.attrelid = C.oid \
- and A.attnum > 0 \
- and T.oid = A.atttypid \
- order by attnum" tup {
-
- incr found
- set i $tup(attnum)
-
- if {$i > $attrs} {
- puts stderr "Table $tabname has extra field '$tup(attname)'"
- incr error
- continue
- }
-
- set xname [lindex $expnames $i]
- set xtype [lindex $exptypes $i]
-
- if {[string compare $tup(attname) $xname] != 0} {
- puts stderr "Attribute $i of $tabname has wrong name"
- puts stderr " got '$tup(attname)' expected '$xname'"
- incr error
- }
- if {[string compare $tup(typname) $xtype] != 0} {
- puts stderr "Attribute $i of $tabname has wrong type"
- puts stderr " got '$tup(typname)' expected '$xtype'"
- incr error
- }
- }
-
- if {$found == 0} {
- return 0
- }
-
- if {$found < $attrs} {
- incr found
- set miss [lrange $expnames $found end]
- puts "Table $tabname doesn't have field(s) $miss"
- incr error
- }
-
- if {$error > 0} {
- return 2
- }
-
- return 1
-}
-
-
-proc __PLTcl_loadmod_check_tables {conn} {
- upvar #0 __PLTcl_loadmod_status status
-
- set error 0
-
- set names {{} modname modseq modsrc}
- set types {{} name int2 text}
-
- switch [__PLTcl_loadmod_check_table $conn pltcl_modules $names $types] {
- 0 {
- set status(create_table_modules) 1
- }
- 1 {
- set status(create_table_modules) 0
- }
- 2 {
- puts "Error(s) in table pltcl_modules"
- incr error
- }
- }
-
- set names {{} funcname modname}
- set types {{} name name}
-
- switch [__PLTcl_loadmod_check_table $conn pltcl_modfuncs $names $types] {
- 0 {
- set status(create_table_modfuncs) 1
- }
- 1 {
- set status(create_table_modfuncs) 0
- }
- 2 {
- puts "Error(s) in table pltcl_modfuncs"
- incr error
- }
- }
-
- if {$status(create_table_modfuncs) && !$status(create_table_modules)} {
- puts stderr "Table pltcl_modfuncs doesn't exist but pltcl_modules does"
- puts stderr "Either both tables must be present or none."
- incr error
- }
-
- if {$status(create_table_modules) && !$status(create_table_modfuncs)} {
- puts stderr "Table pltcl_modules doesn't exist but pltcl_modfuncs does"
- puts stderr "Either both tables must be present or none."
- incr error
- }
-
- if {$error} {
- puts stderr ""
- puts stderr "Abort"
- exit 1
- }
-
- if {!$status(create_table_modules)} {
- __PLTcl_loadmod_read_current $conn
- }
-}
-
-
-proc __PLTcl_loadmod_read_current {conn} {
- upvar #0 __PLTcl_loadmod_status status
- upvar #0 __PLTcl_loadmod_modsrc modsrc
- upvar #0 __PLTcl_loadmod_funclist funcs
- upvar #0 __PLTcl_loadmod_globlist globs
-
- set errors 0
-
- set curmodlist ""
- pg_select $conn "select distinct modname from pltcl_modules" mtup {
- set mname $mtup(modname);
- lappend curmodlist $mname
- }
-
- foreach mname $curmodlist {
- set srctext ""
- pg_select $conn "select * from pltcl_modules \
- where modname = '$mname' \
- order by modseq" tup {
- append srctext $tup(modsrc)
- }
-
- if {[catch {
- __PLTcl_loadmod_analyze \
- "Current $mname" \
- $mname \
- $srctext new_globals new_functions
- }]} {
- incr errors
- }
- set modsrc($mname) $srctext
- set funcs($mname) $new_functions
- set globs($mname) $new_globals
- }
-
- if {$errors} {
- puts stderr ""
- puts stderr "Abort"
- exit 1
- }
-}
-
-
-proc __PLTcl_loadmod_analyze {modinfo modname srctext v_globals v_functions} {
- upvar 1 $v_globals new_g
- upvar 1 $v_functions new_f
- upvar #0 __PLTcl_loadmod_allfuncs allfuncs
- upvar #0 __PLTcl_loadmod_allglobs allglobs
-
- set errors 0
-
- set old_g [info globals]
- set old_f [info procs]
- set new_g ""
- set new_f ""
-
- if {[catch {
- uplevel #0 "$srctext"
- } msg]} {
- puts "$modinfo: $msg"
- incr errors
- }
-
- set cur_g [info globals]
- set cur_f [info procs]
-
- foreach glob $cur_g {
- if {[lsearch -exact $old_g $glob] >= 0} {
- continue
- }
- if {[info exists allglobs($glob)]} {
- puts stderr "$modinfo: Global $glob previously used in module $allglobs($glob)"
- incr errors
- } else {
- set allglobs($glob) $modname
- }
- lappend new_g $glob
- uplevel #0 unset $glob
- }
- foreach func $cur_f {
- if {[lsearch -exact $old_f $func] >= 0} {
- continue
- }
- if {[info exists allfuncs($func)]} {
- puts stderr "$modinfo: Function $func previously defined in module $allfuncs($func)"
- incr errors
- } else {
- set allfuncs($func) $modname
- }
- lappend new_f $func
- rename $func {}
- }
-
- if {$errors} {
- return -code error
- }
- #puts "globs in $modname: $new_g"
- #puts "funcs in $modname: $new_f"
-}
-
-
-proc __PLTcl_loadmod_create_tables {conn} {
- upvar #0 __PLTcl_loadmod_status status
-
- if {$status(create_table_modules)} {
- if {[catch {
- set res [pg_exec $conn \
- "create table pltcl_modules ( \
- modname name, \
- modseq int2, \
- modsrc text);"]
- } msg]} {
- puts stderr "Error creating table pltcl_modules"
- puts stderr " $msg"
- exit 1
- }
- if {[catch {
- set res [pg_exec $conn \
- "create index pltcl_modules_i \
- on pltcl_modules using btree \
- (modname name_ops);"]
- } msg]} {
- puts stderr "Error creating index pltcl_modules_i"
- puts stderr " $msg"
- exit 1
- }
- puts "Table pltcl_modules created"
- pg_result $res -clear
- }
-
- if {$status(create_table_modfuncs)} {
- if {[catch {
- set res [pg_exec $conn \
- "create table pltcl_modfuncs ( \
- funcname name, \
- modname name);"]
- } msg]} {
- puts stderr "Error creating table pltcl_modfuncs"
- puts stderr " $msg"
- exit 1
- }
- if {[catch {
- set res [pg_exec $conn \
- "create index pltcl_modfuncs_i \
- on pltcl_modfuncs using hash \
- (funcname name_ops);"]
- } msg]} {
- puts stderr "Error creating index pltcl_modfuncs_i"
- puts stderr " $msg"
- exit 1
- }
- puts "Table pltcl_modfuncs created"
- pg_result $res -clear
- }
-}
-
-
-proc __PLTcl_loadmod_read_new {conn} {
- upvar #0 __PLTcl_loadmod_status status
- upvar #0 __PLTcl_loadmod_modsrc modsrc
- upvar #0 __PLTcl_loadmod_funclist funcs
- upvar #0 __PLTcl_loadmod_globlist globs
- upvar #0 __PLTcl_loadmod_allfuncs allfuncs
- upvar #0 __PLTcl_loadmod_allglobs allglobs
- upvar #0 __PLTcl_loadmod_modlist modlist
-
- set errors 0
-
- set new_modlist ""
- foreach modfile $modlist {
- set modname [file rootname [file tail $modfile]]
- if {[catch {
- set fid [open $modfile "r"]
- } msg]} {
- puts stderr $msg
- incr errors
- continue
- }
- set srctext [read $fid]
- close $fid
-
- if {[info exists modsrc($modname)]} {
- if {[string compare $modsrc($modname) $srctext] == 0} {
- puts "Module $modname unchanged - ignored"
- continue
- }
- foreach func $funcs($modname) {
- unset allfuncs($func)
- }
- foreach glob $globs($modname) {
- unset allglobs($glob)
- }
- unset funcs($modname)
- unset globs($modname)
- set modsrc($modname) $srctext
- lappend new_modlist $modname
- } else {
- set modsrc($modname) $srctext
- lappend new_modlist $modname
- }
-
- if {[catch {
- __PLTcl_loadmod_analyze "New/updated $modname" \
- $modname $srctext new_globals new_funcs
- }]} {
- incr errors
- }
-
- set funcs($modname) $new_funcs
- set globs($modname) $new_globals
- }
-
- if {$errors} {
- puts stderr ""
- puts stderr "Abort"
- exit 1
- }
-
- set modlist $new_modlist
-}
-
-
-proc __PLTcl_loadmod_load_modules {conn} {
- upvar #0 __PLTcl_loadmod_modsrc modsrc
- upvar #0 __PLTcl_loadmod_funclist funcs
- upvar #0 __PLTcl_loadmod_modlist modlist
-
- set errors 0
-
- foreach modname $modlist {
- set xname [__PLTcl_loadmod_quote $modname]
-
- pg_result [pg_exec $conn "begin;"] -clear
-
- 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
-
- foreach func $funcs($modname) {
- set xfunc [__PLTcl_loadmod_quote $func]
- pg_result [ \
- pg_exec $conn "insert into pltcl_modfuncs values ( \
- '$xfunc', '$xname')" \
- ] -clear
- }
- set i 0
- set srctext $modsrc($modname)
- while {[string compare $srctext ""] != 0} {
- set xpart [string range $srctext 0 3999]
- set xpart [__PLTcl_loadmod_quote $xpart]
- set srctext [string range $srctext 4000 end]
-
- pg_result [ \
- pg_exec $conn "insert into pltcl_modules values ( \
- '$xname', $i, '$xpart')" \
- ] -clear
- incr i
- }
-
- pg_result [pg_exec $conn "commit;"] -clear
-
- puts "Successfully loaded/updated module $modname"
- }
-}
-
-
-proc __PLTcl_loadmod_quote {s} {
- regsub -all {\\} $s {\\\\} s
- regsub -all {'} $s {''} s
- return $s
-}
-
-
-set __PLTcl_loadmod_modlist [lrange $argv $i end]
-set __PLTcl_loadmod_modsrc(dummy) ""
-set __PLTcl_loadmod_funclist(dummy) ""
-set __PLTcl_loadmod_globlist(dummy) ""
-set __PLTcl_loadmod_allfuncs(dummy) ""
-set __PLTcl_loadmod_allglobs(dummy) ""
-
-unset __PLTcl_loadmod_modsrc(dummy)
-unset __PLTcl_loadmod_funclist(dummy)
-unset __PLTcl_loadmod_globlist(dummy)
-unset __PLTcl_loadmod_allfuncs(dummy)
-unset __PLTcl_loadmod_allglobs(dummy)
-
-
-puts ""
-
-set __PLTcl_loadmod_conn [eval pg_connect $dbname $options]
-
-unset i dbname options errors opt val
-
-__PLTcl_loadmod_check_tables $__PLTcl_loadmod_conn
-
-__PLTcl_loadmod_read_new $__PLTcl_loadmod_conn
-
-__PLTcl_loadmod_create_tables $__PLTcl_loadmod_conn
-__PLTcl_loadmod_load_modules $__PLTcl_loadmod_conn
-
-pg_disconnect $__PLTcl_loadmod_conn
-
-puts ""
+++ /dev/null
-#---------------------------------------------------------------------
-# 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]
-}
static void pltcl_init_interp(pltcl_interp_desc *interp_desc, bool pltrusted);
static pltcl_interp_desc *pltcl_fetch_interp(bool pltrusted);
-static void pltcl_init_load_unknown(Tcl_Interp *interp);
static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted);
pltcl_SPI_execute_plan, NULL, NULL);
Tcl_CreateObjCommand(interp, "spi_lastoid",
pltcl_SPI_lastoid, NULL, NULL);
-
- /************************************************************
- * Try to load the unknown procedure from pltcl_modules
- ************************************************************/
- pltcl_init_load_unknown(interp);
}
/**********************************************************************
return interp_desc;
}
-/**********************************************************************
- * pltcl_init_load_unknown() - Load the unknown procedure from
- * table pltcl_modules (if it exists)
- **********************************************************************/
-static void
-pltcl_init_load_unknown(Tcl_Interp *interp)
-{
- Relation pmrel;
- char *pmrelname,
- *nspname;
- char *buf;
- int buflen;
- int spi_rc;
- int tcl_rc;
- Tcl_DString unknown_src;
- char *part;
- uint64 i;
- int fno;
-
- /************************************************************
- * Check if table pltcl_modules exists
- *
- * We allow the table to be found anywhere in the search_path.
- * This is for backwards compatibility. To ensure that the table
- * is trustworthy, we require it to be owned by a superuser.
- ************************************************************/
- pmrel = relation_openrv_extended(makeRangeVar(NULL, "pltcl_modules", -1),
- AccessShareLock, true);
- if (pmrel == NULL)
- return;
- /* sanity-check the relation kind */
- if (!(pmrel->rd_rel->relkind == RELKIND_RELATION ||
- pmrel->rd_rel->relkind == RELKIND_MATVIEW ||
- pmrel->rd_rel->relkind == RELKIND_VIEW))
- {
- relation_close(pmrel, AccessShareLock);
- return;
- }
- /* must be owned by superuser, else ignore */
- if (!superuser_arg(pmrel->rd_rel->relowner))
- {
- relation_close(pmrel, AccessShareLock);
- return;
- }
- /* get fully qualified table name for use in select command */
- nspname = get_namespace_name(RelationGetNamespace(pmrel));
- if (!nspname)
- elog(ERROR, "cache lookup failed for namespace %u",
- RelationGetNamespace(pmrel));
- pmrelname = quote_qualified_identifier(nspname,
- RelationGetRelationName(pmrel));
-
- /************************************************************
- * Read all the rows from it where modname = 'unknown',
- * in the order of modseq
- ************************************************************/
- buflen = strlen(pmrelname) + 100;
- buf = (char *) palloc(buflen);
- snprintf(buf, buflen,
- "select modsrc from %s where modname = 'unknown' order by modseq",
- pmrelname);
-
- spi_rc = SPI_execute(buf, false, 0);
- if (spi_rc != SPI_OK_SELECT)
- elog(ERROR, "select from pltcl_modules failed");
-
- pfree(buf);
-
- /************************************************************
- * If there's nothing, module unknown doesn't exist
- ************************************************************/
- if (SPI_processed == 0)
- {
- SPI_freetuptable(SPI_tuptable);
- ereport(WARNING,
- (errmsg("module \"unknown\" not found in pltcl_modules")));
- relation_close(pmrel, AccessShareLock);
- return;
- }
-
- /************************************************************
- * There is a module named unknown. Reassemble the
- * source from the modsrc attributes and evaluate
- * it in the Tcl interpreter
- *
- * leave this code as DString - it's only executed once per session
- ************************************************************/
- fno = SPI_fnumber(SPI_tuptable->tupdesc, "modsrc");
- Assert(fno > 0);
-
- Tcl_DStringInit(&unknown_src);
-
- for (i = 0; i < SPI_processed; i++)
- {
- part = SPI_getvalue(SPI_tuptable->vals[i],
- SPI_tuptable->tupdesc, fno);
- if (part != NULL)
- {
- UTF_BEGIN;
- Tcl_DStringAppend(&unknown_src, UTF_E2U(part), -1);
- UTF_END;
- pfree(part);
- }
- }
- tcl_rc = Tcl_EvalEx(interp, Tcl_DStringValue(&unknown_src),
- Tcl_DStringLength(&unknown_src),
- TCL_EVAL_GLOBAL);
-
- Tcl_DStringFree(&unknown_src);
- SPI_freetuptable(SPI_tuptable);
-
- if (tcl_rc != TCL_OK)
- ereport(ERROR,
- (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
- errmsg("could not load module \"unknown\": %s",
- utf_u2e(Tcl_GetStringResult(interp)))));
-
- relation_close(pmrel, AccessShareLock);
-}
-
/**********************************************************************
* pltcl_call_handler - This is the only visible function
projects / users / rhaas / postgres.git / commitdiff