--- pl/plperl/plperl.c.2~ 2005-05-22 09:41:09.224877877 +0530 +++ pl/plperl/plperl.c 2005-05-22 10:27:25.804891544 +0530 @@ -4,7 +4,7 @@ * IDENTIFICATION * * This software is copyrighted by Mark Hollomon - * but is shameless cribbed from pltcl.c by Jan Weick. + * but is shameless cribbed from pltcl.c by Jan Wieck. * * The author hereby grants permission to use, copy, modify, * distribute, and license this software and its documentation @@ -140,27 +140,15 @@ fmgr_info_cxt(functionId, finfo, TopMemoryContext); } -/********************************************************************** - * plperl_init() - Initialize everything that can be - * safely initialized during postmaster - * startup. - * - * DO NOT make this static --- it has to be callable by preload - **********************************************************************/ + +/* Perform initialization during postmaster startup. */ + void plperl_init(void) { - /************************************************************ - * Do initialization only once - ************************************************************/ if (!plperl_firstcall) return; - - /************************************************************ - * Get user settings needed before we set up the interpreter - ************************************************************/ - DefineCustomBoolVariable( "plperl.use_strict", "If true, will compile trusted and untrusted perl code in strict mode", @@ -170,39 +158,24 @@ NULL, NULL); EmitWarningsOnPlaceholders("plperl"); - - /************************************************************ - * Create the Perl interpreter - ************************************************************/ - plperl_init_interp(); + plperl_init_interp(); plperl_firstcall = 0; } -/********************************************************************** - * plperl_init_all() - Initialize all - **********************************************************************/ + +/* Perform initialization during backend startup. */ + static void plperl_init_all(void) { - - /************************************************************ - * Execute postmaster-startup safe initialization - ************************************************************/ if (plperl_firstcall) plperl_init(); - /************************************************************ - * Any other initialization that must be done each time a new - * backend starts -- currently none - ************************************************************/ - + /* We don't need to do anything yet when a new backend starts. */ } -/********************************************************************** - * plperl_init_interp() - Create the Perl interpreter - **********************************************************************/ static void plperl_init_interp(void) { @@ -230,9 +203,6 @@ (plperl_use_strict ? strict_embedding : loose_embedding), NULL); perl_run(plperl_interp); - /************************************************************ - * Initialize the procedure hash table - ************************************************************/ plperl_proc_hash = newHV(); } @@ -314,9 +284,8 @@ } -/* - * Build a tuple from a hash - */ +/* Build a tuple from a hash. */ + static HeapTuple plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta) { @@ -332,7 +301,7 @@ hv_iterinit(perlhash); while ((val = hv_iternextsv(perlhash, &key, &klen))) { - int attn = SPI_fnumber(td, key); + int attn = SPI_fnumber(td, key); if (attn <= 0 || td->attrs[attn - 1]->attisdropped) ereport(ERROR, @@ -350,9 +319,8 @@ } -/********************************************************************** - * set up arguments for a trigger call - **********************************************************************/ +/* Set up the arguments for a trigger call. */ + static SV * plperl_trigger_build_args(FunctionCallInfo fcinfo) { @@ -463,9 +431,9 @@ return result; } -/********************************************************************** - * set up the new tuple returned from a trigger - **********************************************************************/ + +/* Set up the new tuple returned from a trigger. */ + static HeapTuple plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup) { @@ -550,38 +518,25 @@ return rtup; } -/********************************************************************** - * plperl_call_handler - This is the only visible function - * of the PL interpreter. The PostgreSQL - * function manager and trigger manager - * call this function for execution of - * perl procedures. - **********************************************************************/ + +/* This is the only externally-visible part of the plperl interface. + * The Postgres function and trigger managers call it to execute a + * perl function. */ + PG_FUNCTION_INFO_V1(plperl_call_handler); -/* keep non-static */ Datum plperl_call_handler(PG_FUNCTION_ARGS) { - Datum retval; + Datum retval; plperl_proc_desc *save_prodesc; - /* - * Initialize interpreter if first time through - */ plperl_init_all(); - /* - * Ensure that static pointers are saved/restored properly - */ save_prodesc = plperl_current_prodesc; PG_TRY(); { - /* - * Determine if called as function or trigger and - * call appropriate subhandler - */ if (CALLED_AS_TRIGGER(fcinfo)) retval = PointerGetDatum(plperl_trigger_handler(fcinfo)); else @@ -600,11 +555,9 @@ } -/********************************************************************** - * plperl_create_sub() - calls the perl interpreter to - * create the anonymous subroutine whose text is in the SV. - * Returns the SV containing the RV to the closure. - **********************************************************************/ +/* Uses mksafefunc/mkunsafefunc to create an anonymous sub whose text is + * supplied in s, and returns a reference to the closure. */ + static SV * plperl_create_sub(char *s, bool trusted) { @@ -680,6 +633,7 @@ return subref; } + /********************************************************************** * plperl_init_shared_libs() - * @@ -701,10 +655,7 @@ newXS("SPI::bootstrap", boot_SPI, file); } -/********************************************************************** - * plperl_call_perl_func() - calls a perl function through the RV - * stored in the prodesc structure. massages the input parms properly - **********************************************************************/ + static SV * plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo) { @@ -791,10 +742,7 @@ return retval; } -/********************************************************************** - * plperl_call_perl_trigger_func() - calls a perl trigger function - * through the RV stored in the prodesc structure. - **********************************************************************/ + static SV * plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo, SV *td) @@ -851,9 +799,7 @@ return retval; } -/********************************************************************** - * plperl_func_handler() - Handler for regular function calls - **********************************************************************/ + static Datum plperl_func_handler(PG_FUNCTION_ARGS) { @@ -861,18 +807,13 @@ SV *perlret; Datum retval; - /* Connect to SPI manager */ if (SPI_connect() != SPI_OK_CONNECT) elog(ERROR, "could not connect to SPI manager"); - /* Find or compile the function */ prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false); plperl_current_prodesc = prodesc; - /************************************************************ - * Call the Perl function if not returning set - ************************************************************/ if (!prodesc->fn_retisset) perlret = plperl_call_perl_func(prodesc, fcinfo); else if (SRF_IS_FIRSTCALL()) @@ -1059,9 +1000,7 @@ return retval; } -/********************************************************************** - * plperl_trigger_handler() - Handler for trigger function calls - **********************************************************************/ + static Datum plperl_trigger_handler(PG_FUNCTION_ARGS) { @@ -1080,18 +1019,9 @@ plperl_current_prodesc = prodesc; - /************************************************************ - * Call the Perl function - ************************************************************/ - - /* - * call perl trigger function and build TD hash - */ svTD = plperl_trigger_build_args(fcinfo); perlret = plperl_call_perl_trigger_func(prodesc, fcinfo, svTD); - - hvTD = (HV *) SvRV(svTD); /* convert SV TD structure to Perl Hash - * structure */ + hvTD = (HV *) SvRV(svTD); /************************************************************ * Disconnect from SPI manager and then create the return @@ -1160,9 +1090,7 @@ return retval; } -/********************************************************************** - * compile_plperl_function - compile (or hopefully just look up) function - **********************************************************************/ + static plperl_proc_desc * compile_plperl_function(Oid fn_oid, bool is_trigger) { @@ -1393,9 +1321,6 @@ internal_proname); } - /************************************************************ - * Add the proc description block to the hashtable - ************************************************************/ hv_store(plperl_proc_hash, internal_proname, proname_len, newSViv((IV) prodesc), 0); } @@ -1406,10 +1331,8 @@ } -/********************************************************************** - * plperl_hash_from_tuple() - Build a ref to a hash - * from all attributes of a given tuple - **********************************************************************/ +/* Build a hash from all attributes of a given tuple. */ + static SV * plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc) { @@ -1456,9 +1379,6 @@ } -/* - * Implementation of spi_exec_query() Perl function - */ HV * plperl_spi_exec(char *query, int limit) { @@ -1526,6 +1446,7 @@ return ret_hv; } + static HV * plperl_spi_execute_fetch_result(SPITupleTable *tuptable, int processed, int status)