--- pl/plperl/plperl.c.6~	2005-05-22 18:48:51.595794503 +0530
+++ pl/plperl/plperl.c	2005-05-22 20:15:57.979899916 +0530
@@ -87,6 +87,9 @@
 	FmgrInfo	arg_out_func[FUNC_MAX_ARGS];
 	bool		arg_is_rowtype[FUNC_MAX_ARGS];
 	SV		   *reference;
+	FunctionCallInfo caller_info;
+	Tuplestorestate *tuple_store;
+	TupleDesc tuple_desc;
 } plperl_proc_desc;
 
 
@@ -123,6 +126,7 @@
 static void plperl_init_shared_libs(pTHX);
 static HV  *plperl_spi_execute_fetch_result(SPITupleTable *, int, int);
 
+static void plperl_return_next(SV *);
 
 /*
  * This routine is a crock, and so is everyplace that calls it.  The problem
@@ -796,6 +800,9 @@
 	prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false);
 
 	plperl_current_prodesc = prodesc;
+	prodesc->caller_info = fcinfo;
+	prodesc->tuple_store = 0;
+	prodesc->tuple_desc = 0;
 
 	perlret = plperl_call_perl_func(prodesc, fcinfo);
 
@@ -810,27 +817,7 @@
 
 	rsi = (ReturnSetInfo *)fcinfo->resultinfo;
 
-	if (!(perlret && SvOK(perlret) && SvTYPE(perlret) != SVt_NULL))
-	{
-		/* return NULL if Perl code returned undef */
-		if (perlret)
-			SvREFCNT_dec(perlret);
-		if (rsi && IsA(rsi, ReturnSetInfo))
-			rsi->isDone = ExprEndResult;
-		PG_RETURN_NULL();
-	}
-
-	if (prodesc->fn_retisset)
-	{
-		/* Returns a set of tuples or scalars. */
-		int i;
-		AV *ret_av;
-		Tuplestorestate *store;
-		MemoryContext cxt;
-		TypeFuncClass rettype;
-		TupleDesc tupdesc;
-		AttInMetadata *attinmeta;
-
+	if (prodesc->fn_retisset) {
 		if (!rsi || !IsA(rsi, ReturnSetInfo) ||
 			(rsi->allowedModes & SFRM_Materialize) == 0 ||
 			rsi->expectedDesc == NULL)
@@ -841,84 +828,47 @@
 							"cannot accept a set")));
 		}
 
-		if (!SvOK(perlret) || SvTYPE(perlret) != SVt_RV ||
-			SvTYPE(SvRV(perlret)) != SVt_PVAV)
+		/* If the Perl function returned an arrayref, we pretend that it
+		 * called return_next() for each element of the array, to handle
+		 * old SRFs that didn't know about return_next(). Any other sort
+		 * of return value is an error. */
+		if (SvTYPE(perlret) == SVt_RV &&
+			SvTYPE(SvRV(perlret)) == SVt_PVAV)
+		{
+			int i = 0;
+			SV **svp = 0;
+			AV *rav = (AV *)SvRV(perlret);
+			while ((svp = av_fetch(rav, i, FALSE)) != NULL) {
+				plperl_return_next(*svp);
+				i++;
+			}
+		}
+		else if (SvTYPE(perlret) != SVt_NULL)
 		{
 			ereport(ERROR,
 					(errcode(ERRCODE_DATATYPE_MISMATCH),
 					 errmsg("set-returning Perl function must return "
-							"reference to array")));
-		}
-
-		cxt = MemoryContextSwitchTo(rsi->econtext->ecxt_per_query_memory);
-		store = tuplestore_begin_heap(true, false, work_mem);
-
-		if (prodesc->fn_retistuple) {
-			rettype = get_call_result_type(fcinfo, NULL, &tupdesc);
-			attinmeta = TupleDescGetAttInMetadata(tupdesc);
-		}
-		else {
-			tupdesc = rsi->expectedDesc;
-			attinmeta = 0;
-		}
-		tupdesc = CreateTupleDescCopy(tupdesc);
-
-		i = 0;
-		ret_av = (AV *)SvRV(perlret);
-		while (i <= av_len(ret_av)) {
-			SV **svp;
-			HeapTuple tuple;
-
-			svp = av_fetch(ret_av, i, FALSE);
-			Assert(svp != NULL);
-
-			if (prodesc->fn_retistuple) {
-				if (!SvOK(*svp) || SvTYPE(*svp) != SVt_RV ||
-					SvTYPE(SvRV(*svp)) != SVt_PVHV)
-				{
-					ereport(ERROR,
-							(errcode(ERRCODE_DATATYPE_MISMATCH),
-							 errmsg("elements of Perl result array must be "
-									"reference to hash")));
-				}
-				tuple = plperl_build_tuple_result((HV *)SvRV(*svp), attinmeta);
-			}
-			else {
-				Datum ret;
-				bool isNull = false;
-
-				if (SvOK(*svp) && SvTYPE(*svp) != SVt_NULL) {
-					char *val = SvPV(*svp, PL_na);
-					ret = FunctionCall3(
-						&prodesc->result_in_func,
-						PointerGetDatum(val),
-						ObjectIdGetDatum(prodesc->result_typioparam),
-						Int32GetDatum(-1)
-					);
-				}
-				else {
-					ret = (Datum)0;
-					isNull = true;
-				}
-
-				tuple = heap_form_tuple(tupdesc, &ret, &isNull);
-			}
-
-			tuplestore_puttuple(store, tuple);
-			heap_freetuple(tuple);
-			i++;
+							"reference to array or use return_next")));
 		}
