Ensure correct locale is used when executing plperl Newer versions of libperl, via plperl, call uselocale() which has the effect of changing the current locale away from the global locale underneath postgres. This can result in, among other infelicities, localeconv() grabbing the wrong locale for numeric and monetary symbols and formatting. Fix that by arranging to capture the perl locale and swapping with the global locale as appropriate when entering and exiting libperl. Importantly, this dance is also needed when exiting perl via SPI calls made while executing perl. Backpatch to all supported versions. Author: Joe Conway Reviewed-By: Tom Lane and Heikki Linnakangas Reported by: Guido Brugnara Discussion: https://postgr.es/m/flat/17946-3e84cb577e9551c3%40postgresql.org Backpatch-through: 11 diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c index 8638642..9831361 100644 *** a/src/pl/plperl/plperl.c --- b/src/pl/plperl/plperl.c *************** typedef struct plperl_array_info *** 223,228 **** --- 223,233 ---- static HTAB *plperl_interp_hash = NULL; static HTAB *plperl_proc_hash = NULL; static plperl_interp_desc *plperl_active_interp = NULL; + /* + * Newer versions of perl call uselocale() to switch away from + * the global locale used by the backend. Store that here. + */ + static locale_t perl_locale_obj = LC_GLOBAL_LOCALE; /* If we have an unassigned "held" interpreter, it's stored here */ static PerlInterpreter *plperl_held_interp = NULL; *************** static char *setlocale_perl(int category *** 302,307 **** --- 307,314 ---- #define setlocale_perl(a,b) Perl_setlocale(a,b) #endif /* defined(WIN32) && PERL_VERSION_LT(5, 28, 0) */ + static void plperl_xact_callback(XactEvent event, void *arg); + /* * Decrement the refcount of the given SV within the active Perl interpreter * *************** _PG_init(void) *** 482,487 **** --- 489,508 ---- */ plperl_held_interp = plperl_init_interp(); + /* + * Grab a copy of perl locale in use, and switch back + * to the global one. We will need to switch back and + * forth, such that the current locale is perl's whenever + * we are about to evaluate perl code, and the global + * locale whenever we return to Postgres. Note that using + * SPI to execute SQL counts as returning to Postgres, + * albeit recursively. + */ + perl_locale_obj = uselocale(LC_GLOBAL_LOCALE); + + /* Arrange to restore the global locale in case of ERROR */ + RegisterXactCallback(plperl_xact_callback, NULL); + inited = true; } *************** plperl_trusted_init(void) *** 962,967 **** --- 983,991 ---- char *key; I32 klen; + /* ensure the perl locale is in use */ + uselocale(perl_locale_obj); + /* use original require while we set up */ PL_ppaddr[OP_REQUIRE] = pp_require_orig; PL_ppaddr[OP_DOFILE] = pp_require_orig; *************** plperl_trusted_init(void) *** 1028,1033 **** --- 1052,1060 ---- errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))), errcontext("while executing plperl.on_plperl_init"))); } + + /* switch back to the global locale */ + perl_locale_obj = uselocale(LC_GLOBAL_LOCALE); } *************** plperl_untrusted_init(void) *** 1039,1044 **** --- 1066,1074 ---- { dTHX; + /* ensure the perl locale is in use */ + uselocale(perl_locale_obj); + /* * Nothing to do except execute plperl.on_plperlu_init */ *************** plperl_untrusted_init(void) *** 1051,1056 **** --- 1081,1089 ---- errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))), errcontext("while executing plperl.on_plperlu_init"))); } + + /* switch back to the global locale */ + perl_locale_obj = uselocale(LC_GLOBAL_LOCALE); } *************** plperl_call_handler(PG_FUNCTION_ARGS) *** 1856,1861 **** --- 1889,1897 ---- plperl_interp_desc *volatile oldinterp = plperl_active_interp; plperl_call_data this_call_data; + /* ensure the perl locale is in use */ + uselocale(perl_locale_obj); + /* Initialize current-call status record */ MemSet(&this_call_data, 0, sizeof(this_call_data)); this_call_data.fcinfo = fcinfo; *************** plperl_call_handler(PG_FUNCTION_ARGS) *** 1882,1887 **** --- 1918,1926 ---- } PG_END_TRY(); + /* switch back to the global locale */ + perl_locale_obj = uselocale(LC_GLOBAL_LOCALE); + return retval; } *************** plperl_inline_handler(PG_FUNCTION_ARGS) *** 1902,1907 **** --- 1941,1949 ---- plperl_call_data this_call_data; ErrorContextCallback pl_error_context; + /* ensure the perl locale is in use */ + uselocale(perl_locale_obj); + /* Initialize current-call status record */ MemSet(&this_call_data, 0, sizeof(this_call_data)); *************** plperl_inline_handler(PG_FUNCTION_ARGS) *** 1975,1980 **** --- 2017,2025 ---- error_context_stack = pl_error_context.previous; + /* switch back to the global locale */ + perl_locale_obj = uselocale(LC_GLOBAL_LOCALE); + PG_RETURN_VOID(); } *************** plperl_validator(PG_FUNCTION_ARGS) *** 2045,2051 **** --- 2090,2102 ---- /* Postpone body checks if !check_function_bodies */ if (check_function_bodies) { + /* ensure the perl locale is in use */ + uselocale(perl_locale_obj); + (void) compile_plperl_function(funcoid, is_trigger, is_event_trigger); + + /* switch back to the global locale */ + perl_locale_obj = uselocale(LC_GLOBAL_LOCALE); } /* the result of a validator is ignored */ *************** plperl_spi_exec(char *query, int limit) *** 3153,3160 **** --- 3204,3218 ---- pg_verifymbstr(query, strlen(query), false); + /* switch back to the global locale */ + perl_locale_obj = uselocale(LC_GLOBAL_LOCALE); + spi_rv = SPI_execute(query, current_call_data->prodesc->fn_readonly, limit); + + /* ensure the perl locale is in use */ + uselocale(perl_locale_obj); + ret_hv = plperl_spi_execute_fetch_result(SPI_tuptable, SPI_processed, spi_rv); *************** plperl_spi_exec(char *query, int limit) *** 3177,3182 **** --- 3235,3243 ---- MemoryContextSwitchTo(oldcontext); CurrentResourceOwner = oldowner; + /* ensure the perl locale is in use */ + uselocale(perl_locale_obj); + /* Punt the error to Perl */ croak_cstr(edata->message); *************** plperl_spi_query(char *query) *** 3426,3431 **** --- 3487,3495 ---- /* Make sure the query is validly encoded */ pg_verifymbstr(query, strlen(query), false); + /* switch back to the global locale */ + perl_locale_obj = uselocale(LC_GLOBAL_LOCALE); + /* Create a cursor for the query */ plan = SPI_prepare(query, 0, NULL); if (plan == NULL) *************** plperl_spi_query(char *query) *** 3441,3446 **** --- 3505,3513 ---- PinPortal(portal); + /* ensure the perl locale is in use */ + uselocale(perl_locale_obj); + /* Commit the inner transaction, return to outer xact context */ ReleaseCurrentSubTransaction(); MemoryContextSwitchTo(oldcontext); *************** plperl_spi_query(char *query) *** 3460,3465 **** --- 3527,3535 ---- MemoryContextSwitchTo(oldcontext); CurrentResourceOwner = oldowner; + /* ensure the perl locale is in use */ + uselocale(perl_locale_obj); + /* Punt the error to Perl */ croak_cstr(edata->message); *************** plperl_spi_prepare(char *query, int argc *** 3640,3645 **** --- 3710,3718 ---- /* Make sure the query is validly encoded */ pg_verifymbstr(query, strlen(query), false); + /* switch back to the global locale */ + perl_locale_obj = uselocale(LC_GLOBAL_LOCALE); + /************************************************************ * Prepare the plan and check for errors ************************************************************/ *************** plperl_spi_prepare(char *query, int argc *** 3649,3654 **** --- 3722,3730 ---- elog(ERROR, "SPI_prepare() failed:%s", SPI_result_code_string(SPI_result)); + /* ensure the perl locale is in use */ + uselocale(perl_locale_obj); + /************************************************************ * Save the plan into permanent memory (right now it's in the * SPI procCxt, which will go away at function end). *************** plperl_spi_prepare(char *query, int argc *** 3697,3702 **** --- 3773,3781 ---- MemoryContextSwitchTo(oldcontext); CurrentResourceOwner = oldowner; + /* ensure the perl locale is in use */ + uselocale(perl_locale_obj); + /* Punt the error to Perl */ croak_cstr(edata->message); *************** plperl_spi_exec_prepared(char *query, HV *** 3798,3807 **** --- 3877,3893 ---- /************************************************************ * go ************************************************************/ + /* switch back to the global locale */ + perl_locale_obj = uselocale(LC_GLOBAL_LOCALE); + spi_rv = SPI_execute_plan(qdesc->plan, argvalues, nulls, current_call_data->prodesc->fn_readonly, limit); ret_hv = plperl_spi_execute_fetch_result(SPI_tuptable, SPI_processed, spi_rv); + + /* ensure the perl locale is in use */ + uselocale(perl_locale_obj); + if (argc > 0) { pfree(argvalues); *************** plperl_spi_exec_prepared(char *query, HV *** 3827,3832 **** --- 3913,3921 ---- MemoryContextSwitchTo(oldcontext); CurrentResourceOwner = oldowner; + /* ensure the perl locale is in use */ + uselocale(perl_locale_obj); + /* Punt the error to Perl */ croak_cstr(edata->message); *************** plperl_spi_query_prepared(char *query, i *** 3911,3918 **** --- 4000,4014 ---- /************************************************************ * go ************************************************************/ + /* switch back to the global locale */ + perl_locale_obj = uselocale(LC_GLOBAL_LOCALE); + portal = SPI_cursor_open(NULL, qdesc->plan, argvalues, nulls, current_call_data->prodesc->fn_readonly); + + /* ensure the perl locale is in use */ + uselocale(perl_locale_obj); + if (argc > 0) { pfree(argvalues); *************** plperl_spi_query_prepared(char *query, i *** 3945,3950 **** --- 4041,4049 ---- MemoryContextSwitchTo(oldcontext); CurrentResourceOwner = oldowner; + /* ensure the perl locale is in use */ + uselocale(perl_locale_obj); + /* Punt the error to Perl */ croak_cstr(edata->message); *************** plperl_util_elog(int level, SV *msg) *** 4064,4070 **** --- 4163,4177 ---- PG_TRY(); { cmsg = sv2cstr(msg); + + /* switch back to the global locale */ + perl_locale_obj = uselocale(LC_GLOBAL_LOCALE); + elog(level, "%s", cmsg); + + /* ensure the perl locale is in use */ + uselocale(perl_locale_obj); + pfree(cmsg); } PG_CATCH(); *************** plperl_util_elog(int level, SV *msg) *** 4079,4084 **** --- 4186,4194 ---- if (cmsg) pfree(cmsg); + /* ensure the perl locale is in use */ + uselocale(perl_locale_obj); + /* Punt the error to Perl */ croak_cstr(edata->message); } *************** setlocale_perl(int category, char *local *** 4245,4247 **** --- 4355,4368 ---- return RETVAL; } #endif /* defined(WIN32) && PERL_VERSION_LT(5, 28, 0) */ + + /* + * plperl_xact_callback --- cleanup at main-transaction end. + */ + static void + plperl_xact_callback(XactEvent event, void *arg) + { + /* ensure global locale is the current locale */ + if (uselocale((locale_t) 0) != LC_GLOBAL_LOCALE) + perl_locale_obj = uselocale(LC_GLOBAL_LOCALE); + }