granicus.if.org Git - postgresql/blob - src/pl/tcl/pltcl.c

   1 /**********************************************************************
   2  * pltcl.c              - PostgreSQL support for Tcl as
   3  *                                procedural language (PL)
   4  *
   5  *        This software is copyrighted by Jan Wieck - Hamburg.
   6  *
   7  *        The author hereby grants permission  to  use,  copy,  modify,
   8  *        distribute,  and      license this software and its documentation
   9  *        for any purpose, provided that existing copyright notices are
  10  *        retained      in      all  copies  and  that  this notice is included
  11  *        verbatim in any distributions. No written agreement, license,
  12  *        or  royalty  fee      is required for any of the authorized uses.
  13  *        Modifications to this software may be  copyrighted  by  their
  14  *        author  and  need  not  follow  the licensing terms described
  15  *        here, provided that the new terms are  clearly  indicated  on
  16  *        the first page of each file where they apply.
  17  *
  18  *        IN NO EVENT SHALL THE AUTHOR OR DISTRIBUTORS BE LIABLE TO ANY
  19  *        PARTY  FOR  DIRECT,   INDIRECT,       SPECIAL,   INCIDENTAL,   OR
  20  *        CONSEQUENTIAL   DAMAGES  ARISING      OUT  OF  THE  USE  OF  THIS
  21  *        SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES THEREOF, EVEN
  22  *        IF  THE  AUTHOR  HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH
  23  *        DAMAGE.
  24  *
  25  *        THE  AUTHOR  AND      DISTRIBUTORS  SPECIFICALLY       DISCLAIM       ANY
  26  *        WARRANTIES,  INCLUDING,  BUT  NOT  LIMITED  TO,  THE  IMPLIED
  27  *        WARRANTIES  OF  MERCHANTABILITY,      FITNESS  FOR  A  PARTICULAR
  28  *        PURPOSE,      AND NON-INFRINGEMENT.  THIS SOFTWARE IS PROVIDED ON
  29  *        AN "AS IS" BASIS, AND THE AUTHOR      AND  DISTRIBUTORS  HAVE  NO
  30  *        OBLIGATION   TO       PROVIDE   MAINTENANCE,   SUPPORT,  UPDATES,
  31  *        ENHANCEMENTS, OR MODIFICATIONS.
  32  *
  33  * IDENTIFICATION
  34  *        $Header: /cvsroot/pgsql/src/pl/tcl/pltcl.c,v 1.65 2002/10/14 04:20:52 momjian Exp $
  35  *
  36  **********************************************************************/
  37
  38 #include "postgres.h"
  39
  40 #include <tcl.h>
  41
  42 #include <unistd.h>
  43 #include <fcntl.h>
  44 #include <setjmp.h>
  45
  46 #include "access/heapam.h"
  47 #include "catalog/pg_language.h"
  48 #include "catalog/pg_proc.h"
  49 #include "catalog/pg_type.h"
  50 #include "commands/trigger.h"
  51 #include "executor/spi.h"
  52 #include "fmgr.h"
  53 #include "nodes/makefuncs.h"
  54 #include "parser/parse_type.h"
  55 #include "tcop/tcopprot.h"
  56 #include "utils/builtins.h"
  57 #include "utils/syscache.h"
  58
  59 #if defined(UNICODE_CONVERSION) && TCL_MAJOR_VERSION == 8 \
  60         && TCL_MINOR_VERSION > 0
  61
  62 #include "mb/pg_wchar.h"
  63
  64 static unsigned char *
  65 utf_u2e(unsigned char *src)
  66 {
  67         return pg_do_encoding_conversion(src, strlen(src), PG_UTF8, GetDatabaseEncoding());
  68 }
  69
  70 static unsigned char *
  71 utf_e2u(unsigned char *src)
  72 {
  73         return pg_do_encoding_conversion(src, strlen(src), GetDatabaseEncoding(), PG_UTF8);
  74 }
  75
  76 #define PLTCL_UTF
  77 #define UTF_BEGIN        do { \
  78                                         unsigned char *_pltcl_utf_src; \
  79                                         unsigned char *_pltcl_utf_dst
  80 #define UTF_END          if (_pltcl_utf_src!=_pltcl_utf_dst) \
  81                                         pfree(_pltcl_utf_dst); } while (0)
  82 #define UTF_U2E(x)       (_pltcl_utf_dst=utf_u2e(_pltcl_utf_src=(x)))
  83 #define UTF_E2U(x)       (_pltcl_utf_dst=utf_e2u(_pltcl_utf_src=(x)))
  84 #else                                                   /* PLTCL_UTF */
  85 #define  UTF_BEGIN
  86 #define  UTF_END
  87 #define  UTF_U2E(x)  (x)
  88 #define  UTF_E2U(x)  (x)
  89 #endif   /* PLTCL_UTF */
  90
  91 /**********************************************************************
  92  * The information we cache about loaded procedures
  93  **********************************************************************/
  94 typedef struct pltcl_proc_desc
  95 {
  96         char       *proname;
  97         TransactionId fn_xmin;
  98         CommandId       fn_cmin;
  99         bool            lanpltrusted;
 100         FmgrInfo        result_in_func;
 101         Oid                     result_in_elem;
 102         int                     nargs;
 103         FmgrInfo        arg_out_func[FUNC_MAX_ARGS];
 104         Oid                     arg_out_elem[FUNC_MAX_ARGS];
 105         int                     arg_is_rel[FUNC_MAX_ARGS];
 106 }       pltcl_proc_desc;
 107
 108
 109 /**********************************************************************
 110  * The information we cache about prepared and saved plans
 111  **********************************************************************/
 112 typedef struct pltcl_query_desc
 113 {
 114         char            qname[20];
 115         void       *plan;
 116         int                     nargs;
 117         Oid                *argtypes;
 118         FmgrInfo   *arginfuncs;
 119         Oid                *argtypelems;
 120 }       pltcl_query_desc;
 121
 122
 123 /**********************************************************************
 124  * Global data
 125  **********************************************************************/
 126 static int      pltcl_firstcall = 1;
 127 static int      pltcl_call_level = 0;
 128 static int      pltcl_restart_in_progress = 0;
 129 static Tcl_Interp *pltcl_hold_interp = NULL;
 130 static Tcl_Interp *pltcl_norm_interp = NULL;
 131 static Tcl_Interp *pltcl_safe_interp = NULL;
 132 static Tcl_HashTable *pltcl_proc_hash = NULL;
 133 static Tcl_HashTable *pltcl_norm_query_hash = NULL;
 134 static Tcl_HashTable *pltcl_safe_query_hash = NULL;
 135 static FunctionCallInfo pltcl_current_fcinfo = NULL;
 136
 137 /**********************************************************************
 138  * Forward declarations
 139  **********************************************************************/
 140 static void pltcl_init_all(void);
 141 static void pltcl_init_interp(Tcl_Interp *interp);
 142
 143 static void pltcl_init_load_unknown(Tcl_Interp *interp);
 144
 145 Datum           pltcl_call_handler(PG_FUNCTION_ARGS);
 146 Datum           pltclu_call_handler(PG_FUNCTION_ARGS);
 147
 148 static Datum pltcl_func_handler(PG_FUNCTION_ARGS);
 149
 150 static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS);
 151
 152 static pltcl_proc_desc *compile_pltcl_function(Oid fn_oid, bool is_trigger);
 153
 154 static int pltcl_elog(ClientData cdata, Tcl_Interp *interp,
 155                    int argc, char *argv[]);
 156 static int pltcl_quote(ClientData cdata, Tcl_Interp *interp,
 157                         int argc, char *argv[]);
 158 static int pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
 159                                 int argc, char *argv[]);
 160 static int pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
 161                                  int argc, char *argv[]);
 162
 163 static int pltcl_SPI_exec(ClientData cdata, Tcl_Interp *interp,
 164                            int argc, char *argv[]);
 165 static int pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
 166                                   int argc, char *argv[]);
 167 static int pltcl_SPI_execp(ClientData cdata, Tcl_Interp *interp,
 168                                 int argc, char *argv[]);
 169
 170 static void pltcl_set_tuple_values(Tcl_Interp *interp, char *arrayname,
 171                                            int tupno, HeapTuple tuple, TupleDesc tupdesc);
 172 static void pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
 173                                                    Tcl_DString *retval);
 174 static int pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
 175                                   int argc, char *argv[]);
 176
 177 /*
 178  * This routine is a crock, and so is everyplace that calls it.  The problem
 179  * is that the cached form of pltcl functions/queries is allocated permanently
 180  * (mostly via malloc()) and never released until backend exit.  Subsidiary
 181  * data structures such as fmgr info records therefore must live forever
 182  * as well.  A better implementation would store all this stuff in a per-
 183  * function memory context that could be reclaimed at need.  In the meantime,
 184  * fmgr_info_cxt must be called specifying TopMemoryContext so that whatever
 185  * it might allocate, and whatever the eventual function might allocate using
 186  * fn_mcxt, will live forever too.
 187  */
 188 static void
 189 perm_fmgr_info(Oid functionId, FmgrInfo *finfo)
 190 {
 191         fmgr_info_cxt(functionId, finfo, TopMemoryContext);
 192 }
 193
 194 /**********************************************************************
 195  * pltcl_init_all()             - Initialize all
 196  **********************************************************************/
 197 static void
 198 pltcl_init_all(void)
 199 {
 200         /************************************************************
 201          * Do initialization only once
 202          ************************************************************/
 203         if (!pltcl_firstcall)
 204                 return;
 205
 206         /************************************************************
 207          * Create the dummy hold interpreter to prevent close of
 208          * stdout and stderr on DeleteInterp
 209          ************************************************************/
 210         if ((pltcl_hold_interp = Tcl_CreateInterp()) == NULL)
 211         {
 212                 elog(ERROR, "pltcl: internal error - cannot create 'hold' "
 213                          "interpreter");
 214         }
 215
 216         /************************************************************
 217          * Create the two interpreters
 218          ************************************************************/
 219         if ((pltcl_norm_interp =
 220                  Tcl_CreateSlave(pltcl_hold_interp, "norm", 0)) == NULL)
 221         {
 222                 elog(ERROR,
 223                    "pltcl: internal error - cannot create 'normal' interpreter");
 224         }
 225         pltcl_init_interp(pltcl_norm_interp);
 226
 227         if ((pltcl_safe_interp =
 228                  Tcl_CreateSlave(pltcl_hold_interp, "safe", 1)) == NULL)
 229         {
 230                 elog(ERROR,
 231                          "pltcl: internal error - cannot create 'safe' interpreter");
 232         }
 233         pltcl_init_interp(pltcl_safe_interp);
 234
 235         /************************************************************
 236          * Initialize the proc and query hash tables
 237          ************************************************************/
 238         pltcl_proc_hash = (Tcl_HashTable *) malloc(sizeof(Tcl_HashTable));
 239         pltcl_norm_query_hash = (Tcl_HashTable *) malloc(sizeof(Tcl_HashTable));
 240         pltcl_safe_query_hash = (Tcl_HashTable *) malloc(sizeof(Tcl_HashTable));
 241         Tcl_InitHashTable(pltcl_proc_hash, TCL_STRING_KEYS);
 242         Tcl_InitHashTable(pltcl_norm_query_hash, TCL_STRING_KEYS);
 243         Tcl_InitHashTable(pltcl_safe_query_hash, TCL_STRING_KEYS);
 244
 245         pltcl_firstcall = 0;
 246         return;
 247 }
 248
 249
 250 /**********************************************************************
 251  * pltcl_init_interp() - initialize a Tcl interpreter
 252  **********************************************************************/
 253 static void
 254 pltcl_init_interp(Tcl_Interp *interp)
 255 {
 256         /************************************************************
 257          * Install the commands for SPI support in the interpreter
 258          ************************************************************/
 259         Tcl_CreateCommand(interp, "elog",
 260                                           pltcl_elog, NULL, NULL);
 261         Tcl_CreateCommand(interp, "quote",
 262                                           pltcl_quote, NULL, NULL);
 263         Tcl_CreateCommand(interp, "argisnull",
 264                                           pltcl_argisnull, NULL, NULL);
 265         Tcl_CreateCommand(interp, "return_null",
 266                                           pltcl_returnnull, NULL, NULL);
 267
 268         Tcl_CreateCommand(interp, "spi_exec",
 269                                           pltcl_SPI_exec, NULL, NULL);
 270         Tcl_CreateCommand(interp, "spi_prepare",
 271                                           pltcl_SPI_prepare, NULL, NULL);
 272         Tcl_CreateCommand(interp, "spi_execp",
 273                                           pltcl_SPI_execp, NULL, NULL);
 274         Tcl_CreateCommand(interp, "spi_lastoid",
 275                                           pltcl_SPI_lastoid, NULL, NULL);
 276
 277         /************************************************************
 278          * Try to load the unknown procedure from pltcl_modules
 279          ************************************************************/
 280         if (SPI_connect() != SPI_OK_CONNECT)
 281                 elog(ERROR, "pltcl_init_interp(): SPI_connect failed");
 282         pltcl_init_load_unknown(interp);
 283         if (SPI_finish() != SPI_OK_FINISH)
 284                 elog(ERROR, "pltcl_init_interp(): SPI_finish failed");
 285 }
 286
 287
 288 /**********************************************************************
 289  * pltcl_init_load_unknown()    - Load the unknown procedure from
 290  *                                table pltcl_modules (if it exists)
 291  **********************************************************************/
 292 static void
 293 pltcl_init_load_unknown(Tcl_Interp *interp)
 294 {
 295         int                     spi_rc;
 296         int                     tcl_rc;
 297         Tcl_DString unknown_src;
 298         char       *part;
 299         int                     i;
 300         int                     fno;
 301
 302         /************************************************************
 303          * Check if table pltcl_modules exists
 304          ************************************************************/
 305         spi_rc = SPI_exec("select 1 from pg_class "
 306                                           "where relname = 'pltcl_modules'", 1);
 307         SPI_freetuptable(SPI_tuptable);
 308         if (spi_rc != SPI_OK_SELECT)
 309                 elog(ERROR, "pltcl_init_load_unknown(): select from pg_class failed");
 310         if (SPI_processed == 0)
 311                 return;
 312
 313         /************************************************************
 314          * Read all the row's from it where modname = 'unknown' in
 315          * the order of modseq
 316          ************************************************************/
 317         Tcl_DStringInit(&unknown_src);
 318
 319         spi_rc = SPI_exec("select modseq, modsrc from pltcl_modules "
 320                                           "where modname = 'unknown' "
 321                                           "order by modseq", 0);
 322         if (spi_rc != SPI_OK_SELECT)
 323         {
 324                 elog(ERROR, "pltcl_init_load_unknown(): select from pltcl_modules "
 325                          "failed");
 326         }
 327
 328         /************************************************************
 329          * If there's nothing, module unknown doesn't exist
 330          ************************************************************/
 331         if (SPI_processed == 0)
 332         {
 333                 Tcl_DStringFree(&unknown_src);
 334                 SPI_freetuptable(SPI_tuptable);
 335                 elog(WARNING, "pltcl: Module unknown not found in pltcl_modules");
 336                 return;
 337         }
 338
 339         /************************************************************
 340          * There is a module named unknown. Resemble the
 341          * source from the modsrc attributes and evaluate
 342          * it in the Tcl interpreter
 343          ************************************************************/
 344         fno = SPI_fnumber(SPI_tuptable->tupdesc, "modsrc");
 345
 346         for (i = 0; i < SPI_processed; i++)
 347         {
 348                 part = SPI_getvalue(SPI_tuptable->vals[i],
 349                                                         SPI_tuptable->tupdesc, fno);
 350                 if (part != NULL)
 351                 {
 352                         UTF_BEGIN;
 353                         Tcl_DStringAppend(&unknown_src, UTF_E2U(part), -1);
 354                         UTF_END;
 355                         pfree(part);
 356                 }
 357         }
 358         tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&unknown_src));
 359         Tcl_DStringFree(&unknown_src);
 360         SPI_freetuptable(SPI_tuptable);
 361 }
 362
 363
 364 /**********************************************************************
 365  * pltcl_call_handler           - This is the only visible function
 366  *                                of the PL interpreter. The PostgreSQL
 367  *                                function manager and trigger manager
 368  *                                call this function for execution of
 369  *                                PL/Tcl procedures.
 370  **********************************************************************/
 371 PG_FUNCTION_INFO_V1(pltcl_call_handler);
 372
 373 /* keep non-static */
 374 Datum
 375 pltcl_call_handler(PG_FUNCTION_ARGS)
 376 {
 377         Datum           retval;
 378         FunctionCallInfo save_fcinfo;
 379
 380         /************************************************************
 381          * Initialize interpreters on first call
 382          ************************************************************/
 383         if (pltcl_firstcall)
 384                 pltcl_init_all();
 385
 386         /************************************************************
 387          * Connect to SPI manager
 388          ************************************************************/
 389         if (SPI_connect() != SPI_OK_CONNECT)
 390                 elog(ERROR, "pltcl: cannot connect to SPI manager");
 391         /************************************************************
 392          * Keep track about the nesting of Tcl-SPI-Tcl-... calls
 393          ************************************************************/
 394         pltcl_call_level++;
 395
 396         /************************************************************
 397          * Determine if called as function or trigger and
 398          * call appropriate subhandler
 399          ************************************************************/
 400         save_fcinfo = pltcl_current_fcinfo;
 401
 402         if (CALLED_AS_TRIGGER(fcinfo))
 403         {
 404                 pltcl_current_fcinfo = NULL;
 405                 retval = PointerGetDatum(pltcl_trigger_handler(fcinfo));
 406         }
 407         else
 408         {
 409                 pltcl_current_fcinfo = fcinfo;
 410                 retval = pltcl_func_handler(fcinfo);
 411         }
 412
 413         pltcl_current_fcinfo = save_fcinfo;
 414
 415         pltcl_call_level--;
 416
 417         return retval;
 418 }
 419
 420
 421 /*
 422  * Alternate handler for unsafe functions
 423  */
 424 PG_FUNCTION_INFO_V1(pltclu_call_handler);
 425
 426 /* keep non-static */
 427 Datum
 428 pltclu_call_handler(PG_FUNCTION_ARGS)
 429 {
 430         return pltcl_call_handler(fcinfo);
 431 }
 432
 433 /**********************************************************************
 434  * pltcl_func_handler()         - Handler for regular function calls
 435  **********************************************************************/
 436 static Datum
 437 pltcl_func_handler(PG_FUNCTION_ARGS)
 438 {
 439         pltcl_proc_desc *prodesc;
 440         Tcl_Interp *volatile interp;
 441         Tcl_DString tcl_cmd;
 442         Tcl_DString list_tmp;
 443         int                     i;
 444         int                     tcl_rc;
 445         Datum           retval;
 446         sigjmp_buf      save_restart;
 447
 448         /* Find or compile the function */
 449         prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, false);
 450
 451         if (prodesc->lanpltrusted)
 452                 interp = pltcl_safe_interp;
 453         else
 454                 interp = pltcl_norm_interp;
 455
 456         /************************************************************
 457          * Create the tcl command to call the internal
 458          * proc in the Tcl interpreter
 459          ************************************************************/
 460         Tcl_DStringInit(&tcl_cmd);
 461         Tcl_DStringInit(&list_tmp);
 462         Tcl_DStringAppendElement(&tcl_cmd, prodesc->proname);
 463
 464         /************************************************************
 465          * Catch elog(ERROR) during build of the Tcl command
 466          ************************************************************/
 467         memcpy(&save_restart, &Warn_restart, sizeof(save_restart));
 468         if (sigsetjmp(Warn_restart, 1) != 0)
 469         {
 470                 memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
 471                 Tcl_DStringFree(&tcl_cmd);
 472                 Tcl_DStringFree(&list_tmp);
 473                 pltcl_restart_in_progress = 1;
 474                 if (--pltcl_call_level == 0)
 475                         pltcl_restart_in_progress = 0;
 476                 siglongjmp(Warn_restart, 1);
 477         }
 478
 479         /************************************************************
 480          * Add all call arguments to the command
 481          ************************************************************/
 482         for (i = 0; i < prodesc->nargs; i++)
 483         {
 484                 if (prodesc->arg_is_rel[i])
 485                 {
 486                         /**************************************************
 487                          * For tuple values, add a list for 'array set ...'
 488                          **************************************************/
 489                         TupleTableSlot *slot = (TupleTableSlot *) fcinfo->arg[i];
 490
 491                         Assert(slot != NULL && !fcinfo->argnull[i]);
 492                         Tcl_DStringInit(&list_tmp);
 493                         pltcl_build_tuple_argument(slot->val,
 494                                                                            slot->ttc_tupleDescriptor,
 495                                                                            &list_tmp);
 496                         Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&list_tmp));
 497                         Tcl_DStringFree(&list_tmp);
 498                         Tcl_DStringInit(&list_tmp);
 499                 }
 500                 else
 501                 {
 502                         /**************************************************
 503                          * Single values are added as string element
 504                          * of their external representation
 505                          **************************************************/
 506                         if (fcinfo->argnull[i])
 507                                 Tcl_DStringAppendElement(&tcl_cmd, "");
 508                         else
 509                         {
 510                                 char       *tmp;
 511
 512                                 tmp = DatumGetCString(FunctionCall3(&prodesc->arg_out_func[i],
 513                                                                                                         fcinfo->arg[i],
 514                                                           ObjectIdGetDatum(prodesc->arg_out_elem[i]),
 515                                                                                                         Int32GetDatum(-1)));
 516                                 UTF_BEGIN;
 517                                 Tcl_DStringAppendElement(&tcl_cmd, UTF_E2U(tmp));
 518                                 UTF_END;
 519                                 pfree(tmp);
 520                         }
 521                 }
 522         }
 523         Tcl_DStringFree(&list_tmp);
 524         memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
 525
 526         /************************************************************
 527          * Call the Tcl function
 528          ************************************************************/
 529         tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&tcl_cmd));
 530         Tcl_DStringFree(&tcl_cmd);
 531
 532         /************************************************************
 533          * Check the return code from Tcl and handle
 534          * our special restart mechanism to get rid
 535          * of all nested call levels on transaction
 536          * abort.
 537          ************************************************************/
 538         if (tcl_rc != TCL_OK || pltcl_restart_in_progress)
 539         {
 540                 if (!pltcl_restart_in_progress)
 541                 {
 542                         pltcl_restart_in_progress = 1;
 543                         if (--pltcl_call_level == 0)
 544                                 pltcl_restart_in_progress = 0;
 545                         UTF_BEGIN;
 546                         elog(ERROR, "pltcl: %s\n%s", interp->result,
 547                                  UTF_U2E(Tcl_GetVar(interp, "errorInfo",
 548                                                                         TCL_GLOBAL_ONLY)));
 549                         UTF_END;
 550                 }
 551                 if (--pltcl_call_level == 0)
 552                         pltcl_restart_in_progress = 0;
 553                 siglongjmp(Warn_restart, 1);
 554         }
 555
 556         /************************************************************
 557          * Convert the result value from the Tcl interpreter
 558          * into its PostgreSQL data format and return it.
 559          * Again, the function call could fire an elog and we
 560          * have to count for the current interpreter level we are
 561          * on. The save_restart from above is still good.
 562          ************************************************************/
 563         if (sigsetjmp(Warn_restart, 1) != 0)
 564         {
 565                 memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
 566                 pltcl_restart_in_progress = 1;
 567                 if (--pltcl_call_level == 0)
 568                         pltcl_restart_in_progress = 0;
 569                 siglongjmp(Warn_restart, 1);
 570         }
 571
 572         /************************************************************
 573          * Disconnect from SPI manager and then create the return
 574          * values datum (if the input function does a palloc for it
 575          * this must not be allocated in the SPI memory context
 576          * because SPI_finish would free it).  But don't try to call
 577          * the result_in_func if we've been told to return a NULL;
 578          * the contents of interp->result may not be a valid value of
 579          * the result type in that case.
 580          ************************************************************/
 581         if (SPI_finish() != SPI_OK_FINISH)
 582                 elog(ERROR, "pltcl: SPI_finish() failed");
 583
 584         if (fcinfo->isnull)
 585                 retval = (Datum) 0;
 586         else
 587         {
 588                 UTF_BEGIN;
 589                 retval = FunctionCall3(&prodesc->result_in_func,
 590                                                            PointerGetDatum(UTF_U2E(interp->result)),
 591                                                            ObjectIdGetDatum(prodesc->result_in_elem),
 592                                                            Int32GetDatum(-1));
 593                 UTF_END;
 594         }
 595
 596         /************************************************************
 597          * Finally we may restore normal error handling.
 598          ************************************************************/
 599         memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
 600
 601         return retval;
 602 }
 603
 604
 605 /**********************************************************************
 606  * pltcl_trigger_handler()      - Handler for trigger calls
 607  **********************************************************************/
 608 static HeapTuple
 609 pltcl_trigger_handler(PG_FUNCTION_ARGS)
 610 {
 611         pltcl_proc_desc *prodesc;
 612         Tcl_Interp *volatile interp;
 613         TriggerData *trigdata = (TriggerData *) fcinfo->context;
 614         char       *stroid;
 615         TupleDesc       tupdesc;
 616         volatile HeapTuple rettup;
 617         Tcl_DString tcl_cmd;
 618         Tcl_DString tcl_trigtup;
 619         Tcl_DString tcl_newtup;
 620         int                     tcl_rc;
 621         int                     i;
 622
 623         int                *modattrs;
 624         Datum      *modvalues;
 625         char       *modnulls;
 626
 627         int                     ret_numvals;
 628         char      **ret_values;
 629
 630         sigjmp_buf      save_restart;
 631
 632         /* Find or compile the function */
 633         prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, true);
 634
 635         if (prodesc->lanpltrusted)
 636                 interp = pltcl_safe_interp;
 637         else
 638                 interp = pltcl_norm_interp;
 639
 640         tupdesc = trigdata->tg_relation->rd_att;
 641
 642         /************************************************************
 643          * Create the tcl command to call the internal
 644          * proc in the interpreter
 645          ************************************************************/
 646         Tcl_DStringInit(&tcl_cmd);
 647         Tcl_DStringInit(&tcl_trigtup);
 648         Tcl_DStringInit(&tcl_newtup);
 649
 650         /************************************************************
 651          * We call external functions below - care for elog(ERROR)
 652          ************************************************************/
 653         memcpy(&save_restart, &Warn_restart, sizeof(save_restart));
 654         if (sigsetjmp(Warn_restart, 1) != 0)
 655         {
 656                 memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
 657                 Tcl_DStringFree(&tcl_cmd);
 658                 Tcl_DStringFree(&tcl_trigtup);
 659                 Tcl_DStringFree(&tcl_newtup);
 660                 pltcl_restart_in_progress = 1;
 661                 if (--pltcl_call_level == 0)
 662                         pltcl_restart_in_progress = 0;
 663                 siglongjmp(Warn_restart, 1);
 664         }
 665
 666         /* The procedure name */
 667         Tcl_DStringAppendElement(&tcl_cmd, prodesc->proname);
 668
 669         /* The trigger name for argument TG_name */
 670         Tcl_DStringAppendElement(&tcl_cmd, trigdata->tg_trigger->tgname);
 671
 672         /* The oid of the trigger relation for argument TG_relid */
 673         stroid = DatumGetCString(DirectFunctionCall1(oidout,
 674                                                 ObjectIdGetDatum(trigdata->tg_relation->rd_id)));
 675         Tcl_DStringAppendElement(&tcl_cmd, stroid);
 676         pfree(stroid);
 677
 678         /* A list of attribute names for argument TG_relatts */
 679         Tcl_DStringAppendElement(&tcl_trigtup, "");
 680         for (i = 0; i < tupdesc->natts; i++)
 681                 Tcl_DStringAppendElement(&tcl_trigtup,
 682                                                                  NameStr(tupdesc->attrs[i]->attname));
 683         Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
 684         Tcl_DStringFree(&tcl_trigtup);
 685         Tcl_DStringInit(&tcl_trigtup);
 686
 687         /* The when part of the event for TG_when */
 688         if (TRIGGER_FIRED_BEFORE(trigdata->tg_event))
 689                 Tcl_DStringAppendElement(&tcl_cmd, "BEFORE");
 690         else if (TRIGGER_FIRED_AFTER(trigdata->tg_event))
 691                 Tcl_DStringAppendElement(&tcl_cmd, "AFTER");
 692         else
 693                 Tcl_DStringAppendElement(&tcl_cmd, "UNKNOWN");
 694
 695         /* The level part of the event for TG_level */
 696         if (TRIGGER_FIRED_FOR_ROW(trigdata->tg_event))
 697                 Tcl_DStringAppendElement(&tcl_cmd, "ROW");
 698         else if (TRIGGER_FIRED_FOR_STATEMENT(trigdata->tg_event))
 699                 Tcl_DStringAppendElement(&tcl_cmd, "STATEMENT");
 700         else
 701                 Tcl_DStringAppendElement(&tcl_cmd, "UNKNOWN");
 702
 703         /* Build the data list for the trigtuple */
 704         pltcl_build_tuple_argument(trigdata->tg_trigtuple,
 705                                                            tupdesc, &tcl_trigtup);
 706
 707         /*
 708          * Now the command part of the event for TG_op and data for NEW and
 709          * OLD
 710          */
 711         if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
 712         {
 713                 Tcl_DStringAppendElement(&tcl_cmd, "INSERT");
 714
 715                 Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
 716                 Tcl_DStringAppendElement(&tcl_cmd, "");
 717
 718                 rettup = trigdata->tg_trigtuple;
 719         }
 720         else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event))
 721         {
 722                 Tcl_DStringAppendElement(&tcl_cmd, "DELETE");
 723
 724                 Tcl_DStringAppendElement(&tcl_cmd, "");
 725                 Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
 726
 727                 rettup = trigdata->tg_trigtuple;
 728         }
 729         else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
 730         {
 731                 Tcl_DStringAppendElement(&tcl_cmd, "UPDATE");
 732
 733                 pltcl_build_tuple_argument(trigdata->tg_newtuple,
 734                                                                    tupdesc, &tcl_newtup);
 735
 736                 Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_newtup));
 737                 Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
 738
 739                 rettup = trigdata->tg_newtuple;
 740         }
 741         else
 742         {
 743                 Tcl_DStringAppendElement(&tcl_cmd, "UNKNOWN");
 744
 745                 Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
 746                 Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
 747
 748                 rettup = trigdata->tg_trigtuple;
 749         }
 750
 751         memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
 752         Tcl_DStringFree(&tcl_trigtup);
 753         Tcl_DStringFree(&tcl_newtup);
 754
 755         /************************************************************
 756          * Finally append the arguments from CREATE TRIGGER
 757          ************************************************************/
 758         for (i = 0; i < trigdata->tg_trigger->tgnargs; i++)
 759                 Tcl_DStringAppendElement(&tcl_cmd, trigdata->tg_trigger->tgargs[i]);
 760
 761         /************************************************************
 762          * Call the Tcl function
 763          ************************************************************/
 764         tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&tcl_cmd));
 765         Tcl_DStringFree(&tcl_cmd);
 766
 767         /************************************************************
 768          * Check the return code from Tcl and handle
 769          * our special restart mechanism to get rid
 770          * of all nested call levels on transaction
 771          * abort.
 772          ************************************************************/
 773         if (tcl_rc == TCL_ERROR || pltcl_restart_in_progress)
 774         {
 775                 if (!pltcl_restart_in_progress)
 776                 {
 777                         pltcl_restart_in_progress = 1;
 778                         if (--pltcl_call_level == 0)
 779                                 pltcl_restart_in_progress = 0;
 780                         UTF_BEGIN;
 781                         elog(ERROR, "pltcl: %s\n%s", interp->result,
 782                                  UTF_U2E(Tcl_GetVar(interp, "errorInfo",
 783                                                                         TCL_GLOBAL_ONLY)));
 784                         UTF_END;
 785                 }
 786                 if (--pltcl_call_level == 0)
 787                         pltcl_restart_in_progress = 0;
 788                 siglongjmp(Warn_restart, 1);
 789         }
 790
 791         switch (tcl_rc)
 792         {
 793                 case TCL_OK:
 794                         break;
 795
 796                 default:
 797                         elog(ERROR, "pltcl: unsupported TCL return code %d", tcl_rc);
 798         }
 799
 800         /************************************************************
 801          * The return value from the procedure might be one of
 802          * the magic strings OK or SKIP or a list from array get
 803          ************************************************************/
 804         if (SPI_finish() != SPI_OK_FINISH)
 805                 elog(ERROR, "pltcl: SPI_finish() failed");
 806
 807         if (strcmp(interp->result, "OK") == 0)
 808                 return rettup;
 809         if (strcmp(interp->result, "SKIP") == 0)
 810                 return (HeapTuple) NULL;
 811
 812         /************************************************************
 813          * Convert the result value from the Tcl interpreter
 814          * and setup structures for SPI_modifytuple();
 815          ************************************************************/
 816         if (Tcl_SplitList(interp, interp->result,
 817                                           &ret_numvals, &ret_values) != TCL_OK)
 818         {
 819                 elog(WARNING, "pltcl: cannot split return value from trigger");
 820                 elog(ERROR, "pltcl: %s", interp->result);
 821         }
 822
 823         if (ret_numvals % 2 != 0)
 824         {
 825                 ckfree((char *) ret_values);
 826                 elog(ERROR, "pltcl: invalid return list from trigger - must have even # of elements");
 827         }
 828
 829         modattrs = (int *) palloc(tupdesc->natts * sizeof(int));
 830         modvalues = (Datum *) palloc(tupdesc->natts * sizeof(Datum));
 831         for (i = 0; i < tupdesc->natts; i++)
 832         {
 833                 modattrs[i] = i + 1;
 834                 modvalues[i] = (Datum) NULL;
 835         }
 836
 837         modnulls = palloc(tupdesc->natts + 1);
 838         memset(modnulls, 'n', tupdesc->natts);
 839         modnulls[tupdesc->natts] = '\0';
 840
 841         /************************************************************
 842          * Care for possible elog(ERROR)'s below
 843          ************************************************************/
 844         if (sigsetjmp(Warn_restart, 1) != 0)
 845         {
 846                 memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
 847                 ckfree((char *) ret_values);
 848                 pltcl_restart_in_progress = 1;
 849                 if (--pltcl_call_level == 0)
 850                         pltcl_restart_in_progress = 0;
 851                 siglongjmp(Warn_restart, 1);
 852         }
 853
 854         i = 0;
 855         while (i < ret_numvals)
 856         {
 857                 int                     attnum;
 858                 HeapTuple       typeTup;
 859                 Oid                     typinput;
 860                 Oid                     typelem;
 861                 FmgrInfo        finfo;
 862
 863                 /************************************************************
 864                  * Ignore pseudo elements with a dot name
 865                  ************************************************************/
 866                 if (*(ret_values[i]) == '.')
 867                 {
 868                         i += 2;
 869                         continue;
 870                 }
 871
 872                 /************************************************************
 873                  * Get the attribute number
 874                  ************************************************************/
 875                 attnum = SPI_fnumber(tupdesc, ret_values[i++]);
 876                 if (attnum == SPI_ERROR_NOATTRIBUTE)
 877                         elog(ERROR, "pltcl: invalid attribute '%s'", ret_values[--i]);
 878                 if (attnum <= 0)
 879                         elog(ERROR, "pltcl: cannot set system attribute '%s'", ret_values[--i]);
 880
 881                 /************************************************************
 882                  * Lookup the attribute type in the syscache
 883                  * for the input function
 884                  ************************************************************/
 885                 typeTup = SearchSysCache(TYPEOID,
 886                                   ObjectIdGetDatum(tupdesc->attrs[attnum - 1]->atttypid),
 887                                                                  0, 0, 0);
 888                 if (!HeapTupleIsValid(typeTup))
 889                 {
 890                         elog(ERROR, "pltcl: Cache lookup for attribute '%s' type %u failed",
 891                                  ret_values[--i],
 892                                  tupdesc->attrs[attnum - 1]->atttypid);
 893                 }
 894                 typinput = ((Form_pg_type) GETSTRUCT(typeTup))->typinput;
 895                 typelem = ((Form_pg_type) GETSTRUCT(typeTup))->typelem;
 896                 ReleaseSysCache(typeTup);
 897
 898                 /************************************************************
 899                  * Set the attribute to NOT NULL and convert the contents
 900                  ************************************************************/
 901                 modnulls[attnum - 1] = ' ';
 902                 fmgr_info(typinput, &finfo);
 903                 UTF_BEGIN;
 904                 modvalues[attnum - 1] =
 905                         FunctionCall3(&finfo,
 906                                                   CStringGetDatum(UTF_U2E(ret_values[i++])),
 907                                                   ObjectIdGetDatum(typelem),
 908                                    Int32GetDatum(tupdesc->attrs[attnum - 1]->atttypmod));
 909                 UTF_END;
 910         }
 911
 912         rettup = SPI_modifytuple(trigdata->tg_relation, rettup, tupdesc->natts,
 913                                                          modattrs, modvalues, modnulls);
 914
 915         pfree(modattrs);
 916         pfree(modvalues);
 917         pfree(modnulls);
 918
 919         if (rettup == NULL)
 920                 elog(ERROR, "pltcl: SPI_modifytuple() failed - RC = %d\n", SPI_result);
 921
 922         ckfree((char *) ret_values);
 923         memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
 924
 925         return rettup;
 926 }
 927
 928
 929 /**********************************************************************
 930  * compile_pltcl_function       - compile (or hopefully just look up) function
 931  **********************************************************************/
 932 static pltcl_proc_desc *
 933 compile_pltcl_function(Oid fn_oid, bool is_trigger)
 934 {
 935         HeapTuple       procTup;
 936         Form_pg_proc procStruct;
 937         char            internal_proname[64];
 938         Tcl_HashEntry *hashent;
 939         pltcl_proc_desc *prodesc = NULL;
 940         Tcl_Interp *interp;
 941         int                     i;
 942         int                     hashnew;
 943         int                     tcl_rc;
 944
 945         /* We'll need the pg_proc tuple in any case... */
 946         procTup = SearchSysCache(PROCOID,
 947                                                          ObjectIdGetDatum(fn_oid),
 948                                                          0, 0, 0);
 949         if (!HeapTupleIsValid(procTup))
 950                 elog(ERROR, "pltcl: cache lookup for proc %u failed", fn_oid);
 951         procStruct = (Form_pg_proc) GETSTRUCT(procTup);
 952
 953         /************************************************************
 954          * Build our internal proc name from the functions Oid
 955          ************************************************************/
 956         if (!is_trigger)
 957                 snprintf(internal_proname, sizeof(internal_proname),
 958                                  "__PLTcl_proc_%u", fn_oid);
 959         else
 960                 snprintf(internal_proname, sizeof(internal_proname),
 961                                  "__PLTcl_proc_%u_trigger", fn_oid);
 962
 963         /************************************************************
 964          * Lookup the internal proc name in the hashtable
 965          ************************************************************/
 966         hashent = Tcl_FindHashEntry(pltcl_proc_hash, internal_proname);
 967
 968         /************************************************************
 969          * If it's present, must check whether it's still up to date.
 970          * This is needed because CREATE OR REPLACE FUNCTION can modify the
 971          * function's pg_proc entry without changing its OID.
 972          ************************************************************/
 973         if (hashent != NULL)
 974         {
 975                 bool            uptodate;
 976
 977                 prodesc = (pltcl_proc_desc *) Tcl_GetHashValue(hashent);
 978
 979                 uptodate = (prodesc->fn_xmin == HeapTupleHeaderGetXmin(procTup->t_data) &&
 980                         prodesc->fn_cmin == HeapTupleHeaderGetCmin(procTup->t_data));
 981
 982                 if (!uptodate)
 983                 {
 984                         Tcl_DeleteHashEntry(hashent);
 985                         hashent = NULL;
 986                 }
 987         }
 988
 989         /************************************************************
 990          * If we haven't found it in the hashtable, we analyze
 991          * the functions arguments and returntype and store
 992          * the in-/out-functions in the prodesc block and create
 993          * a new hashtable entry for it.
 994          *
 995          * Then we load the procedure into the Tcl interpreter.
 996          ************************************************************/
 997         if (hashent == NULL)
 998         {
 999                 HeapTuple       langTup;
1000                 HeapTuple       typeTup;
1001                 Form_pg_language langStruct;
1002                 Form_pg_type typeStruct;
1003                 Tcl_DString proc_internal_def;
1004                 Tcl_DString proc_internal_body;
1005                 char            proc_internal_args[4096];
1006                 char       *proc_source;
1007                 char            buf[512];
1008
1009                 /************************************************************
1010                  * Allocate a new procedure description block
1011                  ************************************************************/
1012                 prodesc = (pltcl_proc_desc *) malloc(sizeof(pltcl_proc_desc));
1013                 if (prodesc == NULL)
1014                         elog(ERROR, "pltcl: out of memory");
1015                 MemSet(prodesc, 0, sizeof(pltcl_proc_desc));
1016                 prodesc->proname = strdup(internal_proname);
1017                 prodesc->fn_xmin = HeapTupleHeaderGetXmin(procTup->t_data);
1018                 prodesc->fn_cmin = HeapTupleHeaderGetCmin(procTup->t_data);
1019
1020                 /************************************************************
1021                  * Lookup the pg_language tuple by Oid
1022                  ************************************************************/
1023                 langTup = SearchSysCache(LANGOID,
1024                                                                  ObjectIdGetDatum(procStruct->prolang),
1025                                                                  0, 0, 0);
1026                 if (!HeapTupleIsValid(langTup))
1027                 {
1028                         free(prodesc->proname);
1029                         free(prodesc);
1030                         elog(ERROR, "pltcl: cache lookup for language %u failed",
1031                                  procStruct->prolang);
1032                 }
1033                 langStruct = (Form_pg_language) GETSTRUCT(langTup);
1034                 prodesc->lanpltrusted = langStruct->lanpltrusted;
1035                 ReleaseSysCache(langTup);
1036
1037                 if (prodesc->lanpltrusted)
1038                         interp = pltcl_safe_interp;
1039                 else
1040                         interp = pltcl_norm_interp;
1041
1042                 /************************************************************
1043                  * Get the required information for input conversion of the
1044                  * return value.
1045                  ************************************************************/
1046                 if (!is_trigger)
1047                 {
1048                         typeTup = SearchSysCache(TYPEOID,
1049                                                                 ObjectIdGetDatum(procStruct->prorettype),
1050                                                                          0, 0, 0);
1051                         if (!HeapTupleIsValid(typeTup))
1052                         {
1053                                 free(prodesc->proname);
1054                                 free(prodesc);
1055                                 elog(ERROR, "pltcl: cache lookup for return type %u failed",
1056                                          procStruct->prorettype);
1057                         }
1058                         typeStruct = (Form_pg_type) GETSTRUCT(typeTup);
1059
1060                         /* Disallow pseudotype result, except VOID */
1061                         if (typeStruct->typtype == 'p')
1062                         {
1063                                 if (procStruct->prorettype == VOIDOID)
1064                                          /* okay */ ;
1065                                 else if (procStruct->prorettype == TRIGGEROID)
1066                                 {
1067                                         free(prodesc->proname);
1068                                         free(prodesc);
1069                                         elog(ERROR, "pltcl functions cannot return type %s"
1070                                                  "\n\texcept when used as triggers",
1071                                                  format_type_be(procStruct->prorettype));
1072                                 }
1073                                 else
1074                                 {
1075                                         free(prodesc->proname);
1076                                         free(prodesc);
1077                                         elog(ERROR, "pltcl functions cannot return type %s",
1078                                                  format_type_be(procStruct->prorettype));
1079                                 }
1080                         }
1081
1082                         if (typeStruct->typrelid != InvalidOid)
1083                         {
1084                                 free(prodesc->proname);
1085                                 free(prodesc);
1086                                 elog(ERROR, "pltcl: return types of tuples not supported yet");
1087                         }
1088
1089                         perm_fmgr_info(typeStruct->typinput, &(prodesc->result_in_func));
1090                         prodesc->result_in_elem = typeStruct->typelem;
1091
1092                         ReleaseSysCache(typeTup);
1093                 }
1094
1095                 /************************************************************
1096                  * Get the required information for output conversion
1097                  * of all procedure arguments
1098                  ************************************************************/
1099                 if (!is_trigger)
1100                 {
1101                         prodesc->nargs = procStruct->pronargs;
1102                         proc_internal_args[0] = '\0';
1103                         for (i = 0; i < prodesc->nargs; i++)
1104                         {
1105                                 typeTup = SearchSysCache(TYPEOID,
1106                                                         ObjectIdGetDatum(procStruct->proargtypes[i]),
1107                                                                                  0, 0, 0);
1108                                 if (!HeapTupleIsValid(typeTup))
1109                                 {
1110                                         free(prodesc->proname);
1111                                         free(prodesc);
1112                                         elog(ERROR, "pltcl: cache lookup for argument type %u failed",
1113                                                  procStruct->proargtypes[i]);
1114                                 }
1115                                 typeStruct = (Form_pg_type) GETSTRUCT(typeTup);
1116
1117                                 /* Disallow pseudotype argument */
1118                                 if (typeStruct->typtype == 'p')
1119                                 {
1120                                         free(prodesc->proname);
1121                                         free(prodesc);
1122                                         elog(ERROR, "pltcl functions cannot take type %s",
1123                                                  format_type_be(procStruct->proargtypes[i]));
1124                                 }
1125
1126                                 if (typeStruct->typrelid != InvalidOid)
1127                                 {
1128                                         prodesc->arg_is_rel[i] = 1;
1129                                         if (i > 0)
1130                                                 strcat(proc_internal_args, " ");
1131                                         snprintf(buf, sizeof(buf), "__PLTcl_Tup_%d", i + 1);
1132                                         strcat(proc_internal_args, buf);
1133                                         ReleaseSysCache(typeTup);
1134                                         continue;
1135                                 }
1136                                 else
1137                                         prodesc->arg_is_rel[i] = 0;
1138
1139                                 perm_fmgr_info(typeStruct->typoutput, &(prodesc->arg_out_func[i]));
1140                                 prodesc->arg_out_elem[i] = typeStruct->typelem;
1141
1142                                 if (i > 0)
1143                                         strcat(proc_internal_args, " ");
1144                                 snprintf(buf, sizeof(buf), "%d", i + 1);
1145                                 strcat(proc_internal_args, buf);
1146
1147                                 ReleaseSysCache(typeTup);
1148                         }
1149                 }
1150                 else
1151                 {
1152                         /* trigger procedure has fixed args */
1153                         strcpy(proc_internal_args,
1154                                    "TG_name TG_relid TG_relatts TG_when TG_level TG_op __PLTcl_Tup_NEW __PLTcl_Tup_OLD args");
1155                 }
1156
1157                 /************************************************************
1158                  * Create the tcl command to define the internal
1159                  * procedure
1160                  ************************************************************/
1161                 Tcl_DStringInit(&proc_internal_def);
1162                 Tcl_DStringInit(&proc_internal_body);
1163                 Tcl_DStringAppendElement(&proc_internal_def, "proc");
1164                 Tcl_DStringAppendElement(&proc_internal_def, internal_proname);
1165                 Tcl_DStringAppendElement(&proc_internal_def, proc_internal_args);
1166
1167                 /************************************************************
1168                  * prefix procedure body with
1169                  * upvar #0 <internal_procname> GD
1170                  * and with appropriate setting of arguments
1171                  ************************************************************/
1172                 Tcl_DStringAppend(&proc_internal_body, "upvar #0 ", -1);
1173                 Tcl_DStringAppend(&proc_internal_body, internal_proname, -1);
1174                 Tcl_DStringAppend(&proc_internal_body, " GD\n", -1);
1175                 if (!is_trigger)
1176                 {
1177                         for (i = 0; i < prodesc->nargs; i++)
1178                         {
1179                                 if (!prodesc->arg_is_rel[i])
1180                                         continue;
1181                                 snprintf(buf, sizeof(buf), "array set %d $__PLTcl_Tup_%d\n",
1182                                                  i + 1, i + 1);
1183                                 Tcl_DStringAppend(&proc_internal_body, buf, -1);
1184                         }
1185                 }
1186                 else
1187                 {
1188                         Tcl_DStringAppend(&proc_internal_body,
1189                                                           "array set NEW $__PLTcl_Tup_NEW\n", -1);
1190                         Tcl_DStringAppend(&proc_internal_body,
1191                                                           "array set OLD $__PLTcl_Tup_OLD\n", -1);
1192
1193                         Tcl_DStringAppend(&proc_internal_body,
1194                                                           "set i 0\n"
1195                                                           "set v 0\n"
1196                                                           "foreach v $args {\n"
1197                                                           "  incr i\n"
1198                                                           "  set $i $v\n"
1199                                                           "}\n"
1200                                                           "unset i v\n\n", -1);
1201                 }
1202
1203                 /************************************************************
1204                  * Add user's function definition to proc body
1205                  ************************************************************/
1206                 proc_source = DatumGetCString(DirectFunctionCall1(textout,
1207                                                                   PointerGetDatum(&procStruct->prosrc)));
1208                 UTF_BEGIN;
1209                 Tcl_DStringAppend(&proc_internal_body, UTF_E2U(proc_source), -1);
1210                 UTF_END;
1211                 pfree(proc_source);
1212                 Tcl_DStringAppendElement(&proc_internal_def,
1213                                                                  Tcl_DStringValue(&proc_internal_body));
1214                 Tcl_DStringFree(&proc_internal_body);
1215
1216                 /************************************************************
1217                  * Create the procedure in the interpreter
1218                  ************************************************************/
1219                 tcl_rc = Tcl_GlobalEval(interp,
1220                                                                 Tcl_DStringValue(&proc_internal_def));
1221                 Tcl_DStringFree(&proc_internal_def);
1222                 if (tcl_rc != TCL_OK)
1223                 {
1224                         free(prodesc->proname);
1225                         free(prodesc);
1226                         elog(ERROR, "pltcl: cannot create internal procedure %s - %s",
1227                                  internal_proname, interp->result);
1228                 }
1229
1230                 /************************************************************
1231                  * Add the proc description block to the hashtable
1232                  ************************************************************/
1233                 hashent = Tcl_CreateHashEntry(pltcl_proc_hash,
1234                                                                           prodesc->proname, &hashnew);
1235                 Tcl_SetHashValue(hashent, (ClientData) prodesc);
1236         }
1237
1238         ReleaseSysCache(procTup);
1239
1240         return prodesc;
1241 }
1242
1243
1244 /**********************************************************************
1245  * pltcl_elog()         - elog() support for PLTcl
1246  **********************************************************************/
1247 static int
1248 pltcl_elog(ClientData cdata, Tcl_Interp *interp,
1249                    int argc, char *argv[])
1250 {
1251         int                     level;
1252         sigjmp_buf      save_restart;
1253
1254         /************************************************************
1255          * Suppress messages during the restart process
1256          ************************************************************/
1257         if (pltcl_restart_in_progress)
1258                 return TCL_ERROR;
1259
1260         /************************************************************
1261          * Catch the restart longjmp and begin a controlled
1262          * return though all interpreter levels if it happens
1263          ************************************************************/
1264         memcpy(&save_restart, &Warn_restart, sizeof(save_restart));
1265         if (sigsetjmp(Warn_restart, 1) != 0)
1266         {
1267                 memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
1268                 pltcl_restart_in_progress = 1;
1269                 return TCL_ERROR;
1270         }
1271
1272         if (argc != 3)
1273         {
1274                 Tcl_SetResult(interp, "syntax error - 'elog level msg'",
1275                                           TCL_VOLATILE);
1276                 return TCL_ERROR;
1277         }
1278
1279         if (strcmp(argv[1], "DEBUG") == 0)
1280                 level = DEBUG1;
1281         else if (strcmp(argv[1], "LOG") == 0)
1282                 level = LOG;
1283         else if (strcmp(argv[1], "INFO") == 0)
1284                 level = INFO;
1285         else if (strcmp(argv[1], "NOTICE") == 0)
1286                 level = NOTICE;
1287         else if (strcmp(argv[1], "WARNING") == 0)
1288                 level = ERROR;
1289         else if (strcmp(argv[1], "ERROR") == 0)
1290                 level = ERROR;
1291         else if (strcmp(argv[1], "FATAL") == 0)
1292                 level = FATAL;
1293         else
1294         {
1295                 Tcl_AppendResult(interp, "Unknown elog level '", argv[1],
1296                                                  "'", NULL);
1297                 memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
1298                 return TCL_ERROR;
1299         }
1300
1301         /************************************************************
1302          * Call elog(), restore the original restart address
1303          * and return to the caller (if not catched)
1304          ************************************************************/
1305         UTF_BEGIN;
1306         elog(level, UTF_U2E(argv[2]));
1307         UTF_END;
1308         memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
1309         return TCL_OK;
1310 }
1311
1312
1313 /**********************************************************************
1314  * pltcl_quote()        - quote literal strings that are to
1315  *                        be used in SPI_exec query strings
1316  **********************************************************************/
1317 static int
1318 pltcl_quote(ClientData cdata, Tcl_Interp *interp,
1319                         int argc, char *argv[])
1320 {
1321         char       *tmp;
1322         char       *cp1;
1323         char       *cp2;
1324
1325         /************************************************************
1326          * Check call syntax
1327          ************************************************************/
1328         if (argc != 2)
1329         {
1330                 Tcl_SetResult(interp, "syntax error - 'quote string'", TCL_VOLATILE);
1331                 return TCL_ERROR;
1332         }
1333
1334         /************************************************************
1335          * Allocate space for the maximum the string can
1336          * grow to and initialize pointers
1337          ************************************************************/
1338         tmp = palloc(strlen(argv[1]) * 2 + 1);
1339         cp1 = argv[1];
1340         cp2 = tmp;
1341
1342         /************************************************************
1343          * Walk through string and double every quote and backslash
1344          ************************************************************/
1345         while (*cp1)
1346         {
1347                 if (*cp1 == '\'')
1348                         *cp2++ = '\'';
1349                 else
1350                 {
1351                         if (*cp1 == '\\')
1352                                 *cp2++ = '\\';
1353                 }
1354                 *cp2++ = *cp1++;
1355         }
1356
1357         /************************************************************
1358          * Terminate the string and set it as result
1359          ************************************************************/
1360         *cp2 = '\0';
1361         Tcl_SetResult(interp, tmp, TCL_VOLATILE);
1362         pfree(tmp);
1363         return TCL_OK;
1364 }
1365
1366
1367 /**********************************************************************
1368  * pltcl_argisnull()    - determine if a specific argument is NULL
1369  **********************************************************************/
1370 static int
1371 pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
1372                                 int argc, char *argv[])
1373 {
1374         int                     argno;
1375         FunctionCallInfo fcinfo = pltcl_current_fcinfo;
1376
1377         /************************************************************
1378          * Check call syntax
1379          ************************************************************/
1380         if (argc != 2)
1381         {
1382                 Tcl_SetResult(interp, "syntax error - 'argisnull argno'", TCL_VOLATILE);
1383                 return TCL_ERROR;
1384         }
1385
1386         /************************************************************
1387          * Check that we're called as a normal function
1388          ************************************************************/
1389         if (fcinfo == NULL)
1390         {
1391                 Tcl_SetResult(interp, "argisnull cannot be used in triggers",
1392                                           TCL_VOLATILE);
1393                 return TCL_ERROR;
1394         }
1395
1396         /************************************************************
1397          * Get the argument number
1398          ************************************************************/
1399         if (Tcl_GetInt(interp, argv[1], &argno) != TCL_OK)
1400                 return TCL_ERROR;
1401
1402         /************************************************************
1403          * Check that the argno is valid
1404          ************************************************************/
1405         argno--;
1406         if (argno < 0 || argno >= fcinfo->nargs)
1407         {
1408                 Tcl_SetResult(interp, "argno out of range", TCL_VOLATILE);
1409                 return TCL_ERROR;
1410         }
1411
1412         /************************************************************
1413          * Get the requested NULL state
1414          ************************************************************/
1415         if (PG_ARGISNULL(argno))
1416                 Tcl_SetResult(interp, "1", TCL_VOLATILE);
1417         else
1418                 Tcl_SetResult(interp, "0", TCL_VOLATILE);
1419
1420         return TCL_OK;
1421 }
1422
1423
1424 /**********************************************************************
1425  * pltcl_returnnull()   - Cause a NULL return from a function
1426  **********************************************************************/
1427 static int
1428 pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
1429                                  int argc, char *argv[])
1430 {
1431         FunctionCallInfo fcinfo = pltcl_current_fcinfo;
1432
1433         /************************************************************
1434          * Check call syntax
1435          ************************************************************/
1436         if (argc != 1)
1437         {
1438                 Tcl_SetResult(interp, "syntax error - 'return_null'", TCL_VOLATILE);
1439                 return TCL_ERROR;
1440         }
1441
1442         /************************************************************
1443          * Check that we're called as a normal function
1444          ************************************************************/
1445         if (fcinfo == NULL)
1446         {
1447                 Tcl_SetResult(interp, "return_null cannot be used in triggers",
1448                                           TCL_VOLATILE);
1449                 return TCL_ERROR;
1450         }
1451
1452         /************************************************************
1453          * Set the NULL return flag and cause Tcl to return from the
1454          * procedure.
1455          ************************************************************/
1456         fcinfo->isnull = true;
1457
1458         return TCL_RETURN;
1459 }
1460
1461
1462 /**********************************************************************
1463  * pltcl_SPI_exec()             - The builtin SPI_exec command
1464  *                                for the Tcl interpreter
1465  **********************************************************************/
1466 static int
1467 pltcl_SPI_exec(ClientData cdata, Tcl_Interp *interp,
1468                            int argc, char *argv[])
1469 {
1470         int                     spi_rc;
1471         char            buf[64];
1472         int                     count = 0;
1473         char       *volatile arrayname = NULL;
1474         volatile int query_idx;
1475         int                     i;
1476         int                     loop_rc;
1477         int                     ntuples;
1478         HeapTuple  *volatile tuples;
1479         volatile TupleDesc tupdesc = NULL;
1480         SPITupleTable *tuptable;
1481         sigjmp_buf      save_restart;
1482
1483         char       *usage = "syntax error - 'SPI_exec "
1484         "?-count n? "
1485         "?-array name? query ?loop body?";
1486
1487         /************************************************************
1488          * Don't do anything if we are already in restart mode
1489          ************************************************************/
1490         if (pltcl_restart_in_progress)
1491                 return TCL_ERROR;
1492
1493         /************************************************************
1494          * Check the call syntax and get the count option
1495          ************************************************************/
1496         if (argc < 2)
1497         {
1498                 Tcl_SetResult(interp, usage, TCL_VOLATILE);
1499                 return TCL_ERROR;
1500         }
1501
1502         i = 1;
1503         while (i < argc)
1504         {
1505                 if (strcmp(argv[i], "-array") == 0)
1506                 {
1507                         if (++i >= argc)
1508                         {
1509                                 Tcl_SetResult(interp, usage, TCL_VOLATILE);
1510                                 return TCL_ERROR;
1511                         }
1512                         arrayname = argv[i++];
1513                         continue;
1514                 }
1515
1516                 if (strcmp(argv[i], "-count") == 0)
1517                 {
1518                         if (++i >= argc)
1519                         {
1520                                 Tcl_SetResult(interp, usage, TCL_VOLATILE);
1521                                 return TCL_ERROR;
1522                         }
1523                         if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK)
1524                                 return TCL_ERROR;
1525                         continue;
1526                 }
1527
1528                 break;
1529         }
1530
1531         query_idx = i;
1532         if (query_idx >= argc)
1533         {
1534                 Tcl_SetResult(interp, usage, TCL_VOLATILE);
1535                 return TCL_ERROR;
1536         }
1537
1538         /************************************************************
1539          * Prepare to start a controlled return through all
1540          * interpreter levels on transaction abort
1541          ************************************************************/
1542         memcpy(&save_restart, &Warn_restart, sizeof(save_restart));
1543         if (sigsetjmp(Warn_restart, 1) != 0)
1544         {
1545                 memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
1546                 pltcl_restart_in_progress = 1;
1547                 Tcl_SetResult(interp, "Transaction abort", TCL_VOLATILE);
1548                 return TCL_ERROR;
1549         }
1550
1551         /************************************************************
1552          * Execute the query and handle return codes
1553          ************************************************************/
1554         UTF_BEGIN;
1555         spi_rc = SPI_exec(UTF_U2E(argv[query_idx]), count);
1556         UTF_END;
1557         memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
1558
1559         switch (spi_rc)
1560         {
1561                 case SPI_OK_UTILITY:
1562                         Tcl_SetResult(interp, "0", TCL_VOLATILE);
1563                         SPI_freetuptable(SPI_tuptable);
1564                         return TCL_OK;
1565
1566                 case SPI_OK_SELINTO:
1567                 case SPI_OK_INSERT:
1568                 case SPI_OK_DELETE:
1569                 case SPI_OK_UPDATE:
1570                         snprintf(buf, sizeof(buf), "%d", SPI_processed);
1571                         Tcl_SetResult(interp, buf, TCL_VOLATILE);
1572                         SPI_freetuptable(SPI_tuptable);
1573                         return TCL_OK;
1574
1575                 case SPI_OK_SELECT:
1576                         break;
1577
1578                 case SPI_ERROR_ARGUMENT:
1579                         Tcl_SetResult(interp,
1580                                                   "pltcl: SPI_exec() failed - SPI_ERROR_ARGUMENT",
1581                                                   TCL_VOLATILE);
1582                         return TCL_ERROR;
1583
1584                 case SPI_ERROR_UNCONNECTED:
1585                         Tcl_SetResult(interp,
1586                                           "pltcl: SPI_exec() failed - SPI_ERROR_UNCONNECTED",
1587                                                   TCL_VOLATILE);
1588                         return TCL_ERROR;
1589
1590                 case SPI_ERROR_COPY:
1591                         Tcl_SetResult(interp,
1592                                                   "pltcl: SPI_exec() failed - SPI_ERROR_COPY",
1593                                                   TCL_VOLATILE);
1594                         return TCL_ERROR;
1595
1596                 case SPI_ERROR_CURSOR:
1597                         Tcl_SetResult(interp,
1598                                                   "pltcl: SPI_exec() failed - SPI_ERROR_CURSOR",
1599                                                   TCL_VOLATILE);
1600                         return TCL_ERROR;
1601
1602                 case SPI_ERROR_TRANSACTION:
1603                         Tcl_SetResult(interp,
1604                                           "pltcl: SPI_exec() failed - SPI_ERROR_TRANSACTION",
1605                                                   TCL_VOLATILE);
1606                         return TCL_ERROR;
1607
1608                 case SPI_ERROR_OPUNKNOWN:
1609                         Tcl_SetResult(interp,
1610                                                 "pltcl: SPI_exec() failed - SPI_ERROR_OPUNKNOWN",
1611                                                   TCL_VOLATILE);
1612                         return TCL_ERROR;
1613
1614                 default:
1615                         snprintf(buf, sizeof(buf), "%d", spi_rc);
1616                         Tcl_AppendResult(interp, "pltcl: SPI_exec() failed - ",
1617                                                          "unknown RC ", buf, NULL);
1618                         return TCL_ERROR;
1619         }
1620
1621         /************************************************************
1622          * Only SELECT queries fall through to here - remember the
1623          * tuples we got
1624          ************************************************************/
1625
1626         ntuples = SPI_processed;
1627         if (ntuples > 0)
1628         {
1629                 tuples = SPI_tuptable->vals;
1630                 tupdesc = SPI_tuptable->tupdesc;
1631         }
1632
1633         /************************************************************
1634          * Again prepare for elog(ERROR)
1635          ************************************************************/
1636         if (sigsetjmp(Warn_restart, 1) != 0)
1637         {
1638                 memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
1639                 pltcl_restart_in_progress = 1;
1640                 Tcl_SetResult(interp, "Transaction abort", TCL_VOLATILE);
1641                 return TCL_ERROR;
1642         }
1643
1644         /************************************************************
1645          * If there is no loop body given, just set the variables
1646          * from the first tuple (if any) and return the number of
1647          * tuples selected
1648          ************************************************************/
1649         if (argc == query_idx + 1)
1650         {
1651                 if (ntuples > 0)
1652                         pltcl_set_tuple_values(interp, arrayname, 0, tuples[0], tupdesc);
1653                 snprintf(buf, sizeof(buf), "%d", ntuples);
1654                 Tcl_SetResult(interp, buf, TCL_VOLATILE);
1655                 SPI_freetuptable(SPI_tuptable);
1656                 memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
1657                 return TCL_OK;
1658         }
1659
1660         tuptable = SPI_tuptable;
1661
1662         /************************************************************
1663          * There is a loop body - process all tuples and evaluate
1664          * the body on each
1665          ************************************************************/
1666         query_idx++;
1667         for (i = 0; i < ntuples; i++)
1668         {
1669                 pltcl_set_tuple_values(interp, arrayname, i, tuples[i], tupdesc);
1670
1671                 loop_rc = Tcl_Eval(interp, argv[query_idx]);
1672
1673                 if (loop_rc == TCL_OK)
1674                         continue;
1675                 if (loop_rc == TCL_CONTINUE)
1676                         continue;
1677                 if (loop_rc == TCL_RETURN)
1678                 {
1679                         SPI_freetuptable(tuptable);
1680                         memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
1681                         return TCL_RETURN;
1682                 }
1683                 if (loop_rc == TCL_BREAK)
1684                         break;
1685                 SPI_freetuptable(tuptable);
1686                 memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
1687                 return TCL_ERROR;
1688         }
1689
1690         SPI_freetuptable(tuptable);
1691
1692         /************************************************************
1693          * Finally return the number of tuples
1694          ************************************************************/
1695         memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
1696         snprintf(buf, sizeof(buf), "%d", ntuples);
1697         Tcl_SetResult(interp, buf, TCL_VOLATILE);
1698         return TCL_OK;
1699 }
1700
1701
1702 /**********************************************************************
1703  * pltcl_SPI_prepare()          - Builtin support for prepared plans
1704  *                                The Tcl command SPI_prepare
1705  *                                always saves the plan using
1706  *                                SPI_saveplan and returns a key for
1707  *                                access. There is no chance to prepare
1708  *                                and not save the plan currently.
1709  **********************************************************************/
1710 static int
1711 pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
1712                                   int argc, char *argv[])
1713 {
1714         int                     nargs;
1715         char      **args;
1716         pltcl_query_desc *qdesc;
1717         void       *plan;
1718         int                     i;
1719         HeapTuple       typeTup;
1720         Tcl_HashEntry *hashent;
1721         int                     hashnew;
1722         sigjmp_buf      save_restart;
1723         Tcl_HashTable *query_hash;
1724
1725         /************************************************************
1726          * Don't do anything if we are already in restart mode
1727          ************************************************************/
1728         if (pltcl_restart_in_progress)
1729                 return TCL_ERROR;
1730
1731         /************************************************************
1732          * Check the call syntax
1733          ************************************************************/
1734         if (argc != 3)
1735         {
1736                 Tcl_SetResult(interp, "syntax error - 'SPI_prepare query argtypes'",
1737                                           TCL_VOLATILE);
1738                 return TCL_ERROR;
1739         }
1740
1741         /************************************************************
1742          * Split the argument type list
1743          ************************************************************/
1744         if (Tcl_SplitList(interp, argv[2], &nargs, &args) != TCL_OK)
1745                 return TCL_ERROR;
1746
1747         /************************************************************
1748          * Allocate the new querydesc structure
1749          ************************************************************/
1750         qdesc = (pltcl_query_desc *) malloc(sizeof(pltcl_query_desc));
1751         snprintf(qdesc->qname, sizeof(qdesc->qname), "%lx", (long) qdesc);
1752         qdesc->nargs = nargs;
1753         qdesc->argtypes = (Oid *) malloc(nargs * sizeof(Oid));
1754         qdesc->arginfuncs = (FmgrInfo *) malloc(nargs * sizeof(FmgrInfo));
1755         qdesc->argtypelems = (Oid *) malloc(nargs * sizeof(Oid));
1756
1757         /************************************************************
1758          * Prepare to start a controlled return through all
1759          * interpreter levels on transaction abort
1760          ************************************************************/
1761         memcpy(&save_restart, &Warn_restart, sizeof(save_restart));
1762         if (sigsetjmp(Warn_restart, 1) != 0)
1763         {
1764                 memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
1765                 pltcl_restart_in_progress = 1;
1766                 free(qdesc->argtypes);
1767                 free(qdesc->arginfuncs);
1768                 free(qdesc->argtypelems);
1769                 free(qdesc);
1770                 ckfree((char *) args);
1771                 return TCL_ERROR;
1772         }
1773
1774         /************************************************************
1775          * Lookup the argument types by name in the system cache
1776          * and remember the required information for input conversion
1777          ************************************************************/
1778         for (i = 0; i < nargs; i++)
1779         {
1780                 /* XXX should extend this to allow qualified type names */
1781                 typeTup = typenameType(makeTypeName(args[i]));
1782                 qdesc->argtypes[i] = HeapTupleGetOid(typeTup);
1783                 perm_fmgr_info(((Form_pg_type) GETSTRUCT(typeTup))->typinput,
1784                                            &(qdesc->arginfuncs[i]));
1785                 qdesc->argtypelems[i] = ((Form_pg_type) GETSTRUCT(typeTup))->typelem;
1786                 ReleaseSysCache(typeTup);
1787         }
1788
1789         /************************************************************
1790          * Prepare the plan and check for errors
1791          ************************************************************/
1792         UTF_BEGIN;
1793         plan = SPI_prepare(UTF_U2E(argv[1]), nargs, qdesc->argtypes);
1794         UTF_END;
1795
1796         if (plan == NULL)
1797         {
1798                 char            buf[128];
1799                 char       *reason;
1800
1801                 memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
1802
1803                 switch (SPI_result)
1804                 {
1805                         case SPI_ERROR_ARGUMENT:
1806                                 reason = "SPI_ERROR_ARGUMENT";
1807                                 break;
1808
1809                         case SPI_ERROR_UNCONNECTED:
1810                                 reason = "SPI_ERROR_UNCONNECTED";
1811                                 break;
1812
1813                         case SPI_ERROR_COPY:
1814                                 reason = "SPI_ERROR_COPY";
1815                                 break;
1816
1817                         case SPI_ERROR_CURSOR:
1818                                 reason = "SPI_ERROR_CURSOR";
1819                                 break;
1820
1821                         case SPI_ERROR_TRANSACTION:
1822                                 reason = "SPI_ERROR_TRANSACTION";
1823                                 break;
1824
1825                         case SPI_ERROR_OPUNKNOWN:
1826                                 reason = "SPI_ERROR_OPUNKNOWN";
1827                                 break;
1828
1829                         default:
1830                                 snprintf(buf, sizeof(buf), "unknown RC %d", SPI_result);
1831                                 reason = buf;
1832                                 break;
1833
1834                 }
1835
1836                 elog(ERROR, "pltcl: SPI_prepare() failed - %s", reason);
1837         }
1838
1839         /************************************************************
1840          * Save the plan
1841          ************************************************************/
1842         qdesc->plan = SPI_saveplan(plan);
1843         if (qdesc->plan == NULL)
1844         {
1845                 char            buf[128];
1846                 char       *reason;
1847
1848                 memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
1849
1850                 switch (SPI_result)
1851                 {
1852                         case SPI_ERROR_ARGUMENT:
1853                                 reason = "SPI_ERROR_ARGUMENT";
1854                                 break;
1855
1856                         case SPI_ERROR_UNCONNECTED:
1857                                 reason = "SPI_ERROR_UNCONNECTED";
1858                                 break;
1859
1860                         default:
1861                                 snprintf(buf, sizeof(buf), "unknown RC %d", SPI_result);
1862                                 reason = buf;
1863                                 break;
1864
1865                 }
1866
1867                 elog(ERROR, "pltcl: SPI_saveplan() failed - %s", reason);
1868         }
1869
1870         /************************************************************
1871          * Insert a hashtable entry for the plan and return
1872          * the key to the caller
1873          ************************************************************/
1874         if (interp == pltcl_norm_interp)
1875                 query_hash = pltcl_norm_query_hash;
1876         else
1877                 query_hash = pltcl_safe_query_hash;
1878
1879         memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
1880         hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew);
1881         Tcl_SetHashValue(hashent, (ClientData) qdesc);
1882
1883         Tcl_SetResult(interp, qdesc->qname, TCL_VOLATILE);
1884         return TCL_OK;
1885 }
1886
1887
1888 /**********************************************************************
1889  * pltcl_SPI_execp()            - Execute a prepared plan
1890  **********************************************************************/
1891 static int
1892 pltcl_SPI_execp(ClientData cdata, Tcl_Interp *interp,
1893                                 int argc, char *argv[])
1894 {
1895         int                     spi_rc;
1896         char            buf[64];
1897         volatile int i;
1898         int                     j;
1899         int                     loop_body;
1900         Tcl_HashEntry *hashent;
1901         pltcl_query_desc *qdesc;
1902         Datum      *volatile argvalues = NULL;
1903         char       *volatile nulls = NULL;
1904         char       *volatile arrayname = NULL;
1905         int                     count = 0;
1906         int                     callnargs;
1907         static char **callargs = NULL;
1908         int                     loop_rc;
1909         int                     ntuples;
1910         HeapTuple  *volatile tuples = NULL;
1911         volatile TupleDesc tupdesc = NULL;
1912         SPITupleTable *tuptable;
1913         sigjmp_buf      save_restart;
1914         Tcl_HashTable *query_hash;
1915
1916         char       *usage = "syntax error - 'SPI_execp "
1917         "?-nulls string? ?-count n? "
1918         "?-array name? query ?args? ?loop body?";
1919
1920         /************************************************************
1921          * Tidy up from an earlier abort
1922          ************************************************************/
1923         if (callargs != NULL)
1924         {
1925                 ckfree((char *) callargs);
1926                 callargs = NULL;
1927         }
1928
1929         /************************************************************
1930          * Don't do anything if we are already in restart mode
1931          ************************************************************/
1932         if (pltcl_restart_in_progress)
1933                 return TCL_ERROR;
1934
1935         /************************************************************
1936          * Get the options and check syntax
1937          ************************************************************/
1938         i = 1;
1939         while (i < argc)
1940         {
1941                 if (strcmp(argv[i], "-array") == 0)
1942                 {
1943                         if (++i >= argc)
1944                         {
1945                                 Tcl_SetResult(interp, usage, TCL_VOLATILE);
1946                                 return TCL_ERROR;
1947                         }
1948                         arrayname = argv[i++];
1949                         continue;
1950                 }
1951                 if (strcmp(argv[i], "-nulls") == 0)
1952                 {
1953                         if (++i >= argc)
1954                         {
1955                                 Tcl_SetResult(interp, usage, TCL_VOLATILE);
1956                                 return TCL_ERROR;
1957                         }
1958                         nulls = argv[i++];
1959                         continue;
1960                 }
1961                 if (strcmp(argv[i], "-count") == 0)
1962                 {
1963                         if (++i >= argc)
1964                         {
1965                                 Tcl_SetResult(interp, usage, TCL_VOLATILE);
1966                                 return TCL_ERROR;
1967                         }
1968                         if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK)
1969                                 return TCL_ERROR;
1970                         continue;
1971                 }
1972
1973                 break;
1974         }
1975
1976         /************************************************************
1977          * Check minimum call arguments
1978          ************************************************************/
1979         if (i >= argc)
1980         {
1981                 Tcl_SetResult(interp, usage, TCL_VOLATILE);
1982                 return TCL_ERROR;
1983         }
1984
1985         /************************************************************
1986          * Get the prepared plan descriptor by its key
1987          ************************************************************/
1988         if (interp == pltcl_norm_interp)
1989                 query_hash = pltcl_norm_query_hash;
1990         else
1991                 query_hash = pltcl_safe_query_hash;
1992
1993         hashent = Tcl_FindHashEntry(query_hash, argv[i++]);
1994         if (hashent == NULL)
1995         {
1996                 Tcl_AppendResult(interp, "invalid queryid '", argv[--i], "'", NULL);
1997                 return TCL_ERROR;
1998         }
1999         qdesc = (pltcl_query_desc *) Tcl_GetHashValue(hashent);
2000
2001         /************************************************************
2002          * If a nulls string is given, check for correct length
2003          ************************************************************/
2004         if (nulls != NULL)
2005         {
2006                 if (strlen(nulls) != qdesc->nargs)
2007                 {
2008                         Tcl_SetResult(interp,
2009                                    "length of nulls string doesn't match # of arguments",
2010                                                   TCL_VOLATILE);
2011                         return TCL_ERROR;
2012                 }
2013         }
2014
2015         /************************************************************
2016          * If there was a argtype list on preparation, we need
2017          * an argument value list now
2018          ************************************************************/
2019         if (qdesc->nargs > 0)
2020         {
2021                 if (i >= argc)
2022                 {
2023                         Tcl_SetResult(interp, "missing argument list", TCL_VOLATILE);
2024                         return TCL_ERROR;
2025                 }
2026
2027                 /************************************************************
2028                  * Split the argument values
2029                  ************************************************************/
2030                 if (Tcl_SplitList(interp, argv[i++], &callnargs, &callargs) != TCL_OK)
2031                         return TCL_ERROR;
2032
2033                 /************************************************************
2034                  * Check that the # of arguments matches
2035                  ************************************************************/
2036                 if (callnargs != qdesc->nargs)
2037                 {
2038                         Tcl_SetResult(interp,
2039                         "argument list length doesn't match # of arguments for query",
2040                                                   TCL_VOLATILE);
2041                         if (callargs != NULL)
2042                         {
2043                                 ckfree((char *) callargs);
2044                                 callargs = NULL;
2045                         }
2046                         return TCL_ERROR;
2047                 }
2048
2049                 /************************************************************
2050                  * Prepare to start a controlled return through all
2051                  * interpreter levels on transaction abort during the
2052                  * parse of the arguments
2053                  ************************************************************/
2054                 memcpy(&save_restart, &Warn_restart, sizeof(save_restart));
2055                 if (sigsetjmp(Warn_restart, 1) != 0)
2056                 {
2057                         memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
2058                         ckfree((char *) callargs);
2059                         callargs = NULL;
2060                         pltcl_restart_in_progress = 1;
2061                         Tcl_SetResult(interp, "Transaction abort", TCL_VOLATILE);
2062                         return TCL_ERROR;
2063                 }
2064
2065                 /************************************************************
2066                  * Setup the value array for the SPI_execp() using
2067                  * the type specific input functions
2068                  ************************************************************/
2069                 argvalues = (Datum *) palloc(callnargs * sizeof(Datum));
2070
2071                 for (j = 0; j < callnargs; j++)
2072                 {
2073                         if (nulls && nulls[j] == 'n')
2074                         {
2075                                 /* don't try to convert the input for a null */
2076                                 argvalues[j] = (Datum) 0;
2077                         }
2078                         else
2079                         {
2080                                 UTF_BEGIN;
2081                                 argvalues[j] =
2082                                         FunctionCall3(&qdesc->arginfuncs[j],
2083                                                                   CStringGetDatum(UTF_U2E(callargs[j])),
2084                                                                   ObjectIdGetDatum(qdesc->argtypelems[j]),
2085                                                                   Int32GetDatum(-1));
2086                                 UTF_END;
2087                         }
2088                 }
2089
2090                 /************************************************************
2091                  * Free the splitted argument value list
2092                  ************************************************************/
2093                 memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
2094                 ckfree((char *) callargs);
2095                 callargs = NULL;
2096         }
2097         else
2098                 callnargs = 0;
2099
2100         /************************************************************
2101          * Remember the index of the last processed call
2102          * argument - a loop body for SELECT might follow
2103          ************************************************************/
2104         loop_body = i;
2105
2106         /************************************************************
2107          * Prepare to start a controlled return through all
2108          * interpreter levels on transaction abort
2109          ************************************************************/
2110         memcpy(&save_restart, &Warn_restart, sizeof(save_restart));
2111         if (sigsetjmp(Warn_restart, 1) != 0)
2112         {
2113                 memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
2114                 pltcl_restart_in_progress = 1;
2115                 Tcl_SetResult(interp, "Transaction abort", TCL_VOLATILE);
2116                 return TCL_ERROR;
2117         }
2118
2119         /************************************************************
2120          * Execute the plan
2121          ************************************************************/
2122         spi_rc = SPI_execp(qdesc->plan, argvalues, nulls, count);
2123         memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
2124
2125         /************************************************************
2126          * Check the return code from SPI_execp()
2127          ************************************************************/
2128         switch (spi_rc)
2129         {
2130                 case SPI_OK_UTILITY:
2131                         Tcl_SetResult(interp, "0", TCL_VOLATILE);
2132                         SPI_freetuptable(SPI_tuptable);
2133                         return TCL_OK;
2134
2135                 case SPI_OK_SELINTO:
2136                 case SPI_OK_INSERT:
2137                 case SPI_OK_DELETE:
2138                 case SPI_OK_UPDATE:
2139                         snprintf(buf, sizeof(buf), "%d", SPI_processed);
2140                         Tcl_SetResult(interp, buf, TCL_VOLATILE);
2141                         SPI_freetuptable(SPI_tuptable);
2142                         return TCL_OK;
2143
2144                 case SPI_OK_SELECT:
2145                         break;
2146
2147                 case SPI_ERROR_ARGUMENT:
2148                         Tcl_SetResult(interp,
2149                                                   "pltcl: SPI_exec() failed - SPI_ERROR_ARGUMENT",
2150                                                   TCL_VOLATILE);
2151                         return TCL_ERROR;
2152
2153                 case SPI_ERROR_UNCONNECTED:
2154                         Tcl_SetResult(interp,
2155                                           "pltcl: SPI_exec() failed - SPI_ERROR_UNCONNECTED",
2156                                                   TCL_VOLATILE);
2157                         return TCL_ERROR;
2158
2159                 case SPI_ERROR_COPY:
2160                         Tcl_SetResult(interp,
2161                                                   "pltcl: SPI_exec() failed - SPI_ERROR_COPY",
2162                                                   TCL_VOLATILE);
2163                         return TCL_ERROR;
2164
2165                 case SPI_ERROR_CURSOR:
2166                         Tcl_SetResult(interp,
2167                                                   "pltcl: SPI_exec() failed - SPI_ERROR_CURSOR",
2168                                                   TCL_VOLATILE);
2169                         return TCL_ERROR;
2170
2171                 case SPI_ERROR_TRANSACTION:
2172                         Tcl_SetResult(interp,
2173                                           "pltcl: SPI_exec() failed - SPI_ERROR_TRANSACTION",
2174                                                   TCL_VOLATILE);
2175                         return TCL_ERROR;
2176
2177                 case SPI_ERROR_OPUNKNOWN:
2178                         Tcl_SetResult(interp,
2179                                                 "pltcl: SPI_exec() failed - SPI_ERROR_OPUNKNOWN",
2180                                                   TCL_VOLATILE);
2181                         return TCL_ERROR;
2182
2183                 default:
2184                         snprintf(buf, sizeof(buf), "%d", spi_rc);
2185                         Tcl_AppendResult(interp, "pltcl: SPI_exec() failed - ",
2186                                                          "unknown RC ", buf, NULL);
2187                         return TCL_ERROR;
2188         }
2189
2190         /************************************************************
2191          * Only SELECT queries fall through to here - remember the
2192          * tuples we got
2193          ************************************************************/
2194
2195         ntuples = SPI_processed;
2196         if (ntuples > 0)
2197         {
2198                 tuples = SPI_tuptable->vals;
2199                 tupdesc = SPI_tuptable->tupdesc;
2200         }
2201
2202         /************************************************************
2203          * Prepare to start a controlled return through all
2204          * interpreter levels on transaction abort during
2205          * the ouput conversions of the results
2206          ************************************************************/
2207         memcpy(&save_restart, &Warn_restart, sizeof(save_restart));
2208         if (sigsetjmp(Warn_restart, 1) != 0)
2209         {
2210                 memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
2211                 pltcl_restart_in_progress = 1;
2212                 Tcl_SetResult(interp, "Transaction abort", TCL_VOLATILE);
2213                 return TCL_ERROR;
2214         }
2215
2216         /************************************************************
2217          * If there is no loop body given, just set the variables
2218          * from the first tuple (if any) and return the number of
2219          * tuples selected
2220          ************************************************************/
2221         if (loop_body >= argc)
2222         {
2223                 if (ntuples > 0)
2224                         pltcl_set_tuple_values(interp, arrayname, 0, tuples[0], tupdesc);
2225                 memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
2226                 snprintf(buf, sizeof(buf), "%d", ntuples);
2227                 Tcl_SetResult(interp, buf, TCL_VOLATILE);
2228                 SPI_freetuptable(SPI_tuptable);
2229                 return TCL_OK;
2230         }
2231
2232         tuptable = SPI_tuptable;
2233
2234         /************************************************************
2235          * There is a loop body - process all tuples and evaluate
2236          * the body on each
2237          ************************************************************/
2238         for (i = 0; i < ntuples; i++)
2239         {
2240                 pltcl_set_tuple_values(interp, arrayname, i, tuples[i], tupdesc);
2241
2242                 loop_rc = Tcl_Eval(interp, argv[loop_body]);
2243
2244                 if (loop_rc == TCL_OK)
2245                         continue;
2246                 if (loop_rc == TCL_CONTINUE)
2247                         continue;
2248                 if (loop_rc == TCL_RETURN)
2249                 {
2250                         SPI_freetuptable(tuptable);
2251                         memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
2252                         return TCL_RETURN;
2253                 }
2254                 if (loop_rc == TCL_BREAK)
2255                         break;
2256                 SPI_freetuptable(tuptable);
2257                 memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
2258                 return TCL_ERROR;
2259         }
2260
2261         SPI_freetuptable(tuptable);
2262
2263         /************************************************************
2264          * Finally return the number of tuples
2265          ************************************************************/
2266         memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart));
2267         snprintf(buf, sizeof(buf), "%d", ntuples);
2268         Tcl_SetResult(interp, buf, TCL_VOLATILE);
2269         return TCL_OK;
2270 }
2271
2272
2273 /**********************************************************************
2274  * pltcl_SPI_lastoid()  - return the last oid. To
2275  *                be used after insert queries
2276  **********************************************************************/
2277 static int
2278 pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
2279                                   int argc, char *argv[])
2280 {
2281         char            buf[64];
2282
2283         snprintf(buf, sizeof(buf), "%u", SPI_lastoid);
2284         Tcl_SetResult(interp, buf, TCL_VOLATILE);
2285         return TCL_OK;
2286 }
2287
2288
2289 /**********************************************************************
2290  * pltcl_set_tuple_values() - Set variables for all attributes
2291  *                                of a given tuple
2292  **********************************************************************/
2293 static void
2294 pltcl_set_tuple_values(Tcl_Interp *interp, char *arrayname,
2295                                            int tupno, HeapTuple tuple, TupleDesc tupdesc)
2296 {
2297         int                     i;
2298         char       *outputstr;
2299         char            buf[64];
2300         Datum           attr;
2301         bool            isnull;
2302
2303         char       *attname;
2304         HeapTuple       typeTup;
2305         Oid                     typoutput;
2306         Oid                     typelem;
2307
2308         char      **arrptr;
2309         char      **nameptr;
2310         char       *nullname = NULL;
2311
2312         /************************************************************
2313          * Prepare pointers for Tcl_SetVar2() below and in array
2314          * mode set the .tupno element
2315          ************************************************************/
2316         if (arrayname == NULL)
2317         {
2318                 arrptr = &attname;
2319                 nameptr = &nullname;
2320         }
2321         else
2322         {
2323                 arrptr = &arrayname;
2324                 nameptr = &attname;
2325                 snprintf(buf, sizeof(buf), "%d", tupno);
2326                 Tcl_SetVar2(interp, arrayname, ".tupno", buf, 0);
2327         }
2328
2329         for (i = 0; i < tupdesc->natts; i++)
2330         {
2331                 /************************************************************
2332                  * Get the attribute name
2333                  ************************************************************/
2334                 attname = NameStr(tupdesc->attrs[i]->attname);
2335
2336                 /************************************************************
2337                  * Get the attributes value
2338                  ************************************************************/
2339                 attr = heap_getattr(tuple, i + 1, tupdesc, &isnull);
2340
2341                 /************************************************************
2342                  * Lookup the attribute type in the syscache
2343                  * for the output function
2344                  ************************************************************/
2345                 typeTup = SearchSysCache(TYPEOID,
2346                                                    ObjectIdGetDatum(tupdesc->attrs[i]->atttypid),
2347                                                                  0, 0, 0);
2348                 if (!HeapTupleIsValid(typeTup))
2349                 {
2350                         elog(ERROR, "pltcl: Cache lookup for attribute '%s' type %u failed",
2351                                  attname, tupdesc->attrs[i]->atttypid);
2352                 }
2353
2354                 typoutput = ((Form_pg_type) GETSTRUCT(typeTup))->typoutput;
2355                 typelem = ((Form_pg_type) GETSTRUCT(typeTup))->typelem;
2356                 ReleaseSysCache(typeTup);
2357
2358                 /************************************************************
2359                  * If there is a value, set the variable
2360                  * If not, unset it
2361                  *
2362                  * Hmmm - Null attributes will cause functions to
2363                  *                crash if they don't expect them - need something
2364                  *                smarter here.
2365                  ************************************************************/
2366                 if (!isnull && OidIsValid(typoutput))
2367                 {
2368                         outputstr = DatumGetCString(OidFunctionCall3(typoutput,
2369                                                                                                                  attr,
2370                                                                                            ObjectIdGetDatum(typelem),
2371                                                    Int32GetDatum(tupdesc->attrs[i]->atttypmod)));
2372                         UTF_BEGIN;
2373                         Tcl_SetVar2(interp, *arrptr, *nameptr, UTF_E2U(outputstr), 0);
2374                         UTF_END;
2375                         pfree(outputstr);
2376                 }
2377                 else
2378                         Tcl_UnsetVar2(interp, *arrptr, *nameptr, 0);
2379         }
2380 }
2381
2382
2383 /**********************************************************************
2384  * pltcl_build_tuple_argument() - Build a string usable for 'array set'
2385  *                                from all attributes of a given tuple
2386  **********************************************************************/
2387 static void
2388 pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
2389                                                    Tcl_DString *retval)
2390 {
2391         int                     i;
2392         char       *outputstr;
2393         Datum           attr;
2394         bool            isnull;
2395
2396         char       *attname;
2397         HeapTuple       typeTup;
2398         Oid                     typoutput;
2399         Oid                     typelem;
2400
2401         for (i = 0; i < tupdesc->natts; i++)
2402         {
2403                 /************************************************************
2404                  * Get the attribute name
2405                  ************************************************************/
2406                 attname = NameStr(tupdesc->attrs[i]->attname);
2407
2408                 /************************************************************
2409                  * Get the attributes value
2410                  ************************************************************/
2411                 attr = heap_getattr(tuple, i + 1, tupdesc, &isnull);
2412
2413                 /************************************************************
2414                  * Lookup the attribute type in the syscache
2415                  * for the output function
2416                  ************************************************************/
2417                 typeTup = SearchSysCache(TYPEOID,
2418                                                    ObjectIdGetDatum(tupdesc->attrs[i]->atttypid),
2419                                                                  0, 0, 0);
2420                 if (!HeapTupleIsValid(typeTup))
2421                 {
2422                         elog(ERROR, "pltcl: Cache lookup for attribute '%s' type %u failed",
2423                                  attname, tupdesc->attrs[i]->atttypid);
2424                 }
2425
2426                 typoutput = ((Form_pg_type) GETSTRUCT(typeTup))->typoutput;
2427                 typelem = ((Form_pg_type) GETSTRUCT(typeTup))->typelem;
2428                 ReleaseSysCache(typeTup);
2429
2430                 /************************************************************
2431                  * If there is a value, append the attribute name and the
2432                  * value to the list
2433                  *
2434                  * Hmmm - Null attributes will cause functions to
2435                  *                crash if they don't expect them - need something
2436                  *                smarter here.
2437                  ************************************************************/
2438                 if (!isnull && OidIsValid(typoutput))
2439                 {
2440                         outputstr = DatumGetCString(OidFunctionCall3(typoutput,
2441                                                                                                                  attr,
2442                                                                                            ObjectIdGetDatum(typelem),
2443                                                    Int32GetDatum(tupdesc->attrs[i]->atttypmod)));
2444                         Tcl_DStringAppendElement(retval, attname);
2445                         UTF_BEGIN;
2446                         Tcl_DStringAppendElement(retval, UTF_E2U(outputstr));
2447                         UTF_END;
2448                         pfree(outputstr);
2449                 }
2450         }
2451 }