This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add switch_to_globale_locale()
authorKarl Williamson <khw@cpan.org>
Fri, 16 Feb 2018 05:44:24 +0000 (22:44 -0700)
committerKarl Williamson <khw@cpan.org>
Sun, 18 Feb 2018 22:44:23 +0000 (15:44 -0700)
This new API function is for use in applications that call alien library
routines that are expecting the old pre-POSIX 2008 locale functionality,
namely a single global locale accessible via setlocale().

This function converts the calling thread to use that global locale, if
not already there.

dist/ExtUtils-ParseXS/lib/perlxs.pod
embed.fnc
embed.h
locale.c
pod/perlvar.pod
proto.h

index 28f88bc..1419ee0 100644 (file)
@@ -2316,7 +2316,7 @@ operates only on the global locale, whereas each thread has its own
 locale, paying no attention to the global one.  Since converting
 these non-Perl libraries to C<Perl_setlocale> is out of the question,
 there is a new function in v5.28
-C<switch_to_global_locale> that will
+L<C<switch_to_global_locale>|perlapi/switch_to_global_locale> that will
 switch the thread it is called from so that any system C<setlocale>
 calls will have their desired effect.  The function
 L<C<sync_locale>|perlapi/sync_locale> must be called before returning to
index d8f4fd9..e748639 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1309,6 +1309,7 @@ Xpn       |void   |_warn_problematic_locale
 Xp     |void   |set_numeric_underlying
 Xp     |void   |set_numeric_standard
 Xp     |bool   |_is_in_locale_category|const bool compiling|const int category
+Apdn   |void   |switch_to_global_locale
 Apdn   |bool   |sync_locale
 ApMn   |void   |thread_locale_init
 ApMn   |void   |thread_locale_term
diff --git a/embed.h b/embed.h
index e68a733..b417aaf 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define sv_vsetpvf(a,b,c)      Perl_sv_vsetpvf(aTHX_ a,b,c)
 #define sv_vsetpvf_mg(a,b,c)   Perl_sv_vsetpvf_mg(aTHX_ a,b,c)
 #define sv_vsetpvfn(a,b,c,d,e,f,g)     Perl_sv_vsetpvfn(aTHX_ a,b,c,d,e,f,g)
+#define switch_to_global_locale        Perl_switch_to_global_locale
 #define sync_locale            Perl_sync_locale
 #define taint_env()            Perl_taint_env(aTHX)
 #define taint_proper(a,b)      Perl_taint_proper(aTHX_ a,b)
index 8a25629..66a4694 100644 (file)
--- a/locale.c
+++ b/locale.c
@@ -4945,6 +4945,77 @@ Perl_my_strerror(pTHX_ const int errnum)
 
 /*
 
+=for apidoc switch_to_global_locale
+
+On systems without locale support, or on single-threaded builds, or on
+platforms that do not support per-thread locale operations, this function does
+nothing.  On such systems that do have locale support, only a locale global to
+the whole program is available.
+
+On multi-threaded builds on systems that do have per-thread locale operations,
+this function converts the thread it is running in to use the global locale.
+This is for code that has not yet or cannot be updated to handle multi-threaded
+locale operation.  As long as only a single thread is so-converted, everything
+works fine, as all the other threads continue to ignore the global one, so only
+this thread looks at it.
+
+Without this function call, threads that use the L<C<setlocale(3)>> system
+function will not work properly, as all the locale-sensitive functions will
+look at the per-thread locale, and C<setlocale> will have no effect on this
+thread.
+
+Perl code should convert to either call
+L<C<Perl_setlocale>|perlapi/Perl_setlocale> (which is a drop-in for the system
+C<setlocale>) or use the methods given in L<perlcall> to call
+L<C<POSIX::setlocale>|POSIX/setlocale>.  Either one will transparently properly
+handle all cases of single- vs multi-thread, POSIX 2008-supported or not.
+
+Non-Perl libraries, such as C<gtk>, that call the system C<setlocale> can
+continue to work if this function is called before transferring control to the
+library.
+
+Upon return from the code that needs to use the global locale,
+L<C<sync_locale()>|perlapi/sync_locale> should be called to restore the safe
+multi-thread operation.
+
+=cut
+*/
+
+void
+Perl_switch_to_global_locale()
+{
+
+#ifdef USE_THREAD_SAFE_LOCALE
+#  ifdef WIN32
+
+    _configthreadlocale(_DISABLE_PER_THREAD_LOCALE);
+
+#  else
+#    ifdef HAS_QUERYLOCALE
+
+    setlocale(LC_ALL, querylocale(LC_ALL_MASK, uselocale((locale_t) 0)));
+
+#    else
+
+    {
+        unsigned int i;
+
+        for (i = 0; i < LC_ALL_INDEX; i++) {
+            setlocale(categories[i], do_setlocale_r(categories[i], NULL));
+        }
+    }
+
+#    endif
+
+    uselocale(LC_GLOBAL_LOCALE);
+
+#  endif
+#endif
+
+}
+
+/*
+
 =for apidoc sync_locale
 
 L<C<Perl_setlocale>|perlapi/Perl_setlocale> can be used at any time to query or
index 06d1ef9..ba23771 100644 (file)
@@ -2267,7 +2267,7 @@ value is 1) or not (the value is 0).  This variable is always 1 if the
 perl has been compiled without threads.  It is also 1 if this perl is
 using thread-safe locale operations.  Note that an individual thread may
 choose to use the global locale (generally unsafe) by calling
-C<switch_to_global_locale>.  This variable currently is still
+L<perlapi/switch_to_global_locale>.  This variable currently is still
 set to 1 in such threads.
 
 This variable is read-only.
diff --git a/proto.h b/proto.h
index ec5009e..80b9e24 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3513,6 +3513,7 @@ PERL_CALLCONV SV* Perl_swash_init(pTHX_ const char* pkg, const char* name, SV* l
 #define PERL_ARGS_ASSERT_SWASH_INIT    \
        assert(pkg); assert(name); assert(listsv)
 
+PERL_CALLCONV void     Perl_switch_to_global_locale(void);
 PERL_CALLCONV bool     Perl_sync_locale(void);
 PERL_CALLCONV void     Perl_sys_init(int* argc, char*** argv);
 #define PERL_ARGS_ASSERT_SYS_INIT      \