3333 * ENHANCEMENTS, OR MODIFICATIONS.
3434 *
3535 * IDENTIFICATION
36- * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.56 2004/11/16 22:05:22 tgl Exp $
36+ * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.57 2004/11/17 21:23:36 tgl Exp $
3737 *
3838 **********************************************************************/
3939
@@ -116,6 +116,8 @@ static void plperl_init_interp(void);
116116Datum plperl_call_handler (PG_FUNCTION_ARGS );
117117void plperl_init (void );
118118
119+ HV * plperl_spi_exec (char * query ,int limit );
120+
119121static Datum plperl_func_handler (PG_FUNCTION_ARGS );
120122
121123static Datum plperl_trigger_handler (PG_FUNCTION_ARGS );
@@ -685,7 +687,7 @@ plperl_create_sub(char *s, bool trusted)
685687
686688if (SvTRUE (ERRSV ))
687689{
688- POPs ;
690+ ( void ) POPs ;
689691PUTBACK ;
690692FREETMPS ;
691693LEAVE ;
@@ -821,7 +823,7 @@ plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo)
821823
822824if (SvTRUE (ERRSV ))
823825{
824- POPs ;
826+ ( void ) POPs ;
825827PUTBACK ;
826828FREETMPS ;
827829LEAVE ;
@@ -872,7 +874,7 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo, S
872874
873875if (SvTRUE (ERRSV ))
874876{
875- POPs ;
877+ ( void ) POPs ;
876878PUTBACK ;
877879FREETMPS ;
878880LEAVE ;
@@ -935,7 +937,6 @@ plperl_func_handler(PG_FUNCTION_ARGS)
935937if (!(perlret && SvOK (perlret )&& SvTYPE (perlret )!= SVt_NULL ))
936938{
937939/* return NULL if Perl code returned undef */
938- retval = (Datum )0 ;
939940fcinfo -> isnull = true;
940941}
941942
@@ -945,29 +946,25 @@ plperl_func_handler(PG_FUNCTION_ARGS)
945946if (prodesc -> fn_retistuple && perlret && SvTYPE (perlret )!= SVt_RV )
946947elog (ERROR ,"plperl: composite-returning function must return a reference" );
947948
949+ if (prodesc -> fn_retisset && !fcinfo -> resultinfo )
950+ ereport (ERROR ,
951+ (errcode (ERRCODE_FEATURE_NOT_SUPPORTED ),
952+ errmsg ("set-valued function called in context that cannot accept a set" )));
953+
948954if (prodesc -> fn_retistuple && fcinfo -> resultinfo )/* set of tuples */
949955{
950956/* SRF support */
951957HV * ret_hv ;
952958AV * ret_av ;
953-
954959FuncCallContext * funcctx ;
955960int call_cntr ;
956961int max_calls ;
957962TupleDesc tupdesc ;
958- TupleTableSlot * slot ;
959963AttInMetadata * attinmeta ;
960- bool isset = 0 ;
964+ bool isset ;
961965char * * values = NULL ;
962966ReturnSetInfo * rsinfo = (ReturnSetInfo * )fcinfo -> resultinfo ;
963967
964- if (prodesc -> fn_retisset && !rsinfo )
965- ereport (ERROR ,
966- (errcode (ERRCODE_SYNTAX_ERROR ),
967- errmsg ("returning a composite type is not allowed in this context" ),
968- errhint ("This function is intended for use in the FROM clause." )));
969-
970-
971968isset = plperl_is_set (perlret );
972969
973970if (SvTYPE (SvRV (perlret ))== SVt_PVHV )
@@ -1007,8 +1004,6 @@ plperl_func_handler(PG_FUNCTION_ARGS)
10071004av_store (g_column_keys ,i + 1 ,
10081005newSVpv (SPI_fname (tupdesc ,i + 1 ),0 ));
10091006
1010- slot = TupleDescGetSlot (tupdesc );
1011- funcctx -> slot = slot ;
10121007attinmeta = TupleDescGetAttInMetadata (tupdesc );
10131008funcctx -> attinmeta = attinmeta ;
10141009MemoryContextSwitchTo (oldcontext );
@@ -1017,8 +1012,8 @@ plperl_func_handler(PG_FUNCTION_ARGS)
10171012funcctx = SRF_PERCALL_SETUP ();
10181013call_cntr = funcctx -> call_cntr ;
10191014max_calls = funcctx -> max_calls ;
1020- slot = funcctx -> slot ;
10211015attinmeta = funcctx -> attinmeta ;
1016+ tupdesc = attinmeta -> tupdesc ;
10221017
10231018if (call_cntr < max_calls )
10241019{
@@ -1065,7 +1060,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
10651060}
10661061}
10671062tuple = BuildTupleFromCStrings (attinmeta ,values );
1068- result = TupleGetDatum ( slot , tuple );
1063+ result = HeapTupleGetDatum ( tuple );
10691064SRF_RETURN_NEXT (funcctx ,result );
10701065}
10711066else
@@ -1100,17 +1095,19 @@ plperl_func_handler(PG_FUNCTION_ARGS)
11001095svp = av_fetch (array ,funcctx -> call_cntr , FALSE);
11011096
11021097if (SvTYPE (* svp )!= SVt_NULL )
1098+ {
1099+ fcinfo -> isnull = false;
11031100result = FunctionCall3 (& prodesc -> result_in_func ,
11041101PointerGetDatum (SvPV (* svp ,PL_na )),
11051102ObjectIdGetDatum (prodesc -> result_typioparam ),
11061103Int32GetDatum (-1 ));
1104+ }
11071105else
11081106{
11091107fcinfo -> isnull = true;
11101108result = (Datum )0 ;
11111109}
11121110SRF_RETURN_NEXT (funcctx ,result );
1113- fcinfo -> isnull = false;
11141111}
11151112else
11161113{
@@ -1121,8 +1118,6 @@ plperl_func_handler(PG_FUNCTION_ARGS)
11211118}
11221119else if (!fcinfo -> isnull )/* non-null singleton */
11231120{
1124-
1125-
11261121if (prodesc -> fn_retistuple )/* singleton perl hash to Datum */
11271122{
11281123TupleDesc td = lookup_rowtype_tupdesc (prodesc -> ret_oid , (int32 )- 1 );
@@ -1153,16 +1148,16 @@ plperl_func_handler(PG_FUNCTION_ARGS)
11531148attinmeta = TupleDescGetAttInMetadata (td );
11541149tup = BuildTupleFromCStrings (attinmeta ,values );
11551150retval = HeapTupleGetDatum (tup );
1156-
11571151}
11581152else
11591153/* perl string to Datum */
11601154retval = FunctionCall3 (& prodesc -> result_in_func ,
11611155PointerGetDatum (SvPV (perlret ,PL_na )),
11621156ObjectIdGetDatum (prodesc -> result_typioparam ),
11631157Int32GetDatum (-1 ));
1164-
11651158}
1159+ else /* null singleton */
1160+ retval = (Datum )0 ;
11661161
11671162SvREFCNT_dec (perlret );
11681163return retval ;
@@ -1220,6 +1215,8 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
12201215retval = (Datum )trigdata -> tg_newtuple ;
12211216else if (TRIGGER_FIRED_BY_DELETE (trigdata -> tg_event ))
12221217retval = (Datum )trigdata -> tg_trigtuple ;
1218+ else
1219+ retval = (Datum )0 ;/* can this happen? */
12231220}
12241221else
12251222{
@@ -1256,6 +1253,8 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
12561253}
12571254retval = PointerGetDatum (trv );
12581255}
1256+ else
1257+ retval = (Datum )0 ;
12591258}
12601259
12611260SvREFCNT_dec (perlret );