diff options
| -rw-r--r-- | src/pl/plperl/SPI.xs | 53 | ||||
| -rw-r--r-- | 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); |