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

Commit4178de3

Browse files
committed
Back out patch for plperl to handle OUT paramaters into arrays and
hashes. Was causing regression failures.
1 parentfb55af2 commit4178de3

File tree

2 files changed

+21
-177
lines changed

2 files changed

+21
-177
lines changed

‎src/pl/plperl/plperl.c‎

Lines changed: 21 additions & 93 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.114 2006/08/11 19:42:35 momjian Exp $
4+
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.115 2006/08/12 04:16:45 momjian Exp $
55
*
66
**********************************************************************/
77

@@ -52,7 +52,6 @@ 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 */
5655
FmgrInfoarg_out_func[FUNC_MAX_ARGS];
5756
boolarg_is_rowtype[FUNC_MAX_ARGS];
5857
SV*reference;
@@ -116,9 +115,6 @@ static SV *plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc);
116115
staticvoidplperl_init_shared_libs(pTHX);
117116
staticHV*plperl_spi_execute_fetch_result(SPITupleTable*,int,int);
118117

119-
staticSV*plperl_convert_to_pg_array(SV*src);
120-
staticSV*plperl_transform_result(plperl_proc_desc*prodesc,SV*result);
121-
122118
/*
123119
* This routine is a crock, and so is everyplace that calls it. The problem
124120
* is that the cached form of plperl functions/queries is allocated permanently
@@ -408,12 +404,7 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
408404
(errcode(ERRCODE_UNDEFINED_COLUMN),
409405
errmsg("Perl hash contains nonexistent column \"%s\"",
410406
key)));
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)
407+
if (SvOK(val)&&SvTYPE(val)!=SVt_NULL)
417408
values[attn-1]=SvPV(val,PL_na);
418409
}
419410
hv_iterinit(perlhash);
@@ -690,7 +681,12 @@ plperl_validator(PG_FUNCTION_ARGS)
690681
HeapTupletuple;
691682
Form_pg_procproc;
692683
charfunctyptype;
684+
intnumargs;
685+
Oid*argtypes;
686+
char**argnames;
687+
char*argmodes;
693688
boolistrigger= false;
689+
inti;
694690

695691
/* Get the new function's pg_proc entry */
696692
tuple=SearchSysCache(PROCOID,
@@ -718,6 +714,18 @@ plperl_validator(PG_FUNCTION_ARGS)
718714
format_type_be(proc->prorettype))));
719715
}
720716

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+
721729
ReleaseSysCache(tuple);
722730

723731
/* Postpone body checks if !check_function_bodies */
@@ -1120,8 +1128,6 @@ plperl_func_handler(PG_FUNCTION_ARGS)
11201128
/* Return a perl string converted to a Datum */
11211129
char*val;
11221130

1123-
perlret=plperl_transform_result(prodesc,perlret);
1124-
11251131
if (prodesc->fn_retisarray&&SvROK(perlret)&&
11261132
SvTYPE(SvRV(perlret))==SVt_PVAV)
11271133
{
@@ -1250,6 +1256,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
12501256
charinternal_proname[64];
12511257
intproname_len;
12521258
plperl_proc_desc*prodesc=NULL;
1259+
inti;
12531260
SV**svp;
12541261

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

13221323
/************************************************************
13231324
* Allocate a new procedure description block
@@ -1336,25 +1337,6 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
13361337
prodesc->fn_readonly=
13371338
(procStruct->provolatile!=PROVOLATILE_VOLATILE);
13381339

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-
13581340
/************************************************************
13591341
* Lookup the pg_language tuple by Oid
13601342
************************************************************/
@@ -1694,8 +1676,6 @@ plperl_return_next(SV *sv)
16941676
fcinfo=current_call_data->fcinfo;
16951677
rsi= (ReturnSetInfo*)fcinfo->resultinfo;
16961678

1697-
sv=plperl_transform_result(prodesc,sv);
1698-
16991679
if (!prodesc->fn_retisset)
17001680
ereport(ERROR,
17011681
(errcode(ERRCODE_SYNTAX_ERROR),
@@ -1773,16 +1753,7 @@ plperl_return_next(SV *sv)
17731753

17741754
if (SvOK(sv)&&SvTYPE(sv)!=SVt_NULL)
17751755
{
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);
1756+
char*val=SvPV(sv,PL_na);
17861757

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

23982369
SPI_freeplan(plan);
23992370
}
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: 0 additions & 84 deletions
Original file line numberDiff line numberDiff line change
@@ -337,87 +337,3 @@ 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