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

Commite3f0271

Browse files
committed
errcontext support in PL/Perl
Author: Alexey Klyukin <alexk@commandprompt.com>
1 parent384cad5 commite3f0271

File tree

4 files changed

+112
-12
lines changed

4 files changed

+112
-12
lines changed

‎src/pl/plperl/expected/plperl.out

Lines changed: 16 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -122,8 +122,10 @@ CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$
122122
$$ LANGUAGE plperl;
123123
SELECT perl_set();
124124
ERROR: SETOF-composite-returning PL/Perl function must call return_next with reference to hash
125+
CONTEXT: PL/Perl function "perl_set"
125126
SELECT * FROM perl_set();
126127
ERROR: SETOF-composite-returning PL/Perl function must call return_next with reference to hash
128+
CONTEXT: PL/Perl function "perl_set"
127129
CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$
128130
return [
129131
{ f1 => 1, f2 => 'Hello', f3 => 'World' },
@@ -171,6 +173,7 @@ CREATE OR REPLACE FUNCTION perl_record() RETURNS record AS $$
171173
$$ LANGUAGE plperl;
172174
SELECT perl_record();
173175
ERROR: function returning record called in context that cannot accept type record
176+
CONTEXT: PL/Perl function "perl_record"
174177
SELECT * FROM perl_record();
175178
ERROR: a column definition list is required for functions returning "record"
176179
LINE 1: SELECT * FROM perl_record();
@@ -186,6 +189,7 @@ CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$
186189
$$ LANGUAGE plperl;
187190
SELECT perl_record_set();
188191
ERROR: set-valued function called in context that cannot accept a set
192+
CONTEXT: PL/Perl function "perl_record_set"
189193
SELECT * FROM perl_record_set();
190194
ERROR: a column definition list is required for functions returning "record"
191195
LINE 1: SELECT * FROM perl_record_set();
@@ -204,12 +208,14 @@ CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$
204208
$$ LANGUAGE plperl;
205209
SELECT perl_record_set();
206210
ERROR: set-valued function called in context that cannot accept a set
211+
CONTEXT: PL/Perl function "perl_record_set"
207212
SELECT * FROM perl_record_set();
208213
ERROR: a column definition list is required for functions returning "record"
209214
LINE 1: SELECT * FROM perl_record_set();
210215
^
211216
SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text);
212217
ERROR: SETOF-composite-returning PL/Perl function must call return_next with reference to hash
218+
CONTEXT: PL/Perl function "perl_record_set"
213219
CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$
214220
return [
215221
{ f1 => 1, f2 => 'Hello', f3 => 'World' },
@@ -219,6 +225,7 @@ CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$
219225
$$ LANGUAGE plperl;
220226
SELECT perl_record_set();
221227
ERROR: set-valued function called in context that cannot accept a set
228+
CONTEXT: PL/Perl function "perl_record_set"
222229
SELECT * FROM perl_record_set();
223230
ERROR: a column definition list is required for functions returning "record"
224231
LINE 1: SELECT * FROM perl_record_set();
@@ -308,11 +315,13 @@ CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$
308315
$$ LANGUAGE plperl;
309316
SELECT * FROM foo_bad();
310317
ERROR: Perl hash contains nonexistent column "z"
318+
CONTEXT: PL/Perl function "foo_bad"
311319
CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$
312320
return 42;
313321
$$ LANGUAGE plperl;
314322
SELECT * FROM foo_bad();
315323
ERROR: composite-returning PL/Perl function must return reference to hash
324+
CONTEXT: PL/Perl function "foo_bad"
316325
CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$
317326
return [
318327
[1, 2],
@@ -321,16 +330,19 @@ return [
321330
$$ LANGUAGE plperl;
322331
SELECT * FROM foo_bad();
323332
ERROR: composite-returning PL/Perl function must return reference to hash
333+
CONTEXT: PL/Perl function "foo_bad"
324334
CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$
325335
return 42;
326336
$$ LANGUAGE plperl;
327337
SELECT * FROM foo_set_bad();
328338
ERROR: set-returning PL/Perl function must return reference to array or use return_next
339+
CONTEXT: PL/Perl function "foo_set_bad"
329340
CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$
330341
return {y => 3, z => 4};
331342
$$ LANGUAGE plperl;
332343
SELECT * FROM foo_set_bad();
333344
ERROR: set-returning PL/Perl function must return reference to array or use return_next
345+
CONTEXT: PL/Perl function "foo_set_bad"
334346
CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$
335347
return [
336348
[1, 2],
@@ -339,13 +351,15 @@ return [
339351
$$ LANGUAGE plperl;
340352
SELECT * FROM foo_set_bad();
341353
ERROR: SETOF-composite-returning PL/Perl function must call return_next with reference to hash
354+
CONTEXT: PL/Perl function "foo_set_bad"
342355
CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$
343356
return [
344357
{y => 3, z => 4}
345358
];
346359
$$ LANGUAGE plperl;
347360
SELECT * FROM foo_set_bad();
348361
ERROR: Perl hash contains nonexistent column "z"
362+
CONTEXT: PL/Perl function "foo_set_bad"
349363
--
350364
-- Check passing a tuple argument
351365
--
@@ -539,4 +553,5 @@ CREATE OR REPLACE FUNCTION perl_spi_prepared_bad(double precision) RETURNS doubl
539553
return $result;
540554
$$ LANGUAGE plperl;
541555
SELECT perl_spi_prepared_bad(4.35) as "double precision";
542-
ERROR: error from Perl function "perl_spi_prepared_bad": type "does_not_exist" does not exist at line 2.
556+
ERROR: type "does_not_exist" does not exist at line 2.
557+
CONTEXT: PL/Perl function "perl_spi_prepared_bad"

‎src/pl/plperl/expected/plperl_elog.out

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@ create or replace function perl_elog(text) returns void language plperl as $$
77
$$;
88
select perl_elog('explicit elog');
99
NOTICE: explicit elog
10+
CONTEXT: PL/Perl function "perl_elog"
1011
perl_elog
1112
-----------
1213

@@ -21,6 +22,7 @@ $$;
2122
select perl_warn('implicit elog via warn');
2223
NOTICE: implicit elog via warn at line 4.
2324

25+
CONTEXT: PL/Perl function "perl_warn"
2426
perl_warn
2527
-----------
2628

@@ -35,8 +37,9 @@ create or replace function uses_global() returns text language plperl as $$
3537
return 'uses_global worked';
3638

3739
$$;
38-
ERROR:creation of Perl function "uses_global" failed:Global symbol "$global" requires explicit package name at line 3.
40+
ERROR: Global symbol "$global" requires explicit package name at line 3.
3941
Global symbol "$other_global" requires explicit package name at line 4.
42+
CONTEXT: compilation of PL/Perl function "uses_global"
4043
select uses_global();
4144
ERROR: function uses_global() does not exist
4245
LINE 1: select uses_global();

‎src/pl/plperl/expected/plperl_trigger.out

Lines changed: 34 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -53,41 +53,75 @@ BEFORE INSERT OR UPDATE OR DELETE ON trigger_test
5353
FOR EACH ROW EXECUTE PROCEDURE trigger_data(23,'skidoo');
5454
insert into trigger_test values(1,'insert');
5555
NOTICE: $_TD->{argc} = '2'
56+
CONTEXT: PL/Perl function "trigger_data"
5657
NOTICE: $_TD->{args} = ['23', 'skidoo']
58+
CONTEXT: PL/Perl function "trigger_data"
5759
NOTICE: $_TD->{event} = 'INSERT'
60+
CONTEXT: PL/Perl function "trigger_data"
5861
NOTICE: $_TD->{level} = 'ROW'
62+
CONTEXT: PL/Perl function "trigger_data"
5963
NOTICE: $_TD->{name} = 'show_trigger_data_trig'
64+
CONTEXT: PL/Perl function "trigger_data"
6065
NOTICE: $_TD->{new} = {'i' => '1', 'v' => 'insert'}
66+
CONTEXT: PL/Perl function "trigger_data"
6167
NOTICE: $_TD->{relid} = 'bogus:12345'
68+
CONTEXT: PL/Perl function "trigger_data"
6269
NOTICE: $_TD->{relname} = 'trigger_test'
70+
CONTEXT: PL/Perl function "trigger_data"
6371
NOTICE: $_TD->{table_name} = 'trigger_test'
72+
CONTEXT: PL/Perl function "trigger_data"
6473
NOTICE: $_TD->{table_schema} = 'public'
74+
CONTEXT: PL/Perl function "trigger_data"
6575
NOTICE: $_TD->{when} = 'BEFORE'
76+
CONTEXT: PL/Perl function "trigger_data"
6677
update trigger_test set v = 'update' where i = 1;
6778
NOTICE: $_TD->{argc} = '2'
79+
CONTEXT: PL/Perl function "trigger_data"
6880
NOTICE: $_TD->{args} = ['23', 'skidoo']
81+
CONTEXT: PL/Perl function "trigger_data"
6982
NOTICE: $_TD->{event} = 'UPDATE'
83+
CONTEXT: PL/Perl function "trigger_data"
7084
NOTICE: $_TD->{level} = 'ROW'
85+
CONTEXT: PL/Perl function "trigger_data"
7186
NOTICE: $_TD->{name} = 'show_trigger_data_trig'
87+
CONTEXT: PL/Perl function "trigger_data"
7288
NOTICE: $_TD->{new} = {'i' => '1', 'v' => 'update'}
89+
CONTEXT: PL/Perl function "trigger_data"
7390
NOTICE: $_TD->{old} = {'i' => '1', 'v' => 'insert'}
91+
CONTEXT: PL/Perl function "trigger_data"
7492
NOTICE: $_TD->{relid} = 'bogus:12345'
93+
CONTEXT: PL/Perl function "trigger_data"
7594
NOTICE: $_TD->{relname} = 'trigger_test'
95+
CONTEXT: PL/Perl function "trigger_data"
7696
NOTICE: $_TD->{table_name} = 'trigger_test'
97+
CONTEXT: PL/Perl function "trigger_data"
7798
NOTICE: $_TD->{table_schema} = 'public'
99+
CONTEXT: PL/Perl function "trigger_data"
78100
NOTICE: $_TD->{when} = 'BEFORE'
101+
CONTEXT: PL/Perl function "trigger_data"
79102
delete from trigger_test;
80103
NOTICE: $_TD->{argc} = '2'
104+
CONTEXT: PL/Perl function "trigger_data"
81105
NOTICE: $_TD->{args} = ['23', 'skidoo']
106+
CONTEXT: PL/Perl function "trigger_data"
82107
NOTICE: $_TD->{event} = 'DELETE'
108+
CONTEXT: PL/Perl function "trigger_data"
83109
NOTICE: $_TD->{level} = 'ROW'
110+
CONTEXT: PL/Perl function "trigger_data"
84111
NOTICE: $_TD->{name} = 'show_trigger_data_trig'
112+
CONTEXT: PL/Perl function "trigger_data"
85113
NOTICE: $_TD->{old} = {'i' => '1', 'v' => 'update'}
114+
CONTEXT: PL/Perl function "trigger_data"
86115
NOTICE: $_TD->{relid} = 'bogus:12345'
116+
CONTEXT: PL/Perl function "trigger_data"
87117
NOTICE: $_TD->{relname} = 'trigger_test'
118+
CONTEXT: PL/Perl function "trigger_data"
88119
NOTICE: $_TD->{table_name} = 'trigger_test'
120+
CONTEXT: PL/Perl function "trigger_data"
89121
NOTICE: $_TD->{table_schema} = 'public'
122+
CONTEXT: PL/Perl function "trigger_data"
90123
NOTICE: $_TD->{when} = 'BEFORE'
124+
CONTEXT: PL/Perl function "trigger_data"
91125

92126
DROP TRIGGER show_trigger_data_trig on trigger_test;
93127

‎src/pl/plperl/plperl.c

Lines changed: 58 additions & 10 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.150 2009/06/11 14:49:14 momjian Exp $
4+
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.151 2009/09/16 06:06:12 petere Exp $
55
*
66
**********************************************************************/
77

@@ -162,6 +162,8 @@ static SV **hv_store_string(HV *hv, const char *key, SV *val);
162162
staticSV**hv_fetch_string(HV*hv,constchar*key);
163163
staticSV*plperl_create_sub(char*proname,char*s,booltrusted);
164164
staticSV*plperl_call_perl_func(plperl_proc_desc*desc,FunctionCallInfofcinfo);
165+
staticvoidplperl_compile_callback(void*arg);
166+
staticvoidplperl_exec_callback(void*arg);
165167

166168
/*
167169
* This routine is a crock, and so is everyplace that calls it. The problem
@@ -1019,9 +1021,7 @@ plperl_create_sub(char *proname, char *s, bool trusted)
10191021
LEAVE;
10201022
ereport(ERROR,
10211023
(errcode(ERRCODE_SYNTAX_ERROR),
1022-
errmsg("creation of Perl function \"%s\" failed: %s",
1023-
proname,
1024-
strip_trailing_ws(SvPV(ERRSV,PL_na)))));
1024+
errmsg("%s",strip_trailing_ws(SvPV(ERRSV,PL_na)))));
10251025
}
10261026

10271027
/*
@@ -1149,9 +1149,7 @@ plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo)
11491149
LEAVE;
11501150
/* XXX need to find a way to assign an errcode here */
11511151
ereport(ERROR,
1152-
(errmsg("error from Perl function \"%s\": %s",
1153-
desc->proname,
1154-
strip_trailing_ws(SvPV(ERRSV,PL_na)))));
1152+
(errmsg("%s",strip_trailing_ws(SvPV(ERRSV,PL_na)))));
11551153
}
11561154

11571155
retval=newSVsv(POPs);
@@ -1207,9 +1205,7 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo,
12071205
LEAVE;
12081206
/* XXX need to find a way to assign an errcode here */
12091207
ereport(ERROR,
1210-
(errmsg("error from Perl function \"%s\": %s",
1211-
desc->proname,
1212-
strip_trailing_ws(SvPV(ERRSV,PL_na)))));
1208+
(errmsg("%s",strip_trailing_ws(SvPV(ERRSV,PL_na)))));
12131209
}
12141210

12151211
retval=newSVsv(POPs);
@@ -1231,6 +1227,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
12311227
ReturnSetInfo*rsi;
12321228
SV*array_ret=NULL;
12331229
boololdcontext=trusted_context;
1230+
ErrorContextCallbackpl_error_context;
12341231

12351232
/*
12361233
* Create the call_data beforing connecting to SPI, so that it is not
@@ -1245,6 +1242,12 @@ plperl_func_handler(PG_FUNCTION_ARGS)
12451242
prodesc=compile_plperl_function(fcinfo->flinfo->fn_oid, false);
12461243
current_call_data->prodesc=prodesc;
12471244

1245+
/* Set a callback for error reporting */
1246+
pl_error_context.callback=plperl_exec_callback;
1247+
pl_error_context.previous=error_context_stack;
1248+
pl_error_context.arg=prodesc->proname;
1249+
error_context_stack=&pl_error_context;
1250+
12481251
rsi= (ReturnSetInfo*)fcinfo->resultinfo;
12491252

12501253
if (prodesc->fn_retisset)
@@ -1367,6 +1370,9 @@ plperl_func_handler(PG_FUNCTION_ARGS)
13671370
prodesc->result_typioparam,-1);
13681371
}
13691372

