Skip to content

Commit 8d3517d

Browse files
committed
The attached patch allows 'select foo()' as well as 'select * from
foo()' where foo() is a plperl function that returns a single composite. Andrew Dunstan
1 parent 8eeae3e commit 8d3517d

File tree

1 file changed

+57
-13
lines changed

1 file changed

+57
-13
lines changed

src/pl/plperl/plperl.c

Lines changed: 57 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,7 @@
3333
* ENHANCEMENTS, OR MODIFICATIONS.
3434
*
3535
* IDENTIFICATION
36-
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.46 2004/07/12 14:31:04 momjian Exp $
36+
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.47 2004/07/21 20:45:54 momjian Exp $
3737
*
3838
**********************************************************************/
3939

@@ -889,7 +889,8 @@ plperl_func_handler(PG_FUNCTION_ARGS)
889889

890890
if (prodesc->fn_retisset && SRF_IS_FIRSTCALL())
891891
{
892-
if (prodesc->fn_retistuple) g_column_keys = newAV();
892+
if (prodesc->fn_retistuple)
893+
g_column_keys = newAV();
893894
if (SvTYPE(perlret) != SVt_RV)
894895
elog(ERROR, "plperl: set-returning function must return reference");
895896
}
@@ -910,7 +911,13 @@ plperl_func_handler(PG_FUNCTION_ARGS)
910911
fcinfo->isnull = true;
911912
}
912913

913-
if (prodesc->fn_retistuple)
914+
if (prodesc->fn_retisset && !(perlret && SvTYPE(SvRV(perlret)) == SVt_PVAV))
915+
elog(ERROR, "plperl: set-returning function must return reference to array");
916+
917+
if (prodesc->fn_retistuple && perlret && SvTYPE(perlret) != SVt_RV)
918+
elog(ERROR, "plperl: composite-returning function must return a reference");
919+
920+
if (prodesc->fn_retistuple && fcinfo->resultinfo ) /* set of tuples */
914921
{
915922
/* SRF support */
916923
HV *ret_hv;
@@ -932,9 +939,6 @@ plperl_func_handler(PG_FUNCTION_ARGS)
932939
errmsg("returning a composite type is not allowed in this context"),
933940
errhint("This function is intended for use in the FROM clause.")));
934941

935-
if (SvTYPE(perlret) != SVt_RV)
936-
elog(ERROR, "plperl: composite-returning function must return a reference");
937-
938942

939943
isset = plperl_is_set(perlret);
940944

@@ -1042,7 +1046,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
10421046
SRF_RETURN_DONE(funcctx);
10431047
}
10441048
}
1045-
else if (prodesc->fn_retisset)
1049+
else if (prodesc->fn_retisset) /* set of non-tuples */
10461050
{
10471051
FuncCallContext *funcctx;
10481052

@@ -1054,8 +1058,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
10541058
funcctx = SRF_FIRSTCALL_INIT();
10551059
oldcontext = MemoryContextSwitchTo(funcctx->multi_call_memory_ctx);
10561060

1057-
if(SvTYPE(SvRV(perlret))!=SVt_PVAV) elog(ERROR, "plperl: set-returning function must return reference to array");
1058-
else funcctx->max_calls = av_len((AV*)SvRV(perlret))+1;
1061+
funcctx->max_calls = av_len((AV *) SvRV(perlret)) + 1;
10591062
}
10601063

10611064
funcctx = SRF_PERCALL_SETUP();
@@ -1085,16 +1088,53 @@ plperl_func_handler(PG_FUNCTION_ARGS)
10851088
}
10861089
else
10871090
{
1088-
if (perlret) SvREFCNT_dec(perlret);
1091+
if (perlret)
1092+
SvREFCNT_dec(perlret);
10891093
SRF_RETURN_DONE(funcctx);
10901094
}
10911095
}
1092-
else if (! fcinfo->isnull)
1096+
else if (!fcinfo->isnull) /* non-null singleton */
10931097
{
1098+
1099+
1100+
if (prodesc->fn_retistuple) /* singleton perl hash to Datum */
1101+
{
1102+
TupleDesc td = lookup_rowtype_tupdesc(prodesc->ret_oid,(int32)-1);
1103+
HV * perlhash = (HV *) SvRV(perlret);
1104+
int i;
1105+
char **values;
1106+
char * key, *val;
1107+
AttInMetadata *attinmeta;
1108+
HeapTuple tup;
1109+
1110+
if (!td)
1111+
ereport(ERROR,
1112+
(errcode(ERRCODE_SYNTAX_ERROR),
1113+
errmsg("no TupleDesc info available")));
1114+
1115+
values = (char **) palloc(td->natts * sizeof(char *));
1116+
for (i = 0; i < td->natts; i++)
1117+
{
1118+
1119+
key = SPI_fname(td,i+1);
1120+
val = plperl_get_elem(perlhash, key);
1121+
if (val)
1122+
values[i] = val;
1123+
else
1124+
values[i] = NULL;
1125+
}
1126+
attinmeta = TupleDescGetAttInMetadata(td);
1127+
tup = BuildTupleFromCStrings(attinmeta, values);
1128+
retval = HeapTupleGetDatum(tup);
1129+
1130+
}
1131+
else /* perl string to Datum */
1132+
10941133
retval = FunctionCall3(&prodesc->result_in_func,
10951134
PointerGetDatum(SvPV(perlret, PL_na)),
10961135
ObjectIdGetDatum(prodesc->result_typioparam),
10971136
Int32GetDatum(-1));
1137+
10981138
}
10991139

11001140
SvREFCNT_dec(perlret);
@@ -1341,12 +1381,16 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
13411381
}
13421382
}
13431383

1344-
prodesc->fn_retisset = procStruct->proretset; /*true, if function returns set*/
1384+
prodesc->fn_retisset = procStruct->proretset; /* true, if function
1385+
* returns set */
13451386

13461387
if (typeStruct->typtype == 'c' || procStruct->prorettype == RECORDOID)
13471388
{
13481389
prodesc->fn_retistuple = true;
1349-
prodesc->ret_oid = typeStruct->typrelid;
1390+
prodesc->ret_oid =
1391+
procStruct->prorettype == RECORDOID ?
1392+
typeStruct->typrelid :
1393+
procStruct->prorettype;
13501394
}
13511395

13521396
perm_fmgr_info(typeStruct->typinput, &(prodesc->result_in_func));

0 commit comments

Comments
 (0)