3333 * ENHANCEMENTS, OR MODIFICATIONS.
3434 *
3535 * IDENTIFICATION
36- * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.99 2006/01/08 22:27:52 adunstan Exp $
36+ * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.100 2006/01/28 03:28:15 neilc Exp $
3737 *
3838 **********************************************************************/
3939
@@ -84,22 +84,33 @@ typedef struct plperl_proc_desc
8484SV * reference ;
8585}plperl_proc_desc ;
8686
87+ /*
88+ * The information we cache for the duration of a single call to a
89+ * function.
90+ */
91+ typedef struct plperl_call_data
92+ {
93+ plperl_proc_desc * prodesc ;
94+ FunctionCallInfo fcinfo ;
95+ Tuplestorestate * tuple_store ;
96+ TupleDesc ret_tdesc ;
97+ AttInMetadata * attinmeta ;
98+ MemoryContext tmp_cxt ;
99+ }plperl_call_data ;
100+
87101
88102/**********************************************************************
89103 * Global data
90104 **********************************************************************/
91- static int plperl_firstcall = 1 ;
105+ static bool plperl_firstcall = true ;
92106static bool plperl_safe_init_done = false;
93107static PerlInterpreter * plperl_interp = NULL ;
94108static HV * plperl_proc_hash = NULL ;
95109
96110static bool plperl_use_strict = false;
97111
98- /* these are saved and restored by plperl_call_handler */
99- static plperl_proc_desc * plperl_current_prodesc = NULL ;
100- static FunctionCallInfo plperl_current_caller_info ;
101- static Tuplestorestate * plperl_current_tuple_store ;
102- static TupleDesc plperl_current_tuple_desc ;
112+ /* this is saved and restored by plperl_call_handler */
113+ static plperl_call_data * current_call_data = NULL ;
103114
104115/**********************************************************************
105116 * Forward declarations
@@ -157,7 +168,7 @@ plperl_init(void)
157168EmitWarningsOnPlaceholders ("plperl" );
158169
159170plperl_init_interp ();
160- plperl_firstcall = 0 ;
171+ plperl_firstcall = false ;
161172}
162173
163174
@@ -292,7 +303,6 @@ plperl_safe_init(void)
292303plperl_safe_init_done = true;
293304}
294305
295-
296306/*
297307 * Perl likes to put a newline after its error messages; clean up such
298308 */
@@ -565,18 +575,11 @@ Datum
565575plperl_call_handler (PG_FUNCTION_ARGS )
566576{
567577Datum retval ;
568- plperl_proc_desc * save_prodesc ;
569- FunctionCallInfo save_caller_info ;
570- Tuplestorestate * save_tuple_store ;
571- TupleDesc save_tuple_desc ;
578+ plperl_call_data * save_call_data ;
572579
573580plperl_init_all ();
574581
575- save_prodesc = plperl_current_prodesc ;
576- save_caller_info = plperl_current_caller_info ;
577- save_tuple_store = plperl_current_tuple_store ;
578- save_tuple_desc = plperl_current_tuple_desc ;
579-
582+ save_call_data = current_call_data ;
580583PG_TRY ();
581584{
582585if (CALLED_AS_TRIGGER (fcinfo ))
@@ -586,19 +589,12 @@ plperl_call_handler(PG_FUNCTION_ARGS)
586589}
587590PG_CATCH ();
588591{
589- plperl_current_prodesc = save_prodesc ;
590- plperl_current_caller_info = save_caller_info ;
591- plperl_current_tuple_store = save_tuple_store ;
592- plperl_current_tuple_desc = save_tuple_desc ;
592+ current_call_data = save_call_data ;
593593PG_RE_THROW ();
594594}
595595PG_END_TRY ();
596596
597- plperl_current_prodesc = save_prodesc ;
598- plperl_current_caller_info = save_caller_info ;
599- plperl_current_tuple_store = save_tuple_store ;
600- plperl_current_tuple_desc = save_tuple_desc ;
601-
597+ current_call_data = save_call_data ;
602598return retval ;
603599}
604600
@@ -947,15 +943,18 @@ plperl_func_handler(PG_FUNCTION_ARGS)
947943ReturnSetInfo * rsi ;
948944SV * array_ret = NULL ;
949945
946+ /*
947+ * Create the call_data beforing connecting to SPI, so that it is
948+ * not allocated in the SPI memory context
949+ */
950+ current_call_data = (plperl_call_data * )palloc0 (sizeof (plperl_call_data ));
951+ current_call_data -> fcinfo = fcinfo ;
952+
950953if (SPI_connect ()!= SPI_OK_CONNECT )
951954elog (ERROR ,"could not connect to SPI manager" );
952955
953956prodesc = compile_plperl_function (fcinfo -> flinfo -> fn_oid , false);
954-
955- plperl_current_prodesc = prodesc ;
956- plperl_current_caller_info = fcinfo ;
957- plperl_current_tuple_store = 0 ;
958- plperl_current_tuple_desc = 0 ;
957+ current_call_data -> prodesc = prodesc ;
959958
960959rsi = (ReturnSetInfo * )fcinfo -> resultinfo ;
961960
@@ -1012,10 +1011,10 @@ plperl_func_handler(PG_FUNCTION_ARGS)
10121011}
10131012
10141013rsi -> returnMode = SFRM_Materialize ;
1015- if (plperl_current_tuple_store )
1014+ if (current_call_data -> tuple_store )
10161015{
1017- rsi -> setResult = plperl_current_tuple_store ;
1018- rsi -> setDesc = plperl_current_tuple_desc ;
1016+ rsi -> setResult = current_call_data -> tuple_store ;
1017+ rsi -> setDesc = current_call_data -> ret_tdesc ;
10191018}
10201019retval = (Datum )0 ;
10211020}
@@ -1080,6 +1079,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
10801079if (array_ret == NULL )
10811080SvREFCNT_dec (perlret );
10821081
1082+ current_call_data = NULL ;
10831083return retval ;
10841084}
10851085
@@ -1093,14 +1093,20 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
10931093SV * svTD ;
10941094HV * hvTD ;
10951095
1096+ /*
1097+ * Create the call_data beforing connecting to SPI, so that it is
1098+ * not allocated in the SPI memory context
1099+ */
1100+ current_call_data = (plperl_call_data * )palloc0 (sizeof (plperl_call_data ));
1101+ current_call_data -> fcinfo = fcinfo ;
1102+
10961103/* Connect to SPI manager */
10971104if (SPI_connect ()!= SPI_OK_CONNECT )
10981105elog (ERROR ,"could not connect to SPI manager" );
10991106
11001107/* Find or compile the function */
11011108prodesc = compile_plperl_function (fcinfo -> flinfo -> fn_oid , true);
1102-
1103- plperl_current_prodesc = prodesc ;
1109+ current_call_data -> prodesc = prodesc ;
11041110
11051111svTD = plperl_trigger_build_args (fcinfo );
11061112perlret = plperl_call_perl_trigger_func (prodesc ,fcinfo ,svTD );
@@ -1171,6 +1177,7 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
11711177if (perlret )
11721178SvREFCNT_dec (perlret );
11731179
1180+ current_call_data = NULL ;
11741181return retval ;
11751182}
11761183
@@ -1495,7 +1502,7 @@ plperl_spi_exec(char *query, int limit)
14951502{
14961503int spi_rv ;
14971504
1498- spi_rv = SPI_execute (query ,plperl_current_prodesc -> fn_readonly ,
1505+ spi_rv = SPI_execute (query ,current_call_data -> prodesc -> fn_readonly ,
14991506limit );
15001507ret_hv = plperl_spi_execute_fetch_result (SPI_tuptable ,SPI_processed ,
15011508spi_rv );
@@ -1590,16 +1597,19 @@ plperl_spi_execute_fetch_result(SPITupleTable *tuptable, int processed,
15901597void
15911598plperl_return_next (SV * sv )
15921599{
1593- plperl_proc_desc * prodesc = plperl_current_prodesc ;
1594- FunctionCallInfo fcinfo = plperl_current_caller_info ;
1595- ReturnSetInfo * rsi = ( ReturnSetInfo * ) fcinfo -> resultinfo ;
1596- MemoryContext cxt ;
1600+ plperl_proc_desc * prodesc ;
1601+ FunctionCallInfo fcinfo ;
1602+ ReturnSetInfo * rsi ;
1603+ MemoryContext old_cxt ;
15971604HeapTuple tuple ;
1598- TupleDesc tupdesc ;
15991605
16001606if (!sv )
16011607return ;
16021608
1609+ prodesc = current_call_data -> prodesc ;
1610+ fcinfo = current_call_data -> fcinfo ;
1611+ rsi = (ReturnSetInfo * )fcinfo -> resultinfo ;
1612+
16031613if (!prodesc -> fn_retisset )
16041614ereport (ERROR ,
16051615(errcode (ERRCODE_SYNTAX_ERROR ),
@@ -1612,28 +1622,68 @@ plperl_return_next(SV *sv)
16121622errmsg ("setof-composite-returning Perl function "
16131623"must call return_next with reference to hash" )));
16141624
1615- cxt = MemoryContextSwitchTo (rsi -> econtext -> ecxt_per_query_memory );
1625+ if (!current_call_data -> ret_tdesc )
1626+ {
1627+ TupleDesc tupdesc ;
1628+
1629+ Assert (!current_call_data -> tuple_store );
1630+ Assert (!current_call_data -> attinmeta );
16161631
1617- if (!plperl_current_tuple_store )
1618- plperl_current_tuple_store =
1632+ /*
1633+ * This is the first call to return_next in the current
1634+ * PL/Perl function call, so memoize some lookups
1635+ */
1636+ if (prodesc -> fn_retistuple )
1637+ (void )get_call_result_type (fcinfo ,NULL ,& tupdesc );
1638+ else
1639+ tupdesc = rsi -> expectedDesc ;
1640+
1641+ /*
1642+ * Make sure the tuple_store and ret_tdesc are sufficiently
1643+ * long-lived.
1644+ */
1645+ old_cxt = MemoryContextSwitchTo (rsi -> econtext -> ecxt_per_query_memory );
1646+
1647+ current_call_data -> ret_tdesc = CreateTupleDescCopy (tupdesc );
1648+ current_call_data -> tuple_store =
16191649tuplestore_begin_heap (true, false,work_mem );
1650+ if (prodesc -> fn_retistuple )
1651+ {
1652+ current_call_data -> attinmeta =
1653+ TupleDescGetAttInMetadata (current_call_data -> ret_tdesc );
1654+ }
16201655
1621- if (prodesc -> fn_retistuple )
1656+ MemoryContextSwitchTo (old_cxt );
1657+ }
1658+
1659+ /*
1660+ * Producing the tuple we want to return requires making plenty of
1661+ * palloc() allocations that are not cleaned up. Since this
1662+ * function can be called many times before the current memory
1663+ * context is reset, we need to do those allocations in a
1664+ * temporary context.
1665+ */
1666+ if (!current_call_data -> tmp_cxt )
16221667{
1623- TypeFuncClass rettype ;
1624- AttInMetadata * attinmeta ;
1668+ current_call_data -> tmp_cxt =
1669+ AllocSetContextCreate (rsi -> econtext -> ecxt_per_tuple_memory ,
1670+ "PL/Perl return_next temporary cxt" ,
1671+ ALLOCSET_DEFAULT_MINSIZE ,
1672+ ALLOCSET_DEFAULT_INITSIZE ,
1673+ ALLOCSET_DEFAULT_MAXSIZE );
1674+ }
1675+
1676+ old_cxt = MemoryContextSwitchTo (current_call_data -> tmp_cxt );
16251677
1626- rettype = get_call_result_type ( fcinfo , NULL , & tupdesc );
1627- tupdesc = CreateTupleDescCopy ( tupdesc );
1628- attinmeta = TupleDescGetAttInMetadata ( tupdesc );
1629- tuple = plperl_build_tuple_result (( HV * ) SvRV ( sv ), attinmeta );
1678+ if ( prodesc -> fn_retistuple )
1679+ {
1680+ tuple = plperl_build_tuple_result (( HV * ) SvRV ( sv ),
1681+ current_call_data -> attinmeta );
16301682}
16311683else
16321684{
1633- Datum ret ;
1634- bool isNull ;
1635-
1636- tupdesc = CreateTupleDescCopy (rsi -> expectedDesc );
1685+ Datum ret = (Datum )0 ;
1686+ bool isNull = true;
16371687
16381688if (SvOK (sv )&& SvTYPE (sv )!= SVt_NULL )
16391689{
@@ -1645,21 +1695,16 @@ plperl_return_next(SV *sv)
16451695Int32GetDatum (-1 ));
16461696isNull = false;
16471697}
1648- else
1649- {
1650- ret = (Datum )0 ;
1651- isNull = true;
1652- }
16531698
1654- tuple = heap_form_tuple (tupdesc ,& ret ,& isNull );
1699+ tuple = heap_form_tuple (current_call_data -> ret_tdesc ,& ret ,& isNull );
16551700}
16561701
1657- if (!plperl_current_tuple_desc )
1658- plperl_current_tuple_desc = tupdesc ;
1702+ /* Make sure to store the tuple in a long-lived memory context */
1703+ MemoryContextSwitchTo (rsi -> econtext -> ecxt_per_query_memory );
1704+ tuplestore_puttuple (current_call_data -> tuple_store ,tuple );
1705+ MemoryContextSwitchTo (old_cxt );
16591706
1660- tuplestore_puttuple (plperl_current_tuple_store ,tuple );
1661- heap_freetuple (tuple );
1662- MemoryContextSwitchTo (cxt );
1707+ MemoryContextReset (current_call_data -> tmp_cxt );
16631708}
16641709
16651710