diff --git a/src/pl/plperl/SPI.xs b/src/pl/plperl/SPI.xs index 6b8dcf6..0447c50 100644 --- a/src/pl/plperl/SPI.xs +++ b/src/pl/plperl/SPI.xs @@ -41,7 +41,7 @@ do_plperl_return_next(SV *sv) FlushErrorState(); /* Punt the error to Perl */ - croak("%s", edata->message); + croak_cstr(edata->message); } PG_END_TRY(); } diff --git a/src/pl/plperl/Util.xs b/src/pl/plperl/Util.xs index b2e0dfc..45924f1 100644 --- a/src/pl/plperl/Util.xs +++ b/src/pl/plperl/Util.xs @@ -36,31 +36,18 @@ static void do_util_elog(int level, SV *msg) { - MemoryContext oldcontext = CurrentMemoryContext; char * volatile cmsg = NULL; - PG_TRY(); + if (level < ERROR) { cmsg = sv2cstr(msg); elog(level, "%s", cmsg); pfree(cmsg); - } - PG_CATCH(); + }else { - ErrorData *edata; - - /* Must reset elog.c's state */ - MemoryContextSwitchTo(oldcontext); - edata = CopyErrorData(); - FlushErrorState(); - - if (cmsg) - pfree(cmsg); - /* Punt the error to Perl */ - croak("%s", edata->message); + croak_cstr(SvPV_nolen(msg)); } - PG_END_TRY(); } static text * diff --git a/src/pl/plperl/expected/plperl_elog.out b/src/pl/plperl/expected/plperl_elog.out index c447fa2..99d447a 100644 --- a/src/pl/plperl/expected/plperl_elog.out +++ b/src/pl/plperl/expected/plperl_elog.out @@ -104,3 +104,10 @@ PL/Perl function "indirect_die_caller" 2 (1 row) +create or replace function perl_test_err() returns text +language plperl as $$ + elog(ERROR, "Česká chyba ěščřžýáíé"); +$$; +select perl_test_err(); +ERROR: Česká chyba ěščřžýáíé at line 2. +CONTEXT: PL/Perl function "perl_test_err" diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c index d57189f..d6584ab 100644 --- a/src/pl/plperl/plperl.c +++ b/src/pl/plperl/plperl.c @@ -3005,7 +3005,7 @@ plperl_spi_exec(char *query, int limit) SPI_restore_connection(); /* Punt the error to Perl */ - croak("%s", edata->message); + croak_cstr(edata->message); /* Can't get here, but keep compiler quiet */ return NULL; @@ -3238,7 +3238,7 @@ plperl_spi_query(char *query) SPI_restore_connection(); /* Punt the error to Perl */ - croak("%s", edata->message); + croak_cstr(edata->message); /* Can't get here, but keep compiler quiet */ return NULL; @@ -3324,7 +3324,7 @@ plperl_spi_fetchrow(char *cursor) SPI_restore_connection(); /* Punt the error to Perl */ - croak("%s", edata->message); + croak_cstr(edata->message); /* Can't get here, but keep compiler quiet */ return NULL; @@ -3499,7 +3499,7 @@ plperl_spi_prepare(char *query, int argc, SV **argv) SPI_restore_connection(); /* Punt the error to Perl */ - croak("%s", edata->message); + croak_cstr(edata->message); /* Can't get here, but keep compiler quiet */ return NULL; @@ -3640,7 +3640,7 @@ plperl_spi_exec_prepared(char *query, HV *attr, int argc, SV **argv) SPI_restore_connection(); /* Punt the error to Perl */ - croak("%s", edata->message); + croak_cstr(edata->message); /* Can't get here, but keep compiler quiet */ return NULL; @@ -3769,7 +3769,7 @@ plperl_spi_query_prepared(char *query, int argc, SV **argv) SPI_restore_connection(); /* Punt the error to Perl */ - croak("%s", edata->message); + croak_cstr(edata->message); /* Can't get here, but keep compiler quiet */ return NULL; diff --git a/src/pl/plperl/plperl_helpers.h b/src/pl/plperl/plperl_helpers.h index c1c7c29..febdd33 100644 --- a/src/pl/plperl/plperl_helpers.h +++ b/src/pl/plperl/plperl_helpers.h @@ -121,4 +121,38 @@ cstr2sv(const char *str) return sv; } +/* + * croak converting from a string assumed to be in the current database's + * encoding to UTF-8 for croak(ing). + */ +static inline void +croak_cstr(const char *str) +{ +#ifdef croak_sv + /* + * without the sv_2mortal the sv never seems to be freed + */ + + croak_sv(sv_2mortal(cstr2sv(str))); +#else + /* + * croak_sv() is not available in older perls and croak() does not play + * nicely with utf8 at all + * + * If we try: + * const char *utf8_str = utf_e2u(str); + * SV *sv = get_sv("@", TRUE); + * sv_setpvf(sv, "%s", utf8_str); + * SvUTF8_on(sv); + * + * Line numbers in error messages get thrown off. + * Instead of "at line 2." we get "at -e line 58." for example. + * + * All we can do is croak() with the potentially improperly encoded string. + */ + + croak("%s", str); +#endif +} + #endif /* PL_PERL_HELPERS_H */ diff --git a/src/pl/plperl/sql/plperl_elog.sql b/src/pl/plperl/sql/plperl_elog.sql index 032fd8b..db3ae8a 100644 --- a/src/pl/plperl/sql/plperl_elog.sql +++ b/src/pl/plperl/sql/plperl_elog.sql @@ -76,3 +76,10 @@ return $a + $b; $$; select indirect_die_caller(); + +create or replace function perl_test_err() returns text +language plperl as $$ + elog(ERROR, "Česká chyba ěščřžýáíé"); +$$; + +select perl_test_err();