-		MemoryContextSwitchTo(cxt);
 
 		rsi->returnMode = SFRM_Materialize;
-		rsi->setResult = store;
-		rsi->setDesc = tupdesc;
-
+		if (prodesc->tuple_store) {
+			rsi->setResult = prodesc->tuple_store;
+			rsi->setDesc = prodesc->tuple_desc;
+		}
+		retval = (Datum)0;
+	}
+	else if (SvTYPE(perlret) == SVt_NULL)
+	{
+		/* Return NULL if Perl code returned undef */
+		if (rsi && IsA(rsi, ReturnSetInfo))
+			rsi->isDone = ExprEndResult;
+		fcinfo->isnull = true;
 		retval = (Datum)0;
 	}
 	else if (prodesc->fn_retistuple)
 	{
-		/* singleton perl hash to Datum */
+		/* Return a perl hash converted to a Datum */
 		TupleDesc td;
 		AttInMetadata *attinmeta;
 		HeapTuple tup;
@@ -932,11 +882,7 @@
 							"must return reference to hash")));
 		}
 
-
-		/*
-		 * XXX should cache the attinmeta data instead of recomputing
-		 */
-
+		/* XXX should cache the attinmeta data instead of recomputing */
 		if (get_call_result_type(fcinfo, NULL, &td) != TYPEFUNC_COMPOSITE)
 		{
 			ereport(ERROR,
@@ -951,7 +897,7 @@
 	}
 	else
 	{
-		/* perl string to Datum */
+		/* Return a perl string converted to a Datum */
 		char *val = SvPV(perlret, PL_na);
 		retval = FunctionCall3(&prodesc->result_in_func,
 							   CStringGetDatum(val),
@@ -1445,3 +1391,79 @@
 
 	return result;
 }
+
+
+static void plperl_return_next(SV *sv)
+{
+	plperl_proc_desc *prodesc = plperl_current_prodesc;
+	FunctionCallInfo fcinfo = prodesc->caller_info;
+	ReturnSetInfo *rsi = (ReturnSetInfo *)fcinfo->resultinfo;
+	MemoryContext cxt;
+	HeapTuple tuple;
+	TupleDesc tupdesc;
+
+	if (!sv)
+		return;
+
+	if (!prodesc->fn_retisset)
+	{
+		ereport(ERROR,
+				(errcode(ERRCODE_SYNTAX_ERROR),
+				 errmsg("cannot use return_next in a non-SETOF function")));
+	}
+
+	if (prodesc->fn_retistuple &&
+		!(SvOK(sv) && SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVHV))
+	{
+		ereport(ERROR,
+				(errcode(ERRCODE_DATATYPE_MISMATCH),
+				 errmsg("setof-composite-returning Perl function "
+						"must call return_next with reference to hash")));
+	}
+
+	cxt = MemoryContextSwitchTo(rsi->econtext->ecxt_per_query_memory);
+
+	if (!prodesc->tuple_store)
+		prodesc->tuple_store = tuplestore_begin_heap(true, false, work_mem);
+
+	if (prodesc->fn_retistuple)
+	{
+		TypeFuncClass rettype;
+		AttInMetadata *attinmeta;
+
+		rettype = get_call_result_type(fcinfo, NULL, &tupdesc);
+		tupdesc = CreateTupleDescCopy(tupdesc);
+		attinmeta = TupleDescGetAttInMetadata(tupdesc);
+		tuple = plperl_build_tuple_result((HV *)SvRV(sv), attinmeta);
+	}
+	else
+	{
+		Datum ret;
+		bool isNull;
+
+		tupdesc = CreateTupleDescCopy(rsi->expectedDesc);
+
+		if (SvOK(sv) && SvTYPE(sv) != SVt_NULL)
+		{
+			char *val = SvPV(sv, PL_na);
+			ret = FunctionCall3(&prodesc->result_in_func,
+								PointerGetDatum(val),
+								ObjectIdGetDatum(prodesc->result_typioparam),
+								Int32GetDatum(-1));
+			isNull = false;
+		}
+		else {
+			ret = (Datum)0;
+			isNull = true;
+		}
+
+		tuple = heap_form_tuple(tupdesc, &ret, &isNull);
+	}
+
+	if (!prodesc->tuple_desc)
+		prodesc->tuple_desc = tupdesc;
+
+	tuplestore_puttuple(prodesc->tuple_store, tuple);
+	heap_freetuple(tuple);
+	MemoryContextSwitchTo(cxt);
+}