/* 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.
* 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"
#include "reentr.h"
+#if defined(USE_LOCALE_NUMERIC) || defined(USE_LOCALE_COLLATE)
/*
* Standardize the locale name from a string returned by 'setlocale'.
*
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;
}
}
}
return locs;
}
+#endif
void
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;
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();
}
* 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++) {
}
#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
++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 > (Size_t)mult) ? (fa - mult) : 0;
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)
+ 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.
*/
This is an alternative to using the -C command line switch
(the -C if present will override this). */
{
- char *p = PerlEnv_getenv("PERL_UNICODE");
+ const char *p = PerlEnv_getenv("PERL_UNICODE");
PL_unicode = p ? parse_unicode_opts(&p) : 0;
}
#endif
#ifdef USE_LOCALE_CTYPE
- if (curctype != NULL)
- Safefree(curctype);
+ 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;
}
* 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)
{
/* 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;
#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:
+ */