plperl features - Mailing list pgsql-patches

Patch provide support for array type and pseudo type
(anyelement, anyarray) for function parameters and result.
for example:

CREATE FUNCTION add_three_values(anyelement, anyelement, anyelement)
RETURNS anyelement AS '
return $_[0]+$_[1]+$_[2];
' LANGUAGE plperl;

CREATE FUNCTION make_array(anyelement, anyelement, anyelement) RETURNS
anyarray AS '
return [$_[0], $_[1], $_[2]];
' LANGUAGE plperl;

Comments?

--ggRay

Index: plperl.c
===================================================================
RCS file: /projects/cvsroot/pgsql-server/src/pl/plperl/plperl.c,v
retrieving revision 1.51
diff -c -w -r1.51 plperl.c
*** plperl.c    13 Sep 2004 20:08:59 -0000    1.51
--- plperl.c    29 Sep 2004 15:18:29 -0000
***************
*** 82,87 ****
--- 82,89 ----
      bool        lanpltrusted;
      bool        fn_retistuple;    /* true, if function returns tuple */
      bool        fn_retisset;    /* true, if function returns set */
+     bool        fn_retisarray;  /* true, if function returns "true" array*/
+     bool        fn_retispseudo; /* true, if function returns pseudo type*/
      Oid            ret_oid;        /* Oid of returning type */
      FmgrInfo    result_in_func;
      Oid            result_typioparam;
***************
*** 89,94 ****
--- 91,97 ----
      FmgrInfo    arg_out_func[FUNC_MAX_ARGS];
      Oid            arg_typioparam[FUNC_MAX_ARGS];
      bool        arg_is_rowtype[FUNC_MAX_ARGS];
+     bool        arg_is_p[FUNC_MAX_ARGS];
      SV           *reference;
  } plperl_proc_desc;

***************
*** 277,282 ****
--- 280,319 ----
  }

  /**********************************************************************
+  * convert perl array to the string representation
+  **********************************************************************/
+ static SV*
+ plperl_convert_to_pg_array(SV *src)
+ {
+     SV*    rv;
+     SV**    val;;
+     AV*    internal;
+     int    len,
+         i;
+
+     internal=(AV*)SvRV(src);
+     len = av_len(internal)+1;
+
+     rv = newSVpv("{ ",0);
+     for(i=0; i<len; i++)
+     {
+         val = av_fetch(internal, i, FALSE);
+         if (SvTYPE(*val)==SVt_RV)
+             if (SvTYPE(SvRV(*val))==SVt_PVAV)
+                 sv_catpvf(rv, "%s", SvPV(plperl_convert_to_pg_array(*val),PL_na));
+             else
+                 elog(ERROR, "plperl: check array structure");
+         else
+             sv_catpvf(rv, "%s", SvPV(*val,PL_na));
+         if (i != len-1) sv_catpvf(rv, ",");
+     }
+
+     sv_catpvf(rv, "}");
+
+     return rv;
+ }
+
+ /**********************************************************************
   * turn a tuple into a hash expression and add it to a list
   **********************************************************************/
  static void
***************
*** 752,757 ****
--- 789,807 ----
      XPUSHs(sv_2mortal(newSVpv("undef", 0)));
      for (i = 0; i < desc->nargs; i++)
      {
+         if (desc->arg_is_p[i]){
+             HeapTuple    typeTup;
+             Form_pg_type    typeStruct;
+
+             typeTup = SearchSysCache(TYPEOID,
+                             ObjectIdGetDatum(get_fn_expr_argtype(fcinfo->flinfo, i)),
+                             0, 0, 0);
+             typeStruct = (Form_pg_type) GETSTRUCT(typeTup);
+             perm_fmgr_info(typeStruct->typoutput, &(desc->arg_out_func[i]));
+             desc->arg_typioparam[i] = getTypeIOParam(typeTup);
+             ReleaseSysCache(typeTup);
+         }
+
          if (desc->arg_is_rowtype[i])
          {
              if (fcinfo->argnull[i])
***************
*** 909,914 ****
--- 959,977 ----
          perlret = srf_perlret;
      }

+     if (prodesc->fn_retispseudo){
+         HeapTuple    retTypeTup;
+         Form_pg_type    retTypeStruct;
+
+         retTypeTup = SearchSysCache(TYPEOID,
+                         ObjectIdGetDatum(get_fn_expr_rettype(fcinfo->flinfo)),
+                         0, 0, 0);
+         retTypeStruct = (Form_pg_type) GETSTRUCT(retTypeTup);
+         perm_fmgr_info(retTypeStruct->typinput, &(prodesc->result_in_func));
+         prodesc->result_typioparam = getTypeIOParam(retTypeTup);
+         ReleaseSysCache(retTypeTup);
+     }
+
      if (prodesc->fn_retisset && SRF_IS_FIRSTCALL())
      {
          if (prodesc->fn_retistuple)
***************
*** 1149,1161 ****

          }
          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);
