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

Commitc07fbcf

Browse files
committed
plperl:
Allow conversion from perl to postgresql array in OUT parameters. Second,allow hash form output from procedures with one OUT argument.Pavel Stehule
1 parent33bf73a commitc07fbcf

File tree

3 files changed

+186
-23
lines changed

3 files changed

+186
-23
lines changed

‎doc/src/FAQ/FAQ_DEV.html

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,7 @@
1313
<H1>Developer's Frequently Asked Questions (FAQ) for
1414
PostgreSQL</H1>
1515

16-
<P>Last updated: Fri Aug 11 15:15:40 EDT 2006</P>
16+
<P>Last updated: Fri Aug 11 15:34:12 EDT 2006</P>
1717

1818
<P>Current maintainer: Bruce Momjian (<Ahref=
1919
"mailto:bruce@momjian.us">bruce@momjian.us</A>)<BR>
@@ -374,7 +374,14 @@ <H3 id="item1.9">1.9) What tools are available for
374374

375375
or
376376

377-
(c-add-style "pgsql"
377+
(add-hook 'c-mode-hook
378+
(function
379+
(lambda nil
380+
(if (string-match "pgsql" buffer-file-name)
381+
(progn
382+
(c-set-style "bsd")
383+
(setq c-basic-offset 4)
384+
(setq tab-width (c-add-style "pgsql"
378385
'("bsd"
379386
(indent-tabs-mode . t)
380387
(c-basic-offset . 4)

‎src/pl/plperl/plperl.c

Lines changed: 93 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
/**********************************************************************
22
* plperl.c - perl as a procedural language for PostgreSQL
33
*
4-
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.113 2006/08/08 19:15:09 tgl Exp $
4+
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.114 2006/08/11 19:42:35 momjian Exp $
55
*
66
**********************************************************************/
77

@@ -52,6 +52,7 @@ typedef struct plperl_proc_desc
5252
FmgrInforesult_in_func;/* I/O function and arg for result type */
5353
Oidresult_typioparam;
5454
intnargs;
55+
intnum_out_args;/* number of out arguments */
5556
FmgrInfoarg_out_func[FUNC_MAX_ARGS];
5657
boolarg_is_rowtype[FUNC_MAX_ARGS];
5758
SV*reference;
@@ -115,6 +116,9 @@ static SV *plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc);
115116
staticvoidplperl_init_shared_libs(pTHX);
116117
staticHV*plperl_spi_execute_fetch_result(SPITupleTable*,int,int);
117118

119+
staticSV*plperl_convert_to_pg_array(SV*src);
120+
staticSV*plperl_transform_result(plperl_proc_desc*prodesc,SV*result);
121+
118122
/*
119123
* This routine is a crock, and so is everyplace that calls it. The problem
120124
* is that the cached form of plperl functions/queries is allocated permanently
@@ -404,7 +408,12 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
404408
(errcode(ERRCODE_UNDEFINED_COLUMN),
405409
errmsg("Perl hash contains nonexistent column \"%s\"",
406410
key)));
407-
if (SvOK(val)&&SvTYPE(val)!=SVt_NULL)
411+
412+
/* if value is ref on array do to pg string array conversion */
413+
if (SvTYPE(val)==SVt_RV&&
414+
SvTYPE(SvRV(val))==SVt_PVAV)
415+
values[attn-1]=SvPV(plperl_convert_to_pg_array(val),PL_na);
416+
elseif (SvOK(val)&&SvTYPE(val)!=SVt_NULL)
408417
values[attn-1]=SvPV(val,PL_na);
409418
}
410419
hv_iterinit(perlhash);
@@ -681,12 +690,7 @@ plperl_validator(PG_FUNCTION_ARGS)
681690
HeapTupletuple;
682691
Form_pg_procproc;
683692
charfunctyptype;
684-
intnumargs;
685-
Oid*argtypes;
686-
char**argnames;
687-
char*argmodes;
688693
boolistrigger= false;
689-
inti;
690694

691695
/* Get the new function's pg_proc entry */
692696
tuple=SearchSysCache(PROCOID,
@@ -714,18 +718,6 @@ plperl_validator(PG_FUNCTION_ARGS)
714718
format_type_be(proc->prorettype))));
715719
}
716720

717-
/* Disallow pseudotypes in arguments (either IN or OUT) */
718-
numargs=get_func_arg_info(tuple,
719-
&argtypes,&argnames,&argmodes);
720-
for (i=0;i<numargs;i++)
721-
{
722-
if (get_typtype(argtypes[i])=='p')
723-
ereport(ERROR,
724-
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
725-
errmsg("plperl functions cannot take type %s",
726-
format_type_be(argtypes[i]))));
727-
}
728-
729721
ReleaseSysCache(tuple);
730722

731723
/* Postpone body checks if !check_function_bodies */
@@ -1128,6 +1120,8 @@ plperl_func_handler(PG_FUNCTION_ARGS)
11281120
/* Return a perl string converted to a Datum */
11291121
char*val;
11301122

1123+
perlret=plperl_transform_result(prodesc,perlret);
1124+
11311125
if (prodesc->fn_retisarray&&SvROK(perlret)&&
11321126
SvTYPE(SvRV(perlret))==SVt_PVAV)
11331127
{
@@ -1256,7 +1250,6 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
12561250
charinternal_proname[64];
12571251
intproname_len;
12581252
plperl_proc_desc*prodesc=NULL;
1259-
inti;
12601253
SV**svp;
12611254

12621255
/* We'll need the pg_proc tuple in any case... */
@@ -1319,6 +1312,12 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
13191312
Datumprosrcdatum;
13201313
boolisnull;
13211314
char*proc_source;
1315+
inti;
1316+
intnumargs;
1317+
Oid*argtypes;
1318+
char**argnames;
1319+
char*argmodes;
1320+
13221321

13231322
/************************************************************
13241323
* Allocate a new procedure description block
@@ -1337,6 +1336,25 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
13371336
prodesc->fn_readonly=
13381337
(procStruct->provolatile!=PROVOLATILE_VOLATILE);
13391338

1339+
1340+
/* Disallow pseudotypes in arguments (either IN or OUT) */
1341+
/* Count number of out arguments */
1342+
numargs=get_func_arg_info(procTup,
1343+
&argtypes,&argnames,&argmodes);
1344+
for (i=0;i<numargs;i++)
1345+
{
1346+
if (get_typtype(argtypes[i])=='p')
1347+
ereport(ERROR,
1348+
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1349+
errmsg("plperl functions cannot take type %s",
1350+
format_type_be(argtypes[i]))));
1351+
1352+
if (argmodes&&argmodes[i]==PROARGMODE_OUT)
1353+
prodesc->num_out_args++;
1354+
1355+
}
1356+
1357+
13401358
/************************************************************
13411359
* Lookup the pg_language tuple by Oid
13421360
************************************************************/
@@ -1676,6 +1694,8 @@ plperl_return_next(SV *sv)
16761694
fcinfo=current_call_data->fcinfo;
16771695
rsi= (ReturnSetInfo*)fcinfo->resultinfo;
16781696

1697+
sv=plperl_transform_result(prodesc,sv);
1698+
16791699
if (!prodesc->fn_retisset)
16801700
ereport(ERROR,
16811701
(errcode(ERRCODE_SYNTAX_ERROR),
@@ -1753,7 +1773,16 @@ plperl_return_next(SV *sv)
17531773

17541774
if (SvOK(sv)&&SvTYPE(sv)!=SVt_NULL)
17551775
{
1756-
char*val=SvPV(sv,PL_na);
1776+
char*val;
1777+
SV*array_ret;
1778+
1779+
if (SvROK(sv)&&SvTYPE(SvRV(sv))==SVt_PVAV )
1780+
{
1781+
array_ret=plperl_convert_to_pg_array(sv);
1782+
sv=array_ret;
1783+
}
1784+
1785+
val=SvPV(sv,PL_na);
17571786

17581787
ret=InputFunctionCall(&prodesc->result_in_func,val,
17591788
prodesc->result_typioparam,-1);
@@ -2368,3 +2397,46 @@ plperl_spi_freeplan(char *query)
23682397

23692398
SPI_freeplan(plan);
23702399
}
2400+
2401+
/*
2402+
* If plerl result is hash and fce result is scalar, it's hash form of
2403+
* out argument. Then, transform it to scalar
2404+
*/
2405+
2406+
staticSV*
2407+
plperl_transform_result(plperl_proc_desc*prodesc,SV*result)
2408+
{
2409+
boolexactly_one_field= false;
2410+
HV*hvr;
2411+
SV*val;
2412+
char*key;
2413+
I32klen;
2414+
2415+
2416+
if (prodesc->num_out_args==1&&SvOK(result)
2417+
&&SvTYPE(result)==SVt_RV&&SvTYPE(SvRV(result))==SVt_PVHV)
2418+
{
2419+
hvr= (HV*)SvRV(result);
2420+
hv_iterinit(hvr);
2421+
2422+
while ((val=hv_iternextsv(hvr,&key,&klen)))
2423+
{
2424+
if (exactly_one_field)
2425+
ereport(ERROR,
2426+
(errcode(ERRCODE_UNDEFINED_COLUMN),
2427+
errmsg("Perl hash contains nonexistent column \"%s\"",
2428+
key)));
2429+
exactly_one_field= true;
2430+
result=val;
2431+
}
2432+
2433+
if (!exactly_one_field)
2434+
ereport(ERROR,
2435+
(errcode(ERRCODE_UNDEFINED_COLUMN),
2436+
errmsg("Perl hash is empty")));
2437+
2438+
hv_iterinit(hvr);
2439+
}
2440+
2441+
returnresult;
2442+
}

‎src/pl/plperl/sql/plperl.sql

Lines changed: 84 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -337,3 +337,87 @@ CREATE OR REPLACE FUNCTION perl_spi_prepared_set(INTEGER, INTEGER) RETURNS SETOF
337337
$$ LANGUAGE plperl;
338338
SELECT*from perl_spi_prepared_set(1,2);
339339

340+
---
341+
--- Some OUT and OUT array tests
342+
---
343+
344+
CREATE OR REPLACEFUNCTIONtest_out_params(OUT avarchar, OUT bvarchar)AS $$
345+
return { a=>'ahoj', b=>'svete'};
346+
$$ LANGUAGE plperl;
347+
SELECT'01'AS i,*FROM test_out_params();
348+
349+
CREATE OR REPLACEFUNCTIONtest_out_params_array(OUT avarchar[], OUT bvarchar[])AS $$
350+
return { a=> ['ahoj'], b=>['svete']};
351+
$$ LANGUAGE plperl;
352+
SELECT'02'AS i,*FROM test_out_params_array();
353+
354+
CREATE OR REPLACEFUNCTIONtest_out_params_set(OUT avarchar, out bvarchar) RETURNS SETOF RECORDAS $$
355+
return_next { a=>'ahoj', b=>'svete'};
356+
return_next { a=>'ahoj', b=>'svete'};
357+
return_next { a=>'ahoj', b=>'svete'};
358+
$$ LANGUAGE plperl;
359+
SELECT'03'AS I,*FROM test_out_params_set();
360+
361+
CREATE OR REPLACEFUNCTIONtest_out_params_set_array(OUT avarchar[], out bvarchar[]) RETURNS SETOF RECORDAS $$
362+
return_next { a=> ['ahoj'], b=>['velky','svete']};
363+
return_next { a=> ['ahoj'], b=>['velky','svete']};
364+
return_next { a=> ['ahoj'], b=>['velky','svete']};
365+
$$ LANGUAGE plperl;
366+
SELECT'04'AS I,*FROM test_out_params_set_array();
367+
368+
369+
DROPFUNCTION test_out_params();
370+
DROPFUNCTION test_out_params_set();
371+
DROPFUNCTION test_out_params_array();
372+
DROPFUNCTION test_out_params_set_array();
373+
374+
-- one out argument can be returned as scalar or hash
375+
CREATE OR REPLACEFUNCTIONtest01(OUT avarchar)AS $$
376+
return'ahoj';
377+
$$ LANGUAGE plperl ;
378+
SELECT'01'AS i,*FROM test01();
379+
380+
CREATE OR REPLACEFUNCTIONtest02(OUT avarchar[])AS $$
381+
return {a=>['ahoj']};
382+
$$ LANGUAGE plperl;
383+
SELECT'02'AS i,a[1]FROM test02();
384+
385+
CREATE OR REPLACEFUNCTIONtest03(OUT avarchar[]) RETURNS SETOFvarchar[]AS $$
386+
return_next { a=> ['ahoj']};
387+
return_next { a=> ['ahoj']};
388+
return_next { a=> ['ahoj']};
389+
$$ LANGUAGE plperl;
390+
SELECT'03'AS i,*FROM test03();
391+
392+
CREATE OR REPLACEFUNCTIONtest04() RETURNS SETOFVARCHAR[]AS $$
393+
return_next ['ahoj'];
394+
return_next ['ahoj'];
395+
$$ LANGUAGE plperl;
396+
SELECT'04'AS i,*FROM test04();
397+
398+
CREATE OR REPLACEFUNCTIONtest05(OUT avarchar)AS $$
399+
return {a=>'ahoj'};
400+
$$ LANGUAGE plperl;
401+
SELECT'05'AS i,aFROM test05();
402+
403+
CREATE OR REPLACEFUNCTIONtest06(OUT avarchar) RETURNS SETOFvarcharAS $$
404+
return_next { a=>'ahoj'};
405+
return_next { a=>'ahoj'};
406+
return_next { a=>'ahoj'};
407+
$$ LANGUAGE plperl;
408+
SELECT'06'AS i,*FROM test06();
409+
410+
CREATE OR REPLACEFUNCTIONtest07() RETURNS SETOFVARCHARAS $$
411+
return_next'ahoj';
412+
return_next'ahoj';
413+
$$ LANGUAGE plperl;
414+
SELECT'07'AS i,*FROM test07();
415+
416+
DROPFUNCTION test01();
417+
DROPFUNCTION test02();
418+
DROPFUNCTION test03();
419+
DROPFUNCTION test04();
420+
DROPFUNCTION test05();
421+
DROPFUNCTION test06();
422+
DROPFUNCTION test07();
423+

0 commit comments

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