The attached patch allows 'select foo()' as well as 'select * from foo()' where foo() is a plperl function that returns a single composite.


cheers

andrew


Index: plperl.c
===================================================================
RCS file: /projects/cvsroot/pgsql-server/src/pl/plperl/plperl.c,v
retrieving revision 1.46
diff -c -w -r1.46 plperl.c
*** plperl.c	12 Jul 2004 14:31:04 -0000	1.46
--- plperl.c	20 Jul 2004 12:57:40 -0000
***************
*** 889,895 ****
  
  	 if (prodesc->fn_retisset && SRF_IS_FIRSTCALL())
  	 {
! 		 if (prodesc->fn_retistuple) g_column_keys = newAV();
  		if (SvTYPE(perlret) != SVt_RV)
  			 elog(ERROR, "plperl: set-returning function must return reference");
  	}
--- 889,896 ----
  
  	if (prodesc->fn_retisset && SRF_IS_FIRSTCALL())
  	{
! 		if (prodesc->fn_retistuple)
! 			g_column_keys = newAV();
  		if (SvTYPE(perlret) != SVt_RV)
  			elog(ERROR, "plperl: set-returning function must return reference");
  	}
***************
*** 910,916 ****
  		fcinfo->isnull = true;
  	}
  
! 	if (prodesc->fn_retistuple)
  	{
  		/* SRF support */
  		HV		   *ret_hv;
--- 911,923 ----
  		fcinfo->isnull = true;
  	}
  
! 	if (prodesc->fn_retisset && !(perlret && SvTYPE(SvRV(perlret)) == SVt_PVAV))
! 		elog(ERROR, "plperl: set-returning function must return reference to array");
! 
! 	if (prodesc->fn_retistuple && perlret && SvTYPE(perlret) != SVt_RV)
! 		elog(ERROR, "plperl: composite-returning function must return a reference");
! 
! 	if (prodesc->fn_retistuple && fcinfo->resultinfo ) /*  set of tuples */
  	{
  		/* SRF support */
  		HV		   *ret_hv;
***************
*** 932,940 ****
  					errmsg("returning a composite type is not allowed in this context"),
  					errhint("This function is intended for use in the FROM clause.")));
  
- 		if (SvTYPE(perlret) != SVt_RV)
- 			elog(ERROR, "plperl: composite-returning function must return a reference");
- 
  
  		isset = plperl_is_set(perlret);
  
--- 939,944 ----
***************
*** 1042,1048 ****
  			SRF_RETURN_DONE(funcctx);
  		}
  	}
! 	else if (prodesc->fn_retisset)
  	{
  		FuncCallContext	*funcctx;
  		
--- 1046,1052 ----
  			SRF_RETURN_DONE(funcctx);
  		}
  	}
! 	else if (prodesc->fn_retisset) /* set of non-tuples */
  	{
  		FuncCallContext *funcctx;
  
***************
*** 1054,1061 ****
  			funcctx = SRF_FIRSTCALL_INIT();
  			oldcontext = MemoryContextSwitchTo(funcctx->multi_call_memory_ctx);
  
! 			if(SvTYPE(SvRV(perlret))!=SVt_PVAV) elog(ERROR, "plperl: set-returning function must return reference to array");
! 				else funcctx->max_calls =  av_len((AV*)SvRV(perlret))+1;
  		}
  		
  		funcctx = SRF_PERCALL_SETUP();
--- 1058,1064 ----
  			funcctx = SRF_FIRSTCALL_INIT();
  			oldcontext = MemoryContextSwitchTo(funcctx->multi_call_memory_ctx);
  
! 			funcctx->max_calls = av_len((AV *) SvRV(perlret)) + 1;
  		}
  
  		funcctx = SRF_PERCALL_SETUP();
***************
*** 1085,1100 ****
  		} 
  		else
  		{
! 			if (perlret) SvREFCNT_dec(perlret);
  			SRF_RETURN_DONE(funcctx);
  		}
  	 }
! 	else if (! fcinfo->isnull)
  	{
  		retval = FunctionCall3(&prodesc->result_in_func,
  							   PointerGetDatum(SvPV(perlret, PL_na)),
  							   ObjectIdGetDatum(prodesc->result_typioparam),
  							   Int32GetDatum(-1));
  	}
  
  	SvREFCNT_dec(perlret);
--- 1088,1140 ----
  		}
  		else
  		{
! 			if (perlret)
! 				SvREFCNT_dec(perlret);
  			SRF_RETURN_DONE(funcctx);
  		}
  	}
! 	else if (!fcinfo->isnull) /* non-null singleton */
  	{
+ 
+ 
+ 		if (prodesc->fn_retistuple) /* singleton perl hash to Datum */
+ 		{
+ 			TupleDesc td = lookup_rowtype_tupdesc(prodesc->ret_oid,(int32)-1);
+ 			HV * perlhash = (HV *) SvRV(perlret);
+ 			int i;
+ 			char **values;
+ 			char * key, *val;
+ 			AttInMetadata *attinmeta;
+ 			HeapTuple tup;
+ 
+ 			if (!td)
+ 				ereport(ERROR,
+ 						(errcode(ERRCODE_SYNTAX_ERROR),
+ 						 errmsg("no TupleDesc info available")));
+ 
+ 			values = (char **) palloc(td->natts * sizeof(char *));
+ 			for (i = 0; i < td->natts; i++)
+ 			{
+ 
+ 				key = SPI_fname(td,i+1);
+ 				val = plperl_get_elem(perlhash, key);
+ 				if (val)
+ 					values[i] = val;
+ 				else
+ 					values[i] = NULL;
+ 			}
+ 			attinmeta = TupleDescGetAttInMetadata(td);
+ 			tup = BuildTupleFromCStrings(attinmeta, values);
+ 			retval = HeapTupleGetDatum(tup);
+ 			
+ 		}
+ 		else /* perl string to Datum */
+ 
  			retval = FunctionCall3(&prodesc->result_in_func,
  								   PointerGetDatum(SvPV(perlret, PL_na)),
  								   ObjectIdGetDatum(prodesc->result_typioparam),
  								   Int32GetDatum(-1));
+ 
  	}
  
  	SvREFCNT_dec(perlret);
***************
*** 1341,1352 ****
  				}
  			}
  
! 			prodesc->fn_retisset = procStruct->proretset; /*true, if function returns set*/
  
  			if (typeStruct->typtype == 'c' || procStruct->prorettype == RECORDOID)
  			{
  				prodesc->fn_retistuple = true;
! 				prodesc->ret_oid = typeStruct->typrelid;
  			}
  
  			perm_fmgr_info(typeStruct->typinput, &(prodesc->result_in_func));
--- 1381,1396 ----
  				}
  			}
  
! 			prodesc->fn_retisset = procStruct->proretset;		/* true, if function
! 																 * returns set */
  
  			if (typeStruct->typtype == 'c' || procStruct->prorettype == RECORDOID)
  			{
  				prodesc->fn_retistuple = true;
! 				prodesc->ret_oid = 
! 					procStruct->prorettype == RECORDOID ? 
! 					typeStruct->typrelid : 
! 					procStruct->prorettype;
  			}
  
  			perm_fmgr_info(typeStruct->typinput, &(prodesc->result_in_func));
---------------------------(end of broadcast)---------------------------
TIP 8: explain analyze is your friend

Reply via email to