summaryrefslogtreecommitdiff
path: root/ext/I18N
diff options
context:
space:
mode:
authorJarkko Hietaniemi <jhi@iki.fi>2001-07-08 01:14:02 +0000
committerJarkko Hietaniemi <jhi@iki.fi>2001-07-08 01:14:02 +0000
commit4bbcc6e8db9fbcaee50f943cf9676737ff07d048 (patch)
treebe9f6a494439a4a4296335b4bd2be6a1941877ef /ext/I18N
parent1475152f1741f07dd9b54406ebac0872695b59b7 (diff)
downloadperl-4bbcc6e8db9fbcaee50f943cf9676737ff07d048.tar.gz
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
Diffstat (limited to 'ext/I18N')
-rw-r--r--ext/I18N/Langinfo/Langinfo.pm194
-rw-r--r--ext/I18N/Langinfo/Langinfo.t35
-rw-r--r--ext/I18N/Langinfo/Langinfo.xs832
-rw-r--r--ext/I18N/Langinfo/Makefile.PL17
4 files changed, 1078 insertions, 0 deletions
diff --git a/ext/I18N/Langinfo/Langinfo.pm b/ext/I18N/Langinfo/Langinfo.pm
new file mode 100644
index 0000000000..79f8a14e01
--- /dev/null
+++ b/ext/I18N/Langinfo/Langinfo.pm
@@ -0,0 +1,194 @@
+package I18N::Langinfo;
+
+use 5.006;
+use strict;
+use warnings;
+use Carp;
+
+require Exporter;
+require DynaLoader;
+use AutoLoader;
+
+our @ISA = qw(Exporter DynaLoader);
+
+our @EXPORT_OK = qw(
+ langinfo
+ 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
+);
+
+our $VERSION = '0.01';
+
+sub AUTOLOAD {
+ # This AUTOLOAD is used to 'autoload' constants from the constant()
+ # XS function.
+
+ my $constname;
+ our $AUTOLOAD;
+ ($constname = $AUTOLOAD) =~ s/.*:://;
+ croak "&I18N::Langinfo::constant not defined" if $constname eq 'constant';
+ my ($error, $val) = constant($constname);
+ if ($error) { croak $error; }
+ {
+ no strict 'refs';
+ # Fixed between 5.005_53 and 5.005_61
+#XXX if ($] >= 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<POSIX>, and also L<Time::Piece>),
+
+ 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<langinfo(3)> for more information about the available
+constants. (Often this means having to look directly at the
+F<langinfo.h> C header file.)
+
+=head2 EXPORT
+
+Nothing is exported by default.
+
+=head1 SEE ALSO
+
+L<perllocale>, L<POSIX/localeconv>, L<POSIX/setlocale>, L<nl_langinfo(3)>.
+
+The langinfo() is just a wrapper for the C nl_langinfo() interface.
+
+=head1 AUTHOR
+
+Jarkko Hietaniemi, E<lt>jhi@hut.fiE<gt>
+
+=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 0000000000..bb74f36030
--- /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 0000000000..3422eed83c
--- /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 <langinfo.h>
+#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 0000000000..aff6f87107
--- /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 <jhi@hut.fi>') : ()),
+ '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
+);