plperl / locale / win32

I was reminded today of the outstanding issue with plperl setting the
locale on Windows, and our environment workaround not working there.

There has been NO response to the bug I filed (#38193) at rt.perl.org
about this issue.

The attached patch adapts one I previously tested as working, but
instead of calling setlocale() directly it gets perl to do it so that
perl and postgres have the same idea of what the locale should be, which
should meet Greg's and Tom's objection to the previous patch. My Windows
machine is currently doing other work, so I can't test right now - if
someone else could that would be nice.

cheers

andrew
*** plperl.c    2006-01-08 17:27:52.000000000 -0500
--- plperl.c.locfix    2006-01-20 19:50:04.000000000 -0500
***************
*** 45,50 ****
--- 45,51 ----
  #include <ctype.h>
  #include <fcntl.h>
  #include <unistd.h>
+ #include <locale.h>

  /* postgreSQL stuff */
  #include "commands/trigger.h"
***************
*** 252,257 ****
--- 253,297 ----
          "", "-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 excisting 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 appaers 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");
***************
*** 261,266 ****
--- 301,349 ----
      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
+
  }