# Functions whose names begin with underscore are internal helper functions
# for this file, and are not to be used by outside callers.
+use Config;
use strict;
eval { require POSIX; import POSIX 'locale_h'; };
# systems
return if $locale =~ / ^ pig $ /ix;
+ # Certain platforms have a crippled locale system in which setlocale
+ # returns success for just about any possible locale name, but if anything
+ # actually happens as a result of the call, it is that the underlying
+ # locale is set to a system default, likely C or C.UTF-8. We can't test
+ # such systems fully, but we shouldn't disable the user from using
+ # locales, as it may work out for them (or not).
+ return if defined $Config{d_setlocale_accepts_any_locale_name}
+ && $locale !~ / ^ (?: C | POSIX | C\.UTF-8 ) $/ix;
+
$categories = [ $categories ] unless ref $categories;
my $badutf8 = 0;
# denoting a single category (either name or number). No conversion into
# a number is done in this case.
- use Config;
+ # khw cargo-culted the '?' in the pattern on the next line.
+ return 0 if $Config{ccflags} =~ /\bD?NO_LOCALE\b/;
+
+ # If we can't load the POSIX XS module, we can't have locales even if they
+ # normally would be available
+ return 0 if ! defined &DynaLoader::boot_DynaLoader;
- return 0 unless $Config{d_setlocale}
- # I (khw) cargo-culted the '?' in the pattern on the
- # next line.
- && $Config{ccflags} !~ /\bD?NO_LOCALE\b/
- && $has_locale_h;
+ if (! $Config{d_setlocale}) {
+ return 0 if $Config{ccflags} =~ /\bD?NO_POSIX_2008_LOCALE\b/;
+ return 0 unless $Config{d_newlocale};
+ return 0 unless $Config{d_uselocale};
+ return 0 unless $Config{d_duplocale};
+ return 0 unless $Config{d_freelocale};
+ }
# Done with the global possibilities. Now check if any passed in category
# is disabled.
my @Locale;
_trylocale("C", $categories, \@Locale, $allow_incompatible);
_trylocale("POSIX", $categories, \@Locale, $allow_incompatible);
+
+ if ($Config{d_has_C_UTF8} eq 'true') {
+ _trylocale("C.UTF-8", $categories, \@Locale, $allow_incompatible);
+ }
+
+ # There's no point in looking at anything more if we know that setlocale
+ # will return success on any garbage or non-garbage name.
+ return sort @Locale if defined $Config{d_setlocale_accepts_any_locale_name};
+
foreach (1..16) {
_trylocale("ISO8859-$_", $categories, \@Locale, $allow_incompatible);
_trylocale("iso8859$_", $categories, \@Locale, $allow_incompatible);
return $ret;
}
-sub find_utf8_ctype_locale (;$) { # Return the name of a locale that core Perl
- # thinks is a UTF-8 LC_CTYPE locale.
+sub find_utf8_ctype_locales (;$) { # Return the names of the locales that core
+ # Perl thinks are UTF-8 LC_CTYPE locales.
# Optional parameter is a reference to a
# list of locales to try; if omitted, this
# tries all locales it can find on the
return unless locales_enabled('LC_CTYPE');
my $locales_ref = shift;
+ my @return;
if (! defined $locales_ref) {
}
foreach my $locale (@$locales_ref) {
- return $locale if is_locale_utf8($locale);
+ push @return, $locale if is_locale_utf8($locale);
+ }
+
+ return @return;
+}
+
+
+sub find_utf8_ctype_locale (;$) { # Return the name of a locale that core Perl
+ # thinks is a UTF-8 LC_CTYPE non-turkic
+ # locale.
+ # Optional parameter is a reference to a
+ # list of locales to try; if omitted, this
+ # tries all locales it can find on the
+ # platform
+ my $try_locales_ref = shift;
+
+ my @utf8_locales = find_utf8_ctype_locales($try_locales_ref);
+ my @turkic_locales = find_utf8_turkic_locales($try_locales_ref);
+
+ my %seen_turkic;
+
+ # Create undef elements in the hash for turkic locales
+ @seen_turkic{@turkic_locales} = ();
+
+ foreach my $locale (@utf8_locales) {
+ return $locale unless exists $seen_turkic{$locale};
}
return;
}
+sub find_utf8_turkic_locales (;$) {
+
+ # Return the name of all the locales that core Perl thinks are UTF-8
+ # Turkic LC_CTYPE. Optional parameter is a reference to a list of locales
+ # to try; if omitted, this tries all locales it can find on the platform
+
+ my @return;
+
+ return unless locales_enabled('LC_CTYPE');
+
+ my $save_locale = setlocale(&POSIX::LC_CTYPE());
+ foreach my $locale (find_utf8_ctype_locales(shift)) {
+ use locale;
+ setlocale(&POSIX::LC_CTYPE(), $locale);
+ push @return, $locale if uc('i') eq "\x{130}";
+ }
+ setlocale(&POSIX::LC_CTYPE(), $save_locale);
+
+ return @return;
+}
+
+sub find_utf8_turkic_locale (;$) {
+ my @turkics = find_utf8_turkic_locales(shift);
+
+ return unless @turkics;
+ return $turkics[0]
+}
+
+
# returns full path to the directory containing the current source
# file, inspired by mauke's Dir::Self
sub _source_location {
https://perl5.git.perl.org / perl5.git / blobdiff