This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Move more locale code to t/loc_tools.pl
authorKarl Williamson <public@khwilliamson.com>
Fri, 24 Jan 2014 20:58:13 +0000 (13:58 -0700)
committerKarl Williamson <public@khwilliamson.com>
Mon, 27 Jan 2014 18:07:17 +0000 (11:07 -0700)
This trivial code to determine if a locale is a utf8 one or not is
currently used in just one place, but future commits will use it in
others, and will make it non-trivial, and non-obvious.

lib/locale.t
t/loc_tools.pl

index 43e660f..3180a69 100644 (file)
@@ -606,14 +606,12 @@ foreach my $Locale (@Locale) {
     # documented deficiencies.  Non- UTF-8 locales are tested only under plain
     # 'use locale', as otherwise we would have to convert everything in them
     # to Unicode.
-    # The locale name doesn't necessarily have to have "utf8" in it to be a
-    # UTF-8 locale, but it works mostly.
-    my $is_utf8_locale = $Locale =~ /UTF-?8/i;
 
     my %UPPER = ();     # All alpha X for which uc(X) == X and lc(X) != X
     my %lower = ();     # All alpha X for which lc(X) == X and uc(X) != X
     my %BoThCaSe = ();  # All alpha X for which uc(X) == lc(X) == X
 
+    my $is_utf8_locale = is_locale_utf8($Locale);
     if (! $is_utf8_locale) {
         use locale;
         @{$posixes{'word'}} = grep /\w/, map { chr } 0..255;
index a3d8407..9136302 100644 (file)
@@ -191,6 +191,33 @@ sub find_locales {  # Returns an array of all the locales we found on the
 
 }
 
+sub is_locale_utf8 ($) { # Return a boolean as to if core Perl thinks the input
+                        # is a UTF-8 locale
+    my $locale = shift;
+
+    # The locale name doesn't necessarily have to have "utf8" in it to be a
+    # UTF-8 locale, but it works, mostly.
+    return $locale =~ /UTF-?8/i;
+}
+
+sub find_utf8_locale (;$) { # Return the name of locale that core Perl thinks
+                            # is a UTF-8 locale.  Optional second parameter is
+                            # a reference to a list of locales to try; if
+                            # omitted, this tries all locales it can find on
+                            # the platform
+    my $locales_ref = shift;
+    if (! defined $locales_ref) {
+        my @locales = find_locales();
+        $locales_ref = \@locales;
+    }
+
+    foreach my $locale (@$locales_ref) {
+        return $locale if is_locale_utf8($locale);
+    }
+
+    return;
+}
+
 1
 
 # Format of data is: locale_name, language_codes, country_codes, encodings