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/fallback.c I18N::Langinfo
+ext/I18N/Langinfo/fallback.xs I18N::Langinfo
ext/I18N/Langinfo/Langinfo.pm I18N::Langinfo
ext/I18N/Langinfo/Langinfo.t I18N::Langinfo
ext/I18N/Langinfo/Langinfo.xs I18N::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;
-}
+#include "constants.c"
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);
- }
+INCLUDE: constants.xs
SV*
langinfo(code)
'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
# Insert -I. if you add *.h files later:
'INC' => '', # e.g., '-I/usr/include/other'
+ # Without this the constants xs files are spotted, and cause rules to be
+ # added to delete the similarly named C files, which isn't what we want.
+ XS => {'Langinfo.xs' => 'Langinfo.c'},
+ realclean => {FILES=> 'constants.c constants.xs'},
# Un-comment this if you add C files to link with later:
# 'OBJECT' => '$(O_FILES)', # link all the C files too
);
+if (eval {require ExtUtils::Constant; 1}) {
+ 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));
+ ExtUtils::Constant::WriteConstants(
+ NAME => 'I18N::Langinfo',
+ NAMES => \@names,
+ );
+} else {
+ use File::Copy;
+ copy ('fallback.c', 'constants.c')
+ or die "Can't copy fallback.c to constants.c: $!";
+ copy ('fallback.xs', 'constants.xs')
+ or die "Can't copy fallback.xs to constants.xs: $!";
+}
--- /dev/null
+#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
+
+#!../../../miniperl -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;
+}
+
--- /dev/null
+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);
+ }
package ExtUtils::Constant;
use vars qw (@ISA $VERSION %XS_Constant %XS_TypeSet @EXPORT_OK %EXPORT_TAGS);
-$VERSION = '0.09';
+$VERSION = '0.10';
=head1 NAME
A fixed length thing, given as a [pointer, length] pair. If you know the
length of a string at compile time you may use this instead of I<PV>
-=item PVN
+=item SV
A B<mortal> SV.
%EXPORT_TAGS = ( 'all' => [ qw(
XS_constant constant_types return_clause memEQ_clause C_stringify
- C_constant autoload WriteConstants
+ C_constant autoload WriteConstants WriteMakefileSnippet
) ] );
@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
=item dump_names
-dump_names PACKAGE, SUBNAME, DEFAULT_TYPE, TYPES, INDENT, BREAKOUT, ITEM...
+dump_names DEFAULT_TYPE, TYPES, INDENT, OPTIONS, ITEM...
An internal function to generate the embedded perl code that will regenerate
-the constant subroutines. Parameters are the same as for C_constant.
+the constant subroutines. I<DEFAULT_TYPE>, I<TYPES> and I<ITEM>s are the
+same as for C_constant. I<INDENT> is treated as number of spaces to indent
+by. I<OPTIONS> is a hashref of options. Currently only C<declare_types> is
+recognised. If the value is true a C<$types> is always declared in the perl
+code generated, if defined and false never declared, and if undefined C<$types>
+is only declared if the values in I<TYPES> as passed in cannot be inferred from
+I<DEFAULT_TYPES> and the I<ITEM>s.
=cut
sub dump_names {
- my ($package, $subname, $default_type, $what, $indent, $breakout, @items)
- = @_;
- my (@simple, @complex);
+ my ($default_type, $what, $indent, $options, @items) = @_;
+ my $declare_types = $options->{declare_types};
+ $indent = ' ' x ($indent || 0);
+
+ my $result;
+ my (@simple, @complex, %used_types);
foreach (@items) {
- my $type = $_->{type} || $default_type;
+ my $type;
+ if (ref $_) {
+ $type = $_->{type} || $default_type;
+ } else {
+ $_ = {name=>$_};
+ $type = $default_type;
+ }
+ $used_types{$type}++;
if ($type eq $default_type and 0 == ($_->{name} =~ tr/A-Za-z0-9_//c)
and !defined ($_->{macro}) and !defined ($_->{value})
and !defined ($_->{default}) and !defined ($_->{pre})
push @complex, $_;
}
}
- my $result = <<"EOT";
- /* 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
-#!$^X -w
-use ExtUtils::Constant qw (constant_types C_constant XS_constant);
-
-EOT
- $result .= 'my $types = {map {($_, 1)} qw(' . join (" ", sort keys %$what)
- . ")};\n";
- $result .= wrap ("my \@names = (qw(",
- " ", join (" ", sort @simple) . ")");
+ if (!defined $declare_types) {
+ # Do they pass in any types we weren't already using?
+ foreach (keys %$what) {
+ next if $used_types{$_};
+ $declare_types++; # Found one in $what that wasn't used.
+ last; # And one is enough to terminate this loop
+ }
+ }
+ if ($declare_types) {
+ $result = $indent . 'my $types = {map {($_, 1)} qw('
+ . join (" ", sort keys %$what) . ")};\n";
+ }
+ $result .= wrap ($indent . "my \@names = (qw(",
+ $indent . " ", join (" ", sort @simple) . ")");
if (@complex) {
foreach my $item (sort {$a->{name} cmp $b->{name}} @complex) {
my $name = C_stringify $item->{name};
- my $line = ",\n {name=>\"$name\"";
+ my $line = ",\n$indent {name=>\"$name\"";
$line .= ", type=>\"$item->{type}\"" if defined $item->{type};
foreach my $thing (qw (macro value default pre post def_pre def_post)) {
my $value = $item->{$thing};
}
$result .= ");\n";
+ $result;
+}
+
+
+=item dogfood
+
+dogfood PACKAGE, SUBNAME, DEFAULT_TYPE, TYPES, INDENT, BREAKOUT, ITEM...
+
+An internal function to generate the embedded perl code that will regenerate
+the constant subroutines. Parameters are the same as for C_constant.
+
+=cut
+
+sub dogfood {
+ my ($package, $subname, $default_type, $what, $indent, $breakout, @items)
+ = @_;
+ my $result = <<"EOT";
+ /* 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
+
+#!$^X -w
+use ExtUtils::Constant qw (constant_types C_constant XS_constant);
+
+EOT
+ $result .= dump_names ($default_type, $what, 0, {declare_types=>1}, @items);
$result .= <<'EOT';
print constant_types(); # macro defs
} else {
# We are the top level.
$body .= " /* Initially switch on the length of the name. */\n";
- $body .= dump_names ($package, $subname, $default_type, $what, $indent,
- $breakout, @items);
+ $body .= dogfood ($package, $subname, $default_type, $what, $indent,
+ $breakout, @items);
$body .= " switch (len) {\n";
# Need to group names of the same length
my @by_length;
}
+=item WriteMakefileSnippet
+
+WriteMakefileSnippet ATTRIBUTE =E<gt> VALUE [, ...]
+
+An function to generate perl code for Makefile.PL that will regenerate
+the constant subroutines. Parameters are named as passed to C<WriteConstants>,
+with the addition of C<INDENT> to specify the number of leading spaces
+(default 2).
+
+Currently only C<INDENT>, C<NAME>, C<DEFAULT_TYPE>, C<NAMES>, C<C_FILE> and
+C<XS_FILE> are recognised.
+
+=cut
+
+sub WriteMakefileSnippet {
+ my %args = @_;
+ my $indent = $args{INDENT} || 2;
+
+ my $result = <<"EOT";
+ExtUtils::Constant::WriteConstants(
+ NAME => '$args{NAME}',
+ NAMES => \\\@names,
+ DEFAULT_TYPE => '$args{DEFAULT_TYPE}',
+EOT
+ foreach (qw (C_FILE XS_FILE)) {
+ next unless exists $args{$_};
+ $result .= sprintf " %-12s => '%s',\n",
+ $_, $args{$_};
+ }
+ $result .= <<'EOT';
+ );
+EOT
+
+ $result =~ s/^/' 'x$indent/gem;
+ return dump_names ($args{DEFAULT_TYPE}, undef, $indent, undef,
+ @{$args{NAMES}})
+ . $result;
+}
+
=item WriteConstants ATTRIBUTE =E<gt> VALUE [, ...]
Writes a file of C code and a file of XS code which you should C<#include>
=item SUBNAME
The perl visible name of the XS subroutine generated which will return the
-constants. The default is C<constant>.
+constants. The default is C<constant>.
=item C_SUBNAME
"-f -n $name", <<"EOXSFILES",
Writing $name/$name.pm
Writing $name/$name.xs
+Writing $name/fallback.c
+Writing $name/fallback.xs
Writing $name/Makefile.PL
Writing $name/README
Writing $name/t/1.t
"-f -n $name $header", <<"EOXSFILES",
Writing $name/$name.pm
Writing $name/$name.xs
+Writing $name/fallback.c
+Writing $name/fallback.xs
Writing $name/Makefile.PL
Writing $name/README
Writing $name/t/1.t
=cut
+# ' # Grr
use strict;
use Text::Wrap;
$Text::Wrap::huge = 'overflow';
$Text::Wrap::columns = 80;
-use ExtUtils::Constant qw (constant_types C_constant XS_constant autoload);
+use ExtUtils::Constant qw (WriteConstants WriteMakefileSnippet autoload);
+use File::Compare;
sub usage {
warn "@_\n" if @_;
-p, --remove-prefix Specify a prefix which should be removed from the
Perl function names.
-s, --const-subs Create subroutines for specified macros.
- -t, --default-type Default type for autoloaded constants
+ -t, --default-type Default type for autoloaded constants (default is IV)
--use-new-tests Use Test::More in backward compatible modules
--use-old-tests Use the module Test rather than Test::More
-v, --version Specify a version number for this extension.
# -X implies -c and -f
$opt_c = $opt_f = 1 if $opt_X;
+$opt_t ||= 'IV';
+
my %const_xsub = map { $_,1 } split(/,+/, $opt_s) if $opt_s;
my $extralibs = '';
# Save current directory so that C::Scan can use it
my $cwd = File::Spec->rel2abs( File::Spec->curdir );
-my ($ext, $nested, @modparts, $modfname, $modpname);
+my ($ext, $nested, @modparts, $modfname, $modpname, $constsfname);
$ext = chdir 'ext' ? 'ext/' : '';
@modparts = ();
$modfname = $modpname = $module;
}
+# Don't trip up if someone calls their module 'constants'
+$constsfname = $modfname eq 'constants' ? 'constdefs' : 'constants';
if ($opt_O) {
$" = "\n\t";
warn "Writing $ext$modpname/$modfname.pm\n";
-if ( $compat_version < 5.006 ) {
print PM <<"END";
package $module;
use $compat_version;
use strict;
END
-}
-else {
-print PM <<"END";
-package $module;
-
-use 5.006;
-use strict;
-use warnings;
-END
-}
+print PM "use warnings;\n" unless $compat_version < 5.006;
unless( $opt_X || $opt_c || $opt_A ){
# we'll have an AUTOLOAD(), and it will have $AUTOLOAD and
return ($struct_typedefs{$otype} = $out);
}
-my $types = {};
-# Important. Passing an undef scalar doesn't cause the
-# autovivified hashref to appear back out in this scope.
+print_tievar_subs(\*XS, $_, $vdecl_hash{$_}) for @vdecls;
if( ! $opt_c ) {
- print XS constant_types(), "\n";
- foreach (C_constant ($module, undef, $opt_t, $types, undef, undef,
- @const_names)) {
- print XS $_, "\n";
- }
+ # We write the "sample" files used when this module is built by perl without
+ # ExtUtils::Constant.
+ # h2xs will later check that these are the same as those generated by the
+ # code embedded into Makefile.PL
+ warn "Writing $ext$modpname/fallback.c\n";
+ warn "Writing $ext$modpname/fallback.xs\n";
+ WriteConstants ( C_FILE => "fallback.c",
+ XS_FILE => "fallback.xs",
+ DEFAULT_TYPE => $opt_t,
+ NAME => $module,
+ NAMES => \@const_names,
+ );
+ print XS "#include \"$constsfname.c\"\n";
}
-print_tievar_subs(\*XS, $_, $vdecl_hash{$_}) for @vdecls;
my $prefix = defined $opt_p ? "PREFIX = $opt_p" : '';
END
+# If a constant() function was #included then output a corresponding
+# XS declaration:
+print XS "INCLUDE: $constsfname.xs\n" unless $opt_c;
+
foreach (sort keys %const_xsub) {
print XS <<"END";
char *
END
}
-# If a constant() function was written then output a corresponding
-# XS declaration:
-# XXX IVs
-print XS XS_constant ($module, $types) unless $opt_c;
-
my %seen_decl;
my %typemap;
$prereq_pm = '';
}
-print PL <<END;
+print PL <<"END";
+use $compat_version;
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
$Icomment 'INC' => '$I', # e.g., '${Ihelp}-I/usr/include/other'
END
- my $C = grep $_ ne "$modfname.c", (glob '*.c'), (glob '*.cc'), (glob '*.C');
+ if (!$opt_c) {
+ print PL <<"END";
+ # Without this the constants xs files are spotted, and cause rules to be
+ # added to delete the similarly names C files, which isn't what we want.
+ 'XS' => {'$modfname.xs' => '$modfname.c'},
+ realclean => {FILES => '$constsfname.c $constsfname.xs'},
+END
+ }
+
+ my $C = grep {$_ ne "$modfname.c" && $_ ne "fallback.c"}
+ (glob '*.c'), (glob '*.cc'), (glob '*.C');
my $Cpre = ($C ? '' : '# ');
my $Ccomment = ($C ? '' : <<EOC);
# Un-comment this if you add C files to link with later:
print PL <<END;
$Ccomment $Cpre\'OBJECT' => '\$(O_FILES)', # link all the C files too
END
-}
+} # ' # Grr
print PL ");\n";
+if (!$opt_c) {
+ my $generate_code =
+ WriteMakefileSnippet ( C_FILE => "$constsfname.c",
+ XS_FILE => "$constsfname.xs",
+ DEFAULT_TYPE => $opt_t,
+ NAME => $module,
+ NAMES => \@const_names,
+ );
+ print PL <<"END";
+if (eval {require ExtUtils::Constant; 1}) {
+ # If you edit these definitions to change the constants used by this module,
+ # you will need to use the generated $constsfname.c and $constsfname.xs
+ # files to replace their "fallback" counterparts before distributing your
+ # changes.
+$generate_code
+}
+else {
+ use File::Copy;
+ copy ('fallback.c', '$constsfname.c')
+ or die "Can't copy fallback.c to $constsfname.c: $!";
+ copy ('fallback.xs', '$constsfname.xs')
+ or die "Can't copy fallback.xs to $constsfname.xs: $!";
+}
+END
+
+ eval $generate_code;
+ if ($@) {
+ warn <<"EOM";
+Attempting to test constant code in $ext$modpname/Makefile.PL:
+$generate_code
+__END__
+gave unexpected error $@
+Please report the circumstances of this bug in h2xs version $H2XS_VERSION
+using the perlbug script.
+EOM
+ } else {
+ my $fail;
+
+ foreach ('c', 'xs') {
+ if (compare("fallback.$_", "$constsfname.$_")) {
+ warn << "EOM";
+Files "$ext$modpname/fallback.$_" and "$ext$modpname/$constsfname.$_" differ.
+EOM
+ $fail++;
+ }
+ }
+ if ($fail) {
+ warn fill ('','', <<"EOM") . "\n";
+It appears that the code in $ext$modpname/Makefile.PL does not autogenerate
+the files $ext$modpname/$constsfname.c and $ext$modpname/$constsfname.xs
+correctly.
+
+Please report the circumstances of this bug in h2xs version $H2XS_VERSION
+using the perlbug script.
+EOM
+ } else {
+ unlink "$constsfname.c", "$constsfname.xs";
+ }
+ }
+}
close(PL) || die "Can't close $ext$modpname/Makefile.PL: $!\n";
# Create a simple README since this is a CPAN requirement
$_ = 'Makefile.PL' if $_ eq 'makefile.pl';
}
}
+if (!$opt_c) {
+ @files = grep {$_ ne "$constsfname.c" and $_ ne "$constsfname.xs"} @files;
+}
print MANI join("\n",@files), "\n";
close MANI;
!NO!SUBS!
projects / p5sagit/p5-mst-13.2.git / commitdiff