locale.c revision 7c478bd95313f5f23a4c958a745db2134aa03244
/* locale.c
*
* Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 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.
*
*/
/*
* A Elbereth Gilthoniel,
* silivren penna m�riel
* o menel aglar elenath!
* Na-chaered palan-d�riel
* o galadhremmin ennorath,
* Fanuilos, le linnathon
* nef aear, si nef aearon!
*/
#include "EXTERN.h"
#define PERL_IN_LOCALE_C
#include "perl.h"
#ifdef I_LOCALE
# include <locale.h>
#endif
#ifdef I_LANGINFO
# include <langinfo.h>
#endif
#include "reentr.h"
/*
* Standardize the locale name from a string returned by 'setlocale'.
*
* The standard return value of setlocale() is either
* (1) "xx_YY" if the first argument of setlocale() is not LC_ALL
* (2) "xa_YY xb_YY ..." if the first argument of setlocale() is LC_ALL
* (the space-separated values represent the various sublocales,
* in some unspecificed order)
*
* In some platforms it has a form like "LC_SOMETHING=Lang_Country.866\n",
* which is harmful for further use of the string in setlocale().
*
*/
STATIC char *
{
char *s;
char *t;
if ((t = strchr(s, '.'))) {
char *u;
if ((u = strchr(t, '\n'))) {
if (u[1] == 0) {
}
}
}
}
if (!okay)
return locs;
}
void
{
#ifdef USE_LOCALE_NUMERIC
# ifdef HAS_LOCALECONV
lc = localeconv();
}
else {
if (PL_numeric_radix_sv)
else
}
}
else
# endif /* HAS_LOCALECONV */
#endif /* USE_LOCALE_NUMERIC */
}
/*
* Set up for a new numeric locale.
*/
void
{
#ifdef USE_LOCALE_NUMERIC
if (! newnum) {
if (PL_numeric_name) {
}
return;
}
}
#endif /* USE_LOCALE_NUMERIC */
}
void
{
#ifdef USE_LOCALE_NUMERIC
if (! PL_numeric_standard) {
}
#endif /* USE_LOCALE_NUMERIC */
}
void
{
#ifdef USE_LOCALE_NUMERIC
if (! PL_numeric_local) {
}
#endif /* USE_LOCALE_NUMERIC */
}
/*
* Set up for a new ctype locale.
*/
void
{
#ifdef USE_LOCALE_CTYPE
int i;
for (i = 0; i < 256; i++) {
if (isUPPER_LC(i))
PL_fold_locale[i] = toLOWER_LC(i);
else if (isLOWER_LC(i))
PL_fold_locale[i] = toUPPER_LC(i);
else
PL_fold_locale[i] = i;
}
#endif /* USE_LOCALE_CTYPE */
}
/*
* Set up for a new collation locale.
*/
void
{
#ifdef USE_LOCALE_COLLATE
if (! newcoll) {
if (PL_collation_name) {
}
PL_collxfrm_base = 0;
PL_collxfrm_mult = 2;
return;
}
{
/* 2: at most so many chars ('a', 'b'). */
/* 50: surely no system expands a char more. */
char xbuf[XFRMBUFSIZE];
if (mult < 1)
}
}
#endif /* USE_LOCALE_COLLATE */
}
/*
* Initialize locale awareness.
*/
int
{
int ok = 1;
/* returns
* 1 = set ok or not applicable,
* 0 = fallback to C locale,
* -1 = fallback to C locale failed
*/
#if defined(USE_LOCALE)
#ifdef USE_LOCALE_CTYPE
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
#endif /* USE_LOCALE_NUMERIC */
#ifdef __GLIBC__
#endif
bool setlocale_failure = FALSE;
#ifdef LOCALE_ENVIRON_REQUIRED
/*
* Ultrix setlocale(..., "") fails if there are no environment
* variables from which to get a locale name.
*/
#ifdef LC_ALL
if (lang) {
else
}
if (!setlocale_failure) {
#ifdef USE_LOCALE_CTYPE
if (! (curctype =
? "" : Nullch)))
else
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
if (! (curcoll =
? "" : Nullch)))
else
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
if (! (curnum =
? "" : Nullch)))
else
#endif /* USE_LOCALE_NUMERIC */
}
#endif /* LC_ALL */
#endif /* !LOCALE_ENVIRON_REQUIRED */
#ifdef LC_ALL
#endif /* LC_ALL */
if (!setlocale_failure) {
#ifdef USE_LOCALE_CTYPE
else
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
else
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
else
#endif /* USE_LOCALE_NUMERIC */
}
if (setlocale_failure) {
char *p;
(printwarn &&
if (locwarn) {
#ifdef LC_ALL
"perl: warning: Setting locale failed.\n");
#else /* !LC_ALL */
"perl: warning: Setting locale failed for the categories:\n\t");
#ifdef USE_LOCALE_CTYPE
if (! curctype)
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
if (! curcoll)
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
if (! curnum)
#endif /* USE_LOCALE_NUMERIC */
#endif /* LC_ALL */
"perl: warning: Please check that your locale settings:\n");
#ifdef __GLIBC__
"\tLANGUAGE = %c%s%c,\n",
#endif
"\tLC_ALL = %c%s%c,\n",
#if defined(USE_ENVIRON_ARRAY)
{
char **e;
for (e = environ; *e; e++) {
&& (p = strchr(*e, '=')))
(int)(p - *e), *e, p + 1);
}
}
#else
"\t(possibly more locale environment variables)\n");
#endif
"\tLANG = %c%s%c\n",
" are supported and installed on your system.\n");
}
#ifdef LC_ALL
if (locwarn)
"perl: warning: Falling back to the standard locale (\"C\").\n");
ok = 0;
}
else {
if (locwarn)
"perl: warning: Failed to fall back to the standard locale (\"C\").\n");
ok = -1;
}
#else /* ! LC_ALL */
if (0
#ifdef USE_LOCALE_CTYPE
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
#endif /* USE_LOCALE_NUMERIC */
)
{
if (locwarn)
"perl: warning: Cannot fall back to the standard locale (\"C\").\n");
ok = -1;
}
#endif /* ! LC_ALL */
#ifdef USE_LOCALE_CTYPE
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
#endif /* USE_LOCALE_NUMERIC */
}
else {
#ifdef USE_LOCALE_CTYPE
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
#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;
#if defined(HAS_NL_LANGINFO) && defined(CODESET)
#endif
if (codeset)
#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)
#ifdef USE_LOCALE_CTYPE
if (curctype)
#endif
if (lc_all)
}
#endif /* USE_LOCALE */
if (utf8locale)
}
/* 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). */
{
char *p = PerlEnv_getenv("PERL_UNICODE");
PL_unicode = p ? parse_unicode_opts(&p) : 0;
}
#endif
#ifdef USE_LOCALE_CTYPE
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
#endif /* USE_LOCALE_NUMERIC */
return ok;
}
/* Backwards compatibility. */
int
{
return init_i18nl10n(printwarn);
}
#ifdef USE_LOCALE_COLLATE
/*
* mem_collxfrm() is a bit like strxfrm() but with two important
* differences. First, it handles embedded NULs. Second, it allocates
* a bit more memory than needed for the transformed data itself.
* The real transformed data begins at offset sizeof(collationix).
* Please see sv_collxfrm() to see how this is used.
*/
char *
{
char *xbuf;
/* the first sizeof(collationix) bytes are used by sv_collxfrm(). */
/* the +1 is for the terminating NUL. */
if (! xbuf)
goto bad;
xout = sizeof(PL_collation_ix);
for (;;) {
if (xused == -1)
goto bad;
break;
if (! xbuf)
goto bad;
}
/* Embedded NULs are understood but silently skipped
* because they make no sense in locale collation. */
}
return xbuf;
bad:
*xlen = 0;
return NULL;
}
#endif /* USE_LOCALE_COLLATE */