From 4400ca2bada53fedda1c6ac10b3eaacb82e1b33b Mon Sep 17 00:00:00 2001
From: Andrew Dunstan <andrew@dunslane.net>
Date: Sat, 28 Jan 2006 16:20:31 +0000
Subject: [PATCH] Undo perl's nasty locale setting on Windows. Since we can't
 do that as elsewhere by setting the environment appropriately, we make perl
 do it right after interpreter startup by calling its POSIX::setlocale().

---
 src/pl/plperl/plperl.c | 85 +++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 84 insertions(+), 1 deletion(-)

diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index 6310db869e..8d81460fcf 100644
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -33,7 +33,7 @@
  *	  ENHANCEMENTS, OR MODIFICATIONS.
  *
  * IDENTIFICATION
- *	  $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.100 2006/01/28 03:28:15 neilc Exp $
+ *	  $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.101 2006/01/28 16:20:31 adunstan Exp $
  *
  **********************************************************************/
 
@@ -45,6 +45,7 @@
 #include <ctype.h>
 #include <fcntl.h>
 #include <unistd.h>
+#include <locale.h>
 
 /* postgreSQL stuff */
 #include "commands/trigger.h"
@@ -263,6 +264,45 @@ plperl_init_interp(void)
 		"", "-e", PERLBOOT
 	};
 
+#ifdef WIN32
+
+	/* 
+	 * The perl library on startup does horrible things like call
+	 * setlocale(LC_ALL,""). We have protected against that on most
+	 * platforms by setting the environment appropriately. However, on
+	 * Windows, setlocale() does not consult the environment, so we need
+	 * to save the existing locale settings before perl has a chance to 
+	 * mangle them and restore them after its dirty deeds are done.
+	 *
+	 * MSDN ref:
+	 * http://msdn.microsoft.com/library/en-us/vclib/html/_crt_locale.asp
+	 *
+	 * It appears that we only need to do this on interpreter startup, and
+	 * subsequent calls to the interpreter don't mess with the locale
+	 * settings.
+	 *
+	 * We restore them using Perl's POSIX::setlocale() function so that
+	 * Perl doesn't have a different idea of the locale from Postgres.
+	 *
+	 */
+
+	char *loc;
+	char *save_collate, *save_ctype, *save_monetary, *save_numeric, *save_time;
+	char buf[1024];
+
+	loc = setlocale(LC_COLLATE,NULL);
+	save_collate = loc ? pstrdup(loc) : NULL;
+	loc = setlocale(LC_CTYPE,NULL);
+	save_ctype = loc ? pstrdup(loc) : NULL;
+	loc = setlocale(LC_MONETARY,NULL);
+	save_monetary = loc ? pstrdup(loc) : NULL;
+	loc = setlocale(LC_NUMERIC,NULL);
+	save_numeric = loc ? pstrdup(loc) : NULL;
+	loc = setlocale(LC_TIME,NULL);
+	save_time = loc ? pstrdup(loc) : NULL;
+
+#endif
+
 	plperl_interp = perl_alloc();
 	if (!plperl_interp)
 		elog(ERROR, "could not allocate Perl interpreter");
@@ -272,6 +312,49 @@ plperl_init_interp(void)
 	perl_run(plperl_interp);
 
 	plperl_proc_hash = newHV();
+
+#ifdef WIN32
+
+	eval_pv("use POSIX qw(locale_h);", TRUE); /* croak on failure */
+
+	if (save_collate != NULL)
+	{
+		snprintf(buf, sizeof(buf),"setlocale(%s,'%s');",
+				 "LC_COLLATE",save_collate);
+		eval_pv(buf,TRUE);
+		pfree(save_collate);
+	}
+	if (save_ctype != NULL)
+	{
+		snprintf(buf, sizeof(buf),"setlocale(%s,'%s');",
+				 "LC_CTYPE",save_ctype);
+		eval_pv(buf,TRUE);
+		pfree(save_ctype);
+	}
+	if (save_monetary != NULL)
+	{
+		snprintf(buf, sizeof(buf),"setlocale(%s,'%s');",
+				 "LC_MONETARY",save_monetary);
+		eval_pv(buf,TRUE);
+		pfree(save_monetary);
+	}
+	if (save_numeric != NULL)
+	{
+		snprintf(buf, sizeof(buf),"setlocale(%s,'%s');",
+				 "LC_NUMERIC",save_numeric);
+		eval_pv(buf,TRUE);
+		pfree(save_numeric);
+	}
+	if (save_time != NULL)
+	{
+		snprintf(buf, sizeof(buf),"setlocale(%s,'%s');",
+				 "LC_TIME",save_time);
+		eval_pv(buf,TRUE);
+		pfree(save_time);
+	}
+
+#endif
+
 }
 
 
-- 
GitLab