From 193a97c2d32afc046ee20f34035906709bf852a0 Mon Sep 17 00:00:00 2001
From: Tom Lane <tgl@sss.pgh.pa.us>
Date: Sat, 20 Nov 2004 19:07:40 +0000
Subject: [PATCH] Fix plperl's elog() function to convert elog(ERROR) into Perl
croak(), rather than longjmp'ing clear out of Perl and thereby leaving Perl
in a broken state. Also some minor prettification of error messages. Still
need to do something with spi_exec_query() error handling.
---
src/pl/plperl/SPI.xs | 53 ++++++++++++++++++++++++++++++++++++------
src/pl/plperl/plperl.c | 37 ++++++++++++++++++++++-------
2 files changed, 74 insertions(+), 16 deletions(-)
diff --git a/src/pl/plperl/SPI.xs b/src/pl/plperl/SPI.xs
index 716d9a1e47b..1a23c0ca25b 100644
--- a/src/pl/plperl/SPI.xs
+++ b/src/pl/plperl/SPI.xs
@@ -10,6 +10,40 @@
#include "spi_internal.h"
+/*
+ * Implementation of plperl's elog() function
+ *
+ * If the error level is less than ERROR, we'll just emit the message and
+ * return. When it is ERROR, elog() will longjmp, which we catch and
+ * turn into a Perl croak(). Note we are assuming that elog() can't have
+ * any internal failures that are so bad as to require a transaction abort.
+ *
+ * This is out-of-line to suppress "might be clobbered by longjmp" warnings.
+ */
+static void
+do_spi_elog(int level, char *message)
+{
+ MemoryContext oldcontext = CurrentMemoryContext;
+
+ PG_TRY();
+ {
+ elog(level, "%s", message);
+ }
+ PG_CATCH();
+ {
+ ErrorData *edata;
+
+ /* Must reset elog.c's state */
+ MemoryContextSwitchTo(oldcontext);
+ edata = CopyErrorData();
+ FlushErrorState();
+
+ /* Punt the error to Perl */
+ croak("%s", edata->message);
+ }
+ PG_END_TRY();
+}
+
MODULE = SPI PREFIX = spi_
@@ -21,8 +55,11 @@ spi_elog(level, message)
int level
char* message
CODE:
- elog(level, message);
-
+ if (level > ERROR) /* no PANIC allowed thanks */
+ level = ERROR;
+ if (level < DEBUG5)
+ level = DEBUG5;
+ do_spi_elog(level, message);
int
spi_DEBUG()
@@ -47,11 +84,13 @@ spi_spi_exec_query(query, ...)
char* query;
PREINIT:
HV *ret_hash;
- int limit=0;
+ int limit = 0;
CODE:
- if (items>2) Perl_croak(aTHX_ "Usage: spi_exec_query(query, limit) or spi_exec_query(query)");
- if (items == 2) limit = SvIV(ST(1));
- ret_hash=plperl_spi_exec(query, limit);
- RETVAL = newRV_noinc((SV*)ret_hash);
+ if (items > 2)
+ croak("Usage: spi_exec_query(query, limit) or spi_exec_query(query)");
+ if (items == 2)
+ limit = SvIV(ST(1));
+ ret_hash = plperl_spi_exec(query, limit);
+ RETVAL = newRV_noinc((SV*) ret_hash);
OUTPUT:
RETVAL
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index fc0a9499188..d2746641852 100644
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -33,13 +33,14 @@
* ENHANCEMENTS, OR MODIFICATIONS.
*
* IDENTIFICATION
- * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.58 2004/11/18 21:35:42 tgl Exp $
+ * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.59 2004/11/20 19:07:40 tgl Exp $
*
**********************************************************************/
#include "postgres.h"
/* system stuff */
+#include <ctype.h>
#include <fcntl.h>
#include <unistd.h>
@@ -281,6 +282,21 @@ plperl_safe_init(void)
}
+/*
+ * Perl likes to put a newline after its error messages; clean up such
+ */
+static char *
+strip_trailing_ws(const char *msg)
+{
+ char *res = pstrdup(msg);
+ int len = strlen(res);
+
+ while (len > 0 && isspace((unsigned char) res[len-1]))
+ res[--len] = '\0';
+ return res;
+}
+
+
static HV *
plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc)
{
@@ -496,7 +512,7 @@ plperl_get_elem(HV *hash, char *key)
{
SV **svp = hv_fetch(hash, key, strlen(key), FALSE);
if (!svp)
- elog(ERROR, "plperl: key '%s' not found", key);
+ elog(ERROR, "plperl: key \"%s\" not found", key);
return SvTYPE(*svp) == SVt_NULL ? NULL : SvPV(*svp, PL_na);
}
@@ -533,7 +549,7 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup, Oid fn_oid)
plkeys = plperl_get_keys(hvNew);
natts = av_len(plkeys) + 1;
if (natts != tupdesc->natts)
- elog(ERROR, "plperl: $_TD->{new} has an incorrect number of keys.");
+ elog(ERROR, "plperl: $_TD->{new} has an incorrect number of keys");
modattrs = palloc0(natts * sizeof(int));
modvalues = palloc0(natts * sizeof(Datum));
@@ -550,7 +566,7 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup, Oid fn_oid)
attn = modattrs[i] = SPI_fnumber(tupdesc, platt);
if (attn == SPI_ERROR_NOATTRIBUTE)
- elog(ERROR, "plperl: invalid attribute `%s' in tuple.", platt);
+ elog(ERROR, "plperl: invalid attribute \"%s\" in tuple", platt);
atti = attn - 1;
plval = plperl_get_elem(hvNew, platt);
@@ -581,7 +597,7 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup, Oid fn_oid)
pfree(modvalues);
pfree(modnulls);
if (rtup == NULL)
- elog(ERROR, "plperl: SPI_modifytuple failed -- error: %d", SPI_result);
+ elog(ERROR, "plperl: SPI_modifytuple failed -- error: %d", SPI_result);
return rtup;
}
@@ -690,7 +706,8 @@ plperl_create_sub(char *s, bool trusted)
PUTBACK;
FREETMPS;
LEAVE;
- elog(ERROR, "creation of function failed: %s", SvPV(ERRSV, PL_na));
+ elog(ERROR, "creation of function failed: %s",
+ strip_trailing_ws(SvPV(ERRSV, PL_na)));
}
/*
@@ -816,7 +833,8 @@ plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo)
PUTBACK;
FREETMPS;
LEAVE;
- elog(ERROR, "error from function: %s", SvPV(ERRSV, PL_na));
+ elog(ERROR, "error from function: %s",
+ strip_trailing_ws(SvPV(ERRSV, PL_na)));
}
retval = newSVsv(POPs);
@@ -860,7 +878,7 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo, S
PUTBACK;
FREETMPS;
LEAVE;
- elog(ERROR, "plperl: didn't get a return item from function");
+ elog(ERROR, "didn't get a return item from trigger function");
}
if (SvTRUE(ERRSV))
@@ -869,7 +887,8 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo, S
PUTBACK;
FREETMPS;
LEAVE;
- elog(ERROR, "plperl: error from function: %s", SvPV(ERRSV, PL_na));
+ elog(ERROR, "error from trigger function: %s",
+ strip_trailing_ws(SvPV(ERRSV, PL_na)));
}
retval = newSVsv(POPs);
--
GitLab