Movatterモバイル変換

[0]ホーム
URL:

Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

 Sign up
Appearance settings

Commitb135508

Browse files
committed
Following up a previous thought I had, yesterday I realised how to
return arays nicely without having to make the plperl programmer awareof anything. The attached patch allows plperl to return an arrayrefwhere the function returns an array type. It silently calls a perlfunction to stringify the array before passing it to the pg arrayparser. Non-array returns are handled as before (i.e. passed throughthis process) so it is backwards compatible. I will presently submitregression tests and docs.example:andrew=# create or replace function blah() returns text[][] languageplperl as $$ return [['a"b','c,d'],['e\\f','g']]; $$;CREATE FUNCTIONandrew=# select blah(); blah----------------------------- {{"a\"b","c,d"},{"e\\f",g}}This would complete half of the TODO item: . Pass arrays natively instead of as text between plperl and postgres(The other half is translating pg array arguments to perl arrays - thatwill have to wait for 8.1).Some of this patch is adapted from a previously submitted patch fromSergej Sergeev. Both he and Abhijit Menon-Sen have looked it overbriefly and tentatively said it looks ok.Andrew Dunstan
1 parent6d92f21 commitb135508

File tree

1 file changed

+75
-6
lines changed

1 file changed

+75
-6
lines changed

‎src/pl/plperl/plperl.c

Lines changed: 75 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,7 @@
3333
* ENHANCEMENTS, OR MODIFICATIONS.
3434
*
3535
* IDENTIFICATION
36-
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.82 2005/07/10 15:19:43 momjian Exp $
36+
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.83 2005/07/10 15:32:47 momjian Exp $
3737
*
3838
**********************************************************************/
3939

@@ -81,6 +81,7 @@ typedef struct plperl_proc_desc
8181
boollanpltrusted;
8282
boolfn_retistuple;/* true, if function returns tuple */
8383
boolfn_retisset;/* true, if function returns set */
84+
boolfn_retisarray;/* true if function returns array */
8485
Oidresult_oid;/* Oid of result type */
8586
FmgrInforesult_in_func;/* I/O function and arg for result type */
8687
Oidresult_typioparam;
@@ -194,8 +195,29 @@ plperl_init_interp(void)
194195
"sub ::plperl_warn { my $msg = shift; &elog(&NOTICE, $msg); } "
195196
"$SIG{__WARN__} = \\&::plperl_warn; "
196197
"sub ::mkunsafefunc {return eval(qq[ sub { $_[0] $_[1] } ]); }"
198+
"sub ::_plperl_to_pg_array"
199+
"{"
200+
" my $arg = shift; ref $arg eq 'ARRAY' || return $arg; "
201+
" my $res = ''; my $first = 1; "
202+
" foreach my $elem (@$arg) "
203+
" { "
204+
" $res .= ', ' unless $first; $first = undef; "
205+
" if (ref $elem) "
206+
" { "
207+
" $res .= _plperl_to_pg_array($elem); "
208+
" } "
209+
" else "
210+
" { "
211+
" my $str = qq($elem); "
212+
" $str =~ s/([\"\\\\])/\\\\$1/g; "
213+
" $res .= qq(\"$str\"); "
214+
" } "
215+
" } "
216+
" return qq({$res}); "
217+
"} "
197218
};
198219

220+
199221
staticchar*strict_embedding[3]= {
200222
"","-e",
201223
/* all one string follows (no commas please) */
@@ -231,6 +253,7 @@ plperl_safe_init(void)
231253
"$PLContainer->permit(qw[:base_math !:base_io sort time]);"
232254
"$PLContainer->share(qw[&elog &spi_exec_query &return_next "
233255
"&spi_query &spi_fetchrow "
256+
"&_plperl_to_pg_array "
234257
"&DEBUG &LOG &INFO &NOTICE &WARNING &ERROR %_SHARED ]);"
235258
;
236259

@@ -331,6 +354,34 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
331354
returntup;
332355
}
333356

357+
/*
358+
* convert perl array to postgres string representation
359+
*/
360+
staticSV*
361+
plperl_convert_to_pg_array(SV*src)
362+
{
363+
SV*rv;
364+
intcount;
365+
dSP ;
366+
367+
PUSHMARK(SP) ;
368+
XPUSHs(src);
369+
PUTBACK ;
370+
371+
count=call_pv("_plperl_to_pg_array",G_SCALAR);
372+
373+
SPAGAIN ;
374+
375+
if (count!=1)
376+
croak("Big trouble\n") ;
377+
378+
rv=POPs;
379+
380+
PUTBACK ;
381+
382+
returnrv;
383+
}
384+
334385

335386
/* Set up the arguments for a trigger call. */
336387

@@ -869,7 +920,8 @@ plperl_func_handler(PG_FUNCTION_ARGS)
869920

870921
rsi= (ReturnSetInfo*)fcinfo->resultinfo;
871922

872-
if (prodesc->fn_retisset) {
923+
if (prodesc->fn_retisset)
924+
{
873925
if (!rsi|| !IsA(rsi,ReturnSetInfo)||
874926
(rsi->allowedModes&SFRM_Materialize)==0||
875927
rsi->expectedDesc==NULL)
@@ -890,7 +942,8 @@ plperl_func_handler(PG_FUNCTION_ARGS)
890942
inti=0;
891943
SV**svp=0;
892944
AV*rav= (AV*)SvRV(perlret);
893-
while ((svp=av_fetch(rav,i, FALSE))!=NULL) {
945+
while ((svp=av_fetch(rav,i, FALSE))!=NULL)
946+
{
894947
plperl_return_next(*svp);
895948
i++;
896949
}
@@ -904,7 +957,8 @@ plperl_func_handler(PG_FUNCTION_ARGS)
904957
}
905958

906959
rsi->returnMode=SFRM_Materialize;
907-
if (prodesc->tuple_store) {
960+
if (prodesc->tuple_store)
961+
{
908962
rsi->setResult=prodesc->tuple_store;
909963
rsi->setDesc=prodesc->tuple_desc;
910964
}
@@ -949,8 +1003,20 @@ plperl_func_handler(PG_FUNCTION_ARGS)
9491003
}
9501004
else
9511005
{
952-
/* Return a perl string converted to a Datum */
953-
char*val=SvPV(perlret,PL_na);
1006+
/* Return a perl string converted to a Datum */
1007+
char*val;
1008+
SV*array_ret;
1009+
1010+
1011+
if (prodesc->fn_retisarray&&SvTYPE(SvRV(perlret))==SVt_PVAV)
1012+
{
1013+
array_ret=plperl_convert_to_pg_array(perlret);
1014+
SvREFCNT_dec(perlret);
1015+
perlret=array_ret;
1016+
}
1017+
1018+
val=SvPV(perlret,PL_na);
1019+
9541020
retval=FunctionCall3(&prodesc->result_in_func,
9551021
CStringGetDatum(val),
9561022
ObjectIdGetDatum(prodesc->result_typioparam),
@@ -1208,6 +1274,9 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
12081274
prodesc->fn_retistuple= (typeStruct->typtype=='c'||
12091275
procStruct->prorettype==RECORDOID);
12101276

1277+
prodesc->fn_retisarray=
1278+
(typeStruct->typlen==-1&&typeStruct->typelem) ;
1279+
12111280
perm_fmgr_info(typeStruct->typinput,&(prodesc->result_in_func));
12121281
prodesc->result_typioparam=getTypeIOParam(typeTup);
12131282

0 commit comments

Comments
 (0)
[8]ページ先頭
©2009-2025 Movatter.jp