1373+
/* Restore the previous error callback */
1374+
error_context_stack=pl_error_context.previous;
1375+
13701376
if (array_ret==NULL)
13711377
SvREFCNT_dec(perlret);
13721378

@@ -1386,6 +1392,7 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
13861392
SV*svTD;
13871393
HV*hvTD;
13881394
boololdcontext=trusted_context;
1395+
ErrorContextCallbackpl_error_context;
13891396

13901397
/*
13911398
* Create the call_data beforing connecting to SPI, so that it is not
@@ -1402,6 +1409,12 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
14021409
prodesc=compile_plperl_function(fcinfo->flinfo->fn_oid, true);
14031410
current_call_data->prodesc=prodesc;
14041411

1412+
/* Set a callback for error reporting */
1413+
pl_error_context.callback=plperl_exec_callback;
1414+
pl_error_context.previous=error_context_stack;
1415+
pl_error_context.arg=prodesc->proname;
1416+
error_context_stack=&pl_error_context;
1417+
14051418
check_interp(prodesc->lanpltrusted);
14061419

14071420
svTD=plperl_trigger_build_args(fcinfo);
@@ -1471,6 +1484,9 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
14711484
retval=PointerGetDatum(trv);
14721485
}
14731486

1487+
/* Restore the previous error callback */
1488+
error_context_stack=pl_error_context.previous;
1489+
14741490
SvREFCNT_dec(svTD);
14751491
if (perlret)
14761492
SvREFCNT_dec(perlret);
@@ -1492,6 +1508,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
14921508
plperl_proc_entry*hash_entry;
14931509
boolfound;
14941510
boololdcontext=trusted_context;
1511+
ErrorContextCallbackplperl_error_context;
14951512

