#define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt")
#endif
-static double
-constant(char *name, int arg)
-{
- errno = 0;
- switch (*name) {
- case 'A':
- break;
- case 'B':
- break;
- case 'C':
- break;
- case 'D':
- break;
- case 'E':
- break;
- case 'F':
- break;
- case 'G':
- if (strEQ(name, "GDBM_CACHESIZE"))
-#ifdef GDBM_CACHESIZE
- return GDBM_CACHESIZE;
+#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_ISUNDEF 8
+#define PERL_constant_ISUV 9
+#define PERL_constant_ISYES 10
+
+static int
+constant (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(GDBM_CACHESIZE GDBM_FAST GDBM_FASTMODE GDBM_INSERT GDBM_NEWDB
+ GDBM_NOLOCK GDBM_READER GDBM_REPLACE GDBM_WRCREAT GDBM_WRITER));
+
+print constant_types(); # macro defs
+foreach (C_constant ("GDBM_File", 'constant', 'IV', $types, undef, 8, @names) ) {
+ print $_, "\n"; # C constant subs
+}
+print "#### XS Section:\n";
+print XS_constant ("GDBM_File", $types);
+__END__
+ */
+
+ switch (len) {
+ case 9:
+ if (memEQ(name, "GDBM_FAST", 9)) {
+#ifdef GDBM_FAST
+ *iv_return = GDBM_FAST;
+ return PERL_constant_ISIV;
#else
- goto not_there;
+ return PERL_constant_NOTDEF;
#endif
- if (strEQ(name, "GDBM_FAST"))
-#ifdef GDBM_FAST
- return GDBM_FAST;
+ }
+ break;
+ case 10:
+ if (memEQ(name, "GDBM_NEWDB", 10)) {
+#ifdef GDBM_NEWDB
+ *iv_return = GDBM_NEWDB;
+ return PERL_constant_ISIV;
#else
- goto not_there;
+ return PERL_constant_NOTDEF;
#endif
- if (strEQ(name, "GDBM_FASTMODE"))
-#ifdef GDBM_FASTMODE
- return GDBM_FASTMODE;
+ }
+ break;
+ case 11:
+ /* Names all of length 11. */
+ /* GDBM_INSERT GDBM_NOLOCK GDBM_READER GDBM_WRITER */
+ /* Offset 6 gives the best switch position. */
+ switch (name[6]) {
+ case 'E':
+ if (memEQ(name, "GDBM_READER", 11)) {
+ /* ^ */
+#ifdef GDBM_READER
+ *iv_return = GDBM_READER;
+ return PERL_constant_ISIV;
#else
- goto not_there;
+ return PERL_constant_NOTDEF;
#endif
- if (strEQ(name, "GDBM_INSERT"))
+ }
+ break;
+ case 'N':
+ if (memEQ(name, "GDBM_INSERT", 11)) {
+ /* ^ */
#ifdef GDBM_INSERT
- return GDBM_INSERT;
+ *iv_return = GDBM_INSERT;
+ return PERL_constant_ISIV;
#else
- goto not_there;
+ return PERL_constant_NOTDEF;
#endif
- if (strEQ(name, "GDBM_NEWDB"))
-#ifdef GDBM_NEWDB
- return GDBM_NEWDB;
+ }
+ break;
+ case 'O':
+ if (memEQ(name, "GDBM_NOLOCK", 11)) {
+ /* ^ */
+#ifdef GDBM_NOLOCK
+ *iv_return = GDBM_NOLOCK;
+ return PERL_constant_ISIV;
#else
- goto not_there;
+ return PERL_constant_NOTDEF;
#endif
- if (strEQ(name, "GDBM_NOLOCK"))
-#ifdef GDBM_NOLOCK
- return GDBM_NOLOCK;
+ }
+ break;
+ case 'R':
+ if (memEQ(name, "GDBM_WRITER", 11)) {
+ /* ^ */
+#ifdef GDBM_WRITER
+ *iv_return = GDBM_WRITER;
+ return PERL_constant_ISIV;
#else
- goto not_there;
+ return PERL_constant_NOTDEF;
#endif
- if (strEQ(name, "GDBM_READER"))
-#ifdef GDBM_READER
- return GDBM_READER;
+ }
+ break;
+ }
+ break;
+ case 12:
+ /* Names all of length 12. */
+ /* GDBM_REPLACE GDBM_WRCREAT */
+ /* Offset 10 gives the best switch position. */
+ switch (name[10]) {
+ case 'A':
+ if (memEQ(name, "GDBM_WRCREAT", 12)) {
+ /* ^ */
+#ifdef GDBM_WRCREAT
+ *iv_return = GDBM_WRCREAT;
+ return PERL_constant_ISIV;
#else
- goto not_there;
+ return PERL_constant_NOTDEF;
#endif
- if (strEQ(name, "GDBM_REPLACE"))
+ }
+ break;
+ case 'C':
+ if (memEQ(name, "GDBM_REPLACE", 12)) {
+ /* ^ */
#ifdef GDBM_REPLACE
- return GDBM_REPLACE;
+ *iv_return = GDBM_REPLACE;
+ return PERL_constant_ISIV;
#else
- goto not_there;
+ return PERL_constant_NOTDEF;
#endif
- if (strEQ(name, "GDBM_WRCREAT"))
-#ifdef GDBM_WRCREAT
- return GDBM_WRCREAT;
+ }
+ break;
+ }
+ break;
+ case 13:
+ if (memEQ(name, "GDBM_FASTMODE", 13)) {
+#ifdef GDBM_FASTMODE
+ *iv_return = GDBM_FASTMODE;
+ return PERL_constant_ISIV;
#else
- goto not_there;
+ return PERL_constant_NOTDEF;
#endif
- if (strEQ(name, "GDBM_WRITER"))
-#ifdef GDBM_WRITER
- return GDBM_WRITER;
+ }
+ break;
+ case 14:
+ if (memEQ(name, "GDBM_CACHESIZE", 14)) {
+#ifdef GDBM_CACHESIZE
+ *iv_return = GDBM_CACHESIZE;
+ return PERL_constant_ISIV;
#else
- goto not_there;
+ return PERL_constant_NOTDEF;
#endif
- break;
- case 'H':
- break;
- case 'I':
- break;
- case 'J':
- break;
- case 'K':
- break;
- case 'L':
- break;
- case 'M':
- break;
- case 'N':
- break;
- case 'O':
- break;
- case 'P':
- break;
- case 'Q':
- break;
- case 'R':
- break;
- case 'S':
- break;
- case 'T':
- break;
- case 'U':
- break;
- case 'V':
- break;
- case 'W':
- break;
- case 'X':
- break;
- case 'Y':
- break;
- case 'Z':
- break;
}
- errno = EINVAL;
- return 0;
-
- if (0) {
- goto not_there; /* -Wall */
- }
-
-not_there:
- errno = ENOENT;
- return 0;
+ break;
+ }
+ return PERL_constant_NOTFOUND;
}
MODULE = GDBM_File PACKAGE = GDBM_File PREFIX = gdbm_
-double
-constant(name,arg)
- char * name
- int arg
+void
+constant(sv)
+ PREINIT:
+ dXSTARG;
+ 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(s, len, &iv, &nv);
+ if you need to return both NVs and IVs */
+ type = constant(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 GDBM_File macro", s));
+ PUSHs(sv);
+ break;
+ case PERL_constant_NOTDEF:
+ sv = sv_2mortal(newSVpvf(
+ "Your vendor has not defined GDBM_File macro %s, used", s));
+ PUSHs(sv);
+ break;
+ case PERL_constant_ISIV:
+ EXTEND(SP, 1);
+ PUSHs(&PL_sv_undef);
+ PUSHi(iv);
+ break;
+ default:
+ sv = sv_2mortal(newSVpvf(
+ "Unexpected return type %d while processing GDBM_File macro %s, used",
+ type, s));
+ PUSHs(sv);
+ }
GDBM_File
projects / p5sagit/p5-mst-13.2.git / commitdiff