This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
printf %s, cast appropriately.
[perl5.git] / ext / NDBM_File / NDBM_File.xs
index 49a1db5..e3adf3f 100644 (file)
@@ -1,14 +1,40 @@
+#define PERL_NO_GET_CONTEXT
+
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
-#include <ndbm.h>
+#undef NDBM_HEADER_USES_PROTOTYPES
+#if defined(I_GDBM_NDBM)
+#  ifdef GDBM_NDBM_H_USES_PROTOTYPES
+#    define NDBM_HEADER_USES_PROTOTYPES
+START_EXTERN_C
+#  endif
+#  include <gdbm-ndbm.h> /* Debian compatibility version */
+#elif defined(I_GDBMNDBM)
+#  ifdef GDBMNDBM_H_USES_PROTOTYPES
+#    define NDBM_HEADER_USES_PROTOTYPES
+START_EXTERN_C
+#  endif
+#  include <gdbm/ndbm.h> /* RedHat compatibility version */
+#elif defined(I_NDBM)
+#  ifdef NDBM_H_USES_PROTOTYPES
+#    define NDBM_HEADER_USES_PROTOTYPES
+START_EXTERN_C
+#  endif
+#  include <ndbm.h>
+#endif
+#ifdef NDBM_HEADER_USES_PROTOTYPES
+END_EXTERN_C
+#endif
+
+#define fetch_key 0
+#define store_key 1
+#define fetch_value 2
+#define store_value 3
 
 typedef struct {
        DBM *   dbp ;
-       SV *    filter_fetch_key ;
-       SV *    filter_store_key ;
-       SV *    filter_fetch_value ;
-       SV *    filter_store_value ;
+       SV *    filter[4];
        int     filtering ;
        } NDBM_File_type;
 
@@ -16,24 +42,19 @@ typedef NDBM_File_type * NDBM_File ;
 typedef datum datum_key ;
 typedef datum datum_value ;
 
-#define ckFilter(arg,type,name)                                        \
-       if (db->type) {                                         \
-           SV * save_defsv ;                                   \
-            /* printf("filtering %s\n", name) ;*/              \
-           if (db->filtering)                                  \
-               croak("recursion detected in %s", name) ;       \
-           db->filtering = TRUE ;                              \
-           save_defsv = newSVsv(DEFSV) ;                       \
-           sv_setsv(DEFSV, arg) ;                              \
-           PUSHMARK(sp) ;                                      \
-           (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS);  \
-           sv_setsv(arg, DEFSV) ;                              \
-           sv_setsv(DEFSV, save_defsv) ;                       \
-           SvREFCNT_dec(save_defsv) ;                          \
-           db->filtering = FALSE ;                             \
-           /*printf("end of filtering %s\n", name) ;*/         \
-       }
 
+#if defined(__cplusplus) && !defined(NDBM_HEADER_USES_PROTOTYPES)
+/* gdbm's header file used for compatibility with gdbm */
+/* isn't compatible to C++ syntax, so we need these */
+/* declarations to make everyone happy. */
+EXTERN_C DBM *dbm_open(const char *, int, mode_t);
+EXTERN_C void dbm_close(DBM *);
+EXTERN_C datum dbm_fetch(DBM *, datum);
+EXTERN_C int dbm_store(DBM *, datum, datum, int);
+EXTERN_C int dbm_delete(DBM *, datum);
+EXTERN_C datum dbm_firstkey(DBM *);
+EXTERN_C datum dbm_nextkey(DBM *);
+#endif
 
 MODULE = NDBM_File     PACKAGE = NDBM_File     PREFIX = ndbm_
 
@@ -48,9 +69,8 @@ ndbm_TIEHASH(dbtype, filename, flags, mode)
            DBM *       dbp ;
 
            RETVAL = NULL ;
-           if (dbp =  dbm_open(filename, flags, mode)) {
-               RETVAL = (NDBM_File)safemalloc(sizeof(NDBM_File_type)) ;
-               Zero(RETVAL, 1, NDBM_File_type) ;
+           if ((dbp =  dbm_open(filename, flags, mode))) {
+               RETVAL = (NDBM_File)safecalloc(1, sizeof(NDBM_File_type));
                RETVAL->dbp = dbp ;
            }
            
@@ -61,8 +81,14 @@ ndbm_TIEHASH(dbtype, filename, flags, mode)
 void
 ndbm_DESTROY(db)
        NDBM_File       db
+       PREINIT:
+       int i = store_value;
        CODE:
        dbm_close(db->dbp);
+       do {
+           if (db->filter[i])
+               SvREFCNT_dec(db->filter[i]);
+       } while (i-- > 0);
        safefree(db);
 
 #define ndbm_FETCH(db,key)                     dbm_fetch(db->dbp,key)
@@ -83,7 +109,7 @@ ndbm_STORE(db, key, value, flags = DBM_REPLACE)
            if (RETVAL < 0 && errno == EPERM)
                croak("No write permission to ndbm file");
            croak("ndbm store returned %d, errno %d, key \"%s\"",
-                       RETVAL,errno,key.dptr);
+                  RETVAL, errno, (const char *)key.dptr);
            dbm_clearerr(db->dbp);
        }
 
@@ -102,7 +128,7 @@ ndbm_FIRSTKEY(db)
 datum_key
 ndbm_NEXTKEY(db, key)
        NDBM_File       db
-       datum_key       key
+       datum_key       key = NO_INIT
 
 #define ndbm_error(db)                         dbm_error(db->dbp)
 int
@@ -115,54 +141,15 @@ ndbm_clearerr(db)
        NDBM_File       db
 
 
-#define setFilter(type)                                        \
-       {                                               \
-           if (db->type)                               \
-               RETVAL = sv_mortalcopy(db->type) ;      \
-           ST(0) = RETVAL ;                            \
-           if (db->type && (code == &PL_sv_undef)) {   \
-                SvREFCNT_dec(db->type) ;               \
-               db->type = NULL ;                       \
-           }                                           \
-           else if (code) {                            \
-               if (db->type)                           \
-                   sv_setsv(db->type, code) ;          \
-               else                                    \
-                   db->type = newSVsv(code) ;          \
-           }                                           \
-       }
-
-
-
 SV *
 filter_fetch_key(db, code)
        NDBM_File       db
        SV *            code
        SV *            RETVAL = &PL_sv_undef ;
+       ALIAS:
+       NDBM_File::filter_fetch_key = fetch_key
+       NDBM_File::filter_store_key = store_key
+       NDBM_File::filter_fetch_value = fetch_value
+       NDBM_File::filter_store_value = store_value
        CODE:
-           setFilter(filter_fetch_key) ;
-
-SV *
-filter_store_key(db, code)
-       NDBM_File       db
-       SV *            code
-       SV *            RETVAL =  &PL_sv_undef ;
-       CODE:
-           setFilter(filter_store_key) ;
-
-SV *
-filter_fetch_value(db, code)
-       NDBM_File       db
-       SV *            code
-       SV *            RETVAL =  &PL_sv_undef ;
-       CODE:
-           setFilter(filter_fetch_value) ;
-
-SV *
-filter_store_value(db, code)
-       NDBM_File       db
-       SV *            code
-       SV *            RETVAL =  &PL_sv_undef ;
-       CODE:
-           setFilter(filter_store_value) ;
-
+           DBM_setFilter(db->filter[ix], code);