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

diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index a9d83d9f3c7e2ddee2111eb09f62e0c3744946a4..ad9de225544d9be96ba14ad21346fd7f00b7090f 100644 (file)
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -33,7 +33,7 @@
  *   ENHANCEMENTS, OR MODIFICATIONS.
  *
  * IDENTIFICATION
- *   $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.46 2004/07/12 14:31:04 momjian Exp $
+ *   $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.47 2004/07/21 20:45:54 momjian Exp $
  *
  **********************************************************************/
 
@@ -889,7 +889,8 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 
     if (prodesc->fn_retisset && SRF_IS_FIRSTCALL())
     {
-        if (prodesc->fn_retistuple) g_column_keys = newAV();
+       if (prodesc->fn_retistuple)
+           g_column_keys = newAV();
        if (SvTYPE(perlret) != SVt_RV)
             elog(ERROR, "plperl: set-returning function must return reference");
    }
@@ -910,7 +911,13 @@ plperl_func_handler(PG_FUNCTION_ARGS)
        fcinfo->isnull = true;
    }
 
-   if (prodesc->fn_retistuple)
+   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,9 +939,6 @@ plperl_func_handler(PG_FUNCTION_ARGS)
                    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);
 
@@ -1042,7 +1046,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
            SRF_RETURN_DONE(funcctx);
        }
    }
-   else if (prodesc->fn_retisset)
+   else if (prodesc->fn_retisset) /* set of non-tuples */
    {
        FuncCallContext *funcctx;
        
@@ -1054,8 +1058,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
            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->max_calls = av_len((AV *) SvRV(perlret)) + 1;
        }
        
        funcctx = SRF_PERCALL_SETUP();
@@ -1085,16 +1088,53 @@ plperl_func_handler(PG_FUNCTION_ARGS)
        } 
        else
        {
-           if (perlret) SvREFCNT_dec(perlret);
+           if (perlret)
+               SvREFCNT_dec(perlret);
            SRF_RETURN_DONE(funcctx);
        }
     }
-   else if (! fcinfo->isnull)
+   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,12 +1381,16 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
                }
            }
 
-           prodesc->fn_retisset = procStruct->proretset; /*true, if function returns set*/
+           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;
+               prodesc->ret_oid = 
+                   procStruct->prorettype == RECORDOID ? 
+                   typeStruct->typrelid : 
+                   procStruct->prorettype;
            }
 
            perm_fmgr_info(typeStruct->typinput, &(prodesc->result_in_func));