X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=locale.c;h=5282146f66e24c91377e0b56566c2adc3ff5439e;hb=0159f81bfe8e286f119bb9a00f0567234a23235b;hp=db9edb74d5699aaa6602a4ae3959484b0c797b27;hpb=077a72a91697decae2d5c3d613a9ee58ec6493c1;p=p5sagit%2Fp5-mst-13.2.git diff --git a/locale.c b/locale.c index db9edb7..5282146 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'. * @@ -72,6 +80,7 @@ S_stdize_locale(pTHX_ char *locs) return locs; } +#endif void Perl_set_numeric_radix(pTHX) @@ -120,7 +129,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(); } @@ -165,7 +175,7 @@ void Perl_new_ctype(pTHX_ char *newctype) { #ifdef USE_LOCALE_CTYPE - + dVAR; int i; for (i = 0; i < 256; i++) { @@ -178,6 +188,7 @@ Perl_new_ctype(pTHX_ char *newctype) } #endif /* USE_LOCALE_CTYPE */ + (void)newctype; } /* @@ -204,7 +215,8 @@ 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'). */ @@ -216,7 +228,7 @@ Perl_new_collate(pTHX_ char *newcoll) 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,41 +483,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; + if (codeset) + utf8locale = (ibcmp(codeset, "UTF-8", 5) == 0 || + ibcmp(codeset, "UTF8", 4) == 0); #if defined(USE_LOCALE) -#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; + 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 (lc_all) + utf8locale = (ibcmp(lc_all, "UTF-8", 5) == 0 || + ibcmp(lc_all, "UTF8", 4) == 0); + } #endif /* USE_LOCALE */ - if (wantutf8) - PL_wantutf8 = TRUE; + 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) @@ -538,6 +569,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) { @@ -561,7 +593,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); @@ -588,3 +620,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: + */