home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / ext / NDBM_File / NDBM_File.xs < prev   
Text File  |  2000-02-14  |  4KB  |  169 lines

  1. #include "EXTERN.h"
  2. #include "perl.h"
  3. #include "XSUB.h"
  4. #include <ndbm.h>
  5.  
  6. typedef struct {
  7.     DBM *     dbp ;
  8.     SV *    filter_fetch_key ;
  9.     SV *    filter_store_key ;
  10.     SV *    filter_fetch_value ;
  11.     SV *    filter_store_value ;
  12.     int     filtering ;
  13.     } NDBM_File_type;
  14.  
  15. typedef NDBM_File_type * NDBM_File ;
  16. typedef datum datum_key ;
  17. typedef datum datum_value ;
  18.  
  19. #define ckFilter(arg,type,name)                    \
  20.     if (db->type) {                        \
  21.         SV * save_defsv ;                    \
  22.             /* printf("filtering %s\n", name) ;*/        \
  23.         if (db->filtering)                    \
  24.             croak("recursion detected in %s", name) ;    \
  25.         db->filtering = TRUE ;                \
  26.         save_defsv = newSVsv(DEFSV) ;            \
  27.         sv_setsv(DEFSV, arg) ;                \
  28.         PUSHMARK(sp) ;                    \
  29.         (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS);     \
  30.         sv_setsv(arg, DEFSV) ;                \
  31.         sv_setsv(DEFSV, save_defsv) ;            \
  32.         SvREFCNT_dec(save_defsv) ;                \
  33.         db->filtering = FALSE ;                \
  34.         /*printf("end of filtering %s\n", name) ;*/        \
  35.     }
  36.  
  37.  
  38. MODULE = NDBM_File    PACKAGE = NDBM_File    PREFIX = ndbm_
  39.  
  40. NDBM_File
  41. ndbm_TIEHASH(dbtype, filename, flags, mode)
  42.     char *        dbtype
  43.     char *        filename
  44.     int        flags
  45.     int        mode
  46.     CODE:
  47.     {
  48.         DBM *     dbp ;
  49.  
  50.         RETVAL = NULL ;
  51.         if (dbp =  dbm_open(filename, flags, mode)) {
  52.             RETVAL = (NDBM_File)safemalloc(sizeof(NDBM_File_type)) ;
  53.                 Zero(RETVAL, 1, NDBM_File_type) ;
  54.         RETVAL->dbp = dbp ;
  55.         }
  56.         
  57.     }
  58.     OUTPUT:
  59.       RETVAL
  60.  
  61. void
  62. ndbm_DESTROY(db)
  63.     NDBM_File    db
  64.     CODE:
  65.     dbm_close(db->dbp);
  66.     safefree(db);
  67.  
  68. #define ndbm_FETCH(db,key)            dbm_fetch(db->dbp,key)
  69. datum_value
  70. ndbm_FETCH(db, key)
  71.     NDBM_File    db
  72.     datum_key    key
  73.  
  74. #define ndbm_STORE(db,key,value,flags)        dbm_store(db->dbp,key,value,flags)
  75. int
  76. ndbm_STORE(db, key, value, flags = DBM_REPLACE)
  77.     NDBM_File    db
  78.     datum_key    key
  79.     datum_value    value
  80.     int        flags
  81.     CLEANUP:
  82.     if (RETVAL) {
  83.         if (RETVAL < 0 && errno == EPERM)
  84.         croak("No write permission to ndbm file");
  85.         croak("ndbm store returned %d, errno %d, key \"%s\"",
  86.             RETVAL,errno,key.dptr);
  87.         dbm_clearerr(db->dbp);
  88.     }
  89.  
  90. #define ndbm_DELETE(db,key)            dbm_delete(db->dbp,key)
  91. int
  92. ndbm_DELETE(db, key)
  93.     NDBM_File    db
  94.     datum_key    key
  95.  
  96. #define ndbm_FIRSTKEY(db)            dbm_firstkey(db->dbp)
  97. datum_key
  98. ndbm_FIRSTKEY(db)
  99.     NDBM_File    db
  100.  
  101. #define ndbm_NEXTKEY(db,key)            dbm_nextkey(db->dbp)
  102. datum_key
  103. ndbm_NEXTKEY(db, key)
  104.     NDBM_File    db
  105.     datum_key    key
  106.  
  107. #define ndbm_error(db)                dbm_error(db->dbp)
  108. int
  109. ndbm_error(db)
  110.     NDBM_File    db
  111.  
  112. #define ndbm_clearerr(db)            dbm_clearerr(db->dbp)
  113. void
  114. ndbm_clearerr(db)
  115.     NDBM_File    db
  116.  
  117.  
  118. #define setFilter(type)                    \
  119.     {                        \
  120.         if (db->type)                \
  121.             RETVAL = sv_mortalcopy(db->type) ;     \
  122.         ST(0) = RETVAL ;                \
  123.         if (db->type && (code == &PL_sv_undef)) {    \
  124.                 SvREFCNT_dec(db->type) ;        \
  125.             db->type = NULL ;            \
  126.         }                        \
  127.         else if (code) {                \
  128.             if (db->type)                \
  129.                 sv_setsv(db->type, code) ;        \
  130.             else                    \
  131.                 db->type = newSVsv(code) ;        \
  132.         }                            \
  133.     }
  134.  
  135.  
  136.  
  137. SV *
  138. filter_fetch_key(db, code)
  139.     NDBM_File    db
  140.     SV *        code
  141.     SV *        RETVAL = &PL_sv_undef ;
  142.     CODE:
  143.         setFilter(filter_fetch_key) ;
  144.  
  145. SV *
  146. filter_store_key(db, code)
  147.     NDBM_File    db
  148.     SV *        code
  149.     SV *        RETVAL =  &PL_sv_undef ;
  150.     CODE:
  151.         setFilter(filter_store_key) ;
  152.  
  153. SV *
  154. filter_fetch_value(db, code)
  155.     NDBM_File    db
  156.     SV *        code
  157.     SV *        RETVAL =  &PL_sv_undef ;
  158.     CODE:
  159.         setFilter(filter_fetch_value) ;
  160.  
  161. SV *
  162. filter_store_value(db, code)
  163.     NDBM_File    db
  164.     SV *        code
  165.     SV *        RETVAL =  &PL_sv_undef ;
  166.     CODE:
  167.         setFilter(filter_store_value) ;
  168.  
  169.