33
33
* ENHANCEMENTS, OR MODIFICATIONS.
34
34
*
35
35
* 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 $
37
37
*
38
38
**********************************************************************/
39
39
@@ -889,7 +889,8 @@ plperl_func_handler(PG_FUNCTION_ARGS)
889
889
890
890
if (prodesc -> fn_retisset && SRF_IS_FIRSTCALL ())
891
891
{
892
- if (prodesc -> fn_retistuple ) g_column_keys = newAV ();
892
+ if (prodesc -> fn_retistuple )
893
+ g_column_keys = newAV ();
893
894
if (SvTYPE (perlret ) != SVt_RV )
894
895
elog (ERROR , "plperl: set-returning function must return reference" );
895
896
}
@@ -910,7 +911,13 @@ plperl_func_handler(PG_FUNCTION_ARGS)
910
911
fcinfo -> isnull = true;
911
912
}
912
913
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 */
914
921
{
915
922
/* SRF support */
916
923
HV * ret_hv ;
@@ -932,9 +939,6 @@ plperl_func_handler(PG_FUNCTION_ARGS)
932
939
errmsg ("returning a composite type is not allowed in this context" ),
933
940
errhint ("This function is intended for use in the FROM clause." )));
934
941
935
- if (SvTYPE (perlret ) != SVt_RV )
936
- elog (ERROR , "plperl: composite-returning function must return a reference" );
937
-
938
942
939
943
isset = plperl_is_set (perlret );
940
944
@@ -1042,7 +1046,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
1042
1046
SRF_RETURN_DONE (funcctx );
1043
1047
}
1044
1048
}
1045
- else if (prodesc -> fn_retisset )
1049
+ else if (prodesc -> fn_retisset ) /* set of non-tuples */
1046
1050
{
1047
1051
FuncCallContext * funcctx ;
1048
1052
@@ -1054,8 +1058,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
1054
1058
funcctx = SRF_FIRSTCALL_INIT ();
1055
1059
oldcontext = MemoryContextSwitchTo (funcctx -> multi_call_memory_ctx );
1056
1060
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 ;
1059
1062
}
1060
1063
1061
1064
funcctx = SRF_PERCALL_SETUP ();
@@ -1085,16 +1088,53 @@ plperl_func_handler(PG_FUNCTION_ARGS)
1085
1088
}
1086
1089
else
1087
1090
{
1088
- if (perlret ) SvREFCNT_dec (perlret );
1091
+ if (perlret )
1092
+ SvREFCNT_dec (perlret );
1089
1093
SRF_RETURN_DONE (funcctx );
1090
1094
}
1091
1095
}
1092
- else if (! fcinfo -> isnull )
1096
+ else if (!fcinfo -> isnull ) /* non-null singleton */
1093
1097
{
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
+
1094
1133
retval = FunctionCall3 (& prodesc -> result_in_func ,
1095
1134
PointerGetDatum (SvPV (perlret , PL_na )),
1096
1135
ObjectIdGetDatum (prodesc -> result_typioparam ),
1097
1136
Int32GetDatum (-1 ));
1137
+
1098
1138
}
1099
1139
1100
1140
SvREFCNT_dec (perlret );
@@ -1341,12 +1381,16 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
1341
1381
}
1342
1382
}
1343
1383
1344
- prodesc -> fn_retisset = procStruct -> proretset ; /*true, if function returns set*/
1384
+ prodesc -> fn_retisset = procStruct -> proretset ; /* true, if function
1385
+ * returns set */
1345
1386
1346
1387
if (typeStruct -> typtype == 'c' || procStruct -> prorettype == RECORDOID )
1347
1388
{
1348
1389
prodesc -> fn_retistuple = true;
1349
- prodesc -> ret_oid = typeStruct -> typrelid ;
1390
+ prodesc -> ret_oid =
1391
+ procStruct -> prorettype == RECORDOID ?
1392
+ typeStruct -> typrelid :
1393
+ procStruct -> prorettype ;
1350
1394
}
1351
1395
1352
1396
perm_fmgr_info (typeStruct -> typinput , & (prodesc -> result_in_func ));
0 commit comments