Patch to add table function support to PL/Tcl (Todo item)
Started by Karl Lehenbauerabout 15 years ago9 messages
Project name: Add table function support to PL/Tcl (Todo item)
What the patch does:
This patch adds table function support (returning record and SETOF record)
to PL/Tcl. This patch also updates PL/Tcl to use the Tcl object-style
interface instead of the older string-style one, increasing performance.
Status of the patch:
The code seems to work well, but this is its first submission.
Branch the patch is against: HEAD
Compiles and tests successfully on FreeBSD and Mac OS X. Have not tested
it with other systems but there is nothing platform specific about it.
Regression tests: Passes all existing tests but there aren't many for PL/Tcl.
This change removes PL/Tcl backward compatibility to Tcl version 7.
Since Tcl 8 has been in production release since 1997, I felt
that 13 years was long enough and PL/Tcl users linking with Tcl 7 should
go ahead and upgrade. This also allowed removal of the Tcl 7 compatibility
shims.
More importantly, this patch extends PL/Tcl to support returning rows and
sets of rows. While I studied all of the other PL languages (PL/PgSql,
PL/Perl, PL/Python and PL/C) while developing this patch, it hews most
closely to to approach taken by PL/PgSQL.
All existing semantics for functions and triggers have been retained, requiring
no changes to existing PL/Tcl code.
PL/Tcl coders who want to create functions returning a record will use "return"
to return results, the same as for a scalar, except that the value returned
should be a list of key-value pairs ("array get" format) where the keys are
`the field names and the values are the corresponding values.
To return sets of rows, one needs to use the new PL/Tcl function "return_next".
Return_next also accepts a list of key-value pairs, as "return" does.
Typically this will be invoked as something like
return_next [array get row]
To return multiple rows, the function should invoke return_next
multiple times (once for each row returned). As mentioned, the C
implementation works like PL/PgSQL, so PL/Tcl saves up the tuples in a
tuple store and then uses the SFRM_Materialize return mode to send the
results back. Fields are converted to Datum during the call to return_next,
so if any field names are in the list that aren't in the row or there are
data conversion errors, they will be returned as a Tcl error to the caller of
return_next and can be caught using Tcl's "catch", etc.
Attachments:
pltclobj-try-1.patchapplication/octet-stream; name=pltclobj-try-1.patchDownload
diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c
index 6e8c5c0..da5cf27 100644
*** a/src/pl/tcl/pltcl.c
--- b/src/pl/tcl/pltcl.c
***************
*** 33,49 ****
#include "utils/memutils.h"
#include "utils/syscache.h"
#include "utils/typcache.h"
#define HAVE_TCL_VERSION(maj,min) \
((TCL_MAJOR_VERSION > maj) || \
(TCL_MAJOR_VERSION == maj && TCL_MINOR_VERSION >= min))
- /* In Tcl >= 8.0, really not supposed to touch interp->result directly */
- #if !HAVE_TCL_VERSION(8,0)
- #define Tcl_GetStringResult(interp) ((interp)->result)
- #endif
-
/* define our text domain for translations */
#undef TEXTDOMAIN
#define TEXTDOMAIN PG_TEXTDOMAIN("pltcl")
--- 33,45 ----
#include "utils/memutils.h"
#include "utils/syscache.h"
#include "utils/typcache.h"
+ #include "funcapi.h"
#define HAVE_TCL_VERSION(maj,min) \
((TCL_MAJOR_VERSION > maj) || \
(TCL_MAJOR_VERSION == maj && TCL_MINOR_VERSION >= min))
/* define our text domain for translations */
#undef TEXTDOMAIN
#define TEXTDOMAIN PG_TEXTDOMAIN("pltcl")
*************** PG_MODULE_MAGIC;
*** 95,104 ****
**********************************************************************/
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;
/**********************************************************************
--- 91,100 ----
**********************************************************************/
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;
/**********************************************************************
*************** typedef struct pltcl_proc_desc
*** 112,124 ****
ItemPointerData fn_tid;
bool fn_readonly;
bool lanpltrusted;
pltcl_interp_desc *interp_desc;
FmgrInfo result_in_func;
Oid result_typioparam;
int nargs;
FmgrInfo arg_out_func[FUNC_MAX_ARGS];
bool arg_is_rowtype[FUNC_MAX_ARGS];
! } pltcl_proc_desc;
/**********************************************************************
--- 108,130 ----
ItemPointerData fn_tid;
bool fn_readonly;
bool lanpltrusted;
+ bool fn_retistuple; /* true, if function returns tuple */
+ bool fn_retisset; /* true, if function returns a set */
pltcl_interp_desc *interp_desc;
FmgrInfo result_in_func;
Oid result_typioparam;
int nargs;
FmgrInfo arg_out_func[FUNC_MAX_ARGS];
bool arg_is_rowtype[FUNC_MAX_ARGS];
!
! TupleDesc ret_tupdesc;
! Tuplestorestate *tuple_store; /* SRFs accumulate result here */
! AttInMetadata *attinmeta;
! int natts;
! MemoryContext tuple_store_cxt;
! ResourceOwner tuple_store_owner;
! ReturnSetInfo *rsi;
! } pltcl_proc_desc;
/**********************************************************************
*************** typedef struct pltcl_query_desc
*** 132,138 ****
Oid *argtypes;
FmgrInfo *arginfuncs;
Oid *argtypioparams;
! } pltcl_query_desc;
/**********************************************************************
--- 138,144 ----
Oid *argtypes;
FmgrInfo *arginfuncs;
Oid *argtypioparams;
! } pltcl_query_desc;
/**********************************************************************
*************** typedef struct pltcl_query_desc
*** 148,167 ****
**********************************************************************/
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;
/**********************************************************************
--- 154,173 ----
**********************************************************************/
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;
/**********************************************************************
*************** Datum pltcl_call_handler(PG_FUNCTION_AR
*** 183,231 ****
Datum pltclu_call_handler(PG_FUNCTION_ARGS);
void _PG_init(void);
! static void pltcl_init_interp(pltcl_interp_desc *interp_desc, bool pltrusted);
static pltcl_interp_desc *pltcl_fetch_interp(bool pltrusted);
! static void pltcl_init_load_unknown(Tcl_Interp *interp);
! static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted);
! static Datum pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted);
! static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS, 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 pltrusted);
! static int pltcl_elog(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[]);
! static int pltcl_quote(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[]);
! static int pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[]);
! static int pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[]);
! static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[]);
! static int pltcl_process_SPI_result(Tcl_Interp *interp,
CONST84 char *arrayname,
! CONST84 char *loop_body,
int spi_rc,
! SPITupleTable *tuptable,
int ntuples);
! static int pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[]);
! static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[]);
! static int pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[]);
! static void pltcl_set_tuple_values(Tcl_Interp *interp, CONST84 char *arrayname,
int tupno, HeapTuple tuple, TupleDesc tupdesc);
static void pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
! Tcl_DString *retval);
/*
--- 189,243 ----
Datum pltclu_call_handler(PG_FUNCTION_ARGS);
void _PG_init(void);
! static void pltcl_init_interp(pltcl_interp_desc * interp_desc, bool pltrusted);
static pltcl_interp_desc *pltcl_fetch_interp(bool pltrusted);
! static void pltcl_init_load_unknown(Tcl_Interp * interp);
! static Datum pltcl_handler(FunctionCallInfo fcinfo, bool pltrusted);
! static Datum pltcl_func_handler(FunctionCallInfo fcinfo, bool pltrusted);
! static HeapTuple pltcl_trigger_handler(FunctionCallInfo fcinfo, 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 pltrusted);
! static void
! pltcl_pg_returnnext(Tcl_Interp * interp, int rowObjc, Tcl_Obj ** rowObjv);
! static int pltcl_elog(ClientData cdata, Tcl_Interp * interp,
! int objc, Tcl_Obj * const objv[]);
! 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,
CONST84 char *arrayname,
! Tcl_Obj * loop_body,
int spi_rc,
! SPITupleTable * tuptable,
int 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_SPI_lastoid(ClientData cdata, Tcl_Interp * interp,
! int objc, Tcl_Obj * const objv[]);
! static void pltcl_set_tuple_values(Tcl_Interp * interp, CONST84 char *arrayname,
int tupno, HeapTuple tuple, TupleDesc tupdesc);
static void pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
! Tcl_Obj * retobj);
! static void pltcl_init_tuple_store(pltcl_proc_desc * prodesc);
/*
*************** pltcl_FinalizeNotifier(ClientData client
*** 256,262 ****
}
static void
! pltcl_SetTimer(Tcl_Time *timePtr)
{
}
--- 268,274 ----
}
static void
! pltcl_SetTimer(Tcl_Time * timePtr)
{
}
*************** pltcl_AlertNotifier(ClientData clientDat
*** 267,273 ****
static void
pltcl_CreateFileHandler(int fd, int mask,
! Tcl_FileProc *proc, ClientData clientData)
{
}
--- 279,285 ----
static void
pltcl_CreateFileHandler(int fd, int mask,
! Tcl_FileProc * proc, ClientData clientData)
{
}
*************** pltcl_ServiceModeHook(int mode)
*** 282,293 ****
}
static int
! pltcl_WaitForEvent(Tcl_Time *timePtr)
{
return 0;
}
#endif /* HAVE_TCL_VERSION(8,4) */
/*
* This routine is a crock, and so is everyplace that calls it. The problem
--- 294,414 ----
}
static int
! pltcl_WaitForEvent(Tcl_Time * timePtr)
{
return 0;
}
#endif /* HAVE_TCL_VERSION(8,4) */
+ #if 0
+ static Tcl_Obj *
+ tclobj_from_bool(Datum d)
+ {
+ return Tcl_NewBooleanObj(DatumGetBool(d));
+ }
+
+ static Tcl_Obj *
+ tclobj_from_float4(Datum d)
+ {
+ return Tcl_NewDoubleObj(DatumGetFloat4(d));
+ }
+
+ static Tcl_Obj *
+ tclobj_from_float8(Datum d)
+ {
+ return Tcl_NewDoubleObj(DatumGetFloat8(d));
+ }
+
+ static Tcl_Obj *
+ tclobj_from_int16(Datum d)
+ {
+ return Tcl_NewIntObj(DatumGetInt16(d));
+ }
+
+
+ static Tcl_Obj *
+ tclobj_from_int32(Datum d)
+ {
+ return Tcl_NewIntObj(DatumGetInt32(d));
+ }
+
+ static Tcl_Obj *
+ tclobj_from_int64(Datum d)
+ {
+ return Tcl_NewWideIntObj(DatumGetInt64(d));
+ }
+
+ static Tcl_Obj *
+ tclobj_from_bytea(Datum d)
+ {
+ text *txt = DatumGetByteaP(d);
+ char *str = VARDATA(txt);
+ size_t size = VARSIZE(txt) - VARHDRSZ;
+
+ return Tcl_NewByteArrayObj(str, size);
+ }
+ #endif
+
+ static HeapTuple
+ pltcl_build_tuple_result(Tcl_Interp * interp, Tcl_Obj ** kvObjv, int kvObjc, pltcl_proc_desc * prodesc)
+ {
+ HeapTuple tup;
+ char **values;
+ int i;
+
+ values = (char **) palloc0(prodesc->natts * sizeof(char *));
+
+ for (i = 0; i < kvObjc; i += 2)
+ {
+ char *fieldName = Tcl_GetString(kvObjv[i]);
+ int attn = SPI_fnumber(prodesc->ret_tupdesc, fieldName);
+
+ if (attn <= 0 || prodesc->ret_tupdesc->attrs[attn - 1]->attisdropped)
+ ereport(ERROR,
+ (errcode(ERRCODE_UNDEFINED_COLUMN),
+ errmsg("Tcl list contains nonexistent column \"%s\"",
+ fieldName)));
+
+ UTF_BEGIN;
+ values[attn - 1] = UTF_E2U(Tcl_GetString(kvObjv[i + 1]));
+ UTF_END;
+ }
+
+ tup = BuildTupleFromCStrings(prodesc->attinmeta, values);
+ pfree(values);
+ return tup;
+ }
+
+ /**********************************************************************
+ * pltcl_reset_state() - reset function's runtime state
+ *
+ * This is called on function and trigger entry
+ * (pltcl_func_handler and pltcl_trigger_handler) to clear
+ * any previous results.
+ *
+ * rsi is present if it's a function but not if it's a trigger.
+ **********************************************************************/
+ static void
+ pltcl_reset_state(pltcl_proc_desc * prodesc, ReturnSetInfo * rsi)
+ {
+ prodesc->ret_tupdesc = NULL;
+ prodesc->tuple_store = NULL;
+ prodesc->attinmeta = NULL;
+ prodesc->natts = 0;
+
+ if (rsi)
+ {
+ prodesc->tuple_store_cxt = rsi->econtext->ecxt_per_query_memory;
+ prodesc->tuple_store_owner = CurrentResourceOwner;
+ }
+ else
+ {
+ prodesc->tuple_store_cxt = NULL;
+ prodesc->tuple_store_owner = NULL;
+ }
+
+ prodesc->rsi = rsi;
+ }
/*
* This routine is a crock, and so is everyplace that calls it. The problem
*************** _PG_init(void)
*** 390,396 ****
* pltcl_init_interp() - initialize a new Tcl interpreter
**********************************************************************/
static void
! pltcl_init_interp(pltcl_interp_desc *interp_desc, bool pltrusted)
{
Tcl_Interp *interp;
char interpname[32];
--- 511,517 ----
* pltcl_init_interp() - initialize a new Tcl interpreter
**********************************************************************/
static void
! pltcl_init_interp(pltcl_interp_desc * interp_desc, bool pltrusted)
{
Tcl_Interp *interp;
char interpname[32];
*************** pltcl_init_interp(pltcl_interp_desc *int
*** 414,436 ****
/************************************************************
* Install the commands for SPI support in the interpreter
************************************************************/
! Tcl_CreateCommand(interp, "elog",
! pltcl_elog, NULL, NULL);
! Tcl_CreateCommand(interp, "quote",
! pltcl_quote, NULL, NULL);
! Tcl_CreateCommand(interp, "argisnull",
! pltcl_argisnull, NULL, NULL);
! Tcl_CreateCommand(interp, "return_null",
! pltcl_returnnull, NULL, NULL);
! Tcl_CreateCommand(interp, "spi_exec",
! pltcl_SPI_execute, NULL, NULL);
! Tcl_CreateCommand(interp, "spi_prepare",
! pltcl_SPI_prepare, NULL, NULL);
! Tcl_CreateCommand(interp, "spi_execp",
! pltcl_SPI_execute_plan, NULL, NULL);
! Tcl_CreateCommand(interp, "spi_lastoid",
! pltcl_SPI_lastoid, NULL, NULL);
/************************************************************
* Try to load the unknown procedure from pltcl_modules
--- 535,559 ----
/************************************************************
* 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, "spi_lastoid",
! pltcl_SPI_lastoid, NULL, NULL);
/************************************************************
* Try to load the unknown procedure from pltcl_modules
*************** pltcl_fetch_interp(bool pltrusted)
*** 471,477 ****
* table pltcl_modules (if it exists)
**********************************************************************/
static void
! pltcl_init_load_unknown(Tcl_Interp *interp)
{
Relation pmrel;
char *pmrelname,
--- 594,600 ----
* table pltcl_modules (if it exists)
**********************************************************************/
static void
! pltcl_init_load_unknown(Tcl_Interp * interp)
{
Relation pmrel;
char *pmrelname,
*************** pltclu_call_handler(PG_FUNCTION_ARGS)
*** 611,618 ****
}
static Datum
! pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted)
{
Datum retval;
FunctionCallInfo save_fcinfo;
--- 734,745 ----
}
+ /**********************************************************************
+ * pltcl_handler() - Handler for function and trigger calls, for
+ * both trusted and untrusted interpreters.
+ **********************************************************************/
static Datum
! pltcl_handler(FunctionCallInfo fcinfo, bool pltrusted)
{
Datum retval;
FunctionCallInfo save_fcinfo;
*************** pltcl_handler(PG_FUNCTION_ARGS, bool plt
*** 632,642 ****
--- 759,771 ----
*/
if (CALLED_AS_TRIGGER(fcinfo))
{
+ /* invoke the trigger handler */
pltcl_current_fcinfo = NULL;
retval = PointerGetDatum(pltcl_trigger_handler(fcinfo, pltrusted));
}
else
{
+ /* invoke the function handler */
pltcl_current_fcinfo = fcinfo;
retval = pltcl_func_handler(fcinfo, pltrusted);
}
*************** pltcl_handler(PG_FUNCTION_ARGS, bool plt
*** 660,671 ****
* pltcl_func_handler() - Handler for regular function calls
**********************************************************************/
static Datum
! pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted)
{
pltcl_proc_desc *prodesc;
Tcl_Interp *volatile interp;
! Tcl_DString tcl_cmd;
! Tcl_DString list_tmp;
int i;
int tcl_rc;
Datum retval;
--- 789,799 ----
* pltcl_func_handler() - Handler for regular function calls
**********************************************************************/
static Datum
! pltcl_func_handler(FunctionCallInfo fcinfo, bool pltrusted)
{
pltcl_proc_desc *prodesc;
Tcl_Interp *volatile interp;
! Tcl_Obj *tcl_cmd = Tcl_NewObj();
int i;
int tcl_rc;
Datum retval;
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 678,694 ****
prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, InvalidOid,
pltrusted);
pltcl_current_prodesc = prodesc;
-
interp = prodesc->interp_desc->interp;
/************************************************************
* Create the tcl command to call the internal
* proc in the Tcl interpreter
************************************************************/
! Tcl_DStringInit(&tcl_cmd);
! Tcl_DStringInit(&list_tmp);
! Tcl_DStringAppendElement(&tcl_cmd, prodesc->internal_proname);
/************************************************************
* Add all call arguments to the command
--- 806,828 ----
prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, InvalidOid,
pltrusted);
+ /*
+ * globally store current proc description, this can be redone using
+ * clientdata-type structures and eventually allow threading or something
+ */
pltcl_current_prodesc = prodesc;
interp = prodesc->interp_desc->interp;
+ /* reset essential function runtime to a known state */
+ pltcl_reset_state(prodesc, (ReturnSetInfo *) fcinfo->resultinfo);
+
/************************************************************
* 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));
/************************************************************
* Add all call arguments to the command
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 703,709 ****
* For tuple values, add a list for 'array set ...'
**************************************************/
if (fcinfo->argnull[i])
! Tcl_DStringAppendElement(&tcl_cmd, "");
else
{
HeapTupleHeader td;
--- 837,843 ----
* For tuple values, add a list for 'array set ...'
**************************************************/
if (fcinfo->argnull[i])
! Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
else
{
HeapTupleHeader td;
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 711,716 ****
--- 845,851 ----
int32 tupTypmod;
TupleDesc tupdesc;
HeapTupleData tmptup;
+ Tcl_Obj *list_tmp;
td = DatumGetHeapTupleHeader(fcinfo->arg[i]);
/* Extract rowtype info and find a tupdesc */
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 721,730 ****
tmptup.t_len = HeapTupleHeaderGetDatumLength(td);
tmptup.t_data = td;
! Tcl_DStringSetLength(&list_tmp, 0);
! pltcl_build_tuple_argument(&tmptup, tupdesc, &list_tmp);
! Tcl_DStringAppendElement(&tcl_cmd,
! Tcl_DStringValue(&list_tmp));
ReleaseTupleDesc(tupdesc);
}
}
--- 856,865 ----
tmptup.t_len = HeapTupleHeaderGetDatumLength(td);
tmptup.t_data = td;
! list_tmp = Tcl_NewObj();
! pltcl_build_tuple_argument(&tmptup, tupdesc, list_tmp);
! Tcl_ListObjAppendElement(NULL, tcl_cmd, list_tmp);
! Tcl_DecrRefCount(list_tmp);
ReleaseTupleDesc(tupdesc);
}
}
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 735,741 ****
* of their external representation
**************************************************/
if (fcinfo->argnull[i])
! Tcl_DStringAppendElement(&tcl_cmd, "");
else
{
char *tmp;
--- 870,876 ----
* of their external representation
**************************************************/
if (fcinfo->argnull[i])
! Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
else
{
char *tmp;
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 743,749 ****
tmp = OutputFunctionCall(&prodesc->arg_out_func[i],
fcinfo->arg[i]);
UTF_BEGIN;
! Tcl_DStringAppendElement(&tcl_cmd, UTF_E2U(tmp));
UTF_END;
pfree(tmp);
}
--- 878,885 ----
tmp = OutputFunctionCall(&prodesc->arg_out_func[i],
fcinfo->arg[i]);
UTF_BEGIN;
! Tcl_ListObjAppendElement(NULL, tcl_cmd,
! Tcl_NewStringObj(UTF_E2U(tmp), -1));
UTF_END;
pfree(tmp);
}
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 752,771 ****
}
PG_CATCH();
{
! Tcl_DStringFree(&tcl_cmd);
! Tcl_DStringFree(&list_tmp);
PG_RE_THROW();
}
PG_END_TRY();
- Tcl_DStringFree(&list_tmp);
/************************************************************
* Call the Tcl function
*
* We assume no PG error can be thrown directly from this call.
************************************************************/
! tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&tcl_cmd));
! Tcl_DStringFree(&tcl_cmd);
/************************************************************
* Check for errors reported by Tcl.
--- 888,905 ----
}
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_IncrRefCount(tcl_cmd);
! tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL));
/************************************************************
* Check for errors reported by Tcl.
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 773,778 ****
--- 907,918 ----
if (tcl_rc != TCL_OK)
throw_tcl_error(interp, prodesc->user_proname);
+ /*
+ * Don't get rid of tcl_cmd until after throwing the error because with
+ * tcl objects it can be referenced from the error handler
+ */
+ Tcl_DecrRefCount(tcl_cmd);
+
/************************************************************
* Disconnect from SPI manager and then create the return
* value datum (if the input function does a palloc for it
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 790,795 ****
--- 930,1001 ----
NULL,
prodesc->result_typioparam,
-1);
+ else if (prodesc->fn_retisset)
+ {
+ ReturnSetInfo *rsi = prodesc->rsi;
+
+ 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")));
+
+ rsi->returnMode = SFRM_Materialize;
+
+ /* If we produced any tuples, send back the result */
+ if (prodesc->tuple_store)
+ {
+ rsi->setResult = prodesc->tuple_store;
+ if (prodesc->ret_tupdesc)
+ {
+ MemoryContext oldcxt;
+
+ oldcxt = MemoryContextSwitchTo(prodesc->tuple_store_cxt);
+ rsi->setDesc = CreateTupleDescCopy(prodesc->ret_tupdesc);
+ MemoryContextSwitchTo(oldcxt);
+ }
+ }
+ retval = (Datum) 0;
+ fcinfo->isnull = true;
+ }
+ else if (prodesc->fn_retistuple)
+ {
+ TupleDesc td;
+ HeapTuple tup;
+ Tcl_Obj *resultObj;
+ Tcl_Obj **resultObjv;
+ int resultObjc;
+
+ if (get_call_result_type(fcinfo, NULL, &td) != TYPEFUNC_COMPOSITE)
+ {
+ ereport(ERROR,
+ (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
+ errmsg("function returning record called in context "
+ "that cannot accept type record")));
+ }
+
+ resultObj = Tcl_GetObjResult(interp);
+ if (Tcl_ListObjGetElements (interp, resultObj, &resultObjc, &resultObjv) == TCL_ERROR)
+ {
+ return TCL_ERROR;
+ }
+
+ if (resultObjc & 1)
+ {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("list must have even number of elements", -1));
+ return TCL_ERROR;
+ }
+
+ Assert(!prodesc->ret_tupdesc);
+ Assert(!prodesc->attinmeta);
+ prodesc->ret_tupdesc = td;
+ prodesc->natts = td->natts;
+ prodesc->attinmeta = TupleDescGetAttInMetadata(prodesc->ret_tupdesc);
+
+ tup = pltcl_build_tuple_result(interp, resultObjv, resultObjc, prodesc);
+ retval = HeapTupleGetDatum(tup);
+ }
else
{
UTF_BEGIN;
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 808,814 ****
* pltcl_trigger_handler() - Handler for trigger calls
**********************************************************************/
static HeapTuple
! pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted)
{
pltcl_proc_desc *prodesc;
Tcl_Interp *volatile interp;
--- 1014,1020 ----
* pltcl_trigger_handler() - Handler for trigger calls
**********************************************************************/
static HeapTuple
! pltcl_trigger_handler(FunctionCallInfo fcinfo, bool pltrusted)
{
pltcl_proc_desc *prodesc;
Tcl_Interp *volatile interp;
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 816,824 ****
char *stroid;
TupleDesc tupdesc;
volatile HeapTuple rettup;
! Tcl_DString tcl_cmd;
! Tcl_DString tcl_trigtup;
! Tcl_DString tcl_newtup;
int tcl_rc;
int i;
int *modattrs;
--- 1022,1030 ----
char *stroid;
TupleDesc tupdesc;
volatile HeapTuple rettup;
! Tcl_Obj *tcl_cmd;
! Tcl_Obj *tcl_trigtup;
! Tcl_Obj *tcl_newtup;
int tcl_rc;
int i;
int *modattrs;
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 838,911 ****
pltrusted);
pltcl_current_prodesc = prodesc;
-
interp = prodesc->interp_desc->interp;
-
tupdesc = trigdata->tg_relation->rd_att;
/************************************************************
* Create the tcl command to call the internal
* proc in the interpreter
************************************************************/
! Tcl_DStringInit(&tcl_cmd);
! Tcl_DStringInit(&tcl_trigtup);
! Tcl_DStringInit(&tcl_newtup);
PG_TRY();
{
/* The procedure name */
! Tcl_DStringAppendElement(&tcl_cmd, prodesc->internal_proname);
/* The trigger name for argument TG_name */
! Tcl_DStringAppendElement(&tcl_cmd, trigdata->tg_trigger->tgname);
/* The oid of the trigger relation for argument TG_relid */
stroid = DatumGetCString(DirectFunctionCall1(oidout,
ObjectIdGetDatum(trigdata->tg_relation->rd_id)));
! Tcl_DStringAppendElement(&tcl_cmd, stroid);
pfree(stroid);
/* The name of the table the trigger is acting on: TG_table_name */
stroid = SPI_getrelname(trigdata->tg_relation);
! Tcl_DStringAppendElement(&tcl_cmd, stroid);
pfree(stroid);
/* The schema of the table the trigger is acting on: TG_table_schema */
stroid = SPI_getnspname(trigdata->tg_relation);
! Tcl_DStringAppendElement(&tcl_cmd, stroid);
pfree(stroid);
/* A list of attribute names for argument TG_relatts */
! Tcl_DStringAppendElement(&tcl_trigtup, "");
for (i = 0; i < tupdesc->natts; i++)
{
if (tupdesc->attrs[i]->attisdropped)
! Tcl_DStringAppendElement(&tcl_trigtup, "");
else
! Tcl_DStringAppendElement(&tcl_trigtup,
! NameStr(tupdesc->attrs[i]->attname));
}
! Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
! Tcl_DStringFree(&tcl_trigtup);
! Tcl_DStringInit(&tcl_trigtup);
/* The when part of the event for TG_when */
if (TRIGGER_FIRED_BEFORE(trigdata->tg_event))
! Tcl_DStringAppendElement(&tcl_cmd, "BEFORE");
else if (TRIGGER_FIRED_AFTER(trigdata->tg_event))
! Tcl_DStringAppendElement(&tcl_cmd, "AFTER");
else if (TRIGGER_FIRED_INSTEAD(trigdata->tg_event))
! Tcl_DStringAppendElement(&tcl_cmd, "INSTEAD OF");
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_DStringAppendElement(&tcl_cmd, "ROW");
/* Build the data list for the trigtuple */
pltcl_build_tuple_argument(trigdata->tg_trigtuple,
! tupdesc, &tcl_trigtup);
/*
* Now the command part of the event for TG_op and data for NEW
--- 1044,1127 ----
pltrusted);
pltcl_current_prodesc = prodesc;
interp = prodesc->interp_desc->interp;
tupdesc = trigdata->tg_relation->rd_att;
+ pltcl_reset_state(prodesc, NULL);
+
/************************************************************
* Create the tcl command to call the internal
* proc in the interpreter
************************************************************/
! tcl_cmd = Tcl_NewObj();
! tcl_trigtup = Tcl_NewObj();
! tcl_newtup = Tcl_NewObj();
PG_TRY();
{
/* The procedure name */
! 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(trigdata->tg_trigger->tgname, -1));
/* The oid of the trigger relation for argument TG_relid */
+ /* NB don't convert 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(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(stroid, -1));
pfree(stroid);
/* A list of attribute names for argument TG_relatts */
! Tcl_ListObjAppendElement(NULL, tcl_trigtup, Tcl_NewObj());
for (i = 0; i < tupdesc->natts; i++)
{
if (tupdesc->attrs[i]->attisdropped)
! Tcl_ListObjAppendElement(NULL, tcl_trigtup, Tcl_NewObj());
else
! Tcl_ListObjAppendElement(NULL, tcl_trigtup,
! Tcl_NewStringObj(NameStr(tupdesc->attrs[i]->attname), -1));
}
! Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
! /* Tcl_DecrRefCount(tcl_trigtup); */
! tcl_trigtup = Tcl_NewObj();
/* 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));
/* Build the data list for the trigtuple */
pltcl_build_tuple_argument(trigdata->tg_trigtuple,
! tupdesc, tcl_trigtup);
/*
* Now the command part of the event for TG_op and data for NEW
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 913,943 ****
*/
if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
{
! Tcl_DStringAppendElement(&tcl_cmd, "INSERT");
! Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
! Tcl_DStringAppendElement(&tcl_cmd, "");
rettup = trigdata->tg_trigtuple;
}
else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event))
{
! Tcl_DStringAppendElement(&tcl_cmd, "DELETE");
! Tcl_DStringAppendElement(&tcl_cmd, "");
! Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
rettup = trigdata->tg_trigtuple;
}
else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
{
! Tcl_DStringAppendElement(&tcl_cmd, "UPDATE");
pltcl_build_tuple_argument(trigdata->tg_newtuple,
! tupdesc, &tcl_newtup);
! Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_newtup));
! Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
rettup = trigdata->tg_newtuple;
}
--- 1129,1162 ----
*/
if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
{
! Tcl_ListObjAppendElement(NULL, tcl_cmd,
! Tcl_NewStringObj("INSERT", -1));
! Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
! 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, tcl_trigtup);
rettup = trigdata->tg_trigtuple;
}
else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
{
! Tcl_ListObjAppendElement(NULL, tcl_cmd,
! Tcl_NewStringObj("UPDATE", -1));
pltcl_build_tuple_argument(trigdata->tg_newtuple,
! tupdesc, tcl_newtup);
! Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_newtup);
! Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
rettup = trigdata->tg_newtuple;
}
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 946,966 ****
}
else if (TRIGGER_FIRED_FOR_STATEMENT(trigdata->tg_event))
{
! Tcl_DStringAppendElement(&tcl_cmd, "STATEMENT");
if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
! Tcl_DStringAppendElement(&tcl_cmd, "INSERT");
else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event))
! Tcl_DStringAppendElement(&tcl_cmd, "DELETE");
else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
! Tcl_DStringAppendElement(&tcl_cmd, "UPDATE");
else if (TRIGGER_FIRED_BY_TRUNCATE(trigdata->tg_event))
! Tcl_DStringAppendElement(&tcl_cmd, "TRUNCATE");
else
elog(ERROR, "unrecognized OP tg_event: %u", trigdata->tg_event);
! Tcl_DStringAppendElement(&tcl_cmd, "");
! Tcl_DStringAppendElement(&tcl_cmd, "");
rettup = (HeapTuple) NULL;
}
--- 1165,1190 ----
}
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;
}
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 969,995 ****
/* Finally append the arguments from CREATE TRIGGER */
for (i = 0; i < trigdata->tg_trigger->tgnargs; i++)
! Tcl_DStringAppendElement(&tcl_cmd, trigdata->tg_trigger->tgargs[i]);
}
PG_CATCH();
{
! Tcl_DStringFree(&tcl_cmd);
! Tcl_DStringFree(&tcl_trigtup);
! Tcl_DStringFree(&tcl_newtup);
PG_RE_THROW();
}
PG_END_TRY();
- Tcl_DStringFree(&tcl_trigtup);
- Tcl_DStringFree(&tcl_newtup);
/************************************************************
* Call the Tcl function
*
* We assume no PG error can be thrown directly from this call.
************************************************************/
! tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&tcl_cmd));
! Tcl_DStringFree(&tcl_cmd);
/************************************************************
* Check for errors reported by Tcl.
--- 1193,1221 ----
/* Finally append the arguments from CREATE TRIGGER */
for (i = 0; i < trigdata->tg_trigger->tgnargs; i++)
! Tcl_ListObjAppendElement(NULL, tcl_cmd,
! Tcl_NewStringObj(trigdata->tg_trigger->tgargs[i], -1));
}
PG_CATCH();
{
! Tcl_DecrRefCount(tcl_cmd);
! Tcl_DecrRefCount(tcl_trigtup);
! Tcl_DecrRefCount(tcl_newtup);
PG_RE_THROW();
}
PG_END_TRY();
/************************************************************
* Call the Tcl function
*
* We assume no PG error can be thrown directly from this call.
************************************************************/
! Tcl_IncrRefCount(tcl_cmd);
! tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL));
! /* Tcl_DecrRefCount(tcl_trigtup); */
! /* Tcl_DecrRefCount(tcl_newtup); */
! Tcl_DecrRefCount(tcl_cmd);
/************************************************************
* Check for errors reported by Tcl.
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 1126,1132 ****
* 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
--- 1352,1358 ----
* 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
*************** throw_tcl_error(Tcl_Interp *interp, cons
*** 1151,1156 ****
--- 1377,1427 ----
UTF_END;
}
+ static void
+ pltcl_init_tuple_store(pltcl_proc_desc * prodesc)
+ {
+ ReturnSetInfo *rsi = prodesc->rsi;
+ MemoryContext oldcxt;
+ ResourceOwner oldowner;
+
+ /*
+ * Check caller can handle a set result in the way we want
+ */
+ if (!rsi || !IsA(rsi, ReturnSetInfo) ||
+ (rsi->allowedModes & SFRM_Materialize) == 0 ||
+ rsi->expectedDesc == NULL)
+ ereport(ERROR,
+ (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
+ errmsg("set-valued function called in context that cannot accept a set")));
+
+ Assert(!prodesc->tuple_store);
+ Assert(!prodesc->attinmeta);
+
+ /*
+ * Switch to the right memory context and resource owner for storing the
+ * tuplestore for return set. 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 resource owner.
+ */
+ prodesc->ret_tupdesc = rsi->expectedDesc;
+ prodesc->natts = prodesc->ret_tupdesc->natts;
+
+ oldcxt = MemoryContextSwitchTo(prodesc->tuple_store_cxt);
+ oldowner = CurrentResourceOwner;
+ CurrentResourceOwner = prodesc->tuple_store_owner;
+
+ prodesc->tuple_store =
+ tuplestore_begin_heap(rsi->allowedModes & SFRM_Materialize_Random,
+ false, work_mem);
+
+ prodesc->attinmeta = TupleDescGetAttInMetadata(prodesc->ret_tupdesc);
+
+ CurrentResourceOwner = oldowner;
+ MemoryContextSwitchTo(oldcxt);
+
+ }
+
/**********************************************************************
* compile_pltcl_function - compile (or hopefully just look up) function
*************** compile_pltcl_function(Oid fn_oid, Oid t
*** 1230,1235 ****
--- 1501,1507 ----
Tcl_Interp *interp;
int i;
int tcl_rc;
+ FunctionCallInfo fcinfo = pltcl_current_fcinfo;
/************************************************************
* Build our internal proc name from the function's Oid. Append
*************** compile_pltcl_function(Oid fn_oid, Oid t
*** 1267,1272 ****
--- 1539,1555 ----
/* And whether it is trusted */
prodesc->lanpltrusted = pltrusted;
+ /* not necessary since MemSet 0 above */
+ prodesc->fn_retistuple = false;
+ prodesc->fn_retisset = false;
+ prodesc->tuple_store_cxt = NULL;
+ prodesc->tuple_store_owner = NULL;
+ prodesc->tuple_store = NULL;
+ prodesc->ret_tupdesc = NULL;
+ prodesc->attinmeta = NULL;
+ prodesc->natts = 0;
+
+
/************************************************************
* Identify the interpreter to use for the function
************************************************************/
*************** compile_pltcl_function(Oid fn_oid, Oid t
*** 1279,1284 ****
--- 1562,1574 ----
************************************************************/
if (!is_trigger)
{
+ prodesc->rsi = (ReturnSetInfo *) fcinfo->resultinfo;
+ if (prodesc->rsi)
+ {
+ prodesc->tuple_store_cxt = prodesc->rsi->econtext->ecxt_per_query_memory;
+ prodesc->tuple_store_owner = CurrentResourceOwner;
+ }
+
typeTup =
SearchSysCache1(TYPEOID,
ObjectIdGetDatum(procStruct->prorettype));
*************** compile_pltcl_function(Oid fn_oid, Oid t
*** 1306,1311 ****
--- 1596,1603 ----
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
errmsg("trigger functions can only be called as triggers")));
}
+ else if (procStruct->prorettype == RECORDOID)
+ ;
else
{
free(prodesc->user_proname);
*************** compile_pltcl_function(Oid fn_oid, Oid t
*** 1318,1332 ****
}
}
! if (typeStruct->typtype == TYPTYPE_COMPOSITE)
! {
! free(prodesc->user_proname);
! free(prodesc->internal_proname);
! free(prodesc);
! ereport(ERROR,
! (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
! errmsg("PL/Tcl functions cannot return composite types")));
! }
perm_fmgr_info(typeStruct->typinput, &(prodesc->result_in_func));
prodesc->result_typioparam = getTypeIOParam(typeTup);
--- 1610,1618 ----
}
}
! prodesc->fn_retisset = procStruct->proretset;
! prodesc->fn_retistuple = (procStruct->prorettype == RECORDOID ||
! typeStruct->typtype == TYPTYPE_COMPOSITE);
perm_fmgr_info(typeStruct->typinput, &(prodesc->result_in_func));
prodesc->result_typioparam = getTypeIOParam(typeTup);
*************** compile_pltcl_function(Oid fn_oid, Oid t
*** 1398,1403 ****
--- 1684,1693 ----
/************************************************************
* Create the tcl command to define the internal
* procedure
+ *
+ * leave this as DString - it's a text processing function
+ * that only gets invoked when the tcl function is invoked
+ * for the first time
************************************************************/
Tcl_DStringInit(&proc_internal_def);
Tcl_DStringInit(&proc_internal_body);
*************** compile_pltcl_function(Oid fn_oid, Oid t
*** 1495,1533 ****
* pltcl_elog() - elog() support for PLTcl
**********************************************************************/
static int
! pltcl_elog(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[])
{
volatile int level;
MemoryContext oldcontext;
! if (argc != 3)
{
! Tcl_SetResult(interp, "syntax error - 'elog level msg'", TCL_STATIC);
return TCL_ERROR;
}
! if (strcmp(argv[1], "DEBUG") == 0)
! level = DEBUG2;
! else if (strcmp(argv[1], "LOG") == 0)
! level = LOG;
! else if (strcmp(argv[1], "INFO") == 0)
! level = INFO;
! else if (strcmp(argv[1], "NOTICE") == 0)
! level = NOTICE;
! else if (strcmp(argv[1], "WARNING") == 0)
! level = WARNING;
! else if (strcmp(argv[1], "ERROR") == 0)
! level = ERROR;
! else if (strcmp(argv[1], "FATAL") == 0)
! level = FATAL;
! else
{
- Tcl_AppendResult(interp, "Unknown elog level '", argv[1],
- "'", NULL);
return TCL_ERROR;
}
if (level == ERROR)
{
/*
--- 1785,1851 ----
* 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;
! enum logpriority
{
! LOG_DEBUG, LOG_LOG, LOG_INFO, LOG_NOTICE,
! LOG_WARNING, LOG_ERROR, LOG_FATAL
! };
!
! static CONST84 char *logpriorities[] = {
! "DEBUG", "LOG", "INFO", "NOTICE",
! "WARNING", "ERROR", "FATAL", (char *) NULL
! };
!
! 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;
}
+ switch ((enum logpriority) priIndex)
+ {
+ case LOG_DEBUG:
+ level = DEBUG2;
+ break;
+
+ case LOG_LOG:
+ level = LOG;
+ break;
+
+ case LOG_INFO:
+ level = INFO;
+ break;
+
+ case LOG_NOTICE:
+ level = NOTICE;
+ break;
+
+ case LOG_WARNING:
+ level = WARNING;
+ break;
+
+ case LOG_ERROR:
+ level = ERROR;
+ break;
+
+ case LOG_FATAL:
+ level = FATAL;
+ break;
+ }
+
if (level == ERROR)
{
/*
*************** pltcl_elog(ClientData cdata, Tcl_Interp
*** 1535,1541 ****
* eventually get converted to a PG error when we reach the call
* handler.
*/
! Tcl_SetResult(interp, (char *) argv[2], TCL_VOLATILE);
return TCL_ERROR;
}
--- 1853,1859 ----
* eventually get converted to a PG error when we reach the call
* handler.
*/
! Tcl_SetObjResult(interp, objv[2]);
return TCL_ERROR;
}
*************** pltcl_elog(ClientData cdata, Tcl_Interp
*** 1552,1558 ****
PG_TRY();
{
UTF_BEGIN;
! elog(level, "%s", UTF_U2E(argv[2]));
UTF_END;
}
PG_CATCH();
--- 1870,1876 ----
PG_TRY();
{
UTF_BEGIN;
! elog(level, "%s", UTF_U2E(Tcl_GetString(objv[2])));
UTF_END;
}
PG_CATCH();
*************** pltcl_elog(ClientData cdata, Tcl_Interp
*** 1566,1572 ****
/* Pass the error message to Tcl */
UTF_BEGIN;
! Tcl_SetResult(interp, UTF_E2U(edata->message), TCL_VOLATILE);
UTF_END;
FreeErrorData(edata);
--- 1884,1890 ----
/* Pass the error message to Tcl */
UTF_BEGIN;
! Tcl_SetObjResult(interp, Tcl_NewStringObj(UTF_E2U(edata->message), -1));
UTF_END;
FreeErrorData(edata);
*************** pltcl_elog(ClientData cdata, Tcl_Interp
*** 1583,1590 ****
* be used in SPI_execute query strings
**********************************************************************/
static int
! pltcl_quote(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[])
{
char *tmp;
const char *cp1;
--- 1901,1908 ----
* 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;
*************** pltcl_quote(ClientData cdata, Tcl_Interp
*** 1593,1601 ****
/************************************************************
* Check call syntax
************************************************************/
! if (argc != 2)
{
! Tcl_SetResult(interp, "syntax error - 'quote string'", TCL_STATIC);
return TCL_ERROR;
}
--- 1911,1919 ----
/************************************************************
* Check call syntax
************************************************************/
! if (objc != 2)
{
! Tcl_WrongNumArgs(interp, 1, objv, "string");
return TCL_ERROR;
}
*************** pltcl_quote(ClientData cdata, Tcl_Interp
*** 1603,1610 ****
* Allocate space for the maximum the string can
* grow to and initialize pointers
************************************************************/
! tmp = palloc(strlen(argv[1]) * 2 + 1);
! cp1 = argv[1];
cp2 = tmp;
/************************************************************
--- 1921,1928 ----
* Allocate space for the maximum the string can
* grow to and initialize pointers
************************************************************/
! tmp = palloc(strlen(Tcl_GetString(objv[1])) * 2 + 1);
! cp1 = Tcl_GetString(objv[1]);
cp2 = tmp;
/************************************************************
*************** pltcl_quote(ClientData cdata, Tcl_Interp
*** 1626,1632 ****
* Terminate the string and set it as result
************************************************************/
*cp2 = '\0';
! Tcl_SetResult(interp, tmp, TCL_VOLATILE);
pfree(tmp);
return TCL_OK;
}
--- 1944,1950 ----
* Terminate the string and set it as result
************************************************************/
*cp2 = '\0';
! Tcl_SetObjResult(interp, Tcl_NewStringObj(tmp, -1));
pfree(tmp);
return TCL_OK;
}
*************** pltcl_quote(ClientData cdata, Tcl_Interp
*** 1636,1643 ****
* pltcl_argisnull() - determine if a specific argument is NULL
**********************************************************************/
static int
! pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[])
{
int argno;
FunctionCallInfo fcinfo = pltcl_current_fcinfo;
--- 1954,1961 ----
* 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_fcinfo;
*************** pltcl_argisnull(ClientData cdata, Tcl_In
*** 1645,1654 ****
/************************************************************
* Check call syntax
************************************************************/
! if (argc != 2)
{
! Tcl_SetResult(interp, "syntax error - 'argisnull argno'",
! TCL_STATIC);
return TCL_ERROR;
}
--- 1963,1971 ----
/************************************************************
* Check call syntax
************************************************************/
! if (objc != 2)
{
! Tcl_WrongNumArgs(interp, 1, objv, "argno");
return TCL_ERROR;
}
*************** pltcl_argisnull(ClientData cdata, Tcl_In
*** 1657,1671 ****
************************************************************/
if (fcinfo == NULL)
{
! Tcl_SetResult(interp, "argisnull cannot be used in triggers",
! TCL_STATIC);
return TCL_ERROR;
}
/************************************************************
* Get the argument number
************************************************************/
! if (Tcl_GetInt(interp, argv[1], &argno) != TCL_OK)
return TCL_ERROR;
/************************************************************
--- 1974,1988 ----
************************************************************/
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;
/************************************************************
*************** pltcl_argisnull(ClientData cdata, Tcl_In
*** 1674,1691 ****
argno--;
if (argno < 0 || argno >= fcinfo->nargs)
{
! Tcl_SetResult(interp, "argno out of range", TCL_STATIC);
return TCL_ERROR;
}
/************************************************************
* Get the requested NULL state
************************************************************/
! if (PG_ARGISNULL(argno))
! Tcl_SetResult(interp, "1", TCL_STATIC);
! else
! Tcl_SetResult(interp, "0", TCL_STATIC);
!
return TCL_OK;
}
--- 1991,2005 ----
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_argisnull(ClientData cdata, Tcl_In
*** 1694,1710 ****
* pltcl_returnnull() - Cause a NULL return from a function
**********************************************************************/
static int
! pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[])
{
FunctionCallInfo fcinfo = pltcl_current_fcinfo;
/************************************************************
* Check call syntax
************************************************************/
! if (argc != 1)
{
! Tcl_SetResult(interp, "syntax error - 'return_null'", TCL_STATIC);
return TCL_ERROR;
}
--- 2008,2024 ----
* pltcl_returnnull() - Cause a NULL return from a function
**********************************************************************/
static int
! pltcl_returnnull(ClientData cdata, Tcl_Interp * interp,
! int objc, Tcl_Obj * const objv[])
{
FunctionCallInfo fcinfo = pltcl_current_fcinfo;
/************************************************************
* Check call syntax
************************************************************/
! if (objc != 1)
{
! Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
}
*************** pltcl_returnnull(ClientData cdata, Tcl_I
*** 1713,1720 ****
************************************************************/
if (fcinfo == NULL)
{
! Tcl_SetResult(interp, "return_null cannot be used in triggers",
! TCL_STATIC);
return TCL_ERROR;
}
--- 2027,2034 ----
************************************************************/
if (fcinfo == NULL)
{
! Tcl_SetObjResult(interp,
! Tcl_NewStringObj("return_null cannot be used in triggers", -1));
return TCL_ERROR;
}
*************** pltcl_returnnull(ClientData cdata, Tcl_I
*** 1727,1732 ****
--- 2041,2134 ----
return TCL_RETURN;
}
+ /**********************************************************************
+ * pltcl_pg_returnnext() - Queue a row of Tcl key-value pairs into the
+ * function's tuple_store
+ **********************************************************************/
+ static void
+ pltcl_pg_returnnext(Tcl_Interp * interp, int rowObjc, Tcl_Obj ** rowObjv)
+ {
+ pltcl_proc_desc *prodesc = pltcl_current_prodesc;
+
+ if (!prodesc->fn_retisset)
+ ereport(ERROR,
+ (errcode(ERRCODE_SYNTAX_ERROR),
+ errmsg("cannot use return_next in a non-SETOF function")));
+
+ if (prodesc->tuple_store == NULL)
+ pltcl_init_tuple_store(prodesc);
+
+ if (prodesc->fn_retistuple)
+ {
+ HeapTuple tuple;
+
+ tuple = pltcl_build_tuple_result(interp, rowObjv, rowObjc, prodesc);
+ tuplestore_puttuple(prodesc->tuple_store, tuple);
+ }
+ else
+ {
+ ereport(ERROR,
+ (errcode(ERRCODE_SYNTAX_ERROR),
+ errmsg("unprepared for non-retistuple state at this point")));
+ }
+ }
+
+ /**********************************************************************
+ * pltcl_returnnext() - Tcl-callable command take a list of key-value
+ * pairs and store in the tuple_store
+ * for sending as a result when the
+ * function is complete.
+ **********************************************************************/
+ static int
+ pltcl_returnnext(ClientData cdata, Tcl_Interp * interp,
+ int objc, Tcl_Obj * const objv[])
+ {
+ FunctionCallInfo fcinfo = pltcl_current_fcinfo;
+ Tcl_Obj **rowObjv;
+ int rowObjc;
+ pltcl_proc_desc *prodesc = pltcl_current_prodesc;
+
+ /************************************************************
+ * Check call syntax
+ ************************************************************/
+ if (objc != 2)
+ {
+ Tcl_WrongNumArgs(interp, 1, objv, "list");
+ return TCL_ERROR;
+ }
+
+ /************************************************************
+ * Check that we're called as a normal 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("cannot use return_next in a non-SETOF function", -1));
+ return TCL_ERROR;
+ }
+
+ if (Tcl_ListObjGetElements(interp, objv[1], &rowObjc, &rowObjv) == TCL_ERROR)
+ {
+ return TCL_ERROR;
+ }
+
+ if (rowObjc & 1)
+ {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("list must have even number of elements", -1));
+ return TCL_ERROR;
+ }
+
+ pltcl_pg_returnnext(interp, rowObjc, rowObjv);
+ return TCL_OK;
+ }
/*----------
* Support for running SPI operations inside subtransactions
*************** pltcl_subtrans_commit(MemoryContext oldc
*** 1777,1783 ****
}
static void
! pltcl_subtrans_abort(Tcl_Interp *interp,
MemoryContext oldcontext, ResourceOwner oldowner)
{
ErrorData *edata;
--- 2179,2185 ----
}
static void
! pltcl_subtrans_abort(Tcl_Interp * interp,
MemoryContext oldcontext, ResourceOwner oldowner)
{
ErrorData *edata;
*************** pltcl_subtrans_abort(Tcl_Interp *interp,
*** 1812,1830 ****
* for the Tcl interpreter
**********************************************************************/
static int
! pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[])
{
int my_rc;
int spi_rc;
int query_idx;
int i;
int count = 0;
CONST84 char *volatile arrayname = NULL;
! CONST84 char *volatile loop_body = NULL;
MemoryContext oldcontext = CurrentMemoryContext;
ResourceOwner oldowner = CurrentResourceOwner;
char *usage = "syntax error - 'SPI_exec "
"?-count n? "
"?-array name? query ?loop body?";
--- 2214,2242 ----
* 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;
CONST84 char *volatile arrayname = NULL;
! Tcl_Obj *loop_body = NULL;
MemoryContext oldcontext = CurrentMemoryContext;
ResourceOwner oldowner = CurrentResourceOwner;
+ enum options
+ {
+ OPT_ARRAY, OPT_COUNT
+ };
+
+ static CONST84 char *options[] = {
+ "-array", "-count", (char *) NULL
+ };
+
char *usage = "syntax error - 'SPI_exec "
"?-count n? "
"?-array name? query ?loop body?";
*************** pltcl_SPI_execute(ClientData cdata, Tcl_
*** 1832,1880 ****
/************************************************************
* Check the call syntax and get the options
************************************************************/
! if (argc < 2)
{
Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR;
}
i = 1;
! while (i < argc)
{
! if (strcmp(argv[i], "-array") == 0)
{
! if (++i >= argc)
! {
! Tcl_SetResult(interp, usage, TCL_STATIC);
! return TCL_ERROR;
! }
! arrayname = argv[i++];
! continue;
}
! if (strcmp(argv[i], "-count") == 0)
{
! if (++i >= argc)
! {
! Tcl_SetResult(interp, usage, TCL_STATIC);
! return TCL_ERROR;
! }
! if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK)
! return TCL_ERROR;
! continue;
}
! break;
}
query_idx = i;
! if (query_idx >= argc || query_idx + 2 < argc)
{
Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR;
}
! if (query_idx + 1 < argc)
! loop_body = argv[query_idx + 1];
/************************************************************
* Execute the query inside a sub-transaction, so we can cope with
--- 2244,2296 ----
/************************************************************
* Check the call syntax and get the options
************************************************************/
! if (objc < 2)
{
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?-count n? ?-array name? query ?loop body?");
Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR;
}
i = 1;
! while (i < objc)
{
! if (Tcl_GetIndexFromObj(interp, objv[i], options, "option",
! TCL_EXACT, &optIndex) != TCL_OK)
{
! return TCL_ERROR;
}
! 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_SetResult(interp, usage, TCL_STATIC);
+ 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
*************** pltcl_SPI_execute(ClientData cdata, Tcl_
*** 1886,1892 ****
PG_TRY();
{
UTF_BEGIN;
! spi_rc = SPI_execute(UTF_U2E(argv[query_idx]),
pltcl_current_prodesc->fn_readonly, count);
UTF_END;
--- 2302,2308 ----
PG_TRY();
{
UTF_BEGIN;
! spi_rc = SPI_execute(UTF_U2E(Tcl_GetString(objv[query_idx])),
pltcl_current_prodesc->fn_readonly, count);
UTF_END;
*************** pltcl_SPI_execute(ClientData cdata, Tcl_
*** 1915,1929 ****
* Shared code between pltcl_SPI_execute and pltcl_SPI_execute_plan
*/
static int
! pltcl_process_SPI_result(Tcl_Interp *interp,
CONST84 char *arrayname,
! CONST84 char *loop_body,
int spi_rc,
! SPITupleTable *tuptable,
int ntuples)
{
int my_rc = TCL_OK;
- char buf[64];
int i;
int loop_rc;
HeapTuple *tuples;
--- 2331,2344 ----
* Shared code between pltcl_SPI_execute and pltcl_SPI_execute_plan
*/
static int
! pltcl_process_SPI_result(Tcl_Interp * interp,
CONST84 char *arrayname,
! Tcl_Obj * loop_body,
int spi_rc,
! SPITupleTable * tuptable,
int ntuples)
{
int my_rc = TCL_OK;
int i;
int loop_rc;
HeapTuple *tuples;
*************** pltcl_process_SPI_result(Tcl_Interp *int
*** 1935,1949 ****
case SPI_OK_INSERT:
case SPI_OK_DELETE:
case SPI_OK_UPDATE:
! snprintf(buf, sizeof(buf), "%d", ntuples);
! Tcl_SetResult(interp, buf, TCL_VOLATILE);
break;
case SPI_OK_UTILITY:
case SPI_OK_REWRITTEN:
if (tuptable == NULL)
{
! Tcl_SetResult(interp, "0", TCL_STATIC);
break;
}
/* FALL THRU for utility returning tuples */
--- 2350,2363 ----
case SPI_OK_INSERT:
case SPI_OK_DELETE:
case SPI_OK_UPDATE:
! Tcl_SetObjResult(interp, Tcl_NewIntObj(ntuples));
break;
case SPI_OK_UTILITY:
case SPI_OK_REWRITTEN:
if (tuptable == NULL)
{
! Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
break;
}
/* FALL THRU for utility returning tuples */
*************** pltcl_process_SPI_result(Tcl_Interp *int
*** 1980,1986 ****
pltcl_set_tuple_values(interp, arrayname, i,
tuples[i], tupdesc);
! loop_rc = Tcl_Eval(interp, loop_body);
if (loop_rc == TCL_OK)
continue;
--- 2394,2400 ----
pltcl_set_tuple_values(interp, arrayname, i,
tuples[i], tupdesc);
! loop_rc = Tcl_EvalObjEx(interp, loop_body, 0);
if (loop_rc == TCL_OK)
continue;
*************** pltcl_process_SPI_result(Tcl_Interp *int
*** 2000,2007 ****
if (my_rc == TCL_OK)
{
! snprintf(buf, sizeof(buf), "%d", ntuples);
! Tcl_SetResult(interp, buf, TCL_VOLATILE);
}
break;
--- 2414,2420 ----
if (my_rc == TCL_OK)
{
! Tcl_SetObjResult(interp, Tcl_NewIntObj(ntuples));
}
break;
*************** pltcl_process_SPI_result(Tcl_Interp *int
*** 2027,2037 ****
* and not save the plan currently.
**********************************************************************/
static int
! pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[])
{
int nargs;
! CONST84 char **args;
pltcl_query_desc *qdesc;
void *plan;
int i;
--- 2440,2450 ----
* and not save the plan currently.
**********************************************************************/
static int
! pltcl_SPI_prepare(ClientData cdata, Tcl_Interp * interp,
! int objc, Tcl_Obj * const objv[])
{
int nargs;
! Tcl_Obj **argsObj;
pltcl_query_desc *qdesc;
void *plan;
int i;
*************** pltcl_SPI_prepare(ClientData cdata, Tcl_
*** 2044,2060 ****
/************************************************************
* Check the call syntax
************************************************************/
! if (argc != 3)
{
! Tcl_SetResult(interp, "syntax error - 'SPI_prepare query argtypes'",
! TCL_STATIC);
return TCL_ERROR;
}
/************************************************************
* Split the argument type list
************************************************************/
! if (Tcl_SplitList(interp, argv[2], &nargs, &args) != TCL_OK)
return TCL_ERROR;
/************************************************************
--- 2457,2472 ----
/************************************************************
* 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;
/************************************************************
*************** pltcl_SPI_prepare(ClientData cdata, Tcl_
*** 2088,2094 ****
typIOParam;
int32 typmod;
! parseTypeString(args[i], &typId, &typmod);
getTypeInputInfo(typId, &typInput, &typIOParam);
--- 2500,2506 ----
typIOParam;
int32 typmod;
! parseTypeString(Tcl_GetString(argsObj[i]), &typId, &typmod);
getTypeInputInfo(typId, &typInput, &typIOParam);
*************** pltcl_SPI_prepare(ClientData cdata, Tcl_
*** 2101,2107 ****
* Prepare the plan and check for errors
************************************************************/
UTF_BEGIN;
! plan = SPI_prepare(UTF_U2E(argv[1]), nargs, qdesc->argtypes);
UTF_END;
if (plan == NULL)
--- 2513,2519 ----
* Prepare the plan and check for errors
************************************************************/
UTF_BEGIN;
! plan = SPI_prepare(UTF_U2E(Tcl_GetString(argsObj[1])), nargs, qdesc->argtypes);
UTF_END;
if (plan == NULL)
*************** pltcl_SPI_prepare(ClientData cdata, Tcl_
*** 2128,2134 ****
free(qdesc->arginfuncs);
free(qdesc->argtypioparams);
free(qdesc);
- ckfree((char *) args);
return TCL_ERROR;
}
--- 2540,2545 ----
*************** pltcl_SPI_prepare(ClientData cdata, Tcl_
*** 2143,2152 ****
hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew);
Tcl_SetHashValue(hashent, (ClientData) qdesc);
- ckfree((char *) args);
-
/* qname is ASCII, so no need for encoding conversion */
! Tcl_SetResult(interp, qdesc->qname, TCL_VOLATILE);
return TCL_OK;
}
--- 2554,2561 ----
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_prepare(ClientData cdata, Tcl_
*** 2155,2172 ****
* pltcl_SPI_execute_plan() - Execute a prepared plan
**********************************************************************/
static int
! pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[])
{
int my_rc;
int spi_rc;
int i;
int j;
Tcl_HashEntry *hashent;
pltcl_query_desc *qdesc;
const char *volatile nulls = NULL;
CONST84 char *volatile arrayname = NULL;
! CONST84 char *volatile loop_body = NULL;
int count = 0;
int callnargs;
CONST84 char **callargs = NULL;
--- 2564,2582 ----
* 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 *volatile nulls = NULL;
CONST84 char *volatile arrayname = NULL;
! Tcl_Obj *loop_body = NULL;
int count = 0;
int callnargs;
CONST84 char **callargs = NULL;
*************** pltcl_SPI_execute_plan(ClientData cdata,
*** 2175,2180 ****
--- 2585,2599 ----
ResourceOwner oldowner = CurrentResourceOwner;
Tcl_HashTable *query_hash;
+ enum options
+ {
+ OPT_ARRAY, OPT_COUNT, OPT_NULLS
+ };
+
+ static CONST84 char *options[] = {
+ "-array", "-count", "-nulls", (char *) NULL
+ };
+
char *usage = "syntax error - 'SPI_execp "
"?-nulls string? ?-count n? "
"?-array name? query ?args? ?loop body?";
*************** pltcl_SPI_execute_plan(ClientData cdata,
*** 2183,2240 ****
* Get the options and check syntax
************************************************************/
i = 1;
! while (i < argc)
{
! if (strcmp(argv[i], "-array") == 0)
{
! if (++i >= argc)
! {
! Tcl_SetResult(interp, usage, TCL_STATIC);
! return TCL_ERROR;
! }
! arrayname = argv[i++];
! continue;
}
! if (strcmp(argv[i], "-nulls") == 0)
{
! if (++i >= argc)
! {
! Tcl_SetResult(interp, usage, TCL_STATIC);
! return TCL_ERROR;
! }
! nulls = argv[i++];
! continue;
}
! if (strcmp(argv[i], "-count") == 0)
{
! if (++i >= argc)
! {
! Tcl_SetResult(interp, usage, TCL_STATIC);
! return TCL_ERROR;
! }
! if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK)
! return TCL_ERROR;
! continue;
! }
! break;
}
/************************************************************
* Get the prepared plan descriptor by its key
************************************************************/
! if (i >= argc)
{
! Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR;
}
query_hash = &pltcl_current_prodesc->interp_desc->query_hash;
! hashent = Tcl_FindHashEntry(query_hash, argv[i]);
if (hashent == NULL)
{
! Tcl_AppendResult(interp, "invalid queryid '", argv[i], "'", NULL);
return TCL_ERROR;
}
qdesc = (pltcl_query_desc *) Tcl_GetHashValue(hashent);
--- 2602,2655 ----
* Get the options and check syntax
************************************************************/
i = 1;
! while (i < objc)
{
! if (Tcl_GetIndexFromObj(interp, objv[i], options, "option",
! TCL_EXACT, &optIndex) != TCL_OK)
{
! return TCL_ERROR;
}
!
! 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;
!
! 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_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);
*************** pltcl_SPI_execute_plan(ClientData cdata,
*** 2260,2266 ****
************************************************************/
if (qdesc->nargs > 0)
{
! if (i >= argc)
{
Tcl_SetResult(interp, "missing argument list", TCL_STATIC);
return TCL_ERROR;
--- 2675,2681 ----
************************************************************/
if (qdesc->nargs > 0)
{
! if (i >= objc)
{
Tcl_SetResult(interp, "missing argument list", TCL_STATIC);
return TCL_ERROR;
*************** pltcl_SPI_execute_plan(ClientData cdata,
*** 2269,2275 ****
/************************************************************
* Split the argument values
************************************************************/
! if (Tcl_SplitList(interp, argv[i++], &callnargs, &callargs) != TCL_OK)
return TCL_ERROR;
/************************************************************
--- 2684,2690 ----
/************************************************************
* Split the argument values
************************************************************/
! if (Tcl_SplitList(interp, Tcl_GetString(objv[i++]), &callnargs, &callargs) != TCL_OK)
return TCL_ERROR;
/************************************************************
*************** pltcl_SPI_execute_plan(ClientData cdata,
*** 2290,2299 ****
/************************************************************
* Get loop body if present
************************************************************/
! if (i < argc)
! loop_body = argv[i++];
! if (i != argc)
{
Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR;
--- 2705,2714 ----
/************************************************************
* Get loop body if present
************************************************************/
! if (i < objc)
! loop_body = objv[i++];
! if (i != objc)
{
Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR;
*************** pltcl_SPI_execute_plan(ClientData cdata,
*** 2373,2385 ****
* be used after insert queries
**********************************************************************/
static int
! pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[])
{
! char buf[64];
!
! snprintf(buf, sizeof(buf), "%u", SPI_lastoid);
! Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_OK;
}
--- 2788,2797 ----
* be used after insert queries
**********************************************************************/
static int
! pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp * interp,
! int objc, Tcl_Obj * const objv[])
{
! Tcl_SetObjResult(interp, Tcl_NewWideIntObj(SPI_lastoid));
return TCL_OK;
}
*************** pltcl_SPI_lastoid(ClientData cdata, Tcl_
*** 2389,2400 ****
* of a given tuple
**********************************************************************/
static void
! pltcl_set_tuple_values(Tcl_Interp *interp, CONST84 char *arrayname,
int tupno, HeapTuple tuple, TupleDesc tupdesc)
{
int i;
char *outputstr;
- char buf[64];
Datum attr;
bool isnull;
--- 2801,2811 ----
* of a given tuple
**********************************************************************/
static void
! pltcl_set_tuple_values(Tcl_Interp * interp, CONST84 char *arrayname,
int tupno, HeapTuple tuple, TupleDesc tupdesc)
{
int i;
char *outputstr;
Datum attr;
bool isnull;
*************** pltcl_set_tuple_values(Tcl_Interp *inter
*** 2419,2426 ****
{
arrptr = &arrayname;
nameptr = &attname;
! snprintf(buf, sizeof(buf), "%d", tupno);
! Tcl_SetVar2(interp, arrayname, ".tupno", buf, 0);
}
for (i = 0; i < tupdesc->natts; i++)
--- 2830,2836 ----
{
arrptr = &arrayname;
nameptr = &attname;
! Tcl_SetVar2Ex(interp, arrayname, ".tupno", Tcl_NewIntObj(tupno), 0);
}
for (i = 0; i < tupdesc->natts; i++)
*************** pltcl_set_tuple_values(Tcl_Interp *inter
*** 2464,2470 ****
{
outputstr = OidOutputFunctionCall(typoutput, attr);
UTF_BEGIN;
! Tcl_SetVar2(interp, *arrptr, *nameptr, UTF_E2U(outputstr), 0);
UTF_END;
pfree(outputstr);
}
--- 2874,2881 ----
{
outputstr = OidOutputFunctionCall(typoutput, attr);
UTF_BEGIN;
! Tcl_SetVar2Ex(interp, *arrptr, *nameptr,
! Tcl_NewStringObj(UTF_E2U(outputstr), -1), 0);
UTF_END;
pfree(outputstr);
}
*************** pltcl_set_tuple_values(Tcl_Interp *inter
*** 2480,2486 ****
**********************************************************************/
static void
pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
! Tcl_DString *retval)
{
int i;
char *outputstr;
--- 2891,2897 ----
**********************************************************************/
static void
pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
! Tcl_Obj * retobj)
{
int i;
char *outputstr;
*************** pltcl_build_tuple_argument(HeapTuple tup
*** 2531,2539 ****
if (!isnull && OidIsValid(typoutput))
{
outputstr = OidOutputFunctionCall(typoutput, attr);
! Tcl_DStringAppendElement(retval, attname);
UTF_BEGIN;
! Tcl_DStringAppendElement(retval, UTF_E2U(outputstr));
UTF_END;
pfree(outputstr);
}
--- 2942,2951 ----
if (!isnull && OidIsValid(typoutput))
{
outputstr = OidOutputFunctionCall(typoutput, attr);
! Tcl_ListObjAppendElement(NULL, retobj,
! Tcl_NewStringObj(attname, -1));
UTF_BEGIN;
! Tcl_ListObjAppendElement(NULL, retobj, Tcl_NewStringObj(UTF_E2U(outputstr), -1));
UTF_END;
pfree(outputstr);
}
Re: Patch to add table function support to PL/Tcl (Todo item)
Excerpts from Karl Lehenbauer's message of mar dic 28 12:33:42 -0300 2010:
Project name: Add table function support to PL/Tcl (Todo item)
What the patch does:
This patch adds table function support (returning record and SETOF record)
to PL/Tcl. This patch also updates PL/Tcl to use the Tcl object-style
interface instead of the older string-style one, increasing performance.
While I don't use PL/Tcl myself, this seems a reasonable idea. However,
I think this patch does too many things in one step. It also contains
numerous superfluous whitespace changes that make it hard to assess its
real size.
I'd recommend splitting it up and dropping the whitespace changes (which
would be reverted by pgindent anyway).
--
Álvaro Herrera <alvherre@commandprompt.com>
The PostgreSQL Company - Command Prompt, Inc.
PostgreSQL Replication, Consulting, Custom Development, 24x7 support
Re: Patch to add table function support to PL/Tcl (Todo item)
Hmm, I ran the code through pgindent so I don't understand why there are whitespace changes.
OK I'll see what the problem is with the whitespace and instead produce two patches, one that converts to using Tcl objects and one on top of that that adds returning records and setof records.
On Dec 28, 2010, at 12:12 PM, Alvaro Herrera wrote:
Show quoted text
Excerpts from Karl Lehenbauer's message of mar dic 28 12:33:42 -0300 2010:
Project name: Add table function support to PL/Tcl (Todo item)
What the patch does:
This patch adds table function support (returning record and SETOF record)
to PL/Tcl. This patch also updates PL/Tcl to use the Tcl object-style
interface instead of the older string-style one, increasing performance.While I don't use PL/Tcl myself, this seems a reasonable idea. However,
I think this patch does too many things in one step. It also contains
numerous superfluous whitespace changes that make it hard to assess its
real size.I'd recommend splitting it up and dropping the whitespace changes (which
would be reverted by pgindent anyway).--
Álvaro Herrera <alvherre@commandprompt.com>
The PostgreSQL Company - Command Prompt, Inc.
PostgreSQL Replication, Consulting, Custom Development, 24x7 support
Revised patches to add table function support to PL/Tcl (TODO item)
In response to Alvaro Herrera's message from today I've split the PL/Tcl table function patch into three separate, easier-to-digest patches. (Thanks for the quick response, Alvaro.)
The first patch, pltcl-karl-try2-1-of-3-pgindent.patch, does nothing but conform HEAD's pltcl.c with pgindent. Applying this patch should have exactly the same effect as running
src/tools/pgindent/pgindent src/tools/pgindent/typedefs.list src/pl/tcl/pltcl.c
The second patch, pltcl-karl-try2-2-of-3-objects.patch, should be applied after the first, and updates PL/Tcl to use the Tcl "Tcl object" C API, the preferred way of interacting with Tcl from C since Tcl 8.0 was released in 1997.
The third patch, pltcl-karl-try2-3-of-3-setof.patch, builds on the above to add both the "return_next" command for returning multiple rows in a SETOF-returning function and to add using "return" with a list of key-value pairs for functions returning a non-SETOF record.
Attachments:
pltcl-karl-try2-1-of-3-pgindent.patchapplication/octet-stream; name=pltcl-karl-try2-1-of-3-pgindent.patchDownload
diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c
index 6e8c5c0..9eaf22b 100644
*** a/src/pl/tcl/pltcl.c
--- b/src/pl/tcl/pltcl.c
*************** PG_MODULE_MAGIC;
*** 95,104 ****
**********************************************************************/
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;
/**********************************************************************
--- 95,104 ----
**********************************************************************/
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;
/**********************************************************************
*************** typedef struct pltcl_proc_desc
*** 118,124 ****
int nargs;
FmgrInfo arg_out_func[FUNC_MAX_ARGS];
bool arg_is_rowtype[FUNC_MAX_ARGS];
! } pltcl_proc_desc;
/**********************************************************************
--- 118,124 ----
int nargs;
FmgrInfo arg_out_func[FUNC_MAX_ARGS];
bool arg_is_rowtype[FUNC_MAX_ARGS];
! } pltcl_proc_desc;
/**********************************************************************
*************** typedef struct pltcl_query_desc
*** 132,138 ****
Oid *argtypes;
FmgrInfo *arginfuncs;
Oid *argtypioparams;
! } pltcl_query_desc;
/**********************************************************************
--- 132,138 ----
Oid *argtypes;
FmgrInfo *arginfuncs;
Oid *argtypioparams;
! } pltcl_query_desc;
/**********************************************************************
*************** typedef struct pltcl_query_desc
*** 148,167 ****
**********************************************************************/
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;
/**********************************************************************
--- 148,167 ----
**********************************************************************/
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;
/**********************************************************************
*************** Datum pltcl_call_handler(PG_FUNCTION_AR
*** 183,191 ****
Datum pltclu_call_handler(PG_FUNCTION_ARGS);
void _PG_init(void);
! static void pltcl_init_interp(pltcl_interp_desc *interp_desc, bool pltrusted);
static pltcl_interp_desc *pltcl_fetch_interp(bool pltrusted);
! static void pltcl_init_load_unknown(Tcl_Interp *interp);
static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted);
--- 183,191 ----
Datum pltclu_call_handler(PG_FUNCTION_ARGS);
void _PG_init(void);
! static void pltcl_init_interp(pltcl_interp_desc * interp_desc, bool pltrusted);
static pltcl_interp_desc *pltcl_fetch_interp(bool pltrusted);
! static void pltcl_init_load_unknown(Tcl_Interp * interp);
static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted);
*************** static Datum pltcl_func_handler(PG_FUNCT
*** 193,231 ****
static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS, 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 pltrusted);
! static int pltcl_elog(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[]);
! static int pltcl_quote(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[]);
! static int pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[]);
! static int pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[]);
! static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[]);
! static int pltcl_process_SPI_result(Tcl_Interp *interp,
CONST84 char *arrayname,
CONST84 char *loop_body,
int spi_rc,
! SPITupleTable *tuptable,
int ntuples);
! static int pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[]);
! static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[]);
! static int pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[]);
! static void pltcl_set_tuple_values(Tcl_Interp *interp, CONST84 char *arrayname,
int tupno, HeapTuple tuple, TupleDesc tupdesc);
static void pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
! Tcl_DString *retval);
/*
--- 193,231 ----
static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS, 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 pltrusted);
! static int pltcl_elog(ClientData cdata, Tcl_Interp * interp,
int argc, CONST84 char *argv[]);
! static int pltcl_quote(ClientData cdata, Tcl_Interp * interp,
int argc, CONST84 char *argv[]);
! static int pltcl_argisnull(ClientData cdata, Tcl_Interp * interp,
int argc, CONST84 char *argv[]);
! static int pltcl_returnnull(ClientData cdata, Tcl_Interp * interp,
int argc, CONST84 char *argv[]);
! static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp * interp,
int argc, CONST84 char *argv[]);
! static int pltcl_process_SPI_result(Tcl_Interp * interp,
CONST84 char *arrayname,
CONST84 char *loop_body,
int spi_rc,
! SPITupleTable * tuptable,
int ntuples);
! static int pltcl_SPI_prepare(ClientData cdata, Tcl_Interp * interp,
int argc, CONST84 char *argv[]);
! static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp * interp,
int argc, CONST84 char *argv[]);
! static int pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp * interp,
int argc, CONST84 char *argv[]);
! static void pltcl_set_tuple_values(Tcl_Interp * interp, CONST84 char *arrayname,
int tupno, HeapTuple tuple, TupleDesc tupdesc);
static void pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
! Tcl_DString * retval);
/*
*************** pltcl_FinalizeNotifier(ClientData client
*** 256,262 ****
}
static void
! pltcl_SetTimer(Tcl_Time *timePtr)
{
}
--- 256,262 ----
}
static void
! pltcl_SetTimer(Tcl_Time * timePtr)
{
}
*************** pltcl_AlertNotifier(ClientData clientDat
*** 267,273 ****
static void
pltcl_CreateFileHandler(int fd, int mask,
! Tcl_FileProc *proc, ClientData clientData)
{
}
--- 267,273 ----
static void
pltcl_CreateFileHandler(int fd, int mask,
! Tcl_FileProc * proc, ClientData clientData)
{
}
*************** pltcl_ServiceModeHook(int mode)
*** 282,288 ****
}
static int
! pltcl_WaitForEvent(Tcl_Time *timePtr)
{
return 0;
}
--- 282,288 ----
}
static int
! pltcl_WaitForEvent(Tcl_Time * timePtr)
{
return 0;
}
*************** _PG_init(void)
*** 390,396 ****
* pltcl_init_interp() - initialize a new Tcl interpreter
**********************************************************************/
static void
! pltcl_init_interp(pltcl_interp_desc *interp_desc, bool pltrusted)
{
Tcl_Interp *interp;
char interpname[32];
--- 390,396 ----
* pltcl_init_interp() - initialize a new Tcl interpreter
**********************************************************************/
static void
! pltcl_init_interp(pltcl_interp_desc * interp_desc, bool pltrusted)
{
Tcl_Interp *interp;
char interpname[32];
*************** pltcl_fetch_interp(bool pltrusted)
*** 471,477 ****
* table pltcl_modules (if it exists)
**********************************************************************/
static void
! pltcl_init_load_unknown(Tcl_Interp *interp)
{
Relation pmrel;
char *pmrelname,
--- 471,477 ----
* table pltcl_modules (if it exists)
**********************************************************************/
static void
! pltcl_init_load_unknown(Tcl_Interp * interp)
{
Relation pmrel;
char *pmrelname,
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 1126,1132 ****
* 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
--- 1126,1132 ----
* 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
*************** compile_pltcl_function(Oid fn_oid, Oid t
*** 1495,1501 ****
* pltcl_elog() - elog() support for PLTcl
**********************************************************************/
static int
! pltcl_elog(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[])
{
volatile int level;
--- 1495,1501 ----
* pltcl_elog() - elog() support for PLTcl
**********************************************************************/
static int
! pltcl_elog(ClientData cdata, Tcl_Interp * interp,
int argc, CONST84 char *argv[])
{
volatile int level;
*************** pltcl_elog(ClientData cdata, Tcl_Interp
*** 1583,1589 ****
* be used in SPI_execute query strings
**********************************************************************/
static int
! pltcl_quote(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[])
{
char *tmp;
--- 1583,1589 ----
* be used in SPI_execute query strings
**********************************************************************/
static int
! pltcl_quote(ClientData cdata, Tcl_Interp * interp,
int argc, CONST84 char *argv[])
{
char *tmp;
*************** pltcl_quote(ClientData cdata, Tcl_Interp
*** 1636,1642 ****
* pltcl_argisnull() - determine if a specific argument is NULL
**********************************************************************/
static int
! pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[])
{
int argno;
--- 1636,1642 ----
* pltcl_argisnull() - determine if a specific argument is NULL
**********************************************************************/
static int
! pltcl_argisnull(ClientData cdata, Tcl_Interp * interp,
int argc, CONST84 char *argv[])
{
int argno;
*************** pltcl_argisnull(ClientData cdata, Tcl_In
*** 1694,1700 ****
* pltcl_returnnull() - Cause a NULL return from a function
**********************************************************************/
static int
! pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[])
{
FunctionCallInfo fcinfo = pltcl_current_fcinfo;
--- 1694,1700 ----
* pltcl_returnnull() - Cause a NULL return from a function
**********************************************************************/
static int
! pltcl_returnnull(ClientData cdata, Tcl_Interp * interp,
int argc, CONST84 char *argv[])
{
FunctionCallInfo fcinfo = pltcl_current_fcinfo;
*************** pltcl_subtrans_commit(MemoryContext oldc
*** 1777,1783 ****
}
static void
! pltcl_subtrans_abort(Tcl_Interp *interp,
MemoryContext oldcontext, ResourceOwner oldowner)
{
ErrorData *edata;
--- 1777,1783 ----
}
static void
! pltcl_subtrans_abort(Tcl_Interp * interp,
MemoryContext oldcontext, ResourceOwner oldowner)
{
ErrorData *edata;
*************** pltcl_subtrans_abort(Tcl_Interp *interp,
*** 1812,1818 ****
* for the Tcl interpreter
**********************************************************************/
static int
! pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[])
{
int my_rc;
--- 1812,1818 ----
* for the Tcl interpreter
**********************************************************************/
static int
! pltcl_SPI_execute(ClientData cdata, Tcl_Interp * interp,
int argc, CONST84 char *argv[])
{
int my_rc;
*************** pltcl_SPI_execute(ClientData cdata, Tcl_
*** 1915,1925 ****
* Shared code between pltcl_SPI_execute and pltcl_SPI_execute_plan
*/
static int
! pltcl_process_SPI_result(Tcl_Interp *interp,
CONST84 char *arrayname,
CONST84 char *loop_body,
int spi_rc,
! SPITupleTable *tuptable,
int ntuples)
{
int my_rc = TCL_OK;
--- 1915,1925 ----
* Shared code between pltcl_SPI_execute and pltcl_SPI_execute_plan
*/
static int
! pltcl_process_SPI_result(Tcl_Interp * interp,
CONST84 char *arrayname,
CONST84 char *loop_body,
int spi_rc,
! SPITupleTable * tuptable,
int ntuples)
{
int my_rc = TCL_OK;
*************** pltcl_process_SPI_result(Tcl_Interp *int
*** 2027,2033 ****
* and not save the plan currently.
**********************************************************************/
static int
! pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[])
{
int nargs;
--- 2027,2033 ----
* and not save the plan currently.
**********************************************************************/
static int
! pltcl_SPI_prepare(ClientData cdata, Tcl_Interp * interp,
int argc, CONST84 char *argv[])
{
int nargs;
*************** pltcl_SPI_prepare(ClientData cdata, Tcl_
*** 2155,2161 ****
* pltcl_SPI_execute_plan() - Execute a prepared plan
**********************************************************************/
static int
! pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[])
{
int my_rc;
--- 2155,2161 ----
* pltcl_SPI_execute_plan() - Execute a prepared plan
**********************************************************************/
static int
! pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp * interp,
int argc, CONST84 char *argv[])
{
int my_rc;
*************** pltcl_SPI_execute_plan(ClientData cdata,
*** 2373,2379 ****
* be used after insert queries
**********************************************************************/
static int
! pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[])
{
char buf[64];
--- 2373,2379 ----
* be used after insert queries
**********************************************************************/
static int
! pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp * interp,
int argc, CONST84 char *argv[])
{
char buf[64];
*************** pltcl_SPI_lastoid(ClientData cdata, Tcl_
*** 2389,2395 ****
* of a given tuple
**********************************************************************/
static void
! pltcl_set_tuple_values(Tcl_Interp *interp, CONST84 char *arrayname,
int tupno, HeapTuple tuple, TupleDesc tupdesc)
{
int i;
--- 2389,2395 ----
* of a given tuple
**********************************************************************/
static void
! pltcl_set_tuple_values(Tcl_Interp * interp, CONST84 char *arrayname,
int tupno, HeapTuple tuple, TupleDesc tupdesc)
{
int i;
*************** pltcl_set_tuple_values(Tcl_Interp *inter
*** 2480,2486 ****
**********************************************************************/
static void
pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
! Tcl_DString *retval)
{
int i;
char *outputstr;
--- 2480,2486 ----
**********************************************************************/
static void
pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
! Tcl_DString * retval)
{
int i;
char *outputstr;
pltcl-karl-try2-2-of-3-objects.patchapplication/octet-stream; name=pltcl-karl-try2-2-of-3-objects.patchDownload
diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c
index 9eaf22b..06e7acd 100644
*** a/src/pl/tcl/pltcl.c
--- b/src/pl/tcl/pltcl.c
*************** static pltcl_proc_desc *compile_pltcl_fu
*** 199,226 ****
bool pltrusted);
static int pltcl_elog(ClientData cdata, Tcl_Interp * interp,
! int argc, CONST84 char *argv[]);
static int pltcl_quote(ClientData cdata, Tcl_Interp * interp,
! int argc, CONST84 char *argv[]);
static int pltcl_argisnull(ClientData cdata, Tcl_Interp * interp,
! int argc, CONST84 char *argv[]);
static int pltcl_returnnull(ClientData cdata, Tcl_Interp * interp,
! int argc, CONST84 char *argv[]);
static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp * interp,
! int argc, CONST84 char *argv[]);
static int pltcl_process_SPI_result(Tcl_Interp * interp,
CONST84 char *arrayname,
! CONST84 char *loop_body,
int spi_rc,
SPITupleTable * tuptable,
int ntuples);
static int pltcl_SPI_prepare(ClientData cdata, Tcl_Interp * interp,
! int argc, CONST84 char *argv[]);
static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp * interp,
! int argc, CONST84 char *argv[]);
static int pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp * interp,
! int argc, CONST84 char *argv[]);
static void pltcl_set_tuple_values(Tcl_Interp * interp, CONST84 char *arrayname,
int tupno, HeapTuple tuple, TupleDesc tupdesc);
--- 199,226 ----
bool pltrusted);
static int pltcl_elog(ClientData cdata, Tcl_Interp * interp,
! int objc, Tcl_Obj * const objv[]);
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_SPI_execute(ClientData cdata, Tcl_Interp * interp,
! int objc, Tcl_Obj * const objv[]);
static int pltcl_process_SPI_result(Tcl_Interp * interp,
CONST84 char *arrayname,
! Tcl_Obj * loop_body,
int spi_rc,
SPITupleTable * tuptable,
int 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_SPI_lastoid(ClientData cdata, Tcl_Interp * interp,
! int objc, Tcl_Obj * const objv[]);
static void pltcl_set_tuple_values(Tcl_Interp * interp, CONST84 char *arrayname,
int tupno, HeapTuple tuple, TupleDesc tupdesc);
*************** pltcl_init_interp(pltcl_interp_desc * in
*** 414,436 ****
/************************************************************
* Install the commands for SPI support in the interpreter
************************************************************/
! Tcl_CreateCommand(interp, "elog",
! pltcl_elog, NULL, NULL);
! Tcl_CreateCommand(interp, "quote",
! pltcl_quote, NULL, NULL);
! Tcl_CreateCommand(interp, "argisnull",
! pltcl_argisnull, NULL, NULL);
! Tcl_CreateCommand(interp, "return_null",
! pltcl_returnnull, NULL, NULL);
! Tcl_CreateCommand(interp, "spi_exec",
! pltcl_SPI_execute, NULL, NULL);
! Tcl_CreateCommand(interp, "spi_prepare",
! pltcl_SPI_prepare, NULL, NULL);
! Tcl_CreateCommand(interp, "spi_execp",
! pltcl_SPI_execute_plan, NULL, NULL);
! Tcl_CreateCommand(interp, "spi_lastoid",
! pltcl_SPI_lastoid, NULL, NULL);
/************************************************************
* Try to load the unknown procedure from pltcl_modules
--- 414,436 ----
/************************************************************
* 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, "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, "spi_lastoid",
! pltcl_SPI_lastoid, NULL, NULL);
/************************************************************
* Try to load the unknown procedure from pltcl_modules
*************** compile_pltcl_function(Oid fn_oid, Oid t
*** 1496,1533 ****
**********************************************************************/
static int
pltcl_elog(ClientData cdata, Tcl_Interp * interp,
! int argc, CONST84 char *argv[])
{
volatile int level;
MemoryContext oldcontext;
! if (argc != 3)
{
! Tcl_SetResult(interp, "syntax error - 'elog level msg'", TCL_STATIC);
return TCL_ERROR;
}
! if (strcmp(argv[1], "DEBUG") == 0)
! level = DEBUG2;
! else if (strcmp(argv[1], "LOG") == 0)
! level = LOG;
! else if (strcmp(argv[1], "INFO") == 0)
! level = INFO;
! else if (strcmp(argv[1], "NOTICE") == 0)
! level = NOTICE;
! else if (strcmp(argv[1], "WARNING") == 0)
! level = WARNING;
! else if (strcmp(argv[1], "ERROR") == 0)
! level = ERROR;
! else if (strcmp(argv[1], "FATAL") == 0)
! level = FATAL;
! else
{
- Tcl_AppendResult(interp, "Unknown elog level '", argv[1],
- "'", NULL);
return TCL_ERROR;
}
if (level == ERROR)
{
/*
--- 1496,1561 ----
**********************************************************************/
static int
pltcl_elog(ClientData cdata, Tcl_Interp * interp,
! int objc, Tcl_Obj * const objv[])
{
volatile int level;
MemoryContext oldcontext;
+ int priIndex;
! enum logpriority
{
! LOG_DEBUG, LOG_LOG, LOG_INFO, LOG_NOTICE,
! LOG_WARNING, LOG_ERROR, LOG_FATAL
! };
!
! static CONST84 char *logpriorities[] = {
! "DEBUG", "LOG", "INFO", "NOTICE",
! "WARNING", "ERROR", "FATAL", (char *) NULL
! };
!
! 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;
}
+ switch ((enum logpriority) priIndex)
+ {
+ case LOG_DEBUG:
+ level = DEBUG2;
+ break;
+
+ case LOG_LOG:
+ level = LOG;
+ break;
+
+ case LOG_INFO:
+ level = INFO;
+ break;
+
+ case LOG_NOTICE:
+ level = NOTICE;
+ break;
+
+ case LOG_WARNING:
+ level = WARNING;
+ break;
+
+ case LOG_ERROR:
+ level = ERROR;
+ break;
+
+ case LOG_FATAL:
+ level = FATAL;
+ break;
+ }
+
if (level == ERROR)
{
/*
*************** pltcl_elog(ClientData cdata, Tcl_Interp
*** 1535,1541 ****
* eventually get converted to a PG error when we reach the call
* handler.
*/
! Tcl_SetResult(interp, (char *) argv[2], TCL_VOLATILE);
return TCL_ERROR;
}
--- 1563,1569 ----
* eventually get converted to a PG error when we reach the call
* handler.
*/
! Tcl_SetObjResult(interp, objv[2]);
return TCL_ERROR;
}
*************** pltcl_elog(ClientData cdata, Tcl_Interp
*** 1552,1558 ****
PG_TRY();
{
UTF_BEGIN;
! elog(level, "%s", UTF_U2E(argv[2]));
UTF_END;
}
PG_CATCH();
--- 1580,1586 ----
PG_TRY();
{
UTF_BEGIN;
! elog(level, "%s", UTF_U2E(Tcl_GetString(objv[2])));
UTF_END;
}
PG_CATCH();
*************** pltcl_elog(ClientData cdata, Tcl_Interp
*** 1566,1572 ****
/* Pass the error message to Tcl */
UTF_BEGIN;
! Tcl_SetResult(interp, UTF_E2U(edata->message), TCL_VOLATILE);
UTF_END;
FreeErrorData(edata);
--- 1594,1600 ----
/* Pass the error message to Tcl */
UTF_BEGIN;
! Tcl_SetObjResult(interp, Tcl_NewStringObj(UTF_E2U(edata->message), -1));
UTF_END;
FreeErrorData(edata);
*************** pltcl_elog(ClientData cdata, Tcl_Interp
*** 1584,1590 ****
**********************************************************************/
static int
pltcl_quote(ClientData cdata, Tcl_Interp * interp,
! int argc, CONST84 char *argv[])
{
char *tmp;
const char *cp1;
--- 1612,1618 ----
**********************************************************************/
static int
pltcl_quote(ClientData cdata, Tcl_Interp * interp,
! int objc, Tcl_Obj * const objv[])
{
char *tmp;
const char *cp1;
*************** pltcl_quote(ClientData cdata, Tcl_Interp
*** 1593,1601 ****
/************************************************************
* Check call syntax
************************************************************/
! if (argc != 2)
{
! Tcl_SetResult(interp, "syntax error - 'quote string'", TCL_STATIC);
return TCL_ERROR;
}
--- 1621,1629 ----
/************************************************************
* Check call syntax
************************************************************/
! if (objc != 2)
{
! Tcl_WrongNumArgs(interp, 1, objv, "string");
return TCL_ERROR;
}
*************** pltcl_quote(ClientData cdata, Tcl_Interp
*** 1603,1610 ****
* Allocate space for the maximum the string can
* grow to and initialize pointers
************************************************************/
! tmp = palloc(strlen(argv[1]) * 2 + 1);
! cp1 = argv[1];
cp2 = tmp;
/************************************************************
--- 1631,1638 ----
* Allocate space for the maximum the string can
* grow to and initialize pointers
************************************************************/
! tmp = palloc(strlen(Tcl_GetString(objv[1])) * 2 + 1);
! cp1 = Tcl_GetString(objv[1]);
cp2 = tmp;
/************************************************************
*************** pltcl_quote(ClientData cdata, Tcl_Interp
*** 1626,1632 ****
* Terminate the string and set it as result
************************************************************/
*cp2 = '\0';
! Tcl_SetResult(interp, tmp, TCL_VOLATILE);
pfree(tmp);
return TCL_OK;
}
--- 1654,1660 ----
* Terminate the string and set it as result
************************************************************/
*cp2 = '\0';
! Tcl_SetObjResult(interp, Tcl_NewStringObj(tmp, -1));
pfree(tmp);
return TCL_OK;
}
*************** pltcl_quote(ClientData cdata, Tcl_Interp
*** 1637,1643 ****
**********************************************************************/
static int
pltcl_argisnull(ClientData cdata, Tcl_Interp * interp,
! int argc, CONST84 char *argv[])
{
int argno;
FunctionCallInfo fcinfo = pltcl_current_fcinfo;
--- 1665,1671 ----
**********************************************************************/
static int
pltcl_argisnull(ClientData cdata, Tcl_Interp * interp,
! int objc, Tcl_Obj * const objv[])
{
int argno;
FunctionCallInfo fcinfo = pltcl_current_fcinfo;
*************** pltcl_argisnull(ClientData cdata, Tcl_In
*** 1645,1654 ****
/************************************************************
* Check call syntax
************************************************************/
! if (argc != 2)
{
! Tcl_SetResult(interp, "syntax error - 'argisnull argno'",
! TCL_STATIC);
return TCL_ERROR;
}
--- 1673,1681 ----
/************************************************************
* Check call syntax
************************************************************/
! if (objc != 2)
{
! Tcl_WrongNumArgs(interp, 1, objv, "argno");
return TCL_ERROR;
}
*************** pltcl_argisnull(ClientData cdata, Tcl_In
*** 1657,1671 ****
************************************************************/
if (fcinfo == NULL)
{
! Tcl_SetResult(interp, "argisnull cannot be used in triggers",
! TCL_STATIC);
return TCL_ERROR;
}
/************************************************************
* Get the argument number
************************************************************/
! if (Tcl_GetInt(interp, argv[1], &argno) != TCL_OK)
return TCL_ERROR;
/************************************************************
--- 1684,1698 ----
************************************************************/
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;
/************************************************************
*************** pltcl_argisnull(ClientData cdata, Tcl_In
*** 1674,1691 ****
argno--;
if (argno < 0 || argno >= fcinfo->nargs)
{
! Tcl_SetResult(interp, "argno out of range", TCL_STATIC);
return TCL_ERROR;
}
/************************************************************
* Get the requested NULL state
************************************************************/
! if (PG_ARGISNULL(argno))
! Tcl_SetResult(interp, "1", TCL_STATIC);
! else
! Tcl_SetResult(interp, "0", TCL_STATIC);
!
return TCL_OK;
}
--- 1701,1715 ----
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_argisnull(ClientData cdata, Tcl_In
*** 1695,1710 ****
**********************************************************************/
static int
pltcl_returnnull(ClientData cdata, Tcl_Interp * interp,
! int argc, CONST84 char *argv[])
{
FunctionCallInfo fcinfo = pltcl_current_fcinfo;
/************************************************************
* Check call syntax
************************************************************/
! if (argc != 1)
{
! Tcl_SetResult(interp, "syntax error - 'return_null'", TCL_STATIC);
return TCL_ERROR;
}
--- 1719,1734 ----
**********************************************************************/
static int
pltcl_returnnull(ClientData cdata, Tcl_Interp * interp,
! int objc, Tcl_Obj * const objv[])
{
FunctionCallInfo fcinfo = pltcl_current_fcinfo;
/************************************************************
* Check call syntax
************************************************************/
! if (objc != 1)
{
! Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
}
*************** pltcl_returnnull(ClientData cdata, Tcl_I
*** 1713,1720 ****
************************************************************/
if (fcinfo == NULL)
{
! Tcl_SetResult(interp, "return_null cannot be used in triggers",
! TCL_STATIC);
return TCL_ERROR;
}
--- 1737,1744 ----
************************************************************/
if (fcinfo == NULL)
{
! Tcl_SetObjResult(interp,
! Tcl_NewStringObj("return_null cannot be used in triggers", -1));
return TCL_ERROR;
}
*************** pltcl_subtrans_abort(Tcl_Interp * interp
*** 1813,1830 ****
**********************************************************************/
static int
pltcl_SPI_execute(ClientData cdata, Tcl_Interp * interp,
! int argc, CONST84 char *argv[])
{
int my_rc;
int spi_rc;
int query_idx;
int i;
int count = 0;
CONST84 char *volatile arrayname = NULL;
! CONST84 char *volatile loop_body = NULL;
MemoryContext oldcontext = CurrentMemoryContext;
ResourceOwner oldowner = CurrentResourceOwner;
char *usage = "syntax error - 'SPI_exec "
"?-count n? "
"?-array name? query ?loop body?";
--- 1837,1864 ----
**********************************************************************/
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;
CONST84 char *volatile arrayname = NULL;
! Tcl_Obj *loop_body = NULL;
MemoryContext oldcontext = CurrentMemoryContext;
ResourceOwner oldowner = CurrentResourceOwner;
+ enum options
+ {
+ OPT_ARRAY, OPT_COUNT
+ };
+
+ static CONST84 char *options[] = {
+ "-array", "-count", (char *) NULL
+ };
+
char *usage = "syntax error - 'SPI_exec "
"?-count n? "
"?-array name? query ?loop body?";
*************** pltcl_SPI_execute(ClientData cdata, Tcl_
*** 1832,1880 ****
/************************************************************
* Check the call syntax and get the options
************************************************************/
! if (argc < 2)
{
Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR;
}
i = 1;
! while (i < argc)
{
! if (strcmp(argv[i], "-array") == 0)
{
! if (++i >= argc)
! {
! Tcl_SetResult(interp, usage, TCL_STATIC);
! return TCL_ERROR;
! }
! arrayname = argv[i++];
! continue;
}
! if (strcmp(argv[i], "-count") == 0)
{
! if (++i >= argc)
! {
! Tcl_SetResult(interp, usage, TCL_STATIC);
! return TCL_ERROR;
! }
! if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK)
! return TCL_ERROR;
! continue;
}
! break;
}
query_idx = i;
! if (query_idx >= argc || query_idx + 2 < argc)
{
Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR;
}
! if (query_idx + 1 < argc)
! loop_body = argv[query_idx + 1];
/************************************************************
* Execute the query inside a sub-transaction, so we can cope with
--- 1866,1918 ----
/************************************************************
* Check the call syntax and get the options
************************************************************/
! if (objc < 2)
{
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?-count n? ?-array name? query ?loop body?");
Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR;
}
i = 1;
! while (i < objc)
{
! if (Tcl_GetIndexFromObj(interp, objv[i], options, "option",
! TCL_EXACT, &optIndex) != TCL_OK)
{
! return TCL_ERROR;
}
! 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_SetResult(interp, usage, TCL_STATIC);
+ 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
*************** pltcl_SPI_execute(ClientData cdata, Tcl_
*** 1886,1892 ****
PG_TRY();
{
UTF_BEGIN;
! spi_rc = SPI_execute(UTF_U2E(argv[query_idx]),
pltcl_current_prodesc->fn_readonly, count);
UTF_END;
--- 1924,1930 ----
PG_TRY();
{
UTF_BEGIN;
! spi_rc = SPI_execute(UTF_U2E(Tcl_GetString(objv[query_idx])),
pltcl_current_prodesc->fn_readonly, count);
UTF_END;
*************** pltcl_SPI_execute(ClientData cdata, Tcl_
*** 1917,1929 ****
static int
pltcl_process_SPI_result(Tcl_Interp * interp,
CONST84 char *arrayname,
! CONST84 char *loop_body,
int spi_rc,
SPITupleTable * tuptable,
int ntuples)
{
int my_rc = TCL_OK;
- char buf[64];
int i;
int loop_rc;
HeapTuple *tuples;
--- 1955,1966 ----
static int
pltcl_process_SPI_result(Tcl_Interp * interp,
CONST84 char *arrayname,
! Tcl_Obj * loop_body,
int spi_rc,
SPITupleTable * tuptable,
int ntuples)
{
int my_rc = TCL_OK;
int i;
int loop_rc;
HeapTuple *tuples;
*************** pltcl_process_SPI_result(Tcl_Interp * in
*** 1935,1949 ****
case SPI_OK_INSERT:
case SPI_OK_DELETE:
case SPI_OK_UPDATE:
! snprintf(buf, sizeof(buf), "%d", ntuples);
! Tcl_SetResult(interp, buf, TCL_VOLATILE);
break;
case SPI_OK_UTILITY:
case SPI_OK_REWRITTEN:
if (tuptable == NULL)
{
! Tcl_SetResult(interp, "0", TCL_STATIC);
break;
}
/* FALL THRU for utility returning tuples */
--- 1972,1985 ----
case SPI_OK_INSERT:
case SPI_OK_DELETE:
case SPI_OK_UPDATE:
! Tcl_SetObjResult(interp, Tcl_NewIntObj(ntuples));
break;
case SPI_OK_UTILITY:
case SPI_OK_REWRITTEN:
if (tuptable == NULL)
{
! Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
break;
}
/* FALL THRU for utility returning tuples */
*************** pltcl_process_SPI_result(Tcl_Interp * in
*** 1980,1986 ****
pltcl_set_tuple_values(interp, arrayname, i,
tuples[i], tupdesc);
! loop_rc = Tcl_Eval(interp, loop_body);
if (loop_rc == TCL_OK)
continue;
--- 2016,2022 ----
pltcl_set_tuple_values(interp, arrayname, i,
tuples[i], tupdesc);
! loop_rc = Tcl_EvalObjEx(interp, loop_body, 0);
if (loop_rc == TCL_OK)
continue;
*************** pltcl_process_SPI_result(Tcl_Interp * in
*** 2000,2007 ****
if (my_rc == TCL_OK)
{
! snprintf(buf, sizeof(buf), "%d", ntuples);
! Tcl_SetResult(interp, buf, TCL_VOLATILE);
}
break;
--- 2036,2042 ----
if (my_rc == TCL_OK)
{
! Tcl_SetObjResult(interp, Tcl_NewIntObj(ntuples));
}
break;
*************** pltcl_process_SPI_result(Tcl_Interp * in
*** 2028,2037 ****
**********************************************************************/
static int
pltcl_SPI_prepare(ClientData cdata, Tcl_Interp * interp,
! int argc, CONST84 char *argv[])
{
int nargs;
! CONST84 char **args;
pltcl_query_desc *qdesc;
void *plan;
int i;
--- 2063,2072 ----
**********************************************************************/
static int
pltcl_SPI_prepare(ClientData cdata, Tcl_Interp * interp,
! int objc, Tcl_Obj * const objv[])
{
int nargs;
! Tcl_Obj **argsObj;
pltcl_query_desc *qdesc;
void *plan;
int i;
*************** pltcl_SPI_prepare(ClientData cdata, Tcl_
*** 2044,2060 ****
/************************************************************
* Check the call syntax
************************************************************/
! if (argc != 3)
{
! Tcl_SetResult(interp, "syntax error - 'SPI_prepare query argtypes'",
! TCL_STATIC);
return TCL_ERROR;
}
/************************************************************
* Split the argument type list
************************************************************/
! if (Tcl_SplitList(interp, argv[2], &nargs, &args) != TCL_OK)
return TCL_ERROR;
/************************************************************
--- 2079,2094 ----
/************************************************************
* 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;
/************************************************************
*************** pltcl_SPI_prepare(ClientData cdata, Tcl_
*** 2088,2094 ****
typIOParam;
int32 typmod;
! parseTypeString(args[i], &typId, &typmod);
getTypeInputInfo(typId, &typInput, &typIOParam);
--- 2122,2128 ----
typIOParam;
int32 typmod;
! parseTypeString(Tcl_GetString(argsObj[i]), &typId, &typmod);
getTypeInputInfo(typId, &typInput, &typIOParam);
*************** pltcl_SPI_prepare(ClientData cdata, Tcl_
*** 2101,2107 ****
* Prepare the plan and check for errors
************************************************************/
UTF_BEGIN;
! plan = SPI_prepare(UTF_U2E(argv[1]), nargs, qdesc->argtypes);
UTF_END;
if (plan == NULL)
--- 2135,2141 ----
* Prepare the plan and check for errors
************************************************************/
UTF_BEGIN;
! plan = SPI_prepare(UTF_U2E(Tcl_GetString(argsObj[1])), nargs, qdesc->argtypes);
UTF_END;
if (plan == NULL)
*************** pltcl_SPI_prepare(ClientData cdata, Tcl_
*** 2128,2134 ****
free(qdesc->arginfuncs);
free(qdesc->argtypioparams);
free(qdesc);
! ckfree((char *) args);
return TCL_ERROR;
}
--- 2162,2168 ----
free(qdesc->arginfuncs);
free(qdesc->argtypioparams);
free(qdesc);
! /* ckfree((char *) args); */
return TCL_ERROR;
}
*************** pltcl_SPI_prepare(ClientData cdata, Tcl_
*** 2143,2152 ****
hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew);
Tcl_SetHashValue(hashent, (ClientData) qdesc);
! ckfree((char *) args);
/* qname is ASCII, so no need for encoding conversion */
! Tcl_SetResult(interp, qdesc->qname, TCL_VOLATILE);
return TCL_OK;
}
--- 2177,2186 ----
hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew);
Tcl_SetHashValue(hashent, (ClientData) qdesc);
! /* ckfree((char *) args); */
/* qname is ASCII, so no need for encoding conversion */
! Tcl_SetObjResult(interp, Tcl_NewStringObj(qdesc->qname, -1));
return TCL_OK;
}
*************** pltcl_SPI_prepare(ClientData cdata, Tcl_
*** 2156,2172 ****
**********************************************************************/
static int
pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp * interp,
! int argc, CONST84 char *argv[])
{
int my_rc;
int spi_rc;
int i;
int j;
Tcl_HashEntry *hashent;
pltcl_query_desc *qdesc;
const char *volatile nulls = NULL;
CONST84 char *volatile arrayname = NULL;
! CONST84 char *volatile loop_body = NULL;
int count = 0;
int callnargs;
CONST84 char **callargs = NULL;
--- 2190,2207 ----
**********************************************************************/
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 *volatile nulls = NULL;
CONST84 char *volatile arrayname = NULL;
! Tcl_Obj *loop_body = NULL;
int count = 0;
int callnargs;
CONST84 char **callargs = NULL;
*************** pltcl_SPI_execute_plan(ClientData cdata,
*** 2175,2180 ****
--- 2210,2224 ----
ResourceOwner oldowner = CurrentResourceOwner;
Tcl_HashTable *query_hash;
+ enum options
+ {
+ OPT_ARRAY, OPT_COUNT, OPT_NULLS
+ };
+
+ static CONST84 char *options[] = {
+ "-array", "-count", "-nulls", (char *) NULL
+ };
+
char *usage = "syntax error - 'SPI_execp "
"?-nulls string? ?-count n? "
"?-array name? query ?args? ?loop body?";
*************** pltcl_SPI_execute_plan(ClientData cdata,
*** 2183,2240 ****
* Get the options and check syntax
************************************************************/
i = 1;
! while (i < argc)
{
! if (strcmp(argv[i], "-array") == 0)
{
! if (++i >= argc)
! {
! Tcl_SetResult(interp, usage, TCL_STATIC);
! return TCL_ERROR;
! }
! arrayname = argv[i++];
! continue;
}
! if (strcmp(argv[i], "-nulls") == 0)
{
! if (++i >= argc)
! {
! Tcl_SetResult(interp, usage, TCL_STATIC);
! return TCL_ERROR;
! }
! nulls = argv[i++];
! continue;
}
! if (strcmp(argv[i], "-count") == 0)
{
! if (++i >= argc)
! {
! Tcl_SetResult(interp, usage, TCL_STATIC);
! return TCL_ERROR;
! }
! if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK)
! return TCL_ERROR;
! continue;
! }
! break;
}
/************************************************************
* Get the prepared plan descriptor by its key
************************************************************/
! if (i >= argc)
{
! Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR;
}
query_hash = &pltcl_current_prodesc->interp_desc->query_hash;
! hashent = Tcl_FindHashEntry(query_hash, argv[i]);
if (hashent == NULL)
{
! Tcl_AppendResult(interp, "invalid queryid '", argv[i], "'", NULL);
return TCL_ERROR;
}
qdesc = (pltcl_query_desc *) Tcl_GetHashValue(hashent);
--- 2227,2280 ----
* Get the options and check syntax
************************************************************/
i = 1;
! while (i < objc)
{
! if (Tcl_GetIndexFromObj(interp, objv[i], options, "option",
! TCL_EXACT, &optIndex) != TCL_OK)
{
! return TCL_ERROR;
}
!
! 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;
!
! 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_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);
*************** pltcl_SPI_execute_plan(ClientData cdata,
*** 2260,2266 ****
************************************************************/
if (qdesc->nargs > 0)
{
! if (i >= argc)
{
Tcl_SetResult(interp, "missing argument list", TCL_STATIC);
return TCL_ERROR;
--- 2300,2306 ----
************************************************************/
if (qdesc->nargs > 0)
{
! if (i >= objc)
{
Tcl_SetResult(interp, "missing argument list", TCL_STATIC);
return TCL_ERROR;
*************** pltcl_SPI_execute_plan(ClientData cdata,
*** 2269,2275 ****
/************************************************************
* Split the argument values
************************************************************/
! if (Tcl_SplitList(interp, argv[i++], &callnargs, &callargs) != TCL_OK)
return TCL_ERROR;
/************************************************************
--- 2309,2315 ----
/************************************************************
* Split the argument values
************************************************************/
! if (Tcl_SplitList(interp, Tcl_GetString(objv[i++]), &callnargs, &callargs) != TCL_OK)
return TCL_ERROR;
/************************************************************
*************** pltcl_SPI_execute_plan(ClientData cdata,
*** 2290,2299 ****
/************************************************************
* Get loop body if present
************************************************************/
! if (i < argc)
! loop_body = argv[i++];
! if (i != argc)
{
Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR;
--- 2330,2339 ----
/************************************************************
* Get loop body if present
************************************************************/
! if (i < objc)
! loop_body = objv[i++];
! if (i != objc)
{
Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR;
*************** pltcl_SPI_execute_plan(ClientData cdata,
*** 2374,2385 ****
**********************************************************************/
static int
pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp * interp,
! int argc, CONST84 char *argv[])
{
! char buf[64];
!
! snprintf(buf, sizeof(buf), "%u", SPI_lastoid);
! Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_OK;
}
--- 2414,2422 ----
**********************************************************************/
static int
pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp * interp,
! int objc, Tcl_Obj * const objv[])
{
! Tcl_SetObjResult(interp, Tcl_NewWideIntObj(SPI_lastoid));
return TCL_OK;
}
*************** pltcl_set_tuple_values(Tcl_Interp * inte
*** 2394,2400 ****
{
int i;
char *outputstr;
- char buf[64];
Datum attr;
bool isnull;
--- 2431,2436 ----
*************** pltcl_set_tuple_values(Tcl_Interp * inte
*** 2419,2426 ****
{
arrptr = &arrayname;
nameptr = &attname;
! snprintf(buf, sizeof(buf), "%d", tupno);
! Tcl_SetVar2(interp, arrayname, ".tupno", buf, 0);
}
for (i = 0; i < tupdesc->natts; i++)
--- 2455,2461 ----
{
arrptr = &arrayname;
nameptr = &attname;
! Tcl_SetVar2Ex(interp, arrayname, ".tupno", Tcl_NewIntObj(tupno), 0);
}
for (i = 0; i < tupdesc->natts; i++)
*************** pltcl_set_tuple_values(Tcl_Interp * inte
*** 2464,2470 ****
{
outputstr = OidOutputFunctionCall(typoutput, attr);
UTF_BEGIN;
! Tcl_SetVar2(interp, *arrptr, *nameptr, UTF_E2U(outputstr), 0);
UTF_END;
pfree(outputstr);
}
--- 2499,2506 ----
{
outputstr = OidOutputFunctionCall(typoutput, attr);
UTF_BEGIN;
! Tcl_SetVar2Ex(interp, *arrptr, *nameptr,
! Tcl_NewStringObj(UTF_E2U(outputstr), -1), 0);
UTF_END;
pfree(outputstr);
}
pltcl-karl-try2-3-of-3-setof.patchapplication/octet-stream; name=pltcl-karl-try2-3-of-3-setof.patchDownload
diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c
index 06e7acd..68d6c77 100644
*** a/src/pl/tcl/pltcl.c
--- b/src/pl/tcl/pltcl.c
***************
*** 33,49 ****
#include "utils/memutils.h"
#include "utils/syscache.h"
#include "utils/typcache.h"
#define HAVE_TCL_VERSION(maj,min) \
((TCL_MAJOR_VERSION > maj) || \
(TCL_MAJOR_VERSION == maj && TCL_MINOR_VERSION >= min))
- /* In Tcl >= 8.0, really not supposed to touch interp->result directly */
- #if !HAVE_TCL_VERSION(8,0)
- #define Tcl_GetStringResult(interp) ((interp)->result)
- #endif
-
/* define our text domain for translations */
#undef TEXTDOMAIN
#define TEXTDOMAIN PG_TEXTDOMAIN("pltcl")
--- 33,45 ----
#include "utils/memutils.h"
#include "utils/syscache.h"
#include "utils/typcache.h"
+ #include "funcapi.h"
#define HAVE_TCL_VERSION(maj,min) \
((TCL_MAJOR_VERSION > maj) || \
(TCL_MAJOR_VERSION == maj && TCL_MINOR_VERSION >= min))
/* define our text domain for translations */
#undef TEXTDOMAIN
#define TEXTDOMAIN PG_TEXTDOMAIN("pltcl")
*************** typedef struct pltcl_proc_desc
*** 112,123 ****
--- 108,129 ----
ItemPointerData fn_tid;
bool fn_readonly;
bool lanpltrusted;
+ bool fn_retistuple; /* true, if function returns tuple */
+ bool fn_retisset; /* true, if function returns a set */
pltcl_interp_desc *interp_desc;
FmgrInfo result_in_func;
Oid result_typioparam;
int nargs;
FmgrInfo arg_out_func[FUNC_MAX_ARGS];
bool arg_is_rowtype[FUNC_MAX_ARGS];
+
+ TupleDesc ret_tupdesc;
+ Tuplestorestate *tuple_store; /* SRFs accumulate result here */
+ AttInMetadata *attinmeta;
+ int natts;
+ MemoryContext tuple_store_cxt;
+ ResourceOwner tuple_store_owner;
+ ReturnSetInfo *rsi;
} pltcl_proc_desc;
*************** static void pltcl_init_interp(pltcl_inte
*** 187,203 ****
static pltcl_interp_desc *pltcl_fetch_interp(bool pltrusted);
static void pltcl_init_load_unknown(Tcl_Interp * interp);
! static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted);
! static Datum pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted);
! static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS, 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 pltrusted);
static int pltcl_elog(ClientData cdata, Tcl_Interp * interp,
int objc, Tcl_Obj * const objv[]);
static int pltcl_quote(ClientData cdata, Tcl_Interp * interp,
--- 193,212 ----
static pltcl_interp_desc *pltcl_fetch_interp(bool pltrusted);
static void pltcl_init_load_unknown(Tcl_Interp * interp);
! static Datum pltcl_handler(FunctionCallInfo fcinfo, bool pltrusted);
! static Datum pltcl_func_handler(FunctionCallInfo fcinfo, bool pltrusted);
! static HeapTuple pltcl_trigger_handler(FunctionCallInfo fcinfo, 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 pltrusted);
+ static void
+ pltcl_pg_returnnext(Tcl_Interp * interp, int rowObjc, Tcl_Obj ** rowObjv);
+
static int pltcl_elog(ClientData cdata, Tcl_Interp * interp,
int objc, Tcl_Obj * const objv[]);
static int pltcl_quote(ClientData cdata, Tcl_Interp * interp,
*************** static int pltcl_argisnull(ClientData cd
*** 206,211 ****
--- 215,222 ----
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_SPI_lastoid(ClientData
*** 225,231 ****
static void pltcl_set_tuple_values(Tcl_Interp * interp, CONST84 char *arrayname,
int tupno, HeapTuple tuple, TupleDesc tupdesc);
static void pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
! Tcl_DString * retval);
/*
--- 236,243 ----
static void pltcl_set_tuple_values(Tcl_Interp * interp, CONST84 char *arrayname,
int tupno, HeapTuple tuple, TupleDesc tupdesc);
static void pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
! Tcl_Obj * retobj);
! static void pltcl_init_tuple_store(pltcl_proc_desc * prodesc);
/*
*************** pltcl_WaitForEvent(Tcl_Time * timePtr)
*** 288,293 ****
--- 300,365 ----
}
#endif /* HAVE_TCL_VERSION(8,4) */
+ static HeapTuple
+ pltcl_build_tuple_result(Tcl_Interp * interp, Tcl_Obj ** kvObjv, int kvObjc, pltcl_proc_desc * prodesc)
+ {
+ HeapTuple tup;
+ char **values;
+ int i;
+
+ values = (char **) palloc0(prodesc->natts * sizeof(char *));
+
+ for (i = 0; i < kvObjc; i += 2)
+ {
+ char *fieldName = Tcl_GetString(kvObjv[i]);
+ int attn = SPI_fnumber(prodesc->ret_tupdesc, fieldName);
+
+ if (attn <= 0 || prodesc->ret_tupdesc->attrs[attn - 1]->attisdropped)
+ ereport(ERROR,
+ (errcode(ERRCODE_UNDEFINED_COLUMN),
+ errmsg("Tcl list contains nonexistent column \"%s\"",
+ fieldName)));
+
+ UTF_BEGIN;
+ values[attn - 1] = UTF_E2U(Tcl_GetString(kvObjv[i + 1]));
+ UTF_END;
+ }
+
+ tup = BuildTupleFromCStrings(prodesc->attinmeta, values);
+ pfree(values);
+ return tup;
+ }
+
+ /**********************************************************************
+ * pltcl_reset_state() - reset function's runtime state
+ *
+ * This is called on function and trigger entry
+ * (pltcl_func_handler and pltcl_trigger_handler) to clear
+ * any previous results.
+ *
+ * rsi is present if it's a function but not if it's a trigger.
+ **********************************************************************/
+ static void
+ pltcl_reset_state(pltcl_proc_desc * prodesc, ReturnSetInfo * rsi)
+ {
+ prodesc->ret_tupdesc = NULL;
+ prodesc->tuple_store = NULL;
+ prodesc->attinmeta = NULL;
+ prodesc->natts = 0;
+
+ if (rsi)
+ {
+ prodesc->tuple_store_cxt = rsi->econtext->ecxt_per_query_memory;
+ prodesc->tuple_store_owner = CurrentResourceOwner;
+ }
+ else
+ {
+ prodesc->tuple_store_cxt = NULL;
+ prodesc->tuple_store_owner = NULL;
+ }
+
+ prodesc->rsi = rsi;
+ }
/*
* This routine is a crock, and so is everyplace that calls it. The problem
*************** pltcl_init_interp(pltcl_interp_desc * in
*** 422,427 ****
--- 494,501 ----
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);
*************** pltclu_call_handler(PG_FUNCTION_ARGS)
*** 611,618 ****
}
static Datum
! pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted)
{
Datum retval;
FunctionCallInfo save_fcinfo;
--- 685,696 ----
}
+ /**********************************************************************
+ * pltcl_handler() - Handler for function and trigger calls, for
+ * both trusted and untrusted interpreters.
+ **********************************************************************/
static Datum
! pltcl_handler(FunctionCallInfo fcinfo, bool pltrusted)
{
Datum retval;
FunctionCallInfo save_fcinfo;
*************** pltcl_handler(PG_FUNCTION_ARGS, bool plt
*** 632,642 ****
--- 710,722 ----
*/
if (CALLED_AS_TRIGGER(fcinfo))
{
+ /* invoke the trigger handler */
pltcl_current_fcinfo = NULL;
retval = PointerGetDatum(pltcl_trigger_handler(fcinfo, pltrusted));
}
else
{
+ /* invoke the function handler */
pltcl_current_fcinfo = fcinfo;
retval = pltcl_func_handler(fcinfo, pltrusted);
}
*************** pltcl_handler(PG_FUNCTION_ARGS, bool plt
*** 660,671 ****
* pltcl_func_handler() - Handler for regular function calls
**********************************************************************/
static Datum
! pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted)
{
pltcl_proc_desc *prodesc;
Tcl_Interp *volatile interp;
! Tcl_DString tcl_cmd;
! Tcl_DString list_tmp;
int i;
int tcl_rc;
Datum retval;
--- 740,750 ----
* pltcl_func_handler() - Handler for regular function calls
**********************************************************************/
static Datum
! pltcl_func_handler(FunctionCallInfo fcinfo, bool pltrusted)
{
pltcl_proc_desc *prodesc;
Tcl_Interp *volatile interp;
! Tcl_Obj *tcl_cmd = Tcl_NewObj();
int i;
int tcl_rc;
Datum retval;
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 678,694 ****
prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, InvalidOid,
pltrusted);
pltcl_current_prodesc = prodesc;
-
interp = prodesc->interp_desc->interp;
/************************************************************
* Create the tcl command to call the internal
* proc in the Tcl interpreter
************************************************************/
! Tcl_DStringInit(&tcl_cmd);
! Tcl_DStringInit(&list_tmp);
! Tcl_DStringAppendElement(&tcl_cmd, prodesc->internal_proname);
/************************************************************
* Add all call arguments to the command
--- 757,779 ----
prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, InvalidOid,
pltrusted);
+ /*
+ * globally store current proc description, this can be redone using
+ * clientdata-type structures and eventually allow threading or something
+ */
pltcl_current_prodesc = prodesc;
interp = prodesc->interp_desc->interp;
+ /* reset essential function runtime to a known state */
+ pltcl_reset_state(prodesc, (ReturnSetInfo *) fcinfo->resultinfo);
+
/************************************************************
* 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));
/************************************************************
* Add all call arguments to the command
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 703,709 ****
* For tuple values, add a list for 'array set ...'
**************************************************/
if (fcinfo->argnull[i])
! Tcl_DStringAppendElement(&tcl_cmd, "");
else
{
HeapTupleHeader td;
--- 788,794 ----
* For tuple values, add a list for 'array set ...'
**************************************************/
if (fcinfo->argnull[i])
! Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
else
{
HeapTupleHeader td;
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 711,716 ****
--- 796,802 ----
int32 tupTypmod;
TupleDesc tupdesc;
HeapTupleData tmptup;
+ Tcl_Obj *list_tmp;
td = DatumGetHeapTupleHeader(fcinfo->arg[i]);
/* Extract rowtype info and find a tupdesc */
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 721,730 ****
tmptup.t_len = HeapTupleHeaderGetDatumLength(td);
tmptup.t_data = td;
! Tcl_DStringSetLength(&list_tmp, 0);
! pltcl_build_tuple_argument(&tmptup, tupdesc, &list_tmp);
! Tcl_DStringAppendElement(&tcl_cmd,
! Tcl_DStringValue(&list_tmp));
ReleaseTupleDesc(tupdesc);
}
}
--- 807,816 ----
tmptup.t_len = HeapTupleHeaderGetDatumLength(td);
tmptup.t_data = td;
! list_tmp = Tcl_NewObj();
! pltcl_build_tuple_argument(&tmptup, tupdesc, list_tmp);
! Tcl_ListObjAppendElement(NULL, tcl_cmd, list_tmp);
! Tcl_DecrRefCount(list_tmp);
ReleaseTupleDesc(tupdesc);
}
}
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 735,741 ****
* of their external representation
**************************************************/
if (fcinfo->argnull[i])
! Tcl_DStringAppendElement(&tcl_cmd, "");
else
{
char *tmp;
--- 821,827 ----
* of their external representation
**************************************************/
if (fcinfo->argnull[i])
! Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
else
{
char *tmp;
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 743,749 ****
tmp = OutputFunctionCall(&prodesc->arg_out_func[i],
fcinfo->arg[i]);
UTF_BEGIN;
! Tcl_DStringAppendElement(&tcl_cmd, UTF_E2U(tmp));
UTF_END;
pfree(tmp);
}
--- 829,836 ----
tmp = OutputFunctionCall(&prodesc->arg_out_func[i],
fcinfo->arg[i]);
UTF_BEGIN;
! Tcl_ListObjAppendElement(NULL, tcl_cmd,
! Tcl_NewStringObj(UTF_E2U(tmp), -1));
UTF_END;
pfree(tmp);
}
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 752,771 ****
}
PG_CATCH();
{
! Tcl_DStringFree(&tcl_cmd);
! Tcl_DStringFree(&list_tmp);
PG_RE_THROW();
}
PG_END_TRY();
- Tcl_DStringFree(&list_tmp);
/************************************************************
* Call the Tcl function
*
* We assume no PG error can be thrown directly from this call.
************************************************************/
! tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&tcl_cmd));
! Tcl_DStringFree(&tcl_cmd);
/************************************************************
* Check for errors reported by Tcl.
--- 839,856 ----
}
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_IncrRefCount(tcl_cmd);
! tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL));
/************************************************************
* Check for errors reported by Tcl.
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 773,778 ****
--- 858,869 ----
if (tcl_rc != TCL_OK)
throw_tcl_error(interp, prodesc->user_proname);
+ /*
+ * Don't get rid of tcl_cmd until after throwing the error because with
+ * tcl objects it can be referenced from the error handler
+ */
+ Tcl_DecrRefCount(tcl_cmd);
+
/************************************************************
* Disconnect from SPI manager and then create the return
* value datum (if the input function does a palloc for it
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 790,795 ****
--- 881,952 ----
NULL,
prodesc->result_typioparam,
-1);
+ else if (prodesc->fn_retisset)
+ {
+ ReturnSetInfo *rsi = prodesc->rsi;
+
+ 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")));
+
+ rsi->returnMode = SFRM_Materialize;
+
+ /* If we produced any tuples, send back the result */
+ if (prodesc->tuple_store)
+ {
+ rsi->setResult = prodesc->tuple_store;
+ if (prodesc->ret_tupdesc)
+ {
+ MemoryContext oldcxt;
+
+ oldcxt = MemoryContextSwitchTo(prodesc->tuple_store_cxt);
+ rsi->setDesc = CreateTupleDescCopy(prodesc->ret_tupdesc);
+ MemoryContextSwitchTo(oldcxt);
+ }
+ }
+ retval = (Datum) 0;
+ fcinfo->isnull = true;
+ }
+ else if (prodesc->fn_retistuple)
+ {
+ TupleDesc td;
+ HeapTuple tup;
+ Tcl_Obj *resultObj;
+ Tcl_Obj **resultObjv;
+ int resultObjc;
+
+ if (get_call_result_type(fcinfo, NULL, &td) != TYPEFUNC_COMPOSITE)
+ {
+ ereport(ERROR,
+ (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
+ errmsg("function returning record called in context "
+ "that cannot accept type record")));
+ }
+
+ resultObj = Tcl_GetObjResult(interp);
+ if (Tcl_ListObjGetElements(interp, resultObj, &resultObjc, &resultObjv) == TCL_ERROR)
+ {
+ return TCL_ERROR;
+ }
+
+ if (resultObjc & 1)
+ {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("list must have even number of elements", -1));
+ return TCL_ERROR;
+ }
+
+ Assert(!prodesc->ret_tupdesc);
+ Assert(!prodesc->attinmeta);
+ prodesc->ret_tupdesc = td;
+ prodesc->natts = td->natts;
+ prodesc->attinmeta = TupleDescGetAttInMetadata(prodesc->ret_tupdesc);
+
+ tup = pltcl_build_tuple_result(interp, resultObjv, resultObjc, prodesc);
+ retval = HeapTupleGetDatum(tup);
+ }
else
{
UTF_BEGIN;
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 808,814 ****
* pltcl_trigger_handler() - Handler for trigger calls
**********************************************************************/
static HeapTuple
! pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted)
{
pltcl_proc_desc *prodesc;
Tcl_Interp *volatile interp;
--- 965,971 ----
* pltcl_trigger_handler() - Handler for trigger calls
**********************************************************************/
static HeapTuple
! pltcl_trigger_handler(FunctionCallInfo fcinfo, bool pltrusted)
{
pltcl_proc_desc *prodesc;
Tcl_Interp *volatile interp;
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 816,824 ****
char *stroid;
TupleDesc tupdesc;
volatile HeapTuple rettup;
! Tcl_DString tcl_cmd;
! Tcl_DString tcl_trigtup;
! Tcl_DString tcl_newtup;
int tcl_rc;
int i;
int *modattrs;
--- 973,981 ----
char *stroid;
TupleDesc tupdesc;
volatile HeapTuple rettup;
! Tcl_Obj *tcl_cmd;
! Tcl_Obj *tcl_trigtup;
! Tcl_Obj *tcl_newtup;
int tcl_rc;
int i;
int *modattrs;
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 838,911 ****
pltrusted);
pltcl_current_prodesc = prodesc;
-
interp = prodesc->interp_desc->interp;
-
tupdesc = trigdata->tg_relation->rd_att;
/************************************************************
* Create the tcl command to call the internal
* proc in the interpreter
************************************************************/
! Tcl_DStringInit(&tcl_cmd);
! Tcl_DStringInit(&tcl_trigtup);
! Tcl_DStringInit(&tcl_newtup);
PG_TRY();
{
/* The procedure name */
! Tcl_DStringAppendElement(&tcl_cmd, prodesc->internal_proname);
/* The trigger name for argument TG_name */
! Tcl_DStringAppendElement(&tcl_cmd, trigdata->tg_trigger->tgname);
/* The oid of the trigger relation for argument TG_relid */
stroid = DatumGetCString(DirectFunctionCall1(oidout,
ObjectIdGetDatum(trigdata->tg_relation->rd_id)));
! Tcl_DStringAppendElement(&tcl_cmd, stroid);
pfree(stroid);
/* The name of the table the trigger is acting on: TG_table_name */
stroid = SPI_getrelname(trigdata->tg_relation);
! Tcl_DStringAppendElement(&tcl_cmd, stroid);
pfree(stroid);
/* The schema of the table the trigger is acting on: TG_table_schema */
stroid = SPI_getnspname(trigdata->tg_relation);
! Tcl_DStringAppendElement(&tcl_cmd, stroid);
pfree(stroid);
/* A list of attribute names for argument TG_relatts */
! Tcl_DStringAppendElement(&tcl_trigtup, "");
for (i = 0; i < tupdesc->natts; i++)
{
if (tupdesc->attrs[i]->attisdropped)
! Tcl_DStringAppendElement(&tcl_trigtup, "");
else
! Tcl_DStringAppendElement(&tcl_trigtup,
! NameStr(tupdesc->attrs[i]->attname));
}
! Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
! Tcl_DStringFree(&tcl_trigtup);
! Tcl_DStringInit(&tcl_trigtup);
/* The when part of the event for TG_when */
if (TRIGGER_FIRED_BEFORE(trigdata->tg_event))
! Tcl_DStringAppendElement(&tcl_cmd, "BEFORE");
else if (TRIGGER_FIRED_AFTER(trigdata->tg_event))
! Tcl_DStringAppendElement(&tcl_cmd, "AFTER");
else if (TRIGGER_FIRED_INSTEAD(trigdata->tg_event))
! Tcl_DStringAppendElement(&tcl_cmd, "INSTEAD OF");
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_DStringAppendElement(&tcl_cmd, "ROW");
/* Build the data list for the trigtuple */
pltcl_build_tuple_argument(trigdata->tg_trigtuple,
! tupdesc, &tcl_trigtup);
/*
* Now the command part of the event for TG_op and data for NEW
--- 995,1078 ----
pltrusted);
pltcl_current_prodesc = prodesc;
interp = prodesc->interp_desc->interp;
tupdesc = trigdata->tg_relation->rd_att;
+ pltcl_reset_state(prodesc, NULL);
+
/************************************************************
* Create the tcl command to call the internal
* proc in the interpreter
************************************************************/
! tcl_cmd = Tcl_NewObj();
! tcl_trigtup = Tcl_NewObj();
! tcl_newtup = Tcl_NewObj();
PG_TRY();
{
/* The procedure name */
! 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(trigdata->tg_trigger->tgname, -1));
/* The oid of the trigger relation for argument TG_relid */
+ /* NB don't convert 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(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(stroid, -1));
pfree(stroid);
/* A list of attribute names for argument TG_relatts */
! Tcl_ListObjAppendElement(NULL, tcl_trigtup, Tcl_NewObj());
for (i = 0; i < tupdesc->natts; i++)
{
if (tupdesc->attrs[i]->attisdropped)
! Tcl_ListObjAppendElement(NULL, tcl_trigtup, Tcl_NewObj());
else
! Tcl_ListObjAppendElement(NULL, tcl_trigtup,
! Tcl_NewStringObj(NameStr(tupdesc->attrs[i]->attname), -1));
}
! Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
! /* Tcl_DecrRefCount(tcl_trigtup); */
! tcl_trigtup = Tcl_NewObj();
/* 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));
/* Build the data list for the trigtuple */
pltcl_build_tuple_argument(trigdata->tg_trigtuple,
! tupdesc, tcl_trigtup);
/*
* Now the command part of the event for TG_op and data for NEW
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 913,943 ****
*/
if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
{
! Tcl_DStringAppendElement(&tcl_cmd, "INSERT");
! Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
! Tcl_DStringAppendElement(&tcl_cmd, "");
rettup = trigdata->tg_trigtuple;
}
else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event))
{
! Tcl_DStringAppendElement(&tcl_cmd, "DELETE");
! Tcl_DStringAppendElement(&tcl_cmd, "");
! Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
rettup = trigdata->tg_trigtuple;
}
else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
{
! Tcl_DStringAppendElement(&tcl_cmd, "UPDATE");
pltcl_build_tuple_argument(trigdata->tg_newtuple,
! tupdesc, &tcl_newtup);
! Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_newtup));
! Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
rettup = trigdata->tg_newtuple;
}
--- 1080,1113 ----
*/
if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
{
! Tcl_ListObjAppendElement(NULL, tcl_cmd,
! Tcl_NewStringObj("INSERT", -1));
! Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
! 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, tcl_trigtup);
rettup = trigdata->tg_trigtuple;
}
else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
{
! Tcl_ListObjAppendElement(NULL, tcl_cmd,
! Tcl_NewStringObj("UPDATE", -1));
pltcl_build_tuple_argument(trigdata->tg_newtuple,
! tupdesc, tcl_newtup);
! Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_newtup);
! Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
rettup = trigdata->tg_newtuple;
}
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 946,966 ****
}
else if (TRIGGER_FIRED_FOR_STATEMENT(trigdata->tg_event))
{
! Tcl_DStringAppendElement(&tcl_cmd, "STATEMENT");
if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
! Tcl_DStringAppendElement(&tcl_cmd, "INSERT");
else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event))
! Tcl_DStringAppendElement(&tcl_cmd, "DELETE");
else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
! Tcl_DStringAppendElement(&tcl_cmd, "UPDATE");
else if (TRIGGER_FIRED_BY_TRUNCATE(trigdata->tg_event))
! Tcl_DStringAppendElement(&tcl_cmd, "TRUNCATE");
else
elog(ERROR, "unrecognized OP tg_event: %u", trigdata->tg_event);
! Tcl_DStringAppendElement(&tcl_cmd, "");
! Tcl_DStringAppendElement(&tcl_cmd, "");
rettup = (HeapTuple) NULL;
}
--- 1116,1141 ----
}
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;
}
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 969,995 ****
/* Finally append the arguments from CREATE TRIGGER */
for (i = 0; i < trigdata->tg_trigger->tgnargs; i++)
! Tcl_DStringAppendElement(&tcl_cmd, trigdata->tg_trigger->tgargs[i]);
}
PG_CATCH();
{
! Tcl_DStringFree(&tcl_cmd);
! Tcl_DStringFree(&tcl_trigtup);
! Tcl_DStringFree(&tcl_newtup);
PG_RE_THROW();
}
PG_END_TRY();
- Tcl_DStringFree(&tcl_trigtup);
- Tcl_DStringFree(&tcl_newtup);
/************************************************************
* Call the Tcl function
*
* We assume no PG error can be thrown directly from this call.
************************************************************/
! tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&tcl_cmd));
! Tcl_DStringFree(&tcl_cmd);
/************************************************************
* Check for errors reported by Tcl.
--- 1144,1172 ----
/* Finally append the arguments from CREATE TRIGGER */
for (i = 0; i < trigdata->tg_trigger->tgnargs; i++)
! Tcl_ListObjAppendElement(NULL, tcl_cmd,
! Tcl_NewStringObj(trigdata->tg_trigger->tgargs[i], -1));
}
PG_CATCH();
{
! Tcl_DecrRefCount(tcl_cmd);
! Tcl_DecrRefCount(tcl_trigtup);
! Tcl_DecrRefCount(tcl_newtup);
PG_RE_THROW();
}
PG_END_TRY();
/************************************************************
* Call the Tcl function
*
* We assume no PG error can be thrown directly from this call.
************************************************************/
! Tcl_IncrRefCount(tcl_cmd);
! tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL));
! /* Tcl_DecrRefCount(tcl_trigtup); */
! /* Tcl_DecrRefCount(tcl_newtup); */
! Tcl_DecrRefCount(tcl_cmd);
/************************************************************
* Check for errors reported by Tcl.
*************** throw_tcl_error(Tcl_Interp * interp, con
*** 1151,1156 ****
--- 1328,1378 ----
UTF_END;
}
+ static void
+ pltcl_init_tuple_store(pltcl_proc_desc * prodesc)
+ {
+ ReturnSetInfo *rsi = prodesc->rsi;
+ MemoryContext oldcxt;
+ ResourceOwner oldowner;
+
+ /*
+ * Check caller can handle a set result in the way we want
+ */
+ if (!rsi || !IsA(rsi, ReturnSetInfo) ||
+ (rsi->allowedModes & SFRM_Materialize) == 0 ||
+ rsi->expectedDesc == NULL)
+ ereport(ERROR,
+ (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
+ errmsg("set-valued function called in context that cannot accept a set")));
+
+ Assert(!prodesc->tuple_store);
+ Assert(!prodesc->attinmeta);
+
+ /*
+ * Switch to the right memory context and resource owner for storing the
+ * tuplestore for return set. 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 resource owner.
+ */
+ prodesc->ret_tupdesc = rsi->expectedDesc;
+ prodesc->natts = prodesc->ret_tupdesc->natts;
+
+ oldcxt = MemoryContextSwitchTo(prodesc->tuple_store_cxt);
+ oldowner = CurrentResourceOwner;
+ CurrentResourceOwner = prodesc->tuple_store_owner;
+
+ prodesc->tuple_store =
+ tuplestore_begin_heap(rsi->allowedModes & SFRM_Materialize_Random,
+ false, work_mem);
+
+ prodesc->attinmeta = TupleDescGetAttInMetadata(prodesc->ret_tupdesc);
+
+ CurrentResourceOwner = oldowner;
+ MemoryContextSwitchTo(oldcxt);
+
+ }
+
/**********************************************************************
* compile_pltcl_function - compile (or hopefully just look up) function
*************** compile_pltcl_function(Oid fn_oid, Oid t
*** 1230,1235 ****
--- 1452,1458 ----
Tcl_Interp *interp;
int i;
int tcl_rc;
+ FunctionCallInfo fcinfo = pltcl_current_fcinfo;
/************************************************************
* Build our internal proc name from the function's Oid. Append
*************** compile_pltcl_function(Oid fn_oid, Oid t
*** 1267,1272 ****
--- 1490,1506 ----
/* And whether it is trusted */
prodesc->lanpltrusted = pltrusted;
+ /* not necessary since MemSet 0 above */
+ prodesc->fn_retistuple = false;
+ prodesc->fn_retisset = false;
+ prodesc->tuple_store_cxt = NULL;
+ prodesc->tuple_store_owner = NULL;
+ prodesc->tuple_store = NULL;
+ prodesc->ret_tupdesc = NULL;
+ prodesc->attinmeta = NULL;
+ prodesc->natts = 0;
+
+
/************************************************************
* Identify the interpreter to use for the function
************************************************************/
*************** compile_pltcl_function(Oid fn_oid, Oid t
*** 1279,1284 ****
--- 1513,1525 ----
************************************************************/
if (!is_trigger)
{
+ prodesc->rsi = (ReturnSetInfo *) fcinfo->resultinfo;
+ if (prodesc->rsi)
+ {
+ prodesc->tuple_store_cxt = prodesc->rsi->econtext->ecxt_per_query_memory;
+ prodesc->tuple_store_owner = CurrentResourceOwner;
+ }
+
typeTup =
SearchSysCache1(TYPEOID,
ObjectIdGetDatum(procStruct->prorettype));
*************** compile_pltcl_function(Oid fn_oid, Oid t
*** 1306,1311 ****
--- 1547,1554 ----
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
errmsg("trigger functions can only be called as triggers")));
}
+ else if (procStruct->prorettype == RECORDOID)
+ ;
else
{
free(prodesc->user_proname);
*************** compile_pltcl_function(Oid fn_oid, Oid t
*** 1318,1332 ****
}
}
! if (typeStruct->typtype == TYPTYPE_COMPOSITE)
! {
! free(prodesc->user_proname);
! free(prodesc->internal_proname);
! free(prodesc);
! ereport(ERROR,
! (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
! errmsg("PL/Tcl functions cannot return composite types")));
! }
perm_fmgr_info(typeStruct->typinput, &(prodesc->result_in_func));
prodesc->result_typioparam = getTypeIOParam(typeTup);
--- 1561,1569 ----
}
}
! prodesc->fn_retisset = procStruct->proretset;
! prodesc->fn_retistuple = (procStruct->prorettype == RECORDOID ||
! typeStruct->typtype == TYPTYPE_COMPOSITE);
perm_fmgr_info(typeStruct->typinput, &(prodesc->result_in_func));
prodesc->result_typioparam = getTypeIOParam(typeTup);
*************** compile_pltcl_function(Oid fn_oid, Oid t
*** 1398,1403 ****
--- 1635,1644 ----
/************************************************************
* Create the tcl command to define the internal
* procedure
+ *
+ * leave this as DString - it's a text processing function
+ * that only gets invoked when the tcl function is invoked
+ * for the first time
************************************************************/
Tcl_DStringInit(&proc_internal_def);
Tcl_DStringInit(&proc_internal_body);
*************** pltcl_returnnull(ClientData cdata, Tcl_I
*** 1751,1756 ****
--- 1992,2085 ----
return TCL_RETURN;
}
+ /**********************************************************************
+ * pltcl_pg_returnnext() - Queue a row of Tcl key-value pairs into the
+ * function's tuple_store
+ **********************************************************************/
+ static void
+ pltcl_pg_returnnext(Tcl_Interp * interp, int rowObjc, Tcl_Obj ** rowObjv)
+ {
+ pltcl_proc_desc *prodesc = pltcl_current_prodesc;
+
+ if (!prodesc->fn_retisset)
+ ereport(ERROR,
+ (errcode(ERRCODE_SYNTAX_ERROR),
+ errmsg("cannot use return_next in a non-SETOF function")));
+
+ if (prodesc->tuple_store == NULL)
+ pltcl_init_tuple_store(prodesc);
+
+ if (prodesc->fn_retistuple)
+ {
+ HeapTuple tuple;
+
+ tuple = pltcl_build_tuple_result(interp, rowObjv, rowObjc, prodesc);
+ tuplestore_puttuple(prodesc->tuple_store, tuple);
+ }
+ else
+ {
+ ereport(ERROR,
+ (errcode(ERRCODE_SYNTAX_ERROR),
+ errmsg("unprepared for non-retistuple state at this point")));
+ }
+ }
+
+ /**********************************************************************
+ * pltcl_returnnext() - Tcl-callable command take a list of key-value
+ * pairs and store in the tuple_store
+ * for sending as a result when the
+ * function is complete.
+ **********************************************************************/
+ static int
+ pltcl_returnnext(ClientData cdata, Tcl_Interp * interp,
+ int objc, Tcl_Obj * const objv[])
+ {
+ FunctionCallInfo fcinfo = pltcl_current_fcinfo;
+ Tcl_Obj **rowObjv;
+ int rowObjc;
+ pltcl_proc_desc *prodesc = pltcl_current_prodesc;
+
+ /************************************************************
+ * Check call syntax
+ ************************************************************/
+ if (objc != 2)
+ {
+ Tcl_WrongNumArgs(interp, 1, objv, "list");
+ return TCL_ERROR;
+ }
+
+ /************************************************************
+ * Check that we're called as a normal 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("cannot use return_next in a non-SETOF function", -1));
+ return TCL_ERROR;
+ }
+
+ if (Tcl_ListObjGetElements(interp, objv[1], &rowObjc, &rowObjv) == TCL_ERROR)
+ {
+ return TCL_ERROR;
+ }
+
+ if (rowObjc & 1)
+ {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("list must have even number of elements", -1));
+ return TCL_ERROR;
+ }
+
+ pltcl_pg_returnnext(interp, rowObjc, rowObjv);
+ return TCL_OK;
+ }
/*----------
* Support for running SPI operations inside subtransactions
*************** pltcl_SPI_prepare(ClientData cdata, Tcl_
*** 2162,2168 ****
free(qdesc->arginfuncs);
free(qdesc->argtypioparams);
free(qdesc);
- /* ckfree((char *) args); */
return TCL_ERROR;
}
--- 2491,2496 ----
*************** pltcl_SPI_prepare(ClientData cdata, Tcl_
*** 2177,2184 ****
hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew);
Tcl_SetHashValue(hashent, (ClientData) qdesc);
- /* ckfree((char *) args); */
-
/* qname is ASCII, so no need for encoding conversion */
Tcl_SetObjResult(interp, Tcl_NewStringObj(qdesc->qname, -1));
return TCL_OK;
--- 2505,2510 ----
*************** pltcl_set_tuple_values(Tcl_Interp * inte
*** 2516,2522 ****
**********************************************************************/
static void
pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
! Tcl_DString * retval)
{
int i;
char *outputstr;
--- 2842,2848 ----
**********************************************************************/
static void
pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
! Tcl_Obj * retobj)
{
int i;
char *outputstr;
*************** pltcl_build_tuple_argument(HeapTuple tup
*** 2567,2575 ****
if (!isnull && OidIsValid(typoutput))
{
outputstr = OidOutputFunctionCall(typoutput, attr);
! Tcl_DStringAppendElement(retval, attname);
UTF_BEGIN;
! Tcl_DStringAppendElement(retval, UTF_E2U(outputstr));
UTF_END;
pfree(outputstr);
}
--- 2893,2902 ----
if (!isnull && OidIsValid(typoutput))
{
outputstr = OidOutputFunctionCall(typoutput, attr);
! Tcl_ListObjAppendElement(NULL, retobj,
! Tcl_NewStringObj(attname, -1));
UTF_BEGIN;
! Tcl_ListObjAppendElement(NULL, retobj, Tcl_NewStringObj(UTF_E2U(outputstr), -1));
UTF_END;
pfree(outputstr);
}
Re: Revised patches to add table function support to PL/Tcl (TODO item)
Karl Lehenbauer <karllehenbauer@gmail.com> writes:
The first patch, pltcl-karl-try2-1-of-3-pgindent.patch, does nothing but conform HEAD's pltcl.c with pgindent. Applying this patch should have exactly the same effect as running
src/tools/pgindent/pgindent src/tools/pgindent/typedefs.list src/pl/tcl/pltcl.c
This patch appears to be changing a whole lot of stuff that in fact
pg_indent has never changed, so there's something wrong with the way you
are doing it. It looks like a bad typedef list from here.
regards, tom lane
Re: Revised patches to add table function support to PL/Tcl (TODO item)
On Dec 28, 2010, at 7:29 PM, Tom Lane wrote:
This patch appears to be changing a whole lot of stuff that in fact
pg_indent has never changed, so there's something wrong with the way you
are doing it. It looks like a bad typedef list from here.
You were right, Tom. The problem was that typedefs "pltcl_interp_desc", "pltcl_proc_key", and "pltcl_proc_ptr" weren't in src/tools/pgindent/typedefs.list. After adding them (and building and installing the netbsd-based, patched indent), pgindent only changes a handful of lines.
pltcl-karl-try3-1-of-3-pgindent.patch patches typedefs.list with the three missing typedefs and pltcl.c with the small changes made by pgindent (it shifted some embedded comments left within their lines, mainly).
As before, but "try3" now, pltcl-karl-try3-2-of-3-objects.patch converts pltcl.c to use the "Tcl objects" C API.
And as before, but "try3" now, pltcl-karl-try3-3-of-3-setof.patch adds returning record and SETOF record.
Attachments:
pltcl-karl-try3-1-of-3-pgindent.patchapplication/octet-stream; name=pltcl-karl-try3-1-of-3-pgindent.patchDownload
diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c
index 6e8c5c0..7b952b2 100644
*** a/src/pl/tcl/pltcl.c
--- b/src/pl/tcl/pltcl.c
*************** PG_MODULE_MAGIC;
*** 95,103 ****
**********************************************************************/
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;
--- 95,103 ----
**********************************************************************/
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;
*************** typedef struct pltcl_query_desc
*** 148,165 ****
**********************************************************************/
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;
--- 148,166 ----
**********************************************************************/
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;
*************** static HeapTuple pltcl_trigger_handler(P
*** 196,202 ****
static void throw_tcl_error(Tcl_Interp *interp, const char *proname);
static pltcl_proc_desc *compile_pltcl_function(Oid fn_oid, Oid tgreloid,
! bool pltrusted);
static int pltcl_elog(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[]);
--- 197,203 ----
static void throw_tcl_error(Tcl_Interp *interp, const char *proname);
static pltcl_proc_desc *compile_pltcl_function(Oid fn_oid, Oid tgreloid,
! bool pltrusted);
static int pltcl_elog(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[]);
diff --git a/src/tools/pgindent/typedefs.list b/src/tools/pgindent/typedefs.list
index 7b3787a..ec99f8e 100644
*** a/src/tools/pgindent/typedefs.list
--- b/src/tools/pgindent/typedefs.list
*************** plperl_proc_entry
*** 1972,1978 ****
--- 1972,1981 ----
plperl_query_desc
plperl_query_entry
plpgsql_HashEnt
+ pltcl_interp_desc
pltcl_proc_desc
+ pltcl_proc_key
+ pltcl_proc_ptr
pltcl_query_desc
pqbool
pqsigfunc
pltcl-karl-try3-2-of-3-objects.patchapplication/octet-stream; name=pltcl-karl-try3-2-of-3-objects.patchDownload
diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c
index 7b952b2..1efdb2d 100644
*** a/src/pl/tcl/pltcl.c
--- b/src/pl/tcl/pltcl.c
*************** static pltcl_proc_desc *compile_pltcl_fu
*** 200,232 ****
bool pltrusted);
static int pltcl_elog(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[]);
static int pltcl_quote(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[]);
static int pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[]);
static int pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[]);
static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[]);
static int pltcl_process_SPI_result(Tcl_Interp *interp,
CONST84 char *arrayname,
! CONST84 char *loop_body,
int spi_rc,
SPITupleTable *tuptable,
int ntuples);
static int pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[]);
static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[]);
static int pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[]);
static void pltcl_set_tuple_values(Tcl_Interp *interp, CONST84 char *arrayname,
int tupno, HeapTuple tuple, TupleDesc tupdesc);
static void pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
! Tcl_DString *retval);
/*
--- 200,232 ----
bool pltrusted);
static int pltcl_elog(ClientData cdata, Tcl_Interp *interp,
! int objc, Tcl_Obj * const objv[]);
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_SPI_execute(ClientData cdata, Tcl_Interp *interp,
! int objc, Tcl_Obj * const objv[]);
static int pltcl_process_SPI_result(Tcl_Interp *interp,
CONST84 char *arrayname,
! Tcl_Obj * loop_body,
int spi_rc,
SPITupleTable *tuptable,
int 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_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
! int objc, Tcl_Obj * const objv[]);
static void pltcl_set_tuple_values(Tcl_Interp *interp, CONST84 char *arrayname,
int tupno, HeapTuple tuple, TupleDesc tupdesc);
static void pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
! Tcl_Obj *retobj);
/*
*************** pltcl_init_interp(pltcl_interp_desc *int
*** 415,437 ****
/************************************************************
* Install the commands for SPI support in the interpreter
************************************************************/
! Tcl_CreateCommand(interp, "elog",
! pltcl_elog, NULL, NULL);
! Tcl_CreateCommand(interp, "quote",
! pltcl_quote, NULL, NULL);
! Tcl_CreateCommand(interp, "argisnull",
! pltcl_argisnull, NULL, NULL);
! Tcl_CreateCommand(interp, "return_null",
! pltcl_returnnull, NULL, NULL);
! Tcl_CreateCommand(interp, "spi_exec",
! pltcl_SPI_execute, NULL, NULL);
! Tcl_CreateCommand(interp, "spi_prepare",
! pltcl_SPI_prepare, NULL, NULL);
! Tcl_CreateCommand(interp, "spi_execp",
! pltcl_SPI_execute_plan, NULL, NULL);
! Tcl_CreateCommand(interp, "spi_lastoid",
! pltcl_SPI_lastoid, NULL, NULL);
/************************************************************
* Try to load the unknown procedure from pltcl_modules
--- 415,437 ----
/************************************************************
* 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, "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, "spi_lastoid",
! pltcl_SPI_lastoid, NULL, NULL);
/************************************************************
* Try to load the unknown procedure from pltcl_modules
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 665,672 ****
{
pltcl_proc_desc *prodesc;
Tcl_Interp *volatile interp;
! Tcl_DString tcl_cmd;
! Tcl_DString list_tmp;
int i;
int tcl_rc;
Datum retval;
--- 665,671 ----
{
pltcl_proc_desc *prodesc;
Tcl_Interp *volatile interp;
! Tcl_Obj *tcl_cmd = Tcl_NewObj();
int i;
int tcl_rc;
Datum retval;
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 687,695 ****
* Create the tcl command to call the internal
* proc in the Tcl interpreter
************************************************************/
! Tcl_DStringInit(&tcl_cmd);
! Tcl_DStringInit(&list_tmp);
! Tcl_DStringAppendElement(&tcl_cmd, prodesc->internal_proname);
/************************************************************
* Add all call arguments to the command
--- 686,694 ----
* 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));
/************************************************************
* Add all call arguments to the command
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 704,710 ****
* For tuple values, add a list for 'array set ...'
**************************************************/
if (fcinfo->argnull[i])
! Tcl_DStringAppendElement(&tcl_cmd, "");
else
{
HeapTupleHeader td;
--- 703,709 ----
* For tuple values, add a list for 'array set ...'
**************************************************/
if (fcinfo->argnull[i])
! Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
else
{
HeapTupleHeader td;
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 712,717 ****
--- 711,717 ----
int32 tupTypmod;
TupleDesc tupdesc;
HeapTupleData tmptup;
+ Tcl_Obj *list_tmp;
td = DatumGetHeapTupleHeader(fcinfo->arg[i]);
/* Extract rowtype info and find a tupdesc */
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 722,731 ****
tmptup.t_len = HeapTupleHeaderGetDatumLength(td);
tmptup.t_data = td;
! Tcl_DStringSetLength(&list_tmp, 0);
! pltcl_build_tuple_argument(&tmptup, tupdesc, &list_tmp);
! Tcl_DStringAppendElement(&tcl_cmd,
! Tcl_DStringValue(&list_tmp));
ReleaseTupleDesc(tupdesc);
}
}
--- 722,731 ----
tmptup.t_len = HeapTupleHeaderGetDatumLength(td);
tmptup.t_data = td;
! list_tmp = Tcl_NewObj();
! pltcl_build_tuple_argument(&tmptup, tupdesc, list_tmp);
! Tcl_ListObjAppendElement(NULL, tcl_cmd, list_tmp);
! Tcl_DecrRefCount(list_tmp);
ReleaseTupleDesc(tupdesc);
}
}
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 736,742 ****
* of their external representation
**************************************************/
if (fcinfo->argnull[i])
! Tcl_DStringAppendElement(&tcl_cmd, "");
else
{
char *tmp;
--- 736,742 ----
* of their external representation
**************************************************/
if (fcinfo->argnull[i])
! Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
else
{
char *tmp;
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 744,750 ****
tmp = OutputFunctionCall(&prodesc->arg_out_func[i],
fcinfo->arg[i]);
UTF_BEGIN;
! Tcl_DStringAppendElement(&tcl_cmd, UTF_E2U(tmp));
UTF_END;
pfree(tmp);
}
--- 744,751 ----
tmp = OutputFunctionCall(&prodesc->arg_out_func[i],
fcinfo->arg[i]);
UTF_BEGIN;
! Tcl_ListObjAppendElement(NULL, tcl_cmd,
! Tcl_NewStringObj(UTF_E2U(tmp), -1));
UTF_END;
pfree(tmp);
}
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 753,772 ****
}
PG_CATCH();
{
! Tcl_DStringFree(&tcl_cmd);
! Tcl_DStringFree(&list_tmp);
PG_RE_THROW();
}
PG_END_TRY();
- Tcl_DStringFree(&list_tmp);
/************************************************************
* Call the Tcl function
*
* We assume no PG error can be thrown directly from this call.
************************************************************/
! tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&tcl_cmd));
! Tcl_DStringFree(&tcl_cmd);
/************************************************************
* Check for errors reported by Tcl.
--- 754,772 ----
}
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_IncrRefCount(tcl_cmd);
! tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL));
! Tcl_DecrRefCount(tcl_cmd);
/************************************************************
* Check for errors reported by Tcl.
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 817,825 ****
char *stroid;
TupleDesc tupdesc;
volatile HeapTuple rettup;
! Tcl_DString tcl_cmd;
! Tcl_DString tcl_trigtup;
! Tcl_DString tcl_newtup;
int tcl_rc;
int i;
int *modattrs;
--- 817,825 ----
char *stroid;
TupleDesc tupdesc;
volatile HeapTuple rettup;
! Tcl_Obj *tcl_cmd;
! Tcl_Obj *tcl_trigtup;
! Tcl_Obj *tcl_newtup;
int tcl_rc;
int i;
int *modattrs;
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 848,912 ****
* Create the tcl command to call the internal
* proc in the interpreter
************************************************************/
! Tcl_DStringInit(&tcl_cmd);
! Tcl_DStringInit(&tcl_trigtup);
! Tcl_DStringInit(&tcl_newtup);
PG_TRY();
{
/* The procedure name */
! Tcl_DStringAppendElement(&tcl_cmd, prodesc->internal_proname);
/* The trigger name for argument TG_name */
! Tcl_DStringAppendElement(&tcl_cmd, trigdata->tg_trigger->tgname);
/* The oid of the trigger relation for argument TG_relid */
stroid = DatumGetCString(DirectFunctionCall1(oidout,
ObjectIdGetDatum(trigdata->tg_relation->rd_id)));
! Tcl_DStringAppendElement(&tcl_cmd, stroid);
pfree(stroid);
/* The name of the table the trigger is acting on: TG_table_name */
stroid = SPI_getrelname(trigdata->tg_relation);
! Tcl_DStringAppendElement(&tcl_cmd, stroid);
pfree(stroid);
/* The schema of the table the trigger is acting on: TG_table_schema */
stroid = SPI_getnspname(trigdata->tg_relation);
! Tcl_DStringAppendElement(&tcl_cmd, stroid);
pfree(stroid);
/* A list of attribute names for argument TG_relatts */
! Tcl_DStringAppendElement(&tcl_trigtup, "");
for (i = 0; i < tupdesc->natts; i++)
{
if (tupdesc->attrs[i]->attisdropped)
! Tcl_DStringAppendElement(&tcl_trigtup, "");
else
! Tcl_DStringAppendElement(&tcl_trigtup,
! NameStr(tupdesc->attrs[i]->attname));
}
! Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
! Tcl_DStringFree(&tcl_trigtup);
! Tcl_DStringInit(&tcl_trigtup);
/* The when part of the event for TG_when */
if (TRIGGER_FIRED_BEFORE(trigdata->tg_event))
! Tcl_DStringAppendElement(&tcl_cmd, "BEFORE");
else if (TRIGGER_FIRED_AFTER(trigdata->tg_event))
! Tcl_DStringAppendElement(&tcl_cmd, "AFTER");
else if (TRIGGER_FIRED_INSTEAD(trigdata->tg_event))
! Tcl_DStringAppendElement(&tcl_cmd, "INSTEAD OF");
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_DStringAppendElement(&tcl_cmd, "ROW");
/* Build the data list for the trigtuple */
pltcl_build_tuple_argument(trigdata->tg_trigtuple,
! tupdesc, &tcl_trigtup);
/*
* Now the command part of the event for TG_op and data for NEW
--- 848,922 ----
* Create the tcl command to call the internal
* proc in the interpreter
************************************************************/
! tcl_cmd = Tcl_NewObj();
! tcl_trigtup = Tcl_NewObj();
! tcl_newtup = Tcl_NewObj();
PG_TRY();
{
/* The procedure name */
! 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(trigdata->tg_trigger->tgname, -1));
/* The oid of the trigger relation for argument TG_relid */
+ /* NB don't convert 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(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(stroid, -1));
pfree(stroid);
/* A list of attribute names for argument TG_relatts */
! Tcl_ListObjAppendElement(NULL, tcl_trigtup, Tcl_NewObj());
for (i = 0; i < tupdesc->natts; i++)
{
if (tupdesc->attrs[i]->attisdropped)
! Tcl_ListObjAppendElement(NULL, tcl_trigtup, Tcl_NewObj());
else
! Tcl_ListObjAppendElement(NULL, tcl_trigtup,
! Tcl_NewStringObj(NameStr(tupdesc->attrs[i]->attname), -1));
}
! Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
! // Tcl_DecrRefCount(tcl_trigtup);
! tcl_trigtup = Tcl_NewObj ();
/* 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));
/* Build the data list for the trigtuple */
pltcl_build_tuple_argument(trigdata->tg_trigtuple,
! tupdesc, tcl_trigtup);
/*
* Now the command part of the event for TG_op and data for NEW
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 914,944 ****
*/
if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
{
! Tcl_DStringAppendElement(&tcl_cmd, "INSERT");
! Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
! Tcl_DStringAppendElement(&tcl_cmd, "");
rettup = trigdata->tg_trigtuple;
}
else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event))
{
! Tcl_DStringAppendElement(&tcl_cmd, "DELETE");
! Tcl_DStringAppendElement(&tcl_cmd, "");
! Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
rettup = trigdata->tg_trigtuple;
}
else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
{
! Tcl_DStringAppendElement(&tcl_cmd, "UPDATE");
pltcl_build_tuple_argument(trigdata->tg_newtuple,
! tupdesc, &tcl_newtup);
! Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_newtup));
! Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
rettup = trigdata->tg_newtuple;
}
--- 924,957 ----
*/
if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
{
! Tcl_ListObjAppendElement(NULL, tcl_cmd,
! Tcl_NewStringObj("INSERT",-1));
! Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
! 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, tcl_trigtup);
rettup = trigdata->tg_trigtuple;
}
else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
{
! Tcl_ListObjAppendElement(NULL, tcl_cmd,
! Tcl_NewStringObj("UPDATE",-1));
pltcl_build_tuple_argument(trigdata->tg_newtuple,
! tupdesc, tcl_newtup);
! Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_newtup);
! Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
rettup = trigdata->tg_newtuple;
}
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 947,967 ****
}
else if (TRIGGER_FIRED_FOR_STATEMENT(trigdata->tg_event))
{
! Tcl_DStringAppendElement(&tcl_cmd, "STATEMENT");
if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
! Tcl_DStringAppendElement(&tcl_cmd, "INSERT");
else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event))
! Tcl_DStringAppendElement(&tcl_cmd, "DELETE");
else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
! Tcl_DStringAppendElement(&tcl_cmd, "UPDATE");
else if (TRIGGER_FIRED_BY_TRUNCATE(trigdata->tg_event))
! Tcl_DStringAppendElement(&tcl_cmd, "TRUNCATE");
else
elog(ERROR, "unrecognized OP tg_event: %u", trigdata->tg_event);
! Tcl_DStringAppendElement(&tcl_cmd, "");
! Tcl_DStringAppendElement(&tcl_cmd, "");
rettup = (HeapTuple) NULL;
}
--- 960,985 ----
}
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;
}
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 970,996 ****
/* Finally append the arguments from CREATE TRIGGER */
for (i = 0; i < trigdata->tg_trigger->tgnargs; i++)
! Tcl_DStringAppendElement(&tcl_cmd, trigdata->tg_trigger->tgargs[i]);
}
PG_CATCH();
{
! Tcl_DStringFree(&tcl_cmd);
! Tcl_DStringFree(&tcl_trigtup);
! Tcl_DStringFree(&tcl_newtup);
PG_RE_THROW();
}
PG_END_TRY();
- Tcl_DStringFree(&tcl_trigtup);
- Tcl_DStringFree(&tcl_newtup);
/************************************************************
* Call the Tcl function
*
* We assume no PG error can be thrown directly from this call.
************************************************************/
! tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&tcl_cmd));
! Tcl_DStringFree(&tcl_cmd);
/************************************************************
* Check for errors reported by Tcl.
--- 988,1016 ----
/* Finally append the arguments from CREATE TRIGGER */
for (i = 0; i < trigdata->tg_trigger->tgnargs; i++)
! Tcl_ListObjAppendElement (NULL, tcl_cmd,
! Tcl_NewStringObj (trigdata->tg_trigger->tgargs[i], -1));
}
PG_CATCH();
{
! Tcl_DecrRefCount(tcl_cmd);
! Tcl_DecrRefCount(tcl_trigtup);
! Tcl_DecrRefCount(tcl_newtup);
PG_RE_THROW();
}
PG_END_TRY();
/************************************************************
* Call the Tcl function
*
* We assume no PG error can be thrown directly from this call.
************************************************************/
! Tcl_IncrRefCount(tcl_cmd);
! tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL));
! // Tcl_DecrRefCount(tcl_trigtup);
! // Tcl_DecrRefCount(tcl_newtup);
! Tcl_DecrRefCount(tcl_cmd);
/************************************************************
* Check for errors reported by Tcl.
*************** compile_pltcl_function(Oid fn_oid, Oid t
*** 1399,1404 ****
--- 1419,1428 ----
/************************************************************
* Create the tcl command to define the internal
* procedure
+ *
+ * leave this as DString - it's a text processing function
+ * that only gets invoked when the tcl function is invoked
+ * for the first time
************************************************************/
Tcl_DStringInit(&proc_internal_def);
Tcl_DStringInit(&proc_internal_body);
*************** compile_pltcl_function(Oid fn_oid, Oid t
*** 1497,1534 ****
**********************************************************************/
static int
pltcl_elog(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[])
{
volatile int level;
MemoryContext oldcontext;
! if (argc != 3)
{
! Tcl_SetResult(interp, "syntax error - 'elog level msg'", TCL_STATIC);
return TCL_ERROR;
}
! if (strcmp(argv[1], "DEBUG") == 0)
! level = DEBUG2;
! else if (strcmp(argv[1], "LOG") == 0)
! level = LOG;
! else if (strcmp(argv[1], "INFO") == 0)
! level = INFO;
! else if (strcmp(argv[1], "NOTICE") == 0)
! level = NOTICE;
! else if (strcmp(argv[1], "WARNING") == 0)
! level = WARNING;
! else if (strcmp(argv[1], "ERROR") == 0)
! level = ERROR;
! else if (strcmp(argv[1], "FATAL") == 0)
! level = FATAL;
! else
{
- Tcl_AppendResult(interp, "Unknown elog level '", argv[1],
- "'", NULL);
return TCL_ERROR;
}
if (level == ERROR)
{
/*
--- 1521,1586 ----
**********************************************************************/
static int
pltcl_elog(ClientData cdata, Tcl_Interp *interp,
! int objc, Tcl_Obj * const objv[])
{
volatile int level;
MemoryContext oldcontext;
+ int priIndex;
! enum logpriority
{
! LOG_DEBUG, LOG_LOG, LOG_INFO, LOG_NOTICE,
! LOG_WARNING, LOG_ERROR, LOG_FATAL
! };
!
! static CONST84 char *logpriorities[] = {
! "DEBUG", "LOG", "INFO", "NOTICE",
! "WARNING", "ERROR", "FATAL", (char *) NULL
! };
!
! 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;
}
+ switch ((enum logpriority) priIndex)
+ {
+ case LOG_DEBUG:
+ level = DEBUG2;
+ break;
+
+ case LOG_LOG:
+ level = LOG;
+ break;
+
+ case LOG_INFO:
+ level = INFO;
+ break;
+
+ case LOG_NOTICE:
+ level = NOTICE;
+ break;
+
+ case LOG_WARNING:
+ level = WARNING;
+ break;
+
+ case LOG_ERROR:
+ level = ERROR;
+ break;
+
+ case LOG_FATAL:
+ level = FATAL;
+ break;
+ }
+
if (level == ERROR)
{
/*
*************** pltcl_elog(ClientData cdata, Tcl_Interp
*** 1536,1542 ****
* eventually get converted to a PG error when we reach the call
* handler.
*/
! Tcl_SetResult(interp, (char *) argv[2], TCL_VOLATILE);
return TCL_ERROR;
}
--- 1588,1594 ----
* eventually get converted to a PG error when we reach the call
* handler.
*/
! Tcl_SetObjResult(interp, objv[2]);
return TCL_ERROR;
}
*************** pltcl_elog(ClientData cdata, Tcl_Interp
*** 1553,1559 ****
PG_TRY();
{
UTF_BEGIN;
! elog(level, "%s", UTF_U2E(argv[2]));
UTF_END;
}
PG_CATCH();
--- 1605,1611 ----
PG_TRY();
{
UTF_BEGIN;
! elog(level, "%s", UTF_U2E(Tcl_GetString(objv[2])));
UTF_END;
}
PG_CATCH();
*************** pltcl_elog(ClientData cdata, Tcl_Interp
*** 1567,1573 ****
/* Pass the error message to Tcl */
UTF_BEGIN;
! Tcl_SetResult(interp, UTF_E2U(edata->message), TCL_VOLATILE);
UTF_END;
FreeErrorData(edata);
--- 1619,1625 ----
/* Pass the error message to Tcl */
UTF_BEGIN;
! Tcl_SetObjResult(interp, Tcl_NewStringObj(UTF_E2U(edata->message), -1));
UTF_END;
FreeErrorData(edata);
*************** pltcl_elog(ClientData cdata, Tcl_Interp
*** 1585,1591 ****
**********************************************************************/
static int
pltcl_quote(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[])
{
char *tmp;
const char *cp1;
--- 1637,1643 ----
**********************************************************************/
static int
pltcl_quote(ClientData cdata, Tcl_Interp *interp,
! int objc, Tcl_Obj * const objv[])
{
char *tmp;
const char *cp1;
*************** pltcl_quote(ClientData cdata, Tcl_Interp
*** 1594,1602 ****
/************************************************************
* Check call syntax
************************************************************/
! if (argc != 2)
{
! Tcl_SetResult(interp, "syntax error - 'quote string'", TCL_STATIC);
return TCL_ERROR;
}
--- 1646,1654 ----
/************************************************************
* Check call syntax
************************************************************/
! if (objc != 2)
{
! Tcl_WrongNumArgs(interp, 1, objv, "string");
return TCL_ERROR;
}
*************** pltcl_quote(ClientData cdata, Tcl_Interp
*** 1604,1611 ****
* Allocate space for the maximum the string can
* grow to and initialize pointers
************************************************************/
! tmp = palloc(strlen(argv[1]) * 2 + 1);
! cp1 = argv[1];
cp2 = tmp;
/************************************************************
--- 1656,1663 ----
* Allocate space for the maximum the string can
* grow to and initialize pointers
************************************************************/
! tmp = palloc(strlen(Tcl_GetString(objv[1])) * 2 + 1);
! cp1 = Tcl_GetString(objv[1]);
cp2 = tmp;
/************************************************************
*************** pltcl_quote(ClientData cdata, Tcl_Interp
*** 1627,1633 ****
* Terminate the string and set it as result
************************************************************/
*cp2 = '\0';
! Tcl_SetResult(interp, tmp, TCL_VOLATILE);
pfree(tmp);
return TCL_OK;
}
--- 1679,1685 ----
* Terminate the string and set it as result
************************************************************/
*cp2 = '\0';
! Tcl_SetObjResult(interp, Tcl_NewStringObj(tmp, -1));
pfree(tmp);
return TCL_OK;
}
*************** pltcl_quote(ClientData cdata, Tcl_Interp
*** 1638,1644 ****
**********************************************************************/
static int
pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[])
{
int argno;
FunctionCallInfo fcinfo = pltcl_current_fcinfo;
--- 1690,1696 ----
**********************************************************************/
static int
pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
! int objc, Tcl_Obj * const objv[])
{
int argno;
FunctionCallInfo fcinfo = pltcl_current_fcinfo;
*************** pltcl_argisnull(ClientData cdata, Tcl_In
*** 1646,1655 ****
/************************************************************
* Check call syntax
************************************************************/
! if (argc != 2)
{
! Tcl_SetResult(interp, "syntax error - 'argisnull argno'",
! TCL_STATIC);
return TCL_ERROR;
}
--- 1698,1706 ----
/************************************************************
* Check call syntax
************************************************************/
! if (objc != 2)
{
! Tcl_WrongNumArgs(interp, 1, objv, "argno");
return TCL_ERROR;
}
*************** pltcl_argisnull(ClientData cdata, Tcl_In
*** 1658,1672 ****
************************************************************/
if (fcinfo == NULL)
{
! Tcl_SetResult(interp, "argisnull cannot be used in triggers",
! TCL_STATIC);
return TCL_ERROR;
}
/************************************************************
* Get the argument number
************************************************************/
! if (Tcl_GetInt(interp, argv[1], &argno) != TCL_OK)
return TCL_ERROR;
/************************************************************
--- 1709,1723 ----
************************************************************/
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;
/************************************************************
*************** pltcl_argisnull(ClientData cdata, Tcl_In
*** 1675,1692 ****
argno--;
if (argno < 0 || argno >= fcinfo->nargs)
{
! Tcl_SetResult(interp, "argno out of range", TCL_STATIC);
return TCL_ERROR;
}
/************************************************************
* Get the requested NULL state
************************************************************/
! if (PG_ARGISNULL(argno))
! Tcl_SetResult(interp, "1", TCL_STATIC);
! else
! Tcl_SetResult(interp, "0", TCL_STATIC);
!
return TCL_OK;
}
--- 1726,1740 ----
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_argisnull(ClientData cdata, Tcl_In
*** 1696,1711 ****
**********************************************************************/
static int
pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[])
{
FunctionCallInfo fcinfo = pltcl_current_fcinfo;
/************************************************************
* Check call syntax
************************************************************/
! if (argc != 1)
{
! Tcl_SetResult(interp, "syntax error - 'return_null'", TCL_STATIC);
return TCL_ERROR;
}
--- 1744,1759 ----
**********************************************************************/
static int
pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
! int objc, Tcl_Obj * const objv[])
{
FunctionCallInfo fcinfo = pltcl_current_fcinfo;
/************************************************************
* Check call syntax
************************************************************/
! if (objc != 1)
{
! Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
}
*************** pltcl_returnnull(ClientData cdata, Tcl_I
*** 1714,1721 ****
************************************************************/
if (fcinfo == NULL)
{
! Tcl_SetResult(interp, "return_null cannot be used in triggers",
! TCL_STATIC);
return TCL_ERROR;
}
--- 1762,1769 ----
************************************************************/
if (fcinfo == NULL)
{
! Tcl_SetObjResult(interp,
! Tcl_NewStringObj("return_null cannot be used in triggers", -1));
return TCL_ERROR;
}
*************** pltcl_subtrans_abort(Tcl_Interp *interp,
*** 1814,1831 ****
**********************************************************************/
static int
pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[])
{
int my_rc;
int spi_rc;
int query_idx;
int i;
int count = 0;
CONST84 char *volatile arrayname = NULL;
! CONST84 char *volatile loop_body = NULL;
MemoryContext oldcontext = CurrentMemoryContext;
ResourceOwner oldowner = CurrentResourceOwner;
char *usage = "syntax error - 'SPI_exec "
"?-count n? "
"?-array name? query ?loop body?";
--- 1862,1889 ----
**********************************************************************/
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;
CONST84 char *volatile arrayname = NULL;
! Tcl_Obj *loop_body = NULL;
MemoryContext oldcontext = CurrentMemoryContext;
ResourceOwner oldowner = CurrentResourceOwner;
+ enum options
+ {
+ OPT_ARRAY, OPT_COUNT
+ };
+
+ static CONST84 char *options[] = {
+ "-array", "-count", (char *) NULL
+ };
+
char *usage = "syntax error - 'SPI_exec "
"?-count n? "
"?-array name? query ?loop body?";
*************** pltcl_SPI_execute(ClientData cdata, Tcl_
*** 1833,1881 ****
/************************************************************
* Check the call syntax and get the options
************************************************************/
! if (argc < 2)
{
Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR;
}
i = 1;
! while (i < argc)
{
! if (strcmp(argv[i], "-array") == 0)
{
! if (++i >= argc)
! {
! Tcl_SetResult(interp, usage, TCL_STATIC);
! return TCL_ERROR;
! }
! arrayname = argv[i++];
! continue;
}
! if (strcmp(argv[i], "-count") == 0)
{
! if (++i >= argc)
! {
! Tcl_SetResult(interp, usage, TCL_STATIC);
! return TCL_ERROR;
! }
! if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK)
! return TCL_ERROR;
! continue;
}
! break;
}
query_idx = i;
! if (query_idx >= argc || query_idx + 2 < argc)
{
Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR;
}
! if (query_idx + 1 < argc)
! loop_body = argv[query_idx + 1];
/************************************************************
* Execute the query inside a sub-transaction, so we can cope with
--- 1891,1943 ----
/************************************************************
* Check the call syntax and get the options
************************************************************/
! if (objc < 2)
{
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?-count n? ?-array name? query ?loop body?");
Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR;
}
i = 1;
! while (i < objc)
{
! if (Tcl_GetIndexFromObj(interp, objv[i], options, "option",
! TCL_EXACT, &optIndex) != TCL_OK)
{
! return TCL_ERROR;
}
! 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_SetResult(interp, usage, TCL_STATIC);
+ 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
*************** pltcl_SPI_execute(ClientData cdata, Tcl_
*** 1887,1893 ****
PG_TRY();
{
UTF_BEGIN;
! spi_rc = SPI_execute(UTF_U2E(argv[query_idx]),
pltcl_current_prodesc->fn_readonly, count);
UTF_END;
--- 1949,1955 ----
PG_TRY();
{
UTF_BEGIN;
! spi_rc = SPI_execute(UTF_U2E(Tcl_GetString(objv[query_idx])),
pltcl_current_prodesc->fn_readonly, count);
UTF_END;
*************** pltcl_SPI_execute(ClientData cdata, Tcl_
*** 1918,1930 ****
static int
pltcl_process_SPI_result(Tcl_Interp *interp,
CONST84 char *arrayname,
! CONST84 char *loop_body,
int spi_rc,
SPITupleTable *tuptable,
int ntuples)
{
int my_rc = TCL_OK;
- char buf[64];
int i;
int loop_rc;
HeapTuple *tuples;
--- 1980,1991 ----
static int
pltcl_process_SPI_result(Tcl_Interp *interp,
CONST84 char *arrayname,
! Tcl_Obj * loop_body,
int spi_rc,
SPITupleTable *tuptable,
int ntuples)
{
int my_rc = TCL_OK;
int i;
int loop_rc;
HeapTuple *tuples;
*************** pltcl_process_SPI_result(Tcl_Interp *int
*** 1936,1950 ****
case SPI_OK_INSERT:
case SPI_OK_DELETE:
case SPI_OK_UPDATE:
! snprintf(buf, sizeof(buf), "%d", ntuples);
! Tcl_SetResult(interp, buf, TCL_VOLATILE);
break;
case SPI_OK_UTILITY:
case SPI_OK_REWRITTEN:
if (tuptable == NULL)
{
! Tcl_SetResult(interp, "0", TCL_STATIC);
break;
}
/* FALL THRU for utility returning tuples */
--- 1997,2010 ----
case SPI_OK_INSERT:
case SPI_OK_DELETE:
case SPI_OK_UPDATE:
! Tcl_SetObjResult(interp, Tcl_NewIntObj(ntuples));
break;
case SPI_OK_UTILITY:
case SPI_OK_REWRITTEN:
if (tuptable == NULL)
{
! Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
break;
}
/* FALL THRU for utility returning tuples */
*************** pltcl_process_SPI_result(Tcl_Interp *int
*** 1981,1987 ****
pltcl_set_tuple_values(interp, arrayname, i,
tuples[i], tupdesc);
! loop_rc = Tcl_Eval(interp, loop_body);
if (loop_rc == TCL_OK)
continue;
--- 2041,2047 ----
pltcl_set_tuple_values(interp, arrayname, i,
tuples[i], tupdesc);
! loop_rc = Tcl_EvalObjEx(interp, loop_body, 0);
if (loop_rc == TCL_OK)
continue;
*************** pltcl_process_SPI_result(Tcl_Interp *int
*** 2001,2008 ****
if (my_rc == TCL_OK)
{
! snprintf(buf, sizeof(buf), "%d", ntuples);
! Tcl_SetResult(interp, buf, TCL_VOLATILE);
}
break;
--- 2061,2067 ----
if (my_rc == TCL_OK)
{
! Tcl_SetObjResult(interp, Tcl_NewIntObj(ntuples));
}
break;
*************** pltcl_process_SPI_result(Tcl_Interp *int
*** 2029,2038 ****
**********************************************************************/
static int
pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[])
{
int nargs;
! CONST84 char **args;
pltcl_query_desc *qdesc;
void *plan;
int i;
--- 2088,2097 ----
**********************************************************************/
static int
pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
! int objc, Tcl_Obj * const objv[])
{
int nargs;
! Tcl_Obj **argsObj;
pltcl_query_desc *qdesc;
void *plan;
int i;
*************** pltcl_SPI_prepare(ClientData cdata, Tcl_
*** 2045,2061 ****
/************************************************************
* Check the call syntax
************************************************************/
! if (argc != 3)
{
! Tcl_SetResult(interp, "syntax error - 'SPI_prepare query argtypes'",
! TCL_STATIC);
return TCL_ERROR;
}
/************************************************************
* Split the argument type list
************************************************************/
! if (Tcl_SplitList(interp, argv[2], &nargs, &args) != TCL_OK)
return TCL_ERROR;
/************************************************************
--- 2104,2119 ----
/************************************************************
* 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;
/************************************************************
*************** pltcl_SPI_prepare(ClientData cdata, Tcl_
*** 2089,2095 ****
typIOParam;
int32 typmod;
! parseTypeString(args[i], &typId, &typmod);
getTypeInputInfo(typId, &typInput, &typIOParam);
--- 2147,2153 ----
typIOParam;
int32 typmod;
! parseTypeString(Tcl_GetString(argsObj[i]), &typId, &typmod);
getTypeInputInfo(typId, &typInput, &typIOParam);
*************** pltcl_SPI_prepare(ClientData cdata, Tcl_
*** 2102,2108 ****
* Prepare the plan and check for errors
************************************************************/
UTF_BEGIN;
! plan = SPI_prepare(UTF_U2E(argv[1]), nargs, qdesc->argtypes);
UTF_END;
if (plan == NULL)
--- 2160,2166 ----
* Prepare the plan and check for errors
************************************************************/
UTF_BEGIN;
! plan = SPI_prepare(UTF_U2E(Tcl_GetString(argsObj[1])), nargs, qdesc->argtypes);
UTF_END;
if (plan == NULL)
*************** pltcl_SPI_prepare(ClientData cdata, Tcl_
*** 2129,2135 ****
free(qdesc->arginfuncs);
free(qdesc->argtypioparams);
free(qdesc);
! ckfree((char *) args);
return TCL_ERROR;
}
--- 2187,2193 ----
free(qdesc->arginfuncs);
free(qdesc->argtypioparams);
free(qdesc);
! /* ckfree((char *) args); */
return TCL_ERROR;
}
*************** pltcl_SPI_prepare(ClientData cdata, Tcl_
*** 2144,2153 ****
hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew);
Tcl_SetHashValue(hashent, (ClientData) qdesc);
! ckfree((char *) args);
/* qname is ASCII, so no need for encoding conversion */
! Tcl_SetResult(interp, qdesc->qname, TCL_VOLATILE);
return TCL_OK;
}
--- 2202,2211 ----
hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew);
Tcl_SetHashValue(hashent, (ClientData) qdesc);
! /* ckfree((char *) args); */
/* qname is ASCII, so no need for encoding conversion */
! Tcl_SetObjResult(interp, Tcl_NewStringObj(qdesc->qname, -1));
return TCL_OK;
}
*************** pltcl_SPI_prepare(ClientData cdata, Tcl_
*** 2157,2173 ****
**********************************************************************/
static int
pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[])
{
int my_rc;
int spi_rc;
int i;
int j;
Tcl_HashEntry *hashent;
pltcl_query_desc *qdesc;
const char *volatile nulls = NULL;
CONST84 char *volatile arrayname = NULL;
! CONST84 char *volatile loop_body = NULL;
int count = 0;
int callnargs;
CONST84 char **callargs = NULL;
--- 2215,2232 ----
**********************************************************************/
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 *volatile nulls = NULL;
CONST84 char *volatile arrayname = NULL;
! Tcl_Obj *loop_body = NULL;
int count = 0;
int callnargs;
CONST84 char **callargs = NULL;
*************** pltcl_SPI_execute_plan(ClientData cdata,
*** 2176,2181 ****
--- 2235,2249 ----
ResourceOwner oldowner = CurrentResourceOwner;
Tcl_HashTable *query_hash;
+ enum options
+ {
+ OPT_ARRAY, OPT_COUNT, OPT_NULLS
+ };
+
+ static CONST84 char *options[] = {
+ "-array", "-count", "-nulls", (char *) NULL
+ };
+
char *usage = "syntax error - 'SPI_execp "
"?-nulls string? ?-count n? "
"?-array name? query ?args? ?loop body?";
*************** pltcl_SPI_execute_plan(ClientData cdata,
*** 2184,2241 ****
* Get the options and check syntax
************************************************************/
i = 1;
! while (i < argc)
{
! if (strcmp(argv[i], "-array") == 0)
{
! if (++i >= argc)
! {
! Tcl_SetResult(interp, usage, TCL_STATIC);
! return TCL_ERROR;
! }
! arrayname = argv[i++];
! continue;
}
! if (strcmp(argv[i], "-nulls") == 0)
{
! if (++i >= argc)
! {
! Tcl_SetResult(interp, usage, TCL_STATIC);
! return TCL_ERROR;
! }
! nulls = argv[i++];
! continue;
}
! if (strcmp(argv[i], "-count") == 0)
{
! if (++i >= argc)
! {
! Tcl_SetResult(interp, usage, TCL_STATIC);
! return TCL_ERROR;
! }
! if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK)
! return TCL_ERROR;
! continue;
! }
! break;
}
/************************************************************
* Get the prepared plan descriptor by its key
************************************************************/
! if (i >= argc)
{
! Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR;
}
query_hash = &pltcl_current_prodesc->interp_desc->query_hash;
! hashent = Tcl_FindHashEntry(query_hash, argv[i]);
if (hashent == NULL)
{
! Tcl_AppendResult(interp, "invalid queryid '", argv[i], "'", NULL);
return TCL_ERROR;
}
qdesc = (pltcl_query_desc *) Tcl_GetHashValue(hashent);
--- 2252,2305 ----
* Get the options and check syntax
************************************************************/
i = 1;
! while (i < objc)
{
! if (Tcl_GetIndexFromObj(interp, objv[i], options, "option",
! TCL_EXACT, &optIndex) != TCL_OK)
{
! return TCL_ERROR;
}
!
! 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;
!
! 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_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);
*************** pltcl_SPI_execute_plan(ClientData cdata,
*** 2261,2267 ****
************************************************************/
if (qdesc->nargs > 0)
{
! if (i >= argc)
{
Tcl_SetResult(interp, "missing argument list", TCL_STATIC);
return TCL_ERROR;
--- 2325,2331 ----
************************************************************/
if (qdesc->nargs > 0)
{
! if (i >= objc)
{
Tcl_SetResult(interp, "missing argument list", TCL_STATIC);
return TCL_ERROR;
*************** pltcl_SPI_execute_plan(ClientData cdata,
*** 2270,2276 ****
/************************************************************
* Split the argument values
************************************************************/
! if (Tcl_SplitList(interp, argv[i++], &callnargs, &callargs) != TCL_OK)
return TCL_ERROR;
/************************************************************
--- 2334,2340 ----
/************************************************************
* Split the argument values
************************************************************/
! if (Tcl_SplitList(interp, Tcl_GetString(objv[i++]), &callnargs, &callargs) != TCL_OK)
return TCL_ERROR;
/************************************************************
*************** pltcl_SPI_execute_plan(ClientData cdata,
*** 2291,2300 ****
/************************************************************
* Get loop body if present
************************************************************/
! if (i < argc)
! loop_body = argv[i++];
! if (i != argc)
{
Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR;
--- 2355,2364 ----
/************************************************************
* Get loop body if present
************************************************************/
! if (i < objc)
! loop_body = objv[i++];
! if (i != objc)
{
Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR;
*************** pltcl_SPI_execute_plan(ClientData cdata,
*** 2375,2386 ****
**********************************************************************/
static int
pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
! int argc, CONST84 char *argv[])
{
! char buf[64];
!
! snprintf(buf, sizeof(buf), "%u", SPI_lastoid);
! Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_OK;
}
--- 2439,2447 ----
**********************************************************************/
static int
pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
! int objc, Tcl_Obj * const objv[])
{
! Tcl_SetObjResult(interp, Tcl_NewWideIntObj(SPI_lastoid));
return TCL_OK;
}
*************** pltcl_set_tuple_values(Tcl_Interp *inter
*** 2395,2401 ****
{
int i;
char *outputstr;
- char buf[64];
Datum attr;
bool isnull;
--- 2456,2461 ----
*************** pltcl_set_tuple_values(Tcl_Interp *inter
*** 2420,2427 ****
{
arrptr = &arrayname;
nameptr = &attname;
! snprintf(buf, sizeof(buf), "%d", tupno);
! Tcl_SetVar2(interp, arrayname, ".tupno", buf, 0);
}
for (i = 0; i < tupdesc->natts; i++)
--- 2480,2486 ----
{
arrptr = &arrayname;
nameptr = &attname;
! Tcl_SetVar2Ex(interp, arrayname, ".tupno", Tcl_NewIntObj(tupno), 0);
}
for (i = 0; i < tupdesc->natts; i++)
*************** pltcl_set_tuple_values(Tcl_Interp *inter
*** 2465,2471 ****
{
outputstr = OidOutputFunctionCall(typoutput, attr);
UTF_BEGIN;
! Tcl_SetVar2(interp, *arrptr, *nameptr, UTF_E2U(outputstr), 0);
UTF_END;
pfree(outputstr);
}
--- 2524,2531 ----
{
outputstr = OidOutputFunctionCall(typoutput, attr);
UTF_BEGIN;
! Tcl_SetVar2Ex(interp, *arrptr, *nameptr,
! Tcl_NewStringObj(UTF_E2U(outputstr), -1), 0);
UTF_END;
pfree(outputstr);
}
*************** pltcl_set_tuple_values(Tcl_Interp *inter
*** 2481,2487 ****
**********************************************************************/
static void
pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
! Tcl_DString *retval)
{
int i;
char *outputstr;
--- 2541,2547 ----
**********************************************************************/
static void
pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
! Tcl_Obj *retobj)
{
int i;
char *outputstr;
*************** pltcl_build_tuple_argument(HeapTuple tup
*** 2532,2540 ****
if (!isnull && OidIsValid(typoutput))
{
outputstr = OidOutputFunctionCall(typoutput, attr);
! Tcl_DStringAppendElement(retval, attname);
UTF_BEGIN;
! Tcl_DStringAppendElement(retval, UTF_E2U(outputstr));
UTF_END;
pfree(outputstr);
}
--- 2592,2601 ----
if (!isnull && OidIsValid(typoutput))
{
outputstr = OidOutputFunctionCall(typoutput, attr);
! Tcl_ListObjAppendElement (NULL, retobj,
! Tcl_NewStringObj (attname, -1));
UTF_BEGIN;
! Tcl_ListObjAppendElement(NULL, retobj, Tcl_NewStringObj(UTF_E2U(outputstr), -1));
UTF_END;
pfree(outputstr);
}
pltcl-karl-try3-3-of-3-setof.patchapplication/octet-stream; name=pltcl-karl-try3-3-of-3-setof.patchDownload
diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c
index 1efdb2d..4737a5b 100644
*** a/src/pl/tcl/pltcl.c
--- b/src/pl/tcl/pltcl.c
***************
*** 33,49 ****
#include "utils/memutils.h"
#include "utils/syscache.h"
#include "utils/typcache.h"
#define HAVE_TCL_VERSION(maj,min) \
((TCL_MAJOR_VERSION > maj) || \
(TCL_MAJOR_VERSION == maj && TCL_MINOR_VERSION >= min))
- /* In Tcl >= 8.0, really not supposed to touch interp->result directly */
- #if !HAVE_TCL_VERSION(8,0)
- #define Tcl_GetStringResult(interp) ((interp)->result)
- #endif
-
/* define our text domain for translations */
#undef TEXTDOMAIN
#define TEXTDOMAIN PG_TEXTDOMAIN("pltcl")
--- 33,45 ----
#include "utils/memutils.h"
#include "utils/syscache.h"
#include "utils/typcache.h"
+ #include "funcapi.h"
#define HAVE_TCL_VERSION(maj,min) \
((TCL_MAJOR_VERSION > maj) || \
(TCL_MAJOR_VERSION == maj && TCL_MINOR_VERSION >= min))
/* define our text domain for translations */
#undef TEXTDOMAIN
#define TEXTDOMAIN PG_TEXTDOMAIN("pltcl")
*************** typedef struct pltcl_proc_desc
*** 112,123 ****
--- 108,129 ----
ItemPointerData fn_tid;
bool fn_readonly;
bool lanpltrusted;
+ bool fn_retistuple; /* true, if function returns tuple */
+ bool fn_retisset; /* true, if function returns a set */
pltcl_interp_desc *interp_desc;
FmgrInfo result_in_func;
Oid result_typioparam;
int nargs;
FmgrInfo arg_out_func[FUNC_MAX_ARGS];
bool arg_is_rowtype[FUNC_MAX_ARGS];
+
+ TupleDesc ret_tupdesc;
+ Tuplestorestate *tuple_store; /* SRFs accumulate result here */
+ AttInMetadata *attinmeta;
+ int natts;
+ MemoryContext tuple_store_cxt;
+ ResourceOwner tuple_store_owner;
+ ReturnSetInfo *rsi;
} pltcl_proc_desc;
*************** static void pltcl_init_interp(pltcl_inte
*** 188,204 ****
static pltcl_interp_desc *pltcl_fetch_interp(bool pltrusted);
static void pltcl_init_load_unknown(Tcl_Interp *interp);
! static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted);
! static Datum pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted);
! static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS, 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 pltrusted);
static int pltcl_elog(ClientData cdata, Tcl_Interp *interp,
int objc, Tcl_Obj * const objv[]);
static int pltcl_quote(ClientData cdata, Tcl_Interp *interp,
--- 194,213 ----
static pltcl_interp_desc *pltcl_fetch_interp(bool pltrusted);
static void pltcl_init_load_unknown(Tcl_Interp *interp);
! static Datum pltcl_handler(FunctionCallInfo fcinfo, bool pltrusted);
! static Datum pltcl_func_handler(FunctionCallInfo fcinfo, bool pltrusted);
! static HeapTuple pltcl_trigger_handler(FunctionCallInfo fcinfo, 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 pltrusted);
+ static void
+ pltcl_pg_returnnext(Tcl_Interp *interp, int rowObjc, Tcl_Obj ** rowObjv);
+
static int pltcl_elog(ClientData cdata, Tcl_Interp *interp,
int objc, Tcl_Obj * const objv[]);
static int pltcl_quote(ClientData cdata, Tcl_Interp *interp,
*************** static int pltcl_argisnull(ClientData cd
*** 207,212 ****
--- 216,223 ----
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_SPI_lastoid(ClientData
*** 226,232 ****
static void pltcl_set_tuple_values(Tcl_Interp *interp, CONST84 char *arrayname,
int tupno, HeapTuple tuple, TupleDesc tupdesc);
static void pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
! Tcl_Obj *retobj);
/*
--- 237,244 ----
static void pltcl_set_tuple_values(Tcl_Interp *interp, CONST84 char *arrayname,
int tupno, HeapTuple tuple, TupleDesc tupdesc);
static void pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
! Tcl_Obj * retobj);
! static void pltcl_init_tuple_store(pltcl_proc_desc *prodesc);
/*
*************** pltcl_WaitForEvent(Tcl_Time *timePtr)
*** 289,294 ****
--- 301,366 ----
}
#endif /* HAVE_TCL_VERSION(8,4) */
+ static HeapTuple
+ pltcl_build_tuple_result(Tcl_Interp *interp, Tcl_Obj ** kvObjv, int kvObjc, pltcl_proc_desc *prodesc)
+ {
+ HeapTuple tup;
+ char **values;
+ int i;
+
+ values = (char **) palloc0(prodesc->natts * sizeof(char *));
+
+ for (i = 0; i < kvObjc; i += 2)
+ {
+ char *fieldName = Tcl_GetString(kvObjv[i]);
+ int attn = SPI_fnumber(prodesc->ret_tupdesc, fieldName);
+
+ if (attn <= 0 || prodesc->ret_tupdesc->attrs[attn - 1]->attisdropped)
+ ereport(ERROR,
+ (errcode(ERRCODE_UNDEFINED_COLUMN),
+ errmsg("Tcl list contains nonexistent column \"%s\"",
+ fieldName)));
+
+ UTF_BEGIN;
+ values[attn - 1] = UTF_E2U(Tcl_GetString(kvObjv[i + 1]));
+ UTF_END;
+ }
+
+ tup = BuildTupleFromCStrings(prodesc->attinmeta, values);
+ pfree(values);
+ return tup;
+ }
+
+ /**********************************************************************
+ * pltcl_reset_state() - reset function's runtime state
+ *
+ * This is called on function and trigger entry
+ * (pltcl_func_handler and pltcl_trigger_handler) to clear
+ * any previous results.
+ *
+ * rsi is present if it's a function but not if it's a trigger.
+ **********************************************************************/
+ static void
+ pltcl_reset_state(pltcl_proc_desc *prodesc, ReturnSetInfo *rsi)
+ {
+ prodesc->ret_tupdesc = NULL;
+ prodesc->tuple_store = NULL;
+ prodesc->attinmeta = NULL;
+ prodesc->natts = 0;
+
+ if (rsi)
+ {
+ prodesc->tuple_store_cxt = rsi->econtext->ecxt_per_query_memory;
+ prodesc->tuple_store_owner = CurrentResourceOwner;
+ }
+ else
+ {
+ prodesc->tuple_store_cxt = NULL;
+ prodesc->tuple_store_owner = NULL;
+ }
+
+ prodesc->rsi = rsi;
+ }
/*
* This routine is a crock, and so is everyplace that calls it. The problem
*************** pltcl_init_interp(pltcl_interp_desc *int
*** 423,428 ****
--- 495,502 ----
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);
*************** pltclu_call_handler(PG_FUNCTION_ARGS)
*** 612,619 ****
}
static Datum
! pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted)
{
Datum retval;
FunctionCallInfo save_fcinfo;
--- 686,697 ----
}
+ /**********************************************************************
+ * pltcl_handler() - Handler for function and trigger calls, for
+ * both trusted and untrusted interpreters.
+ **********************************************************************/
static Datum
! pltcl_handler(FunctionCallInfo fcinfo, bool pltrusted)
{
Datum retval;
FunctionCallInfo save_fcinfo;
*************** pltcl_handler(PG_FUNCTION_ARGS, bool plt
*** 633,643 ****
--- 711,723 ----
*/
if (CALLED_AS_TRIGGER(fcinfo))
{
+ /* invoke the trigger handler */
pltcl_current_fcinfo = NULL;
retval = PointerGetDatum(pltcl_trigger_handler(fcinfo, pltrusted));
}
else
{
+ /* invoke the function handler */
pltcl_current_fcinfo = fcinfo;
retval = pltcl_func_handler(fcinfo, pltrusted);
}
*************** pltcl_handler(PG_FUNCTION_ARGS, bool plt
*** 661,667 ****
* pltcl_func_handler() - Handler for regular function calls
**********************************************************************/
static Datum
! pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted)
{
pltcl_proc_desc *prodesc;
Tcl_Interp *volatile interp;
--- 741,747 ----
* pltcl_func_handler() - Handler for regular function calls
**********************************************************************/
static Datum
! pltcl_func_handler(FunctionCallInfo fcinfo, bool pltrusted)
{
pltcl_proc_desc *prodesc;
Tcl_Interp *volatile interp;
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 678,694 ****
prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, InvalidOid,
pltrusted);
pltcl_current_prodesc = prodesc;
-
interp = prodesc->interp_desc->interp;
/************************************************************
* 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));
/************************************************************
* Add all call arguments to the command
--- 758,780 ----
prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, InvalidOid,
pltrusted);
+ /*
+ * globally store current proc description, this can be redone using
+ * clientdata-type structures and eventually allow threading or something
+ */
pltcl_current_prodesc = prodesc;
interp = prodesc->interp_desc->interp;
+ /* reset essential function runtime to a known state */
+ pltcl_reset_state(prodesc, (ReturnSetInfo *) fcinfo->resultinfo);
+
/************************************************************
* 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));
/************************************************************
* Add all call arguments to the command
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 703,709 ****
* For tuple values, add a list for 'array set ...'
**************************************************/
if (fcinfo->argnull[i])
! Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
else
{
HeapTupleHeader td;
--- 789,795 ----
* For tuple values, add a list for 'array set ...'
**************************************************/
if (fcinfo->argnull[i])
! Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
else
{
HeapTupleHeader td;
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 736,742 ****
* of their external representation
**************************************************/
if (fcinfo->argnull[i])
! Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
else
{
char *tmp;
--- 822,828 ----
* of their external representation
**************************************************/
if (fcinfo->argnull[i])
! Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
else
{
char *tmp;
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 745,751 ****
fcinfo->arg[i]);
UTF_BEGIN;
Tcl_ListObjAppendElement(NULL, tcl_cmd,
! Tcl_NewStringObj(UTF_E2U(tmp), -1));
UTF_END;
pfree(tmp);
}
--- 831,837 ----
fcinfo->arg[i]);
UTF_BEGIN;
Tcl_ListObjAppendElement(NULL, tcl_cmd,
! Tcl_NewStringObj(UTF_E2U(tmp), -1));
UTF_END;
pfree(tmp);
}
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 765,772 ****
* We assume no PG error can be thrown directly from this call.
************************************************************/
Tcl_IncrRefCount(tcl_cmd);
! tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL));
! Tcl_DecrRefCount(tcl_cmd);
/************************************************************
* Check for errors reported by Tcl.
--- 851,857 ----
* We assume no PG error can be thrown directly from this call.
************************************************************/
Tcl_IncrRefCount(tcl_cmd);
! tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL));
/************************************************************
* Check for errors reported by Tcl.
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 774,779 ****
--- 859,870 ----
if (tcl_rc != TCL_OK)
throw_tcl_error(interp, prodesc->user_proname);
+ /*
+ * Don't get rid of tcl_cmd until after throwing the error because with
+ * tcl objects it can be referenced from the error handler
+ */
+ Tcl_DecrRefCount(tcl_cmd);
+
/************************************************************
* Disconnect from SPI manager and then create the return
* value datum (if the input function does a palloc for it
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 791,796 ****
--- 882,953 ----
NULL,
prodesc->result_typioparam,
-1);
+ else if (prodesc->fn_retisset)
+ {
+ ReturnSetInfo *rsi = prodesc->rsi;
+
+ 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")));
+
+ rsi->returnMode = SFRM_Materialize;
+
+ /* If we produced any tuples, send back the result */
+ if (prodesc->tuple_store)
+ {
+ rsi->setResult = prodesc->tuple_store;
+ if (prodesc->ret_tupdesc)
+ {
+ MemoryContext oldcxt;
+
+ oldcxt = MemoryContextSwitchTo(prodesc->tuple_store_cxt);
+ rsi->setDesc = CreateTupleDescCopy(prodesc->ret_tupdesc);
+ MemoryContextSwitchTo(oldcxt);
+ }
+ }
+ retval = (Datum) 0;
+ fcinfo->isnull = true;
+ }
+ else if (prodesc->fn_retistuple)
+ {
+ TupleDesc td;
+ HeapTuple tup;
+ Tcl_Obj *resultObj;
+ Tcl_Obj **resultObjv;
+ int resultObjc;
+
+ if (get_call_result_type(fcinfo, NULL, &td) != TYPEFUNC_COMPOSITE)
+ {
+ ereport(ERROR,
+ (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
+ errmsg("function returning record called in context "
+ "that cannot accept type record")));
+ }
+
+ resultObj = Tcl_GetObjResult(interp);
+ if (Tcl_ListObjGetElements(interp, resultObj, &resultObjc, &resultObjv) == TCL_ERROR)
+ {
+ return TCL_ERROR;
+ }
+
+ if (resultObjc & 1)
+ {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("list must have even number of elements", -1));
+ return TCL_ERROR;
+ }
+
+ Assert(!prodesc->ret_tupdesc);
+ Assert(!prodesc->attinmeta);
+ prodesc->ret_tupdesc = td;
+ prodesc->natts = td->natts;
+ prodesc->attinmeta = TupleDescGetAttInMetadata(prodesc->ret_tupdesc);
+
+ tup = pltcl_build_tuple_result(interp, resultObjv, resultObjc, prodesc);
+ retval = HeapTupleGetDatum(tup);
+ }
else
{
UTF_BEGIN;
*************** pltcl_func_handler(PG_FUNCTION_ARGS, boo
*** 809,815 ****
* pltcl_trigger_handler() - Handler for trigger calls
**********************************************************************/
static HeapTuple
! pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted)
{
pltcl_proc_desc *prodesc;
Tcl_Interp *volatile interp;
--- 966,972 ----
* pltcl_trigger_handler() - Handler for trigger calls
**********************************************************************/
static HeapTuple
! pltcl_trigger_handler(FunctionCallInfo fcinfo, bool pltrusted)
{
pltcl_proc_desc *prodesc;
Tcl_Interp *volatile interp;
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 839,849 ****
pltrusted);
pltcl_current_prodesc = prodesc;
-
interp = prodesc->interp_desc->interp;
-
tupdesc = trigdata->tg_relation->rd_att;
/************************************************************
* Create the tcl command to call the internal
* proc in the interpreter
--- 996,1006 ----
pltrusted);
pltcl_current_prodesc = prodesc;
interp = prodesc->interp_desc->interp;
tupdesc = trigdata->tg_relation->rd_att;
+ pltcl_reset_state(prodesc, NULL);
+
/************************************************************
* Create the tcl command to call the internal
* proc in the interpreter
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 855,884 ****
{
/* The procedure name */
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(trigdata->tg_trigger->tgname, -1));
/* The oid of the trigger relation for argument TG_relid */
/* NB don't convert 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(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(stroid, -1));
pfree(stroid);
/* A list of attribute names for argument TG_relatts */
--- 1012,1041 ----
{
/* The procedure name */
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(trigdata->tg_trigger->tgname, -1));
/* The oid of the trigger relation for argument TG_relid */
/* NB don't convert 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(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(stroid, -1));
pfree(stroid);
/* A list of attribute names for argument TG_relatts */
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 886,918 ****
for (i = 0; i < tupdesc->natts; i++)
{
if (tupdesc->attrs[i]->attisdropped)
! Tcl_ListObjAppendElement(NULL, tcl_trigtup, Tcl_NewObj());
else
! Tcl_ListObjAppendElement(NULL, tcl_trigtup,
! Tcl_NewStringObj(NameStr(tupdesc->attrs[i]->attname), -1));
}
Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
! // Tcl_DecrRefCount(tcl_trigtup);
! tcl_trigtup = Tcl_NewObj ();
/* 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));
/* Build the data list for the trigtuple */
pltcl_build_tuple_argument(trigdata->tg_trigtuple,
--- 1043,1075 ----
for (i = 0; i < tupdesc->natts; i++)
{
if (tupdesc->attrs[i]->attisdropped)
! Tcl_ListObjAppendElement(NULL, tcl_trigtup, Tcl_NewObj());
else
! Tcl_ListObjAppendElement(NULL, tcl_trigtup,
! Tcl_NewStringObj(NameStr(tupdesc->attrs[i]->attname), -1));
}
Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
! /* Tcl_DecrRefCount(tcl_trigtup); */
! tcl_trigtup = Tcl_NewObj();
/* 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));
/* Build the data list for the trigtuple */
pltcl_build_tuple_argument(trigdata->tg_trigtuple,
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 925,931 ****
if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
{
Tcl_ListObjAppendElement(NULL, tcl_cmd,
! Tcl_NewStringObj("INSERT",-1));
Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
--- 1082,1088 ----
if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
{
Tcl_ListObjAppendElement(NULL, tcl_cmd,
! Tcl_NewStringObj("INSERT", -1));
Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 935,941 ****
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, tcl_trigtup);
--- 1092,1098 ----
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, tcl_trigtup);
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 945,951 ****
else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
{
Tcl_ListObjAppendElement(NULL, tcl_cmd,
! Tcl_NewStringObj("UPDATE",-1));
pltcl_build_tuple_argument(trigdata->tg_newtuple,
tupdesc, tcl_newtup);
--- 1102,1108 ----
else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
{
Tcl_ListObjAppendElement(NULL, tcl_cmd,
! Tcl_NewStringObj("UPDATE", -1));
pltcl_build_tuple_argument(trigdata->tg_newtuple,
tupdesc, tcl_newtup);
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 961,980 ****
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);
--- 1118,1137 ----
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);
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 988,1000 ****
/* Finally append the arguments from CREATE TRIGGER */
for (i = 0; i < trigdata->tg_trigger->tgnargs; i++)
! Tcl_ListObjAppendElement (NULL, tcl_cmd,
! Tcl_NewStringObj (trigdata->tg_trigger->tgargs[i], -1));
}
PG_CATCH();
{
! Tcl_DecrRefCount(tcl_cmd);
Tcl_DecrRefCount(tcl_trigtup);
Tcl_DecrRefCount(tcl_newtup);
PG_RE_THROW();
--- 1145,1157 ----
/* Finally append the arguments from CREATE TRIGGER */
for (i = 0; i < trigdata->tg_trigger->tgnargs; i++)
! Tcl_ListObjAppendElement(NULL, tcl_cmd,
! Tcl_NewStringObj(trigdata->tg_trigger->tgargs[i], -1));
}
PG_CATCH();
{
! Tcl_DecrRefCount(tcl_cmd);
Tcl_DecrRefCount(tcl_trigtup);
Tcl_DecrRefCount(tcl_newtup);
PG_RE_THROW();
*************** pltcl_trigger_handler(PG_FUNCTION_ARGS,
*** 1007,1015 ****
* We assume no PG error can be thrown directly from this call.
************************************************************/
Tcl_IncrRefCount(tcl_cmd);
! tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL));
! // Tcl_DecrRefCount(tcl_trigtup);
! // Tcl_DecrRefCount(tcl_newtup);
Tcl_DecrRefCount(tcl_cmd);
/************************************************************
--- 1164,1172 ----
* We assume no PG error can be thrown directly from this call.
************************************************************/
Tcl_IncrRefCount(tcl_cmd);
! tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL));
! /* Tcl_DecrRefCount(tcl_trigtup); */
! /* Tcl_DecrRefCount(tcl_newtup); */
Tcl_DecrRefCount(tcl_cmd);
/************************************************************
*************** throw_tcl_error(Tcl_Interp *interp, cons
*** 1172,1177 ****
--- 1329,1379 ----
UTF_END;
}
+ static void
+ pltcl_init_tuple_store(pltcl_proc_desc *prodesc)
+ {
+ ReturnSetInfo *rsi = prodesc->rsi;
+ MemoryContext oldcxt;
+ ResourceOwner oldowner;
+
+ /*
+ * Check caller can handle a set result in the way we want
+ */
+ if (!rsi || !IsA(rsi, ReturnSetInfo) ||
+ (rsi->allowedModes & SFRM_Materialize) == 0 ||
+ rsi->expectedDesc == NULL)
+ ereport(ERROR,
+ (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
+ errmsg("set-valued function called in context that cannot accept a set")));
+
+ Assert(!prodesc->tuple_store);
+ Assert(!prodesc->attinmeta);
+
+ /*
+ * Switch to the right memory context and resource owner for storing the
+ * tuplestore for return set. 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 resource owner.
+ */
+ prodesc->ret_tupdesc = rsi->expectedDesc;
+ prodesc->natts = prodesc->ret_tupdesc->natts;
+
+ oldcxt = MemoryContextSwitchTo(prodesc->tuple_store_cxt);
+ oldowner = CurrentResourceOwner;
+ CurrentResourceOwner = prodesc->tuple_store_owner;
+
+ prodesc->tuple_store =
+ tuplestore_begin_heap(rsi->allowedModes & SFRM_Materialize_Random,
+ false, work_mem);
+
+ prodesc->attinmeta = TupleDescGetAttInMetadata(prodesc->ret_tupdesc);
+
+ CurrentResourceOwner = oldowner;
+ MemoryContextSwitchTo(oldcxt);
+
+ }
+
/**********************************************************************
* compile_pltcl_function - compile (or hopefully just look up) function
*************** compile_pltcl_function(Oid fn_oid, Oid t
*** 1251,1256 ****
--- 1453,1459 ----
Tcl_Interp *interp;
int i;
int tcl_rc;
+ FunctionCallInfo fcinfo = pltcl_current_fcinfo;
/************************************************************
* Build our internal proc name from the function's Oid. Append
*************** compile_pltcl_function(Oid fn_oid, Oid t
*** 1288,1293 ****
--- 1491,1507 ----
/* And whether it is trusted */
prodesc->lanpltrusted = pltrusted;
+ /* not necessary since MemSet 0 above */
+ prodesc->fn_retistuple = false;
+ prodesc->fn_retisset = false;
+ prodesc->tuple_store_cxt = NULL;
+ prodesc->tuple_store_owner = NULL;
+ prodesc->tuple_store = NULL;
+ prodesc->ret_tupdesc = NULL;
+ prodesc->attinmeta = NULL;
+ prodesc->natts = 0;
+
+
/************************************************************
* Identify the interpreter to use for the function
************************************************************/
*************** compile_pltcl_function(Oid fn_oid, Oid t
*** 1300,1305 ****
--- 1514,1526 ----
************************************************************/
if (!is_trigger)
{
+ prodesc->rsi = (ReturnSetInfo *) fcinfo->resultinfo;
+ if (prodesc->rsi)
+ {
+ prodesc->tuple_store_cxt = prodesc->rsi->econtext->ecxt_per_query_memory;
+ prodesc->tuple_store_owner = CurrentResourceOwner;
+ }
+
typeTup =
SearchSysCache1(TYPEOID,
ObjectIdGetDatum(procStruct->prorettype));
*************** compile_pltcl_function(Oid fn_oid, Oid t
*** 1327,1332 ****
--- 1548,1555 ----
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
errmsg("trigger functions can only be called as triggers")));
}
+ else if (procStruct->prorettype == RECORDOID)
+ ;
else
{
free(prodesc->user_proname);
*************** compile_pltcl_function(Oid fn_oid, Oid t
*** 1339,1353 ****
}
}
! if (typeStruct->typtype == TYPTYPE_COMPOSITE)
! {
! free(prodesc->user_proname);
! free(prodesc->internal_proname);
! free(prodesc);
! ereport(ERROR,
! (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
! errmsg("PL/Tcl functions cannot return composite types")));
! }
perm_fmgr_info(typeStruct->typinput, &(prodesc->result_in_func));
prodesc->result_typioparam = getTypeIOParam(typeTup);
--- 1562,1570 ----
}
}
! prodesc->fn_retisset = procStruct->proretset;
! prodesc->fn_retistuple = (procStruct->prorettype == RECORDOID ||
! typeStruct->typtype == TYPTYPE_COMPOSITE);
perm_fmgr_info(typeStruct->typinput, &(prodesc->result_in_func));
prodesc->result_typioparam = getTypeIOParam(typeTup);
*************** pltcl_returnnull(ClientData cdata, Tcl_I
*** 1776,1781 ****
--- 1993,2086 ----
return TCL_RETURN;
}
+ /**********************************************************************
+ * pltcl_pg_returnnext() - Queue a row of Tcl key-value pairs into the
+ * function's tuple_store
+ **********************************************************************/
+ static void
+ pltcl_pg_returnnext(Tcl_Interp *interp, int rowObjc, Tcl_Obj ** rowObjv)
+ {
+ pltcl_proc_desc *prodesc = pltcl_current_prodesc;
+
+ if (!prodesc->fn_retisset)
+ ereport(ERROR,
+ (errcode(ERRCODE_SYNTAX_ERROR),
+ errmsg("cannot use return_next in a non-SETOF function")));
+
+ if (prodesc->tuple_store == NULL)
+ pltcl_init_tuple_store(prodesc);
+
+ if (prodesc->fn_retistuple)
+ {
+ HeapTuple tuple;
+
+ tuple = pltcl_build_tuple_result(interp, rowObjv, rowObjc, prodesc);
+ tuplestore_puttuple(prodesc->tuple_store, tuple);
+ }
+ else
+ {
+ ereport(ERROR,
+ (errcode(ERRCODE_SYNTAX_ERROR),
+ errmsg("unprepared for non-retistuple state at this point")));
+ }
+ }
+
+ /**********************************************************************
+ * pltcl_returnnext() - Tcl-callable command take a list of key-value
+ * pairs and store in the tuple_store
+ * for sending as a result when the
+ * function is complete.
+ **********************************************************************/
+ static int
+ pltcl_returnnext(ClientData cdata, Tcl_Interp *interp,
+ int objc, Tcl_Obj * const objv[])
+ {
+ FunctionCallInfo fcinfo = pltcl_current_fcinfo;
+ Tcl_Obj **rowObjv;
+ int rowObjc;
+ pltcl_proc_desc *prodesc = pltcl_current_prodesc;
+
+ /************************************************************
+ * Check call syntax
+ ************************************************************/
+ if (objc != 2)
+ {
+ Tcl_WrongNumArgs(interp, 1, objv, "list");
+ return TCL_ERROR;
+ }
+
+ /************************************************************
+ * Check that we're called as a normal 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("cannot use return_next in a non-SETOF function", -1));
+ return TCL_ERROR;
+ }
+
+ if (Tcl_ListObjGetElements(interp, objv[1], &rowObjc, &rowObjv) == TCL_ERROR)
+ {
+ return TCL_ERROR;
+ }
+
+ if (rowObjc & 1)
+ {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("list must have even number of elements", -1));
+ return TCL_ERROR;
+ }
+
+ pltcl_pg_returnnext(interp, rowObjc, rowObjv);
+ return TCL_OK;
+ }
/*----------
* Support for running SPI operations inside subtransactions
*************** pltcl_SPI_prepare(ClientData cdata, Tcl_
*** 2187,2193 ****
free(qdesc->arginfuncs);
free(qdesc->argtypioparams);
free(qdesc);
- /* ckfree((char *) args); */
return TCL_ERROR;
}
--- 2492,2497 ----
*************** pltcl_SPI_prepare(ClientData cdata, Tcl_
*** 2202,2209 ****
hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew);
Tcl_SetHashValue(hashent, (ClientData) qdesc);
- /* ckfree((char *) args); */
-
/* qname is ASCII, so no need for encoding conversion */
Tcl_SetObjResult(interp, Tcl_NewStringObj(qdesc->qname, -1));
return TCL_OK;
--- 2506,2511 ----
*************** pltcl_set_tuple_values(Tcl_Interp *inter
*** 2541,2547 ****
**********************************************************************/
static void
pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
! Tcl_Obj *retobj)
{
int i;
char *outputstr;
--- 2843,2849 ----
**********************************************************************/
static void
pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
! Tcl_Obj * retobj)
{
int i;
char *outputstr;
*************** pltcl_build_tuple_argument(HeapTuple tup
*** 2592,2599 ****
if (!isnull && OidIsValid(typoutput))
{
outputstr = OidOutputFunctionCall(typoutput, attr);
! Tcl_ListObjAppendElement (NULL, retobj,
! Tcl_NewStringObj (attname, -1));
UTF_BEGIN;
Tcl_ListObjAppendElement(NULL, retobj, Tcl_NewStringObj(UTF_E2U(outputstr), -1));
UTF_END;
--- 2894,2901 ----
if (!isnull && OidIsValid(typoutput))
{
outputstr = OidOutputFunctionCall(typoutput, attr);
! Tcl_ListObjAppendElement(NULL, retobj,
! Tcl_NewStringObj(attname, -1));
UTF_BEGIN;
Tcl_ListObjAppendElement(NULL, retobj, Tcl_NewStringObj(UTF_E2U(outputstr), -1));
UTF_END;
Re: Revised patches to add table function support to PL/Tcl (TODO item)
On Tue, Dec 28, 2010 at 9:23 PM, Karl Lehenbauer
<karllehenbauer@gmail.com> wrote:
On Dec 28, 2010, at 7:29 PM, Tom Lane wrote:
This patch appears to be changing a whole lot of stuff that in fact
pg_indent has never changed, so there's something wrong with the way you
are doing it. It looks like a bad typedef list from here.You were right, Tom. The problem was that typedefs "pltcl_interp_desc", "pltcl_proc_key", and "pltcl_proc_ptr" weren't in src/tools/pgindent/typedefs.list. After adding them (and building and installing the netbsd-based, patched indent), pgindent only changes a handful of lines.
pltcl-karl-try3-1-of-3-pgindent.patch patches typedefs.list with the three missing typedefs and pltcl.c with the small changes made by pgindent (it shifted some embedded comments left within their lines, mainly).
As before, but "try3" now, pltcl-karl-try3-2-of-3-objects.patch converts pltcl.c to use the "Tcl objects" C API.
And as before, but "try3" now, pltcl-karl-try3-3-of-3-setof.patch adds returning record and SETOF record.
This patch did not get reviewed, because the person who originally
planned to review it had a hardware failure that prevented him from
doing so. Can anyone pick this up?
--
Robert Haas
EnterpriseDB: http://www.enterprisedb.com
The Enterprise PostgreSQL Company
Re: Revised patches to add table function support to PL/Tcl (TODO item)
On 02/07/2011 11:30 PM, Robert Haas wrote:
On Tue, Dec 28, 2010 at 9:23 PM, Karl Lehenbauer
<karllehenbauer@gmail.com> wrote:On Dec 28, 2010, at 7:29 PM, Tom Lane wrote:
This patch appears to be changing a whole lot of stuff that in fact
pg_indent has never changed, so there's something wrong with the way you
are doing it. It looks like a bad typedef list from here.You were right, Tom. The problem was that typedefs "pltcl_interp_desc", "pltcl_proc_key", and "pltcl_proc_ptr" weren't in src/tools/pgindent/typedefs.list. After adding them (and building and installing the netbsd-based, patched indent), pgindent only changes a handful of lines.
pltcl-karl-try3-1-of-3-pgindent.patch patches typedefs.list with the three missing typedefs and pltcl.c with the small changes made by pgindent (it shifted some embedded comments left within their lines, mainly).
As before, but "try3" now, pltcl-karl-try3-2-of-3-objects.patch converts pltcl.c to use the "Tcl objects" C API.
And as before, but "try3" now, pltcl-karl-try3-3-of-3-setof.patch adds returning record and SETOF record.
This patch did not get reviewed, because the person who originally
planned to review it had a hardware failure that prevented him from
doing so. Can anyone pick this up?
I will have a look at it.
cheers
andrew
Re: Revised patches to add table function support to PL/Tcl (TODO item)
On 02/08/2011 08:37 PM, Andrew Dunstan wrote:
On 02/07/2011 11:30 PM, Robert Haas wrote:
On Tue, Dec 28, 2010 at 9:23 PM, Karl Lehenbauer
<karllehenbauer@gmail.com> wrote:On Dec 28, 2010, at 7:29 PM, Tom Lane wrote:
This patch appears to be changing a whole lot of stuff that in fact
pg_indent has never changed, so there's something wrong with the
way you
are doing it. It looks like a bad typedef list from here.You were right, Tom. The problem was that typedefs
"pltcl_interp_desc", "pltcl_proc_key", and "pltcl_proc_ptr" weren't
in src/tools/pgindent/typedefs.list. After adding them (and
building and installing the netbsd-based, patched indent), pgindent
only changes a handful of lines.pltcl-karl-try3-1-of-3-pgindent.patch patches typedefs.list with the
three missing typedefs and pltcl.c with the small changes made by
pgindent (it shifted some embedded comments left within their lines,
mainly).As before, but "try3" now, pltcl-karl-try3-2-of-3-objects.patch
converts pltcl.c to use the "Tcl objects" C API.And as before, but "try3" now, pltcl-karl-try3-3-of-3-setof.patch
adds returning record and SETOF record.This patch did not get reviewed, because the person who originally
planned to review it had a hardware failure that prevented him from
doing so. Can anyone pick this up?I will have a look at it.
As promised I have had a look. The first point is that it doesn't have
any documentation at all.
The second is that it doesn't appear from a my admittedly short look to
support nested composites, or perhaps more importantly composites with
array fields. I think if we're going to add support for composites to
pltcl, we should make sure we support these from the start rather than
store up for ourselves the sorts of trouble that we're now grappling
with in plperl-land. We shouldn't start to make pltcl users pass back
composed array or record literals, if possible.
As for the API changes, I'd like to have that piece reviewed by someone
more familiar with the Tcl API than I am. I'm not sure who if anyone we
have that has that familiarity, now Jan is no longer active.
I know this has been on the table for six weeks, and an earlier review
might have given Karl more chance to remedy these matters in time. I'm
sorry about that, it's a pity the original reviewer ran into issues.
But for now I'm inclined to mark this as "Returned with Feedbnack".
cheers
andrew