errcontext support in PL/Perl
Hi,
While trying to build a custom error reporting function for one of our
clients we came across the fact that PL/Perl doesn't set errcontext
that we relied on to get the traceback of running functions. Exactly
the same problem with PL/Python was fixed recently by Peter Eisentraut
(http://archives.postgresql.org/pgsql-committers/2009-07/msg00168.php).
Attached is a patch (HEAD) that sets errcontext with PL/Perl function
name, making a distinction between compilation and execution stages,
fixes error messages where function name was already included in the
message itself and updates regression tests. I'll appreciate any
suggestions on how to improve it.
Attachments:
plperl_error_callback.diffapplication/octet-stream; name=plperl_error_callback.diff; x-unix-mode=0644Download
diff --git a/src/pl/plperl/expected/plperl.out b/src/pl/plperl/expected/plperl.out
index e1b0c75..c8a8fdb 100644
*** a/src/pl/plperl/expected/plperl.out
--- b/src/pl/plperl/expected/plperl.out
*************** CREATE OR REPLACE FUNCTION perl_set() RE
*** 122,129 ****
--- 122,131 ----
$$ 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' },
*************** CREATE OR REPLACE FUNCTION perl_record()
*** 171,176 ****
--- 173,179 ----
$$ 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();
*************** CREATE OR REPLACE FUNCTION perl_record_s
*** 186,191 ****
--- 189,195 ----
$$ 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();
*************** CREATE OR REPLACE FUNCTION perl_record_s
*** 204,215 ****
--- 208,221 ----
$$ 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' },
*************** CREATE OR REPLACE FUNCTION perl_record_s
*** 219,224 ****
--- 225,231 ----
$$ 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();
*************** CREATE OR REPLACE FUNCTION foo_bad() RET
*** 308,318 ****
--- 315,327 ----
$$ 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],
*************** return [
*** 321,336 ****
--- 330,348 ----
$$ 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],
*************** return [
*** 339,344 ****
--- 351,357 ----
$$ 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}
*************** return [
*** 346,351 ****
--- 359,365 ----
$$ 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
--
*************** CREATE OR REPLACE FUNCTION perl_spi_prep
*** 539,542 ****
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.
--- 553,557 ----
return $result;
$$ LANGUAGE plperl;
SELECT perl_spi_prepared_bad(4.35) as "double precision";
! 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 fcb6e8d..1791d3c 100644
*** a/src/pl/plperl/expected/plperl_elog.out
--- b/src/pl/plperl/expected/plperl_elog.out
*************** create or replace function perl_elog(tex
*** 7,12 ****
--- 7,13 ----
$$;
select perl_elog('explicit elog');
NOTICE: explicit elog
+ CONTEXT: PL/Perl function "perl_elog"
perl_elog
-----------
*************** $$;
*** 21,26 ****
--- 22,28 ----
select perl_warn('implicit elog via warn');
NOTICE: implicit elog via warn at line 4.
+ CONTEXT: PL/Perl function "perl_warn"
perl_warn
-----------
*************** create or replace function uses_global()
*** 35,42 ****
return 'uses_global worked';
$$;
! ERROR: creation of Perl function "uses_global" failed: Global symbol "$global" requires explicit package name at line 3.
Global symbol "$other_global" requires explicit package name at line 4.
select uses_global();
ERROR: function uses_global() does not exist
LINE 1: select uses_global();
--- 37,45 ----
return 'uses_global worked';
$$;
! 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 48a4853..b5af566 100644
*** a/src/pl/plperl/expected/plperl_trigger.out
--- b/src/pl/plperl/expected/plperl_trigger.out
*************** BEFORE INSERT OR UPDATE OR DELETE ON tri
*** 53,93 ****
--- 53,127 ----
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 82e2f4b..ef09245 100644
*** a/src/pl/plperl/plperl.c
--- b/src/pl/plperl/plperl.c
*************** static SV **hv_store_string(HV *hv, cons
*** 162,167 ****
--- 162,169 ----
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
*************** plperl_call_handler(PG_FUNCTION_ARGS)
*** 869,876 ****
--- 871,885 ----
{
Datum retval;
plperl_call_data *save_call_data;
+ ErrorContextCallback pl_error_context;
save_call_data = current_call_data;
+
+ /* Set a callback for error reporting */
+ pl_error_context.callback = plperl_exec_callback;
+ pl_error_context.previous = error_context_stack;
+ error_context_stack = &pl_error_context;
+
PG_TRY();
{
if (CALLED_AS_TRIGGER(fcinfo))
*************** plperl_call_handler(PG_FUNCTION_ARGS)
*** 885,890 ****
--- 894,902 ----
}
PG_END_TRY();
+ /* Restore the previous error callback */
+ error_context_stack = pl_error_context.previous;
+
current_call_data = save_call_data;
return retval;
}
*************** plperl_create_sub(char *proname, char *s
*** 1019,1027 ****
LEAVE;
ereport(ERROR,
(errcode(ERRCODE_SYNTAX_ERROR),
! errmsg("creation of Perl function \"%s\" failed: %s",
! proname,
! strip_trailing_ws(SvPV(ERRSV, PL_na)))));
}
/*
--- 1031,1037 ----
LEAVE;
ereport(ERROR,
(errcode(ERRCODE_SYNTAX_ERROR),
! errmsg("%s", strip_trailing_ws(SvPV(ERRSV, PL_na)))));
}
/*
*************** plperl_call_perl_func(plperl_proc_desc *
*** 1149,1157 ****
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)))));
}
retval = newSVsv(POPs);
--- 1159,1165 ----
LEAVE;
/* XXX need to find a way to assign an errcode here */
ereport(ERROR,
! (errmsg("%s", strip_trailing_ws(SvPV(ERRSV, PL_na)))));
}
retval = newSVsv(POPs);
*************** plperl_call_perl_trigger_func(plperl_pro
*** 1207,1215 ****
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)))));
}
retval = newSVsv(POPs);
--- 1215,1221 ----
LEAVE;
/* XXX need to find a way to assign an errcode here */
ereport(ERROR,
! (errmsg("%s", strip_trailing_ws(SvPV(ERRSV, PL_na)))));
}
retval = newSVsv(POPs);
*************** compile_plperl_function(Oid fn_oid, bool
*** 1492,1497 ****
--- 1498,1504 ----
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,
*************** compile_plperl_function(Oid fn_oid, bool
*** 1500,1505 ****
--- 1507,1518 ----
if (!HeapTupleIsValid(procTup))
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
*************** compile_plperl_function(Oid fn_oid, bool
*** 1731,1736 ****
--- 1744,1752 ----
hash_entry->proc_data = prodesc;
}
+ /* restore previous error callback */
+ error_context_stack = plperl_error_context.previous;
+
ReleaseSysCache(procTup);
return prodesc;
*************** hv_fetch_string(HV *hv, const char *key)
*** 2683,2685 ****
--- 2699,2723 ----
#endif
return hv_fetch(hv, key, klen, 0);
}
+
+ /*
+ * Provide function name for PL/Perl execution errors
+ */
+ static void
+ plperl_exec_callback(void *arg)
+ {
+ if (current_call_data && current_call_data->prodesc &&
+ current_call_data->prodesc->proname)
+ errcontext("PL/Perl function \"%s\"", current_call_data->prodesc->proname);
+ }
+
+ /*
+ * 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);
+ }
Alexey Klyukin wrote:
Attached is a patch (HEAD) that sets errcontext with PL/Perl function
name, making a distinction between compilation and execution stages,
fixes error messages where function name was already included in the
message itself and updates regression tests. I'll appreciate any
suggestions on how to improve it.
Hmm, in plperl_exec_callback(), does the global variable work if you
call one plperl function from another?
--
Alvaro Herrera http://www.CommandPrompt.com/
The PostgreSQL Company - Command Prompt, Inc.
On Jul 21, 2009, at 6:39 PM, Alvaro Herrera wrote:
Alexey Klyukin wrote:
Attached is a patch (HEAD) that sets errcontext with PL/Perl function
name, making a distinction between compilation and execution stages,
fixes error messages where function name was already included in the
message itself and updates regression tests. I'll appreciate any
suggestions on how to improve it.Hmm, in plperl_exec_callback(), does the global variable work if you
call one plperl function from another?
PL/Perl functions can't call each other directly. I don't see any
problems with SPI calls:
test=# create function perl_log1() returns void language plperl as $$
test$# elog(NOTICE, "Test from function one");
test$# $$
test-# ;
CREATE FUNCTION
test=# create function perl_log2() returns void language plperl as $
$
elog
(NOTICE, "Test from function two");
my $rv = spi_exec_query('SELECT * FROM perl_log1()');
$$;
CREATE FUNCTION
test=# select perl_log2();
NOTICE: Test from function two
CONTEXT: PL/Perl function "perl_log2"
NOTICE: Test from function one
CONTEXT: PL/Perl function "perl_log1"
SQL statement "SELECT * FROM perl_log1()"
PL/Perl function "perl_log1"
perl_log2
-----------
(1 row)
--
Alexey Klyukin http://www.CommandPrompt.com
The PostgreSQL Company - Command Prompt, Inc.
Alexey Klyukin wrote:
NOTICE: Test from function one
CONTEXT: PL/Perl function "perl_log1"
SQL statement "SELECT * FROM perl_log1()"
PL/Perl function "perl_log1"
Shouldn't the second "PL/Perl function" line say perl_log2 instead?
--
Alvaro Herrera http://www.CommandPrompt.com/
The PostgreSQL Company - Command Prompt, Inc.
Alexey Klyukin <alexk@commandprompt.com> writes:
On Jul 21, 2009, at 6:39 PM, Alvaro Herrera wrote:
Hmm, in plperl_exec_callback(), does the global variable work if you
call one plperl function from another?
PL/Perl functions can't call each other directly.
Still, it's poor style to rely on the global variable when you don't
have to. Use the error_context.arg field to pass it.
regards, tom lane
On Jul 21, 2009, at 7:20 PM, Alvaro Herrera wrote:
Alexey Klyukin wrote:
NOTICE: Test from function one
CONTEXT: PL/Perl function "perl_log1"
SQL statement "SELECT * FROM perl_log1()"
PL/Perl function "perl_log1"Shouldn't the second "PL/Perl function" line say perl_log2 instead?
Hm, yeah, seems to be a problem. I'll change the callback to avoid
using global data.
--
Alexey Klyukin http://www.CommandPrompt.com
The PostgreSQL Company - Command Prompt, Inc.
On Jul 21, 2009, at 7:47 PM, Alexey Klyukin wrote:
On Jul 21, 2009, at 7:20 PM, Alvaro Herrera wrote:
Alexey Klyukin wrote:
NOTICE: Test from function one
CONTEXT: PL/Perl function "perl_log1"
SQL statement "SELECT * FROM perl_log1()"
PL/Perl function "perl_log1"Shouldn't the second "PL/Perl function" line say perl_log2 instead?
Hm, yeah, seems to be a problem. I'll change the callback to avoid
using global data.
Attached is the updated version of the patch (the original description
is here: http://archives.postgresql.org/pgsql-hackers/2009-07/msg01332.php)
that doesn't use global variables. It also shows the last line of
the context in the example above correctly:
psql (8.5devel)
Type "help" for help.
test=# select perl_log2();
NOTICE: Test from function two
CONTEXT: PL/Perl function "perl_log2"
NOTICE: Test from function one
CONTEXT: PL/Perl function "perl_log1"
SQL statement "SELECT * FROM perl_log1()"
PL/Perl function "perl_log2"
perl_log2
-----------
(1 row)
Attachments:
plperl_error_callback_v2.diffapplication/octet-stream; name=plperl_error_callback_v2.diff; x-unix-mode=0600Download
diff --git a/src/pl/plperl/expected/plperl.out b/src/pl/plperl/expected/plperl.out
index e1b0c75..c8a8fdb 100644
*** a/src/pl/plperl/expected/plperl.out
--- b/src/pl/plperl/expected/plperl.out
*************** CREATE OR REPLACE FUNCTION perl_set() RE
*** 122,129 ****
--- 122,131 ----
$$ 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' },
*************** CREATE OR REPLACE FUNCTION perl_record()
*** 171,176 ****
--- 173,179 ----
$$ 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();
*************** CREATE OR REPLACE FUNCTION perl_record_s
*** 186,191 ****
--- 189,195 ----
$$ 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();
*************** CREATE OR REPLACE FUNCTION perl_record_s
*** 204,215 ****
--- 208,221 ----
$$ 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' },
*************** CREATE OR REPLACE FUNCTION perl_record_s
*** 219,224 ****
--- 225,231 ----
$$ 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();
*************** CREATE OR REPLACE FUNCTION foo_bad() RET
*** 308,318 ****
--- 315,327 ----
$$ 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],
*************** return [
*** 321,336 ****
--- 330,348 ----
$$ 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],
*************** return [
*** 339,344 ****
--- 351,357 ----
$$ 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}
*************** return [
*** 346,351 ****
--- 359,365 ----
$$ 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
--
*************** CREATE OR REPLACE FUNCTION perl_spi_prep
*** 539,542 ****
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.
--- 553,557 ----
return $result;
$$ LANGUAGE plperl;
SELECT perl_spi_prepared_bad(4.35) as "double precision";
! 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 fcb6e8d..1791d3c 100644
*** a/src/pl/plperl/expected/plperl_elog.out
--- b/src/pl/plperl/expected/plperl_elog.out
*************** create or replace function perl_elog(tex
*** 7,12 ****
--- 7,13 ----
$$;
select perl_elog('explicit elog');
NOTICE: explicit elog
+ CONTEXT: PL/Perl function "perl_elog"
perl_elog
-----------
*************** $$;
*** 21,26 ****
--- 22,28 ----
select perl_warn('implicit elog via warn');
NOTICE: implicit elog via warn at line 4.
+ CONTEXT: PL/Perl function "perl_warn"
perl_warn
-----------
*************** create or replace function uses_global()
*** 35,42 ****
return 'uses_global worked';
$$;
! ERROR: creation of Perl function "uses_global" failed: Global symbol "$global" requires explicit package name at line 3.
Global symbol "$other_global" requires explicit package name at line 4.
select uses_global();
ERROR: function uses_global() does not exist
LINE 1: select uses_global();
--- 37,45 ----
return 'uses_global worked';
$$;
! 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 48a4853..b5af566 100644
*** a/src/pl/plperl/expected/plperl_trigger.out
--- b/src/pl/plperl/expected/plperl_trigger.out
*************** BEFORE INSERT OR UPDATE OR DELETE ON tri
*** 53,93 ****
--- 53,127 ----
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 82e2f4b..0a4bb8c 100644
*** a/src/pl/plperl/plperl.c
--- b/src/pl/plperl/plperl.c
*************** static SV **hv_store_string(HV *hv, cons
*** 162,167 ****
--- 162,169 ----
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
*************** plperl_call_handler(PG_FUNCTION_ARGS)
*** 869,875 ****
{
Datum retval;
plperl_call_data *save_call_data;
!
save_call_data = current_call_data;
PG_TRY();
{
--- 871,877 ----
{
Datum retval;
plperl_call_data *save_call_data;
!
save_call_data = current_call_data;
PG_TRY();
{
*************** plperl_create_sub(char *proname, char *s
*** 1019,1027 ****
LEAVE;
ereport(ERROR,
(errcode(ERRCODE_SYNTAX_ERROR),
! errmsg("creation of Perl function \"%s\" failed: %s",
! proname,
! strip_trailing_ws(SvPV(ERRSV, PL_na)))));
}
/*
--- 1021,1027 ----
LEAVE;
ereport(ERROR,
(errcode(ERRCODE_SYNTAX_ERROR),
! errmsg("%s", strip_trailing_ws(SvPV(ERRSV, PL_na)))));
}
/*
*************** plperl_call_perl_func(plperl_proc_desc *
*** 1149,1157 ****
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)))));
}
retval = newSVsv(POPs);
--- 1149,1155 ----
LEAVE;
/* XXX need to find a way to assign an errcode here */
ereport(ERROR,
! (errmsg("%s", strip_trailing_ws(SvPV(ERRSV, PL_na)))));
}
retval = newSVsv(POPs);
*************** plperl_call_perl_trigger_func(plperl_pro
*** 1207,1215 ****
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)))));
}
retval = newSVsv(POPs);
--- 1205,1211 ----
LEAVE;
/* XXX need to find a way to assign an errcode here */
ereport(ERROR,
! (errmsg("%s", strip_trailing_ws(SvPV(ERRSV, PL_na)))));
}
retval = newSVsv(POPs);
*************** plperl_func_handler(PG_FUNCTION_ARGS)
*** 1231,1236 ****
--- 1227,1233 ----
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
*************** plperl_func_handler(PG_FUNCTION_ARGS)
*** 1244,1249 ****
--- 1241,1252 ----
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;
*************** plperl_func_handler(PG_FUNCTION_ARGS)
*** 1366,1372 ****
retval = InputFunctionCall(&prodesc->result_in_func, val,
prodesc->result_typioparam, -1);
}
!
if (array_ret == NULL)
SvREFCNT_dec(perlret);
--- 1369,1378 ----
retval = InputFunctionCall(&prodesc->result_in_func, val,
prodesc->result_typioparam, -1);
}
!
! /* Restore the previous error callback */
! error_context_stack = pl_error_context.previous;
!
if (array_ret == NULL)
SvREFCNT_dec(perlret);
*************** plperl_trigger_handler(PG_FUNCTION_ARGS)
*** 1386,1391 ****
--- 1392,1398 ----
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
*************** plperl_trigger_handler(PG_FUNCTION_ARGS)
*** 1401,1406 ****
--- 1408,1419 ----
/* Find or compile the function */
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);
*************** plperl_trigger_handler(PG_FUNCTION_ARGS)
*** 1470,1475 ****
--- 1483,1491 ----
}
retval = PointerGetDatum(trv);
}
+
+ /* Restore the previous error callback */
+ error_context_stack = pl_error_context.previous;
SvREFCNT_dec(svTD);
if (perlret)
*************** compile_plperl_function(Oid fn_oid, bool
*** 1492,1497 ****
--- 1508,1514 ----
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,
*************** compile_plperl_function(Oid fn_oid, bool
*** 1500,1505 ****
--- 1517,1528 ----
if (!HeapTupleIsValid(procTup))
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
*************** compile_plperl_function(Oid fn_oid, bool
*** 1731,1736 ****
--- 1754,1762 ----
hash_entry->proc_data = prodesc;
}
+ /* restore previous error callback */
+ error_context_stack = plperl_error_context.previous;
+
ReleaseSysCache(procTup);
return prodesc;
*************** hv_fetch_string(HV *hv, const char *key)
*** 2683,2685 ****
--- 2709,2733 ----
#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);
+ }
On Tue, 2009-07-21 at 20:54 +0300, Alexey Klyukin wrote:
Attached is the updated version of the patch (the original description
is here: http://archives.postgresql.org/pgsql-hackers/2009-07/msg01332.php)
that doesn't use global variables.
Patch looks OK.
But for extra credit, couldn't we code it so that the context is set
before the PL handler is called, so that we get this functionality into
all PLs at once?
Peter Eisentraut <peter_e@gmx.net> writes:
But for extra credit, couldn't we code it so that the context is set
before the PL handler is called, so that we get this functionality into
all PLs at once?
FWIW, I don't particularly agree with that --- there is no reason to
suppose that all PLs will want to do this exactly the same way. Even
if they did, the amount of code shared would only be a few lines.
It would likely end up being *more* code not less by the time you'd
found a way to do it in common (since e.g. the function caches would
not be the same for all PLs, if they even had one).
regards, tom lane
On tis, 2009-09-15 at 11:32 -0400, Tom Lane wrote:
Peter Eisentraut <peter_e@gmx.net> writes:
But for extra credit, couldn't we code it so that the context is set
before the PL handler is called, so that we get this functionality into
all PLs at once?FWIW, I don't particularly agree with that --- there is no reason to
suppose that all PLs will want to do this exactly the same way.
I'd imagine that we simply set the context to "$language function
$name", probably in fmgr_info_other_lang(). If a language wants more
than that, it can set another level of context. Of course this way we
would not save much code in, say, PL/Perl, but all the other PLs that
are currently not using this stuff at all would get it for free.
Peter Eisentraut <peter_e@gmx.net> writes:
On tis, 2009-09-15 at 11:32 -0400, Tom Lane wrote:
FWIW, I don't particularly agree with that --- there is no reason to
suppose that all PLs will want to do this exactly the same way.
I'd imagine that we simply set the context to "$language function
$name", probably in fmgr_info_other_lang(). If a language wants more
than that, it can set another level of context.
So if we want to emit something like "$language function $name line $lineno",
that now has to be two separate lines of context? There'd be no clean way
for the PL to suppress the one it doesn't really need.
Of course this way we
would not save much code in, say, PL/Perl, but all the other PLs that
are currently not using this stuff at all would get it for free.
It would be very far from being "for free", because there's no
inexpensive way for a general-purpose hook to get hold of either
$language or $name without knowing anything about the internals of
the PL. It would have to fetch the relevant pg_language and pg_proc
rows, the former being unnecessary for the PL itself, and the latter
being almost certainly redundant with what the PL is doing. You could
eliminate the performance objection perhaps by fetching the rows only
if the context hook is actually called, but then you have added
failure modes that weren't there before (if the fetch fails for some
reason).
Also, there is noplace to establish the hook anyway (without adding
another layer of call overhead). fmgr_info cannot do it, because
it's not in the actual runtime call chain.
Between the expense, the low return, and the high probability of not
being exactly what's wanted, I don't think this seems like a good
design choice.
regards, tom lane
From the patch review group this evening, courtesy of Webb Sprague and
Brent Dombrowski. I'm replying on their behalf so that this response
is in the correct thread.
Looks like Peter also reviewed, but I'm forwarding this on anyway.
(Note: Problem running regressions because make check doesn't descend
automatically into the plperl -- we built with --with-perl
successfully, but it doesn't change the behavior of make check.
However, the tests do work with patch.)
Per the wiki guidelines:
== Submission review ==
* Is the patch in the standard form?
Yes,
* Does it apply cleanly to the current CVS HEAD?
Yes
* Does it include reasonable tests, docs, etc?
Inline comments suffice.
== Usability review ==
Read what the patch is supposed to do, and consider:
* Does the patch actually implement that?
Yes, built in to the expected test output.
* Do we want that?
Yes, based on the patch to Python that does similar stuff.
* Do we already have it?
No
* Does it follow SQL spec, or the community-agreed behavior?
There was extensive discussion on the list about the desirability of
the context messages, and the community seems to agree in the utility
* Are there dangers?
No. (??)
* Have all the bases been covered?
We guess...
== Feature test ==
Apply the patch, compile it and test:
* Does the feature work as advertised?
Make check passes, and expected output is provided (problem with
automatically checking all)
* Are there corner cases the author has failed to consider?
Can't think of any -- popping off an empty stack or such worries me,
but I couldn't determine if there was a risk of this in the code.
== Performance review ==
* Does the patch slow down simple tests?
No.
* If it claims to improve performance, does it?
NA
* Does it slow down other things?
No (?)
== Coding review ==
Read the changes to the code in detail and consider:
* Does it follow the project
[http://developer.postgresql.org/pgdocs/postgres/source.html coding
guidelines]?
Yes
* Are there portability issues?
None that we can see
* Will it work on Windows/BSD etc?
No issues we can see
* Are the comments sufficient and accurate?
Yes
* Does it do what it says, correctly?
Yes
* Does it produce compiler warnings?
No
* Can you make it crash?
No
== Architecture review ==
Consider the changes to the code in the context of the project as a whole:
* Is everything done in a way that fits together coherently with other
features/modules?
Yes
* Are there interdependencies than can cause problems?
No, it is a simple set of changes all within plperl
On Tue, 2009-07-21 at 20:54 +0300, Alexey Klyukin wrote:
Attached is the updated version of the patch (the original description
is here: http://archives.postgresql.org/pgsql-hackers/2009-07/msg01332.php)
that doesn't use global variables. It also shows the last line of
the context in the example above correctly:
committed
Selena Deckelmann escribi�:
From the patch review group this evening, courtesy of Webb Sprague and
Brent Dombrowski. I'm replying on their behalf so that this response
is in the correct thread.Looks like Peter also reviewed, but I'm forwarding this on anyway.
(Note: Problem running regressions because make check doesn't descend
automatically into the plperl -- we built with --with-perl
successfully, but it doesn't change the behavior of make check.
However, the tests do work with patch.)
You have to use "make -C src/pl installcheck".
--
Alvaro Herrera http://www.CommandPrompt.com/
PostgreSQL Replication, Consulting, Custom Development, 24x7 support