[Plperlng-devel] Re: plperl better array support
Andrew Dunstan
andrew at dunslane.net
Thu Jun 30 23:50:54 GMT 2005
... and further experimentation shows that the escaping of CR and NL is
neither required nor functional, so I have simply removed those 2 lines.
Andrew Dunstan wrote:
>
> David Fetter has rightly pointed out that I should have used "eq"
> rather than "==" in my perl function. I have changed that already.
>
> cheers
>
> andrew
>
> Andrew Dunstan wrote:
>
>>
>> People,
>>
>> this itched so I scratched it.
>>
>> Here's another go at array return which I'm much happier with than my
>> previous try. Please comment ASAP (especially Sergej and Abhijit) - I
>> would like to send it to -patches ASAP to make the 8.1 cut.
>> Especially I need to knwo that the body of
>> plperl_convert_to_pg_array() is correct.
>>
>> cheers
>>
>> andrew
>>
>> Andrew Dunstan wrote:
>>
>>>
>>> The attached patch (submitted for comment) is somewhat adapted from
>>> one submitted last October. This allows returning a perl array where
>>> a postgres array is expected.
>>>
>>> example:
>>>
>>> andrew=# create function blurfl() returns text[] language plperl as $$
>>> andrew$# return ['a','b','c','a"b\c'];
>>> andrew$# $$;
>>> CREATE FUNCTION
>>> andrew=# select blurfl();
>>> blurfl -------------------
>>> {a,b,c,"a\"b\\c"}
>>>
>>>
>>> Unlike the patch from October, this patch does not implement
>>> ANYARRAY or ANYELEMENT pseudotypes. However it does escape/quote
>>> array elements where necessary. It also preserves the old behaviour
>>> (if the plperl function returns a string it is just passed through).
>>>
>>> I'm not happy about constructing a string which we then parse out
>>> again into an array - that strikes me as quite inefficient. (And
>>> there are other inelegancies that I'd like to get rid of.) Much
>>> better would be to use some array contruction calls directly - any
>>> pointers on how to do that would be apprciated :-)
>>>
>>>
>> ------------------------------------------------------------------------
>>
>> Index: plperl.c
>> ===================================================================
>> RCS file: /projects/cvsroot/pgsql/src/pl/plperl/plperl.c,v
>> retrieving revision 1.78
>> diff -c -r1.78 plperl.c
>> *** plperl.c 22 Jun 2005 16:45:51 -0000 1.78
>> --- plperl.c 30 Jun 2005 20:36:11 -0000
>> ***************
>> *** 81,86 ****
>> --- 81,87 ----
>> 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 array */
>> Oid result_oid; /* Oid of result type */
>> FmgrInfo result_in_func; /* I/O function and arg for
>> result type */
>> Oid result_typioparam;
>> ***************
>> *** 191,196 ****
>> --- 192,219 ----
>> /* all one string follows (no commas please) */
>> "SPI::bootstrap(); use vars qw(%_SHARED);"
>> "sub ::mkunsafefunc {return eval(qq[ sub { $_[0] $_[1] } ]); }"
>> + "sub ::_plperl_to_pg_array"
>> + "{"
>> + " my $arg = shift; ref $arg == 'ARRAY' || return $arg; "
>> + " my $res = ''; my $first = 1; "
>> + " foreach my $elem (@$arg) "
>> + " { "
>> + " $res .= ', ' unless $first; $first = undef; "
>> + " if (ref $elem) "
>> + " { "
>> + " $res .= _plperl_to_pg_array($elem); "
>> + " } "
>> + " else "
>> + " { "
>> + " my $str = qq($elem); "
>> + " $str =~ s/([,\"\\\\])/\\\\$1/g; "
>> + " $str =~ s/\\r/\\\\r/g; "
>> + " $str =~ s/\\n/\\\\n/g; "
>> + " $res .= qq(\"$str\"); "
>> + " } "
>> + " } "
>> + " return qq({$res}); "
>> + "} "
>> };
>>
>> static char *strict_embedding[3] = {
>> ***************
>> *** 225,230 ****
>> --- 248,254 ----
>> "$PLContainer->permit_only(':default');"
>> "$PLContainer->permit(qw[:base_math !:base_io sort time]);"
>> "$PLContainer->share(qw[&elog &spi_exec_query &return_next "
>> + "&_plperl_to_pg_array "
>> "&DEBUG &LOG &INFO &NOTICE &WARNING &ERROR %_SHARED ]);"
>> ;
>>
>> ***************
>> *** 325,330 ****
>> --- 349,382 ----
>> return tup;
>> }
>>
>> + /*
>> + * convert perl array to postgres string representation
>> + */
>> + static SV*
>> + plperl_convert_to_pg_array(SV *src)
>> + {
>> + SV* rv;
>> + int count;
>> + dSP ;
>> + + PUSHMARK(SP) ;
>> + XPUSHs(src);
>> + PUTBACK ;
>> + + count = call_pv("_plperl_to_pg_array", G_SCALAR);
>> + + SPAGAIN ;
>> + + if (count != 1)
>> + croak("Big trouble\n") ;
>> + + rv = POPs;
>> + + PUTBACK ;
>> + + return rv;
>> + }
>> +
>> /* Set up the arguments for a trigger call. */
>>
>> ***************
>> *** 863,869 ****
>>
>> rsi = (ReturnSetInfo *)fcinfo->resultinfo;
>>
>> ! if (prodesc->fn_retisset) {
>> if (!rsi || !IsA(rsi, ReturnSetInfo) ||
>> (rsi->allowedModes & SFRM_Materialize) == 0 ||
>> rsi->expectedDesc == NULL)
>> --- 915,922 ----
>>
>> rsi = (ReturnSetInfo *)fcinfo->resultinfo;
>>
>> ! if (prodesc->fn_retisset) ! {
>> if (!rsi || !IsA(rsi, ReturnSetInfo) ||
>> (rsi->allowedModes & SFRM_Materialize) == 0 ||
>> rsi->expectedDesc == NULL)
>> ***************
>> *** 884,890 ****
>> int i = 0;
>> SV **svp = 0;
>> AV *rav = (AV *)SvRV(perlret);
>> ! while ((svp = av_fetch(rav, i, FALSE)) != NULL) {
>> plperl_return_next(*svp);
>> i++;
>> }
>> --- 937,944 ----
>> int i = 0;
>> SV **svp = 0;
>> AV *rav = (AV *)SvRV(perlret);
>> ! while ((svp = av_fetch(rav, i, FALSE)) != NULL)
>> ! {
>> plperl_return_next(*svp);
>> i++;
>> }
>> ***************
>> *** 898,904 ****
>> }
>>
>> rsi->returnMode = SFRM_Materialize;
>> ! if (prodesc->tuple_store) {
>> rsi->setResult = prodesc->tuple_store;
>> rsi->setDesc = prodesc->tuple_desc;
>> }
>> --- 952,959 ----
>> }
>>
>> rsi->returnMode = SFRM_Materialize;
>> ! if (prodesc->tuple_store) ! {
>> rsi->setResult = prodesc->tuple_store;
>> rsi->setDesc = prodesc->tuple_desc;
>> }
>> ***************
>> *** 943,950 ****
>> }
>> else
>> {
>> ! /* Return a perl string converted to a Datum */
>> ! char *val = SvPV(perlret, PL_na);
>> retval = FunctionCall3(&prodesc->result_in_func,
>> CStringGetDatum(val),
>>
>> ObjectIdGetDatum(prodesc->result_typioparam),
>> --- 998,1017 ----
>> }
>> else
>> {
>> ! /* Return a perl string converted to a Datum */
>> ! char *val;
>> ! SV* array_ret;
>> ! ! ! if (prodesc->fn_retisarray && SvTYPE(SvRV(perlret)) ==
>> SVt_PVAV)
>> ! {
>> ! array_ret = plperl_convert_to_pg_array(perlret);
>> ! SvREFCNT_dec(perlret);
>> ! perlret = array_ret;
>> ! }
>> ! ! val = SvPV(perlret, PL_na);
>> ! retval = FunctionCall3(&prodesc->result_in_func,
>> CStringGetDatum(val),
>>
>> ObjectIdGetDatum(prodesc->result_typioparam),
>> ***************
>> *** 1202,1207 ****
>> --- 1269,1277 ----
>> prodesc->fn_retistuple = (typeStruct->typtype == 'c' ||
>> procStruct->prorettype ==
>> RECORDOID);
>>
>> + prodesc->fn_retisarray = +
>> (typeStruct->typlen == -1 && typeStruct->typelem) ;
>> + perm_fmgr_info(typeStruct->typinput,
>> &(prodesc->result_in_func));
>> prodesc->result_typioparam = getTypeIOParam(typeTup);
>>
>>
>>
>> ------------------------------------------------------------------------
>>
>> _______________________________________________
>> Plperlng-devel mailing list
>> Plperlng-devel at pgfoundry.org
>> http://pgfoundry.org/mailman/listinfo/plperlng-devel
>>
>>
> _______________________________________________
> Plperlng-devel mailing list
> Plperlng-devel at pgfoundry.org
> http://pgfoundry.org/mailman/listinfo/plperlng-devel
>
More information about the Plperlng-devel
mailing list