--- 1212,1234 ----

          }
          else
+         {
+             SV* ret;
+
+             if (prodesc->fn_retisarray)
+             {
+                 if(SvTYPE(SvRV(perlret))!=SVt_PVAV) elog(ERROR, "plperl: this function must return reference to
array");
+                 ret = plperl_convert_to_pg_array(perlret);
+                 SvREFCNT_dec(perlret);
+                 perlret = ret;
+             }
  /* perl string to Datum */

              retval = FunctionCall3(&prodesc->result_in_func,
                                     PointerGetDatum(SvPV(perlret, PL_na)),
                              ObjectIdGetDatum(prodesc->result_typioparam),
                                     Int32GetDatum(-1));
!         }
      }

      SvREFCNT_dec(perlret);
***************
*** 1384,1395 ****
              }
              typeStruct = (Form_pg_type) GETSTRUCT(typeTup);

!             /* Disallow pseudotype result, except VOID or RECORD */
              if (typeStruct->typtype == 'p')
              {
                  if (procStruct->prorettype == VOIDOID ||
!                     procStruct->prorettype == RECORDOID)
!                      /* okay */ ;
                  else if (procStruct->prorettype == TRIGGEROID)
                  {
                      free(prodesc->proname);
--- 1457,1471 ----
              }
              typeStruct = (Form_pg_type) GETSTRUCT(typeTup);

!             /* Disallow pseudotype result, except VOID, RECORD, ANYELEMENT or ANYARRAY*/
              if (typeStruct->typtype == 'p')
              {
                  if (procStruct->prorettype == VOIDOID ||
!                     procStruct->prorettype == RECORDOID ||
!                     procStruct->prorettype == ANYARRAYOID ||
!                     procStruct->prorettype == ANYELEMENTOID)
!                      /* okay */
!                      prodesc->fn_retispseudo=true;
                  else if (procStruct->prorettype == TRIGGEROID)
                  {
                      free(prodesc->proname);
***************
*** 1421,1426 ****
--- 1497,1509 ----
                      procStruct->prorettype;
              }

+             if (procStruct->prorettype != ANYARRAYOID)
+                 if (typeStruct->typlen == -1 && typeStruct->typelem)  /*true, if function returns "true" array*/
+                     prodesc->fn_retisarray = true;
+                 else
+                     prodesc->fn_retisarray = false;
+             else prodesc->fn_retisarray = true;
+
              perm_fmgr_info(typeStruct->typinput, &(prodesc->result_in_func));
              prodesc->result_typioparam = getTypeIOParam(typeTup);

***************
*** 1448,1463 ****
                  }
                  typeStruct = (Form_pg_type) GETSTRUCT(typeTup);

-                 /* Disallow pseudotype argument */
                  if (typeStruct->typtype == 'p')
!                 {
!                     free(prodesc->proname);
!                     free(prodesc);
!                     ereport(ERROR,
!                             (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
!                            errmsg("plperl functions cannot take type %s",
!                            format_type_be(procStruct->proargtypes[i]))));
!                 }

                  if (typeStruct->typtype == 'c')
                      prodesc->arg_is_rowtype[i] = true;
--- 1531,1540 ----
                  }
                  typeStruct = (Form_pg_type) GETSTRUCT(typeTup);

                  if (typeStruct->typtype == 'p')
!                     prodesc->arg_is_p[i] = true;
!                 else
!                     prodesc->arg_is_p[i] = false;

                  if (typeStruct->typtype == 'c')
                      prodesc->arg_is_rowtype[i] = true;