[perl-Gtk2] Fix compatibility with perl 5.20 and non-dot locales



commit 02a7052603306cca8e1b910e3cfe8c8677ee0354
Author: Torsten Schönfeld <kaffeetisch gmx de>
Date:   Wed Jun 25 21:27:51 2014 +0200

    Fix compatibility with perl 5.20 and non-dot locales
    
    In locales with something else than a dot as the decimal separator, the
    combination of perl >= 5.20 and Gtk2 lead to errors wherever perl tried to
    parse version numbers, as in "use 5.8.0" or "use Encode 0.5".  Fix by making
    sure we notify perl when the locale might have changed behind its back.

 NEWS        |    1 +
 lib/Gtk2.pm |   30 ++++++++++++++++++++++++++++++
 2 files changed, 31 insertions(+), 0 deletions(-)
---
diff --git a/NEWS b/NEWS
index 97ce172..064ea63 100644
--- a/NEWS
+++ b/NEWS
@@ -1,6 +1,7 @@
 Overview of changes in Gtk2 <next>
 ==================================
 
+* Fix compatibility with perl 5.20 and non-dot locales.
 * Disable some tests that are known to behave erratically in certain
   environments.  They are still available in the "xt" directory, but they will
   not be run by default.
diff --git a/lib/Gtk2.pm b/lib/Gtk2.pm
index 3373387..2f22e2e 100644
--- a/lib/Gtk2.pm
+++ b/lib/Gtk2.pm
@@ -98,6 +98,36 @@ Gtk2->bootstrap ($VERSION);
 our @EXPORT_OK = map { @$_ } values %Gtk2::EXPORT_TAGS;
 $Gtk2::EXPORT_TAGS{all} = \ EXPORT_OK;
 
+# Compatibility with perl 5.20 and non-dot locales.  Wrap all functions that
+# might end up calling setlocale() such that POSIX::setlocale() is also called
+# to ensure perl knows about the current locale.  See the discussion in
+# <https://rt.perl.org//Public/Bug/Display.html?id=121930>,
+# <https://rt.perl.org/Public/Bug/Display.html?id=121317>,
+# <https://rt.perl.org/Public/Bug/Display.html?id=120723>.
+if ($^V ge v5.20.0) {
+  require POSIX;
+  no strict 'refs';
+  no warnings 'redefine';
+
+  my $disable_setlocale = 0;
+  my $orig = \&Gtk2::disable_setlocale;
+  *{Gtk2::disable_setlocale} = sub {
+    $disable_setlocale = 1;
+    $orig->(@_);
+  };
+
+  # gtk_init_with_args is not wrapped.
+  foreach my $function (qw/Gtk2::init Gtk2::init_check Gtk2::parse_args/) {
+    my $orig = \&{$function};
+    *{$function} = sub {
+      if (!$disable_setlocale) {
+        POSIX::setlocale (POSIX::LC_ALL (), '');
+      }
+      $orig->(@_);
+    };
+  }
+}
+
 # Names "STOP" and "PROPAGATE" here are per the GtkWidget event signal
 # descriptions.  In some other flavours of signals the jargon is "handled"
 # instead of "stop".  "Handled" matches g_signal_accumulator_true_handled(),


[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]