From: Peter Eisentraut Date: Wed, 16 Sep 2009 06:06:12 +0000 (+0000) Subject: errcontext support in PL/Perl X-Git-Tag: REL9_0_0~1586 X-Git-Url: http://git.osdn.net/view?a=commitdiff_plain;h=e3f027115a5a5109527238886bde7f6d5b4a5b96;p=pg-rex%2Fsyncrep.git errcontext support in PL/Perl Author: Alexey Klyukin --- diff --git a/src/pl/plperl/expected/plperl.out b/src/pl/plperl/expected/plperl.out index e1b0c75108..c8a8fdb877 100644 --- a/src/pl/plperl/expected/plperl.out +++ b/src/pl/plperl/expected/plperl.out @@ -122,8 +122,10 @@ CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$ $$ LANGUAGE plperl; SELECT perl_set(); ERROR: SETOF-composite-returning PL/Perl function must call return_next with reference to hash +CONTEXT: PL/Perl function "perl_set" SELECT * FROM perl_set(); ERROR: SETOF-composite-returning PL/Perl function must call return_next with reference to hash +CONTEXT: PL/Perl function "perl_set" CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$ return [ { f1 => 1, f2 => 'Hello', f3 => 'World' }, @@ -171,6 +173,7 @@ CREATE OR REPLACE FUNCTION perl_record() RETURNS record AS $$ $$ LANGUAGE plperl; SELECT perl_record(); ERROR: function returning record called in context that cannot accept type record +CONTEXT: PL/Perl function "perl_record" SELECT * FROM perl_record(); ERROR: a column definition list is required for functions returning "record" LINE 1: SELECT * FROM perl_record(); @@ -186,6 +189,7 @@ CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$ $$ LANGUAGE plperl; SELECT perl_record_set(); ERROR: set-valued function called in context that cannot accept a set +CONTEXT: PL/Perl function "perl_record_set" SELECT * FROM perl_record_set(); ERROR: a column definition list is required for functions returning "record" LINE 1: SELECT * FROM perl_record_set(); @@ -204,12 +208,14 @@ CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$ $$ LANGUAGE plperl; SELECT perl_record_set(); ERROR: set-valued function called in context that cannot accept a set +CONTEXT: PL/Perl function "perl_record_set" SELECT * FROM perl_record_set(); ERROR: a column definition list is required for functions returning "record" LINE 1: SELECT * FROM perl_record_set(); ^ SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text); ERROR: SETOF-composite-returning PL/Perl function must call return_next with reference to hash +CONTEXT: PL/Perl function "perl_record_set" CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$ return [ { f1 => 1, f2 => 'Hello', f3 => 'World' }, @@ -219,6 +225,7 @@ CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$ $$ LANGUAGE plperl; SELECT perl_record_set(); ERROR: set-valued function called in context that cannot accept a set +CONTEXT: PL/Perl function "perl_record_set" SELECT * FROM perl_record_set(); ERROR: a column definition list is required for functions returning "record" LINE 1: SELECT * FROM perl_record_set(); @@ -308,11 +315,13 @@ CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$ $$ LANGUAGE plperl; SELECT * FROM foo_bad(); ERROR: Perl hash contains nonexistent column "z" +CONTEXT: PL/Perl function "foo_bad" CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$ return 42; $$ LANGUAGE plperl; SELECT * FROM foo_bad(); ERROR: composite-returning PL/Perl function must return reference to hash +CONTEXT: PL/Perl function "foo_bad" CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$ return [ [1, 2], @@ -321,16 +330,19 @@ return [ $$ LANGUAGE plperl; SELECT * FROM foo_bad(); ERROR: composite-returning PL/Perl function must return reference to hash +CONTEXT: PL/Perl function "foo_bad" CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$ return 42; $$ LANGUAGE plperl; SELECT * FROM foo_set_bad(); ERROR: set-returning PL/Perl function must return reference to array or use return_next +CONTEXT: PL/Perl function "foo_set_bad" CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$ return {y => 3, z => 4}; $$ LANGUAGE plperl; SELECT * FROM foo_set_bad(); ERROR: set-returning PL/Perl function must return reference to array or use return_next +CONTEXT: PL/Perl function "foo_set_bad" CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$ return [ [1, 2], @@ -339,6 +351,7 @@ return [ $$ LANGUAGE plperl; SELECT * FROM foo_set_bad(); ERROR: SETOF-composite-returning PL/Perl function must call return_next with reference to hash +CONTEXT: PL/Perl function "foo_set_bad" CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$ return [ {y => 3, z => 4} @@ -346,6 +359,7 @@ return [ $$ LANGUAGE plperl; SELECT * FROM foo_set_bad(); ERROR: Perl hash contains nonexistent column "z" +CONTEXT: PL/Perl function "foo_set_bad" -- -- Check passing a tuple argument -- @@ -539,4 +553,5 @@ CREATE OR REPLACE FUNCTION perl_spi_prepared_bad(double precision) RETURNS doubl return $result; $$ LANGUAGE plperl; SELECT perl_spi_prepared_bad(4.35) as "double precision"; -ERROR: error from Perl function "perl_spi_prepared_bad": type "does_not_exist" does not exist at line 2. +ERROR: type "does_not_exist" does not exist at line 2. +CONTEXT: PL/Perl function "perl_spi_prepared_bad" diff --git a/src/pl/plperl/expected/plperl_elog.out b/src/pl/plperl/expected/plperl_elog.out index fcb6e8d11e..1791d3cc31 100644 --- a/src/pl/plperl/expected/plperl_elog.out +++ b/src/pl/plperl/expected/plperl_elog.out @@ -7,6 +7,7 @@ create or replace function perl_elog(text) returns void language plperl as $$ $$; select perl_elog('explicit elog'); NOTICE: explicit elog +CONTEXT: PL/Perl function "perl_elog" perl_elog ----------- @@ -21,6 +22,7 @@ $$; select perl_warn('implicit elog via warn'); NOTICE: implicit elog via warn at line 4. +CONTEXT: PL/Perl function "perl_warn" perl_warn ----------- @@ -35,8 +37,9 @@ create or replace function uses_global() returns text language plperl as $$ return 'uses_global worked'; $$; -ERROR: creation of Perl function "uses_global" failed: Global symbol "$global" requires explicit package name at line 3. +ERROR: Global symbol "$global" requires explicit package name at line 3. Global symbol "$other_global" requires explicit package name at line 4. +CONTEXT: compilation of PL/Perl function "uses_global" select uses_global(); ERROR: function uses_global() does not exist LINE 1: select uses_global(); diff --git a/src/pl/plperl/expected/plperl_trigger.out b/src/pl/plperl/expected/plperl_trigger.out index 48a4853e21..b5af566b27 100644 --- a/src/pl/plperl/expected/plperl_trigger.out +++ b/src/pl/plperl/expected/plperl_trigger.out @@ -53,41 +53,75 @@ BEFORE INSERT OR UPDATE OR DELETE ON trigger_test FOR EACH ROW EXECUTE PROCEDURE trigger_data(23,'skidoo'); insert into trigger_test values(1,'insert'); NOTICE: $_TD->{argc} = '2' +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{args} = ['23', 'skidoo'] +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{event} = 'INSERT' +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{level} = 'ROW' +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{name} = 'show_trigger_data_trig' +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{new} = {'i' => '1', 'v' => 'insert'} +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{relid} = 'bogus:12345' +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{relname} = 'trigger_test' +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{table_name} = 'trigger_test' +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{table_schema} = 'public' +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{when} = 'BEFORE' +CONTEXT: PL/Perl function "trigger_data" update trigger_test set v = 'update' where i = 1; NOTICE: $_TD->{argc} = '2' +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{args} = ['23', 'skidoo'] +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{event} = 'UPDATE' +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{level} = 'ROW' +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{name} = 'show_trigger_data_trig' +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{new} = {'i' => '1', 'v' => 'update'} +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{old} = {'i' => '1', 'v' => 'insert'} +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{relid} = 'bogus:12345' +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{relname} = 'trigger_test' +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{table_name} = 'trigger_test' +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{table_schema} = 'public' +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{when} = 'BEFORE' +CONTEXT: PL/Perl function "trigger_data" delete from trigger_test; NOTICE: $_TD->{argc} = '2' +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{args} = ['23', 'skidoo'] +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{event} = 'DELETE' +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{level} = 'ROW' +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{name} = 'show_trigger_data_trig' +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{old} = {'i' => '1', 'v' => 'update'} +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{relid} = 'bogus:12345' +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{relname} = 'trigger_test' +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{table_name} = 'trigger_test' +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{table_schema} = 'public' +CONTEXT: PL/Perl function "trigger_data" NOTICE: $_TD->{when} = 'BEFORE' +CONTEXT: PL/Perl function "trigger_data" DROP TRIGGER show_trigger_data_trig on trigger_test; diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c index 9a64f578f8..6a30611603 100644 --- a/src/pl/plperl/plperl.c +++ b/src/pl/plperl/plperl.c @@ -1,7 +1,7 @@ /********************************************************************** * plperl.c - perl as a procedural language for PostgreSQL * - * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.150 2009/06/11 14:49:14 momjian Exp $ + * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.151 2009/09/16 06:06:12 petere Exp $ * **********************************************************************/ @@ -162,6 +162,8 @@ static SV **hv_store_string(HV *hv, const char *key, SV *val); static SV **hv_fetch_string(HV *hv, const char *key); static SV *plperl_create_sub(char *proname, char *s, bool trusted); static SV *plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo); +static void plperl_compile_callback(void *arg); +static void plperl_exec_callback(void *arg); /* * 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) LEAVE; ereport(ERROR, (errcode(ERRCODE_SYNTAX_ERROR), - errmsg("creation of Perl function \"%s\" failed: %s", - proname, - strip_trailing_ws(SvPV(ERRSV, PL_na))))); + errmsg("%s", strip_trailing_ws(SvPV(ERRSV, PL_na))))); } /* @@ -1149,9 +1149,7 @@ plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo) LEAVE; /* XXX need to find a way to assign an errcode here */ ereport(ERROR, - (errmsg("error from Perl function \"%s\": %s", - desc->proname, - strip_trailing_ws(SvPV(ERRSV, PL_na))))); + (errmsg("%s", strip_trailing_ws(SvPV(ERRSV, PL_na))))); } retval = newSVsv(POPs); @@ -1207,9 +1205,7 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo, LEAVE; /* XXX need to find a way to assign an errcode here */ ereport(ERROR, - (errmsg("error from Perl function \"%s\": %s", - desc->proname, - strip_trailing_ws(SvPV(ERRSV, PL_na))))); + (errmsg("%s", strip_trailing_ws(SvPV(ERRSV, PL_na))))); } retval = newSVsv(POPs); @@ -1231,6 +1227,7 @@ plperl_func_handler(PG_FUNCTION_ARGS) ReturnSetInfo *rsi; SV *array_ret = NULL; bool oldcontext = trusted_context; + ErrorContextCallback pl_error_context; /* * Create the call_data beforing connecting to SPI, so that it is not @@ -1245,6 +1242,12 @@ plperl_func_handler(PG_FUNCTION_ARGS) prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false); current_call_data->prodesc = prodesc; + /* Set a callback for error reporting */ + pl_error_context.callback = plperl_exec_callback; + pl_error_context.previous = error_context_stack; + pl_error_context.arg = prodesc->proname; + error_context_stack = &pl_error_context; + rsi = (ReturnSetInfo *) fcinfo->resultinfo; if (prodesc->fn_retisset) @@ -1367,6 +1370,9 @@ plperl_func_handler(PG_FUNCTION_ARGS) prodesc->result_typioparam, -1); } + /* Restore the previous error callback */ + error_context_stack = pl_error_context.previous; + if (array_ret == NULL) SvREFCNT_dec(perlret); @@ -1386,6 +1392,7 @@ plperl_trigger_handler(PG_FUNCTION_ARGS) SV *svTD; HV *hvTD; bool oldcontext = trusted_context; + ErrorContextCallback pl_error_context; /* * Create the call_data beforing connecting to SPI, so that it is not @@ -1402,6 +1409,12 @@ plperl_trigger_handler(PG_FUNCTION_ARGS) prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, true); current_call_data->prodesc = prodesc; + /* Set a callback for error reporting */ + pl_error_context.callback = plperl_exec_callback; + pl_error_context.previous = error_context_stack; + pl_error_context.arg = prodesc->proname; + error_context_stack = &pl_error_context; + check_interp(prodesc->lanpltrusted); svTD = plperl_trigger_build_args(fcinfo); @@ -1471,6 +1484,9 @@ plperl_trigger_handler(PG_FUNCTION_ARGS) retval = PointerGetDatum(trv); } + /* Restore the previous error callback */ + error_context_stack = pl_error_context.previous; + SvREFCNT_dec(svTD); if (perlret) SvREFCNT_dec(perlret); @@ -1492,6 +1508,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger) plperl_proc_entry *hash_entry; bool found; bool oldcontext = trusted_context; + ErrorContextCallback plperl_error_context; /* We'll need the pg_proc tuple in any case... */ procTup = SearchSysCache(PROCOID, @@ -1501,6 +1518,12 @@ compile_plperl_function(Oid fn_oid, bool is_trigger) elog(ERROR, "cache lookup failed for function %u", fn_oid); procStruct = (Form_pg_proc) GETSTRUCT(procTup); + /* Set a callback for reporting compilation errors */ + plperl_error_context.callback = plperl_compile_callback; + plperl_error_context.previous = error_context_stack; + plperl_error_context.arg = NameStr(procStruct->proname); + error_context_stack = &plperl_error_context; + /************************************************************ * Build our internal proc name from the function's Oid ************************************************************/ @@ -1731,6 +1754,9 @@ compile_plperl_function(Oid fn_oid, bool is_trigger) hash_entry->proc_data = prodesc; } + /* restore previous error callback */ + error_context_stack = plperl_error_context.previous; + ReleaseSysCache(procTup); return prodesc; @@ -2683,3 +2709,25 @@ hv_fetch_string(HV *hv, const char *key) #endif return hv_fetch(hv, key, klen, 0); } + +/* + * Provide function name for PL/Perl execution errors + */ +static void +plperl_exec_callback(void *arg) +{ + char *procname = (char *) arg; + if (procname) + errcontext("PL/Perl function \"%s\"", procname); +} + +/* + * Provide function name for PL/Perl compilation errors + */ +static void +plperl_compile_callback(void *arg) +{ + char *procname = (char *) arg; + if (procname) + errcontext("compilation of PL/Perl function \"%s\"", procname); +}