From 4bbcc6e8db9fbcaee50f943cf9676737ff07d048 Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Sun, 8 Jul 2001 01:14:02 +0000 Subject: [PATCH] Add I18N::Langinfo, which is basically a wrapper around nl_langinfo(), which is an additional way to query locale specific information. p4raw-id: //depot/perl@11207 --- Configure | 7 +- MANIFEST | 4 + ext/I18N/Langinfo/Langinfo.pm | 194 ++++++++++ ext/I18N/Langinfo/Langinfo.t | 35 ++ ext/I18N/Langinfo/Langinfo.xs | 832 ++++++++++++++++++++++++++++++++++++++++++ ext/I18N/Langinfo/Makefile.PL | 17 + pod/perl572delta.pod | 4 + pod/perllocale.pod | 41 ++- 8 files changed, 1127 insertions(+), 7 deletions(-) create mode 100644 ext/I18N/Langinfo/Langinfo.pm create mode 100644 ext/I18N/Langinfo/Langinfo.t create mode 100644 ext/I18N/Langinfo/Langinfo.xs create mode 100644 ext/I18N/Langinfo/Makefile.PL diff --git a/Configure b/Configure index 87547b0..08afc72 100755 --- a/Configure +++ b/Configure @@ -20,7 +20,7 @@ # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ # -# Generated on Wed Jul 4 20:30:41 EET DST 2001 [metaconfig 3.0 PL70] +# Generated on Sun Jul 8 03:26:11 EET DST 2001 [metaconfig 3.0 PL70] # (with additional metaconfig patches by perlbug@perl.org) cat >c1$$ <= 5.00561) { +#XXX *$AUTOLOAD = sub () { $val }; +#XXX } +#XXX else { + *$AUTOLOAD = sub { $val }; +#XXX } + } + goto &$AUTOLOAD; +} + +bootstrap I18N::Langinfo $VERSION; + +1; +__END__ + +=head1 NAME + +I18N::Langinfo - query locale information + +=head1 SYNOPSIS + + use I18N::Langinfo; + +=head1 DESCRIPTION + +The langinfo() function queries various locale information that +can be used to localize output and user interfaces. + +The following example will import the langinfo() function itself +(implicitly) and (explicitly) three constants to be used as arguments +to langinfo(): a constant for the abbreviated first day of the week (the +numbering starts from Sunday 1) and two more constant for the affirmative +and negative answers for a yes/no question in the current locale. + + use I18N::Langinfo qw(langinfo ABDAY_1 YESSTR NOSTR); + + my ($abday_1, $yesstr, $nostr) = map { langinfo } qw(ABDAY_1 YESSTR NOSTR); + + print "$abday_1? [$yesstr/$nostr] "; + +In other words, in the "C" (or English) locale the above will probably print: + + Sun? [y/n] + +The usually available constants are + + ABDAY_1 ABDAY_2 ABDAY_3 ABDAY_4 ABDAY_5 ABDAY_6 ABDAY_7 + ABMON_1 ABMON_2 ABMON_3 ABMON_4 ABMON_5 ABMON_6 + ABMON_7 ABMON_8 ABMON_9 ABMON_10 ABMON_11 ABMON_12 + DAY_1 DAY_2 DAY_3 DAY_4 DAY_5 DAY_6 DAY_7 + MON_1 MON_2 MON_3 MON_4 MON_5 MON_6 + MON_7 MON_8 MON_9 MON_10 MON_11 MON_12 + +for abbreviated and full length days of the week and months of the year, + + D_T_FMT D_FMT T_FMT + +for the date-time, date, and time formats used by the strftime() function +(see L, and also L), + + AM_STR PM_STR T_FMT_AMPM + +for the locales for which it makes sense to have ante meridiem and post +meridiem time formats, + + CODESET CRNCYSTR RADIXCHAR + +for the character code set being used (such as "ISO8859-1", "cp850", +"koi8-r", "sjis", "utf8", etc.), for the currency string, for the +radix character (yes, this is redundant with POSIX::localeconv()) + + YESSTR YESEXPR NOSTR NOEXPR + +for the affirmative and negative responses and expressions, and + + ERA ERA_D_FMT ERA_D_T_FMT ETA_T_FMT + +for the Japanese Emperor eras (naturally only defined under Japanese locales). + +See your L for more information about the available +constants. (Often this means having to look directly at the +F C header file.) + +=head2 EXPORT + +Nothing is exported by default. + +=head1 SEE ALSO + +L, L, L, L. + +The langinfo() is just a wrapper for the C nl_langinfo() interface. + +=head1 AUTHOR + +Jarkko Hietaniemi, Ejhi@hut.fiE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2001 by Jarkko Hietaniemi + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/ext/I18N/Langinfo/Langinfo.t b/ext/I18N/Langinfo/Langinfo.t new file mode 100644 index 0000000..bb74f36 --- /dev/null +++ b/ext/I18N/Langinfo/Langinfo.t @@ -0,0 +1,35 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + require Config; import Config; + if ($Config{'extensions'} !~ m!\bI18N/Langinfo\b!) { + print "1..0\n"; + exit 0; + } +} + + +use I18N::Langinfo qw(langinfo ABDAY_1 DAY_1 ABMON_1 MON_1 RADIXCHAR); + +# use the "C" locale + +print "1..5\n"; + +print "not " unless langinfo(ABDAY_1) eq "Sun"; +print "ok 1\n"; + +print "not " unless langinfo(DAY_1) eq "Sunday"; +print "ok 2\n"; + +print "not " unless langinfo(ABMON_1) eq "Jan"; +print "ok 3\n"; + +print "not " unless langinfo(MON_1) eq "January"; +print "ok 4\n"; + +print "not " unless langinfo(RADIXCHAR) eq "."; +print "ok 5\n"; + + + diff --git a/ext/I18N/Langinfo/Langinfo.xs b/ext/I18N/Langinfo/Langinfo.xs new file mode 100644 index 0000000..3422eed --- /dev/null +++ b/ext/I18N/Langinfo/Langinfo.xs @@ -0,0 +1,832 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#ifdef I_LANGINFO +# include +#endif + +#define PERL_constant_NOTFOUND 1 +#define PERL_constant_NOTDEF 2 +#define PERL_constant_ISIV 3 +#define PERL_constant_ISNO 4 +#define PERL_constant_ISNV 5 +#define PERL_constant_ISPV 6 +#define PERL_constant_ISPVN 7 +#define PERL_constant_ISSV 8 +#define PERL_constant_ISUNDEF 9 +#define PERL_constant_ISUV 10 +#define PERL_constant_ISYES 11 + +#ifndef NVTYPE +typedef double NV; /* 5.6 and later define NVTYPE, and typedef NV to it. */ +#endif +static int +constant_5 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + DAY_1 DAY_2 DAY_3 DAY_4 DAY_5 DAY_6 DAY_7 D_FMT MON_1 MON_2 MON_3 MON_4 + MON_5 MON_6 MON_7 MON_8 MON_9 NOSTR T_FMT */ + /* Offset 4 gives the best switch position. */ + switch (name[4]) { + case '1': + if (memEQ(name, "DAY_1", 5)) { + /* ^ */ +#ifdef DAY_1 + *iv_return = DAY_1; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "MON_1", 5)) { + /* ^ */ +#ifdef MON_1 + *iv_return = MON_1; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '2': + if (memEQ(name, "DAY_2", 5)) { + /* ^ */ +#ifdef DAY_2 + *iv_return = DAY_2; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "MON_2", 5)) { + /* ^ */ +#ifdef MON_2 + *iv_return = MON_2; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '3': + if (memEQ(name, "DAY_3", 5)) { + /* ^ */ +#ifdef DAY_3 + *iv_return = DAY_3; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "MON_3", 5)) { + /* ^ */ +#ifdef MON_3 + *iv_return = MON_3; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '4': + if (memEQ(name, "DAY_4", 5)) { + /* ^ */ +#ifdef DAY_4 + *iv_return = DAY_4; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "MON_4", 5)) { + /* ^ */ +#ifdef MON_4 + *iv_return = MON_4; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '5': + if (memEQ(name, "DAY_5", 5)) { + /* ^ */ +#ifdef DAY_5 + *iv_return = DAY_5; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "MON_5", 5)) { + /* ^ */ +#ifdef MON_5 + *iv_return = MON_5; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '6': + if (memEQ(name, "DAY_6", 5)) { + /* ^ */ +#ifdef DAY_6 + *iv_return = DAY_6; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "MON_6", 5)) { + /* ^ */ +#ifdef MON_6 + *iv_return = MON_6; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '7': + if (memEQ(name, "DAY_7", 5)) { + /* ^ */ +#ifdef DAY_7 + *iv_return = DAY_7; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "MON_7", 5)) { + /* ^ */ +#ifdef MON_7 + *iv_return = MON_7; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '8': + if (memEQ(name, "MON_8", 5)) { + /* ^ */ +#ifdef MON_8 + *iv_return = MON_8; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '9': + if (memEQ(name, "MON_9", 5)) { + /* ^ */ +#ifdef MON_9 + *iv_return = MON_9; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'R': + if (memEQ(name, "NOSTR", 5)) { + /* ^ */ +#ifdef NOSTR + *iv_return = NOSTR; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'T': + if (memEQ(name, "D_FMT", 5)) { + /* ^ */ +#ifdef D_FMT + *iv_return = D_FMT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "T_FMT", 5)) { + /* ^ */ +#ifdef T_FMT + *iv_return = T_FMT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant_6 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + AM_STR MON_10 MON_11 MON_12 NOEXPR PM_STR YESSTR */ + /* Offset 0 gives the best switch position. */ + switch (name[0]) { + case 'A': + if (memEQ(name, "AM_STR", 6)) { + /* ^ */ +#ifdef AM_STR + *iv_return = AM_STR; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'M': + if (memEQ(name, "MON_10", 6)) { + /* ^ */ +#ifdef MON_10 + *iv_return = MON_10; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "MON_11", 6)) { + /* ^ */ +#ifdef MON_11 + *iv_return = MON_11; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "MON_12", 6)) { + /* ^ */ +#ifdef MON_12 + *iv_return = MON_12; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'N': + if (memEQ(name, "NOEXPR", 6)) { + /* ^ */ +#ifdef NOEXPR + *iv_return = NOEXPR; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'P': + if (memEQ(name, "PM_STR", 6)) { + /* ^ */ +#ifdef PM_STR + *iv_return = PM_STR; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'Y': + if (memEQ(name, "YESSTR", 6)) { + /* ^ */ +#ifdef YESSTR + *iv_return = YESSTR; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant_7 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + ABDAY_1 ABDAY_2 ABDAY_3 ABDAY_4 ABDAY_5 ABDAY_6 ABDAY_7 ABMON_1 ABMON_2 + ABMON_3 ABMON_4 ABMON_5 ABMON_6 ABMON_7 ABMON_8 ABMON_9 CODESET D_T_FMT + THOUSEP YESEXPR */ + /* Offset 6 gives the best switch position. */ + switch (name[6]) { + case '1': + if (memEQ(name, "ABDAY_1", 7)) { + /* ^ */ +#ifdef ABDAY_1 + *iv_return = ABDAY_1; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "ABMON_1", 7)) { + /* ^ */ +#ifdef ABMON_1 + *iv_return = ABMON_1; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '2': + if (memEQ(name, "ABDAY_2", 7)) { + /* ^ */ +#ifdef ABDAY_2 + *iv_return = ABDAY_2; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "ABMON_2", 7)) { + /* ^ */ +#ifdef ABMON_2 + *iv_return = ABMON_2; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '3': + if (memEQ(name, "ABDAY_3", 7)) { + /* ^ */ +#ifdef ABDAY_3 + *iv_return = ABDAY_3; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "ABMON_3", 7)) { + /* ^ */ +#ifdef ABMON_3 + *iv_return = ABMON_3; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '4': + if (memEQ(name, "ABDAY_4", 7)) { + /* ^ */ +#ifdef ABDAY_4 + *iv_return = ABDAY_4; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "ABMON_4", 7)) { + /* ^ */ +#ifdef ABMON_4 + *iv_return = ABMON_4; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '5': + if (memEQ(name, "ABDAY_5", 7)) { + /* ^ */ +#ifdef ABDAY_5 + *iv_return = ABDAY_5; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "ABMON_5", 7)) { + /* ^ */ +#ifdef ABMON_5 + *iv_return = ABMON_5; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '6': + if (memEQ(name, "ABDAY_6", 7)) { + /* ^ */ +#ifdef ABDAY_6 + *iv_return = ABDAY_6; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "ABMON_6", 7)) { + /* ^ */ +#ifdef ABMON_6 + *iv_return = ABMON_6; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '7': + if (memEQ(name, "ABDAY_7", 7)) { + /* ^ */ +#ifdef ABDAY_7 + *iv_return = ABDAY_7; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "ABMON_7", 7)) { + /* ^ */ +#ifdef ABMON_7 + *iv_return = ABMON_7; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '8': + if (memEQ(name, "ABMON_8", 7)) { + /* ^ */ +#ifdef ABMON_8 + *iv_return = ABMON_8; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '9': + if (memEQ(name, "ABMON_9", 7)) { + /* ^ */ +#ifdef ABMON_9 + *iv_return = ABMON_9; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'P': + if (memEQ(name, "THOUSEP", 7)) { + /* ^ */ +#ifdef THOUSEP + *iv_return = THOUSEP; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'R': + if (memEQ(name, "YESEXPR", 7)) { + /* ^ */ +#ifdef YESEXPR + *iv_return = YESEXPR; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'T': + if (memEQ(name, "CODESET", 7)) { + /* ^ */ +#ifdef CODESET + *iv_return = CODESET; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "D_T_FMT", 7)) { + /* ^ */ +#ifdef D_T_FMT + *iv_return = D_T_FMT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant_8 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + ABMON_10 ABMON_11 ABMON_12 CRNCYSTR */ + /* Offset 7 gives the best switch position. */ + switch (name[7]) { + case '0': + if (memEQ(name, "ABMON_10", 8)) { + /* ^ */ +#ifdef ABMON_10 + *iv_return = ABMON_10; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '1': + if (memEQ(name, "ABMON_11", 8)) { + /* ^ */ +#ifdef ABMON_11 + *iv_return = ABMON_11; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '2': + if (memEQ(name, "ABMON_12", 8)) { + /* ^ */ +#ifdef ABMON_12 + *iv_return = ABMON_12; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'R': + if (memEQ(name, "CRNCYSTR", 8)) { + /* ^ */ +#ifdef CRNCYSTR + *iv_return = CRNCYSTR; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant_9 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + ERA_D_FMT ERA_T_FMT RADIXCHAR */ + /* Offset 4 gives the best switch position. */ + switch (name[4]) { + case 'D': + if (memEQ(name, "ERA_D_FMT", 9)) { + /* ^ */ +#ifdef ERA_D_FMT + *iv_return = ERA_D_FMT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'T': + if (memEQ(name, "ERA_T_FMT", 9)) { + /* ^ */ +#ifdef ERA_T_FMT + *iv_return = ERA_T_FMT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'X': + if (memEQ(name, "RADIXCHAR", 9)) { + /* ^ */ +#ifdef RADIXCHAR + *iv_return = RADIXCHAR; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant (pTHX_ const char *name, STRLEN len, IV *iv_return) { + /* Initially switch on the length of the name. */ + /* When generated this function returned values for the list of names given + in this section of perl code. Rather than manually editing these functions + to add or remove constants, which would result in this comment and section + of code becoming inaccurate, we recommend that you edit this section of + code, and use it to regenerate a new set of constant functions which you + then use to replace the originals. + + Regenerate these constant functions by feeding this entire source file to + perl -x + +#!../../../perl -w +use ExtUtils::Constant qw (constant_types C_constant XS_constant); + +my $types = {map {($_, 1)} qw(IV)}; +my @names = (qw(ABDAY_1 ABDAY_2 ABDAY_3 ABDAY_4 ABDAY_5 ABDAY_6 ABDAY_7 ABMON_1 + ABMON_10 ABMON_11 ABMON_12 ABMON_2 ABMON_3 ABMON_4 ABMON_5 + ABMON_6 ABMON_7 ABMON_8 ABMON_9 ALT_DIGITS AM_STR CODESET + CRNCYSTR DAY_1 DAY_2 DAY_3 DAY_4 DAY_5 DAY_6 DAY_7 D_FMT D_T_FMT + ERA ERA_D_FMT ERA_D_T_FMT ERA_T_FMT MON_1 MON_10 MON_11 MON_12 + MON_2 MON_3 MON_4 MON_5 MON_6 MON_7 MON_8 MON_9 NOEXPR NOSTR + PM_STR RADIXCHAR THOUSEP T_FMT T_FMT_AMPM YESEXPR YESSTR)); + +print constant_types(); # macro defs +foreach (C_constant ("I18N::Langinfo", 'constant', 'IV', $types, undef, 3, @names) ) { + print $_, "\n"; # C constant subs +} +print "#### XS Section:\n"; +print XS_constant ("I18N::Langinfo", $types); +__END__ + */ + + switch (len) { + case 3: + if (memEQ(name, "ERA", 3)) { +#ifdef ERA + *iv_return = ERA; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 5: + return constant_5 (aTHX_ name, iv_return); + break; + case 6: + return constant_6 (aTHX_ name, iv_return); + break; + case 7: + return constant_7 (aTHX_ name, iv_return); + break; + case 8: + return constant_8 (aTHX_ name, iv_return); + break; + case 9: + return constant_9 (aTHX_ name, iv_return); + break; + case 10: + /* Names all of length 10. */ + /* ALT_DIGITS T_FMT_AMPM */ + /* Offset 7 gives the best switch position. */ + switch (name[7]) { + case 'I': + if (memEQ(name, "ALT_DIGITS", 10)) { + /* ^ */ +#ifdef ALT_DIGITS + *iv_return = ALT_DIGITS; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'M': + if (memEQ(name, "T_FMT_AMPM", 10)) { + /* ^ */ +#ifdef T_FMT_AMPM + *iv_return = T_FMT_AMPM; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + break; + case 11: + if (memEQ(name, "ERA_D_T_FMT", 11)) { +#ifdef ERA_D_T_FMT + *iv_return = ERA_D_T_FMT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +MODULE = I18N::Langinfo PACKAGE = I18N::Langinfo + +PROTOTYPES: ENABLE + +void +constant(sv) + PREINIT: +#ifdef dXSTARG + dXSTARG; /* Faster if we have it. */ +#else + dTARGET; +#endif + STRLEN len; + int type; + IV iv; + /* NV nv; Uncomment this if you need to return NVs */ + /* const char *pv; Uncomment this if you need to return PVs */ + INPUT: + SV * sv; + const char * s = SvPV(sv, len); + PPCODE: + /* Change this to constant(aTHX_ s, len, &iv, &nv); + if you need to return both NVs and IVs */ + type = constant(aTHX_ s, len, &iv); + /* Return 1 or 2 items. First is error message, or undef if no error. + Second, if present, is found value */ + switch (type) { + case PERL_constant_NOTFOUND: + sv = sv_2mortal(newSVpvf("%s is not a valid I18N::Langinfo macro", s)); + PUSHs(sv); + break; + case PERL_constant_NOTDEF: + sv = sv_2mortal(newSVpvf( + "Your vendor has not defined I18N::Langinfo macro %s, used", s)); + PUSHs(sv); + break; + case PERL_constant_ISIV: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHi(iv); + break; + /* Uncomment this if you need to return NOs + case PERL_constant_ISNO: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHs(&PL_sv_no); + break; */ + /* Uncomment this if you need to return NVs + case PERL_constant_ISNV: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHn(nv); + break; */ + /* Uncomment this if you need to return PVs + case PERL_constant_ISPV: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHp(pv, strlen(pv)); + break; */ + /* Uncomment this if you need to return PVNs + case PERL_constant_ISPVN: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHp(pv, iv); + break; */ + /* Uncomment this if you need to return SVs + case PERL_constant_ISSV: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHs(sv); + break; */ + /* Uncomment this if you need to return UNDEFs + case PERL_constant_ISUNDEF: + break; */ + /* Uncomment this if you need to return UVs + case PERL_constant_ISUV: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHu((UV)iv); + break; */ + /* Uncomment this if you need to return YESs + case PERL_constant_ISYES: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHs(&PL_sv_yes); + break; */ + default: + sv = sv_2mortal(newSVpvf( + "Unexpected return type %d while processing I18N::Langinfo macro %s, used", + type, s)); + PUSHs(sv); + } + +SV* +langinfo(code) + int code + CODE: + char *s = nl_langinfo(code); + RETVAL = newSVpvn(s, strlen(s)); + OUTPUT: + RETVAL diff --git a/ext/I18N/Langinfo/Makefile.PL b/ext/I18N/Langinfo/Makefile.PL new file mode 100644 index 0000000..aff6f87 --- /dev/null +++ b/ext/I18N/Langinfo/Makefile.PL @@ -0,0 +1,17 @@ +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + 'NAME' => 'I18N::Langinfo', + 'VERSION_FROM' => 'Langinfo.pm', # finds $VERSION + 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1 + ($] >= 5.005 ? ## Add these new keywords supported since 5.005 + (ABSTRACT_FROM => 'Langinfo.pm', # retrieve abstract from module + AUTHOR => 'Jarkko Hietaniemi ') : ()), + 'LIBS' => [''], # e.g., '-lm' + 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' + # Insert -I. if you add *.h files later: + 'INC' => '', # e.g., '-I/usr/include/other' + # Un-comment this if you add C files to link with later: + # 'OBJECT' => '$(O_FILES)', # link all the C files too +); diff --git a/pod/perl572delta.pod b/pod/perl572delta.pod index b75d0d0..636c16a 100644 --- a/pod/perl572delta.pod +++ b/pod/perl572delta.pod @@ -174,6 +174,10 @@ L - generate XS code to import C header constants =item * +L - query locale information + +=item * + L - functions for dealing with RFC3066-style language tags =item * diff --git a/pod/perllocale.pod b/pod/perllocale.pod index f680c73..5232eba 100644 --- a/pod/perllocale.pod +++ b/pod/perllocale.pod @@ -427,6 +427,28 @@ parameters as integers correctly formatted in the current locale: } print "\n"; +=head2 I18::Langinfo + +Another interface for querying locale-dependent information is the +I18N::Langinfo::langinfo() function, available at least in UNIX-like +systems and VMS. + +The following example will import the langinfo() function itself +(implicitly) and (explicitly) three string constants: a string for the +abbreviated first day of the week (the numbering starts from Sunday = +1) and two strings for the affirmative and negative answers for a +yes/no question in the current locale. + + use I18N::Langinfo qw(ABDAY_1 YESSTR NOSTR); + + print ABDAY_1, "? [", YESSTR, "/", NOSTR, "] "; + +In other words, in the "C" (or English) locale the above will print: + + Sun? [y/n] + +See L for more information. + =head1 LOCALE CATEGORIES The following subsections describe basic locale categories. Beyond these, @@ -574,6 +596,8 @@ string formats: print "DECIMAL POINT IS COMMA\n" if $n == (strtod("2,5"))[0]; # Locale-dependent conversion +See also L and C. + =head2 Category LC_MONETARY: Formatting of monetary amounts The C standard defines the C category, but no function @@ -587,6 +611,8 @@ find that the information, voluminous and complex though it may be, still does not quite meet your requirements: currency formatting is a hard nut to crack. +See also L and C. + =head2 LC_TIME Output produced by POSIX::strftime(), which builds a formatted @@ -606,6 +632,9 @@ Note: C isn't needed in this example: as a function that exists only to generate locale-dependent results, strftime() always obeys the current C locale. +See also L and C..C, C..C, +C..C, and C..C; and L. + =head2 Other categories The remaining locale category, C (possibly supplemented @@ -964,12 +993,12 @@ operating system upgrade. =head1 SEE ALSO -L, L, L, -L, L, L, -L, L, L, -L, L, L, -L, L, L, -L. +L, L, L, +L, L, L, +L, L, L, +L, L, L, +L, L, L, +L, L. =head1 HISTORY -- 2.7.4