Must Uppercase.
[p5sagit/p5-mst-13.2.git] / ext / DB_File / DB_File.xs
index 8a9ce8a..d2dc572 100644 (file)
@@ -3,8 +3,8 @@
  DB_File.xs -- Perl 5 interface to Berkeley DB 
 
  written by Paul Marquess <Paul.Marquess@btinternet.com>
- last modified 26th April 2001
- version 1.77
+ last modified 30th July 2001
+ version 1.78
 
  All comments/suggestions/problems are welcome
 
                needed to be changed.
         1.76 -  No change to DB_File.xs
         1.77 -  Tidied up a few types used in calling newSVpvn.
+        1.78 -  Core patch 10335, 10372, 10534, 10549, 11051 included.
 
 */
 
+#define PERL_NO_GET_CONTEXT
 #include "EXTERN.h"  
 #include "perl.h"
 #include "XSUB.h"
  * shortly #included by the <db.h>) __attribute__ to the possibly
  * already defined __attribute__, for example by GNUC or by Perl. */
 
-#if DB_VERSION_MAJOR_CFG < 2
+/* #if DB_VERSION_MAJOR_CFG < 2  */
+#ifndef DB_VERSION_MAJOR
+#    undef __attribute__
+#endif
 
-#undef __attribute__
 
-/* Since we dropped the gccish definition of __attribute__ we will want
- * to redefine dNOOP, however (so that dTHX continues to work).  Yes,
- * all this means that we can't do attribute checking on the DB_File,
- * boo, hiss. */
-#undef  dNOOP
-#define dNOOP extern int Perl___notused
-
-#endif
 
 /* If Perl has been compiled with Threads support,the symbol op will
    be defined here. This clashes with a field name in db.h, so get rid of it.
 #    include <db.h>
 #endif
 
-#ifdef CAN_PROTOTYPE
-extern void __getBerkeleyDBInfo(void);
-#endif
+/* Wall starts with 5.7.x */
+
+#if PERL_REVISION > 5 || (PERL_REVISION == 5 && PERL_VERSION >= 7)
+
+/* Since we dropped the gccish definition of __attribute__ we will want
+ * to redefine dNOOP, however (so that dTHX continues to work).  Yes,
+ * all this means that we can't do attribute checking on the DB_File,
+ * boo, hiss. */
+#  ifndef DB_VERSION_MAJOR
+
+#    undef  dNOOP
+#    define dNOOP extern int Perl___notused
+
+    /* Ditto for dXSARGS. */
+#    undef  dXSARGS
+#    define dXSARGS                            \
+       dSP; dMARK;                     \
+       I32 ax = mark - PL_stack_base + 1;      \
+       I32 items = sp - mark
+
+#  endif
+
+/* avoid -Wall; DB_File xsubs never make use of `ix' setup for ALIASes */
+#  undef dXSI32
+#  define dXSI32 dNOOP
+
+#endif /* Perl >= 5.7 */
 
 #ifndef pTHX
 #    define pTHX
@@ -435,6 +455,10 @@ typedef DBT DBTKEY ;
        }
 
 
+#ifdef CAN_PROTOTYPE
+extern void __getBerkeleyDBInfo(void);
+#endif
+
 /* Internal Global Data */
 static recno_t Value ; 
 static recno_t zero = 0 ;
@@ -1703,11 +1727,13 @@ db_EXISTS(db, key)
        OUTPUT:
          RETVAL
 
-int
+void
 db_FETCH(db, key, flags=0)
        DB_File         db
        DBTKEY          key
        u_int           flags
+       PREINIT:
+       int RETVAL;
        CODE:
        {
             DBT                value ;
@@ -1730,9 +1756,11 @@ db_STORE(db, key, value, flags=0)
          CurrentDB = db ;
 
 
-int
+void
 db_FIRSTKEY(db)
        DB_File         db
+       PREINIT:
+       int RETVAL;
        CODE:
        {
            DBTKEY      key ;
@@ -1746,10 +1774,12 @@ db_FIRSTKEY(db)
            OutputKey(ST(0), key) ;
        }
 
-int
+void
 db_NEXTKEY(db, key)
        DB_File         db
        DBTKEY          key
+       PREINIT:
+       int RETVAL;
        CODE:
        {
            DBT         value ;
@@ -1806,10 +1836,12 @@ unshift(db, ...)
        OUTPUT:
            RETVAL
 
-I32
+void
 pop(db)
        DB_File         db
        ALIAS:          POP = 1
+       PREINIT:
+       I32 RETVAL;
        CODE:
        {
            DBTKEY      key ;
@@ -1833,10 +1865,12 @@ pop(db)
            }
        }
 
-I32
+void
 shift(db)
        DB_File         db
        ALIAS:          SHIFT = 1
+       PREINIT:
+       I32 RETVAL;
        CODE:
        {
            DBT         value ;
@@ -1977,16 +2011,18 @@ db_put(db, key, value, flags=0)
 int
 db_fd(db)
        DB_File         db
-       int             status = 0 ;
        CODE:
          CurrentDB = db ;
 #ifdef DB_VERSION_MAJOR
          RETVAL = -1 ;
-         status = (db->in_memory
-               ? -1 
-               : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
-         if (status != 0)
-           RETVAL = -1 ;
+         {
+           int status = 0 ;
+           status = (db->in_memory
+                     ? -1 
+                     : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
+           if (status != 0)
+             RETVAL = -1 ;
+         }
 #else
          RETVAL = (db->in_memory
                ? -1