X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/d6b7ef8642dbff7f74dde11fd4995a37e8f38c04..1946a0741a168241d8fbd229705465c825727649:/locale.c diff --git a/locale.c b/locale.c index 2c84ab5..77a83fd 100644 --- a/locale.c +++ b/locale.c @@ -1,6 +1,7 @@ /* locale.c * - * Copyright (c) 2001-2002, Larry Wall + * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, + * 2000, 2001, 2002, 2003, 2005, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -17,6 +18,10 @@ * nef aear, si nef aearon! */ +/* utility functions for handling locale-specific stuff like what + * character represents the decimal point. + */ + #include "EXTERN.h" #define PERL_IN_LOCALE_C #include "perl.h" @@ -29,6 +34,9 @@ # include #endif +#include "reentr.h" + +#if defined(USE_LOCALE_NUMERIC) || defined(USE_LOCALE_COLLATE) /* * Standardize the locale name from a string returned by 'setlocale'. * @@ -45,24 +53,19 @@ STATIC char * S_stdize_locale(pTHX_ char *locs) { - char *s; + const char *s = strchr(locs, '='); bool okay = TRUE; - if ((s = strchr(locs, '='))) { - char *t; - + if (s) { + const char * const t = strchr(s, '.'); okay = FALSE; - if ((t = strchr(s, '.'))) { - char *u; - - if ((u = strchr(t, '\n'))) { - - if (u[1] == 0) { - STRLEN len = u - s; - Move(s + 1, locs, len, char); - locs[len] = 0; - okay = TRUE; - } + if (t) { + const char * const u = strchr(t, '\n'); + if (u && (u[1] == 0)) { + const STRLEN len = u - s; + Move(s + 1, locs, len, char); + locs[len] = 0; + okay = TRUE; } } } @@ -72,6 +75,7 @@ S_stdize_locale(pTHX_ char *locs) return locs; } +#endif void Perl_set_numeric_radix(pTHX) @@ -103,7 +107,7 @@ Perl_set_numeric_radix(pTHX) * Set up for a new numeric locale. */ void -Perl_new_numeric(pTHX_ char *newnum) +Perl_new_numeric(pTHX_ const char *newnum) { #ifdef USE_LOCALE_NUMERIC @@ -120,7 +124,8 @@ Perl_new_numeric(pTHX_ char *newnum) if (! PL_numeric_name || strNE(PL_numeric_name, newnum)) { Safefree(PL_numeric_name); PL_numeric_name = stdize_locale(savepv(newnum)); - PL_numeric_standard = (strEQ(newnum, "C") || strEQ(newnum, "POSIX")); + PL_numeric_standard = ((*newnum == 'C' && newnum[1] == '\0') + || strEQ(newnum, "POSIX")); PL_numeric_local = TRUE; set_numeric_radix(); } @@ -162,10 +167,10 @@ Perl_set_numeric_local(pTHX) * Set up for a new ctype locale. */ void -Perl_new_ctype(pTHX_ char *newctype) +Perl_new_ctype(pTHX_ const char *newctype) { #ifdef USE_LOCALE_CTYPE - + dVAR; int i; for (i = 0; i < 256; i++) { @@ -178,13 +183,14 @@ Perl_new_ctype(pTHX_ char *newctype) } #endif /* USE_LOCALE_CTYPE */ + PERL_UNUSED_ARG(newctype); } /* * Set up for a new collation locale. */ void -Perl_new_collate(pTHX_ char *newcoll) +Perl_new_collate(pTHX_ const char *newcoll) { #ifdef USE_LOCALE_COLLATE @@ -204,19 +210,20 @@ Perl_new_collate(pTHX_ char *newcoll) ++PL_collation_ix; Safefree(PL_collation_name); PL_collation_name = stdize_locale(savepv(newcoll)); - PL_collation_standard = (strEQ(newcoll, "C") || strEQ(newcoll, "POSIX")); + PL_collation_standard = ((*newcoll == 'C' && newcoll[1] == '\0') + || strEQ(newcoll, "POSIX")); { /* 2: at most so many chars ('a', 'b'). */ /* 50: surely no system expands a char more. */ #define XFRMBUFSIZE (2 * 50) char xbuf[XFRMBUFSIZE]; - Size_t fa = strxfrm(xbuf, "a", XFRMBUFSIZE); - Size_t fb = strxfrm(xbuf, "ab", XFRMBUFSIZE); - SSize_t mult = fb - fa; + const Size_t fa = strxfrm(xbuf, "a", XFRMBUFSIZE); + const Size_t fb = strxfrm(xbuf, "ab", XFRMBUFSIZE); + const SSize_t mult = fb - fa; if (mult < 1) Perl_croak(aTHX_ "strxfrm() gets absurd"); - PL_collxfrm_base = (fa > mult) ? (fa - mult) : 0; + PL_collxfrm_base = (fa > (Size_t)mult) ? (fa - mult) : 0; PL_collxfrm_mult = mult; } } @@ -471,39 +478,60 @@ Perl_init_i18nl10n(pTHX_ int printwarn) #endif /* USE_LOCALE */ +#ifdef USE_PERLIO { - bool wantutf8 = FALSE; + /* Set PL_utf8locale to TRUE if using PerlIO _and_ + any of the following are true: + - nl_langinfo(CODESET) contains /^utf-?8/i + - $ENV{LC_ALL} contains /^utf-?8/i + - $ENV{LC_CTYPE} contains /^utf-?8/i + - $ENV{LANG} contains /^utf-?8/i + The LC_ALL, LC_CTYPE, LANG obey the usual override + hierarchy of locale environment variables. (LANGUAGE + affects only LC_MESSAGES only under glibc.) (If present, + it overrides LC_MESSAGES for GNU gettext, and it also + can have more than one locale, separated by spaces, + in case you need to know.) + If PL_utf8locale and PL_unicode (set by -C or by $ENV{PERL_UNICODE}) + are true, perl.c:S_parse_body() will turn on the PerlIO :utf8 layer + on STDIN, STDOUT, STDERR, _and_ the default open discipline. + */ + bool utf8locale = FALSE; char *codeset = NULL; #if defined(HAS_NL_LANGINFO) && defined(CODESET) codeset = nl_langinfo(CODESET); #endif - if (codeset && - (ibcmp(codeset, "UTF-8", 5) == 0 || - ibcmp(codeset, "UTF8", 4) == 0)) - wantutf8 = TRUE; -#ifdef __GLIBC__ - if (!wantutf8 && language && - (ibcmp(language, "UTF-8", 5) == 0 || - ibcmp(language, "UTF8", 4) == 0)) - wantutf8 = TRUE; -#endif - if (!wantutf8 && lc_all && - (ibcmp(lc_all, "UTF-8", 5) == 0 || - ibcmp(lc_all, "UTF8", 4) == 0)) - wantutf8 = TRUE; + if (codeset) + utf8locale = (ibcmp(codeset, "UTF-8", 5) == 0 || + ibcmp(codeset, "UTF8", 4) == 0); +#if defined(USE_LOCALE) + else { /* nl_langinfo(CODESET) is supposed to correctly + * interpret the locale environment variables, + * but just in case it fails, let's do this manually. */ + if (lang) + utf8locale = (ibcmp(lang, "UTF-8", 5) == 0 || + ibcmp(lang, "UTF8", 4) == 0); #ifdef USE_LOCALE_CTYPE - if (!wantutf8 && curctype && - (ibcmp(curctype, "UTF-8", 5) == 0 || - ibcmp(curctype, "UTF8", 4) == 0)) - wantutf8 = TRUE; + if (curctype) + utf8locale = (ibcmp(curctype, "UTF-8", 5) == 0 || + ibcmp(curctype, "UTF8", 4) == 0); #endif - if (!wantutf8 && lang && - (ibcmp(lang, "UTF-8", 5) == 0 || - ibcmp(lang, "UTF8", 4) == 0)) - wantutf8 = TRUE; - if (wantutf8) - PL_wantutf8 = TRUE; + if (lc_all) + utf8locale = (ibcmp(lc_all, "UTF-8", 5) == 0 || + ibcmp(lc_all, "UTF8", 4) == 0); + } +#endif /* USE_LOCALE */ + if (utf8locale) + PL_utf8locale = TRUE; } + /* Set PL_unicode to $ENV{PERL_UNICODE} if using PerlIO. + This is an alternative to using the -C command line switch + (the -C if present will override this). */ + { + const char *p = PerlEnv_getenv("PERL_UNICODE"); + PL_unicode = p ? parse_unicode_opts(&p) : 0; + } +#endif #ifdef USE_LOCALE_CTYPE if (curctype != NULL) @@ -536,6 +564,7 @@ Perl_init_i18nl14n(pTHX_ int printwarn) * The real transformed data begins at offset sizeof(collationix). * Please see sv_collxfrm() to see how this is used. */ + char * Perl_mem_collxfrm(pTHX_ const char *s, STRLEN len, STRLEN *xlen) { @@ -559,7 +588,7 @@ Perl_mem_collxfrm(pTHX_ const char *s, STRLEN len, STRLEN *xlen) xused = strxfrm(xbuf + xout, s + xin, xAlloc - xout); if (xused == -1) goto bad; - if (xused < xAlloc - xout) + if ((STRLEN)xused < xAlloc - xout) break; xAlloc = (2 * xAlloc) + 1; Renew(xbuf, xAlloc, char); @@ -586,3 +615,12 @@ Perl_mem_collxfrm(pTHX_ const char *s, STRLEN len, STRLEN *xlen) #endif /* USE_LOCALE_COLLATE */ +/* + * Local variables: + * c-indentation-style: bsd + * c-basic-offset: 4 + * indent-tabs-mode: t + * End: + * + * ex: set ts=8 sts=4 sw=4 noet: + */