14961513
/* We'll need the pg_proc tuple in any case... */
14971514
procTup=SearchSysCache(PROCOID,
@@ -1501,6 +1518,12 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
15011518
elog(ERROR,"cache lookup failed for function %u",fn_oid);
15021519
procStruct= (Form_pg_proc)GETSTRUCT(procTup);
15031520

1521+
/* Set a callback for reporting compilation errors */
1522+
plperl_error_context.callback=plperl_compile_callback;
1523+
plperl_error_context.previous=error_context_stack;
1524+
plperl_error_context.arg=NameStr(procStruct->proname);
1525+
error_context_stack=&plperl_error_context;
1526+
15041527
/************************************************************
15051528
* Build our internal proc name from the function's Oid
15061529
************************************************************/
@@ -1731,6 +1754,9 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
17311754
hash_entry->proc_data=prodesc;
17321755
}
17331756

1757+
/* restore previous error callback */
1758+
error_context_stack=plperl_error_context.previous;
1759+
17341760
ReleaseSysCache(procTup);
17351761

17361762
returnprodesc;
@@ -2683,3 +2709,25 @@ hv_fetch_string(HV *hv, const char *key)
26832709
#endif
26842710
returnhv_fetch(hv,key,klen,0);
26852711
}
2712+
2713+
/*
2714+
* Provide function name for PL/Perl execution errors
2715+
*/
2716+
staticvoid
2717+
plperl_exec_callback(void*arg)
2718+
{
2719+
char*procname= (char*)arg;
2720+
if (procname)
2721+
errcontext("PL/Perl function \"%s\"",procname);
2722+
}
2723+
2724+
/*
2725+
* Provide function name for PL/Perl compilation errors
2726+
*/
2727+
staticvoid
2728+
plperl_compile_callback(void*arg)
2729+
{
2730+
char*procname= (char*)arg;
2731+
if (procname)
2732+
errcontext("compilation of PL/Perl function \"%s\"",procname);
2733+
}

0 commit comments

Comments
 (0)

[8]ページ先頭

©2009-2025 Movatter.jp