3333 * ENHANCEMENTS, OR MODIFICATIONS.
3434 *
3535 * IDENTIFICATION
36- * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.100 2006/01/2803:28:15 neilc Exp $
36+ * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.101 2006/01/2816:20:31 adunstan Exp $
3737 *
3838 **********************************************************************/
3939
4545#include <ctype.h>
4646#include <fcntl.h>
4747#include <unistd.h>
48+ #include <locale.h>
4849
4950/* postgreSQL stuff */
5051#include "commands/trigger.h"
@@ -263,6 +264,45 @@ plperl_init_interp(void)
263264"" ,"-e" ,PERLBOOT
264265};
265266
267+ #ifdef WIN32
268+
269+ /*
270+ * The perl library on startup does horrible things like call
271+ * setlocale(LC_ALL,""). We have protected against that on most
272+ * platforms by setting the environment appropriately. However, on
273+ * Windows, setlocale() does not consult the environment, so we need
274+ * to save the existing locale settings before perl has a chance to
275+ * mangle them and restore them after its dirty deeds are done.
276+ *
277+ * MSDN ref:
278+ * http://msdn.microsoft.com/library/en-us/vclib/html/_crt_locale.asp
279+ *
280+ * It appears that we only need to do this on interpreter startup, and
281+ * subsequent calls to the interpreter don't mess with the locale
282+ * settings.
283+ *
284+ * We restore them using Perl's POSIX::setlocale() function so that
285+ * Perl doesn't have a different idea of the locale from Postgres.
286+ *
287+ */
288+
289+ char * loc ;
290+ char * save_collate ,* save_ctype ,* save_monetary ,* save_numeric ,* save_time ;
291+ char buf [1024 ];
292+
293+ loc = setlocale (LC_COLLATE ,NULL );
294+ save_collate = loc ?pstrdup (loc ) :NULL ;
295+ loc = setlocale (LC_CTYPE ,NULL );
296+ save_ctype = loc ?pstrdup (loc ) :NULL ;
297+ loc = setlocale (LC_MONETARY ,NULL );
298+ save_monetary = loc ?pstrdup (loc ) :NULL ;
299+ loc = setlocale (LC_NUMERIC ,NULL );
300+ save_numeric = loc ?pstrdup (loc ) :NULL ;
301+ loc = setlocale (LC_TIME ,NULL );
302+ save_time = loc ?pstrdup (loc ) :NULL ;
303+
304+ #endif
305+
266306plperl_interp = perl_alloc ();
267307if (!plperl_interp )
268308elog (ERROR ,"could not allocate Perl interpreter" );
@@ -272,6 +312,49 @@ plperl_init_interp(void)
272312perl_run (plperl_interp );
273313
274314plperl_proc_hash = newHV ();
315+
316+ #ifdef WIN32
317+
318+ eval_pv ("use POSIX qw(locale_h);" , TRUE);/* croak on failure */
319+
320+ if (save_collate != NULL )
321+ {
322+ snprintf (buf ,sizeof (buf ),"setlocale(%s,'%s');" ,
323+ "LC_COLLATE" ,save_collate );
324+ eval_pv (buf ,TRUE);
325+ pfree (save_collate );
326+ }
327+ if (save_ctype != NULL )
328+ {
329+ snprintf (buf ,sizeof (buf ),"setlocale(%s,'%s');" ,
330+ "LC_CTYPE" ,save_ctype );
331+ eval_pv (buf ,TRUE);
332+ pfree (save_ctype );
333+ }
334+ if (save_monetary != NULL )
335+ {
336+ snprintf (buf ,sizeof (buf ),"setlocale(%s,'%s');" ,
337+ "LC_MONETARY" ,save_monetary );
338+ eval_pv (buf ,TRUE);
339+ pfree (save_monetary );
340+ }
341+ if (save_numeric != NULL )
342+ {
343+ snprintf (buf ,sizeof (buf ),"setlocale(%s,'%s');" ,
344+ "LC_NUMERIC" ,save_numeric );
345+ eval_pv (buf ,TRUE);
346+ pfree (save_numeric );
347+ }
348+ if (save_time != NULL )
349+ {
350+ snprintf (buf ,sizeof (buf ),"setlocale(%s,'%s');" ,
351+ "LC_TIME" ,save_time );
352+ eval_pv (buf ,TRUE);
353+ pfree (save_time );
354+ }
355+
356+ #endif
357+
275358}
276359
277360