Add I18N::Langinfo, which is basically a wrapper around
authorJarkko Hietaniemi <jhi@iki.fi>
Sun, 8 Jul 2001 01:14:02 +0000 (01:14 +0000)
committerJarkko Hietaniemi <jhi@iki.fi>
Sun, 8 Jul 2001 01:14:02 +0000 (01:14 +0000)
nl_langinfo(), which is an additional way to query locale
specific information.

p4raw-id: //depot/perl@11207

Configure
MANIFEST
ext/I18N/Langinfo/Langinfo.pm [new file with mode: 0644]
ext/I18N/Langinfo/Langinfo.t [new file with mode: 0644]
ext/I18N/Langinfo/Langinfo.xs [new file with mode: 0644]
ext/I18N/Langinfo/Makefile.PL [new file with mode: 0644]
pod/perl572delta.pod
pod/perllocale.pod

index 87547b0..08afc72 100755 (executable)
--- 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$$ <<EOF
@@ -16247,6 +16247,11 @@ for xxx in $known_extensions ; do
                $define) avail_ext="$avail_ext $xxx" ;;
                esac
                ;;
+       I18N_Langinfo|i18n_lan)
+               case "$i_langinfo$d_nl_langinfo" in 
+               $define$define) avail_ext="$avail_ext $xxx" ;;
+               esac
+               ;;
        NDBM_File|ndbm_fil)
                case "$i_ndbm" in
                $define)
index 118481f..2c9da00 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -315,6 +315,10 @@ ext/GDBM_File/GDBM_File.xs GDBM extension external subroutines
 ext/GDBM_File/hints/sco.pl     Hint for GDBM_File for named architecture
 ext/GDBM_File/Makefile.PL      GDBM extension makefile writer
 ext/GDBM_File/typemap          GDBM extension interface types
+ext/I18N/Langinfo/Langinfo.pm  I18N::Langinfo
+ext/I18N/Langinfo/Langinfo.t   I18N::Langinfo
+ext/I18N/Langinfo/Langinfo.xs  I18N::Langinfo
+ext/I18N/Langinfo/Makefile.PL  I18N::Langinfo
 ext/IO/ChangeLog               IO perl module change log
 ext/IO/IO.pm                   Top-level interface to IO::* classes
 ext/IO/IO.xs                   IO extension external subroutines
diff --git a/ext/I18N/Langinfo/Langinfo.pm b/ext/I18N/Langinfo/Langinfo.pm
new file mode 100644 (file)
index 0000000..79f8a14
--- /dev/null
@@ -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 (file)
index 0000000..bb74f36
--- /dev/null
@@ -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 (file)
index 0000000..3422eed
--- /dev/null
@@ -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 (file)
index 0000000..aff6f87
--- /dev/null
@@ -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
+);
index b75d0d0..636c16a 100644 (file)
@@ -174,6 +174,10 @@ L<ExtUtils::Constant> - generate XS code to import C header constants
 
 =item *
 
+L<I18N::Langinfo> - query locale information
+
+=item *
+
 L<I18N::LangTags> - functions for dealing with RFC3066-style language tags
 
 =item *
index f680c73..5232eba 100644 (file)
@@ -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<I18N::Langinfo> 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<I18N::Langinfo> and C<RADIXCHAR>.
+
 =head2 Category LC_MONETARY: Formatting of monetary amounts
 
 The C standard defines the C<LC_MONETARY> 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<I18N::Langinfo> and C<CRNCYSTR>.
+
 =head2 LC_TIME
 
 Output produced by POSIX::strftime(), which builds a formatted
@@ -606,6 +632,9 @@ Note: C<use locale> isn't needed in this example: as a function that
 exists only to generate locale-dependent results, strftime() always
 obeys the current C<LC_TIME> locale.
 
+See also L<I18N::Langinfo> and C<ABDAY_1>..C<ABDAY_7>, C<DAY_1>..C<DAY_7>,
+C<ABMON_1>..C<ABMON_12>, and C<ABMON_1>..C<ABMON_12>; and L<Time::Piece>.
+
 =head2 Other categories
 
 The remaining locale category, C<LC_MESSAGES> (possibly supplemented
@@ -964,12 +993,12 @@ operating system upgrade.
 
 =head1 SEE ALSO
 
-L<POSIX/isalnum>, L<POSIX/isalpha>, L<POSIX/isdigit>, 
-L<POSIX/isgraph>, L<POSIX/islower>, L<POSIX/isprint>, 
-L<POSIX/ispunct>, L<POSIX/isspace>, L<POSIX/isupper>, 
-L<POSIX/isxdigit>, L<POSIX/localeconv>, L<POSIX/setlocale>, 
-L<POSIX/strcoll>, L<POSIX/strftime>, L<POSIX/strtod>, 
-L<POSIX/strxfrm>.
+L<I18N::Langinfo>, L<POSIX/isalnum>, L<POSIX/isalpha>,
+L<POSIX/isdigit>, L<POSIX/isgraph>, L<POSIX/islower>,
+L<POSIX/isprint>, L<POSIX/ispunct>, L<POSIX/isspace>,
+L<POSIX/isupper>, L<POSIX/isxdigit>, L<POSIX/localeconv>,
+L<POSIX/setlocale>, L<POSIX/strcoll>, L<POSIX/strftime>,
+L<POSIX/strtod>, L<POSIX/strxfrm>.
 
 =head1 HISTORY