plperl return single composite - Mailing list pgsql-patches

From Andrew Dunstan
Subject plperl return single composite
Date
Msg-id 40FD19AF.2090208@dunslane.net
Whole thread Raw
Responses Re: plperl return single composite  (Bruce Momjian <pgman@candle.pha.pa.us>)
List pgsql-patches
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));

pgsql-patches by date:

Previous
From: "David F. Skoll"
Date:
Subject: Re: Patch for pg_dump: Multiple -t options and new -T
Next
From: Andreas Pflug
Date:
Subject: Re: logfile subprocess and Fancy File Functions