mirrors/postgres
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Fix plperl's elog() function to convert elog(ERROR) into Perl croak(),

Browse Source 
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.
This commit is contained in:
Tom Lane 2004-11-20 19:07:40 +00:00
parent d5013ab50f
commit 193a97c2d3
2 changed files with 74 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
src/pl/plperl/SPI.xs
View File

@ -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

37
src/pl/plperl/plperl.c
View File

@ -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);