diff options
Diffstat (limited to 'src/pl/tcl')
41 files changed, 9511 insertions, 0 deletions
diff --git a/src/pl/tcl/.gitignore b/src/pl/tcl/.gitignore new file mode 100644 index 0000000..62b62eb --- /dev/null +++ b/src/pl/tcl/.gitignore @@ -0,0 +1,6 @@ +/pltclerrcodes.h + +# Generated subdirectories +/log/ +/results/ +/tmp_check/ diff --git a/src/pl/tcl/Makefile b/src/pl/tcl/Makefile new file mode 100644 index 0000000..1e7740d --- /dev/null +++ b/src/pl/tcl/Makefile @@ -0,0 +1,103 @@ +#------------------------------------------------------------------------- +# +# Makefile for the PL/Tcl procedural language +# +# src/pl/tcl/Makefile +# +#------------------------------------------------------------------------- + +subdir = src/pl/tcl +top_builddir = ../../.. +include $(top_builddir)/src/Makefile.global + + +override CPPFLAGS := -I. -I$(srcdir) $(TCL_INCLUDE_SPEC) $(CPPFLAGS) + +# On Windows, we don't link directly with the Tcl library; see below +ifneq ($(PORTNAME), win32) +SHLIB_LINK = $(TCL_LIB_SPEC) $(TCL_LIBS) -lc +endif + +PGFILEDESC = "PL/Tcl - procedural language" + +NAME = pltcl + +OBJS = \ + $(WIN32RES) \ + pltcl.o + +DATA = pltcl.control pltcl--1.0.sql \ + pltclu.control pltclu--1.0.sql + +REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-extension=pltcl +REGRESS = pltcl_setup pltcl_queries pltcl_trigger pltcl_call pltcl_start_proc pltcl_subxact pltcl_unicode pltcl_transaction + +# Tcl on win32 ships with import libraries only for Microsoft Visual C++, +# which are not compatible with mingw gcc. Therefore we need to build a +# new import library to link with. +ifeq ($(PORTNAME), win32) + +tclwithver = $(subst -l,,$(filter -l%, $(TCL_LIB_SPEC))) +TCLDLL = $(dir $(TCLSH))/$(tclwithver).dll + +OBJS += lib$(tclwithver).a + +lib$(tclwithver).a: $(tclwithver).def + dlltool --dllname $(tclwithver).dll --def $(tclwithver).def --output-lib lib$(tclwithver).a + +$(tclwithver).def: $(TCLDLL) + pexports $^ > $@ + +endif # win32 + + +include $(top_srcdir)/src/Makefile.shlib + + +all: all-lib + +# Force this dependency to be known even without dependency info built: +pltcl.o: pltclerrcodes.h + +# generate pltclerrcodes.h from src/backend/utils/errcodes.txt +pltclerrcodes.h: $(top_srcdir)/src/backend/utils/errcodes.txt generate-pltclerrcodes.pl + $(PERL) $(srcdir)/generate-pltclerrcodes.pl $< > $@ + +distprep: pltclerrcodes.h + +install: all install-lib install-data + +installdirs: installdirs-lib + $(MKDIR_P) '$(DESTDIR)$(datadir)/extension' + +uninstall: uninstall-lib uninstall-data + +install-data: installdirs + $(INSTALL_DATA) $(addprefix $(srcdir)/, $(DATA)) '$(DESTDIR)$(datadir)/extension/' + +uninstall-data: + rm -f $(addprefix '$(DESTDIR)$(datadir)/extension'/, $(notdir $(DATA))) + +.PHONY: install-data uninstall-data + + +check: submake + $(pg_regress_check) $(REGRESS_OPTS) $(REGRESS) + +installcheck: submake + $(pg_regress_installcheck) $(REGRESS_OPTS) $(REGRESS) + +.PHONY: submake +submake: + $(MAKE) -C $(top_builddir)/src/test/regress pg_regress$(X) + +# pltclerrcodes.h is in the distribution tarball, so don't clean it here. +clean distclean: clean-lib + rm -f $(OBJS) + rm -rf $(pg_regress_clean_files) +ifeq ($(PORTNAME), win32) + rm -f $(tclwithver).def +endif + +maintainer-clean: distclean + rm -f pltclerrcodes.h diff --git a/src/pl/tcl/expected/pltcl_call.out b/src/pl/tcl/expected/pltcl_call.out new file mode 100644 index 0000000..d290c8f --- /dev/null +++ b/src/pl/tcl/expected/pltcl_call.out @@ -0,0 +1,55 @@ +CREATE PROCEDURE test_proc1() +LANGUAGE pltcl +AS $$ +unset +$$; +CALL test_proc1(); +CREATE PROCEDURE test_proc2() +LANGUAGE pltcl +AS $$ +return 5 +$$; +CALL test_proc2(); +CREATE TABLE test1 (a int); +CREATE PROCEDURE test_proc3(x int) +LANGUAGE pltcl +AS $$ +spi_exec "INSERT INTO test1 VALUES ($1)" +$$; +CALL test_proc3(55); +SELECT * FROM test1; + a +---- + 55 +(1 row) + +-- output arguments +CREATE PROCEDURE test_proc5(INOUT a text) +LANGUAGE pltcl +AS $$ +set aa [concat $1 "+" $1] +return [list a $aa] +$$; +CALL test_proc5('abc'); + a +----------- + abc + abc +(1 row) + +CREATE PROCEDURE test_proc6(a int, INOUT b int, INOUT c int) +LANGUAGE pltcl +AS $$ +set bb [expr $2 * $1] +set cc [expr $3 * $1] +return [list b $bb c $cc] +$$; +CALL test_proc6(2, 3, 4); + b | c +---+--- + 6 | 8 +(1 row) + +DROP PROCEDURE test_proc1; +DROP PROCEDURE test_proc2; +DROP PROCEDURE test_proc3; +DROP TABLE test1; diff --git a/src/pl/tcl/expected/pltcl_queries.out b/src/pl/tcl/expected/pltcl_queries.out new file mode 100644 index 0000000..2d922c2 --- /dev/null +++ b/src/pl/tcl/expected/pltcl_queries.out @@ -0,0 +1,397 @@ +-- suppress CONTEXT so that function OIDs aren't in output +\set VERBOSITY terse +-- Test composite-type arguments +select tcl_composite_arg_ref1(row('tkey', 42, 'ref2')); + tcl_composite_arg_ref1 +------------------------ + 42 +(1 row) + +select tcl_composite_arg_ref2(row('tkey', 42, 'ref2')); + tcl_composite_arg_ref2 +------------------------ + ref2 +(1 row) + +-- More tests for composite argument/result types +create domain d_comp1 as T_comp1 check ((value).ref1 > 0); +create function tcl_record_arg(record, fldname text) returns int as ' + return $1($2) +' language pltcl; +select tcl_record_arg(row('tkey', 42, 'ref2')::T_comp1, 'ref1'); + tcl_record_arg +---------------- + 42 +(1 row) + +select tcl_record_arg(row('tkey', 42, 'ref2')::d_comp1, 'ref1'); + tcl_record_arg +---------------- + 42 +(1 row) + +select tcl_record_arg(row(2,4), 'f2'); + tcl_record_arg +---------------- + 4 +(1 row) + +create function tcl_cdomain_arg(d_comp1) returns int as ' + return $1(ref1) +' language pltcl; +select tcl_cdomain_arg(row('tkey', 42, 'ref2')); + tcl_cdomain_arg +----------------- + 42 +(1 row) + +select tcl_cdomain_arg(row('tkey', 42, 'ref2')::T_comp1); + tcl_cdomain_arg +----------------- + 42 +(1 row) + +select tcl_cdomain_arg(row('tkey', -1, 'ref2')); -- fail +ERROR: value for domain d_comp1 violates check constraint "d_comp1_check" +-- Test argisnull primitive +select tcl_argisnull('foo'); + tcl_argisnull +--------------- + f +(1 row) + +select tcl_argisnull(''); + tcl_argisnull +--------------- + f +(1 row) + +select tcl_argisnull(null); + tcl_argisnull +--------------- + t +(1 row) + +-- test some error cases +create function tcl_error(out a int, out b int) as $$return {$$ language pltcl; +select tcl_error(); +ERROR: missing close-brace +create function bad_record(out a text, out b text) as $$return [list a]$$ language pltcl; +select bad_record(); +ERROR: column name/value list must have even number of elements +create function bad_field(out a text, out b text) as $$return [list a 1 b 2 cow 3]$$ language pltcl; +select bad_field(); +ERROR: column name/value list contains nonexistent column name "cow" +-- test compound return +select * from tcl_test_cube_squared(5); + squared | cubed +---------+------- + 25 | 125 +(1 row) + +-- test SRF +select * from tcl_test_squared_rows(0,5); + x | y +---+---- + 0 | 0 + 1 | 1 + 2 | 4 + 3 | 9 + 4 | 16 +(5 rows) + +select * from tcl_test_sequence(0,5) as a; + a +--- + 0 + 1 + 2 + 3 + 4 +(5 rows) + +select 1, tcl_test_sequence(0,5); + ?column? | tcl_test_sequence +----------+------------------- + 1 | 0 + 1 | 1 + 1 | 2 + 1 | 3 + 1 | 4 +(5 rows) + +create function non_srf() returns int as $$return_next 1$$ language pltcl; +select non_srf(); +ERROR: return_next cannot be used in non-set-returning functions +create function bad_record_srf(out a text, out b text) returns setof record as $$ +return_next [list a] +$$ language pltcl; +select bad_record_srf(); +ERROR: column name/value list must have even number of elements +create function bad_field_srf(out a text, out b text) returns setof record as $$ +return_next [list a 1 b 2 cow 3] +$$ language pltcl; +select bad_field_srf(); +ERROR: column name/value list contains nonexistent column name "cow" +-- test composite and domain-over-composite results +create function tcl_composite_result(int) returns T_comp1 as $$ +return [list tkey tkey1 ref1 $1 ref2 ref22] +$$ language pltcl; +select tcl_composite_result(1001); + tcl_composite_result +-------------------------------------------- + ("tkey1 ",1001,"ref22 ") +(1 row) + +select * from tcl_composite_result(1002); + tkey | ref1 | ref2 +------------+------+---------------------- + tkey1 | 1002 | ref22 +(1 row) + +create function tcl_dcomposite_result(int) returns d_comp1 as $$ +return [list tkey tkey2 ref1 $1 ref2 ref42] +$$ language pltcl; +select tcl_dcomposite_result(1001); + tcl_dcomposite_result +-------------------------------------------- + ("tkey2 ",1001,"ref42 ") +(1 row) + +select * from tcl_dcomposite_result(1002); + tkey | ref1 | ref2 +------------+------+---------------------- + tkey2 | 1002 | ref42 +(1 row) + +select * from tcl_dcomposite_result(-1); -- fail +ERROR: value for domain d_comp1 violates check constraint "d_comp1_check" +create function tcl_record_result(int) returns record as $$ +return [list q1 sometext q2 $1 q3 moretext] +$$ language pltcl; +select tcl_record_result(42); -- fail +ERROR: function returning record called in context that cannot accept type record +select * from tcl_record_result(42); -- fail +ERROR: a column definition list is required for functions returning "record" at character 15 +select * from tcl_record_result(42) as (q1 text, q2 int, q3 text); + q1 | q2 | q3 +----------+----+---------- + sometext | 42 | moretext +(1 row) + +select * from tcl_record_result(42) as (q1 text, q2 int, q3 text, q4 int); + q1 | q2 | q3 | q4 +----------+----+----------+---- + sometext | 42 | moretext | +(1 row) + +select * from tcl_record_result(42) as (q1 text, q2 int, q4 int); -- fail +ERROR: column name/value list contains nonexistent column name "q3" +-- test quote +select tcl_eval('quote foo bar'); +ERROR: wrong # args: should be "quote string" +select tcl_eval('quote [format %c 39]'); + tcl_eval +---------- + '' +(1 row) + +select tcl_eval('quote [format %c 92]'); + tcl_eval +---------- + \\ +(1 row) + +-- Test argisnull +select tcl_eval('argisnull'); +ERROR: wrong # args: should be "argisnull argno" +select tcl_eval('argisnull 14'); +ERROR: argno out of range +select tcl_eval('argisnull abc'); +ERROR: expected integer but got "abc" +-- Test return_null +select tcl_eval('return_null 14'); +ERROR: wrong # args: should be "return_null " +-- Test spi_exec +select tcl_eval('spi_exec'); +ERROR: wrong # args: should be "spi_exec ?-count n? ?-array name? query ?loop body?" +select tcl_eval('spi_exec -count'); +ERROR: missing argument to -count or -array +select tcl_eval('spi_exec -array'); +ERROR: missing argument to -count or -array +select tcl_eval('spi_exec -count abc'); +ERROR: expected integer but got "abc" +select tcl_eval('spi_exec query loop body toomuch'); +ERROR: wrong # args: should be "query ?loop body?" +select tcl_eval('spi_exec "begin; rollback;"'); +ERROR: pltcl: SPI_execute failed: SPI_ERROR_TRANSACTION +-- Test spi_execp +select tcl_eval('spi_execp'); +ERROR: missing argument to -count or -array +select tcl_eval('spi_execp -count'); +ERROR: missing argument to -array, -count or -nulls +select tcl_eval('spi_execp -array'); +ERROR: missing argument to -array, -count or -nulls +select tcl_eval('spi_execp -count abc'); +ERROR: expected integer but got "abc" +select tcl_eval('spi_execp -nulls'); +ERROR: missing argument to -array, -count or -nulls +select tcl_eval('spi_execp ""'); +ERROR: invalid queryid '' +-- test spi_prepare +select tcl_eval('spi_prepare'); +ERROR: wrong # args: should be "spi_prepare query argtypes" +select tcl_eval('spi_prepare a b'); +ERROR: type "b" does not exist +select tcl_eval('spi_prepare a "b {"'); +ERROR: unmatched open brace in list +select tcl_error_handling_test($tcl$spi_prepare "select moo" []$tcl$); + tcl_error_handling_test +-------------------------------------- + SQLSTATE: 42703 + + condition: undefined_column + + cursor_position: 8 + + message: column "moo" does not exist+ + statement: select moo +(1 row) + +-- test full error text +select tcl_error_handling_test($tcl$ +spi_exec "DO $$ +BEGIN +RAISE 'my message' + USING HINT = 'my hint' + , DETAIL = 'my detail' + , SCHEMA = 'my schema' + , TABLE = 'my table' + , COLUMN = 'my column' + , CONSTRAINT = 'my constraint' + , DATATYPE = 'my datatype' +; +END$$;" +$tcl$); + tcl_error_handling_test +-------------------------------------------------------------- + SQLSTATE: P0001 + + column: my column + + condition: raise_exception + + constraint: my constraint + + context: PL/pgSQL function inline_code_block line 3 at RAISE+ + SQL statement "DO $$ + + BEGIN + + RAISE 'my message' + + USING HINT = 'my hint' + + , DETAIL = 'my detail' + + , SCHEMA = 'my schema' + + , TABLE = 'my table' + + , COLUMN = 'my column' + + , CONSTRAINT = 'my constraint' + + , DATATYPE = 'my datatype' + + ; + + END$$;" + + datatype: my datatype + + detail: my detail + + hint: my hint + + message: my message + + schema: my schema + + table: my table +(1 row) + +-- verify tcl_error_handling_test() properly reports non-postgres errors +select tcl_error_handling_test('moo'); + tcl_error_handling_test +---------------------------- + invalid command name "moo" +(1 row) + +-- test elog +select tcl_eval('elog'); +ERROR: wrong # args: should be "elog level msg" +select tcl_eval('elog foo bar'); +ERROR: bad priority "foo": must be DEBUG, LOG, INFO, NOTICE, WARNING, ERROR, or FATAL +-- test forced error +select tcl_eval('error "forced error"'); +ERROR: forced error +-- test loop control in spi_exec[p] +select tcl_spi_exec(true, 'break'); +NOTICE: col1 1, col2 foo +NOTICE: col1 2, col2 bar +NOTICE: action: break +NOTICE: end of function + tcl_spi_exec +-------------- + +(1 row) + +select tcl_spi_exec(true, 'continue'); +NOTICE: col1 1, col2 foo +NOTICE: col1 2, col2 bar +NOTICE: action: continue +NOTICE: col1 3, col2 baz +NOTICE: end of function + tcl_spi_exec +-------------- + +(1 row) + +select tcl_spi_exec(true, 'error'); +NOTICE: col1 1, col2 foo +NOTICE: col1 2, col2 bar +NOTICE: action: error +ERROR: error message +select tcl_spi_exec(true, 'return'); +NOTICE: col1 1, col2 foo +NOTICE: col1 2, col2 bar +NOTICE: action: return + tcl_spi_exec +-------------- + +(1 row) + +select tcl_spi_exec(false, 'break'); +NOTICE: col1 1, col2 foo +NOTICE: col1 2, col2 bar +NOTICE: action: break +NOTICE: end of function + tcl_spi_exec +-------------- + +(1 row) + +select tcl_spi_exec(false, 'continue'); +NOTICE: col1 1, col2 foo +NOTICE: col1 2, col2 bar +NOTICE: action: continue +NOTICE: col1 3, col2 baz +NOTICE: end of function + tcl_spi_exec +-------------- + +(1 row) + +select tcl_spi_exec(false, 'error'); +NOTICE: col1 1, col2 foo +NOTICE: col1 2, col2 bar +NOTICE: action: error +ERROR: error message +select tcl_spi_exec(false, 'return'); +NOTICE: col1 1, col2 foo +NOTICE: col1 2, col2 bar +NOTICE: action: return + tcl_spi_exec +-------------- + +(1 row) + +-- forcibly run the Tcl event loop for awhile, to check that we have not +-- messed things up too badly by disabling the Tcl notifier subsystem +select tcl_eval($$ + unset -nocomplain ::tcl_vwait + after 100 {set ::tcl_vwait 1} + vwait ::tcl_vwait + unset -nocomplain ::tcl_vwait$$); + tcl_eval +---------- + +(1 row) + diff --git a/src/pl/tcl/expected/pltcl_setup.out b/src/pl/tcl/expected/pltcl_setup.out new file mode 100644 index 0000000..ed809f0 --- /dev/null +++ b/src/pl/tcl/expected/pltcl_setup.out @@ -0,0 +1,263 @@ +create table T_comp1 ( + tkey char(10), + ref1 int4, + ref2 char(20) +); +create function tcl_composite_arg_ref1(T_comp1) returns int as ' + return $1(ref1) +' language pltcl; +create function tcl_composite_arg_ref2(T_comp1) returns text as ' + return $1(ref2) +' language pltcl; +create function tcl_argisnull(text) returns bool as ' + argisnull 1 +' language pltcl; +create function tcl_int4add(int4,int4) returns int4 as ' + return [expr $1 + $2] +' language pltcl; +-- We use split(n) as a quick-and-dirty way of parsing the input array +-- value, which comes in as a string like '{1,2}'. There are better ways... +create function tcl_int4_accum(int4[], int4) returns int4[] as ' + set state [split $1 "{,}"] + set newsum [expr {[lindex $state 1] + $2}] + set newcnt [expr {[lindex $state 2] + 1}] + return "{$newsum,$newcnt}" +' language pltcl; +create function tcl_int4_avg(int4[]) returns int4 as ' + set state [split $1 "{,}"] + if {[lindex $state 2] == 0} { return_null } + return [expr {[lindex $state 1] / [lindex $state 2]}] +' language pltcl; +create aggregate tcl_avg ( + sfunc = tcl_int4_accum, + basetype = int4, + stype = int4[], + finalfunc = tcl_int4_avg, + initcond = '{0,0}' + ); +create aggregate tcl_sum ( + sfunc = tcl_int4add, + basetype = int4, + stype = int4, + initcond1 = 0 + ); +create function tcl_int4lt(int4,int4) returns bool as ' + if {$1 < $2} { + return t + } + return f +' language pltcl; +create function tcl_int4le(int4,int4) returns bool as ' + if {$1 <= $2} { + return t + } + return f +' language pltcl; +create function tcl_int4eq(int4,int4) returns bool as ' + if {$1 == $2} { + return t + } + return f +' language pltcl; +create function tcl_int4ge(int4,int4) returns bool as ' + if {$1 >= $2} { + return t + } + return f +' language pltcl; +create function tcl_int4gt(int4,int4) returns bool as ' + if {$1 > $2} { + return t + } + return f +' language pltcl; +create operator @< ( + leftarg = int4, + rightarg = int4, + procedure = tcl_int4lt + ); +create operator @<= ( + leftarg = int4, + rightarg = int4, + procedure = tcl_int4le + ); +create operator @= ( + leftarg = int4, + rightarg = int4, + procedure = tcl_int4eq + ); +create operator @>= ( + leftarg = int4, + rightarg = int4, + procedure = tcl_int4ge + ); +create operator @> ( + leftarg = int4, + rightarg = int4, + procedure = tcl_int4gt + ); +create function tcl_int4cmp(int4,int4) returns int4 as ' + if {$1 < $2} { + return -1 + } + if {$1 > $2} { + return 1 + } + return 0 +' language pltcl; +CREATE OPERATOR CLASS tcl_int4_ops + FOR TYPE int4 USING btree AS + OPERATOR 1 @<, + OPERATOR 2 @<=, + OPERATOR 3 @=, + OPERATOR 4 @>=, + OPERATOR 5 @>, + FUNCTION 1 tcl_int4cmp(int4,int4) ; +-- +-- Test usage of Tcl's "clock" command. In recent Tcl versions this +-- command fails without working "unknown" support, so it's a good canary +-- for initialization problems. +-- +create function tcl_date_week(int4,int4,int4) returns text as $$ + return [clock format [clock scan "$2/$3/$1"] -format "%U"] +$$ language pltcl immutable; +select tcl_date_week(2010,1,26); + tcl_date_week +--------------- + 04 +(1 row) + +select tcl_date_week(2001,10,24); + tcl_date_week +--------------- + 42 +(1 row) + +-- test pltcl event triggers +create function tclsnitch() returns event_trigger language pltcl as $$ + elog NOTICE "tclsnitch: $TG_event $TG_tag" +$$; +create event trigger tcl_a_snitch on ddl_command_start execute procedure tclsnitch(); +create event trigger tcl_b_snitch on ddl_command_end execute procedure tclsnitch(); +create function foobar() returns int language sql as $$select 1;$$; +NOTICE: tclsnitch: ddl_command_start CREATE FUNCTION +NOTICE: tclsnitch: ddl_command_end CREATE FUNCTION +alter function foobar() cost 77; +NOTICE: tclsnitch: ddl_command_start ALTER FUNCTION +NOTICE: tclsnitch: ddl_command_end ALTER FUNCTION +drop function foobar(); +NOTICE: tclsnitch: ddl_command_start DROP FUNCTION +NOTICE: tclsnitch: ddl_command_end DROP FUNCTION +create table foo(); +NOTICE: tclsnitch: ddl_command_start CREATE TABLE +NOTICE: tclsnitch: ddl_command_end CREATE TABLE +drop table foo; +NOTICE: tclsnitch: ddl_command_start DROP TABLE +NOTICE: tclsnitch: ddl_command_end DROP TABLE +drop event trigger tcl_a_snitch; +drop event trigger tcl_b_snitch; +create function tcl_test_cube_squared(in int, out squared int, out cubed int) as $$ + return [list squared [expr {$1 * $1}] cubed [expr {$1 * $1 * $1}]] +$$ language pltcl; +create function tcl_test_squared_rows(int,int) returns table (x int, y int) as $$ + for {set i $1} {$i < $2} {incr i} { + return_next [list y [expr {$i * $i}] x $i] + } +$$ language pltcl; +create function tcl_test_sequence(int,int) returns setof int as $$ + for {set i $1} {$i < $2} {incr i} { + return_next $i + } +$$ language pltcl; +create function tcl_eval(string text) returns text as $$ + eval $1 +$$ language pltcl; +-- test use of errorCode in error handling +create function tcl_error_handling_test(text) returns text +language pltcl +as $function$ + if {[catch $1 err]} { + # If not a Postgres error, just return the basic error message + if {[lindex $::errorCode 0] != "POSTGRES"} { + return $err + } + + # Get rid of keys that can't be expected to remain constant + array set myArray $::errorCode + unset myArray(POSTGRES) + unset -nocomplain myArray(funcname) + unset -nocomplain myArray(filename) + unset -nocomplain myArray(lineno) + + # Format into something nicer + set vals [] + foreach {key} [lsort [array names myArray]] { + set value [string map {"\n" "\n\t"} $myArray($key)] + lappend vals "$key: $value" + } + return [join $vals "\n"] + } else { + return "no error" + } +$function$; +-- test spi_exec and spi_execp with -array +create function tcl_spi_exec( + prepare boolean, + action text +) +returns void language pltcl AS $function$ +set query "select * from (values (1,'foo'),(2,'bar'),(3,'baz')) v(col1,col2)" +if {$1 == "t"} { + set prep [spi_prepare $query {}] + spi_execp -array A $prep { + elog NOTICE "col1 $A(col1), col2 $A(col2)" + + switch $A(col1) { + 2 { + elog NOTICE "action: $2" + switch $2 { + break { + break + } + continue { + continue + } + return { + return + } + error { + error "error message" + } + } + error "should not get here" + } + } + } +} else { + spi_exec -array A $query { + elog NOTICE "col1 $A(col1), col2 $A(col2)" + + switch $A(col1) { + 2 { + elog NOTICE "action: $2" + switch $2 { + break { + break + } + continue { + continue + } + return { + return + } + error { + error "error message" + } + } + error "should not get here" + } + } + } +} +elog NOTICE "end of function" +$function$; diff --git a/src/pl/tcl/expected/pltcl_start_proc.out b/src/pl/tcl/expected/pltcl_start_proc.out new file mode 100644 index 0000000..9946cd9 --- /dev/null +++ b/src/pl/tcl/expected/pltcl_start_proc.out @@ -0,0 +1,31 @@ +-- +-- Test start_proc execution +-- +SET pltcl.start_proc = 'no_such_function'; +select tcl_int4add(1, 2); +ERROR: function no_such_function() does not exist +CONTEXT: processing pltcl.start_proc parameter +select tcl_int4add(1, 2); +ERROR: function no_such_function() does not exist +CONTEXT: processing pltcl.start_proc parameter +create function tcl_initialize() returns void as +$$ elog NOTICE "in tcl_initialize" $$ language pltcl SECURITY DEFINER; +SET pltcl.start_proc = 'public.tcl_initialize'; +select tcl_int4add(1, 2); -- fail +ERROR: function "public.tcl_initialize" must not be SECURITY DEFINER +CONTEXT: processing pltcl.start_proc parameter +create or replace function tcl_initialize() returns void as +$$ elog NOTICE "in tcl_initialize" $$ language pltcl; +select tcl_int4add(1, 2); +NOTICE: in tcl_initialize + tcl_int4add +------------- + 3 +(1 row) + +select tcl_int4add(1, 2); + tcl_int4add +------------- + 3 +(1 row) + diff --git a/src/pl/tcl/expected/pltcl_subxact.out b/src/pl/tcl/expected/pltcl_subxact.out new file mode 100644 index 0000000..5e19bbb --- /dev/null +++ b/src/pl/tcl/expected/pltcl_subxact.out @@ -0,0 +1,143 @@ +-- +-- Test explicit subtransactions +-- +CREATE TABLE subtransaction_tbl ( + i integer +); +-- +-- We use this wrapper to catch errors and return errormsg only, +-- because values of $::errorinfo variable contain procedure name which +-- includes OID, so it's not stable +-- +CREATE FUNCTION pltcl_wrapper(statement text) RETURNS text +AS $$ + if [catch {spi_exec $1} msg] { + return "ERROR: $msg" + } else { + return "SUCCESS: $msg" + } +$$ LANGUAGE pltcl; +-- Test subtransaction successfully committed +CREATE FUNCTION subtransaction_ctx_success() RETURNS void +AS $$ + spi_exec "INSERT INTO subtransaction_tbl VALUES(1)" + subtransaction { + spi_exec "INSERT INTO subtransaction_tbl VALUES(2)" + } +$$ LANGUAGE pltcl; +BEGIN; +INSERT INTO subtransaction_tbl VALUES(0); +SELECT subtransaction_ctx_success(); + subtransaction_ctx_success +---------------------------- + +(1 row) + +COMMIT; +SELECT * FROM subtransaction_tbl; + i +--- + 0 + 1 + 2 +(3 rows) + +TRUNCATE subtransaction_tbl; +-- Test subtransaction rollback +CREATE FUNCTION subtransaction_ctx_test(what_error text = NULL) RETURNS void +AS $$ + spi_exec "INSERT INTO subtransaction_tbl VALUES (1)" + subtransaction { + spi_exec "INSERT INTO subtransaction_tbl VALUES (2)" + if {$1 == "SPI"} { + spi_exec "INSERT INTO subtransaction_tbl VALUES ('oops')" + } elseif { $1 == "Tcl"} { + elog ERROR "Tcl error" + } + } +$$ LANGUAGE pltcl; +SELECT pltcl_wrapper('SELECT subtransaction_ctx_test()'); + pltcl_wrapper +--------------- + SUCCESS: 1 +(1 row) + +SELECT * FROM subtransaction_tbl; + i +--- + 1 + 2 +(2 rows) + +TRUNCATE subtransaction_tbl; +SELECT pltcl_wrapper('SELECT subtransaction_ctx_test(''SPI'')'); + pltcl_wrapper +------------------------------------------------------ + ERROR: invalid input syntax for type integer: "oops" +(1 row) + +SELECT * FROM subtransaction_tbl; + i +--- +(0 rows) + +TRUNCATE subtransaction_tbl; +SELECT pltcl_wrapper('SELECT subtransaction_ctx_test(''Tcl'')'); + pltcl_wrapper +------------------ + ERROR: Tcl error +(1 row) + +SELECT * FROM subtransaction_tbl; + i +--- +(0 rows) + +TRUNCATE subtransaction_tbl; +-- Nested subtransactions +CREATE FUNCTION subtransaction_nested_test(swallow boolean = 'f') RETURNS text +AS $$ +spi_exec "INSERT INTO subtransaction_tbl VALUES (1)" +subtransaction { + spi_exec "INSERT INTO subtransaction_tbl VALUES (2)" + if [catch { + subtransaction { + spi_exec "INSERT INTO subtransaction_tbl VALUES (3)" + spi_exec "error" + } + } errormsg] { + if {$1 != "t"} { + error $errormsg $::errorInfo $::errorCode + } + elog NOTICE "Swallowed $errormsg" + } +} +return "ok" +$$ LANGUAGE pltcl; +SELECT pltcl_wrapper('SELECT subtransaction_nested_test()'); + pltcl_wrapper +---------------------------------------- + ERROR: syntax error at or near "error" +(1 row) + +SELECT * FROM subtransaction_tbl; + i +--- +(0 rows) + +TRUNCATE subtransaction_tbl; +SELECT pltcl_wrapper('SELECT subtransaction_nested_test(''t'')'); +NOTICE: Swallowed syntax error at or near "error" + pltcl_wrapper +--------------- + SUCCESS: 1 +(1 row) + +SELECT * FROM subtransaction_tbl; + i +--- + 1 + 2 +(2 rows) + +TRUNCATE subtransaction_tbl; diff --git a/src/pl/tcl/expected/pltcl_transaction.out b/src/pl/tcl/expected/pltcl_transaction.out new file mode 100644 index 0000000..007204b --- /dev/null +++ b/src/pl/tcl/expected/pltcl_transaction.out @@ -0,0 +1,100 @@ +-- suppress CONTEXT so that function OIDs aren't in output +\set VERBOSITY terse +CREATE TABLE test1 (a int, b text); +CREATE PROCEDURE transaction_test1() +LANGUAGE pltcl +AS $$ +for {set i 0} {$i < 10} {incr i} { + spi_exec "INSERT INTO test1 (a) VALUES ($i)" + if {$i % 2 == 0} { + commit + } else { + rollback + } +} +$$; +CALL transaction_test1(); +SELECT * FROM test1; + a | b +---+--- + 0 | + 2 | + 4 | + 6 | + 8 | +(5 rows) + +TRUNCATE test1; +-- not allowed in a function +CREATE FUNCTION transaction_test2() RETURNS int +LANGUAGE pltcl +AS $$ +for {set i 0} {$i < 10} {incr i} { + spi_exec "INSERT INTO test1 (a) VALUES ($i)" + if {$i % 2 == 0} { + commit + } else { + rollback + } +} +return 1 +$$; +SELECT transaction_test2(); +ERROR: invalid transaction termination +SELECT * FROM test1; + a | b +---+--- +(0 rows) + +-- also not allowed if procedure is called from a function +CREATE FUNCTION transaction_test3() RETURNS int +LANGUAGE pltcl +AS $$ +spi_exec "CALL transaction_test1()" +return 1 +$$; +SELECT transaction_test3(); +ERROR: invalid transaction termination +SELECT * FROM test1; + a | b +---+--- +(0 rows) + +-- commit inside cursor loop +CREATE TABLE test2 (x int); +INSERT INTO test2 VALUES (0), (1), (2), (3), (4); +TRUNCATE test1; +CREATE PROCEDURE transaction_test4a() +LANGUAGE pltcl +AS $$ +spi_exec -array row "SELECT * FROM test2 ORDER BY x" { + spi_exec "INSERT INTO test1 (a) VALUES ($row(x))" + commit +} +$$; +CALL transaction_test4a(); +ERROR: cannot commit while a subtransaction is active +SELECT * FROM test1; + a | b +---+--- +(0 rows) + +-- rollback inside cursor loop +TRUNCATE test1; +CREATE PROCEDURE transaction_test4b() +LANGUAGE pltcl +AS $$ +spi_exec -array row "SELECT * FROM test2 ORDER BY x" { + spi_exec "INSERT INTO test1 (a) VALUES ($row(x))" + rollback +} +$$; +CALL transaction_test4b(); +ERROR: cannot roll back while a subtransaction is active +SELECT * FROM test1; + a | b +---+--- +(0 rows) + +DROP TABLE test1; +DROP TABLE test2; diff --git a/src/pl/tcl/expected/pltcl_trigger.out b/src/pl/tcl/expected/pltcl_trigger.out new file mode 100644 index 0000000..008ea19 --- /dev/null +++ b/src/pl/tcl/expected/pltcl_trigger.out @@ -0,0 +1,888 @@ +-- suppress CONTEXT so that function OIDs aren't in output +\set VERBOSITY terse +-- +-- Create the tables used in the test queries +-- +-- T_pkey1 is the primary key table for T_dta1. Entries from T_pkey1 +-- Cannot be changed or deleted if they are referenced from T_dta1. +-- +-- T_pkey2 is the primary key table for T_dta2. If the key values in +-- T_pkey2 are changed, the references in T_dta2 follow. If entries +-- are deleted, the referencing entries from T_dta2 are deleted too. +-- The values for field key2 in T_pkey2 are silently converted to +-- upper case on insert/update. +-- +create table T_pkey1 ( + key1 int4, + key2 char(20), + txt char(40) +); +create table T_pkey2 ( + key1 int4, + key2 char(20), + txt char(40) +); +create table T_dta1 ( + tkey char(10), + ref1 int4, + ref2 char(20) +); +create table T_dta2 ( + tkey char(10), + ref1 int4, + ref2 char(20) +); +-- +-- Function to check key existence in T_pkey1 +-- +create function check_pkey1_exists(int4, bpchar) returns bool as E' + if {![info exists GD]} { + set GD(plan) [spi_prepare \\ + "select 1 from T_pkey1 \\ + where key1 = \\$1 and key2 = \\$2" \\ + {int4 bpchar}] + } + + set n [spi_execp -count 1 $GD(plan) [list $1 $2]] + + if {$n > 0} { + return "t" + } + return "f" +' language pltcl; +-- dump trigger data +CREATE TABLE trigger_test ( + i int, + v text, + dropme text, + test_skip boolean DEFAULT false, + test_return_null boolean DEFAULT false, + test_argisnull boolean DEFAULT false +); +-- Make certain dropped attributes are handled correctly +ALTER TABLE trigger_test DROP dropme; +CREATE TABLE trigger_test_generated ( + i int, + j int GENERATED ALWAYS AS (i * 2) STORED +); +CREATE VIEW trigger_test_view AS SELECT i, v FROM trigger_test; +CREATE FUNCTION trigger_data() returns trigger language pltcl as $_$ + if {$TG_table_name eq "trigger_test" && $TG_level eq "ROW" && $TG_op ne "DELETE"} { + # Special case tests + if {$NEW(test_return_null) eq "t" } { + return_null + } + if {$NEW(test_argisnull) eq "t" } { + set should_error [argisnull 1] + } + if {$NEW(test_skip) eq "t" } { + elog NOTICE "SKIPPING OPERATION $TG_op" + return SKIP + } + } + + if { [info exists TG_relid] } { + set TG_relid "bogus:12345" + } + + set dnames [info locals {[a-zA-Z]*} ] + + foreach key [lsort $dnames] { + + if { [array exists $key] } { + set str "{" + foreach akey [lsort [ array names $key ] ] { + if {[string length $str] > 1} { set str "$str, " } + set cmd "($akey)" + set cmd "set val \$$key$cmd" + eval $cmd + set str "$str$akey: $val" + } + set str "$str}" + elog NOTICE "$key: $str" + } else { + set val [eval list "\$$key" ] + elog NOTICE "$key: $val" + } + } + + + return OK + +$_$; +CREATE TRIGGER show_trigger_data_trig +BEFORE INSERT OR UPDATE OR DELETE ON trigger_test +FOR EACH ROW EXECUTE PROCEDURE trigger_data(23,'skidoo'); +CREATE TRIGGER statement_trigger +BEFORE INSERT OR UPDATE OR DELETE OR TRUNCATE ON trigger_test +FOR EACH STATEMENT EXECUTE PROCEDURE trigger_data(42,'statement trigger'); +CREATE TRIGGER show_trigger_data_trig_before +BEFORE INSERT OR UPDATE OR DELETE ON trigger_test_generated +FOR EACH ROW EXECUTE PROCEDURE trigger_data(); +CREATE TRIGGER show_trigger_data_trig_after +AFTER INSERT OR UPDATE OR DELETE ON trigger_test_generated +FOR EACH ROW EXECUTE PROCEDURE trigger_data(); +CREATE TRIGGER show_trigger_data_view_trig +INSTEAD OF INSERT OR UPDATE OR DELETE ON trigger_test_view +FOR EACH ROW EXECUTE PROCEDURE trigger_data(24,'skidoo view'); +-- +-- Trigger function on every change to T_pkey1 +-- +create function trig_pkey1_before() returns trigger as E' + # + # Create prepared plans on the first call + # + if {![info exists GD]} { + # + # Plan to check for duplicate key in T_pkey1 + # + set GD(plan_pkey1) [spi_prepare \\ + "select check_pkey1_exists(\\$1, \\$2) as ret" \\ + {int4 bpchar}] + # + # Plan to check for references from T_dta1 + # + set GD(plan_dta1) [spi_prepare \\ + "select 1 from T_dta1 \\ + where ref1 = \\$1 and ref2 = \\$2" \\ + {int4 bpchar}] + } + + # + # Initialize flags + # + set check_old_ref 0 + set check_new_dup 0 + + switch $TG_op { + INSERT { + # + # Must check for duplicate key on INSERT + # + set check_new_dup 1 + } + UPDATE { + # + # Must check for duplicate key on UPDATE only if + # the key changes. In that case we must check for + # references to OLD values too. + # + if {[string compare $NEW(key1) $OLD(key1)] != 0} { + set check_old_ref 1 + set check_new_dup 1 + } + if {[string compare $NEW(key2) $OLD(key2)] != 0} { + set check_old_ref 1 + set check_new_dup 1 + } + } + DELETE { + # + # Must only check for references to OLD on DELETE + # + set check_old_ref 1 + } + } + + if {$check_new_dup} { + # + # Check for duplicate key + # + spi_execp -count 1 $GD(plan_pkey1) [list $NEW(key1) $NEW(key2)] + if {$ret == "t"} { + elog ERROR \\ + "duplicate key ''$NEW(key1)'', ''$NEW(key2)'' for T_pkey1" + } + } + + if {$check_old_ref} { + # + # Check for references to OLD + # + set n [spi_execp -count 1 $GD(plan_dta1) [list $OLD(key1) $OLD(key2)]] + if {$n > 0} { + elog ERROR \\ + "key ''$OLD(key1)'', ''$OLD(key2)'' referenced by T_dta1" + } + } + + # + # Anything is fine - let operation pass through + # + return OK +' language pltcl; +create trigger pkey1_before before insert or update or delete on T_pkey1 + for each row execute procedure + trig_pkey1_before(); +-- +-- Trigger function to check for duplicate keys in T_pkey2 +-- and to force key2 to be upper case only without leading whitespaces +-- +create function trig_pkey2_before() returns trigger as E' + # + # Prepare plan on first call + # + if {![info exists GD]} { + set GD(plan_pkey2) [spi_prepare \\ + "select 1 from T_pkey2 \\ + where key1 = \\$1 and key2 = \\$2" \\ + {int4 bpchar}] + } + + # + # Convert key2 value + # + set NEW(key2) [string toupper [string trim $NEW(key2)]] + + # + # Check for duplicate key + # + set n [spi_execp -count 1 $GD(plan_pkey2) [list $NEW(key1) $NEW(key2)]] + if {$n > 0} { + elog ERROR \\ + "duplicate key ''$NEW(key1)'', ''$NEW(key2)'' for T_pkey2" + } + + # + # Return modified tuple in NEW + # + return [array get NEW] +' language pltcl; +create trigger pkey2_before before insert or update on T_pkey2 + for each row execute procedure + trig_pkey2_before(); +-- +-- Trigger function to force references from T_dta2 follow changes +-- in T_pkey2 or be deleted too. This must be done AFTER the changes +-- in T_pkey2 are done so the trigger for primkey check on T_dta2 +-- fired on our updates will see the new key values in T_pkey2. +-- +create function trig_pkey2_after() returns trigger as E' + # + # Prepare plans on first call + # + if {![info exists GD]} { + # + # Plan to update references from T_dta2 + # + set GD(plan_dta2_upd) [spi_prepare \\ + "update T_dta2 set ref1 = \\$3, ref2 = \\$4 \\ + where ref1 = \\$1 and ref2 = \\$2" \\ + {int4 bpchar int4 bpchar}] + # + # Plan to delete references from T_dta2 + # + set GD(plan_dta2_del) [spi_prepare \\ + "delete from T_dta2 \\ + where ref1 = \\$1 and ref2 = \\$2" \\ + {int4 bpchar}] + } + + # + # Initialize flags + # + set old_ref_follow 0 + set old_ref_delete 0 + + switch $TG_op { + UPDATE { + # + # On update we must let old references follow + # + set NEW(key2) [string toupper $NEW(key2)] + + if {[string compare $NEW(key1) $OLD(key1)] != 0} { + set old_ref_follow 1 + } + if {[string compare $NEW(key2) $OLD(key2)] != 0} { + set old_ref_follow 1 + } + } + DELETE { + # + # On delete we must delete references too + # + set old_ref_delete 1 + } + } + + if {$old_ref_follow} { + # + # Let old references follow and fire NOTICE message if + # there where some + # + set n [spi_execp $GD(plan_dta2_upd) \\ + [list $OLD(key1) $OLD(key2) $NEW(key1) $NEW(key2)]] + if {$n > 0} { + elog NOTICE \\ + "updated $n entries in T_dta2 for new key in T_pkey2" + } + } + + if {$old_ref_delete} { + # + # delete references and fire NOTICE message if + # there where some + # + set n [spi_execp $GD(plan_dta2_del) \\ + [list $OLD(key1) $OLD(key2)]] + if {$n > 0} { + elog NOTICE \\ + "deleted $n entries from T_dta2" + } + } + + return OK +' language pltcl; +create trigger pkey2_after after update or delete on T_pkey2 + for each row execute procedure + trig_pkey2_after(); +-- +-- Generic trigger function to check references in T_dta1 and T_dta2 +-- +create function check_primkey() returns trigger as E' + # + # For every trigger/relation pair we create + # a saved plan and hold them in GD + # + set plankey [list "plan" $TG_name $TG_relid] + set planrel [list "relname" $TG_relid] + + # + # Extract the pkey relation name + # + set keyidx [expr [llength $args] / 2] + set keyrel [string tolower [lindex $args $keyidx]] + + if {![info exists GD($plankey)]} { + # + # We must prepare a new plan. Build up a query string + # for the primary key check. + # + set keylist [lrange $args [expr $keyidx + 1] end] + + set query "select 1 from $keyrel" + set qual " where" + set typlist "" + set idx 1 + foreach key $keylist { + set key [string tolower $key] + # + # Add the qual part to the query string + # + append query "$qual $key = \\$$idx" + set qual " and" + + # + # Lookup the fields type in pg_attribute + # + set n [spi_exec "select T.typname \\ + from pg_catalog.pg_type T, pg_catalog.pg_attribute A, pg_catalog.pg_class C \\ + where C.relname = ''[quote $keyrel]'' \\ + and C.oid = A.attrelid \\ + and A.attname = ''[quote $key]'' \\ + and A.atttypid = T.oid"] + if {$n != 1} { + elog ERROR "table $keyrel doesn''t have a field named $key" + } + + # + # Append the fields type to the argument type list + # + lappend typlist $typname + incr idx + } + + # + # Prepare the plan + # + set GD($plankey) [spi_prepare $query $typlist] + + # + # Lookup and remember the table name for later error messages + # + spi_exec "select relname from pg_catalog.pg_class \\ + where oid = ''$TG_relid''::oid" + set GD($planrel) $relname + } + + # + # Build the argument list from the NEW row + # + incr keyidx -1 + set arglist "" + foreach arg [lrange $args 0 $keyidx] { + lappend arglist $NEW($arg) + } + + # + # Check for the primary key + # + set n [spi_execp -count 1 $GD($plankey) $arglist] + if {$n <= 0} { + elog ERROR "key for $GD($planrel) not in $keyrel" + } + + # + # Anything is fine + # + return OK +' language pltcl; +create trigger dta1_before before insert or update on T_dta1 + for each row execute procedure + check_primkey('ref1', 'ref2', 'T_pkey1', 'key1', 'key2'); +create trigger dta2_before before insert or update on T_dta2 + for each row execute procedure + check_primkey('ref1', 'ref2', 'T_pkey2', 'key1', 'key2'); +insert into T_pkey1 values (1, 'key1-1', 'test key'); +insert into T_pkey1 values (1, 'key1-2', 'test key'); +insert into T_pkey1 values (1, 'key1-3', 'test key'); +insert into T_pkey1 values (2, 'key2-1', 'test key'); +insert into T_pkey1 values (2, 'key2-2', 'test key'); +insert into T_pkey1 values (2, 'key2-3', 'test key'); +insert into T_pkey2 values (1, 'key1-1', 'test key'); +insert into T_pkey2 values (1, 'key1-2', 'test key'); +insert into T_pkey2 values (1, 'key1-3', 'test key'); +insert into T_pkey2 values (2, 'key2-1', 'test key'); +insert into T_pkey2 values (2, 'key2-2', 'test key'); +insert into T_pkey2 values (2, 'key2-3', 'test key'); +select * from T_pkey1; + key1 | key2 | txt +------+----------------------+------------------------------------------ + 1 | key1-1 | test key + 1 | key1-2 | test key + 1 | key1-3 | test key + 2 | key2-1 | test key + 2 | key2-2 | test key + 2 | key2-3 | test key +(6 rows) + +-- key2 in T_pkey2 should have upper case only +select * from T_pkey2; + key1 | key2 | txt +------+----------------------+------------------------------------------ + 1 | KEY1-1 | test key + 1 | KEY1-2 | test key + 1 | KEY1-3 | test key + 2 | KEY2-1 | test key + 2 | KEY2-2 | test key + 2 | KEY2-3 | test key +(6 rows) + +insert into T_pkey1 values (1, 'KEY1-3', 'should work'); +-- Due to the upper case translation in trigger this must fail +insert into T_pkey2 values (1, 'KEY1-3', 'should fail'); +ERROR: duplicate key '1', 'KEY1-3' for T_pkey2 +insert into T_dta1 values ('trec 1', 1, 'key1-1'); +insert into T_dta1 values ('trec 2', 1, 'key1-2'); +insert into T_dta1 values ('trec 3', 1, 'key1-3'); +-- Must fail due to unknown key in T_pkey1 +insert into T_dta1 values ('trec 4', 1, 'key1-4'); +ERROR: key for t_dta1 not in t_pkey1 +insert into T_dta2 values ('trec 1', 1, 'KEY1-1'); +insert into T_dta2 values ('trec 2', 1, 'KEY1-2'); +insert into T_dta2 values ('trec 3', 1, 'KEY1-3'); +-- Must fail due to unknown key in T_pkey2 +insert into T_dta2 values ('trec 4', 1, 'KEY1-4'); +ERROR: key for t_dta2 not in t_pkey2 +select * from T_dta1; + tkey | ref1 | ref2 +------------+------+---------------------- + trec 1 | 1 | key1-1 + trec 2 | 1 | key1-2 + trec 3 | 1 | key1-3 +(3 rows) + +select * from T_dta2; + tkey | ref1 | ref2 +------------+------+---------------------- + trec 1 | 1 | KEY1-1 + trec 2 | 1 | KEY1-2 + trec 3 | 1 | KEY1-3 +(3 rows) + +update T_pkey1 set key2 = 'key2-9' where key1 = 2 and key2 = 'key2-1'; +update T_pkey1 set key2 = 'key1-9' where key1 = 1 and key2 = 'key1-1'; +ERROR: key '1', 'key1-1 ' referenced by T_dta1 +delete from T_pkey1 where key1 = 2 and key2 = 'key2-2'; +delete from T_pkey1 where key1 = 1 and key2 = 'key1-2'; +ERROR: key '1', 'key1-2 ' referenced by T_dta1 +update T_pkey2 set key2 = 'KEY2-9' where key1 = 2 and key2 = 'KEY2-1'; +update T_pkey2 set key2 = 'KEY1-9' where key1 = 1 and key2 = 'KEY1-1'; +NOTICE: updated 1 entries in T_dta2 for new key in T_pkey2 +delete from T_pkey2 where key1 = 2 and key2 = 'KEY2-2'; +delete from T_pkey2 where key1 = 1 and key2 = 'KEY1-2'; +NOTICE: deleted 1 entries from T_dta2 +select * from T_pkey1; + key1 | key2 | txt +------+----------------------+------------------------------------------ + 1 | key1-1 | test key + 1 | key1-2 | test key + 1 | key1-3 | test key + 2 | key2-3 | test key + 1 | KEY1-3 | should work + 2 | key2-9 | test key +(6 rows) + +select * from T_pkey2; + key1 | key2 | txt +------+----------------------+------------------------------------------ + 1 | KEY1-3 | test key + 2 | KEY2-3 | test key + 2 | KEY2-9 | test key + 1 | KEY1-9 | test key +(4 rows) + +select * from T_dta1; + tkey | ref1 | ref2 +------------+------+---------------------- + trec 1 | 1 | key1-1 + trec 2 | 1 | key1-2 + trec 3 | 1 | key1-3 +(3 rows) + +select * from T_dta2; + tkey | ref1 | ref2 +------------+------+---------------------- + trec 3 | 1 | KEY1-3 + trec 1 | 1 | KEY1-9 +(2 rows) + +select tcl_avg(key1) from T_pkey1; + tcl_avg +--------- + 1 +(1 row) + +select tcl_sum(key1) from T_pkey1; + tcl_sum +--------- + 8 +(1 row) + +select tcl_avg(key1) from T_pkey2; + tcl_avg +--------- + 1 +(1 row) + +select tcl_sum(key1) from T_pkey2; + tcl_sum +--------- + 6 +(1 row) + +-- The following should return NULL instead of 0 +select tcl_avg(key1) from T_pkey1 where key1 = 99; + tcl_avg +--------- + +(1 row) + +select tcl_sum(key1) from T_pkey1 where key1 = 99; + tcl_sum +--------- + 0 +(1 row) + +select 1 @< 2; + ?column? +---------- + t +(1 row) + +select 100 @< 4; + ?column? +---------- + f +(1 row) + +select * from T_pkey1 order by key1 using @<, key2 collate "C"; + key1 | key2 | txt +------+----------------------+------------------------------------------ + 1 | KEY1-3 | should work + 1 | key1-1 | test key + 1 | key1-2 | test key + 1 | key1-3 | test key + 2 | key2-3 | test key + 2 | key2-9 | test key +(6 rows) + +select * from T_pkey2 order by key1 using @<, key2 collate "C"; + key1 | key2 | txt +------+----------------------+------------------------------------------ + 1 | KEY1-3 | test key + 1 | KEY1-9 | test key + 2 | KEY2-3 | test key + 2 | KEY2-9 | test key +(4 rows) + +-- show dump of trigger data +insert into trigger_test values(1,'insert'); +NOTICE: NEW: {} +NOTICE: OLD: {} +NOTICE: TG_level: STATEMENT +NOTICE: TG_name: statement_trigger +NOTICE: TG_op: INSERT +NOTICE: TG_relatts: {{} i v {} test_skip test_return_null test_argisnull} +NOTICE: TG_relid: bogus:12345 +NOTICE: TG_table_name: trigger_test +NOTICE: TG_table_schema: public +NOTICE: TG_when: BEFORE +NOTICE: args: {42 {statement trigger}} +NOTICE: NEW: {i: 1, test_argisnull: f, test_return_null: f, test_skip: f, v: insert} +NOTICE: OLD: {} +NOTICE: TG_level: ROW +NOTICE: TG_name: show_trigger_data_trig +NOTICE: TG_op: INSERT +NOTICE: TG_relatts: {{} i v {} test_skip test_return_null test_argisnull} +NOTICE: TG_relid: bogus:12345 +NOTICE: TG_table_name: trigger_test +NOTICE: TG_table_schema: public +NOTICE: TG_when: BEFORE +NOTICE: args: {23 skidoo} +insert into trigger_test_generated (i) values (1); +NOTICE: NEW: {i: 1} +NOTICE: OLD: {} +NOTICE: TG_level: ROW +NOTICE: TG_name: show_trigger_data_trig_before +NOTICE: TG_op: INSERT +NOTICE: TG_relatts: {{} i j} +NOTICE: TG_relid: bogus:12345 +NOTICE: TG_table_name: trigger_test_generated +NOTICE: TG_table_schema: public +NOTICE: TG_when: BEFORE +NOTICE: args: {} +NOTICE: NEW: {i: 1, j: 2} +NOTICE: OLD: {} +NOTICE: TG_level: ROW +NOTICE: TG_name: show_trigger_data_trig_after +NOTICE: TG_op: INSERT +NOTICE: TG_relatts: {{} i j} +NOTICE: TG_relid: bogus:12345 +NOTICE: TG_table_name: trigger_test_generated +NOTICE: TG_table_schema: public +NOTICE: TG_when: AFTER +NOTICE: args: {} +update trigger_test_generated set i = 11 where i = 1; +NOTICE: NEW: {i: 11} +NOTICE: OLD: {i: 1, j: 2} +NOTICE: TG_level: ROW +NOTICE: TG_name: show_trigger_data_trig_before +NOTICE: TG_op: UPDATE +NOTICE: TG_relatts: {{} i j} +NOTICE: TG_relid: bogus:12345 +NOTICE: TG_table_name: trigger_test_generated +NOTICE: TG_table_schema: public +NOTICE: TG_when: BEFORE +NOTICE: args: {} +NOTICE: NEW: {i: 11, j: 22} +NOTICE: OLD: {i: 1, j: 2} +NOTICE: TG_level: ROW +NOTICE: TG_name: show_trigger_data_trig_after +NOTICE: TG_op: UPDATE +NOTICE: TG_relatts: {{} i j} +NOTICE: TG_relid: bogus:12345 +NOTICE: TG_table_name: trigger_test_generated +NOTICE: TG_table_schema: public +NOTICE: TG_when: AFTER +NOTICE: args: {} +delete from trigger_test_generated; +NOTICE: NEW: {} +NOTICE: OLD: {i: 11, j: 22} +NOTICE: TG_level: ROW +NOTICE: TG_name: show_trigger_data_trig_before +NOTICE: TG_op: DELETE +NOTICE: TG_relatts: {{} i j} +NOTICE: TG_relid: bogus:12345 +NOTICE: TG_table_name: trigger_test_generated +NOTICE: TG_table_schema: public +NOTICE: TG_when: BEFORE +NOTICE: args: {} +NOTICE: NEW: {} +NOTICE: OLD: {i: 11, j: 22} +NOTICE: TG_level: ROW +NOTICE: TG_name: show_trigger_data_trig_after +NOTICE: TG_op: DELETE +NOTICE: TG_relatts: {{} i j} +NOTICE: TG_relid: bogus:12345 +NOTICE: TG_table_name: trigger_test_generated +NOTICE: TG_table_schema: public +NOTICE: TG_when: AFTER +NOTICE: args: {} +insert into trigger_test_view values(2,'insert'); +NOTICE: NEW: {i: 2, v: insert} +NOTICE: OLD: {} +NOTICE: TG_level: ROW +NOTICE: TG_name: show_trigger_data_view_trig +NOTICE: TG_op: INSERT +NOTICE: TG_relatts: {{} i v} +NOTICE: TG_relid: bogus:12345 +NOTICE: TG_table_name: trigger_test_view +NOTICE: TG_table_schema: public +NOTICE: TG_when: {INSTEAD OF} +NOTICE: args: {24 {skidoo view}} +update trigger_test_view set v = 'update' where i=1; +NOTICE: NEW: {i: 1, v: update} +NOTICE: OLD: {i: 1, v: insert} +NOTICE: TG_level: ROW +NOTICE: TG_name: show_trigger_data_view_trig +NOTICE: TG_op: UPDATE +NOTICE: TG_relatts: {{} i v} +NOTICE: TG_relid: bogus:12345 +NOTICE: TG_table_name: trigger_test_view +NOTICE: TG_table_schema: public +NOTICE: TG_when: {INSTEAD OF} +NOTICE: args: {24 {skidoo view}} +delete from trigger_test_view; +NOTICE: NEW: {} +NOTICE: OLD: {i: 1, v: insert} +NOTICE: TG_level: ROW +NOTICE: TG_name: show_trigger_data_view_trig +NOTICE: TG_op: DELETE +NOTICE: TG_relatts: {{} i v} +NOTICE: TG_relid: bogus:12345 +NOTICE: TG_table_name: trigger_test_view +NOTICE: TG_table_schema: public +NOTICE: TG_when: {INSTEAD OF} +NOTICE: args: {24 {skidoo view}} +update trigger_test set v = 'update', test_skip=true where i = 1; +NOTICE: NEW: {} +NOTICE: OLD: {} +NOTICE: TG_level: STATEMENT +NOTICE: TG_name: statement_trigger +NOTICE: TG_op: UPDATE +NOTICE: TG_relatts: {{} i v {} test_skip test_return_null test_argisnull} +NOTICE: TG_relid: bogus:12345 +NOTICE: TG_table_name: trigger_test +NOTICE: TG_table_schema: public +NOTICE: TG_when: BEFORE +NOTICE: args: {42 {statement trigger}} +NOTICE: SKIPPING OPERATION UPDATE +update trigger_test set v = 'update' where i = 1; +NOTICE: NEW: {} +NOTICE: OLD: {} +NOTICE: TG_level: STATEMENT +NOTICE: TG_name: statement_trigger +NOTICE: TG_op: UPDATE +NOTICE: TG_relatts: {{} i v {} test_skip test_return_null test_argisnull} +NOTICE: TG_relid: bogus:12345 +NOTICE: TG_table_name: trigger_test +NOTICE: TG_table_schema: public +NOTICE: TG_when: BEFORE +NOTICE: args: {42 {statement trigger}} +NOTICE: NEW: {i: 1, test_argisnull: f, test_return_null: f, test_skip: f, v: update} +NOTICE: OLD: {i: 1, test_argisnull: f, test_return_null: f, test_skip: f, v: insert} +NOTICE: TG_level: ROW +NOTICE: TG_name: show_trigger_data_trig +NOTICE: TG_op: UPDATE +NOTICE: TG_relatts: {{} i v {} test_skip test_return_null test_argisnull} +NOTICE: TG_relid: bogus:12345 +NOTICE: TG_table_name: trigger_test +NOTICE: TG_table_schema: public +NOTICE: TG_when: BEFORE +NOTICE: args: {23 skidoo} +delete from trigger_test; +NOTICE: NEW: {} +NOTICE: OLD: {} +NOTICE: TG_level: STATEMENT +NOTICE: TG_name: statement_trigger +NOTICE: TG_op: DELETE +NOTICE: TG_relatts: {{} i v {} test_skip test_return_null test_argisnull} +NOTICE: TG_relid: bogus:12345 +NOTICE: TG_table_name: trigger_test +NOTICE: TG_table_schema: public +NOTICE: TG_when: BEFORE +NOTICE: args: {42 {statement trigger}} +NOTICE: NEW: {} +NOTICE: OLD: {i: 1, test_argisnull: f, test_return_null: f, test_skip: f, v: update} +NOTICE: TG_level: ROW +NOTICE: TG_name: show_trigger_data_trig +NOTICE: TG_op: DELETE +NOTICE: TG_relatts: {{} i v {} test_skip test_return_null test_argisnull} +NOTICE: TG_relid: bogus:12345 +NOTICE: TG_table_name: trigger_test +NOTICE: TG_table_schema: public +NOTICE: TG_when: BEFORE +NOTICE: args: {23 skidoo} +truncate trigger_test; +NOTICE: NEW: {} +NOTICE: OLD: {} +NOTICE: TG_level: STATEMENT +NOTICE: TG_name: statement_trigger +NOTICE: TG_op: TRUNCATE +NOTICE: TG_relatts: {{} i v {} test_skip test_return_null test_argisnull} +NOTICE: TG_relid: bogus:12345 +NOTICE: TG_table_name: trigger_test +NOTICE: TG_table_schema: public +NOTICE: TG_when: BEFORE +NOTICE: args: {42 {statement trigger}} +DROP TRIGGER show_trigger_data_trig_before ON trigger_test_generated; +DROP TRIGGER show_trigger_data_trig_after ON trigger_test_generated; +-- should error +insert into trigger_test(test_argisnull) values(true); +NOTICE: NEW: {} +NOTICE: OLD: {} +NOTICE: TG_level: STATEMENT +NOTICE: TG_name: statement_trigger +NOTICE: TG_op: INSERT +NOTICE: TG_relatts: {{} i v {} test_skip test_return_null test_argisnull} +NOTICE: TG_relid: bogus:12345 +NOTICE: TG_table_name: trigger_test +NOTICE: TG_table_schema: public +NOTICE: TG_when: BEFORE +NOTICE: args: {42 {statement trigger}} +ERROR: argisnull cannot be used in triggers +-- should error +insert into trigger_test(test_return_null) values(true); +NOTICE: NEW: {} +NOTICE: OLD: {} +NOTICE: TG_level: STATEMENT +NOTICE: TG_name: statement_trigger +NOTICE: TG_op: INSERT +NOTICE: TG_relatts: {{} i v {} test_skip test_return_null test_argisnull} +NOTICE: TG_relid: bogus:12345 +NOTICE: TG_table_name: trigger_test +NOTICE: TG_table_schema: public +NOTICE: TG_when: BEFORE +NOTICE: args: {42 {statement trigger}} +ERROR: return_null cannot be used in triggers +-- test transition table visibility +create table transition_table_test (id int, name text); +insert into transition_table_test values (1, 'a'); +create function transition_table_test_f() returns trigger language pltcl as +$$ + spi_exec -array C "SELECT id, name FROM old_table" { + elog INFO "old: $C(id) -> $C(name)" + } + spi_exec -array C "SELECT id, name FROM new_table" { + elog INFO "new: $C(id) -> $C(name)" + } + return OK +$$; +CREATE TRIGGER a_t AFTER UPDATE ON transition_table_test + REFERENCING OLD TABLE AS old_table NEW TABLE AS new_table + FOR EACH STATEMENT EXECUTE PROCEDURE transition_table_test_f(); +update transition_table_test set name = 'b'; +INFO: old: 1 -> a +INFO: new: 1 -> b +drop table transition_table_test; +drop function transition_table_test_f(); +-- dealing with generated columns +CREATE FUNCTION generated_test_func1() RETURNS trigger +LANGUAGE pltcl +AS $$ +# not allowed +set NEW(j) 5 +return [array get NEW] +$$; +CREATE TRIGGER generated_test_trigger1 BEFORE INSERT ON trigger_test_generated +FOR EACH ROW EXECUTE PROCEDURE generated_test_func1(); +TRUNCATE trigger_test_generated; +INSERT INTO trigger_test_generated (i) VALUES (1); +ERROR: cannot set generated column "j" +SELECT * FROM trigger_test_generated; + i | j +---+--- +(0 rows) + diff --git a/src/pl/tcl/expected/pltcl_unicode.out b/src/pl/tcl/expected/pltcl_unicode.out new file mode 100644 index 0000000..eea7d70 --- /dev/null +++ b/src/pl/tcl/expected/pltcl_unicode.out @@ -0,0 +1,45 @@ +-- +-- Unicode handling +-- +-- Note: this test case is known to fail if the database encoding is +-- EUC_CN, EUC_JP, EUC_KR, or EUC_TW, for lack of any equivalent to +-- U+00A0 (no-break space) in those encodings. However, testing with +-- plain ASCII data would be rather useless, so we must live with that. +-- +SET client_encoding TO UTF8; +CREATE TABLE unicode_test ( + testvalue text NOT NULL +); +CREATE FUNCTION unicode_return() RETURNS text AS $$ + return "\xA0" +$$ LANGUAGE pltcl; +CREATE FUNCTION unicode_trigger() RETURNS trigger AS $$ + set NEW(testvalue) "\xA0" + return [array get NEW] +$$ LANGUAGE pltcl; +CREATE TRIGGER unicode_test_bi BEFORE INSERT ON unicode_test + FOR EACH ROW EXECUTE PROCEDURE unicode_trigger(); +CREATE FUNCTION unicode_plan1() RETURNS text AS $$ + set plan [ spi_prepare {SELECT $1 AS testvalue} [ list "text" ] ] + spi_execp $plan [ list "\xA0" ] + return $testvalue +$$ LANGUAGE pltcl; +SELECT unicode_return(); + unicode_return +---------------- + +(1 row) + +INSERT INTO unicode_test (testvalue) VALUES ('test'); +SELECT * FROM unicode_test; + testvalue +----------- + +(1 row) + +SELECT unicode_plan1(); + unicode_plan1 +--------------- + +(1 row) + diff --git a/src/pl/tcl/generate-pltclerrcodes.pl b/src/pl/tcl/generate-pltclerrcodes.pl new file mode 100644 index 0000000..59ea2ba --- /dev/null +++ b/src/pl/tcl/generate-pltclerrcodes.pl @@ -0,0 +1,40 @@ +#!/usr/bin/perl +# +# Generate the pltclerrcodes.h header from errcodes.txt +# Copyright (c) 2000-2020, PostgreSQL Global Development Group + +use warnings; +use strict; + +print + "/* autogenerated from src/backend/utils/errcodes.txt, do not edit */\n"; +print "/* there is deliberately not an #ifndef PLTCLERRCODES_H here */\n"; + +open my $errcodes, '<', $ARGV[0] or die; + +while (<$errcodes>) +{ + chomp; + + # Skip comments + next if /^#/; + next if /^\s*$/; + + # Skip section headers + next if /^Section:/; + + die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/; + + (my $sqlstate, my $type, my $errcode_macro, my $condition_name) = + ($1, $2, $3, $4); + + # Skip non-errors + next unless $type eq 'E'; + + # Skip lines without PL/pgSQL condition names + next unless defined($condition_name); + + print "{\n\t\"$condition_name\", $errcode_macro\n},\n\n"; +} + +close $errcodes; diff --git a/src/pl/tcl/nls.mk b/src/pl/tcl/nls.mk new file mode 100644 index 0000000..1f17ba1 --- /dev/null +++ b/src/pl/tcl/nls.mk @@ -0,0 +1,6 @@ +# src/pl/tcl/nls.mk +CATALOG_NAME = pltcl +AVAIL_LANGUAGES = cs de es fr it ja ko pl pt_BR ru sv tr uk vi zh_CN +GETTEXT_FILES = pltcl.c +GETTEXT_TRIGGERS = $(BACKEND_COMMON_GETTEXT_TRIGGERS) +GETTEXT_FLAGS = $(BACKEND_COMMON_GETTEXT_FLAGS) diff --git a/src/pl/tcl/pltcl--1.0.sql b/src/pl/tcl/pltcl--1.0.sql new file mode 100644 index 0000000..2ed2b92 --- /dev/null +++ b/src/pl/tcl/pltcl--1.0.sql @@ -0,0 +1,12 @@ +/* src/pl/tcl/pltcl--1.0.sql */ + +CREATE FUNCTION pltcl_call_handler() RETURNS language_handler + LANGUAGE c AS 'MODULE_PATHNAME'; + +CREATE TRUSTED LANGUAGE pltcl + HANDLER pltcl_call_handler; + +-- The language object, but not the functions, can be owned by a non-superuser. +ALTER LANGUAGE pltcl OWNER TO @extowner@; + +COMMENT ON LANGUAGE pltcl IS 'PL/Tcl procedural language'; diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c new file mode 100644 index 0000000..24d4b57 --- /dev/null +++ b/src/pl/tcl/pltcl.c @@ -0,0 +1,3288 @@ +/********************************************************************** + * pltcl.c - PostgreSQL support for Tcl as + * procedural language (PL) + * + * src/pl/tcl/pltcl.c + * + **********************************************************************/ + +#include "postgres.h" + +#include <tcl.h> + +#include <unistd.h> +#include <fcntl.h> + +#include "access/htup_details.h" +#include "access/xact.h" +#include "catalog/objectaccess.h" +#include "catalog/pg_proc.h" +#include "catalog/pg_type.h" +#include "commands/event_trigger.h" +#include "commands/trigger.h" +#include "executor/spi.h" +#include "fmgr.h" +#include "funcapi.h" +#include "mb/pg_wchar.h" +#include "miscadmin.h" +#include "nodes/makefuncs.h" +#include "parser/parse_func.h" +#include "parser/parse_type.h" +#include "pgstat.h" +#include "tcop/tcopprot.h" +#include "utils/acl.h" +#include "utils/builtins.h" +#include "utils/lsyscache.h" +#include "utils/memutils.h" +#include "utils/regproc.h" +#include "utils/rel.h" +#include "utils/syscache.h" +#include "utils/typcache.h" + + +PG_MODULE_MAGIC; + +#define HAVE_TCL_VERSION(maj,min) \ + ((TCL_MAJOR_VERSION > maj) || \ + (TCL_MAJOR_VERSION == maj && TCL_MINOR_VERSION >= min)) + +/* Insist on Tcl >= 8.4 */ +#if !HAVE_TCL_VERSION(8,4) +#error PostgreSQL only supports Tcl 8.4 or later. +#endif + +/* Hack to deal with Tcl 8.6 const-ification without losing compatibility */ +#ifndef CONST86 +#define CONST86 +#endif + +/* define our text domain for translations */ +#undef TEXTDOMAIN +#define TEXTDOMAIN PG_TEXTDOMAIN("pltcl") + + +/* + * Support for converting between UTF8 (which is what all strings going into + * or out of Tcl should be) and the database encoding. + * + * If you just use utf_u2e() or utf_e2u() directly, they will leak some + * palloc'd space when doing a conversion. This is not worth worrying about + * if it only happens, say, once per PL/Tcl function call. If it does seem + * worth worrying about, use the wrapper macros. + */ + +static inline char * +utf_u2e(const char *src) +{ + return pg_any_to_server(src, strlen(src), PG_UTF8); +} + +static inline char * +utf_e2u(const char *src) +{ + return pg_server_to_any(src, strlen(src), PG_UTF8); +} + +#define UTF_BEGIN \ + do { \ + const char *_pltcl_utf_src = NULL; \ + char *_pltcl_utf_dst = NULL + +#define UTF_END \ + if (_pltcl_utf_src != (const char *) _pltcl_utf_dst) \ + pfree(_pltcl_utf_dst); \ + } while (0) + +#define UTF_U2E(x) \ + (_pltcl_utf_dst = utf_u2e(_pltcl_utf_src = (x))) + +#define UTF_E2U(x) \ + (_pltcl_utf_dst = utf_e2u(_pltcl_utf_src = (x))) + + +/********************************************************************** + * Information associated with a Tcl interpreter. We have one interpreter + * that is used for all pltclu (untrusted) functions. For pltcl (trusted) + * functions, there is a separate interpreter for each effective SQL userid. + * (This is needed to ensure that an unprivileged user can't inject Tcl code + * that'll be executed with the privileges of some other SQL user.) + * + * The pltcl_interp_desc structs are kept in a Postgres hash table indexed + * by userid OID, with OID 0 used for the single untrusted interpreter. + **********************************************************************/ +typedef struct pltcl_interp_desc +{ + Oid user_id; /* Hash key (must be first!) */ + Tcl_Interp *interp; /* The interpreter */ + Tcl_HashTable query_hash; /* pltcl_query_desc structs */ +} pltcl_interp_desc; + + +/********************************************************************** + * The information we cache about loaded procedures + * + * The pltcl_proc_desc struct itself, as well as all subsidiary data, + * is stored in the memory context identified by the fn_cxt field. + * We can reclaim all the data by deleting that context, and should do so + * when the fn_refcount goes to zero. (But note that we do not bother + * trying to clean up Tcl's copy of the procedure definition: it's Tcl's + * problem to manage its memory when we replace a proc definition. We do + * not clean up pltcl_proc_descs when a pg_proc row is deleted, only when + * it is updated, and the same policy applies to Tcl's copy as well.) + * + * Note that the data in this struct is shared across all active calls; + * nothing except the fn_refcount should be changed by a call instance. + **********************************************************************/ +typedef struct pltcl_proc_desc +{ + char *user_proname; /* user's name (from pg_proc.proname) */ + char *internal_proname; /* Tcl name (based on function OID) */ + MemoryContext fn_cxt; /* memory context for this procedure */ + unsigned long fn_refcount; /* number of active references */ + TransactionId fn_xmin; /* xmin of pg_proc row */ + ItemPointerData fn_tid; /* TID of pg_proc row */ + bool fn_readonly; /* is function readonly? */ + bool lanpltrusted; /* is it pltcl (vs. pltclu)? */ + pltcl_interp_desc *interp_desc; /* interpreter to use */ + Oid result_typid; /* OID of fn's result type */ + FmgrInfo result_in_func; /* input function for fn's result type */ + Oid result_typioparam; /* param to pass to same */ + bool fn_retisset; /* true if function returns a set */ + bool fn_retistuple; /* true if function returns composite */ + bool fn_retisdomain; /* true if function returns domain */ + void *domain_info; /* opaque cache for domain checks */ + int nargs; /* number of arguments */ + /* these arrays have nargs entries: */ + FmgrInfo *arg_out_func; /* output fns for arg types */ + bool *arg_is_rowtype; /* is each arg composite? */ +} pltcl_proc_desc; + + +/********************************************************************** + * The information we cache about prepared and saved plans + **********************************************************************/ +typedef struct pltcl_query_desc +{ + char qname[20]; + SPIPlanPtr plan; + int nargs; + Oid *argtypes; + FmgrInfo *arginfuncs; + Oid *argtypioparams; +} pltcl_query_desc; + + +/********************************************************************** + * For speedy lookup, we maintain a hash table mapping from + * function OID + trigger flag + user OID to pltcl_proc_desc pointers. + * The reason the pltcl_proc_desc struct isn't directly part of the hash + * entry is to simplify recovery from errors during compile_pltcl_function. + * + * Note: if the same function is called by multiple userIDs within a session, + * there will be a separate pltcl_proc_desc entry for each userID in the case + * of pltcl functions, but only one entry for pltclu functions, because we + * set user_id = 0 for that case. + **********************************************************************/ +typedef struct pltcl_proc_key +{ + Oid proc_id; /* Function OID */ + + /* + * is_trigger is really a bool, but declare as Oid to ensure this struct + * contains no padding + */ + Oid is_trigger; /* is it a trigger function? */ + Oid user_id; /* User calling the function, or 0 */ +} pltcl_proc_key; + +typedef struct pltcl_proc_ptr +{ + pltcl_proc_key proc_key; /* Hash key (must be first!) */ + pltcl_proc_desc *proc_ptr; +} pltcl_proc_ptr; + + +/********************************************************************** + * Per-call state + **********************************************************************/ +typedef struct pltcl_call_state +{ + /* Call info struct, or NULL in a trigger */ + FunctionCallInfo fcinfo; + + /* Trigger data, if we're in a normal (not event) trigger; else NULL */ + TriggerData *trigdata; + + /* Function we're executing (NULL if not yet identified) */ + pltcl_proc_desc *prodesc; + + /* + * Information for SRFs and functions returning composite types. + * ret_tupdesc and attinmeta are set up if either fn_retistuple or + * fn_retisset, since even a scalar-returning SRF needs a tuplestore. + */ + TupleDesc ret_tupdesc; /* return rowtype, if retistuple or retisset */ + AttInMetadata *attinmeta; /* metadata for building tuples of that type */ + + ReturnSetInfo *rsi; /* passed-in ReturnSetInfo, if any */ + Tuplestorestate *tuple_store; /* SRFs accumulate result here */ + MemoryContext tuple_store_cxt; /* context and resowner for tuplestore */ + ResourceOwner tuple_store_owner; +} pltcl_call_state; + + +/********************************************************************** + * Global data + **********************************************************************/ +static char *pltcl_start_proc = NULL; +static char *pltclu_start_proc = NULL; +static bool pltcl_pm_init_done = false; +static Tcl_Interp *pltcl_hold_interp = NULL; +static HTAB *pltcl_interp_htab = NULL; +static HTAB *pltcl_proc_htab = NULL; + +/* this is saved and restored by pltcl_handler */ +static pltcl_call_state *pltcl_current_call_state = NULL; + +/********************************************************************** + * Lookup table for SQLSTATE condition names + **********************************************************************/ +typedef struct +{ + const char *label; + int sqlerrstate; +} TclExceptionNameMap; + +static const TclExceptionNameMap exception_name_map[] = { +#include "pltclerrcodes.h" /* pgrminclude ignore */ + {NULL, 0} +}; + +/********************************************************************** + * Forward declarations + **********************************************************************/ +void _PG_init(void); + +static void pltcl_init_interp(pltcl_interp_desc *interp_desc, + Oid prolang, bool pltrusted); +static pltcl_interp_desc *pltcl_fetch_interp(Oid prolang, bool pltrusted); +static void call_pltcl_start_proc(Oid prolang, bool pltrusted); +static void start_proc_error_callback(void *arg); + +static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted); + +static Datum pltcl_func_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state, + bool pltrusted); +static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state, + bool pltrusted); +static void pltcl_event_trigger_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state, + bool pltrusted); + +static void throw_tcl_error(Tcl_Interp *interp, const char *proname); + +static pltcl_proc_desc *compile_pltcl_function(Oid fn_oid, Oid tgreloid, + bool is_event_trigger, + bool pltrusted); + +static int pltcl_elog(ClientData cdata, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static void pltcl_construct_errorCode(Tcl_Interp *interp, ErrorData *edata); +static const char *pltcl_get_condition_name(int sqlstate); +static int pltcl_quote(ClientData cdata, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int pltcl_argisnull(ClientData cdata, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int pltcl_returnnull(ClientData cdata, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int pltcl_returnnext(ClientData cdata, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int pltcl_process_SPI_result(Tcl_Interp *interp, + const char *arrayname, + Tcl_Obj *loop_body, + int spi_rc, + SPITupleTable *tuptable, + uint64 ntuples); +static int pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int pltcl_subtransaction(ClientData cdata, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int pltcl_commit(ClientData cdata, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int pltcl_rollback(ClientData cdata, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); + +static void pltcl_subtrans_begin(MemoryContext oldcontext, + ResourceOwner oldowner); +static void pltcl_subtrans_commit(MemoryContext oldcontext, + ResourceOwner oldowner); +static void pltcl_subtrans_abort(Tcl_Interp *interp, + MemoryContext oldcontext, + ResourceOwner oldowner); + +static void pltcl_set_tuple_values(Tcl_Interp *interp, const char *arrayname, + uint64 tupno, HeapTuple tuple, TupleDesc tupdesc); +static Tcl_Obj *pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc, bool include_generated); +static HeapTuple pltcl_build_tuple_result(Tcl_Interp *interp, + Tcl_Obj **kvObjv, int kvObjc, + pltcl_call_state *call_state); +static void pltcl_init_tuple_store(pltcl_call_state *call_state); + + +/* + * Hack to override Tcl's builtin Notifier subsystem. This prevents the + * backend from becoming multithreaded, which breaks all sorts of things. + * That happens in the default version of Tcl_InitNotifier if the TCL library + * has been compiled with multithreading support (i.e. when TCL_THREADS is + * defined under Unix, and in all cases under Windows). + * It's okay to disable the notifier because we never enter the Tcl event loop + * from Postgres, so the notifier capabilities are initialized, but never + * used. Only InitNotifier and DeleteFileHandler ever seem to get called + * within Postgres, but we implement all the functions for completeness. + */ +static ClientData +pltcl_InitNotifier(void) +{ + static int fakeThreadKey; /* To give valid address for ClientData */ + + return (ClientData) &(fakeThreadKey); +} + +static void +pltcl_FinalizeNotifier(ClientData clientData) +{ +} + +static void +pltcl_SetTimer(CONST86 Tcl_Time *timePtr) +{ +} + +static void +pltcl_AlertNotifier(ClientData clientData) +{ +} + +static void +pltcl_CreateFileHandler(int fd, int mask, + Tcl_FileProc *proc, ClientData clientData) +{ +} + +static void +pltcl_DeleteFileHandler(int fd) +{ +} + +static void +pltcl_ServiceModeHook(int mode) +{ +} + +static int +pltcl_WaitForEvent(CONST86 Tcl_Time *timePtr) +{ + return 0; +} + + +/* + * _PG_init() - library load-time initialization + * + * DO NOT make this static nor change its name! + * + * The work done here must be safe to do in the postmaster process, + * in case the pltcl library is preloaded in the postmaster. + */ +void +_PG_init(void) +{ + Tcl_NotifierProcs notifier; + HASHCTL hash_ctl; + + /* Be sure we do initialization only once (should be redundant now) */ + if (pltcl_pm_init_done) + return; + + pg_bindtextdomain(TEXTDOMAIN); + +#ifdef WIN32 + /* Required on win32 to prevent error loading init.tcl */ + Tcl_FindExecutable(""); +#endif + + /* + * Override the functions in the Notifier subsystem. See comments above. + */ + notifier.setTimerProc = pltcl_SetTimer; + notifier.waitForEventProc = pltcl_WaitForEvent; + notifier.createFileHandlerProc = pltcl_CreateFileHandler; + notifier.deleteFileHandlerProc = pltcl_DeleteFileHandler; + notifier.initNotifierProc = pltcl_InitNotifier; + notifier.finalizeNotifierProc = pltcl_FinalizeNotifier; + notifier.alertNotifierProc = pltcl_AlertNotifier; + notifier.serviceModeHookProc = pltcl_ServiceModeHook; + Tcl_SetNotifier(¬ifier); + + /************************************************************ + * Create the dummy hold interpreter to prevent close of + * stdout and stderr on DeleteInterp + ************************************************************/ + if ((pltcl_hold_interp = Tcl_CreateInterp()) == NULL) + elog(ERROR, "could not create master Tcl interpreter"); + if (Tcl_Init(pltcl_hold_interp) == TCL_ERROR) + elog(ERROR, "could not initialize master Tcl interpreter"); + + /************************************************************ + * Create the hash table for working interpreters + ************************************************************/ + memset(&hash_ctl, 0, sizeof(hash_ctl)); + hash_ctl.keysize = sizeof(Oid); + hash_ctl.entrysize = sizeof(pltcl_interp_desc); + pltcl_interp_htab = hash_create("PL/Tcl interpreters", + 8, + &hash_ctl, + HASH_ELEM | HASH_BLOBS); + + /************************************************************ + * Create the hash table for function lookup + ************************************************************/ + memset(&hash_ctl, 0, sizeof(hash_ctl)); + hash_ctl.keysize = sizeof(pltcl_proc_key); + hash_ctl.entrysize = sizeof(pltcl_proc_ptr); + pltcl_proc_htab = hash_create("PL/Tcl functions", + 100, + &hash_ctl, + HASH_ELEM | HASH_BLOBS); + + /************************************************************ + * Define PL/Tcl's custom GUCs + ************************************************************/ + DefineCustomStringVariable("pltcl.start_proc", + gettext_noop("PL/Tcl function to call once when pltcl is first used."), + NULL, + &pltcl_start_proc, + NULL, + PGC_SUSET, 0, + NULL, NULL, NULL); + DefineCustomStringVariable("pltclu.start_proc", + gettext_noop("PL/TclU function to call once when pltclu is first used."), + NULL, + &pltclu_start_proc, + NULL, + PGC_SUSET, 0, + NULL, NULL, NULL); + + pltcl_pm_init_done = true; +} + +/********************************************************************** + * pltcl_init_interp() - initialize a new Tcl interpreter + **********************************************************************/ +static void +pltcl_init_interp(pltcl_interp_desc *interp_desc, Oid prolang, bool pltrusted) +{ + Tcl_Interp *interp; + char interpname[32]; + + /************************************************************ + * Create the Tcl interpreter as a slave of pltcl_hold_interp. + * Note: Tcl automatically does Tcl_Init in the untrusted case, + * and it's not wanted in the trusted case. + ************************************************************/ + snprintf(interpname, sizeof(interpname), "slave_%u", interp_desc->user_id); + if ((interp = Tcl_CreateSlave(pltcl_hold_interp, interpname, + pltrusted ? 1 : 0)) == NULL) + elog(ERROR, "could not create slave Tcl interpreter"); + + /************************************************************ + * Initialize the query hash table associated with interpreter + ************************************************************/ + Tcl_InitHashTable(&interp_desc->query_hash, TCL_STRING_KEYS); + + /************************************************************ + * Install the commands for SPI support in the interpreter + ************************************************************/ + Tcl_CreateObjCommand(interp, "elog", + pltcl_elog, NULL, NULL); + Tcl_CreateObjCommand(interp, "quote", + pltcl_quote, NULL, NULL); + Tcl_CreateObjCommand(interp, "argisnull", + pltcl_argisnull, NULL, NULL); + Tcl_CreateObjCommand(interp, "return_null", + pltcl_returnnull, NULL, NULL); + Tcl_CreateObjCommand(interp, "return_next", + pltcl_returnnext, NULL, NULL); + Tcl_CreateObjCommand(interp, "spi_exec", + pltcl_SPI_execute, NULL, NULL); + Tcl_CreateObjCommand(interp, "spi_prepare", + pltcl_SPI_prepare, NULL, NULL); + Tcl_CreateObjCommand(interp, "spi_execp", + pltcl_SPI_execute_plan, NULL, NULL); + Tcl_CreateObjCommand(interp, "subtransaction", + pltcl_subtransaction, NULL, NULL); + Tcl_CreateObjCommand(interp, "commit", + pltcl_commit, NULL, NULL); + Tcl_CreateObjCommand(interp, "rollback", + pltcl_rollback, NULL, NULL); + + /************************************************************ + * Call the appropriate start_proc, if there is one. + * + * We must set interp_desc->interp before the call, else the start_proc + * won't find the interpreter it's supposed to use. But, if the + * start_proc fails, we want to abandon use of the interpreter. + ************************************************************/ + PG_TRY(); + { + interp_desc->interp = interp; + call_pltcl_start_proc(prolang, pltrusted); + } + PG_CATCH(); + { + interp_desc->interp = NULL; + Tcl_DeleteInterp(interp); + PG_RE_THROW(); + } + PG_END_TRY(); +} + +/********************************************************************** + * pltcl_fetch_interp() - fetch the Tcl interpreter to use for a function + * + * This also takes care of any on-first-use initialization required. + **********************************************************************/ +static pltcl_interp_desc * +pltcl_fetch_interp(Oid prolang, bool pltrusted) +{ + Oid user_id; + pltcl_interp_desc *interp_desc; + bool found; + + /* Find or create the interpreter hashtable entry for this userid */ + if (pltrusted) + user_id = GetUserId(); + else + user_id = InvalidOid; + + interp_desc = hash_search(pltcl_interp_htab, &user_id, + HASH_ENTER, + &found); + if (!found) + interp_desc->interp = NULL; + + /* If we haven't yet successfully made an interpreter, try to do that */ + if (!interp_desc->interp) + pltcl_init_interp(interp_desc, prolang, pltrusted); + + return interp_desc; +} + + +/********************************************************************** + * call_pltcl_start_proc() - Call user-defined initialization proc, if any + **********************************************************************/ +static void +call_pltcl_start_proc(Oid prolang, bool pltrusted) +{ + LOCAL_FCINFO(fcinfo, 0); + char *start_proc; + const char *gucname; + ErrorContextCallback errcallback; + List *namelist; + Oid procOid; + HeapTuple procTup; + Form_pg_proc procStruct; + AclResult aclresult; + FmgrInfo finfo; + PgStat_FunctionCallUsage fcusage; + + /* select appropriate GUC */ + start_proc = pltrusted ? pltcl_start_proc : pltclu_start_proc; + gucname = pltrusted ? "pltcl.start_proc" : "pltclu.start_proc"; + + /* Nothing to do if it's empty or unset */ + if (start_proc == NULL || start_proc[0] == '\0') + return; + + /* Set up errcontext callback to make errors more helpful */ + errcallback.callback = start_proc_error_callback; + errcallback.arg = unconstify(char *, gucname); + errcallback.previous = error_context_stack; + error_context_stack = &errcallback; + + /* Parse possibly-qualified identifier and look up the function */ + namelist = stringToQualifiedNameList(start_proc); + procOid = LookupFuncName(namelist, 0, NULL, false); + + /* Current user must have permission to call function */ + aclresult = pg_proc_aclcheck(procOid, GetUserId(), ACL_EXECUTE); + if (aclresult != ACLCHECK_OK) + aclcheck_error(aclresult, OBJECT_FUNCTION, start_proc); + + /* Get the function's pg_proc entry */ + procTup = SearchSysCache1(PROCOID, ObjectIdGetDatum(procOid)); + if (!HeapTupleIsValid(procTup)) + elog(ERROR, "cache lookup failed for function %u", procOid); + procStruct = (Form_pg_proc) GETSTRUCT(procTup); + + /* It must be same language as the function we're currently calling */ + if (procStruct->prolang != prolang) + ereport(ERROR, + (errcode(ERRCODE_OBJECT_NOT_IN_PREREQUISITE_STATE), + errmsg("function \"%s\" is in the wrong language", + start_proc))); + + /* + * It must not be SECURITY DEFINER, either. This together with the + * language match check ensures that the function will execute in the same + * Tcl interpreter we just finished initializing. + */ + if (procStruct->prosecdef) + ereport(ERROR, + (errcode(ERRCODE_OBJECT_NOT_IN_PREREQUISITE_STATE), + errmsg("function \"%s\" must not be SECURITY DEFINER", + start_proc))); + + /* A-OK */ + ReleaseSysCache(procTup); + + /* + * Call the function using the normal SQL function call mechanism. We + * could perhaps cheat and jump directly to pltcl_handler(), but it seems + * better to do it this way so that the call is exposed to, eg, call + * statistics collection. + */ + InvokeFunctionExecuteHook(procOid); + fmgr_info(procOid, &finfo); + InitFunctionCallInfoData(*fcinfo, &finfo, + 0, + InvalidOid, NULL, NULL); + pgstat_init_function_usage(fcinfo, &fcusage); + (void) FunctionCallInvoke(fcinfo); + pgstat_end_function_usage(&fcusage, true); + + /* Pop the error context stack */ + error_context_stack = errcallback.previous; +} + +/* + * Error context callback for errors occurring during start_proc processing. + */ +static void +start_proc_error_callback(void *arg) +{ + const char *gucname = (const char *) arg; + + /* translator: %s is "pltcl.start_proc" or "pltclu.start_proc" */ + errcontext("processing %s parameter", gucname); +} + + +/********************************************************************** + * pltcl_call_handler - This is the only visible function + * of the PL interpreter. The PostgreSQL + * function manager and trigger manager + * call this function for execution of + * PL/Tcl procedures. + **********************************************************************/ +PG_FUNCTION_INFO_V1(pltcl_call_handler); + +/* keep non-static */ +Datum +pltcl_call_handler(PG_FUNCTION_ARGS) +{ + return pltcl_handler(fcinfo, true); +} + +/* + * Alternative handler for unsafe functions + */ +PG_FUNCTION_INFO_V1(pltclu_call_handler); + +/* keep non-static */ +Datum +pltclu_call_handler(PG_FUNCTION_ARGS) +{ + return pltcl_handler(fcinfo, false); +} + + +/********************************************************************** + * pltcl_handler() - Handler for function and trigger calls, for + * both trusted and untrusted interpreters. + **********************************************************************/ +static Datum +pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted) +{ + Datum retval = (Datum) 0; + pltcl_call_state current_call_state; + pltcl_call_state *save_call_state; + + /* + * Initialize current_call_state to nulls/zeroes; in particular, set its + * prodesc pointer to null. Anything that sets it non-null should + * increase the prodesc's fn_refcount at the same time. We'll decrease + * the refcount, and then delete the prodesc if it's no longer referenced, + * on the way out of this function. This ensures that prodescs live as + * long as needed even if somebody replaces the originating pg_proc row + * while they're executing. + */ + memset(¤t_call_state, 0, sizeof(current_call_state)); + + /* + * Ensure that static pointer is saved/restored properly + */ + save_call_state = pltcl_current_call_state; + pltcl_current_call_state = ¤t_call_state; + + PG_TRY(); + { + /* + * Determine if called as function or trigger and call appropriate + * subhandler + */ + if (CALLED_AS_TRIGGER(fcinfo)) + { + /* invoke the trigger handler */ + retval = PointerGetDatum(pltcl_trigger_handler(fcinfo, + ¤t_call_state, + pltrusted)); + } + else if (CALLED_AS_EVENT_TRIGGER(fcinfo)) + { + /* invoke the event trigger handler */ + pltcl_event_trigger_handler(fcinfo, ¤t_call_state, pltrusted); + retval = (Datum) 0; + } + else + { + /* invoke the regular function handler */ + current_call_state.fcinfo = fcinfo; + retval = pltcl_func_handler(fcinfo, ¤t_call_state, pltrusted); + } + } + PG_FINALLY(); + { + /* Restore static pointer, then clean up the prodesc refcount if any */ + /* + * (We're being paranoid in case an error is thrown in context + * deletion) + */ + pltcl_current_call_state = save_call_state; + if (current_call_state.prodesc != NULL) + { + Assert(current_call_state.prodesc->fn_refcount > 0); + if (--current_call_state.prodesc->fn_refcount == 0) + MemoryContextDelete(current_call_state.prodesc->fn_cxt); + } + } + PG_END_TRY(); + + return retval; +} + + +/********************************************************************** + * pltcl_func_handler() - Handler for regular function calls + **********************************************************************/ +static Datum +pltcl_func_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state, + bool pltrusted) +{ + bool nonatomic; + pltcl_proc_desc *prodesc; + Tcl_Interp *volatile interp; + Tcl_Obj *tcl_cmd; + int i; + int tcl_rc; + Datum retval; + + nonatomic = fcinfo->context && + IsA(fcinfo->context, CallContext) && + !castNode(CallContext, fcinfo->context)->atomic; + + /* Connect to SPI manager */ + if (SPI_connect_ext(nonatomic ? SPI_OPT_NONATOMIC : 0) != SPI_OK_CONNECT) + elog(ERROR, "could not connect to SPI manager"); + + /* Find or compile the function */ + prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, InvalidOid, + false, pltrusted); + + call_state->prodesc = prodesc; + prodesc->fn_refcount++; + + interp = prodesc->interp_desc->interp; + + /* + * If we're a SRF, check caller can handle materialize mode, and save + * relevant info into call_state. We must ensure that the returned + * tuplestore is owned by the caller's context, even if we first create it + * inside a subtransaction. + */ + if (prodesc->fn_retisset) + { + ReturnSetInfo *rsi = (ReturnSetInfo *) fcinfo->resultinfo; + + if (!rsi || !IsA(rsi, ReturnSetInfo) || + (rsi->allowedModes & SFRM_Materialize) == 0) + ereport(ERROR, + (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), + errmsg("set-valued function called in context that cannot accept a set"))); + + call_state->rsi = rsi; + call_state->tuple_store_cxt = rsi->econtext->ecxt_per_query_memory; + call_state->tuple_store_owner = CurrentResourceOwner; + } + + /************************************************************ + * Create the tcl command to call the internal + * proc in the Tcl interpreter + ************************************************************/ + tcl_cmd = Tcl_NewObj(); + Tcl_ListObjAppendElement(NULL, tcl_cmd, + Tcl_NewStringObj(prodesc->internal_proname, -1)); + + /* We hold a refcount on tcl_cmd just to be sure it stays around */ + Tcl_IncrRefCount(tcl_cmd); + + /************************************************************ + * Add all call arguments to the command + ************************************************************/ + PG_TRY(); + { + for (i = 0; i < prodesc->nargs; i++) + { + if (prodesc->arg_is_rowtype[i]) + { + /************************************************** + * For tuple values, add a list for 'array set ...' + **************************************************/ + if (fcinfo->args[i].isnull) + Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj()); + else + { + HeapTupleHeader td; + Oid tupType; + int32 tupTypmod; + TupleDesc tupdesc; + HeapTupleData tmptup; + Tcl_Obj *list_tmp; + + td = DatumGetHeapTupleHeader(fcinfo->args[i].value); + /* Extract rowtype info and find a tupdesc */ + tupType = HeapTupleHeaderGetTypeId(td); + tupTypmod = HeapTupleHeaderGetTypMod(td); + tupdesc = lookup_rowtype_tupdesc(tupType, tupTypmod); + /* Build a temporary HeapTuple control structure */ + tmptup.t_len = HeapTupleHeaderGetDatumLength(td); + tmptup.t_data = td; + + list_tmp = pltcl_build_tuple_argument(&tmptup, tupdesc, true); + Tcl_ListObjAppendElement(NULL, tcl_cmd, list_tmp); + + ReleaseTupleDesc(tupdesc); + } + } + else + { + /************************************************** + * Single values are added as string element + * of their external representation + **************************************************/ + if (fcinfo->args[i].isnull) + Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj()); + else + { + char *tmp; + + tmp = OutputFunctionCall(&prodesc->arg_out_func[i], + fcinfo->args[i].value); + UTF_BEGIN; + Tcl_ListObjAppendElement(NULL, tcl_cmd, + Tcl_NewStringObj(UTF_E2U(tmp), -1)); + UTF_END; + pfree(tmp); + } + } + } + } + PG_CATCH(); + { + /* Release refcount to free tcl_cmd */ + Tcl_DecrRefCount(tcl_cmd); + PG_RE_THROW(); + } + PG_END_TRY(); + + /************************************************************ + * Call the Tcl function + * + * We assume no PG error can be thrown directly from this call. + ************************************************************/ + tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL)); + + /* Release refcount to free tcl_cmd (and all subsidiary objects) */ + Tcl_DecrRefCount(tcl_cmd); + + /************************************************************ + * Check for errors reported by Tcl. + ************************************************************/ + if (tcl_rc != TCL_OK) + throw_tcl_error(interp, prodesc->user_proname); + + /************************************************************ + * Disconnect from SPI manager and then create the return + * value datum (if the input function does a palloc for it + * this must not be allocated in the SPI memory context + * because SPI_finish would free it). But don't try to call + * the result_in_func if we've been told to return a NULL; + * the Tcl result may not be a valid value of the result type + * in that case. + ************************************************************/ + if (SPI_finish() != SPI_OK_FINISH) + elog(ERROR, "SPI_finish() failed"); + + if (prodesc->fn_retisset) + { + ReturnSetInfo *rsi = call_state->rsi; + + /* We already checked this is OK */ + rsi->returnMode = SFRM_Materialize; + + /* If we produced any tuples, send back the result */ + if (call_state->tuple_store) + { + rsi->setResult = call_state->tuple_store; + if (call_state->ret_tupdesc) + { + MemoryContext oldcxt; + + oldcxt = MemoryContextSwitchTo(call_state->tuple_store_cxt); + rsi->setDesc = CreateTupleDescCopy(call_state->ret_tupdesc); + MemoryContextSwitchTo(oldcxt); + } + } + retval = (Datum) 0; + fcinfo->isnull = true; + } + else if (fcinfo->isnull) + { + retval = InputFunctionCall(&prodesc->result_in_func, + NULL, + prodesc->result_typioparam, + -1); + } + else if (prodesc->fn_retistuple) + { + TupleDesc td; + HeapTuple tup; + Tcl_Obj *resultObj; + Tcl_Obj **resultObjv; + int resultObjc; + + /* + * Set up data about result type. XXX it's tempting to consider + * caching this in the prodesc, in the common case where the rowtype + * is determined by the function not the calling query. But we'd have + * to be able to deal with ADD/DROP/ALTER COLUMN events when the + * result type is a named composite type, so it's not exactly trivial. + * Maybe worth improving someday. + */ + switch (get_call_result_type(fcinfo, NULL, &td)) + { + case TYPEFUNC_COMPOSITE: + /* success */ + break; + case TYPEFUNC_COMPOSITE_DOMAIN: + Assert(prodesc->fn_retisdomain); + break; + case TYPEFUNC_RECORD: + /* failed to determine actual type of RECORD */ + ereport(ERROR, + (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), + errmsg("function returning record called in context " + "that cannot accept type record"))); + break; + default: + /* result type isn't composite? */ + elog(ERROR, "return type must be a row type"); + break; + } + + Assert(!call_state->ret_tupdesc); + Assert(!call_state->attinmeta); + call_state->ret_tupdesc = td; + call_state->attinmeta = TupleDescGetAttInMetadata(td); + + /* Convert function result to tuple */ + resultObj = Tcl_GetObjResult(interp); + if (Tcl_ListObjGetElements(interp, resultObj, &resultObjc, &resultObjv) == TCL_ERROR) + throw_tcl_error(interp, prodesc->user_proname); + + tup = pltcl_build_tuple_result(interp, resultObjv, resultObjc, + call_state); + retval = HeapTupleGetDatum(tup); + } + else + retval = InputFunctionCall(&prodesc->result_in_func, + utf_u2e(Tcl_GetStringResult(interp)), + prodesc->result_typioparam, + -1); + + return retval; +} + + +/********************************************************************** + * pltcl_trigger_handler() - Handler for trigger calls + **********************************************************************/ +static HeapTuple +pltcl_trigger_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state, + bool pltrusted) +{ + pltcl_proc_desc *prodesc; + Tcl_Interp *volatile interp; + TriggerData *trigdata = (TriggerData *) fcinfo->context; + char *stroid; + TupleDesc tupdesc; + volatile HeapTuple rettup; + Tcl_Obj *tcl_cmd; + Tcl_Obj *tcl_trigtup; + int tcl_rc; + int i; + const char *result; + int result_Objc; + Tcl_Obj **result_Objv; + int rc PG_USED_FOR_ASSERTS_ONLY; + + call_state->trigdata = trigdata; + + /* Connect to SPI manager */ + if (SPI_connect() != SPI_OK_CONNECT) + elog(ERROR, "could not connect to SPI manager"); + + /* Make transition tables visible to this SPI connection */ + rc = SPI_register_trigger_data(trigdata); + Assert(rc >= 0); + + /* Find or compile the function */ + prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, + RelationGetRelid(trigdata->tg_relation), + false, /* not an event trigger */ + pltrusted); + + call_state->prodesc = prodesc; + prodesc->fn_refcount++; + + interp = prodesc->interp_desc->interp; + + tupdesc = RelationGetDescr(trigdata->tg_relation); + + /************************************************************ + * Create the tcl command to call the internal + * proc in the interpreter + ************************************************************/ + tcl_cmd = Tcl_NewObj(); + Tcl_IncrRefCount(tcl_cmd); + + PG_TRY(); + { + /* The procedure name (note this is all ASCII, so no utf_e2u) */ + Tcl_ListObjAppendElement(NULL, tcl_cmd, + Tcl_NewStringObj(prodesc->internal_proname, -1)); + + /* The trigger name for argument TG_name */ + Tcl_ListObjAppendElement(NULL, tcl_cmd, + Tcl_NewStringObj(utf_e2u(trigdata->tg_trigger->tgname), -1)); + + /* The oid of the trigger relation for argument TG_relid */ + /* Consider not converting to a string for more performance? */ + stroid = DatumGetCString(DirectFunctionCall1(oidout, + ObjectIdGetDatum(trigdata->tg_relation->rd_id))); + Tcl_ListObjAppendElement(NULL, tcl_cmd, + Tcl_NewStringObj(stroid, -1)); + pfree(stroid); + + /* The name of the table the trigger is acting on: TG_table_name */ + stroid = SPI_getrelname(trigdata->tg_relation); + Tcl_ListObjAppendElement(NULL, tcl_cmd, + Tcl_NewStringObj(utf_e2u(stroid), -1)); + pfree(stroid); + + /* The schema of the table the trigger is acting on: TG_table_schema */ + stroid = SPI_getnspname(trigdata->tg_relation); + Tcl_ListObjAppendElement(NULL, tcl_cmd, + Tcl_NewStringObj(utf_e2u(stroid), -1)); + pfree(stroid); + + /* A list of attribute names for argument TG_relatts */ + tcl_trigtup = Tcl_NewObj(); + Tcl_ListObjAppendElement(NULL, tcl_trigtup, Tcl_NewObj()); + for (i = 0; i < tupdesc->natts; i++) + { + Form_pg_attribute att = TupleDescAttr(tupdesc, i); + + if (att->attisdropped) + Tcl_ListObjAppendElement(NULL, tcl_trigtup, Tcl_NewObj()); + else + Tcl_ListObjAppendElement(NULL, tcl_trigtup, + Tcl_NewStringObj(utf_e2u(NameStr(att->attname)), -1)); + } + Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup); + + /* The when part of the event for TG_when */ + if (TRIGGER_FIRED_BEFORE(trigdata->tg_event)) + Tcl_ListObjAppendElement(NULL, tcl_cmd, + Tcl_NewStringObj("BEFORE", -1)); + else if (TRIGGER_FIRED_AFTER(trigdata->tg_event)) + Tcl_ListObjAppendElement(NULL, tcl_cmd, + Tcl_NewStringObj("AFTER", -1)); + else if (TRIGGER_FIRED_INSTEAD(trigdata->tg_event)) + Tcl_ListObjAppendElement(NULL, tcl_cmd, + Tcl_NewStringObj("INSTEAD OF", -1)); + else + elog(ERROR, "unrecognized WHEN tg_event: %u", trigdata->tg_event); + + /* The level part of the event for TG_level */ + if (TRIGGER_FIRED_FOR_ROW(trigdata->tg_event)) + { + Tcl_ListObjAppendElement(NULL, tcl_cmd, + Tcl_NewStringObj("ROW", -1)); + + /* + * Now the command part of the event for TG_op and data for NEW + * and OLD + * + * Note: In BEFORE trigger, stored generated columns are not + * computed yet, so don't make them accessible in NEW row. + */ + if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event)) + { + Tcl_ListObjAppendElement(NULL, tcl_cmd, + Tcl_NewStringObj("INSERT", -1)); + + Tcl_ListObjAppendElement(NULL, tcl_cmd, + pltcl_build_tuple_argument(trigdata->tg_trigtuple, + tupdesc, + !TRIGGER_FIRED_BEFORE(trigdata->tg_event))); + Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj()); + + rettup = trigdata->tg_trigtuple; + } + else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event)) + { + Tcl_ListObjAppendElement(NULL, tcl_cmd, + Tcl_NewStringObj("DELETE", -1)); + + Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj()); + Tcl_ListObjAppendElement(NULL, tcl_cmd, + pltcl_build_tuple_argument(trigdata->tg_trigtuple, + tupdesc, + true)); + + rettup = trigdata->tg_trigtuple; + } + else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event)) + { + Tcl_ListObjAppendElement(NULL, tcl_cmd, + Tcl_NewStringObj("UPDATE", -1)); + + Tcl_ListObjAppendElement(NULL, tcl_cmd, + pltcl_build_tuple_argument(trigdata->tg_newtuple, + tupdesc, + !TRIGGER_FIRED_BEFORE(trigdata->tg_event))); + Tcl_ListObjAppendElement(NULL, tcl_cmd, + pltcl_build_tuple_argument(trigdata->tg_trigtuple, + tupdesc, + true)); + + rettup = trigdata->tg_newtuple; + } + else + elog(ERROR, "unrecognized OP tg_event: %u", trigdata->tg_event); + } + else if (TRIGGER_FIRED_FOR_STATEMENT(trigdata->tg_event)) + { + Tcl_ListObjAppendElement(NULL, tcl_cmd, + Tcl_NewStringObj("STATEMENT", -1)); + + if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event)) + Tcl_ListObjAppendElement(NULL, tcl_cmd, + Tcl_NewStringObj("INSERT", -1)); + else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event)) + Tcl_ListObjAppendElement(NULL, tcl_cmd, + Tcl_NewStringObj("DELETE", -1)); + else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event)) + Tcl_ListObjAppendElement(NULL, tcl_cmd, + Tcl_NewStringObj("UPDATE", -1)); + else if (TRIGGER_FIRED_BY_TRUNCATE(trigdata->tg_event)) + Tcl_ListObjAppendElement(NULL, tcl_cmd, + Tcl_NewStringObj("TRUNCATE", -1)); + else + elog(ERROR, "unrecognized OP tg_event: %u", trigdata->tg_event); + + Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj()); + Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj()); + + rettup = (HeapTuple) NULL; + } + else + elog(ERROR, "unrecognized LEVEL tg_event: %u", trigdata->tg_event); + + /* Finally append the arguments from CREATE TRIGGER */ + for (i = 0; i < trigdata->tg_trigger->tgnargs; i++) + Tcl_ListObjAppendElement(NULL, tcl_cmd, + Tcl_NewStringObj(utf_e2u(trigdata->tg_trigger->tgargs[i]), -1)); + + } + PG_CATCH(); + { + Tcl_DecrRefCount(tcl_cmd); + PG_RE_THROW(); + } + PG_END_TRY(); + + /************************************************************ + * Call the Tcl function + * + * We assume no PG error can be thrown directly from this call. + ************************************************************/ + tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL)); + + /* Release refcount to free tcl_cmd (and all subsidiary objects) */ + Tcl_DecrRefCount(tcl_cmd); + + /************************************************************ + * Check for errors reported by Tcl. + ************************************************************/ + if (tcl_rc != TCL_OK) + throw_tcl_error(interp, prodesc->user_proname); + + /************************************************************ + * Exit SPI environment. + ************************************************************/ + if (SPI_finish() != SPI_OK_FINISH) + elog(ERROR, "SPI_finish() failed"); + + /************************************************************ + * The return value from the procedure might be one of + * the magic strings OK or SKIP, or a list from array get. + * We can check for OK or SKIP without worrying about encoding. + ************************************************************/ + result = Tcl_GetStringResult(interp); + + if (strcmp(result, "OK") == 0) + return rettup; + if (strcmp(result, "SKIP") == 0) + return (HeapTuple) NULL; + + /************************************************************ + * Otherwise, the return value should be a column name/value list + * specifying the modified tuple to return. + ************************************************************/ + if (Tcl_ListObjGetElements(interp, Tcl_GetObjResult(interp), + &result_Objc, &result_Objv) != TCL_OK) + ereport(ERROR, + (errcode(ERRCODE_E_R_I_E_TRIGGER_PROTOCOL_VIOLATED), + errmsg("could not split return value from trigger: %s", + utf_u2e(Tcl_GetStringResult(interp))))); + + /* Convert function result to tuple */ + rettup = pltcl_build_tuple_result(interp, result_Objv, result_Objc, + call_state); + + return rettup; +} + +/********************************************************************** + * pltcl_event_trigger_handler() - Handler for event trigger calls + **********************************************************************/ +static void +pltcl_event_trigger_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state, + bool pltrusted) +{ + pltcl_proc_desc *prodesc; + Tcl_Interp *volatile interp; + EventTriggerData *tdata = (EventTriggerData *) fcinfo->context; + Tcl_Obj *tcl_cmd; + int tcl_rc; + + /* Connect to SPI manager */ + if (SPI_connect() != SPI_OK_CONNECT) + elog(ERROR, "could not connect to SPI manager"); + + /* Find or compile the function */ + prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, + InvalidOid, true, pltrusted); + + call_state->prodesc = prodesc; + prodesc->fn_refcount++; + + interp = prodesc->interp_desc->interp; + + /* Create the tcl command and call the internal proc */ + tcl_cmd = Tcl_NewObj(); + Tcl_IncrRefCount(tcl_cmd); + Tcl_ListObjAppendElement(NULL, tcl_cmd, + Tcl_NewStringObj(prodesc->internal_proname, -1)); + Tcl_ListObjAppendElement(NULL, tcl_cmd, + Tcl_NewStringObj(utf_e2u(tdata->event), -1)); + Tcl_ListObjAppendElement(NULL, tcl_cmd, + Tcl_NewStringObj(utf_e2u(GetCommandTagName(tdata->tag)), + -1)); + + tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL)); + + /* Release refcount to free tcl_cmd (and all subsidiary objects) */ + Tcl_DecrRefCount(tcl_cmd); + + /* Check for errors reported by Tcl. */ + if (tcl_rc != TCL_OK) + throw_tcl_error(interp, prodesc->user_proname); + + if (SPI_finish() != SPI_OK_FINISH) + elog(ERROR, "SPI_finish() failed"); +} + + +/********************************************************************** + * throw_tcl_error - ereport an error returned from the Tcl interpreter + **********************************************************************/ +static void +throw_tcl_error(Tcl_Interp *interp, const char *proname) +{ + /* + * Caution is needed here because Tcl_GetVar could overwrite the + * interpreter result (even though it's not really supposed to), and we + * can't control the order of evaluation of ereport arguments. Hence, make + * real sure we have our own copy of the result string before invoking + * Tcl_GetVar. + */ + char *emsg; + char *econtext; + + emsg = pstrdup(utf_u2e(Tcl_GetStringResult(interp))); + econtext = utf_u2e(Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY)); + ereport(ERROR, + (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION), + errmsg("%s", emsg), + errcontext("%s\nin PL/Tcl function \"%s\"", + econtext, proname))); +} + + +/********************************************************************** + * compile_pltcl_function - compile (or hopefully just look up) function + * + * tgreloid is the OID of the relation when compiling a trigger, or zero + * (InvalidOid) when compiling a plain function. + **********************************************************************/ +static pltcl_proc_desc * +compile_pltcl_function(Oid fn_oid, Oid tgreloid, + bool is_event_trigger, bool pltrusted) +{ + HeapTuple procTup; + Form_pg_proc procStruct; + pltcl_proc_key proc_key; + pltcl_proc_ptr *proc_ptr; + bool found; + pltcl_proc_desc *prodesc; + pltcl_proc_desc *old_prodesc; + volatile MemoryContext proc_cxt = NULL; + Tcl_DString proc_internal_def; + Tcl_DString proc_internal_body; + + /* We'll need the pg_proc tuple in any case... */ + procTup = SearchSysCache1(PROCOID, ObjectIdGetDatum(fn_oid)); + if (!HeapTupleIsValid(procTup)) + elog(ERROR, "cache lookup failed for function %u", fn_oid); + procStruct = (Form_pg_proc) GETSTRUCT(procTup); + + /* + * Look up function in pltcl_proc_htab; if it's not there, create an entry + * and set the entry's proc_ptr to NULL. + */ + proc_key.proc_id = fn_oid; + proc_key.is_trigger = OidIsValid(tgreloid); + proc_key.user_id = pltrusted ? GetUserId() : InvalidOid; + + proc_ptr = hash_search(pltcl_proc_htab, &proc_key, + HASH_ENTER, + &found); + if (!found) + proc_ptr->proc_ptr = NULL; + + prodesc = proc_ptr->proc_ptr; + + /************************************************************ + * If it's present, must check whether it's still up to date. + * This is needed because CREATE OR REPLACE FUNCTION can modify the + * function's pg_proc entry without changing its OID. + ************************************************************/ + if (prodesc != NULL && + prodesc->fn_xmin == HeapTupleHeaderGetRawXmin(procTup->t_data) && + ItemPointerEquals(&prodesc->fn_tid, &procTup->t_self)) + { + /* It's still up-to-date, so we can use it */ + ReleaseSysCache(procTup); + return prodesc; + } + + /************************************************************ + * If we haven't found it in the hashtable, we analyze + * the functions arguments and returntype and store + * the in-/out-functions in the prodesc block and create + * a new hashtable entry for it. + * + * Then we load the procedure into the Tcl interpreter. + ************************************************************/ + Tcl_DStringInit(&proc_internal_def); + Tcl_DStringInit(&proc_internal_body); + PG_TRY(); + { + bool is_trigger = OidIsValid(tgreloid); + char internal_proname[128]; + HeapTuple typeTup; + Form_pg_type typeStruct; + char proc_internal_args[33 * FUNC_MAX_ARGS]; + Datum prosrcdatum; + bool isnull; + char *proc_source; + char buf[48]; + Tcl_Interp *interp; + int i; + int tcl_rc; + MemoryContext oldcontext; + + /************************************************************ + * Build our internal proc name from the function's Oid. Append + * "_trigger" when appropriate to ensure the normal and trigger + * cases are kept separate. Note name must be all-ASCII. + ************************************************************/ + if (is_event_trigger) + snprintf(internal_proname, sizeof(internal_proname), + "__PLTcl_proc_%u_evttrigger", fn_oid); + else if (is_trigger) + snprintf(internal_proname, sizeof(internal_proname), + "__PLTcl_proc_%u_trigger", fn_oid); + else + snprintf(internal_proname, sizeof(internal_proname), + "__PLTcl_proc_%u", fn_oid); + + /************************************************************ + * Allocate a context that will hold all PG data for the procedure. + ************************************************************/ + proc_cxt = AllocSetContextCreate(TopMemoryContext, + "PL/Tcl function", + ALLOCSET_SMALL_SIZES); + + /************************************************************ + * Allocate and fill a new procedure description block. + * struct prodesc and subsidiary data must all live in proc_cxt. + ************************************************************/ + oldcontext = MemoryContextSwitchTo(proc_cxt); + prodesc = (pltcl_proc_desc *) palloc0(sizeof(pltcl_proc_desc)); + prodesc->user_proname = pstrdup(NameStr(procStruct->proname)); + MemoryContextSetIdentifier(proc_cxt, prodesc->user_proname); + prodesc->internal_proname = pstrdup(internal_proname); + prodesc->fn_cxt = proc_cxt; + prodesc->fn_refcount = 0; + prodesc->fn_xmin = HeapTupleHeaderGetRawXmin(procTup->t_data); + prodesc->fn_tid = procTup->t_self; + prodesc->nargs = procStruct->pronargs; + prodesc->arg_out_func = (FmgrInfo *) palloc0(prodesc->nargs * sizeof(FmgrInfo)); + prodesc->arg_is_rowtype = (bool *) palloc0(prodesc->nargs * sizeof(bool)); + MemoryContextSwitchTo(oldcontext); + + /* Remember if function is STABLE/IMMUTABLE */ + prodesc->fn_readonly = + (procStruct->provolatile != PROVOLATILE_VOLATILE); + /* And whether it is trusted */ + prodesc->lanpltrusted = pltrusted; + + /************************************************************ + * Identify the interpreter to use for the function + ************************************************************/ + prodesc->interp_desc = pltcl_fetch_interp(procStruct->prolang, + prodesc->lanpltrusted); + interp = prodesc->interp_desc->interp; + + /************************************************************ + * Get the required information for input conversion of the + * return value. + ************************************************************/ + if (!is_trigger && !is_event_trigger) + { + Oid rettype = procStruct->prorettype; + + typeTup = SearchSysCache1(TYPEOID, ObjectIdGetDatum(rettype)); + if (!HeapTupleIsValid(typeTup)) + elog(ERROR, "cache lookup failed for type %u", rettype); + typeStruct = (Form_pg_type) GETSTRUCT(typeTup); + + /* Disallow pseudotype result, except VOID and RECORD */ + if (typeStruct->typtype == TYPTYPE_PSEUDO) + { + if (rettype == VOIDOID || + rettype == RECORDOID) + /* okay */ ; + else if (rettype == TRIGGEROID || + rettype == EVTTRIGGEROID) + ereport(ERROR, + (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), + errmsg("trigger functions can only be called as triggers"))); + else + ereport(ERROR, + (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), + errmsg("PL/Tcl functions cannot return type %s", + format_type_be(rettype)))); + } + + prodesc->result_typid = rettype; + fmgr_info_cxt(typeStruct->typinput, + &(prodesc->result_in_func), + proc_cxt); + prodesc->result_typioparam = getTypeIOParam(typeTup); + + prodesc->fn_retisset = procStruct->proretset; + prodesc->fn_retistuple = type_is_rowtype(rettype); + prodesc->fn_retisdomain = (typeStruct->typtype == TYPTYPE_DOMAIN); + prodesc->domain_info = NULL; + + ReleaseSysCache(typeTup); + } + + /************************************************************ + * Get the required information for output conversion + * of all procedure arguments, and set up argument naming info. + ************************************************************/ + if (!is_trigger && !is_event_trigger) + { + proc_internal_args[0] = '\0'; + for (i = 0; i < prodesc->nargs; i++) + { + Oid argtype = procStruct->proargtypes.values[i]; + + typeTup = SearchSysCache1(TYPEOID, ObjectIdGetDatum(argtype)); + if (!HeapTupleIsValid(typeTup)) + elog(ERROR, "cache lookup failed for type %u", argtype); + typeStruct = (Form_pg_type) GETSTRUCT(typeTup); + + /* Disallow pseudotype argument, except RECORD */ + if (typeStruct->typtype == TYPTYPE_PSEUDO && + argtype != RECORDOID) + ereport(ERROR, + (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), + errmsg("PL/Tcl functions cannot accept type %s", + format_type_be(argtype)))); + + if (type_is_rowtype(argtype)) + { + prodesc->arg_is_rowtype[i] = true; + snprintf(buf, sizeof(buf), "__PLTcl_Tup_%d", i + 1); + } + else + { + prodesc->arg_is_rowtype[i] = false; + fmgr_info_cxt(typeStruct->typoutput, + &(prodesc->arg_out_func[i]), + proc_cxt); + snprintf(buf, sizeof(buf), "%d", i + 1); + } + + if (i > 0) + strcat(proc_internal_args, " "); + strcat(proc_internal_args, buf); + + ReleaseSysCache(typeTup); + } + } + else if (is_trigger) + { + /* trigger procedure has fixed args */ + strcpy(proc_internal_args, + "TG_name TG_relid TG_table_name TG_table_schema TG_relatts TG_when TG_level TG_op __PLTcl_Tup_NEW __PLTcl_Tup_OLD args"); + } + else if (is_event_trigger) + { + /* event trigger procedure has fixed args */ + strcpy(proc_internal_args, "TG_event TG_tag"); + } + + /************************************************************ + * Create the tcl command to define the internal + * procedure + * + * Leave this code as DString - performance is not critical here, + * and we don't want to duplicate the knowledge of the Tcl quoting + * rules that's embedded in Tcl_DStringAppendElement. + ************************************************************/ + Tcl_DStringAppendElement(&proc_internal_def, "proc"); + Tcl_DStringAppendElement(&proc_internal_def, internal_proname); + Tcl_DStringAppendElement(&proc_internal_def, proc_internal_args); + + /************************************************************ + * prefix procedure body with + * upvar #0 <internal_proname> GD + * and with appropriate setting of arguments + ************************************************************/ + Tcl_DStringAppend(&proc_internal_body, "upvar #0 ", -1); + Tcl_DStringAppend(&proc_internal_body, internal_proname, -1); + Tcl_DStringAppend(&proc_internal_body, " GD\n", -1); + if (is_trigger) + { + Tcl_DStringAppend(&proc_internal_body, + "array set NEW $__PLTcl_Tup_NEW\n", -1); + Tcl_DStringAppend(&proc_internal_body, + "array set OLD $__PLTcl_Tup_OLD\n", -1); + Tcl_DStringAppend(&proc_internal_body, + "set i 0\n" + "set v 0\n" + "foreach v $args {\n" + " incr i\n" + " set $i $v\n" + "}\n" + "unset i v\n\n", -1); + } + else if (is_event_trigger) + { + /* no argument support for event triggers */ + } + else + { + for (i = 0; i < prodesc->nargs; i++) + { + if (prodesc->arg_is_rowtype[i]) + { + snprintf(buf, sizeof(buf), + "array set %d $__PLTcl_Tup_%d\n", + i + 1, i + 1); + Tcl_DStringAppend(&proc_internal_body, buf, -1); + } + } + } + + /************************************************************ + * Add user's function definition to proc body + ************************************************************/ + prosrcdatum = SysCacheGetAttr(PROCOID, procTup, + Anum_pg_proc_prosrc, &isnull); + if (isnull) + elog(ERROR, "null prosrc"); + proc_source = TextDatumGetCString(prosrcdatum); + UTF_BEGIN; + Tcl_DStringAppend(&proc_internal_body, UTF_E2U(proc_source), -1); + UTF_END; + pfree(proc_source); + Tcl_DStringAppendElement(&proc_internal_def, + Tcl_DStringValue(&proc_internal_body)); + + /************************************************************ + * Create the procedure in the interpreter + ************************************************************/ + tcl_rc = Tcl_EvalEx(interp, + Tcl_DStringValue(&proc_internal_def), + Tcl_DStringLength(&proc_internal_def), + TCL_EVAL_GLOBAL); + if (tcl_rc != TCL_OK) + ereport(ERROR, + (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION), + errmsg("could not create internal procedure \"%s\": %s", + internal_proname, + utf_u2e(Tcl_GetStringResult(interp))))); + } + PG_CATCH(); + { + /* + * If we failed anywhere above, clean up whatever got allocated. It + * should all be in the proc_cxt, except for the DStrings. + */ + if (proc_cxt) + MemoryContextDelete(proc_cxt); + Tcl_DStringFree(&proc_internal_def); + Tcl_DStringFree(&proc_internal_body); + PG_RE_THROW(); + } + PG_END_TRY(); + + /* + * Install the new proc description block in the hashtable, incrementing + * its refcount (the hashtable link counts as a reference). Then, if + * there was a previous definition of the function, decrement that one's + * refcount, and delete it if no longer referenced. The order of + * operations here is important: if something goes wrong during the + * MemoryContextDelete, leaking some memory for the old definition is OK, + * but we don't want to corrupt the live hashtable entry. (Likewise, + * freeing the DStrings is pretty low priority if that happens.) + */ + old_prodesc = proc_ptr->proc_ptr; + + proc_ptr->proc_ptr = prodesc; + prodesc->fn_refcount++; + + if (old_prodesc != NULL) + { + Assert(old_prodesc->fn_refcount > 0); + if (--old_prodesc->fn_refcount == 0) + MemoryContextDelete(old_prodesc->fn_cxt); + } + + Tcl_DStringFree(&proc_internal_def); + Tcl_DStringFree(&proc_internal_body); + + ReleaseSysCache(procTup); + + return prodesc; +} + + +/********************************************************************** + * pltcl_elog() - elog() support for PLTcl + **********************************************************************/ +static int +pltcl_elog(ClientData cdata, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + volatile int level; + MemoryContext oldcontext; + int priIndex; + + static const char *logpriorities[] = { + "DEBUG", "LOG", "INFO", "NOTICE", + "WARNING", "ERROR", "FATAL", (const char *) NULL + }; + + static const int loglevels[] = { + DEBUG2, LOG, INFO, NOTICE, + WARNING, ERROR, FATAL + }; + + if (objc != 3) + { + Tcl_WrongNumArgs(interp, 1, objv, "level msg"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[1], logpriorities, "priority", + TCL_EXACT, &priIndex) != TCL_OK) + return TCL_ERROR; + + level = loglevels[priIndex]; + + if (level == ERROR) + { + /* + * We just pass the error back to Tcl. If it's not caught, it'll + * eventually get converted to a PG error when we reach the call + * handler. + */ + Tcl_SetObjResult(interp, objv[2]); + return TCL_ERROR; + } + + /* + * For non-error messages, just pass 'em to ereport(). We do not expect + * that this will fail, but just on the off chance it does, report the + * error back to Tcl. Note we are assuming that ereport() can't have any + * internal failures that are so bad as to require a transaction abort. + * + * This path is also used for FATAL errors, which aren't going to come + * back to us at all. + */ + oldcontext = CurrentMemoryContext; + PG_TRY(); + { + UTF_BEGIN; + ereport(level, + (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION), + errmsg("%s", UTF_U2E(Tcl_GetString(objv[2]))))); + UTF_END; + } + PG_CATCH(); + { + ErrorData *edata; + + /* Must reset elog.c's state */ + MemoryContextSwitchTo(oldcontext); + edata = CopyErrorData(); + FlushErrorState(); + + /* Pass the error data to Tcl */ + pltcl_construct_errorCode(interp, edata); + UTF_BEGIN; + Tcl_SetObjResult(interp, Tcl_NewStringObj(UTF_E2U(edata->message), -1)); + UTF_END; + FreeErrorData(edata); + + return TCL_ERROR; + } + PG_END_TRY(); + + return TCL_OK; +} + + +/********************************************************************** + * pltcl_construct_errorCode() - construct a Tcl errorCode + * list with detailed information from the PostgreSQL server + **********************************************************************/ +static void +pltcl_construct_errorCode(Tcl_Interp *interp, ErrorData *edata) +{ + Tcl_Obj *obj = Tcl_NewObj(); + + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("POSTGRES", -1)); + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(PG_VERSION, -1)); + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("SQLSTATE", -1)); + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(unpack_sql_state(edata->sqlerrcode), -1)); + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("condition", -1)); + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(pltcl_get_condition_name(edata->sqlerrcode), -1)); + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("message", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->message), -1)); + UTF_END; + if (edata->detail) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("detail", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->detail), -1)); + UTF_END; + } + if (edata->hint) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("hint", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->hint), -1)); + UTF_END; + } + if (edata->context) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("context", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->context), -1)); + UTF_END; + } + if (edata->schema_name) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("schema", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->schema_name), -1)); + UTF_END; + } + if (edata->table_name) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("table", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->table_name), -1)); + UTF_END; + } + if (edata->column_name) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("column", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->column_name), -1)); + UTF_END; + } + if (edata->datatype_name) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("datatype", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->datatype_name), -1)); + UTF_END; + } + if (edata->constraint_name) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("constraint", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->constraint_name), -1)); + UTF_END; + } + /* cursorpos is never interesting here; report internal query/pos */ + if (edata->internalquery) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("statement", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->internalquery), -1)); + UTF_END; + } + if (edata->internalpos > 0) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("cursor_position", -1)); + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewIntObj(edata->internalpos)); + } + if (edata->filename) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("filename", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->filename), -1)); + UTF_END; + } + if (edata->lineno > 0) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("lineno", -1)); + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewIntObj(edata->lineno)); + } + if (edata->funcname) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("funcname", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->funcname), -1)); + UTF_END; + } + + Tcl_SetObjErrorCode(interp, obj); +} + + +/********************************************************************** + * pltcl_get_condition_name() - find name for SQLSTATE + **********************************************************************/ +static const char * +pltcl_get_condition_name(int sqlstate) +{ + int i; + + for (i = 0; exception_name_map[i].label != NULL; i++) + { + if (exception_name_map[i].sqlerrstate == sqlstate) + return exception_name_map[i].label; + } + return "unrecognized_sqlstate"; +} + + +/********************************************************************** + * pltcl_quote() - quote literal strings that are to + * be used in SPI_execute query strings + **********************************************************************/ +static int +pltcl_quote(ClientData cdata, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + char *tmp; + const char *cp1; + char *cp2; + int length; + + /************************************************************ + * Check call syntax + ************************************************************/ + if (objc != 2) + { + Tcl_WrongNumArgs(interp, 1, objv, "string"); + return TCL_ERROR; + } + + /************************************************************ + * Allocate space for the maximum the string can + * grow to and initialize pointers + ************************************************************/ + cp1 = Tcl_GetStringFromObj(objv[1], &length); + tmp = palloc(length * 2 + 1); + cp2 = tmp; + + /************************************************************ + * Walk through string and double every quote and backslash + ************************************************************/ + while (*cp1) + { + if (*cp1 == '\'') + *cp2++ = '\''; + else + { + if (*cp1 == '\\') + *cp2++ = '\\'; + } + *cp2++ = *cp1++; + } + + /************************************************************ + * Terminate the string and set it as result + ************************************************************/ + *cp2 = '\0'; + Tcl_SetObjResult(interp, Tcl_NewStringObj(tmp, -1)); + pfree(tmp); + return TCL_OK; +} + + +/********************************************************************** + * pltcl_argisnull() - determine if a specific argument is NULL + **********************************************************************/ +static int +pltcl_argisnull(ClientData cdata, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + int argno; + FunctionCallInfo fcinfo = pltcl_current_call_state->fcinfo; + + /************************************************************ + * Check call syntax + ************************************************************/ + if (objc != 2) + { + Tcl_WrongNumArgs(interp, 1, objv, "argno"); + return TCL_ERROR; + } + + /************************************************************ + * Check that we're called as a normal function + ************************************************************/ + if (fcinfo == NULL) + { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("argisnull cannot be used in triggers", -1)); + return TCL_ERROR; + } + + /************************************************************ + * Get the argument number + ************************************************************/ + if (Tcl_GetIntFromObj(interp, objv[1], &argno) != TCL_OK) + return TCL_ERROR; + + /************************************************************ + * Check that the argno is valid + ************************************************************/ + argno--; + if (argno < 0 || argno >= fcinfo->nargs) + { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("argno out of range", -1)); + return TCL_ERROR; + } + + /************************************************************ + * Get the requested NULL state + ************************************************************/ + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(PG_ARGISNULL(argno))); + return TCL_OK; +} + + +/********************************************************************** + * pltcl_returnnull() - Cause a NULL return from the current function + **********************************************************************/ +static int +pltcl_returnnull(ClientData cdata, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + FunctionCallInfo fcinfo = pltcl_current_call_state->fcinfo; + + /************************************************************ + * Check call syntax + ************************************************************/ + if (objc != 1) + { + Tcl_WrongNumArgs(interp, 1, objv, ""); + return TCL_ERROR; + } + + /************************************************************ + * Check that we're called as a normal function + ************************************************************/ + if (fcinfo == NULL) + { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("return_null cannot be used in triggers", -1)); + return TCL_ERROR; + } + + /************************************************************ + * Set the NULL return flag and cause Tcl to return from the + * procedure. + ************************************************************/ + fcinfo->isnull = true; + + return TCL_RETURN; +} + + +/********************************************************************** + * pltcl_returnnext() - Add a row to the result tuplestore in a SRF. + **********************************************************************/ +static int +pltcl_returnnext(ClientData cdata, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + pltcl_call_state *call_state = pltcl_current_call_state; + FunctionCallInfo fcinfo = call_state->fcinfo; + pltcl_proc_desc *prodesc = call_state->prodesc; + MemoryContext oldcontext = CurrentMemoryContext; + ResourceOwner oldowner = CurrentResourceOwner; + volatile int result = TCL_OK; + + /* + * Check that we're called as a set-returning function + */ + if (fcinfo == NULL) + { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("return_next cannot be used in triggers", -1)); + return TCL_ERROR; + } + + if (!prodesc->fn_retisset) + { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("return_next cannot be used in non-set-returning functions", -1)); + return TCL_ERROR; + } + + /* + * Check call syntax + */ + if (objc != 2) + { + Tcl_WrongNumArgs(interp, 1, objv, "result"); + return TCL_ERROR; + } + + /* + * The rest might throw elog(ERROR), so must run in a subtransaction. + * + * A small advantage of using a subtransaction is that it provides a + * short-lived memory context for free, so we needn't worry about leaking + * memory here. To use that context, call BeginInternalSubTransaction + * directly instead of going through pltcl_subtrans_begin. + */ + BeginInternalSubTransaction(NULL); + PG_TRY(); + { + /* Set up tuple store if first output row */ + if (call_state->tuple_store == NULL) + pltcl_init_tuple_store(call_state); + + if (prodesc->fn_retistuple) + { + Tcl_Obj **rowObjv; + int rowObjc; + + /* result should be a list, so break it down */ + if (Tcl_ListObjGetElements(interp, objv[1], &rowObjc, &rowObjv) == TCL_ERROR) + result = TCL_ERROR; + else + { + HeapTuple tuple; + + tuple = pltcl_build_tuple_result(interp, rowObjv, rowObjc, + call_state); + tuplestore_puttuple(call_state->tuple_store, tuple); + } + } + else + { + Datum retval; + bool isNull = false; + + /* for paranoia's sake, check that tupdesc has exactly one column */ + if (call_state->ret_tupdesc->natts != 1) + elog(ERROR, "wrong result type supplied in return_next"); + + retval = InputFunctionCall(&prodesc->result_in_func, + utf_u2e((char *) Tcl_GetString(objv[1])), + prodesc->result_typioparam, + -1); + tuplestore_putvalues(call_state->tuple_store, call_state->ret_tupdesc, + &retval, &isNull); + } + + pltcl_subtrans_commit(oldcontext, oldowner); + } + PG_CATCH(); + { + pltcl_subtrans_abort(interp, oldcontext, oldowner); + return TCL_ERROR; + } + PG_END_TRY(); + + return result; +} + + +/*---------- + * Support for running SPI operations inside subtransactions + * + * Intended usage pattern is: + * + * MemoryContext oldcontext = CurrentMemoryContext; + * ResourceOwner oldowner = CurrentResourceOwner; + * + * ... + * pltcl_subtrans_begin(oldcontext, oldowner); + * PG_TRY(); + * { + * do something risky; + * pltcl_subtrans_commit(oldcontext, oldowner); + * } + * PG_CATCH(); + * { + * pltcl_subtrans_abort(interp, oldcontext, oldowner); + * return TCL_ERROR; + * } + * PG_END_TRY(); + * return TCL_OK; + *---------- + */ +static void +pltcl_subtrans_begin(MemoryContext oldcontext, ResourceOwner oldowner) +{ + BeginInternalSubTransaction(NULL); + + /* Want to run inside function's memory context */ + MemoryContextSwitchTo(oldcontext); +} + +static void +pltcl_subtrans_commit(MemoryContext oldcontext, ResourceOwner oldowner) +{ + /* Commit the inner transaction, return to outer xact context */ + ReleaseCurrentSubTransaction(); + MemoryContextSwitchTo(oldcontext); + CurrentResourceOwner = oldowner; +} + +static void +pltcl_subtrans_abort(Tcl_Interp *interp, + MemoryContext oldcontext, ResourceOwner oldowner) +{ + ErrorData *edata; + + /* Save error info */ + MemoryContextSwitchTo(oldcontext); + edata = CopyErrorData(); + FlushErrorState(); + + /* Abort the inner transaction */ + RollbackAndReleaseCurrentSubTransaction(); + MemoryContextSwitchTo(oldcontext); + CurrentResourceOwner = oldowner; + + /* Pass the error data to Tcl */ + pltcl_construct_errorCode(interp, edata); + UTF_BEGIN; + Tcl_SetObjResult(interp, Tcl_NewStringObj(UTF_E2U(edata->message), -1)); + UTF_END; + FreeErrorData(edata); +} + + +/********************************************************************** + * pltcl_SPI_execute() - The builtin SPI_execute command + * for the Tcl interpreter + **********************************************************************/ +static int +pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + int my_rc; + int spi_rc; + int query_idx; + int i; + int optIndex; + int count = 0; + const char *volatile arrayname = NULL; + Tcl_Obj *volatile loop_body = NULL; + MemoryContext oldcontext = CurrentMemoryContext; + ResourceOwner oldowner = CurrentResourceOwner; + + enum options + { + OPT_ARRAY, OPT_COUNT + }; + + static const char *options[] = { + "-array", "-count", (const char *) NULL + }; + + /************************************************************ + * Check the call syntax and get the options + ************************************************************/ + if (objc < 2) + { + Tcl_WrongNumArgs(interp, 1, objv, + "?-count n? ?-array name? query ?loop body?"); + return TCL_ERROR; + } + + i = 1; + while (i < objc) + { + if (Tcl_GetIndexFromObj(NULL, objv[i], options, NULL, + TCL_EXACT, &optIndex) != TCL_OK) + break; + + if (++i >= objc) + { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("missing argument to -count or -array", -1)); + return TCL_ERROR; + } + + switch ((enum options) optIndex) + { + case OPT_ARRAY: + arrayname = Tcl_GetString(objv[i++]); + break; + + case OPT_COUNT: + if (Tcl_GetIntFromObj(interp, objv[i++], &count) != TCL_OK) + return TCL_ERROR; + break; + } + } + + query_idx = i; + if (query_idx >= objc || query_idx + 2 < objc) + { + Tcl_WrongNumArgs(interp, query_idx - 1, objv, "query ?loop body?"); + return TCL_ERROR; + } + + if (query_idx + 1 < objc) + loop_body = objv[query_idx + 1]; + + /************************************************************ + * Execute the query inside a sub-transaction, so we can cope with + * errors sanely + ************************************************************/ + + pltcl_subtrans_begin(oldcontext, oldowner); + + PG_TRY(); + { + UTF_BEGIN; + spi_rc = SPI_execute(UTF_U2E(Tcl_GetString(objv[query_idx])), + pltcl_current_call_state->prodesc->fn_readonly, count); + UTF_END; + + my_rc = pltcl_process_SPI_result(interp, + arrayname, + loop_body, + spi_rc, + SPI_tuptable, + SPI_processed); + + pltcl_subtrans_commit(oldcontext, oldowner); + } + PG_CATCH(); + { + pltcl_subtrans_abort(interp, oldcontext, oldowner); + return TCL_ERROR; + } + PG_END_TRY(); + + return my_rc; +} + +/* + * Process the result from SPI_execute or SPI_execute_plan + * + * Shared code between pltcl_SPI_execute and pltcl_SPI_execute_plan + */ +static int +pltcl_process_SPI_result(Tcl_Interp *interp, + const char *arrayname, + Tcl_Obj *loop_body, + int spi_rc, + SPITupleTable *tuptable, + uint64 ntuples) +{ + int my_rc = TCL_OK; + int loop_rc; + HeapTuple *tuples; + TupleDesc tupdesc; + + switch (spi_rc) + { + case SPI_OK_SELINTO: + case SPI_OK_INSERT: + case SPI_OK_DELETE: + case SPI_OK_UPDATE: + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(ntuples)); + break; + + case SPI_OK_UTILITY: + case SPI_OK_REWRITTEN: + if (tuptable == NULL) + { + Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); + break; + } + /* fall through for utility returning tuples */ + /* FALLTHROUGH */ + + case SPI_OK_SELECT: + case SPI_OK_INSERT_RETURNING: + case SPI_OK_DELETE_RETURNING: + case SPI_OK_UPDATE_RETURNING: + + /* + * Process the tuples we got + */ + tuples = tuptable->vals; + tupdesc = tuptable->tupdesc; + + if (loop_body == NULL) + { + /* + * If there is no loop body given, just set the variables from + * the first tuple (if any) + */ + if (ntuples > 0) + pltcl_set_tuple_values(interp, arrayname, 0, + tuples[0], tupdesc); + } + else + { + /* + * There is a loop body - process all tuples and evaluate the + * body on each + */ + uint64 i; + + for (i = 0; i < ntuples; i++) + { + pltcl_set_tuple_values(interp, arrayname, i, + tuples[i], tupdesc); + + loop_rc = Tcl_EvalObjEx(interp, loop_body, 0); + + if (loop_rc == TCL_OK) + continue; + if (loop_rc == TCL_CONTINUE) + continue; + if (loop_rc == TCL_RETURN) + { + my_rc = TCL_RETURN; + break; + } + if (loop_rc == TCL_BREAK) + break; + my_rc = TCL_ERROR; + break; + } + } + + if (my_rc == TCL_OK) + { + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(ntuples)); + } + break; + + default: + Tcl_AppendResult(interp, "pltcl: SPI_execute failed: ", + SPI_result_code_string(spi_rc), NULL); + my_rc = TCL_ERROR; + break; + } + + SPI_freetuptable(tuptable); + + return my_rc; +} + + +/********************************************************************** + * pltcl_SPI_prepare() - Builtin support for prepared plans + * The Tcl command SPI_prepare + * always saves the plan using + * SPI_keepplan and returns a key for + * access. There is no chance to prepare + * and not save the plan currently. + **********************************************************************/ +static int +pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + volatile MemoryContext plan_cxt = NULL; + int nargs; + Tcl_Obj **argsObj; + pltcl_query_desc *qdesc; + int i; + Tcl_HashEntry *hashent; + int hashnew; + Tcl_HashTable *query_hash; + MemoryContext oldcontext = CurrentMemoryContext; + ResourceOwner oldowner = CurrentResourceOwner; + + /************************************************************ + * Check the call syntax + ************************************************************/ + if (objc != 3) + { + Tcl_WrongNumArgs(interp, 1, objv, "query argtypes"); + return TCL_ERROR; + } + + /************************************************************ + * Split the argument type list + ************************************************************/ + if (Tcl_ListObjGetElements(interp, objv[2], &nargs, &argsObj) != TCL_OK) + return TCL_ERROR; + + /************************************************************ + * Allocate the new querydesc structure + * + * struct qdesc and subsidiary data all live in plan_cxt. Note that if the + * function is recompiled for whatever reason, permanent memory leaks + * occur. FIXME someday. + ************************************************************/ + plan_cxt = AllocSetContextCreate(TopMemoryContext, + "PL/Tcl spi_prepare query", + ALLOCSET_SMALL_SIZES); + MemoryContextSwitchTo(plan_cxt); + qdesc = (pltcl_query_desc *) palloc0(sizeof(pltcl_query_desc)); + snprintf(qdesc->qname, sizeof(qdesc->qname), "%p", qdesc); + qdesc->nargs = nargs; + qdesc->argtypes = (Oid *) palloc(nargs * sizeof(Oid)); + qdesc->arginfuncs = (FmgrInfo *) palloc(nargs * sizeof(FmgrInfo)); + qdesc->argtypioparams = (Oid *) palloc(nargs * sizeof(Oid)); + MemoryContextSwitchTo(oldcontext); + + /************************************************************ + * Execute the prepare inside a sub-transaction, so we can cope with + * errors sanely + ************************************************************/ + + pltcl_subtrans_begin(oldcontext, oldowner); + + PG_TRY(); + { + /************************************************************ + * Resolve argument type names and then look them up by oid + * in the system cache, and remember the required information + * for input conversion. + ************************************************************/ + for (i = 0; i < nargs; i++) + { + Oid typId, + typInput, + typIOParam; + int32 typmod; + + parseTypeString(Tcl_GetString(argsObj[i]), &typId, &typmod, false); + + getTypeInputInfo(typId, &typInput, &typIOParam); + + qdesc->argtypes[i] = typId; + fmgr_info_cxt(typInput, &(qdesc->arginfuncs[i]), plan_cxt); + qdesc->argtypioparams[i] = typIOParam; + } + + /************************************************************ + * Prepare the plan and check for errors + ************************************************************/ + UTF_BEGIN; + qdesc->plan = SPI_prepare(UTF_U2E(Tcl_GetString(objv[1])), + nargs, qdesc->argtypes); + UTF_END; + + if (qdesc->plan == NULL) + elog(ERROR, "SPI_prepare() failed"); + + /************************************************************ + * Save the plan into permanent memory (right now it's in the + * SPI procCxt, which will go away at function end). + ************************************************************/ + if (SPI_keepplan(qdesc->plan)) + elog(ERROR, "SPI_keepplan() failed"); + + pltcl_subtrans_commit(oldcontext, oldowner); + } + PG_CATCH(); + { + pltcl_subtrans_abort(interp, oldcontext, oldowner); + + MemoryContextDelete(plan_cxt); + + return TCL_ERROR; + } + PG_END_TRY(); + + /************************************************************ + * Insert a hashtable entry for the plan and return + * the key to the caller + ************************************************************/ + query_hash = &pltcl_current_call_state->prodesc->interp_desc->query_hash; + + hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew); + Tcl_SetHashValue(hashent, (ClientData) qdesc); + + /* qname is ASCII, so no need for encoding conversion */ + Tcl_SetObjResult(interp, Tcl_NewStringObj(qdesc->qname, -1)); + return TCL_OK; +} + + +/********************************************************************** + * pltcl_SPI_execute_plan() - Execute a prepared plan + **********************************************************************/ +static int +pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + int my_rc; + int spi_rc; + int i; + int j; + int optIndex; + Tcl_HashEntry *hashent; + pltcl_query_desc *qdesc; + const char *nulls = NULL; + const char *arrayname = NULL; + Tcl_Obj *loop_body = NULL; + int count = 0; + int callObjc; + Tcl_Obj **callObjv = NULL; + Datum *argvalues; + MemoryContext oldcontext = CurrentMemoryContext; + ResourceOwner oldowner = CurrentResourceOwner; + Tcl_HashTable *query_hash; + + enum options + { + OPT_ARRAY, OPT_COUNT, OPT_NULLS + }; + + static const char *options[] = { + "-array", "-count", "-nulls", (const char *) NULL + }; + + /************************************************************ + * Get the options and check syntax + ************************************************************/ + i = 1; + while (i < objc) + { + if (Tcl_GetIndexFromObj(NULL, objv[i], options, NULL, + TCL_EXACT, &optIndex) != TCL_OK) + break; + + if (++i >= objc) + { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("missing argument to -array, -count or -nulls", -1)); + return TCL_ERROR; + } + + switch ((enum options) optIndex) + { + case OPT_ARRAY: + arrayname = Tcl_GetString(objv[i++]); + break; + + case OPT_COUNT: + if (Tcl_GetIntFromObj(interp, objv[i++], &count) != TCL_OK) + return TCL_ERROR; + break; + + case OPT_NULLS: + nulls = Tcl_GetString(objv[i++]); + break; + } + } + + /************************************************************ + * Get the prepared plan descriptor by its key + ************************************************************/ + if (i >= objc) + { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("missing argument to -count or -array", -1)); + return TCL_ERROR; + } + + query_hash = &pltcl_current_call_state->prodesc->interp_desc->query_hash; + + hashent = Tcl_FindHashEntry(query_hash, Tcl_GetString(objv[i])); + if (hashent == NULL) + { + Tcl_AppendResult(interp, "invalid queryid '", Tcl_GetString(objv[i]), "'", NULL); + return TCL_ERROR; + } + qdesc = (pltcl_query_desc *) Tcl_GetHashValue(hashent); + i++; + + /************************************************************ + * If a nulls string is given, check for correct length + ************************************************************/ + if (nulls != NULL) + { + if (strlen(nulls) != qdesc->nargs) + { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("length of nulls string doesn't match number of arguments", + -1)); + return TCL_ERROR; + } + } + + /************************************************************ + * If there was an argtype list on preparation, we need + * an argument value list now + ************************************************************/ + if (qdesc->nargs > 0) + { + if (i >= objc) + { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("argument list length doesn't match number of arguments for query", + -1)); + return TCL_ERROR; + } + + /************************************************************ + * Split the argument values + ************************************************************/ + if (Tcl_ListObjGetElements(interp, objv[i++], &callObjc, &callObjv) != TCL_OK) + return TCL_ERROR; + + /************************************************************ + * Check that the number of arguments matches + ************************************************************/ + if (callObjc != qdesc->nargs) + { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("argument list length doesn't match number of arguments for query", + -1)); + return TCL_ERROR; + } + } + else + callObjc = 0; + + /************************************************************ + * Get loop body if present + ************************************************************/ + if (i < objc) + loop_body = objv[i++]; + + if (i != objc) + { + Tcl_WrongNumArgs(interp, 1, objv, + "?-count n? ?-array name? ?-nulls string? " + "query ?args? ?loop body?"); + return TCL_ERROR; + } + + /************************************************************ + * Execute the plan inside a sub-transaction, so we can cope with + * errors sanely + ************************************************************/ + + pltcl_subtrans_begin(oldcontext, oldowner); + + PG_TRY(); + { + /************************************************************ + * Setup the value array for SPI_execute_plan() using + * the type specific input functions + ************************************************************/ + argvalues = (Datum *) palloc(callObjc * sizeof(Datum)); + + for (j = 0; j < callObjc; j++) + { + if (nulls && nulls[j] == 'n') + { + argvalues[j] = InputFunctionCall(&qdesc->arginfuncs[j], + NULL, + qdesc->argtypioparams[j], + -1); + } + else + { + UTF_BEGIN; + argvalues[j] = InputFunctionCall(&qdesc->arginfuncs[j], + UTF_U2E(Tcl_GetString(callObjv[j])), + qdesc->argtypioparams[j], + -1); + UTF_END; + } + } + + /************************************************************ + * Execute the plan + ************************************************************/ + spi_rc = SPI_execute_plan(qdesc->plan, argvalues, nulls, + pltcl_current_call_state->prodesc->fn_readonly, + count); + + my_rc = pltcl_process_SPI_result(interp, + arrayname, + loop_body, + spi_rc, + SPI_tuptable, + SPI_processed); + + pltcl_subtrans_commit(oldcontext, oldowner); + } + PG_CATCH(); + { + pltcl_subtrans_abort(interp, oldcontext, oldowner); + return TCL_ERROR; + } + PG_END_TRY(); + + return my_rc; +} + + +/********************************************************************** + * pltcl_subtransaction() - Execute some Tcl code in a subtransaction + * + * The subtransaction is aborted if the Tcl code fragment returns TCL_ERROR, + * otherwise it's subcommitted. + **********************************************************************/ +static int +pltcl_subtransaction(ClientData cdata, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + MemoryContext oldcontext = CurrentMemoryContext; + ResourceOwner oldowner = CurrentResourceOwner; + int retcode; + + if (objc != 2) + { + Tcl_WrongNumArgs(interp, 1, objv, "command"); + return TCL_ERROR; + } + + /* + * Note: we don't use pltcl_subtrans_begin and friends here because we + * don't want the error handling in pltcl_subtrans_abort. But otherwise + * the processing should be about the same as in those functions. + */ + BeginInternalSubTransaction(NULL); + MemoryContextSwitchTo(oldcontext); + + retcode = Tcl_EvalObjEx(interp, objv[1], 0); + + if (retcode == TCL_ERROR) + { + /* Rollback the subtransaction */ + RollbackAndReleaseCurrentSubTransaction(); + } + else + { + /* Commit the subtransaction */ + ReleaseCurrentSubTransaction(); + } + + /* In either case, restore previous memory context and resource owner */ + MemoryContextSwitchTo(oldcontext); + CurrentResourceOwner = oldowner; + + return retcode; +} + + +/********************************************************************** + * pltcl_commit() + * + * Commit the transaction and start a new one. + **********************************************************************/ +static int +pltcl_commit(ClientData cdata, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + MemoryContext oldcontext = CurrentMemoryContext; + + PG_TRY(); + { + SPI_commit(); + SPI_start_transaction(); + } + PG_CATCH(); + { + ErrorData *edata; + + /* Save error info */ + MemoryContextSwitchTo(oldcontext); + edata = CopyErrorData(); + FlushErrorState(); + + /* Pass the error data to Tcl */ + pltcl_construct_errorCode(interp, edata); + UTF_BEGIN; + Tcl_SetObjResult(interp, Tcl_NewStringObj(UTF_E2U(edata->message), -1)); + UTF_END; + FreeErrorData(edata); + + return TCL_ERROR; + } + PG_END_TRY(); + + return TCL_OK; +} + + +/********************************************************************** + * pltcl_rollback() + * + * Abort the transaction and start a new one. + **********************************************************************/ +static int +pltcl_rollback(ClientData cdata, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + MemoryContext oldcontext = CurrentMemoryContext; + + PG_TRY(); + { + SPI_rollback(); + SPI_start_transaction(); + } + PG_CATCH(); + { + ErrorData *edata; + + /* Save error info */ + MemoryContextSwitchTo(oldcontext); + edata = CopyErrorData(); + FlushErrorState(); + + /* Pass the error data to Tcl */ + pltcl_construct_errorCode(interp, edata); + UTF_BEGIN; + Tcl_SetObjResult(interp, Tcl_NewStringObj(UTF_E2U(edata->message), -1)); + UTF_END; + FreeErrorData(edata); + + return TCL_ERROR; + } + PG_END_TRY(); + + return TCL_OK; +} + + +/********************************************************************** + * pltcl_set_tuple_values() - Set variables for all attributes + * of a given tuple + * + * Note: arrayname is presumed to be UTF8; it usually came from Tcl + **********************************************************************/ +static void +pltcl_set_tuple_values(Tcl_Interp *interp, const char *arrayname, + uint64 tupno, HeapTuple tuple, TupleDesc tupdesc) +{ + int i; + char *outputstr; + Datum attr; + bool isnull; + const char *attname; + Oid typoutput; + bool typisvarlena; + const char **arrptr; + const char **nameptr; + const char *nullname = NULL; + + /************************************************************ + * Prepare pointers for Tcl_SetVar2Ex() below + ************************************************************/ + if (arrayname == NULL) + { + arrptr = &attname; + nameptr = &nullname; + } + else + { + arrptr = &arrayname; + nameptr = &attname; + + /* + * When outputting to an array, fill the ".tupno" element with the + * current tuple number. This will be overridden below if ".tupno" is + * in use as an actual field name in the rowtype. + */ + Tcl_SetVar2Ex(interp, arrayname, ".tupno", Tcl_NewWideIntObj(tupno), 0); + } + + for (i = 0; i < tupdesc->natts; i++) + { + Form_pg_attribute att = TupleDescAttr(tupdesc, i); + + /* ignore dropped attributes */ + if (att->attisdropped) + continue; + + /************************************************************ + * Get the attribute name + ************************************************************/ + UTF_BEGIN; + attname = pstrdup(UTF_E2U(NameStr(att->attname))); + UTF_END; + + /************************************************************ + * Get the attributes value + ************************************************************/ + attr = heap_getattr(tuple, i + 1, tupdesc, &isnull); + + /************************************************************ + * If there is a value, set the variable + * If not, unset it + * + * Hmmm - Null attributes will cause functions to + * crash if they don't expect them - need something + * smarter here. + ************************************************************/ + if (!isnull) + { + getTypeOutputInfo(att->atttypid, &typoutput, &typisvarlena); + outputstr = OidOutputFunctionCall(typoutput, attr); + UTF_BEGIN; + Tcl_SetVar2Ex(interp, *arrptr, *nameptr, + Tcl_NewStringObj(UTF_E2U(outputstr), -1), 0); + UTF_END; + pfree(outputstr); + } + else + Tcl_UnsetVar2(interp, *arrptr, *nameptr, 0); + + pfree(unconstify(char *, attname)); + } +} + + +/********************************************************************** + * pltcl_build_tuple_argument() - Build a list object usable for 'array set' + * from all attributes of a given tuple + **********************************************************************/ +static Tcl_Obj * +pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc, bool include_generated) +{ + Tcl_Obj *retobj = Tcl_NewObj(); + int i; + char *outputstr; + Datum attr; + bool isnull; + char *attname; + Oid typoutput; + bool typisvarlena; + + for (i = 0; i < tupdesc->natts; i++) + { + Form_pg_attribute att = TupleDescAttr(tupdesc, i); + + /* ignore dropped attributes */ + if (att->attisdropped) + continue; + + if (att->attgenerated) + { + /* don't include unless requested */ + if (!include_generated) + continue; + } + + /************************************************************ + * Get the attribute name + ************************************************************/ + attname = NameStr(att->attname); + + /************************************************************ + * Get the attributes value + ************************************************************/ + attr = heap_getattr(tuple, i + 1, tupdesc, &isnull); + + /************************************************************ + * If there is a value, append the attribute name and the + * value to the list + * + * Hmmm - Null attributes will cause functions to + * crash if they don't expect them - need something + * smarter here. + ************************************************************/ + if (!isnull) + { + getTypeOutputInfo(att->atttypid, + &typoutput, &typisvarlena); + outputstr = OidOutputFunctionCall(typoutput, attr); + UTF_BEGIN; + Tcl_ListObjAppendElement(NULL, retobj, + Tcl_NewStringObj(UTF_E2U(attname), -1)); + UTF_END; + UTF_BEGIN; + Tcl_ListObjAppendElement(NULL, retobj, + Tcl_NewStringObj(UTF_E2U(outputstr), -1)); + UTF_END; + pfree(outputstr); + } + } + + return retobj; +} + +/********************************************************************** + * pltcl_build_tuple_result() - Build a tuple of function's result rowtype + * from a Tcl list of column names and values + * + * In a trigger function, we build a tuple of the trigger table's rowtype. + * + * Note: this function leaks memory. Even if we made it clean up its own + * mess, there's no way to prevent the datatype input functions it calls + * from leaking. Run it in a short-lived context, unless we're about to + * exit the procedure anyway. + **********************************************************************/ +static HeapTuple +pltcl_build_tuple_result(Tcl_Interp *interp, Tcl_Obj **kvObjv, int kvObjc, + pltcl_call_state *call_state) +{ + HeapTuple tuple; + TupleDesc tupdesc; + AttInMetadata *attinmeta; + char **values; + int i; + + if (call_state->ret_tupdesc) + { + tupdesc = call_state->ret_tupdesc; + attinmeta = call_state->attinmeta; + } + else if (call_state->trigdata) + { + tupdesc = RelationGetDescr(call_state->trigdata->tg_relation); + attinmeta = TupleDescGetAttInMetadata(tupdesc); + } + else + { + elog(ERROR, "PL/Tcl function does not return a tuple"); + tupdesc = NULL; /* keep compiler quiet */ + attinmeta = NULL; + } + + values = (char **) palloc0(tupdesc->natts * sizeof(char *)); + + if (kvObjc % 2 != 0) + ereport(ERROR, + (errcode(ERRCODE_INVALID_PARAMETER_VALUE), + errmsg("column name/value list must have even number of elements"))); + + for (i = 0; i < kvObjc; i += 2) + { + char *fieldName = utf_u2e(Tcl_GetString(kvObjv[i])); + int attn = SPI_fnumber(tupdesc, fieldName); + + /* + * We silently ignore ".tupno", if it's present but doesn't match any + * actual output column. This allows direct use of a row returned by + * pltcl_set_tuple_values(). + */ + if (attn == SPI_ERROR_NOATTRIBUTE) + { + if (strcmp(fieldName, ".tupno") == 0) + continue; + ereport(ERROR, + (errcode(ERRCODE_UNDEFINED_COLUMN), + errmsg("column name/value list contains nonexistent column name \"%s\"", + fieldName))); + } + + if (attn <= 0) + ereport(ERROR, + (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), + errmsg("cannot set system attribute \"%s\"", + fieldName))); + + if (TupleDescAttr(tupdesc, attn - 1)->attgenerated) + ereport(ERROR, + (errcode(ERRCODE_E_R_I_E_TRIGGER_PROTOCOL_VIOLATED), + errmsg("cannot set generated column \"%s\"", + fieldName))); + + values[attn - 1] = utf_u2e(Tcl_GetString(kvObjv[i + 1])); + } + + tuple = BuildTupleFromCStrings(attinmeta, values); + + /* if result type is domain-over-composite, check domain constraints */ + if (call_state->prodesc->fn_retisdomain) + domain_check(HeapTupleGetDatum(tuple), false, + call_state->prodesc->result_typid, + &call_state->prodesc->domain_info, + call_state->prodesc->fn_cxt); + + return tuple; +} + +/********************************************************************** + * pltcl_init_tuple_store() - Initialize the result tuplestore for a SRF + **********************************************************************/ +static void +pltcl_init_tuple_store(pltcl_call_state *call_state) +{ + ReturnSetInfo *rsi = call_state->rsi; + MemoryContext oldcxt; + ResourceOwner oldowner; + + /* Should be in a SRF */ + Assert(rsi); + /* Should be first time through */ + Assert(!call_state->tuple_store); + Assert(!call_state->attinmeta); + + /* We expect caller to provide an appropriate result tupdesc */ + Assert(rsi->expectedDesc); + call_state->ret_tupdesc = rsi->expectedDesc; + + /* + * Switch to the right memory context and resource owner for storing the + * tuplestore. If we're within a subtransaction opened for an exception + * block, for example, we must still create the tuplestore in the resource + * owner that was active when this function was entered, and not in the + * subtransaction's resource owner. + */ + oldcxt = MemoryContextSwitchTo(call_state->tuple_store_cxt); + oldowner = CurrentResourceOwner; + CurrentResourceOwner = call_state->tuple_store_owner; + + call_state->tuple_store = + tuplestore_begin_heap(rsi->allowedModes & SFRM_Materialize_Random, + false, work_mem); + + /* Build attinmeta in this context, too */ + call_state->attinmeta = TupleDescGetAttInMetadata(call_state->ret_tupdesc); + + CurrentResourceOwner = oldowner; + MemoryContextSwitchTo(oldcxt); +} diff --git a/src/pl/tcl/pltcl.control b/src/pl/tcl/pltcl.control new file mode 100644 index 0000000..1568c17 --- /dev/null +++ b/src/pl/tcl/pltcl.control @@ -0,0 +1,8 @@ +# pltcl extension +comment = 'PL/Tcl procedural language' +default_version = '1.0' +module_pathname = '$libdir/pltcl' +relocatable = false +schema = pg_catalog +superuser = true +trusted = true diff --git a/src/pl/tcl/pltclerrcodes.h b/src/pl/tcl/pltclerrcodes.h new file mode 100644 index 0000000..a4a7252 --- /dev/null +++ b/src/pl/tcl/pltclerrcodes.h @@ -0,0 +1,990 @@ +/* autogenerated from src/backend/utils/errcodes.txt, do not edit */ +/* there is deliberately not an #ifndef PLTCLERRCODES_H here */ +{ + "sql_statement_not_yet_complete", ERRCODE_SQL_STATEMENT_NOT_YET_COMPLETE +}, + +{ + "connection_exception", ERRCODE_CONNECTION_EXCEPTION +}, + +{ + "connection_does_not_exist", ERRCODE_CONNECTION_DOES_NOT_EXIST +}, + +{ + "connection_failure", ERRCODE_CONNECTION_FAILURE +}, + +{ + "sqlclient_unable_to_establish_sqlconnection", ERRCODE_SQLCLIENT_UNABLE_TO_ESTABLISH_SQLCONNECTION +}, + +{ + "sqlserver_rejected_establishment_of_sqlconnection", ERRCODE_SQLSERVER_REJECTED_ESTABLISHMENT_OF_SQLCONNECTION +}, + +{ + "transaction_resolution_unknown", ERRCODE_TRANSACTION_RESOLUTION_UNKNOWN +}, + +{ + "protocol_violation", ERRCODE_PROTOCOL_VIOLATION +}, + +{ + "triggered_action_exception", ERRCODE_TRIGGERED_ACTION_EXCEPTION +}, + +{ + "feature_not_supported", ERRCODE_FEATURE_NOT_SUPPORTED +}, + +{ + "invalid_transaction_initiation", ERRCODE_INVALID_TRANSACTION_INITIATION +}, + +{ + "locator_exception", ERRCODE_LOCATOR_EXCEPTION +}, + +{ + "invalid_locator_specification", ERRCODE_L_E_INVALID_SPECIFICATION +}, + +{ + "invalid_grantor", ERRCODE_INVALID_GRANTOR +}, + +{ + "invalid_grant_operation", ERRCODE_INVALID_GRANT_OPERATION +}, + +{ + "invalid_role_specification", ERRCODE_INVALID_ROLE_SPECIFICATION +}, + +{ + "diagnostics_exception", ERRCODE_DIAGNOSTICS_EXCEPTION +}, + +{ + "stacked_diagnostics_accessed_without_active_handler", ERRCODE_STACKED_DIAGNOSTICS_ACCESSED_WITHOUT_ACTIVE_HANDLER +}, + +{ + "case_not_found", ERRCODE_CASE_NOT_FOUND +}, + +{ + "cardinality_violation", ERRCODE_CARDINALITY_VIOLATION +}, + +{ + "data_exception", ERRCODE_DATA_EXCEPTION +}, + +{ + "array_subscript_error", ERRCODE_ARRAY_SUBSCRIPT_ERROR +}, + +{ + "character_not_in_repertoire", ERRCODE_CHARACTER_NOT_IN_REPERTOIRE +}, + +{ + "datetime_field_overflow", ERRCODE_DATETIME_FIELD_OVERFLOW +}, + +{ + "division_by_zero", ERRCODE_DIVISION_BY_ZERO +}, + +{ + "error_in_assignment", ERRCODE_ERROR_IN_ASSIGNMENT +}, + +{ + "escape_character_conflict", ERRCODE_ESCAPE_CHARACTER_CONFLICT +}, + +{ + "indicator_overflow", ERRCODE_INDICATOR_OVERFLOW +}, + +{ + "interval_field_overflow", ERRCODE_INTERVAL_FIELD_OVERFLOW +}, + +{ + "invalid_argument_for_logarithm", ERRCODE_INVALID_ARGUMENT_FOR_LOG +}, + +{ + "invalid_argument_for_ntile_function", ERRCODE_INVALID_ARGUMENT_FOR_NTILE +}, + +{ + "invalid_argument_for_nth_value_function", ERRCODE_INVALID_ARGUMENT_FOR_NTH_VALUE +}, + +{ + "invalid_argument_for_power_function", ERRCODE_INVALID_ARGUMENT_FOR_POWER_FUNCTION +}, + +{ + "invalid_argument_for_width_bucket_function", ERRCODE_INVALID_ARGUMENT_FOR_WIDTH_BUCKET_FUNCTION +}, + +{ + "invalid_character_value_for_cast", ERRCODE_INVALID_CHARACTER_VALUE_FOR_CAST +}, + +{ + "invalid_datetime_format", ERRCODE_INVALID_DATETIME_FORMAT +}, + +{ + "invalid_escape_character", ERRCODE_INVALID_ESCAPE_CHARACTER +}, + +{ + "invalid_escape_octet", ERRCODE_INVALID_ESCAPE_OCTET +}, + +{ + "invalid_escape_sequence", ERRCODE_INVALID_ESCAPE_SEQUENCE +}, + +{ + "nonstandard_use_of_escape_character", ERRCODE_NONSTANDARD_USE_OF_ESCAPE_CHARACTER +}, + +{ + "invalid_indicator_parameter_value", ERRCODE_INVALID_INDICATOR_PARAMETER_VALUE +}, + +{ + "invalid_parameter_value", ERRCODE_INVALID_PARAMETER_VALUE +}, + +{ + "invalid_preceding_or_following_size", ERRCODE_INVALID_PRECEDING_OR_FOLLOWING_SIZE +}, + +{ + "invalid_regular_expression", ERRCODE_INVALID_REGULAR_EXPRESSION +}, + +{ + "invalid_row_count_in_limit_clause", ERRCODE_INVALID_ROW_COUNT_IN_LIMIT_CLAUSE +}, + +{ + "invalid_row_count_in_result_offset_clause", ERRCODE_INVALID_ROW_COUNT_IN_RESULT_OFFSET_CLAUSE +}, + +{ + "invalid_tablesample_argument", ERRCODE_INVALID_TABLESAMPLE_ARGUMENT +}, + +{ + "invalid_tablesample_repeat", ERRCODE_INVALID_TABLESAMPLE_REPEAT +}, + +{ + "invalid_time_zone_displacement_value", ERRCODE_INVALID_TIME_ZONE_DISPLACEMENT_VALUE +}, + +{ + "invalid_use_of_escape_character", ERRCODE_INVALID_USE_OF_ESCAPE_CHARACTER +}, + +{ + "most_specific_type_mismatch", ERRCODE_MOST_SPECIFIC_TYPE_MISMATCH +}, + +{ + "null_value_not_allowed", ERRCODE_NULL_VALUE_NOT_ALLOWED +}, + +{ + "null_value_no_indicator_parameter", ERRCODE_NULL_VALUE_NO_INDICATOR_PARAMETER +}, + +{ + "numeric_value_out_of_range", ERRCODE_NUMERIC_VALUE_OUT_OF_RANGE +}, + +{ + "sequence_generator_limit_exceeded", ERRCODE_SEQUENCE_GENERATOR_LIMIT_EXCEEDED +}, + +{ + "string_data_length_mismatch", ERRCODE_STRING_DATA_LENGTH_MISMATCH +}, + +{ + "string_data_right_truncation", ERRCODE_STRING_DATA_RIGHT_TRUNCATION +}, + +{ + "substring_error", ERRCODE_SUBSTRING_ERROR +}, + +{ + "trim_error", ERRCODE_TRIM_ERROR +}, + +{ + "unterminated_c_string", ERRCODE_UNTERMINATED_C_STRING +}, + +{ + "zero_length_character_string", ERRCODE_ZERO_LENGTH_CHARACTER_STRING +}, + +{ + "floating_point_exception", ERRCODE_FLOATING_POINT_EXCEPTION +}, + +{ + "invalid_text_representation", ERRCODE_INVALID_TEXT_REPRESENTATION +}, + +{ + "invalid_binary_representation", ERRCODE_INVALID_BINARY_REPRESENTATION +}, + +{ + "bad_copy_file_format", ERRCODE_BAD_COPY_FILE_FORMAT +}, + +{ + "untranslatable_character", ERRCODE_UNTRANSLATABLE_CHARACTER +}, + +{ + "not_an_xml_document", ERRCODE_NOT_AN_XML_DOCUMENT +}, + +{ + "invalid_xml_document", ERRCODE_INVALID_XML_DOCUMENT +}, + +{ + "invalid_xml_content", ERRCODE_INVALID_XML_CONTENT +}, + +{ + "invalid_xml_comment", ERRCODE_INVALID_XML_COMMENT +}, + +{ + "invalid_xml_processing_instruction", ERRCODE_INVALID_XML_PROCESSING_INSTRUCTION +}, + +{ + "duplicate_json_object_key_value", ERRCODE_DUPLICATE_JSON_OBJECT_KEY_VALUE +}, + +{ + "invalid_argument_for_sql_json_datetime_function", ERRCODE_INVALID_ARGUMENT_FOR_SQL_JSON_DATETIME_FUNCTION +}, + +{ + "invalid_json_text", ERRCODE_INVALID_JSON_TEXT +}, + +{ + "invalid_sql_json_subscript", ERRCODE_INVALID_SQL_JSON_SUBSCRIPT +}, + +{ + "more_than_one_sql_json_item", ERRCODE_MORE_THAN_ONE_SQL_JSON_ITEM +}, + +{ + "no_sql_json_item", ERRCODE_NO_SQL_JSON_ITEM +}, + +{ + "non_numeric_sql_json_item", ERRCODE_NON_NUMERIC_SQL_JSON_ITEM +}, + +{ + "non_unique_keys_in_a_json_object", ERRCODE_NON_UNIQUE_KEYS_IN_A_JSON_OBJECT +}, + +{ + "singleton_sql_json_item_required", ERRCODE_SINGLETON_SQL_JSON_ITEM_REQUIRED +}, + +{ + "sql_json_array_not_found", ERRCODE_SQL_JSON_ARRAY_NOT_FOUND +}, + +{ + "sql_json_member_not_found", ERRCODE_SQL_JSON_MEMBER_NOT_FOUND +}, + +{ + "sql_json_number_not_found", ERRCODE_SQL_JSON_NUMBER_NOT_FOUND +}, + +{ + "sql_json_object_not_found", ERRCODE_SQL_JSON_OBJECT_NOT_FOUND +}, + +{ + "too_many_json_array_elements", ERRCODE_TOO_MANY_JSON_ARRAY_ELEMENTS +}, + +{ + "too_many_json_object_members", ERRCODE_TOO_MANY_JSON_OBJECT_MEMBERS +}, + +{ + "sql_json_scalar_required", ERRCODE_SQL_JSON_SCALAR_REQUIRED +}, + +{ + "integrity_constraint_violation", ERRCODE_INTEGRITY_CONSTRAINT_VIOLATION +}, + +{ + "restrict_violation", ERRCODE_RESTRICT_VIOLATION +}, + +{ + "not_null_violation", ERRCODE_NOT_NULL_VIOLATION +}, + +{ + "foreign_key_violation", ERRCODE_FOREIGN_KEY_VIOLATION +}, + +{ + "unique_violation", ERRCODE_UNIQUE_VIOLATION +}, + +{ + "check_violation", ERRCODE_CHECK_VIOLATION +}, + +{ + "exclusion_violation", ERRCODE_EXCLUSION_VIOLATION +}, + +{ + "invalid_cursor_state", ERRCODE_INVALID_CURSOR_STATE +}, + +{ + "invalid_transaction_state", ERRCODE_INVALID_TRANSACTION_STATE +}, + +{ + "active_sql_transaction", ERRCODE_ACTIVE_SQL_TRANSACTION +}, + +{ + "branch_transaction_already_active", ERRCODE_BRANCH_TRANSACTION_ALREADY_ACTIVE +}, + +{ + "held_cursor_requires_same_isolation_level", ERRCODE_HELD_CURSOR_REQUIRES_SAME_ISOLATION_LEVEL +}, + +{ + "inappropriate_access_mode_for_branch_transaction", ERRCODE_INAPPROPRIATE_ACCESS_MODE_FOR_BRANCH_TRANSACTION +}, + +{ + "inappropriate_isolation_level_for_branch_transaction", ERRCODE_INAPPROPRIATE_ISOLATION_LEVEL_FOR_BRANCH_TRANSACTION +}, + +{ + "no_active_sql_transaction_for_branch_transaction", ERRCODE_NO_ACTIVE_SQL_TRANSACTION_FOR_BRANCH_TRANSACTION +}, + +{ + "read_only_sql_transaction", ERRCODE_READ_ONLY_SQL_TRANSACTION +}, + +{ + "schema_and_data_statement_mixing_not_supported", ERRCODE_SCHEMA_AND_DATA_STATEMENT_MIXING_NOT_SUPPORTED +}, + +{ + "no_active_sql_transaction", ERRCODE_NO_ACTIVE_SQL_TRANSACTION +}, + +{ + "in_failed_sql_transaction", ERRCODE_IN_FAILED_SQL_TRANSACTION +}, + +{ + "idle_in_transaction_session_timeout", ERRCODE_IDLE_IN_TRANSACTION_SESSION_TIMEOUT +}, + +{ + "invalid_sql_statement_name", ERRCODE_INVALID_SQL_STATEMENT_NAME +}, + +{ + "triggered_data_change_violation", ERRCODE_TRIGGERED_DATA_CHANGE_VIOLATION +}, + +{ + "invalid_authorization_specification", ERRCODE_INVALID_AUTHORIZATION_SPECIFICATION +}, + +{ + "invalid_password", ERRCODE_INVALID_PASSWORD +}, + +{ + "dependent_privilege_descriptors_still_exist", ERRCODE_DEPENDENT_PRIVILEGE_DESCRIPTORS_STILL_EXIST +}, + +{ + "dependent_objects_still_exist", ERRCODE_DEPENDENT_OBJECTS_STILL_EXIST +}, + +{ + "invalid_transaction_termination", ERRCODE_INVALID_TRANSACTION_TERMINATION +}, + +{ + "sql_routine_exception", ERRCODE_SQL_ROUTINE_EXCEPTION +}, + +{ + "function_executed_no_return_statement", ERRCODE_S_R_E_FUNCTION_EXECUTED_NO_RETURN_STATEMENT +}, + +{ + "modifying_sql_data_not_permitted", ERRCODE_S_R_E_MODIFYING_SQL_DATA_NOT_PERMITTED +}, + +{ + "prohibited_sql_statement_attempted", ERRCODE_S_R_E_PROHIBITED_SQL_STATEMENT_ATTEMPTED +}, + +{ + "reading_sql_data_not_permitted", ERRCODE_S_R_E_READING_SQL_DATA_NOT_PERMITTED +}, + +{ + "invalid_cursor_name", ERRCODE_INVALID_CURSOR_NAME +}, + +{ + "external_routine_exception", ERRCODE_EXTERNAL_ROUTINE_EXCEPTION +}, + +{ + "containing_sql_not_permitted", ERRCODE_E_R_E_CONTAINING_SQL_NOT_PERMITTED +}, + +{ + "modifying_sql_data_not_permitted", ERRCODE_E_R_E_MODIFYING_SQL_DATA_NOT_PERMITTED +}, + +{ + "prohibited_sql_statement_attempted", ERRCODE_E_R_E_PROHIBITED_SQL_STATEMENT_ATTEMPTED +}, + +{ + "reading_sql_data_not_permitted", ERRCODE_E_R_E_READING_SQL_DATA_NOT_PERMITTED +}, + +{ + "external_routine_invocation_exception", ERRCODE_EXTERNAL_ROUTINE_INVOCATION_EXCEPTION +}, + +{ + "invalid_sqlstate_returned", ERRCODE_E_R_I_E_INVALID_SQLSTATE_RETURNED +}, + +{ + "null_value_not_allowed", ERRCODE_E_R_I_E_NULL_VALUE_NOT_ALLOWED +}, + +{ + "trigger_protocol_violated", ERRCODE_E_R_I_E_TRIGGER_PROTOCOL_VIOLATED +}, + +{ + "srf_protocol_violated", ERRCODE_E_R_I_E_SRF_PROTOCOL_VIOLATED +}, + +{ + "event_trigger_protocol_violated", ERRCODE_E_R_I_E_EVENT_TRIGGER_PROTOCOL_VIOLATED +}, + +{ + "savepoint_exception", ERRCODE_SAVEPOINT_EXCEPTION +}, + +{ + "invalid_savepoint_specification", ERRCODE_S_E_INVALID_SPECIFICATION +}, + +{ + "invalid_catalog_name", ERRCODE_INVALID_CATALOG_NAME +}, + +{ + "invalid_schema_name", ERRCODE_INVALID_SCHEMA_NAME +}, + +{ + "transaction_rollback", ERRCODE_TRANSACTION_ROLLBACK +}, + +{ + "transaction_integrity_constraint_violation", ERRCODE_T_R_INTEGRITY_CONSTRAINT_VIOLATION +}, + +{ + "serialization_failure", ERRCODE_T_R_SERIALIZATION_FAILURE +}, + +{ + "statement_completion_unknown", ERRCODE_T_R_STATEMENT_COMPLETION_UNKNOWN +}, + +{ + "deadlock_detected", ERRCODE_T_R_DEADLOCK_DETECTED +}, + +{ + "syntax_error_or_access_rule_violation", ERRCODE_SYNTAX_ERROR_OR_ACCESS_RULE_VIOLATION +}, + +{ + "syntax_error", ERRCODE_SYNTAX_ERROR +}, + +{ + "insufficient_privilege", ERRCODE_INSUFFICIENT_PRIVILEGE +}, + +{ + "cannot_coerce", ERRCODE_CANNOT_COERCE +}, + +{ + "grouping_error", ERRCODE_GROUPING_ERROR +}, + +{ + "windowing_error", ERRCODE_WINDOWING_ERROR +}, + +{ + "invalid_recursion", ERRCODE_INVALID_RECURSION +}, + +{ + "invalid_foreign_key", ERRCODE_INVALID_FOREIGN_KEY +}, + +{ + "invalid_name", ERRCODE_INVALID_NAME +}, + +{ + "name_too_long", ERRCODE_NAME_TOO_LONG +}, + +{ + "reserved_name", ERRCODE_RESERVED_NAME +}, + +{ + "datatype_mismatch", ERRCODE_DATATYPE_MISMATCH +}, + +{ + "indeterminate_datatype", ERRCODE_INDETERMINATE_DATATYPE +}, + +{ + "collation_mismatch", ERRCODE_COLLATION_MISMATCH +}, + +{ + "indeterminate_collation", ERRCODE_INDETERMINATE_COLLATION +}, + +{ + "wrong_object_type", ERRCODE_WRONG_OBJECT_TYPE +}, + +{ + "generated_always", ERRCODE_GENERATED_ALWAYS +}, + +{ + "undefined_column", ERRCODE_UNDEFINED_COLUMN +}, + +{ + "undefined_function", ERRCODE_UNDEFINED_FUNCTION +}, + +{ + "undefined_table", ERRCODE_UNDEFINED_TABLE +}, + +{ + "undefined_parameter", ERRCODE_UNDEFINED_PARAMETER +}, + +{ + "undefined_object", ERRCODE_UNDEFINED_OBJECT +}, + +{ + "duplicate_column", ERRCODE_DUPLICATE_COLUMN +}, + +{ + "duplicate_cursor", ERRCODE_DUPLICATE_CURSOR +}, + +{ + "duplicate_database", ERRCODE_DUPLICATE_DATABASE +}, + +{ + "duplicate_function", ERRCODE_DUPLICATE_FUNCTION +}, + +{ + "duplicate_prepared_statement", ERRCODE_DUPLICATE_PSTATEMENT +}, + +{ + "duplicate_schema", ERRCODE_DUPLICATE_SCHEMA +}, + +{ + "duplicate_table", ERRCODE_DUPLICATE_TABLE +}, + +{ + "duplicate_alias", ERRCODE_DUPLICATE_ALIAS +}, + +{ + "duplicate_object", ERRCODE_DUPLICATE_OBJECT +}, + +{ + "ambiguous_column", ERRCODE_AMBIGUOUS_COLUMN +}, + +{ + "ambiguous_function", ERRCODE_AMBIGUOUS_FUNCTION +}, + +{ + "ambiguous_parameter", ERRCODE_AMBIGUOUS_PARAMETER +}, + +{ + "ambiguous_alias", ERRCODE_AMBIGUOUS_ALIAS +}, + +{ + "invalid_column_reference", ERRCODE_INVALID_COLUMN_REFERENCE +}, + +{ + "invalid_column_definition", ERRCODE_INVALID_COLUMN_DEFINITION +}, + +{ + "invalid_cursor_definition", ERRCODE_INVALID_CURSOR_DEFINITION +}, + +{ + "invalid_database_definition", ERRCODE_INVALID_DATABASE_DEFINITION +}, + +{ + "invalid_function_definition", ERRCODE_INVALID_FUNCTION_DEFINITION +}, + +{ + "invalid_prepared_statement_definition", ERRCODE_INVALID_PSTATEMENT_DEFINITION +}, + +{ + "invalid_schema_definition", ERRCODE_INVALID_SCHEMA_DEFINITION +}, + +{ + "invalid_table_definition", ERRCODE_INVALID_TABLE_DEFINITION +}, + +{ + "invalid_object_definition", ERRCODE_INVALID_OBJECT_DEFINITION +}, + +{ + "with_check_option_violation", ERRCODE_WITH_CHECK_OPTION_VIOLATION +}, + +{ + "insufficient_resources", ERRCODE_INSUFFICIENT_RESOURCES +}, + +{ + "disk_full", ERRCODE_DISK_FULL +}, + +{ + "out_of_memory", ERRCODE_OUT_OF_MEMORY +}, + +{ + "too_many_connections", ERRCODE_TOO_MANY_CONNECTIONS +}, + +{ + "configuration_limit_exceeded", ERRCODE_CONFIGURATION_LIMIT_EXCEEDED +}, + +{ + "program_limit_exceeded", ERRCODE_PROGRAM_LIMIT_EXCEEDED +}, + +{ + "statement_too_complex", ERRCODE_STATEMENT_TOO_COMPLEX +}, + +{ + "too_many_columns", ERRCODE_TOO_MANY_COLUMNS +}, + +{ + "too_many_arguments", ERRCODE_TOO_MANY_ARGUMENTS +}, + +{ + "object_not_in_prerequisite_state", ERRCODE_OBJECT_NOT_IN_PREREQUISITE_STATE +}, + +{ + "object_in_use", ERRCODE_OBJECT_IN_USE +}, + +{ + "cant_change_runtime_param", ERRCODE_CANT_CHANGE_RUNTIME_PARAM +}, + +{ + "lock_not_available", ERRCODE_LOCK_NOT_AVAILABLE +}, + +{ + "unsafe_new_enum_value_usage", ERRCODE_UNSAFE_NEW_ENUM_VALUE_USAGE +}, + +{ + "operator_intervention", ERRCODE_OPERATOR_INTERVENTION +}, + +{ + "query_canceled", ERRCODE_QUERY_CANCELED +}, + +{ + "admin_shutdown", ERRCODE_ADMIN_SHUTDOWN +}, + +{ + "crash_shutdown", ERRCODE_CRASH_SHUTDOWN +}, + +{ + "cannot_connect_now", ERRCODE_CANNOT_CONNECT_NOW +}, + +{ + "database_dropped", ERRCODE_DATABASE_DROPPED +}, + +{ + "system_error", ERRCODE_SYSTEM_ERROR +}, + +{ + "io_error", ERRCODE_IO_ERROR +}, + +{ + "undefined_file", ERRCODE_UNDEFINED_FILE +}, + +{ + "duplicate_file", ERRCODE_DUPLICATE_FILE +}, + +{ + "snapshot_too_old", ERRCODE_SNAPSHOT_TOO_OLD +}, + +{ + "config_file_error", ERRCODE_CONFIG_FILE_ERROR +}, + +{ + "lock_file_exists", ERRCODE_LOCK_FILE_EXISTS +}, + +{ + "fdw_error", ERRCODE_FDW_ERROR +}, + +{ + "fdw_column_name_not_found", ERRCODE_FDW_COLUMN_NAME_NOT_FOUND +}, + +{ + "fdw_dynamic_parameter_value_needed", ERRCODE_FDW_DYNAMIC_PARAMETER_VALUE_NEEDED +}, + +{ + "fdw_function_sequence_error", ERRCODE_FDW_FUNCTION_SEQUENCE_ERROR +}, + +{ + "fdw_inconsistent_descriptor_information", ERRCODE_FDW_INCONSISTENT_DESCRIPTOR_INFORMATION +}, + +{ + "fdw_invalid_attribute_value", ERRCODE_FDW_INVALID_ATTRIBUTE_VALUE +}, + +{ + "fdw_invalid_column_name", ERRCODE_FDW_INVALID_COLUMN_NAME +}, + +{ + "fdw_invalid_column_number", ERRCODE_FDW_INVALID_COLUMN_NUMBER +}, + +{ + "fdw_invalid_data_type", ERRCODE_FDW_INVALID_DATA_TYPE +}, + +{ + "fdw_invalid_data_type_descriptors", ERRCODE_FDW_INVALID_DATA_TYPE_DESCRIPTORS +}, + +{ + "fdw_invalid_descriptor_field_identifier", ERRCODE_FDW_INVALID_DESCRIPTOR_FIELD_IDENTIFIER +}, + +{ + "fdw_invalid_handle", ERRCODE_FDW_INVALID_HANDLE +}, + +{ + "fdw_invalid_option_index", ERRCODE_FDW_INVALID_OPTION_INDEX +}, + +{ + "fdw_invalid_option_name", ERRCODE_FDW_INVALID_OPTION_NAME +}, + +{ + "fdw_invalid_string_length_or_buffer_length", ERRCODE_FDW_INVALID_STRING_LENGTH_OR_BUFFER_LENGTH +}, + +{ + "fdw_invalid_string_format", ERRCODE_FDW_INVALID_STRING_FORMAT +}, + +{ + "fdw_invalid_use_of_null_pointer", ERRCODE_FDW_INVALID_USE_OF_NULL_POINTER +}, + +{ + "fdw_too_many_handles", ERRCODE_FDW_TOO_MANY_HANDLES +}, + +{ + "fdw_out_of_memory", ERRCODE_FDW_OUT_OF_MEMORY +}, + +{ + "fdw_no_schemas", ERRCODE_FDW_NO_SCHEMAS +}, + +{ + "fdw_option_name_not_found", ERRCODE_FDW_OPTION_NAME_NOT_FOUND +}, + +{ + "fdw_reply_handle", ERRCODE_FDW_REPLY_HANDLE +}, + +{ + "fdw_schema_not_found", ERRCODE_FDW_SCHEMA_NOT_FOUND +}, + +{ + "fdw_table_not_found", ERRCODE_FDW_TABLE_NOT_FOUND +}, + +{ + "fdw_unable_to_create_execution", ERRCODE_FDW_UNABLE_TO_CREATE_EXECUTION +}, + +{ + "fdw_unable_to_create_reply", ERRCODE_FDW_UNABLE_TO_CREATE_REPLY +}, + +{ + "fdw_unable_to_establish_connection", ERRCODE_FDW_UNABLE_TO_ESTABLISH_CONNECTION +}, + +{ + "plpgsql_error", ERRCODE_PLPGSQL_ERROR +}, + +{ + "raise_exception", ERRCODE_RAISE_EXCEPTION +}, + +{ + "no_data_found", ERRCODE_NO_DATA_FOUND +}, + +{ + "too_many_rows", ERRCODE_TOO_MANY_ROWS +}, + +{ + "assert_failure", ERRCODE_ASSERT_FAILURE +}, + +{ + "internal_error", ERRCODE_INTERNAL_ERROR +}, + +{ + "data_corrupted", ERRCODE_DATA_CORRUPTED +}, + +{ + "index_corrupted", ERRCODE_INDEX_CORRUPTED +}, + diff --git a/src/pl/tcl/pltclu--1.0.sql b/src/pl/tcl/pltclu--1.0.sql new file mode 100644 index 0000000..fca869f --- /dev/null +++ b/src/pl/tcl/pltclu--1.0.sql @@ -0,0 +1,9 @@ +/* src/pl/tcl/pltclu--1.0.sql */ + +CREATE FUNCTION pltclu_call_handler() RETURNS language_handler + LANGUAGE c AS 'MODULE_PATHNAME'; + +CREATE LANGUAGE pltclu + HANDLER pltclu_call_handler; + +COMMENT ON LANGUAGE pltclu IS 'PL/TclU untrusted procedural language'; diff --git a/src/pl/tcl/pltclu.control b/src/pl/tcl/pltclu.control new file mode 100644 index 0000000..1418dc5 --- /dev/null +++ b/src/pl/tcl/pltclu.control @@ -0,0 +1,7 @@ +# pltclu extension +comment = 'PL/TclU untrusted procedural language' +default_version = '1.0' +module_pathname = '$libdir/pltcl' +relocatable = false +schema = pg_catalog +superuser = true diff --git a/src/pl/tcl/po/cs.po b/src/pl/tcl/po/cs.po new file mode 100644 index 0000000..e48dff2 --- /dev/null +++ b/src/pl/tcl/po/cs.po @@ -0,0 +1,117 @@ +# Czech message translation file for pltcl +# Copyright (C) 2012 PostgreSQL Global Development Group +# This file is distributed under the same license as the PostgreSQL package. +# +# Tomáš Vondra <tv@fuzzy.cz>, 2012, 2013. +msgid "" +msgstr "" +"Project-Id-Version: pltcl-cs (PostgreSQL 9.3)\n" +"Report-Msgid-Bugs-To: pgsql-bugs@lists.postgresql.org\n" +"POT-Creation-Date: 2019-09-27 08:07+0000\n" +"PO-Revision-Date: 2019-09-27 21:02+0200\n" +"Last-Translator: Tomas Vondra <tv@fuzzy.cz>\n" +"Language-Team: Czech <info@cspug.cx>\n" +"Language: cs\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Generator: Poedit 2.2.3\n" + +#: pltcl.c:464 +msgid "PL/Tcl function to call once when pltcl is first used." +msgstr "PL/Tcl funkce kterou zavolat jednou při prvním použití pltcl." + +#: pltcl.c:471 +msgid "PL/TclU function to call once when pltclu is first used." +msgstr "PL/TclU funkce kterou zavolat jednou při prvním použití pltclu." + +#: pltcl.c:636 +#, c-format +msgid "function \"%s\" is in the wrong language" +msgstr "funkce \"%s\" je ve špatném jazyce" + +#: pltcl.c:647 +#, c-format +msgid "function \"%s\" must not be SECURITY DEFINER" +msgstr "funkce \"%s\" nesmí být SECURITY DEFINER" + +#. translator: %s is "pltcl.start_proc" or "pltclu.start_proc" +#: pltcl.c:681 +#, c-format +msgid "processing %s parameter" +msgstr "zpracovávám %s parametr" + +#: pltcl.c:842 +#, c-format +msgid "set-valued function called in context that cannot accept a set" +msgstr "set-valued funkce volána v kontextu který nemůže přijmout více řádek" + +#: pltcl.c:1015 +#, c-format +msgid "function returning record called in context that cannot accept type record" +msgstr "funkce vracející záznam volána v kontextu který nemůže přijmout záznam" + +#: pltcl.c:1299 +#, c-format +msgid "could not split return value from trigger: %s" +msgstr "z triggeru nelze oddělit návratovou hodnotu: %s" + +#: pltcl.c:1379 pltcl.c:1809 +#, c-format +msgid "%s" +msgstr "%s" + +#: pltcl.c:1380 +#, c-format +msgid "" +"%s\n" +"in PL/Tcl function \"%s\"" +msgstr "" +"%s\n" +"v PL/Tcl funkci \"%s\"" + +#: pltcl.c:1544 +#, c-format +msgid "trigger functions can only be called as triggers" +msgstr "funkce pro obsluhu triggerů mohou být volané pouze prostřednictvím triggerů" + +#: pltcl.c:1548 +#, c-format +msgid "PL/Tcl functions cannot return type %s" +msgstr "PL/Tcl funkce nemohou vracet datový typ %s" + +#: pltcl.c:1587 +#, c-format +msgid "PL/Tcl functions cannot accept type %s" +msgstr "PL/Tcl funkce nemohou přijímat datový typ %s" + +#: pltcl.c:1701 +#, c-format +msgid "could not create internal procedure \"%s\": %s" +msgstr "nelze vytvořit interní proceduru \"%s\": %s" + +#: pltcl.c:3208 +#, c-format +msgid "column name/value list must have even number of elements" +msgstr "seznam názvů sloupců a hodnot musí mít sudý počet položek" + +#: pltcl.c:3226 +#, c-format +msgid "column name/value list contains nonexistent column name \"%s\"" +msgstr "seznam názvů sloupců a hodnot obsahuje neexistující název sloupce \"%s\"" + +#: pltcl.c:3233 +#, c-format +msgid "cannot set system attribute \"%s\"" +msgstr "nelze nastavit systémový atribut \"%s\"" + +#: pltcl.c:3239 +#, c-format +msgid "cannot set generated column \"%s\"" +msgstr "nelze přiřazovat do generovaného sloupce \"%s\"" + +#~ msgid "PL/Tcl functions cannot return composite types" +#~ msgstr "PL/Tcl funkce nemohou vracet složené datové typy" + +#~ msgid "out of memory" +#~ msgstr "paměť vyčerpána" diff --git a/src/pl/tcl/po/de.po b/src/pl/tcl/po/de.po new file mode 100644 index 0000000..7e48770 --- /dev/null +++ b/src/pl/tcl/po/de.po @@ -0,0 +1,110 @@ +# German message translation file for PL/Tcl +# Peter Eisentraut <peter@eisentraut.org>, 2009 - 2019. +# +# Use these quotes: »%s« +# +msgid "" +msgstr "" +"Project-Id-Version: PostgreSQL 12\n" +"Report-Msgid-Bugs-To: pgsql-bugs@lists.postgresql.org\n" +"POT-Creation-Date: 2019-08-28 09:07+0000\n" +"PO-Revision-Date: 2019-08-28 11:21+0200\n" +"Last-Translator: Peter Eisentraut <peter@eisentraut.org>\n" +"Language-Team: German <pgsql-translators@postgresql.org>\n" +"Language: de\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" + +#: pltcl.c:464 +msgid "PL/Tcl function to call once when pltcl is first used." +msgstr "PL/Tcl-Funktion, die einmal aufgerufen wird, wenn pltcl zum ersten Mal benutzt wird." + +#: pltcl.c:471 +msgid "PL/TclU function to call once when pltclu is first used." +msgstr "PL/Tcl-Funktion, die einmal aufgerufen wird, wenn pltclu zum ersten Mal benutzt wird." + +#: pltcl.c:636 +#, c-format +msgid "function \"%s\" is in the wrong language" +msgstr "Funktion »%s« ist in der falschen Sprache" + +#: pltcl.c:647 +#, c-format +msgid "function \"%s\" must not be SECURITY DEFINER" +msgstr "Funktion »%s« darf nicht SECURITY DEFINER sein" + +#. translator: %s is "pltcl.start_proc" or "pltclu.start_proc" +#: pltcl.c:681 +#, c-format +msgid "processing %s parameter" +msgstr "Verarbeiten von Parameter von %s" + +#: pltcl.c:842 +#, c-format +msgid "set-valued function called in context that cannot accept a set" +msgstr "Funktion mit Mengenergebnis in einem Zusammenhang aufgerufen, der keine Mengenergebnisse verarbeiten kann" + +#: pltcl.c:1015 +#, c-format +msgid "function returning record called in context that cannot accept type record" +msgstr "Funktion, die einen Record zurückgibt, in einem Zusammenhang aufgerufen, der Typ record nicht verarbeiten kann" + +#: pltcl.c:1299 +#, c-format +msgid "could not split return value from trigger: %s" +msgstr "konnte Rückgabewert des Triggers nicht splitten: %s" + +#: pltcl.c:1379 pltcl.c:1809 +#, c-format +msgid "%s" +msgstr "%s" + +#: pltcl.c:1380 +#, c-format +msgid "" +"%s\n" +"in PL/Tcl function \"%s\"" +msgstr "" +"%s\n" +"in PL/Tcl-Funktion »%s«" + +#: pltcl.c:1544 +#, c-format +msgid "trigger functions can only be called as triggers" +msgstr "Triggerfunktionen können nur als Trigger aufgerufen werden" + +#: pltcl.c:1548 +#, c-format +msgid "PL/Tcl functions cannot return type %s" +msgstr "PL/Tcl-Funktionen können keinen Rückgabetyp %s haben" + +#: pltcl.c:1587 +#, c-format +msgid "PL/Tcl functions cannot accept type %s" +msgstr "PL/Tcl-Funktionen können Typ %s nicht annehmen" + +#: pltcl.c:1701 +#, c-format +msgid "could not create internal procedure \"%s\": %s" +msgstr "konnte interne Prozedur »%s« nicht erzeugen: %s" + +#: pltcl.c:3208 +#, c-format +msgid "column name/value list must have even number of elements" +msgstr "Liste der Spaltennamen/-werte muss gerade Anzahl Elemente haben" + +#: pltcl.c:3226 +#, c-format +msgid "column name/value list contains nonexistent column name \"%s\"" +msgstr "Liste der Spaltennamen/-werte enthält nicht existierenden Spaltennamen »%s«" + +#: pltcl.c:3233 +#, c-format +msgid "cannot set system attribute \"%s\"" +msgstr "Systemattribut »%s« kann nicht gesetzt werden" + +#: pltcl.c:3239 +#, c-format +msgid "cannot set generated column \"%s\"" +msgstr "kann generierte Spalte »%s« nicht setzen" diff --git a/src/pl/tcl/po/es.po b/src/pl/tcl/po/es.po new file mode 100644 index 0000000..7aa7658 --- /dev/null +++ b/src/pl/tcl/po/es.po @@ -0,0 +1,114 @@ +# Spanish translation file for pltcl +# +# Copyright (c) 2009-2019, PostgreSQL Global Development Group +# This file is distributed under the same license as the PostgreSQL package. +# +# Emanuel Calvo Franco <postgres.arg@gmail.com>, 2009. +# Alvaro Herrera <alvherre@alvh.no-ip.org>, 2009-2012, 2015 +# +msgid "" +msgstr "" +"Project-Id-Version: pltcl (PostgreSQL) 12\n" +"Report-Msgid-Bugs-To: pgsql-bugs@lists.postgresql.org\n" +"POT-Creation-Date: 2020-09-13 10:38+0000\n" +"PO-Revision-Date: 2019-06-06 17:26-0400\n" +"Last-Translator: Carlos Chapi <carlos.chapi@2ndquadrant.com>\n" +"Language-Team: PgSQL-es-Ayuda <pgsql-es-ayuda@lists.postgresql.org>\n" +"Language: es\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Generator: Poedit 2.0.2\n" + +#: pltcl.c:465 +msgid "PL/Tcl function to call once when pltcl is first used." +msgstr "función PL/Tcl a ejecutar cuando se use pltcl por primera vez." + +#: pltcl.c:472 +msgid "PL/TclU function to call once when pltclu is first used." +msgstr "función PL/TclU a ejecutar cuando se use pltclu por primera vez." + +#: pltcl.c:636 +#, c-format +msgid "function \"%s\" is in the wrong language" +msgstr "la función «%s» está en el lenguaje equivocado" + +#: pltcl.c:647 +#, c-format +msgid "function \"%s\" must not be SECURITY DEFINER" +msgstr "la función «%s» no debe ser SECURITY DEFINER" + +#. translator: %s is "pltcl.start_proc" or "pltclu.start_proc" +#: pltcl.c:681 +#, c-format +msgid "processing %s parameter" +msgstr "procesando el parámetro %s" + +#: pltcl.c:835 +#, c-format +msgid "set-valued function called in context that cannot accept a set" +msgstr "se llamó una función que retorna un conjunto en un contexto que no puede aceptarlo" + +#: pltcl.c:1008 +#, c-format +msgid "function returning record called in context that cannot accept type record" +msgstr "se llamó una función que retorna un registro en un contexto que no puede aceptarlo" + +#: pltcl.c:1292 +#, c-format +msgid "could not split return value from trigger: %s" +msgstr "no se pudo separar el valor de retorno del disparador: %s" + +#: pltcl.c:1373 pltcl.c:1803 +#, c-format +msgid "%s" +msgstr "%s" + +#: pltcl.c:1374 +#, c-format +msgid "" +"%s\n" +"in PL/Tcl function \"%s\"" +msgstr "" +"%s\n" +"en función PL/Tcl \"%s\"" + +#: pltcl.c:1538 +#, c-format +msgid "trigger functions can only be called as triggers" +msgstr "las funciones disparadoras sólo pueden ser invocadas como disparadores" + +#: pltcl.c:1542 +#, c-format +msgid "PL/Tcl functions cannot return type %s" +msgstr "las funciones PL/Tcl no pueden retornar tipo %s" + +#: pltcl.c:1581 +#, c-format +msgid "PL/Tcl functions cannot accept type %s" +msgstr "las funciones PL/Tcl no pueden aceptar el tipog%s" + +#: pltcl.c:1695 +#, c-format +msgid "could not create internal procedure \"%s\": %s" +msgstr "no se pudo crear procedimiento interno «%s»: %s" + +#: pltcl.c:3199 +#, c-format +msgid "column name/value list must have even number of elements" +msgstr "la lista de nombres de columnas y valores debe tener un número par de elementos" + +#: pltcl.c:3217 +#, c-format +msgid "column name/value list contains nonexistent column name \"%s\"" +msgstr "la lista de nombres de columnas y valores contiene el nombre de columna no existente «%s»" + +#: pltcl.c:3224 +#, c-format +msgid "cannot set system attribute \"%s\"" +msgstr "no se puede definir el atributo de sistema «%s»" + +#: pltcl.c:3230 +#, c-format +msgid "cannot set generated column \"%s\"" +msgstr "no se puede definir el atributo generado «%s»" diff --git a/src/pl/tcl/po/fr.po b/src/pl/tcl/po/fr.po new file mode 100644 index 0000000..cca8823 --- /dev/null +++ b/src/pl/tcl/po/fr.po @@ -0,0 +1,141 @@ +# translation of pltcl.po to fr_fr +# french message translation file for pltcl +# +# Use these quotes: « %s » +# Guillaume Lelarge <guillaume@lelarge.info>, 2009. +# +msgid "" +msgstr "" +"Project-Id-Version: PostgreSQL 12\n" +"Report-Msgid-Bugs-To: pgsql-bugs@lists.postgresql.org\n" +"POT-Creation-Date: 2019-05-17 01:07+0000\n" +"PO-Revision-Date: 2019-05-17 14:57+0200\n" +"Last-Translator: Guillaume Lelarge <guillaume@lelarge.info>\n" +"Language-Team: French <guillaume@lelarge.info>\n" +"Language: fr\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Generator: Poedit 2.2.1\n" + +#: pltcl.c:464 +msgid "PL/Tcl function to call once when pltcl is first used." +msgstr "" +"Fonction PL/Tcl à appeler une fois quand pltcl est utilisé pour la\n" +"première fois" + +#: pltcl.c:471 +msgid "PL/TclU function to call once when pltclu is first used." +msgstr "" +"Fonction PL/TclU à appeler une fois quand pltcl est utilisé pour la\n" +"première fois" + +#: pltcl.c:636 +#, c-format +msgid "function \"%s\" is in the wrong language" +msgstr "la fonction « %s » est dans le mauvais langage" + +#: pltcl.c:647 +#, c-format +msgid "function \"%s\" must not be SECURITY DEFINER" +msgstr "la fonction « %s » doit être définie en SECURITY DEFINER" + +#. translator: %s is "pltcl.start_proc" or "pltclu.start_proc" +#: pltcl.c:681 +#, c-format +msgid "processing %s parameter" +msgstr "traitement du paramètre %s" + +#: pltcl.c:842 +#, c-format +msgid "set-valued function called in context that cannot accept a set" +msgstr "" +"la fonction avec set-value a été appelé dans un contexte qui n'accepte pas\n" +"un ensemble" + +#: pltcl.c:1015 +#, c-format +msgid "" +"function returning record called in context that cannot accept type record" +msgstr "" +"fonction renvoyant le type record appelée dans un contexte qui ne peut pas\n" +"accepter le type record" + +#: pltcl.c:1299 +#, c-format +msgid "could not split return value from trigger: %s" +msgstr "n'a pas pu séparer la valeur de retour du trigger : %s" + +#: pltcl.c:1379 pltcl.c:1809 +#, c-format +msgid "%s" +msgstr "%s" + +#: pltcl.c:1380 +#, c-format +msgid "" +"%s\n" +"in PL/Tcl function \"%s\"" +msgstr "" +"%s\n" +"dans la fonction PL/Tcl « %s »" + +#: pltcl.c:1544 +#, c-format +msgid "trigger functions can only be called as triggers" +msgstr "les fonctions trigger peuvent seulement être appelées par des triggers" + +#: pltcl.c:1548 +#, c-format +msgid "PL/Tcl functions cannot return type %s" +msgstr "les fonctions PL/Tcl ne peuvent pas renvoyer le type %s" + +#: pltcl.c:1587 +#, c-format +msgid "PL/Tcl functions cannot accept type %s" +msgstr "les fonctions PL/Tcl ne peuvent pas accepter le type %s" + +#: pltcl.c:1701 +#, c-format +msgid "could not create internal procedure \"%s\": %s" +msgstr "n'a pas pu créer la procédure interne « %s » : %s" + +#: pltcl.c:3208 +#, c-format +msgid "column name/value list must have even number of elements" +msgstr "la liste de nom de colonne/valeur doit avoir un nombre pair d'éléments" + +#: pltcl.c:3226 +#, c-format +msgid "column name/value list contains nonexistent column name \"%s\"" +msgstr "" +"la liste de nom de colonne/valeur contient des noms de colonne inexistantes " +"(« %s »)" + +#: pltcl.c:3233 +#, c-format +msgid "cannot set system attribute \"%s\"" +msgstr "ne peut pas initialiser l'attribut système « %s »" + +#: pltcl.c:3239 +#, c-format +msgid "cannot set generated column \"%s\"" +msgstr "ne peut pas initialiser la colonne générée « %s »" + +#~ msgid "module \"unknown\" not found in pltcl_modules" +#~ msgstr "module « unkown » introuvable dans pltcl_modules" + +#~ msgid "could not load module \"unknown\": %s" +#~ msgstr "n'a pas pu charger le module « unknown » : %s" + +#~ msgid "trigger's return list must have even number of elements" +#~ msgstr "la liste de retour du trigger doit avoir un nombre pair d'éléments" + +#~ msgid "unrecognized attribute \"%s\"" +#~ msgstr "attribut « %s » non reconnu" + +#~ msgid "out of memory" +#~ msgstr "mémoire épuisée" + +#~ msgid "PL/Tcl functions cannot return composite types" +#~ msgstr "les fonctions PL/Tcl ne peuvent pas renvoyer des types composites" diff --git a/src/pl/tcl/po/it.po b/src/pl/tcl/po/it.po new file mode 100644 index 0000000..0aa100f --- /dev/null +++ b/src/pl/tcl/po/it.po @@ -0,0 +1,117 @@ +# +# pltcl.po +# Italian message translation file for pltcl +# +# For development and bug report please use: +# https://github.com/dvarrazzo/postgresql-it +# +# Copyright (C) 2012-2017 PostgreSQL Global Development Group +# Copyright (C) 2010, Associazione Culturale ITPUG +# +# Daniele Varrazzo <daniele.varrazzo@gmail.com>, 2012-2017. +# Flavio Spada <f.spada@sbv.mi.it> +# +# This file is distributed under the same license as the PostgreSQL package. +# +msgid "" +msgstr "" +"Project-Id-Version: pltcl (PostgreSQL) 10\n" +"Report-Msgid-Bugs-To: pgsql-bugs@postgresql.org\n" +"POT-Creation-Date: 2017-05-22 07:37+0000\n" +"PO-Revision-Date: 2017-05-29 17:51+0100\n" +"Last-Translator: Daniele Varrazzo <daniele.varrazzo@gmail.com>\n" +"Language-Team: https://github.com/dvarrazzo/postgresql-it\n" +"Language: it\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"Plural-Forms: nplurals=2; plural=n != 1;\n" +"X-Generator: Poedit 1.8.7.1\n" + +#: pltcl.c:459 +msgid "PL/Tcl function to call once when pltcl is first used." +msgstr "Funzione PL/Tcl da richiamare una volta quando pltcl è usato la prima volta." + +#: pltcl.c:466 +msgid "PL/TclU function to call once when pltclu is first used." +msgstr "Funzione PL/TclU da richiamare una volta quando pltcl è usato la prima volta." + +#: pltcl.c:629 +#, c-format +msgid "function \"%s\" is in the wrong language" +msgstr "la funzione \"%s\" è nel linguaggio sbagliato" + +#: pltcl.c:640 +#, c-format +msgid "function \"%s\" must not be SECURITY DEFINER" +msgstr "la funzione \"%s\" non può essere SECURITY DEFINER" + +#. translator: %s is "pltcl.start_proc" or "pltclu.start_proc" +#: pltcl.c:674 +#, c-format +msgid "processing %s parameter" +msgstr "esecuzione del parametro %s" + +#: pltcl.c:830 +#, c-format +msgid "set-valued function called in context that cannot accept a set" +msgstr "funzione che restituisce insiemi richiamata in un contesto che non può accettare un insieme" + +#: pltcl.c:994 +#, c-format +msgid "function returning record called in context that cannot accept type record" +msgstr "funzione che restituisce record richiamata in un contesto che non può accettare record" + +#: pltcl.c:1263 +#, c-format +msgid "could not split return value from trigger: %s" +msgstr "divisione del valore di ritorno del trigger fallita: %s" + +#: pltcl.c:1343 pltcl.c:1771 +#, c-format +msgid "%s" +msgstr "%s" + +#: pltcl.c:1344 +#, c-format +msgid "" +"%s\n" +"in PL/Tcl function \"%s\"" +msgstr "" +"%s\n" +"nella funzione PL/Tcl \"%s\"" + +#: pltcl.c:1509 +#, c-format +msgid "trigger functions can only be called as triggers" +msgstr "le funzioni trigger possono essere chiamate esclusivamente da trigger" + +#: pltcl.c:1513 +#, c-format +msgid "PL/Tcl functions cannot return type %s" +msgstr "le funzioni PL/Tcl non possono restituire il tipo %s" + +#: pltcl.c:1549 +#, c-format +msgid "PL/Tcl functions cannot accept type %s" +msgstr "le funzioni PL/Tcl non possono accettare il tipo %s" + +#: pltcl.c:1663 +#, c-format +msgid "could not create internal procedure \"%s\": %s" +msgstr "creazione della procedura interna \"%s\" fallita: %s" + +#: pltcl.c:3100 +#, c-format +msgid "column name/value list must have even number of elements" +msgstr "la lista nome/valore di colonne deve avere un numero di elementi pari" + +#: pltcl.c:3118 +#, c-format +msgid "column name/value list contains nonexistent column name \"%s\"" +msgstr "la lista nome/valore di elementi contiene un nome di colonna inesistente \"%s\"" + +#: pltcl.c:3125 +#, c-format +msgid "cannot set system attribute \"%s\"" +msgstr "non è possibile impostare l'attributo di sistema \"%s\"" diff --git a/src/pl/tcl/po/ja.po b/src/pl/tcl/po/ja.po new file mode 100644 index 0000000..ddae7b4 --- /dev/null +++ b/src/pl/tcl/po/ja.po @@ -0,0 +1,116 @@ +# Japanese message translation file for pltcl +# Copyright (C) 2019 PostgreSQL Global Development Group +# This file is distributed under the same license as the pg_archivecleanup (PostgreSQL) package. +# KOIZUMI Satoru <koizumistr@minos.ocn.ne.jp>, 2015. +# +msgid "" +msgstr "" +"Project-Id-Version: pltcl (PostgreSQL 12 beta 1)\n" +"Report-Msgid-Bugs-To: pgsql-bugs@lists.postgresql.org\n" +"POT-Creation-Date: 2019-06-11 11:34+0900\n" +"PO-Revision-Date: 2019-06-11 17:26+0900\n" +"Last-Translator: Kyotaro Horiguchi <horikyota.ntt@gmail.com>\n" +"Language-Team: Japan PostgreSQL Users Group <jpug-doc@ml.postgresql.jp>\n" +"Language: ja\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"Plural-Forms: nplurals=1; plural=0;\n" +"X-Generator: Poedit 1.5.4\n" + +#: pltcl.c:464 +msgid "PL/Tcl function to call once when pltcl is first used." +msgstr "pltcl が最初に使用される際に一度だけ呼び出される PL/Tcl 関数。" + +#: pltcl.c:471 +msgid "PL/TclU function to call once when pltclu is first used." +msgstr "pltclu が最初に使用される際に一度だけ呼び出される PL/TclU 関数。" + +#: pltcl.c:636 +#, c-format +msgid "function \"%s\" is in the wrong language" +msgstr "関数\"%s\"は言語が異なります" + +#: pltcl.c:647 +#, c-format +msgid "function \"%s\" must not be SECURITY DEFINER" +msgstr "関数\"%s\"はSECURITY DEFINERであってはなりません" + +#. translator: %s is "pltcl.start_proc" or "pltclu.start_proc" +#: pltcl.c:681 +#, c-format +msgid "processing %s parameter" +msgstr "%sパラメーターを処理しています" + +#: pltcl.c:842 +#, c-format +msgid "set-valued function called in context that cannot accept a set" +msgstr "このコンテキストでは、集合値の関数は集合を受け付けられません" + +#: pltcl.c:1015 +#, c-format +msgid "" +"function returning record called in context that cannot accept type record" +msgstr "" +"レコード型を受け付けられないコンテキストでレコードを返す関数が呼び出されまし" +"た" + +#: pltcl.c:1299 +#, c-format +msgid "could not split return value from trigger: %s" +msgstr "トリガーからの戻り値を分割できませんでした: %s" + +#: pltcl.c:1379 pltcl.c:1809 +#, c-format +msgid "%s" +msgstr "%s" + +#: pltcl.c:1380 +#, c-format +msgid "" +"%s\n" +"in PL/Tcl function \"%s\"" +msgstr "" +"%s\n" +"PL/Tcl 関数 \"%s\"" + +#: pltcl.c:1544 +#, c-format +msgid "trigger functions can only be called as triggers" +msgstr "トリガー関数はトリガーとしてのみコールできます" + +#: pltcl.c:1548 +#, c-format +msgid "PL/Tcl functions cannot return type %s" +msgstr "PL/Tcl 関数は%s型の戻り値を返せません" + +#: pltcl.c:1587 +#, c-format +msgid "PL/Tcl functions cannot accept type %s" +msgstr "PL/Tcl 関数は%s型を受け付けません" + +#: pltcl.c:1701 +#, c-format +msgid "could not create internal procedure \"%s\": %s" +msgstr "内部プロシージャ\"%s\"を作成できませんでした: %s" + +#: pltcl.c:3208 +#, c-format +msgid "column name/value list must have even number of elements" +msgstr "列名/値のリストの要素は偶数個でなければなりません" + +#: pltcl.c:3226 +#, c-format +msgid "column name/value list contains nonexistent column name \"%s\"" +msgstr "列名/値のリストの中に、存在しない列名\"%s\"が含まれています" + +#: pltcl.c:3233 +#, c-format +msgid "cannot set system attribute \"%s\"" +msgstr "システム属性\"%s\"は設定できません" + +#: pltcl.c:3239 +#, c-format +#| msgid "cannot alter inherited column \"%s\"" +msgid "cannot set generated column \"%s\"" +msgstr "生成列\"%s\"を変更できません" diff --git a/src/pl/tcl/po/ko.po b/src/pl/tcl/po/ko.po new file mode 100644 index 0000000..0673223 --- /dev/null +++ b/src/pl/tcl/po/ko.po @@ -0,0 +1,113 @@ +# LANGUAGE message translation file for pltcl +# Copyright (C) 2016 PostgreSQL Global Development Group +# This file is distributed under the same license as the PostgreSQL package. +# Ioseph Kim <ioseph@uri.sarang.net>, 2016. +# +msgid "" +msgstr "" +"Project-Id-Version: pltcl (PostgreSQL) 12\n" +"Report-Msgid-Bugs-To: pgsql-bugs@lists.postgresql.org\n" +"POT-Creation-Date: 2020-02-09 20:08+0000\n" +"PO-Revision-Date: 2019-11-01 12:52+0900\n" +"Last-Translator: Ioseph Kim <ioseph@uri.sarang.net>\n" +"Language-Team: Korean Team <pgsql-kr@postgresql.kr>\n" +"Language: ko\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"Plural-Forms: nplurals=1; plural=0;\n" + +#: pltcl.c:464 +msgid "PL/Tcl function to call once when pltcl is first used." +msgstr "pltcl 언어가 처음 사용될 때 한번 호출 될 PL/Tcl 함수" + +#: pltcl.c:471 +msgid "PL/TclU function to call once when pltclu is first used." +msgstr "pltclu 언어가 처음 사용될 때 한번 호출 될 PL/Tcl 함수" + +#: pltcl.c:636 +#, c-format +msgid "function \"%s\" is in the wrong language" +msgstr "\"%s\" 함수에 잘못된 언어가 있음" + +#: pltcl.c:647 +#, c-format +msgid "function \"%s\" must not be SECURITY DEFINER" +msgstr "\"%s\" 함수는 SECURITY DEFINER 속성이 없어야 합니다" + +#. translator: %s is "pltcl.start_proc" or "pltclu.start_proc" +#: pltcl.c:681 +#, c-format +msgid "processing %s parameter" +msgstr "%s 매개 변수 처리 중" + +#: pltcl.c:842 +#, c-format +msgid "set-valued function called in context that cannot accept a set" +msgstr "집합이 값이 함수가 집합을 사용할 수 없는 구문에서 호출 되었음" + +#: pltcl.c:1015 +#, c-format +msgid "" +"function returning record called in context that cannot accept type record" +msgstr "" +"레코드를 반환하는 함수가 레코드 형을 사용할 수 없는 구문에서 호출 되었음" + +#: pltcl.c:1299 +#, c-format +msgid "could not split return value from trigger: %s" +msgstr "트리거에서 반환값을 분리할 수 없음: %s" + +#: pltcl.c:1379 pltcl.c:1809 +#, c-format +msgid "%s" +msgstr "%s" + +#: pltcl.c:1380 +#, c-format +msgid "" +"%s\n" +"in PL/Tcl function \"%s\"" +msgstr "" +"%s\n" +"해당 PL/Tcl 함수: \"%s\"" + +#: pltcl.c:1544 +#, c-format +msgid "trigger functions can only be called as triggers" +msgstr "트리거 함수는 트리거로만 호출될 수 있음" + +#: pltcl.c:1548 +#, c-format +msgid "PL/Tcl functions cannot return type %s" +msgstr "PL/Tcl 함수는 %s 자료형을 반환할 수 없음" + +#: pltcl.c:1587 +#, c-format +msgid "PL/Tcl functions cannot accept type %s" +msgstr "PL/Tcl 함수는 %s 자료형을 사용할 수 없음" + +#: pltcl.c:1701 +#, c-format +msgid "could not create internal procedure \"%s\": %s" +msgstr "\"%s\" 내부 프로시져를 만들 수 없음: %s" + +#: pltcl.c:3208 +#, c-format +msgid "column name/value list must have even number of elements" +msgstr "칼럼 이름/값 목록은 그 요소의 개수가 짝수여야 함" + +#: pltcl.c:3226 +#, c-format +msgid "column name/value list contains nonexistent column name \"%s\"" +msgstr "칼럼 이름/값 목록에 \"%s\" 칼럼에 대한 값이 없음" + +#: pltcl.c:3233 +#, c-format +msgid "cannot set system attribute \"%s\"" +msgstr "\"%s\" 시스템 속성을 지정할 수 없음" + +#: pltcl.c:3239 +#, c-format +msgid "cannot set generated column \"%s\"" +msgstr "\"%s\" 계산된 칼럼을 지정할 수 없음" diff --git a/src/pl/tcl/po/pl.po b/src/pl/tcl/po/pl.po new file mode 100644 index 0000000..0a0b2bf --- /dev/null +++ b/src/pl/tcl/po/pl.po @@ -0,0 +1,136 @@ +# pltcl message translation file for pltcl +# Copyright (C) 2011 PostgreSQL Global Development Group +# This file is distributed under the same license as the PostgreSQL package. +# Begina Felicysym <begina.felicysym@wp.eu>, 2011. +# grzegorz <begina.felicysym@wp.eu>, 2015, 2017. +msgid "" +msgstr "" +"Project-Id-Version: pltcl (PostgreSQL 9.5)\n" +"Report-Msgid-Bugs-To: pgsql-bugs@postgresql.org\n" +"POT-Creation-Date: 2017-04-09 21:07+0000\n" +"PO-Revision-Date: 2017-05-02 13:57-0400\n" +"Last-Translator: grzegorz <begina.felicysym@wp.eu>\n" +"Language-Team: begina.felicysym@wp.eu\n" +"Language: pl\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"Plural-Forms: nplurals=3; plural=(n==1 ? 0 : n%10>=2 && n%10<=4 && (n%100<10 " +"|| n%100>=20) ? 1 : 2);\n" +"X-Generator: Virtaal 0.7.1\n" + +#: pltcl.c:459 +#| msgid "Perl initialization code to execute once when plperl is first used." +msgid "PL/Tcl function to call once when pltcl is first used." +msgstr "" +"Funkcja PL/TCL do jednokrotnego wykonania gdy pltcl jest użyty po raz " +"pierwszy." + +#: pltcl.c:466 +#| msgid "Perl initialization code to execute once when plperlu is first used." +msgid "PL/TclU function to call once when pltclu is first used." +msgstr "" +"Funkcja PL/TCL do jednokrotnego wykonania gdy pltclu jest użyty po raz " +"pierwszy." + +#: pltcl.c:629 +#, c-format +#| msgid "function \"%s\" was not called by trigger manager" +msgid "function \"%s\" is in the wrong language" +msgstr "funkcja \"%s\" jest napisana nie w tym języku" + +#: pltcl.c:640 +#, c-format +#| msgid "function \"%s\" must be fired for INSERT" +msgid "function \"%s\" must not be SECURITY DEFINER" +msgstr "funkcja \"%s\" nie może być SECURITY DEFINER" + +#. translator: %s is "pltcl.start_proc" or "pltclu.start_proc" +#: pltcl.c:674 +#, c-format +#| msgid "processing %s\n" +msgid "processing %s parameter" +msgstr "przetwarzanie parametru %s" + +#: pltcl.c:830 +#, c-format +msgid "set-valued function called in context that cannot accept a set" +msgstr "" +"funkcja zwracająca zbiór rekordów wywołana w kontekście, w którym nie jest " +"to dopuszczalne" + +#: pltcl.c:994 +#, c-format +msgid "function returning record called in context that cannot accept type record" +msgstr "funkcja zwracająca rekord w wywołaniu, które nie akceptuje typów złożonych" + +#: pltcl.c:1263 +#, c-format +msgid "could not split return value from trigger: %s" +msgstr "nie można podzielić wartości zwracanej przez wyzwalacz: %s" + +#: pltcl.c:1343 pltcl.c:1771 +#, c-format +msgid "%s" +msgstr "%s" + +#: pltcl.c:1344 +#, c-format +msgid "" +"%s\n" +"in PL/Tcl function \"%s\"" +msgstr "" +"%s\n" +"w funkcji PL/Tcl \"%s\"" + +#: pltcl.c:1509 +#, c-format +msgid "trigger functions can only be called as triggers" +msgstr "procedury wyzwalaczy mogą być wywoływane jedynie przez wyzwalacze" + +#: pltcl.c:1513 +#, c-format +msgid "PL/Tcl functions cannot return type %s" +msgstr "funkcje PL/Tcl nie mogą zwracać wartości typu %s" + +#: pltcl.c:1549 +#, c-format +msgid "PL/Tcl functions cannot accept type %s" +msgstr "funkcje PL/Tcl nie akceptują typu %s" + +#: pltcl.c:1663 +#, c-format +msgid "could not create internal procedure \"%s\": %s" +msgstr "nie można utworzyć procedury wewnętrznej \"%s\": %s" + +#: pltcl.c:3100 +#, c-format +#| msgid "argument list must have even number of elements" +msgid "column name/value list must have even number of elements" +msgstr "lista kolumn nazwa/wartość musi mieć parzystą liczbę elementów" + +#: pltcl.c:3118 +#, c-format +#| msgid "Perl hash contains nonexistent column \"%s\"" +msgid "column name/value list contains nonexistent column name \"%s\"" +msgstr "lista kolumn nazwa/wartość zawiera nieistniejącą kolumnę \"%s\"" + +#: pltcl.c:3125 +#, c-format +msgid "cannot set system attribute \"%s\"" +msgstr "nie można ustawić atrybutu systemowego \"%s\"" + +#~ msgid "PL/Tcl functions cannot return composite types" +#~ msgstr "funkcje PL/Tcl nie mogą zwracać wartości złożonych" + +#~ msgid "out of memory" +#~ msgstr "brak pamięci" + +#~ msgid "unrecognized attribute \"%s\"" +#~ msgstr "nierozpoznany atrybut \"%s\"" + +#~ msgid "could not load module \"unknown\": %s" +#~ msgstr "nie można wczytać modułu \"unknown\": %s" + +#~ msgid "module \"unknown\" not found in pltcl_modules" +#~ msgstr "nie znaleziono modułu \"unknown\" w pltcl_modules" diff --git a/src/pl/tcl/po/pt_BR.po b/src/pl/tcl/po/pt_BR.po new file mode 100644 index 0000000..d0b5f52 --- /dev/null +++ b/src/pl/tcl/po/pt_BR.po @@ -0,0 +1,112 @@ +# Brazilian Portuguese message translation file for pltcl +# +# Copyright (C) 2009-2021 PostgreSQL Global Development Group +# This file is distributed under the same license as the PostgreSQL package. +# +# Euler Taveira <euler@eulerto.com>, 2009-2021. +# +msgid "" +msgstr "" +"Project-Id-Version: PostgreSQL 13\n" +"Report-Msgid-Bugs-To: pgsql-bugs@lists.postgresql.org\n" +"POT-Creation-Date: 2021-05-09 21:44-0300\n" +"PO-Revision-Date: 2009-05-06 18:00-0300\n" +"Last-Translator: Euler Taveira <euler@eulerto.com>\n" +"Language-Team: Brazilian Portuguese <pgsql-translators@postgresql.org>\n" +"Language: pt_BR\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" + +#: pltcl.c:465 +msgid "PL/Tcl function to call once when pltcl is first used." +msgstr "função PL/Tcl executada quando pltcl for utilizado pela primeira vez." + +#: pltcl.c:472 +msgid "PL/TclU function to call once when pltclu is first used." +msgstr "função PL/TclU executada quando pltclu for utilizado pela primeira vez." + +#: pltcl.c:636 +#, c-format +msgid "function \"%s\" is in the wrong language" +msgstr "função \"%s\" está na linguagem incorreta" + +#: pltcl.c:647 +#, c-format +msgid "function \"%s\" must not be SECURITY DEFINER" +msgstr "função \"%s\" não deve ser SECURITY DEFINER" + +#. translator: %s is "pltcl.start_proc" or "pltclu.start_proc" +#: pltcl.c:681 +#, c-format +msgid "processing %s parameter" +msgstr "processando parâmetro %s" + +#: pltcl.c:835 +#, c-format +msgid "set-valued function called in context that cannot accept a set" +msgstr "função que tem argumento do tipo conjunto foi chamada em um contexto que não pode aceitar um conjunto" + +#: pltcl.c:1008 +#, c-format +msgid "function returning record called in context that cannot accept type record" +msgstr "função que retorna record foi chamada em um contexto que não pode aceitar tipo record" + +#: pltcl.c:1292 +#, c-format +msgid "could not split return value from trigger: %s" +msgstr "não pôde dividir valor retornado do gatilho: %s" + +#: pltcl.c:1373 pltcl.c:1803 +#, c-format +msgid "%s" +msgstr "%s" + +#: pltcl.c:1374 +#, c-format +msgid "" +"%s\n" +"in PL/Tcl function \"%s\"" +msgstr "" +"%s\n" +"na função PL/Tcl \"%s\"" + +#: pltcl.c:1538 +#, c-format +msgid "trigger functions can only be called as triggers" +msgstr "funções de gatilho só podem ser chamadas como gatilhos" + +#: pltcl.c:1542 +#, c-format +msgid "PL/Tcl functions cannot return type %s" +msgstr "funções PL/Tcl não podem retornar tipo %s" + +#: pltcl.c:1581 +#, c-format +msgid "PL/Tcl functions cannot accept type %s" +msgstr "funções PL/Tcl não podem aceitar tipo %s" + +#: pltcl.c:1695 +#, c-format +msgid "could not create internal procedure \"%s\": %s" +msgstr "não pôde criar função interna \"%s\": %s" + +#: pltcl.c:3199 +#, c-format +msgid "column name/value list must have even number of elements" +msgstr "lista de nome/valor de colunas deve ter número par de elementos" + +#: pltcl.c:3217 +#, c-format +msgid "column name/value list contains nonexistent column name \"%s\"" +msgstr "lsta de nome/valor de colunas contém nome de coluna inexistente \"%s\"" + +#: pltcl.c:3224 +#, c-format +msgid "cannot set system attribute \"%s\"" +msgstr "não pode definir atributo do sistema \"%s\"" + +#: pltcl.c:3230 +#, c-format +msgid "cannot set generated column \"%s\"" +msgstr "não pode definir coluna gerada \"%s\"" diff --git a/src/pl/tcl/po/ru.po b/src/pl/tcl/po/ru.po new file mode 100644 index 0000000..c866c07 --- /dev/null +++ b/src/pl/tcl/po/ru.po @@ -0,0 +1,130 @@ +# Russian message translation file for pltcl +# Copyright (C) 2012-2016 PostgreSQL Global Development Group +# This file is distributed under the same license as the PostgreSQL package. +# Alexander Lakhin <exclusion@gmail.com>, 2012-2017, 2019. +msgid "" +msgstr "" +"Project-Id-Version: pltcl (PostgreSQL current)\n" +"Report-Msgid-Bugs-To: pgsql-bugs@lists.postgresql.org\n" +"POT-Creation-Date: 2020-09-03 11:22+0300\n" +"PO-Revision-Date: 2019-08-29 15:43+0300\n" +"Last-Translator: Alexander Lakhin <exclusion@gmail.com>\n" +"Language-Team: Russian <pgsql-ru-general@postgresql.org>\n" +"Language: ru\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"Plural-Forms: nplurals=3; plural=(n%10==1 && n%100!=11 ? 0 : n%10>=2 && n" +"%10<=4 && (n%100<10 || n%100>=20) ? 1 : 2);\n" + +#: pltcl.c:465 +msgid "PL/Tcl function to call once when pltcl is first used." +msgstr "Функция на PL/Tcl, вызываемая при первом использовании pltcl." + +#: pltcl.c:472 +msgid "PL/TclU function to call once when pltclu is first used." +msgstr "Функция на PL/TclU, вызываемая при первом использовании pltclu." + +#: pltcl.c:636 +#, c-format +msgid "function \"%s\" is in the wrong language" +msgstr "Функция \"%s\" объявлена на другом языке" + +#: pltcl.c:647 +#, c-format +msgid "function \"%s\" must not be SECURITY DEFINER" +msgstr "функция \"%s\" не должна иметь характеристику SECURITY DEFINER" + +#. translator: %s is "pltcl.start_proc" or "pltclu.start_proc" +#: pltcl.c:681 +#, c-format +msgid "processing %s parameter" +msgstr "обработка параметра %s" + +#: pltcl.c:835 +#, c-format +msgid "set-valued function called in context that cannot accept a set" +msgstr "" +"функция, возвращающая множество, вызвана в контексте, где ему нет места" + +#: pltcl.c:1008 +#, c-format +msgid "" +"function returning record called in context that cannot accept type record" +msgstr "" +"функция, возвращающая запись, вызвана в контексте, не допускающем этот тип" + +#: pltcl.c:1292 +#, c-format +msgid "could not split return value from trigger: %s" +msgstr "разложить возвращаемое из триггера значение не удалось: %s" + +#: pltcl.c:1373 pltcl.c:1803 +#, c-format +msgid "%s" +msgstr "%s" + +#: pltcl.c:1374 +#, c-format +msgid "" +"%s\n" +"in PL/Tcl function \"%s\"" +msgstr "" +"%s\n" +"в функции PL/Tcl \"%s\"" + +#: pltcl.c:1538 +#, c-format +msgid "trigger functions can only be called as triggers" +msgstr "триггерные функции могут вызываться только в триггерах" + +#: pltcl.c:1542 +#, c-format +msgid "PL/Tcl functions cannot return type %s" +msgstr "функции PL/Tcl не могут возвращать тип %s" + +#: pltcl.c:1581 +#, c-format +msgid "PL/Tcl functions cannot accept type %s" +msgstr "функции PL/Tcl не могут принимать тип %s" + +#: pltcl.c:1695 +#, c-format +msgid "could not create internal procedure \"%s\": %s" +msgstr "не удалось создать внутреннюю процедуру \"%s\": %s" + +#: pltcl.c:3199 +#, c-format +msgid "column name/value list must have even number of elements" +msgstr "в списке имён/значений столбцов должно быть чётное число элементов" + +#: pltcl.c:3217 +#, c-format +msgid "column name/value list contains nonexistent column name \"%s\"" +msgstr "" +"список имён/значений столбцов содержит имя несуществующего столбца \"%s\"" + +#: pltcl.c:3224 +#, c-format +msgid "cannot set system attribute \"%s\"" +msgstr "присвоить значение системному атрибуту \"%s\" нельзя" + +#: pltcl.c:3230 +#, c-format +msgid "cannot set generated column \"%s\"" +msgstr "присвоить значение генерируемому столбцу \"%s\" нельзя" + +#~ msgid "module \"unknown\" not found in pltcl_modules" +#~ msgstr "модуль \"unknown\" не найден в pltcl_modules" + +#~ msgid "could not load module \"unknown\": %s" +#~ msgstr "загрузить модуль \"unknown\" не удалось: %s" + +#~ msgid "unrecognized attribute \"%s\"" +#~ msgstr "нераспознанный атрибут \"%s\"" + +#~ msgid "out of memory" +#~ msgstr "нехватка памяти" + +#~ msgid "PL/Tcl functions cannot return composite types" +#~ msgstr "функции PL/Tcl не могут возвращать составные типы" diff --git a/src/pl/tcl/po/sv.po b/src/pl/tcl/po/sv.po new file mode 100644 index 0000000..bacc8e7 --- /dev/null +++ b/src/pl/tcl/po/sv.po @@ -0,0 +1,111 @@ +# Swedish message translation file for pltcl +# Copyright (C) 2017 PostgreSQL Global Development Group +# This file is distributed under the same license as the PostgreSQL package. +# Dennis Björklund <db@zigo.dhs.org>, 2017, 2018, 2019, 2020. +# +msgid "" +msgstr "" +"Project-Id-Version: PostgreSQL 13\n" +"Report-Msgid-Bugs-To: pgsql-bugs@lists.postgresql.org\n" +"POT-Creation-Date: 2020-04-11 01:08+0000\n" +"PO-Revision-Date: 2020-04-11 08:45+0200\n" +"Last-Translator: Dennis Björklund <db@zigo.dhs.org>\n" +"Language-Team: Swedish <pgsql-translators@postgresql.org>\n" +"Language: sv\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"Plural-Forms: nplurals=2; plural=n != 1;\n" + +#: pltcl.c:465 +msgid "PL/Tcl function to call once when pltcl is first used." +msgstr "PL/Tcl-funktion att anropa en gång när pltcl först används." + +#: pltcl.c:472 +msgid "PL/TclU function to call once when pltclu is first used." +msgstr "PL/TclU-funktion att anrop en gång när pltclu först används." + +#: pltcl.c:636 +#, c-format +msgid "function \"%s\" is in the wrong language" +msgstr "funktionen \"%s\" är skriven i fel språk" + +#: pltcl.c:647 +#, c-format +msgid "function \"%s\" must not be SECURITY DEFINER" +msgstr "funktionen \"%s\" får ej vara SECURITY DEFINER" + +#. translator: %s is "pltcl.start_proc" or "pltclu.start_proc" +#: pltcl.c:681 +#, c-format +msgid "processing %s parameter" +msgstr "processar parameter %s" + +#: pltcl.c:832 +#, c-format +msgid "set-valued function called in context that cannot accept a set" +msgstr "en funktion som returnerar en mängd anropades i kontext som inte godtar en mängd" + +#: pltcl.c:1005 +#, c-format +msgid "function returning record called in context that cannot accept type record" +msgstr "en funktion med post som värde anropades i sammanhang där poster inte kan godtagas." + +#: pltcl.c:1289 +#, c-format +msgid "could not split return value from trigger: %s" +msgstr "kunde inte dela på returvärde och utlösare: %s" + +#: pltcl.c:1370 pltcl.c:1800 +#, c-format +msgid "%s" +msgstr "%s" + +#: pltcl.c:1371 +#, c-format +msgid "" +"%s\n" +"in PL/Tcl function \"%s\"" +msgstr "" +"%s\n" +"i PL/Tcl-funktion \"%s\"" + +#: pltcl.c:1535 +#, c-format +msgid "trigger functions can only be called as triggers" +msgstr "Triggningsfunktioner kan bara anropas vid triggning." + +#: pltcl.c:1539 +#, c-format +msgid "PL/Tcl functions cannot return type %s" +msgstr "PL/Tcl-funktioner kan inte returnera typ %s" + +#: pltcl.c:1578 +#, c-format +msgid "PL/Tcl functions cannot accept type %s" +msgstr "PL/Tcl-funktioner kan inte ta emot typ %s" + +#: pltcl.c:1692 +#, c-format +msgid "could not create internal procedure \"%s\": %s" +msgstr "kunde inte skapa en intern procedur \"%s\": %s" + +#: pltcl.c:3197 +#, c-format +msgid "column name/value list must have even number of elements" +msgstr "kolumn-namn/-värde måste ha ett jämt antal element" + +#: pltcl.c:3215 +#, c-format +msgid "column name/value list contains nonexistent column name \"%s\"" +msgstr "listan med kolumn-namn/-värde innehåller det icke existerande kolumnnamnet \"%s\"" + +#: pltcl.c:3222 +#, c-format +msgid "cannot set system attribute \"%s\"" +msgstr "kan inte sätta systemattribut \"%s\"" + +#: pltcl.c:3228 +#, c-format +msgid "cannot set generated column \"%s\"" +msgstr "kan inte sätta genererad kolumn \"%s\"" diff --git a/src/pl/tcl/po/tr.po b/src/pl/tcl/po/tr.po new file mode 100644 index 0000000..ee51dfd --- /dev/null +++ b/src/pl/tcl/po/tr.po @@ -0,0 +1,117 @@ +# LANGUAGE message translation file for pltcl +# Copyright (C) 2009 PostgreSQL Global Development Group +# This file is distributed under the same license as the PostgreSQL package. +# FIRST AUTHOR <EMAIL@ADDRESS>, 2009. +# +msgid "" +msgstr "" +"Project-Id-Version: PostgreSQL 8.4\n" +"Report-Msgid-Bugs-To: pgsql-bugs@lists.postgresql.org\n" +"POT-Creation-Date: 2019-04-26 13:38+0000\n" +"PO-Revision-Date: 2019-06-13 17:11+0300\n" +"Last-Translator: Devrim GÜNDÜZ <devrim@commandprompt.com>\n" +"Language-Team: TR <devrim@commandprompt.com>\n" +"Language: tr\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Generator: Poedit 1.8.7.1\n" + +#: pltcl.c:464 +msgid "PL/Tcl function to call once when pltcl is first used." +msgstr "pltcl ilk sefer kullanıldığında bir kez çağrılacak PL/Tcl fonksiyonu" + +#: pltcl.c:471 +msgid "PL/TclU function to call once when pltclu is first used." +msgstr "pltclu ilk sefer kullanıldığında bir kez çağrılacak PL/Tclu fonksiyonu" + +#: pltcl.c:636 +#, c-format +msgid "function \"%s\" is in the wrong language" +msgstr "\"%s\" fonksiyonu yanlış dilde" + +#: pltcl.c:647 +#, c-format +msgid "function \"%s\" must not be SECURITY DEFINER" +msgstr "\"%s\" fonksiyonu SECURITY DEFINER olmamalı" + +#. translator: %s is "pltcl.start_proc" or "pltclu.start_proc" +#: pltcl.c:681 +#, c-format +msgid "processing %s parameter" +msgstr "%s parametresi işleniyor" + +#: pltcl.c:842 +#, c-format +msgid "set-valued function called in context that cannot accept a set" +msgstr "set değerini kabul etmediği ortamda set değeri alan fonksiyon çağırılmış" + +#: pltcl.c:1015 +#, c-format +msgid "function returning record called in context that cannot accept type record" +msgstr "tip kaydı içermeyen alanda çağırılan ve kayıt döndüren fonksiyon" + +#: pltcl.c:1299 +#, c-format +msgid "could not split return value from trigger: %s" +msgstr "sdönüş değeri tetikleyiciden (trigger) ayrılamadı: %s" + +#: pltcl.c:1379 pltcl.c:1809 +#, c-format +msgid "%s" +msgstr "%s" + +#: pltcl.c:1380 +#, c-format +msgid "" +"%s\n" +"in PL/Tcl function \"%s\"" +msgstr "" +"%s\n" +"Şu PL/Tcl fonksiyonunda: \"%s\"" + +#: pltcl.c:1544 +#, c-format +msgid "trigger functions can only be called as triggers" +msgstr "trigger fonksiyonları sadece trigger olarak çağırılabilirler" + +#: pltcl.c:1548 +#, c-format +msgid "PL/Tcl functions cannot return type %s" +msgstr "PL/Tcl fonksiyonları %s tipini döndüremezler" + +#: pltcl.c:1587 +#, c-format +msgid "PL/Tcl functions cannot accept type %s" +msgstr "PL/Tcl fonksiyonları %s veri tipini kabul etmezler" + +#: pltcl.c:1701 +#, c-format +msgid "could not create internal procedure \"%s\": %s" +msgstr "\"%s\" dahili yordamı oluşturulamadı: %s" + +#: pltcl.c:3208 +#, c-format +msgid "column name/value list must have even number of elements" +msgstr "sütun adı/değer listesinin çift sayıda öğesi olmalı" + +#: pltcl.c:3226 +#, c-format +msgid "column name/value list contains nonexistent column name \"%s\"" +msgstr "sütun adı/değer listesi mevcut olmayan \"%s\" sütun adını içeriyor" + +#: pltcl.c:3233 +#, c-format +msgid "cannot set system attribute \"%s\"" +msgstr "\"%s\" sistem niteliği ayarlanamaz" + +#: pltcl.c:3239 +#, c-format +msgid "cannot set generated column \"%s\"" +msgstr "oluşturulan \"%s\" sütunu ayarlanamıyor" + +#~ msgid "out of memory" +#~ msgstr "yetersiz bellek" + +#~ msgid "PL/Tcl functions cannot return composite types" +#~ msgstr "PL/Tcl fonksiyonları composit tip döndüremezler" diff --git a/src/pl/tcl/po/uk.po b/src/pl/tcl/po/uk.po new file mode 100644 index 0000000..bea5631 --- /dev/null +++ b/src/pl/tcl/po/uk.po @@ -0,0 +1,110 @@ +msgid "" +msgstr "" +"Project-Id-Version: postgresql\n" +"Report-Msgid-Bugs-To: pgsql-bugs@lists.postgresql.org\n" +"POT-Creation-Date: 2020-09-21 21:08+0000\n" +"PO-Revision-Date: 2020-09-22 13:43\n" +"Last-Translator: \n" +"Language-Team: Ukrainian\n" +"Language: uk_UA\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"Plural-Forms: nplurals=4; plural=((n%10==1 && n%100!=11) ? 0 : ((n%10 >= 2 && n%10 <=4 && (n%100 < 12 || n%100 > 14)) ? 1 : ((n%10 == 0 || (n%10 >= 5 && n%10 <=9)) || (n%100 >= 11 && n%100 <= 14)) ? 2 : 3));\n" +"X-Crowdin-Project: postgresql\n" +"X-Crowdin-Project-ID: 324573\n" +"X-Crowdin-Language: uk\n" +"X-Crowdin-File: /DEV_13/pltcl.pot\n" +"X-Crowdin-File-ID: 522\n" + +#: pltcl.c:465 +msgid "PL/Tcl function to call once when pltcl is first used." +msgstr "Функція PL/Tcl використовується для виклику коли pltcl вперше використаний." + +#: pltcl.c:472 +msgid "PL/TclU function to call once when pltclu is first used." +msgstr "Функція PL/TclU використовується для виклику коли pltclu вперше використаний." + +#: pltcl.c:636 +#, c-format +msgid "function \"%s\" is in the wrong language" +msgstr "функція «%s» написана неправильною мовою" + +#: pltcl.c:647 +#, c-format +msgid "function \"%s\" must not be SECURITY DEFINER" +msgstr "функція \"%s\" не має бути SECURITY DEFINER" + +#. translator: %s is "pltcl.start_proc" or "pltclu.start_proc" +#: pltcl.c:681 +#, c-format +msgid "processing %s parameter" +msgstr "обробляється параметр %s" + +#: pltcl.c:835 +#, c-format +msgid "set-valued function called in context that cannot accept a set" +msgstr "функція \"set-valued\" викликана в контексті, де йому немає місця" + +#: pltcl.c:1008 +#, c-format +msgid "function returning record called in context that cannot accept type record" +msgstr "функція, що повертає набір, викликана у контексті, що не приймає тип запис" + +#: pltcl.c:1292 +#, c-format +msgid "could not split return value from trigger: %s" +msgstr "не вдалося розділити повернене значення з тригера: %s" + +#: pltcl.c:1373 pltcl.c:1803 +#, c-format +msgid "%s" +msgstr "%s" + +#: pltcl.c:1374 +#, c-format +msgid "%s\n" +"in PL/Tcl function \"%s\"" +msgstr "%s\n" +"у функції PL/Tcl \"%s\"" + +#: pltcl.c:1538 +#, c-format +msgid "trigger functions can only be called as triggers" +msgstr "тригер-функція може викликатися лише як тригер" + +#: pltcl.c:1542 +#, c-format +msgid "PL/Tcl functions cannot return type %s" +msgstr "Функції PL/Tcl не можуть повертати тип %s" + +#: pltcl.c:1581 +#, c-format +msgid "PL/Tcl functions cannot accept type %s" +msgstr "Функції PL/Tcl не можуть приймати тип %s" + +#: pltcl.c:1695 +#, c-format +msgid "could not create internal procedure \"%s\": %s" +msgstr "не вдалося створити внутрішню процедуру \"%s\": %s" + +#: pltcl.c:3199 +#, c-format +msgid "column name/value list must have even number of elements" +msgstr "список імен і значень стовпців повинен мати парну кількість елементів" + +#: pltcl.c:3217 +#, c-format +msgid "column name/value list contains nonexistent column name \"%s\"" +msgstr "список імен і значень стовпців містить неіснуєче ім'я стовпця \"%s\"" + +#: pltcl.c:3224 +#, c-format +msgid "cannot set system attribute \"%s\"" +msgstr "не вдалося встановити системний атрибут \"%s\"" + +#: pltcl.c:3230 +#, c-format +msgid "cannot set generated column \"%s\"" +msgstr "неможливо оновити згенерований стовпець \"%s\"" + diff --git a/src/pl/tcl/po/vi.po b/src/pl/tcl/po/vi.po new file mode 100644 index 0000000..7224bf1 --- /dev/null +++ b/src/pl/tcl/po/vi.po @@ -0,0 +1,107 @@ +# LANGUAGE message translation file for pltcl +# Copyright (C) 2018 PostgreSQL Global Development Group +# This file is distributed under the same license as the pltcl (PostgreSQL) package. +# FIRST AUTHOR <kakalot49@gmail.com>, 2018. +# +msgid "" +msgstr "" +"Project-Id-Version: pltcl (PostgreSQL) 11\n" +"Report-Msgid-Bugs-To: pgsql-bugs@postgresql.org\n" +"POT-Creation-Date: 2018-04-22 12:08+0000\n" +"PO-Revision-Date: 2018-04-29 22:56+0900\n" +"Language-Team: <pgvn_translators@postgresql.vn>\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Generator: Poedit 2.0.6\n" +"Last-Translator: Dang Minh Huong <kakalot49@gmail.com>\n" +"Plural-Forms: nplurals=1; plural=0;\n" +"Language: vi_VN\n" + +#: pltcl.c:466 +msgid "PL/Tcl function to call once when pltcl is first used." +msgstr "Chỉ định hàm PL/Tcl được gọi một lần khi pltcl sử dụng lần đầu tiên." + +#: pltcl.c:473 +msgid "PL/TclU function to call once when pltclu is first used." +msgstr "Chỉ định hàm PL/TclU được gọi một lần khi pltclu sử dụng lần đầu tiên." + +#: pltcl.c:640 +#, c-format +msgid "function \"%s\" is in the wrong language" +msgstr "hàm \"%s\" không đúng ngôn ngữ" + +#: pltcl.c:651 +#, c-format +msgid "function \"%s\" must not be SECURITY DEFINER" +msgstr "hàm \"%s\" không được là SECURITY DEFINER" + +#. translator: %s is "pltcl.start_proc" or "pltclu.start_proc" +#: pltcl.c:685 +#, c-format +msgid "processing %s parameter" +msgstr "xử lý tham số %s" + +#: pltcl.c:846 +#, c-format +msgid "set-valued function called in context that cannot accept a set" +msgstr "hàm thiết lập giá trị được gọi trong ngữ cảnh không thể chấp nhận một tập hợp" + +#: pltcl.c:1019 +#, c-format +msgid "function returning record called in context that cannot accept type record" +msgstr "hàm trả về bản ghi được gọi trong ngữ cảnh không thể chấp nhận kiểu bản ghi" + +#: pltcl.c:1296 +#, c-format +msgid "could not split return value from trigger: %s" +msgstr "không thể tách giá trị trả về khỏi trigger: %s" + +#: pltcl.c:1376 pltcl.c:1806 +#, c-format +msgid "%s" +msgstr "%s" + +#: pltcl.c:1377 +#, c-format +msgid "" +"%s\n" +"in PL/Tcl function \"%s\"" +msgstr "" +"%s\n" +"trong hàm PL/Tcl \"%s\"" + +#: pltcl.c:1541 +#, c-format +msgid "trigger functions can only be called as triggers" +msgstr "hàm trigger chỉ có thể được goi như những triggers." + +#: pltcl.c:1545 +#, c-format +msgid "PL/Tcl functions cannot return type %s" +msgstr "Hàm PL/Tcl không thể trả về kiểu %s" + +#: pltcl.c:1584 +#, c-format +msgid "PL/Tcl functions cannot accept type %s" +msgstr "Hàm PL/Tcl không thể chấp nhận kiểu %s" + +#: pltcl.c:1698 +#, c-format +msgid "could not create internal procedure \"%s\": %s" +msgstr "không thể tạo procedure nội bộ \"%s\": %s" + +#: pltcl.c:3219 +#, c-format +msgid "column name/value list must have even number of elements" +msgstr "danh sách cột tên/giá trị phải có giá trị chẵn cho số phần tử" + +#: pltcl.c:3237 +#, c-format +msgid "column name/value list contains nonexistent column name \"%s\"" +msgstr "danh sách cột tên/giá trị chứa tên cột không tồn tại \"%s\"" + +#: pltcl.c:3244 +#, c-format +msgid "cannot set system attribute \"%s\"" +msgstr "không thể thiết lập attribute hệ thống \"%s\"" diff --git a/src/pl/tcl/po/zh_CN.po b/src/pl/tcl/po/zh_CN.po new file mode 100644 index 0000000..be25e83 --- /dev/null +++ b/src/pl/tcl/po/zh_CN.po @@ -0,0 +1,111 @@ +# LANGUAGE message translation file for pltcl +# Copyright (C) 2019 PostgreSQL Global Development Group +# This file is distributed under the same license as the pltcl (PostgreSQL) package. +# FIRST AUTHOR <EMAIL@ADDRESS>, 2019. +# +msgid "" +msgstr "" +"Project-Id-Version: pltcl (PostgreSQL) 12\n" +"Report-Msgid-Bugs-To: pgsql-bugs@lists.postgresql.org\n" +"POT-Creation-Date: 2019-05-22 17:56+0800\n" +"PO-Revision-Date: 2019-06-04 18:00+0800\n" +"Last-Translator: Jie Zhang <zhangjie2@cn.fujitsu.com>\n" +"Language-Team: Chinese (Simplified) <zhangjie2@cn.fujitsu.com>\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"Language: zh_CN\n" +"X-Generator: Poedit 1.5.7\n" + +#: pltcl.c:464 +msgid "PL/Tcl function to call once when pltcl is first used." +msgstr "PL/Tcl函数在首次使用pltcl时调用一次." + +#: pltcl.c:471 +msgid "PL/TclU function to call once when pltclu is first used." +msgstr "PL/TclU函数在首次使用pltcl时调用一次." + +#: pltcl.c:636 +#, c-format +msgid "function \"%s\" is in the wrong language" +msgstr "函数\"%s\"的语言错误" + +#: pltcl.c:647 +#, c-format +msgid "function \"%s\" must not be SECURITY DEFINER" +msgstr "函数\"%s\"不能是安全定义者" + +#. translator: %s is "pltcl.start_proc" or "pltclu.start_proc" +#: pltcl.c:681 +#, c-format +msgid "processing %s parameter" +msgstr "正在处理%s参数" + +#: pltcl.c:842 +#, c-format +msgid "set-valued function called in context that cannot accept a set" +msgstr "在不能接受使用集合的环境中调用set-valued函数" + +#: pltcl.c:1015 +#, c-format +msgid "function returning record called in context that cannot accept type record" +msgstr "返回值类型是记录的函数在不接受使用记录类型的环境中调用" + +#: pltcl.c:1299 +#, c-format +msgid "could not split return value from trigger: %s" +msgstr "无法分离来自触发器的返回值：%s" + +#: pltcl.c:1379 pltcl.c:1809 +#, c-format +msgid "%s" +msgstr "%s" + +#: pltcl.c:1380 +#, c-format +msgid "" +"%s\n" +"in PL/Tcl function \"%s\"" +msgstr "" +"%s\n" +"在PL/Tcl函数\"%s\"中" + +#: pltcl.c:1544 +#, c-format +msgid "trigger functions can only be called as triggers" +msgstr "触发器函数只能以触发器的形式调用" + +#: pltcl.c:1548 +#, c-format +msgid "PL/Tcl functions cannot return type %s" +msgstr "PL/Tcl函数不能返回类型%s" + +#: pltcl.c:1587 +#, c-format +msgid "PL/Tcl functions cannot accept type %s" +msgstr "PL/Tcl函数不能使用类型 %s" + +#: pltcl.c:1701 +#, c-format +msgid "could not create internal procedure \"%s\": %s" +msgstr "无法创建内部过程\"%s\"：%s" + +#: pltcl.c:3208 +#, c-format +msgid "column name/value list must have even number of elements" +msgstr "列名/值列表必须具有偶数个元素" + +#: pltcl.c:3226 +#, c-format +msgid "column name/value list contains nonexistent column name \"%s\"" +msgstr "列名/值列表包含不存在的列名\"%s\"" + +#: pltcl.c:3233 +#, c-format +msgid "cannot set system attribute \"%s\"" +msgstr "不能设置系统属性\"%s\"" + +#: pltcl.c:3239 +#, c-format +msgid "cannot set generated column \"%s\"" +msgstr "无法设置生成的列 \"%s\"" diff --git a/src/pl/tcl/sql/pltcl_call.sql b/src/pl/tcl/sql/pltcl_call.sql new file mode 100644 index 0000000..95791d0 --- /dev/null +++ b/src/pl/tcl/sql/pltcl_call.sql @@ -0,0 +1,59 @@ +CREATE PROCEDURE test_proc1() +LANGUAGE pltcl +AS $$ +unset +$$; + +CALL test_proc1(); + + +CREATE PROCEDURE test_proc2() +LANGUAGE pltcl +AS $$ +return 5 +$$; + +CALL test_proc2(); + + +CREATE TABLE test1 (a int); + +CREATE PROCEDURE test_proc3(x int) +LANGUAGE pltcl +AS $$ +spi_exec "INSERT INTO test1 VALUES ($1)" +$$; + +CALL test_proc3(55); + +SELECT * FROM test1; + + +-- output arguments + +CREATE PROCEDURE test_proc5(INOUT a text) +LANGUAGE pltcl +AS $$ +set aa [concat $1 "+" $1] +return [list a $aa] +$$; + +CALL test_proc5('abc'); + + +CREATE PROCEDURE test_proc6(a int, INOUT b int, INOUT c int) +LANGUAGE pltcl +AS $$ +set bb [expr $2 * $1] +set cc [expr $3 * $1] +return [list b $bb c $cc] +$$; + +CALL test_proc6(2, 3, 4); + + +DROP PROCEDURE test_proc1; +DROP PROCEDURE test_proc2; +DROP PROCEDURE test_proc3; + +DROP TABLE test1; diff --git a/src/pl/tcl/sql/pltcl_queries.sql b/src/pl/tcl/sql/pltcl_queries.sql new file mode 100644 index 0000000..bbd2d97 --- /dev/null +++ b/src/pl/tcl/sql/pltcl_queries.sql @@ -0,0 +1,166 @@ +-- suppress CONTEXT so that function OIDs aren't in output +\set VERBOSITY terse + +-- Test composite-type arguments +select tcl_composite_arg_ref1(row('tkey', 42, 'ref2')); +select tcl_composite_arg_ref2(row('tkey', 42, 'ref2')); + +-- More tests for composite argument/result types + +create domain d_comp1 as T_comp1 check ((value).ref1 > 0); + +create function tcl_record_arg(record, fldname text) returns int as ' + return $1($2) +' language pltcl; + +select tcl_record_arg(row('tkey', 42, 'ref2')::T_comp1, 'ref1'); +select tcl_record_arg(row('tkey', 42, 'ref2')::d_comp1, 'ref1'); +select tcl_record_arg(row(2,4), 'f2'); + +create function tcl_cdomain_arg(d_comp1) returns int as ' + return $1(ref1) +' language pltcl; + +select tcl_cdomain_arg(row('tkey', 42, 'ref2')); +select tcl_cdomain_arg(row('tkey', 42, 'ref2')::T_comp1); +select tcl_cdomain_arg(row('tkey', -1, 'ref2')); -- fail + +-- Test argisnull primitive +select tcl_argisnull('foo'); +select tcl_argisnull(''); +select tcl_argisnull(null); + +-- test some error cases +create function tcl_error(out a int, out b int) as $$return {$$ language pltcl; +select tcl_error(); + +create function bad_record(out a text, out b text) as $$return [list a]$$ language pltcl; +select bad_record(); + +create function bad_field(out a text, out b text) as $$return [list a 1 b 2 cow 3]$$ language pltcl; +select bad_field(); + +-- test compound return +select * from tcl_test_cube_squared(5); + +-- test SRF +select * from tcl_test_squared_rows(0,5); + +select * from tcl_test_sequence(0,5) as a; + +select 1, tcl_test_sequence(0,5); + +create function non_srf() returns int as $$return_next 1$$ language pltcl; +select non_srf(); + +create function bad_record_srf(out a text, out b text) returns setof record as $$ +return_next [list a] +$$ language pltcl; +select bad_record_srf(); + +create function bad_field_srf(out a text, out b text) returns setof record as $$ +return_next [list a 1 b 2 cow 3] +$$ language pltcl; +select bad_field_srf(); + +-- test composite and domain-over-composite results +create function tcl_composite_result(int) returns T_comp1 as $$ +return [list tkey tkey1 ref1 $1 ref2 ref22] +$$ language pltcl; +select tcl_composite_result(1001); +select * from tcl_composite_result(1002); + +create function tcl_dcomposite_result(int) returns d_comp1 as $$ +return [list tkey tkey2 ref1 $1 ref2 ref42] +$$ language pltcl; +select tcl_dcomposite_result(1001); +select * from tcl_dcomposite_result(1002); +select * from tcl_dcomposite_result(-1); -- fail + +create function tcl_record_result(int) returns record as $$ +return [list q1 sometext q2 $1 q3 moretext] +$$ language pltcl; +select tcl_record_result(42); -- fail +select * from tcl_record_result(42); -- fail +select * from tcl_record_result(42) as (q1 text, q2 int, q3 text); +select * from tcl_record_result(42) as (q1 text, q2 int, q3 text, q4 int); +select * from tcl_record_result(42) as (q1 text, q2 int, q4 int); -- fail + +-- test quote +select tcl_eval('quote foo bar'); +select tcl_eval('quote [format %c 39]'); +select tcl_eval('quote [format %c 92]'); + +-- Test argisnull +select tcl_eval('argisnull'); +select tcl_eval('argisnull 14'); +select tcl_eval('argisnull abc'); + +-- Test return_null +select tcl_eval('return_null 14'); + +-- Test spi_exec +select tcl_eval('spi_exec'); +select tcl_eval('spi_exec -count'); +select tcl_eval('spi_exec -array'); +select tcl_eval('spi_exec -count abc'); +select tcl_eval('spi_exec query loop body toomuch'); +select tcl_eval('spi_exec "begin; rollback;"'); + +-- Test spi_execp +select tcl_eval('spi_execp'); +select tcl_eval('spi_execp -count'); +select tcl_eval('spi_execp -array'); +select tcl_eval('spi_execp -count abc'); +select tcl_eval('spi_execp -nulls'); +select tcl_eval('spi_execp ""'); + +-- test spi_prepare +select tcl_eval('spi_prepare'); +select tcl_eval('spi_prepare a b'); +select tcl_eval('spi_prepare a "b {"'); +select tcl_error_handling_test($tcl$spi_prepare "select moo" []$tcl$); + +-- test full error text +select tcl_error_handling_test($tcl$ +spi_exec "DO $$ +BEGIN +RAISE 'my message' + USING HINT = 'my hint' + , DETAIL = 'my detail' + , SCHEMA = 'my schema' + , TABLE = 'my table' + , COLUMN = 'my column' + , CONSTRAINT = 'my constraint' + , DATATYPE = 'my datatype' +; +END$$;" +$tcl$); + +-- verify tcl_error_handling_test() properly reports non-postgres errors +select tcl_error_handling_test('moo'); + +-- test elog +select tcl_eval('elog'); +select tcl_eval('elog foo bar'); + +-- test forced error +select tcl_eval('error "forced error"'); + +-- test loop control in spi_exec[p] +select tcl_spi_exec(true, 'break'); +select tcl_spi_exec(true, 'continue'); +select tcl_spi_exec(true, 'error'); +select tcl_spi_exec(true, 'return'); +select tcl_spi_exec(false, 'break'); +select tcl_spi_exec(false, 'continue'); +select tcl_spi_exec(false, 'error'); +select tcl_spi_exec(false, 'return'); + +-- forcibly run the Tcl event loop for awhile, to check that we have not +-- messed things up too badly by disabling the Tcl notifier subsystem +select tcl_eval($$ + unset -nocomplain ::tcl_vwait + after 100 {set ::tcl_vwait 1} + vwait ::tcl_vwait + unset -nocomplain ::tcl_vwait$$); diff --git a/src/pl/tcl/sql/pltcl_setup.sql b/src/pl/tcl/sql/pltcl_setup.sql new file mode 100644 index 0000000..e9f5998 --- /dev/null +++ b/src/pl/tcl/sql/pltcl_setup.sql @@ -0,0 +1,278 @@ +create table T_comp1 ( + tkey char(10), + ref1 int4, + ref2 char(20) +); + +create function tcl_composite_arg_ref1(T_comp1) returns int as ' + return $1(ref1) +' language pltcl; + +create function tcl_composite_arg_ref2(T_comp1) returns text as ' + return $1(ref2) +' language pltcl; + +create function tcl_argisnull(text) returns bool as ' + argisnull 1 +' language pltcl; + + +create function tcl_int4add(int4,int4) returns int4 as ' + return [expr $1 + $2] +' language pltcl; + +-- We use split(n) as a quick-and-dirty way of parsing the input array +-- value, which comes in as a string like '{1,2}'. There are better ways... + +create function tcl_int4_accum(int4[], int4) returns int4[] as ' + set state [split $1 "{,}"] + set newsum [expr {[lindex $state 1] + $2}] + set newcnt [expr {[lindex $state 2] + 1}] + return "{$newsum,$newcnt}" +' language pltcl; + +create function tcl_int4_avg(int4[]) returns int4 as ' + set state [split $1 "{,}"] + if {[lindex $state 2] == 0} { return_null } + return [expr {[lindex $state 1] / [lindex $state 2]}] +' language pltcl; + +create aggregate tcl_avg ( + sfunc = tcl_int4_accum, + basetype = int4, + stype = int4[], + finalfunc = tcl_int4_avg, + initcond = '{0,0}' + ); + +create aggregate tcl_sum ( + sfunc = tcl_int4add, + basetype = int4, + stype = int4, + initcond1 = 0 + ); + +create function tcl_int4lt(int4,int4) returns bool as ' + if {$1 < $2} { + return t + } + return f +' language pltcl; + +create function tcl_int4le(int4,int4) returns bool as ' + if {$1 <= $2} { + return t + } + return f +' language pltcl; + +create function tcl_int4eq(int4,int4) returns bool as ' + if {$1 == $2} { + return t + } + return f +' language pltcl; + +create function tcl_int4ge(int4,int4) returns bool as ' + if {$1 >= $2} { + return t + } + return f +' language pltcl; + +create function tcl_int4gt(int4,int4) returns bool as ' + if {$1 > $2} { + return t + } + return f +' language pltcl; + +create operator @< ( + leftarg = int4, + rightarg = int4, + procedure = tcl_int4lt + ); + +create operator @<= ( + leftarg = int4, + rightarg = int4, + procedure = tcl_int4le + ); + +create operator @= ( + leftarg = int4, + rightarg = int4, + procedure = tcl_int4eq + ); + +create operator @>= ( + leftarg = int4, + rightarg = int4, + procedure = tcl_int4ge + ); + +create operator @> ( + leftarg = int4, + rightarg = int4, + procedure = tcl_int4gt + ); + +create function tcl_int4cmp(int4,int4) returns int4 as ' + if {$1 < $2} { + return -1 + } + if {$1 > $2} { + return 1 + } + return 0 +' language pltcl; + +CREATE OPERATOR CLASS tcl_int4_ops + FOR TYPE int4 USING btree AS + OPERATOR 1 @<, + OPERATOR 2 @<=, + OPERATOR 3 @=, + OPERATOR 4 @>=, + OPERATOR 5 @>, + FUNCTION 1 tcl_int4cmp(int4,int4) ; + +-- +-- Test usage of Tcl's "clock" command. In recent Tcl versions this +-- command fails without working "unknown" support, so it's a good canary +-- for initialization problems. +-- +create function tcl_date_week(int4,int4,int4) returns text as $$ + return [clock format [clock scan "$2/$3/$1"] -format "%U"] +$$ language pltcl immutable; + +select tcl_date_week(2010,1,26); +select tcl_date_week(2001,10,24); + +-- test pltcl event triggers +create function tclsnitch() returns event_trigger language pltcl as $$ + elog NOTICE "tclsnitch: $TG_event $TG_tag" +$$; + +create event trigger tcl_a_snitch on ddl_command_start execute procedure tclsnitch(); +create event trigger tcl_b_snitch on ddl_command_end execute procedure tclsnitch(); + +create function foobar() returns int language sql as $$select 1;$$; +alter function foobar() cost 77; +drop function foobar(); + +create table foo(); +drop table foo; + +drop event trigger tcl_a_snitch; +drop event trigger tcl_b_snitch; + +create function tcl_test_cube_squared(in int, out squared int, out cubed int) as $$ + return [list squared [expr {$1 * $1}] cubed [expr {$1 * $1 * $1}]] +$$ language pltcl; + +create function tcl_test_squared_rows(int,int) returns table (x int, y int) as $$ + for {set i $1} {$i < $2} {incr i} { + return_next [list y [expr {$i * $i}] x $i] + } +$$ language pltcl; + +create function tcl_test_sequence(int,int) returns setof int as $$ + for {set i $1} {$i < $2} {incr i} { + return_next $i + } +$$ language pltcl; + +create function tcl_eval(string text) returns text as $$ + eval $1 +$$ language pltcl; + +-- test use of errorCode in error handling +create function tcl_error_handling_test(text) returns text +language pltcl +as $function$ + if {[catch $1 err]} { + # If not a Postgres error, just return the basic error message + if {[lindex $::errorCode 0] != "POSTGRES"} { + return $err + } + + # Get rid of keys that can't be expected to remain constant + array set myArray $::errorCode + unset myArray(POSTGRES) + unset -nocomplain myArray(funcname) + unset -nocomplain myArray(filename) + unset -nocomplain myArray(lineno) + + # Format into something nicer + set vals [] + foreach {key} [lsort [array names myArray]] { + set value [string map {"\n" "\n\t"} $myArray($key)] + lappend vals "$key: $value" + } + return [join $vals "\n"] + } else { + return "no error" + } +$function$; + +-- test spi_exec and spi_execp with -array +create function tcl_spi_exec( + prepare boolean, + action text +) +returns void language pltcl AS $function$ +set query "select * from (values (1,'foo'),(2,'bar'),(3,'baz')) v(col1,col2)" +if {$1 == "t"} { + set prep [spi_prepare $query {}] + spi_execp -array A $prep { + elog NOTICE "col1 $A(col1), col2 $A(col2)" + + switch $A(col1) { + 2 { + elog NOTICE "action: $2" + switch $2 { + break { + break + } + continue { + continue + } + return { + return + } + error { + error "error message" + } + } + error "should not get here" + } + } + } +} else { + spi_exec -array A $query { + elog NOTICE "col1 $A(col1), col2 $A(col2)" + + switch $A(col1) { + 2 { + elog NOTICE "action: $2" + switch $2 { + break { + break + } + continue { + continue + } + return { + return + } + error { + error "error message" + } + } + error "should not get here" + } + } + } +} +elog NOTICE "end of function" +$function$; diff --git a/src/pl/tcl/sql/pltcl_start_proc.sql b/src/pl/tcl/sql/pltcl_start_proc.sql new file mode 100644 index 0000000..7a8e68e --- /dev/null +++ b/src/pl/tcl/sql/pltcl_start_proc.sql @@ -0,0 +1,21 @@ +-- +-- Test start_proc execution +-- + +SET pltcl.start_proc = 'no_such_function'; + +select tcl_int4add(1, 2); +select tcl_int4add(1, 2); + +create function tcl_initialize() returns void as +$$ elog NOTICE "in tcl_initialize" $$ language pltcl SECURITY DEFINER; + +SET pltcl.start_proc = 'public.tcl_initialize'; + +select tcl_int4add(1, 2); -- fail + +create or replace function tcl_initialize() returns void as +$$ elog NOTICE "in tcl_initialize" $$ language pltcl; + +select tcl_int4add(1, 2); +select tcl_int4add(1, 2); diff --git a/src/pl/tcl/sql/pltcl_subxact.sql b/src/pl/tcl/sql/pltcl_subxact.sql new file mode 100644 index 0000000..0625736 --- /dev/null +++ b/src/pl/tcl/sql/pltcl_subxact.sql @@ -0,0 +1,95 @@ +-- +-- Test explicit subtransactions +-- + +CREATE TABLE subtransaction_tbl ( + i integer +); + +-- +-- We use this wrapper to catch errors and return errormsg only, +-- because values of $::errorinfo variable contain procedure name which +-- includes OID, so it's not stable +-- +CREATE FUNCTION pltcl_wrapper(statement text) RETURNS text +AS $$ + if [catch {spi_exec $1} msg] { + return "ERROR: $msg" + } else { + return "SUCCESS: $msg" + } +$$ LANGUAGE pltcl; + +-- Test subtransaction successfully committed + +CREATE FUNCTION subtransaction_ctx_success() RETURNS void +AS $$ + spi_exec "INSERT INTO subtransaction_tbl VALUES(1)" + subtransaction { + spi_exec "INSERT INTO subtransaction_tbl VALUES(2)" + } +$$ LANGUAGE pltcl; + +BEGIN; +INSERT INTO subtransaction_tbl VALUES(0); +SELECT subtransaction_ctx_success(); +COMMIT; +SELECT * FROM subtransaction_tbl; +TRUNCATE subtransaction_tbl; + +-- Test subtransaction rollback + +CREATE FUNCTION subtransaction_ctx_test(what_error text = NULL) RETURNS void +AS $$ + spi_exec "INSERT INTO subtransaction_tbl VALUES (1)" + subtransaction { + spi_exec "INSERT INTO subtransaction_tbl VALUES (2)" + if {$1 == "SPI"} { + spi_exec "INSERT INTO subtransaction_tbl VALUES ('oops')" + } elseif { $1 == "Tcl"} { + elog ERROR "Tcl error" + } + } +$$ LANGUAGE pltcl; + +SELECT pltcl_wrapper('SELECT subtransaction_ctx_test()'); +SELECT * FROM subtransaction_tbl; +TRUNCATE subtransaction_tbl; + +SELECT pltcl_wrapper('SELECT subtransaction_ctx_test(''SPI'')'); +SELECT * FROM subtransaction_tbl; +TRUNCATE subtransaction_tbl; + +SELECT pltcl_wrapper('SELECT subtransaction_ctx_test(''Tcl'')'); +SELECT * FROM subtransaction_tbl; +TRUNCATE subtransaction_tbl; + +-- Nested subtransactions + +CREATE FUNCTION subtransaction_nested_test(swallow boolean = 'f') RETURNS text +AS $$ +spi_exec "INSERT INTO subtransaction_tbl VALUES (1)" +subtransaction { + spi_exec "INSERT INTO subtransaction_tbl VALUES (2)" + if [catch { + subtransaction { + spi_exec "INSERT INTO subtransaction_tbl VALUES (3)" + spi_exec "error" + } + } errormsg] { + if {$1 != "t"} { + error $errormsg $::errorInfo $::errorCode + } + elog NOTICE "Swallowed $errormsg" + } +} +return "ok" +$$ LANGUAGE pltcl; + +SELECT pltcl_wrapper('SELECT subtransaction_nested_test()'); +SELECT * FROM subtransaction_tbl; +TRUNCATE subtransaction_tbl; + +SELECT pltcl_wrapper('SELECT subtransaction_nested_test(''t'')'); +SELECT * FROM subtransaction_tbl; +TRUNCATE subtransaction_tbl; diff --git a/src/pl/tcl/sql/pltcl_transaction.sql b/src/pl/tcl/sql/pltcl_transaction.sql new file mode 100644 index 0000000..c752faf --- /dev/null +++ b/src/pl/tcl/sql/pltcl_transaction.sql @@ -0,0 +1,98 @@ +-- suppress CONTEXT so that function OIDs aren't in output +\set VERBOSITY terse + +CREATE TABLE test1 (a int, b text); + + +CREATE PROCEDURE transaction_test1() +LANGUAGE pltcl +AS $$ +for {set i 0} {$i < 10} {incr i} { + spi_exec "INSERT INTO test1 (a) VALUES ($i)" + if {$i % 2 == 0} { + commit + } else { + rollback + } +} +$$; + +CALL transaction_test1(); + +SELECT * FROM test1; + + +TRUNCATE test1; + +-- not allowed in a function +CREATE FUNCTION transaction_test2() RETURNS int +LANGUAGE pltcl +AS $$ +for {set i 0} {$i < 10} {incr i} { + spi_exec "INSERT INTO test1 (a) VALUES ($i)" + if {$i % 2 == 0} { + commit + } else { + rollback + } +} +return 1 +$$; + +SELECT transaction_test2(); + +SELECT * FROM test1; + + +-- also not allowed if procedure is called from a function +CREATE FUNCTION transaction_test3() RETURNS int +LANGUAGE pltcl +AS $$ +spi_exec "CALL transaction_test1()" +return 1 +$$; + +SELECT transaction_test3(); + +SELECT * FROM test1; + + +-- commit inside cursor loop +CREATE TABLE test2 (x int); +INSERT INTO test2 VALUES (0), (1), (2), (3), (4); + +TRUNCATE test1; + +CREATE PROCEDURE transaction_test4a() +LANGUAGE pltcl +AS $$ +spi_exec -array row "SELECT * FROM test2 ORDER BY x" { + spi_exec "INSERT INTO test1 (a) VALUES ($row(x))" + commit +} +$$; + +CALL transaction_test4a(); + +SELECT * FROM test1; + + +-- rollback inside cursor loop +TRUNCATE test1; + +CREATE PROCEDURE transaction_test4b() +LANGUAGE pltcl +AS $$ +spi_exec -array row "SELECT * FROM test2 ORDER BY x" { + spi_exec "INSERT INTO test1 (a) VALUES ($row(x))" + rollback +} +$$; + +CALL transaction_test4b(); + +SELECT * FROM test1; + + +DROP TABLE test1; +DROP TABLE test2; diff --git a/src/pl/tcl/sql/pltcl_trigger.sql b/src/pl/tcl/sql/pltcl_trigger.sql new file mode 100644 index 0000000..2db75a3 --- /dev/null +++ b/src/pl/tcl/sql/pltcl_trigger.sql @@ -0,0 +1,603 @@ +-- suppress CONTEXT so that function OIDs aren't in output +\set VERBOSITY terse + +-- +-- Create the tables used in the test queries +-- +-- T_pkey1 is the primary key table for T_dta1. Entries from T_pkey1 +-- Cannot be changed or deleted if they are referenced from T_dta1. +-- +-- T_pkey2 is the primary key table for T_dta2. If the key values in +-- T_pkey2 are changed, the references in T_dta2 follow. If entries +-- are deleted, the referencing entries from T_dta2 are deleted too. +-- The values for field key2 in T_pkey2 are silently converted to +-- upper case on insert/update. +-- +create table T_pkey1 ( + key1 int4, + key2 char(20), + txt char(40) +); + +create table T_pkey2 ( + key1 int4, + key2 char(20), + txt char(40) +); + +create table T_dta1 ( + tkey char(10), + ref1 int4, + ref2 char(20) +); + +create table T_dta2 ( + tkey char(10), + ref1 int4, + ref2 char(20) +); + + +-- +-- Function to check key existence in T_pkey1 +-- +create function check_pkey1_exists(int4, bpchar) returns bool as E' + if {![info exists GD]} { + set GD(plan) [spi_prepare \\ + "select 1 from T_pkey1 \\ + where key1 = \\$1 and key2 = \\$2" \\ + {int4 bpchar}] + } + + set n [spi_execp -count 1 $GD(plan) [list $1 $2]] + + if {$n > 0} { + return "t" + } + return "f" +' language pltcl; + + +-- dump trigger data + +CREATE TABLE trigger_test ( + i int, + v text, + dropme text, + test_skip boolean DEFAULT false, + test_return_null boolean DEFAULT false, + test_argisnull boolean DEFAULT false +); +-- Make certain dropped attributes are handled correctly +ALTER TABLE trigger_test DROP dropme; + +CREATE TABLE trigger_test_generated ( + i int, + j int GENERATED ALWAYS AS (i * 2) STORED +); + +CREATE VIEW trigger_test_view AS SELECT i, v FROM trigger_test; + +CREATE FUNCTION trigger_data() returns trigger language pltcl as $_$ + if {$TG_table_name eq "trigger_test" && $TG_level eq "ROW" && $TG_op ne "DELETE"} { + # Special case tests + if {$NEW(test_return_null) eq "t" } { + return_null + } + if {$NEW(test_argisnull) eq "t" } { + set should_error [argisnull 1] + } + if {$NEW(test_skip) eq "t" } { + elog NOTICE "SKIPPING OPERATION $TG_op" + return SKIP + } + } + + if { [info exists TG_relid] } { + set TG_relid "bogus:12345" + } + + set dnames [info locals {[a-zA-Z]*} ] + + foreach key [lsort $dnames] { + + if { [array exists $key] } { + set str "{" + foreach akey [lsort [ array names $key ] ] { + if {[string length $str] > 1} { set str "$str, " } + set cmd "($akey)" + set cmd "set val \$$key$cmd" + eval $cmd + set str "$str$akey: $val" + } + set str "$str}" + elog NOTICE "$key: $str" + } else { + set val [eval list "\$$key" ] + elog NOTICE "$key: $val" + } + } + + + return OK + +$_$; + +CREATE TRIGGER show_trigger_data_trig +BEFORE INSERT OR UPDATE OR DELETE ON trigger_test +FOR EACH ROW EXECUTE PROCEDURE trigger_data(23,'skidoo'); +CREATE TRIGGER statement_trigger +BEFORE INSERT OR UPDATE OR DELETE OR TRUNCATE ON trigger_test +FOR EACH STATEMENT EXECUTE PROCEDURE trigger_data(42,'statement trigger'); + +CREATE TRIGGER show_trigger_data_trig_before +BEFORE INSERT OR UPDATE OR DELETE ON trigger_test_generated +FOR EACH ROW EXECUTE PROCEDURE trigger_data(); +CREATE TRIGGER show_trigger_data_trig_after +AFTER INSERT OR UPDATE OR DELETE ON trigger_test_generated +FOR EACH ROW EXECUTE PROCEDURE trigger_data(); + +CREATE TRIGGER show_trigger_data_view_trig +INSTEAD OF INSERT OR UPDATE OR DELETE ON trigger_test_view +FOR EACH ROW EXECUTE PROCEDURE trigger_data(24,'skidoo view'); + +-- +-- Trigger function on every change to T_pkey1 +-- +create function trig_pkey1_before() returns trigger as E' + # + # Create prepared plans on the first call + # + if {![info exists GD]} { + # + # Plan to check for duplicate key in T_pkey1 + # + set GD(plan_pkey1) [spi_prepare \\ + "select check_pkey1_exists(\\$1, \\$2) as ret" \\ + {int4 bpchar}] + # + # Plan to check for references from T_dta1 + # + set GD(plan_dta1) [spi_prepare \\ + "select 1 from T_dta1 \\ + where ref1 = \\$1 and ref2 = \\$2" \\ + {int4 bpchar}] + } + + # + # Initialize flags + # + set check_old_ref 0 + set check_new_dup 0 + + switch $TG_op { + INSERT { + # + # Must check for duplicate key on INSERT + # + set check_new_dup 1 + } + UPDATE { + # + # Must check for duplicate key on UPDATE only if + # the key changes. In that case we must check for + # references to OLD values too. + # + if {[string compare $NEW(key1) $OLD(key1)] != 0} { + set check_old_ref 1 + set check_new_dup 1 + } + if {[string compare $NEW(key2) $OLD(key2)] != 0} { + set check_old_ref 1 + set check_new_dup 1 + } + } + DELETE { + # + # Must only check for references to OLD on DELETE + # + set check_old_ref 1 + } + } + + if {$check_new_dup} { + # + # Check for duplicate key + # + spi_execp -count 1 $GD(plan_pkey1) [list $NEW(key1) $NEW(key2)] + if {$ret == "t"} { + elog ERROR \\ + "duplicate key ''$NEW(key1)'', ''$NEW(key2)'' for T_pkey1" + } + } + + if {$check_old_ref} { + # + # Check for references to OLD + # + set n [spi_execp -count 1 $GD(plan_dta1) [list $OLD(key1) $OLD(key2)]] + if {$n > 0} { + elog ERROR \\ + "key ''$OLD(key1)'', ''$OLD(key2)'' referenced by T_dta1" + } + } + + # + # Anything is fine - let operation pass through + # + return OK +' language pltcl; + + +create trigger pkey1_before before insert or update or delete on T_pkey1 + for each row execute procedure + trig_pkey1_before(); + + +-- +-- Trigger function to check for duplicate keys in T_pkey2 +-- and to force key2 to be upper case only without leading whitespaces +-- +create function trig_pkey2_before() returns trigger as E' + # + # Prepare plan on first call + # + if {![info exists GD]} { + set GD(plan_pkey2) [spi_prepare \\ + "select 1 from T_pkey2 \\ + where key1 = \\$1 and key2 = \\$2" \\ + {int4 bpchar}] + } + + # + # Convert key2 value + # + set NEW(key2) [string toupper [string trim $NEW(key2)]] + + # + # Check for duplicate key + # + set n [spi_execp -count 1 $GD(plan_pkey2) [list $NEW(key1) $NEW(key2)]] + if {$n > 0} { + elog ERROR \\ + "duplicate key ''$NEW(key1)'', ''$NEW(key2)'' for T_pkey2" + } + + # + # Return modified tuple in NEW + # + return [array get NEW] +' language pltcl; + + +create trigger pkey2_before before insert or update on T_pkey2 + for each row execute procedure + trig_pkey2_before(); + + +-- +-- Trigger function to force references from T_dta2 follow changes +-- in T_pkey2 or be deleted too. This must be done AFTER the changes +-- in T_pkey2 are done so the trigger for primkey check on T_dta2 +-- fired on our updates will see the new key values in T_pkey2. +-- +create function trig_pkey2_after() returns trigger as E' + # + # Prepare plans on first call + # + if {![info exists GD]} { + # + # Plan to update references from T_dta2 + # + set GD(plan_dta2_upd) [spi_prepare \\ + "update T_dta2 set ref1 = \\$3, ref2 = \\$4 \\ + where ref1 = \\$1 and ref2 = \\$2" \\ + {int4 bpchar int4 bpchar}] + # + # Plan to delete references from T_dta2 + # + set GD(plan_dta2_del) [spi_prepare \\ + "delete from T_dta2 \\ + where ref1 = \\$1 and ref2 = \\$2" \\ + {int4 bpchar}] + } + + # + # Initialize flags + # + set old_ref_follow 0 + set old_ref_delete 0 + + switch $TG_op { + UPDATE { + # + # On update we must let old references follow + # + set NEW(key2) [string toupper $NEW(key2)] + + if {[string compare $NEW(key1) $OLD(key1)] != 0} { + set old_ref_follow 1 + } + if {[string compare $NEW(key2) $OLD(key2)] != 0} { + set old_ref_follow 1 + } + } + DELETE { + # + # On delete we must delete references too + # + set old_ref_delete 1 + } + } + + if {$old_ref_follow} { + # + # Let old references follow and fire NOTICE message if + # there where some + # + set n [spi_execp $GD(plan_dta2_upd) \\ + [list $OLD(key1) $OLD(key2) $NEW(key1) $NEW(key2)]] + if {$n > 0} { + elog NOTICE \\ + "updated $n entries in T_dta2 for new key in T_pkey2" + } + } + + if {$old_ref_delete} { + # + # delete references and fire NOTICE message if + # there where some + # + set n [spi_execp $GD(plan_dta2_del) \\ + [list $OLD(key1) $OLD(key2)]] + if {$n > 0} { + elog NOTICE \\ + "deleted $n entries from T_dta2" + } + } + + return OK +' language pltcl; + + +create trigger pkey2_after after update or delete on T_pkey2 + for each row execute procedure + trig_pkey2_after(); + + +-- +-- Generic trigger function to check references in T_dta1 and T_dta2 +-- +create function check_primkey() returns trigger as E' + # + # For every trigger/relation pair we create + # a saved plan and hold them in GD + # + set plankey [list "plan" $TG_name $TG_relid] + set planrel [list "relname" $TG_relid] + + # + # Extract the pkey relation name + # + set keyidx [expr [llength $args] / 2] + set keyrel [string tolower [lindex $args $keyidx]] + + if {![info exists GD($plankey)]} { + # + # We must prepare a new plan. Build up a query string + # for the primary key check. + # + set keylist [lrange $args [expr $keyidx + 1] end] + + set query "select 1 from $keyrel" + set qual " where" + set typlist "" + set idx 1 + foreach key $keylist { + set key [string tolower $key] + # + # Add the qual part to the query string + # + append query "$qual $key = \\$$idx" + set qual " and" + + # + # Lookup the fields type in pg_attribute + # + set n [spi_exec "select T.typname \\ + from pg_catalog.pg_type T, pg_catalog.pg_attribute A, pg_catalog.pg_class C \\ + where C.relname = ''[quote $keyrel]'' \\ + and C.oid = A.attrelid \\ + and A.attname = ''[quote $key]'' \\ + and A.atttypid = T.oid"] + if {$n != 1} { + elog ERROR "table $keyrel doesn''t have a field named $key" + } + + # + # Append the fields type to the argument type list + # + lappend typlist $typname + incr idx + } + + # + # Prepare the plan + # + set GD($plankey) [spi_prepare $query $typlist] + + # + # Lookup and remember the table name for later error messages + # + spi_exec "select relname from pg_catalog.pg_class \\ + where oid = ''$TG_relid''::oid" + set GD($planrel) $relname + } + + # + # Build the argument list from the NEW row + # + incr keyidx -1 + set arglist "" + foreach arg [lrange $args 0 $keyidx] { + lappend arglist $NEW($arg) + } + + # + # Check for the primary key + # + set n [spi_execp -count 1 $GD($plankey) $arglist] + if {$n <= 0} { + elog ERROR "key for $GD($planrel) not in $keyrel" + } + + # + # Anything is fine + # + return OK +' language pltcl; + + +create trigger dta1_before before insert or update on T_dta1 + for each row execute procedure + check_primkey('ref1', 'ref2', 'T_pkey1', 'key1', 'key2'); + + +create trigger dta2_before before insert or update on T_dta2 + for each row execute procedure + check_primkey('ref1', 'ref2', 'T_pkey2', 'key1', 'key2'); + + +insert into T_pkey1 values (1, 'key1-1', 'test key'); +insert into T_pkey1 values (1, 'key1-2', 'test key'); +insert into T_pkey1 values (1, 'key1-3', 'test key'); +insert into T_pkey1 values (2, 'key2-1', 'test key'); +insert into T_pkey1 values (2, 'key2-2', 'test key'); +insert into T_pkey1 values (2, 'key2-3', 'test key'); + +insert into T_pkey2 values (1, 'key1-1', 'test key'); +insert into T_pkey2 values (1, 'key1-2', 'test key'); +insert into T_pkey2 values (1, 'key1-3', 'test key'); +insert into T_pkey2 values (2, 'key2-1', 'test key'); +insert into T_pkey2 values (2, 'key2-2', 'test key'); +insert into T_pkey2 values (2, 'key2-3', 'test key'); + +select * from T_pkey1; + +-- key2 in T_pkey2 should have upper case only +select * from T_pkey2; + +insert into T_pkey1 values (1, 'KEY1-3', 'should work'); + +-- Due to the upper case translation in trigger this must fail +insert into T_pkey2 values (1, 'KEY1-3', 'should fail'); + +insert into T_dta1 values ('trec 1', 1, 'key1-1'); +insert into T_dta1 values ('trec 2', 1, 'key1-2'); +insert into T_dta1 values ('trec 3', 1, 'key1-3'); + +-- Must fail due to unknown key in T_pkey1 +insert into T_dta1 values ('trec 4', 1, 'key1-4'); + +insert into T_dta2 values ('trec 1', 1, 'KEY1-1'); +insert into T_dta2 values ('trec 2', 1, 'KEY1-2'); +insert into T_dta2 values ('trec 3', 1, 'KEY1-3'); + +-- Must fail due to unknown key in T_pkey2 +insert into T_dta2 values ('trec 4', 1, 'KEY1-4'); + +select * from T_dta1; + +select * from T_dta2; + +update T_pkey1 set key2 = 'key2-9' where key1 = 2 and key2 = 'key2-1'; +update T_pkey1 set key2 = 'key1-9' where key1 = 1 and key2 = 'key1-1'; +delete from T_pkey1 where key1 = 2 and key2 = 'key2-2'; +delete from T_pkey1 where key1 = 1 and key2 = 'key1-2'; + +update T_pkey2 set key2 = 'KEY2-9' where key1 = 2 and key2 = 'KEY2-1'; +update T_pkey2 set key2 = 'KEY1-9' where key1 = 1 and key2 = 'KEY1-1'; +delete from T_pkey2 where key1 = 2 and key2 = 'KEY2-2'; +delete from T_pkey2 where key1 = 1 and key2 = 'KEY1-2'; + +select * from T_pkey1; +select * from T_pkey2; +select * from T_dta1; +select * from T_dta2; + +select tcl_avg(key1) from T_pkey1; +select tcl_sum(key1) from T_pkey1; +select tcl_avg(key1) from T_pkey2; +select tcl_sum(key1) from T_pkey2; + +-- The following should return NULL instead of 0 +select tcl_avg(key1) from T_pkey1 where key1 = 99; +select tcl_sum(key1) from T_pkey1 where key1 = 99; + +select 1 @< 2; +select 100 @< 4; + +select * from T_pkey1 order by key1 using @<, key2 collate "C"; +select * from T_pkey2 order by key1 using @<, key2 collate "C"; + +-- show dump of trigger data +insert into trigger_test values(1,'insert'); + +insert into trigger_test_generated (i) values (1); +update trigger_test_generated set i = 11 where i = 1; +delete from trigger_test_generated; + +insert into trigger_test_view values(2,'insert'); +update trigger_test_view set v = 'update' where i=1; +delete from trigger_test_view; + +update trigger_test set v = 'update', test_skip=true where i = 1; +update trigger_test set v = 'update' where i = 1; +delete from trigger_test; +truncate trigger_test; + +DROP TRIGGER show_trigger_data_trig_before ON trigger_test_generated; +DROP TRIGGER show_trigger_data_trig_after ON trigger_test_generated; + +-- should error +insert into trigger_test(test_argisnull) values(true); + +-- should error +insert into trigger_test(test_return_null) values(true); + +-- test transition table visibility +create table transition_table_test (id int, name text); +insert into transition_table_test values (1, 'a'); +create function transition_table_test_f() returns trigger language pltcl as +$$ + spi_exec -array C "SELECT id, name FROM old_table" { + elog INFO "old: $C(id) -> $C(name)" + } + spi_exec -array C "SELECT id, name FROM new_table" { + elog INFO "new: $C(id) -> $C(name)" + } + return OK +$$; +CREATE TRIGGER a_t AFTER UPDATE ON transition_table_test + REFERENCING OLD TABLE AS old_table NEW TABLE AS new_table + FOR EACH STATEMENT EXECUTE PROCEDURE transition_table_test_f(); +update transition_table_test set name = 'b'; +drop table transition_table_test; +drop function transition_table_test_f(); + +-- dealing with generated columns + +CREATE FUNCTION generated_test_func1() RETURNS trigger +LANGUAGE pltcl +AS $$ +# not allowed +set NEW(j) 5 +return [array get NEW] +$$; + +CREATE TRIGGER generated_test_trigger1 BEFORE INSERT ON trigger_test_generated +FOR EACH ROW EXECUTE PROCEDURE generated_test_func1(); + +TRUNCATE trigger_test_generated; +INSERT INTO trigger_test_generated (i) VALUES (1); +SELECT * FROM trigger_test_generated; diff --git a/src/pl/tcl/sql/pltcl_unicode.sql b/src/pl/tcl/sql/pltcl_unicode.sql new file mode 100644 index 0000000..f000604 --- /dev/null +++ b/src/pl/tcl/sql/pltcl_unicode.sql @@ -0,0 +1,38 @@ +-- +-- Unicode handling +-- +-- Note: this test case is known to fail if the database encoding is +-- EUC_CN, EUC_JP, EUC_KR, or EUC_TW, for lack of any equivalent to +-- U+00A0 (no-break space) in those encodings. However, testing with +-- plain ASCII data would be rather useless, so we must live with that. +-- + +SET client_encoding TO UTF8; + +CREATE TABLE unicode_test ( + testvalue text NOT NULL +); + +CREATE FUNCTION unicode_return() RETURNS text AS $$ + return "\xA0" +$$ LANGUAGE pltcl; + +CREATE FUNCTION unicode_trigger() RETURNS trigger AS $$ + set NEW(testvalue) "\xA0" + return [array get NEW] +$$ LANGUAGE pltcl; + +CREATE TRIGGER unicode_test_bi BEFORE INSERT ON unicode_test + FOR EACH ROW EXECUTE PROCEDURE unicode_trigger(); + +CREATE FUNCTION unicode_plan1() RETURNS text AS $$ + set plan [ spi_prepare {SELECT $1 AS testvalue} [ list "text" ] ] + spi_execp $plan [ list "\xA0" ] + return $testvalue +$$ LANGUAGE pltcl; + + +SELECT unicode_return(); +INSERT INTO unicode_test (testvalue) VALUES ('test'); +SELECT * FROM unicode_test; +SELECT unicode_plan1(); |