Re: plperl features

This has been saved for the 8.1 release:

http:/momjian.postgresql.org/cgi-bin/pgpatches2

---------------------------------------------------------------------------

Sergej Sergeev wrote:
>
> >Sergej Sergeev <sergej(at)commandprompt(dot)com> writes:
> >
> >
> >>>What happens if you feed other pseudotypes, like cstring or
> >>>language_handler? Shouldn't that be disallowed or something?
> >>>
> >>>
> >
> >
> >
> >>Other pseudo-types are disallowed (no-change)
> >>
> >>
> >
> >No, because you diked out the check at lines 1452ff, rather than
> >upgrading it to something correct.
> >
> >I find the "fn_retispseudo" and "arg_is_p" flags pretty bogus anyway
> >since they fail to indicate *which* pseudotype it is. You might as
> >well just test for the specific type OID.
> >
> > regards, tom lane
> >
> >
> New patch. I have added the check pseudo-type argumetns.
> Specific type is substituted in runtime, during function call.
>
> --
> g.gRay: PL/perl, PL/PHP ;)
>

> 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 30 Sep 2004 16:07:25 -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,1455 ****
> }
> typeStruct = (Form_pg_type) GETSTRUCT(typeTup);
>
> ! /* Disallow pseudotype argument */
> if (typeStruct->typtype == 'p')
> {
> free(prodesc->proname);
> free(prodesc);
> --- 1531,1543 ----
> }
> typeStruct = (Form_pg_type) GETSTRUCT(typeTup);
>
> ! /* Disallow pseudotype argument, except ANYELEMENT or ANYARRAY */
> if (typeStruct->typtype == 'p')
> + if (procStruct->proargtypes[i] == ANYARRAYOID ||
> + procStruct->proargtypes[i] == ANYELEMENTOID)
> + /* okay */
> + prodesc->arg_is_p[i] = true;
> + else
> {
> free(prodesc->proname);
> free(prodesc);
> ***************
> *** 1458,1463 ****
> --- 1546,1553 ----
> errmsg("plperl functions cannot take type %s",
> format_type_be(procStruct->proargtypes[i]))));
> }
> + else
> + prodesc->arg_is_p[i] = false;
>
> if (typeStruct->typtype == 'c')
> prodesc->arg_is_rowtype[i] = true;

>
> ---------------------------(end of broadcast)---------------------------
> TIP 2: you can get off all lists at once with the unregister command
> (send "unregister YourEmailAddressHere" to majordomo(at)postgresql(dot)org)

--
Bruce Momjian | http://candle.pha.pa.us
pgman(at)candle(dot)pha(dot)pa(dot)us | (610) 359-1001
+ If your life is a hard drive, | 13 Roberts Road
+ Christ can be your backup. | Newtown Square, Pennsylvania 19073