Update to version 1.02

[perl5.git] / ext / DB_File / DB_File.xs

diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
index dd9e03d..f344794 100644 (file)
--- a/ext/DB_File/DB_File.xs
+++ b/ext/DB_File/DB_File.xs
@@ -3,8 +3,8 @@
  DB_File.xs -- Perl 5 interface to Berkeley DB 
 
  written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
- last modified 14th November 1995
- version 1.01
+ last modified 26th June 1996
+ version 1.02
 
  All comments/suggestions/problems are welcome
 
@@ -17,6 +17,11 @@
        1.01 -  Fixed a SunOS core dump problem.
                The return value from TIEHASH wasn't set to NULL when
                dbopen returned an error.
+       1.02 -  Use ALIAS to define TIEARRAY.
+               Removed some redundant commented code.
+               Merged OS2 code into the main distribution.
+               Allow negative subscripts with RECNO interface.
+               Changed the default flags to O_CREAT|O_RDWR
 */
 
 #include "EXTERN.h"  
@@ -45,7 +50,7 @@ union INFO {
       } ;
 
 
-/* #define TRACE  */
+/* #define TRACE   */
 
 #define db_DESTROY(db)                  ((db->dbp)->close)(db->dbp)
 #define db_DELETE(db, key, flags)       ((db->dbp)->del)(db->dbp, &key, flags)
@@ -61,14 +66,18 @@ union INFO {
 #define db_sync(db, flags)              ((db->dbp)->sync)(db->dbp, flags)
 
 
-#define OutputValue(arg, name)  \
-       { if (RETVAL == 0) sv_setpvn(arg, name.data, name.size) ; }
+#define OutputValue(arg, name)                                 \
+       { if (RETVAL == 0) {                                    \
+             sv_setpvn(arg, name.data, name.size) ;            \
+         }                                                     \
+       }
 
 #define OutputKey(arg, name)                                   \
        { if (RETVAL == 0) \
          {                                                     \
-               if (db->type != DB_RECNO)                       \
+               if (db->type != DB_RECNO) {                     \
                    sv_setpvn(arg, name.data, name.size);       \
+               }                                               \
                else                                            \
                    sv_setiv(arg, (I32)*(I32*)name.data - 1);   \
          }                                                     \
@@ -235,7 +244,7 @@ RECNOINFO recno ;
     printf ("  lorder    = %d\n", recno.lorder) ;
     printf ("  reclen    = %d\n", recno.reclen) ;
     printf ("  bval      = %d\n", recno.bval) ;
-    printf ("  bfname    = %s\n", recno.bfname) ;
+    printf ("  bfname    = %d [%s]\n", recno.bfname, recno.bfname) ;
 }
 
 PrintBtree(btree)
@@ -278,6 +287,27 @@ DB * db ;
     return (RETVAL) ;
 }
 
+static recno_t
+GetRecnoKey(db, value)
+DB_File  db ;
+I32      value ;
+{
+    if (value < 0) {
+       /* Get the length of the array */
+       I32 length = GetArrayLength(db->dbp) ;
+
+       /* check for attempt to write before start of array */
+       if (length + value + 1 <= 0)
+           croak("Modification of non-creatable array value attempted, subscript %d", value) ;
+
+       value = length + value + 1 ;
+    }
+    else
+        ++ value ;
+
+    return value ;
+}
+
 static DB_File
 ParseOpenInfo(name, flags, mode, sv, string)
 char * name ;
@@ -291,8 +321,8 @@ char * string ;
     union INFO info ;
     DB_File    RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
     void *     openinfo = NULL ;
-    /* DBTYPE  type = DB_HASH ; */
 
+    /* Default to HASH */
     RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
     RETVAL->type = DB_HASH ;
 
@@ -415,7 +445,10 @@ char * string ;
            }
          
             svp = hv_fetch(action, "bfname", 6, FALSE); 
-            info.recno.bfname = (char *) svp ? SvPV(*svp,na) : 0;
+            if (svp) {
+               char * ptr = SvPV(*svp,na) ;
+                info.recno.bfname = (char*) na ? ptr : 0 ;
+           }
 
             PrintRecno(info) ;
         }
@@ -424,17 +457,14 @@ char * string ;
     }
 
 
-    RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ; 
-
-#if 0
-    /* kludge mode on: RETVAL->type for DB_RECNO is set to DB_BTREE
-                      so remember a DB_RECNO by saving the address
-                      of one of it's internal routines
-    */
-    if (RETVAL->dbp && type == DB_RECNO)
-        DB_recno_close = RETVAL->dbp->close ;
-#endif
+    /* OS2 Specific Code */
+#ifdef OS2
+#ifdef __EMX__
+    flags |= O_BINARY;
+#endif /* __EMX__ */
+#endif /* OS2 */
 
+    RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ; 
 
     return (RETVAL) ;
 }
@@ -695,10 +725,11 @@ constant(name,arg)
 
 
 DB_File
-db_TIEHASH(dbtype, name=undef, flags=O_RDWR, mode=0640, type=DB_HASH)
+db_TIEHASH(dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0640, type=DB_HASH)
        char *          dbtype
        int             flags
        int             mode
+       ALIAS: TIEARRAY = 1
        CODE:
        {
            char *      name = (char *) NULL ; 
@@ -717,9 +748,6 @@ db_TIEHASH(dbtype, name=undef, flags=O_RDWR, mode=0640, type=DB_HASH)
        OUTPUT: 
            RETVAL
 
-BOOT:
-    newXS("DB_File::TIEARRAY", XS_DB_File_db_TIEHASH, file);
-
 int
 db_DESTROY(db)
        DB_File         db