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));
