X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=locale.c;h=145bed79b337dd77baff618c3e215a8b40157aec;hb=075502290ff69af888b5629ff1fecf91d588fbbd;hp=22e903037a4b41d70903a430086c3fee84f04fd8;hpb=be3c0a43e1e6b1244032726df02a3ab450a3c4be;p=p5sagit%2Fp5-mst-13.2.git diff --git a/locale.c b/locale.c index 22e9030..145bed7 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" @@ -25,6 +30,13 @@ # include #endif +#ifdef I_LANGINFO +# include +#endif + +#include "reentr.h" + +#if defined(USE_LOCALE_NUMERIC) || defined(USE_LOCALE_COLLATE) /* * Standardize the locale name from a string returned by 'setlocale'. * @@ -41,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; } } } @@ -68,6 +75,7 @@ S_stdize_locale(pTHX_ char *locs) return locs; } +#endif void Perl_set_numeric_radix(pTHX) @@ -99,15 +107,13 @@ 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 if (! newnum) { - if (PL_numeric_name) { - Safefree(PL_numeric_name); - PL_numeric_name = NULL; - } + Safefree(PL_numeric_name); + PL_numeric_name = NULL; PL_numeric_standard = TRUE; PL_numeric_local = TRUE; return; @@ -116,7 +122,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(); } @@ -158,10 +165,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++) { @@ -174,13 +181,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 @@ -200,19 +208,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; } } @@ -462,21 +471,74 @@ Perl_init_i18nl10n(pTHX_ int printwarn) #ifdef USE_LOCALE_NUMERIC new_numeric(curnum); #endif /* USE_LOCALE_NUMERIC */ + } #endif /* USE_LOCALE */ +#ifdef USE_PERLIO + { + /* 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) + 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 (curctype != NULL) - Safefree(curctype); + if (curctype) + utf8locale = (ibcmp(curctype, "UTF-8", 5) == 0 || + ibcmp(curctype, "UTF8", 4) == 0); +#endif + 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 + Safefree(curctype); #endif /* USE_LOCALE_CTYPE */ #ifdef USE_LOCALE_COLLATE - if (curcoll != NULL) - Safefree(curcoll); + Safefree(curcoll); #endif /* USE_LOCALE_COLLATE */ #ifdef USE_LOCALE_NUMERIC - if (curnum != NULL) - Safefree(curnum); + Safefree(curnum); #endif /* USE_LOCALE_NUMERIC */ return ok; } @@ -497,6 +559,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) { @@ -507,7 +570,7 @@ Perl_mem_collxfrm(pTHX_ const char *s, STRLEN len, STRLEN *xlen) /* the +1 is for the terminating NUL. */ xAlloc = sizeof(PL_collation_ix) + PL_collxfrm_base + (PL_collxfrm_mult * len) + 1; - New(171, xbuf, xAlloc, char); + Newx(xbuf, xAlloc, char); if (! xbuf) goto bad; @@ -520,7 +583,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); @@ -547,3 +610,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: + */