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.
This commit is contained in:
Marc G. Fournier
parent
a71a80b0f2
commit
957a6149e5
|
|
@ -0,0 +1,22 @@
|
|||
|
||||
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
|
||||
|
||||
|
|
@ -0,0 +1,116 @@
|
|||
#!/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
|
||||
|
||||
|
|
@ -0,0 +1,122 @@
|
|||
#!/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
|
||||
|
||||
|
|
@ -0,0 +1,502 @@
|
|||
#!/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_class C, pg_attribute A, 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
|
||||
}
|
||||
|
||||
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 ""
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,65 @@
|
|||
#---------------------------------------------------------------------
|
||||
# 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]
|
||||
}
|
||||
|
||||
|
||||
Loading…
Reference in New Issue