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