home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / ext / ODBM_File / ODBM_File.xs < prev   
Text File  |  2000-02-15  |  5KB  |  203 lines
  1. #include "EXTERN.h"
  2. #include "perl.h"
  3. #include "XSUB.h"
  4.  
  5. #ifdef I_DBM
  6. #  include <dbm.h>
  7. #else
  8. #  ifdef I_RPCSVC_DBM
  9. #    include <rpcsvc/dbm.h>
  10. #  endif
  11. #endif
  12.  
  13. #ifdef DBM_BUG_DUPLICATE_FREE 
  14. /*
  15.  * DBM on at least Ultrix and HPUX call dbmclose() from dbminit(),
  16.  * resulting in duplicate free() because dbmclose() does *not*
  17.  * check if it has already been called for this DBM.
  18.  * If some malloc/free calls have been done between dbmclose() and
  19.  * the next dbminit(), the memory might be used for something else when
  20.  * it is freed.
  21.  * Verified to work on ultrix4.3.  Probably will work on HP/UX.
  22.  * Set DBM_BUG_DUPLICATE_FREE in the extension hint file.
  23.  */
  24. /* Close the previous dbm, and fail to open a new dbm */
  25. #define dbmclose()    ((void) dbminit("/tmp/x/y/z/z/y"))
  26. #endif
  27.  
  28. #include <fcntl.h>
  29.  
  30. typedef struct {
  31.     void *     dbp ;
  32.     SV *    filter_fetch_key ;
  33.     SV *    filter_store_key ;
  34.     SV *    filter_fetch_value ;
  35.     SV *    filter_store_value ;
  36.     int     filtering ;
  37.     } ODBM_File_type;
  38.  
  39. typedef ODBM_File_type * ODBM_File ;
  40. typedef datum datum_key ;
  41. typedef datum datum_value ;
  42.  
  43. #define ckFilter(arg,type,name)                    \
  44.     if (db->type) {                        \
  45.         SV * save_defsv ;                    \
  46.             /* printf("filtering %s\n", name) ;*/        \
  47.         if (db->filtering)                    \
  48.             croak("recursion detected in %s", name) ;    \
  49.         db->filtering = TRUE ;                \
  50.         save_defsv = newSVsv(DEFSV) ;            \
  51.         sv_setsv(DEFSV, arg) ;                \
  52.         PUSHMARK(sp) ;                    \
  53.         (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS);     \
  54.         sv_setsv(arg, DEFSV) ;                \
  55.         sv_setsv(DEFSV, save_defsv) ;            \
  56.         SvREFCNT_dec(save_defsv) ;                \
  57.         db->filtering = FALSE ;                \
  58.         /*printf("end of filtering %s\n", name) ;*/        \
  59.     }
  60.  
  61.  
  62. #define odbm_FETCH(db,key)            fetch(key)
  63. #define odbm_STORE(db,key,value,flags)        store(key,value)
  64. #define odbm_DELETE(db,key)            delete(key)
  65. #define odbm_FIRSTKEY(db)            firstkey()
  66. #define odbm_NEXTKEY(db,key)            nextkey(key)
  67.  
  68. static int dbmrefcnt;
  69.  
  70. #ifndef DBM_REPLACE
  71. #define DBM_REPLACE 0
  72. #endif
  73.  
  74. MODULE = ODBM_File    PACKAGE = ODBM_File    PREFIX = odbm_
  75.  
  76. ODBM_File
  77. odbm_TIEHASH(dbtype, filename, flags, mode)
  78.     char *        dbtype
  79.     char *        filename
  80.     int        flags
  81.     int        mode
  82.     CODE:
  83.     {
  84.         char *tmpbuf;
  85.         void * dbp ;
  86.         if (dbmrefcnt++)
  87.         croak("Old dbm can only open one database");
  88.         New(0, tmpbuf, strlen(filename) + 5, char);
  89.         SAVEFREEPV(tmpbuf);
  90.         sprintf(tmpbuf,"%s.dir",filename);
  91.         if (stat(tmpbuf, &PL_statbuf) < 0) {
  92.         if (flags & O_CREAT) {
  93.             if (mode < 0 || close(creat(tmpbuf,mode)) < 0)
  94.             croak("ODBM_File: Can't create %s", filename);
  95.             sprintf(tmpbuf,"%s.pag",filename);
  96.             if (close(creat(tmpbuf,mode)) < 0)
  97.             croak("ODBM_File: Can't create %s", filename);
  98.         }
  99.         else
  100.             croak("ODBM_FILE: Can't open %s", filename);
  101.         }
  102.         dbp = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
  103.         RETVAL = (ODBM_File)safemalloc(sizeof(ODBM_File_type)) ;
  104.             Zero(RETVAL, 1, ODBM_File_type) ;
  105.         RETVAL->dbp = dbp ;
  106.         ST(0) = sv_mortalcopy(&PL_sv_undef);
  107.         sv_setptrobj(ST(0), RETVAL, dbtype);
  108.     }
  109.  
  110. void
  111. DESTROY(db)
  112.     ODBM_File    db
  113.     CODE:
  114.     dbmrefcnt--;
  115.     dbmclose();
  116.     safefree(db);
  117.  
  118. datum_value
  119. odbm_FETCH(db, key)
  120.     ODBM_File    db
  121.     datum_key    key
  122.  
  123. int
  124. odbm_STORE(db, key, value, flags = DBM_REPLACE)
  125.     ODBM_File    db
  126.     datum_key    key
  127.     datum_value    value
  128.     int        flags
  129.     CLEANUP:
  130.     if (RETVAL) {
  131.         if (RETVAL < 0 && errno == EPERM)
  132.         croak("No write permission to odbm file");
  133.         croak("odbm store returned %d, errno %d, key \"%s\"",
  134.             RETVAL,errno,key.dptr);
  135.     }
  136.  
  137. int
  138. odbm_DELETE(db, key)
  139.     ODBM_File    db
  140.     datum_key    key
  141.  
  142. datum_key
  143. odbm_FIRSTKEY(db)
  144.     ODBM_File    db
  145.  
  146. datum_key
  147. odbm_NEXTKEY(db, key)
  148.     ODBM_File    db
  149.     datum_key    key
  150.  
  151.  
  152. #define setFilter(type)                    \
  153.     {                        \
  154.         if (db->type)                \
  155.             RETVAL = sv_mortalcopy(db->type) ;     \
  156.         ST(0) = RETVAL ;                \
  157.         if (db->type && (code == &PL_sv_undef)) {    \
  158.                 SvREFCNT_dec(db->type) ;        \
  159.             db->type = Nullsv ;            \
  160.         }                        \
  161.         else if (code) {                \
  162.             if (db->type)                \
  163.                 sv_setsv(db->type, code) ;        \
  164.             else                    \
  165.                 db->type = newSVsv(code) ;        \
  166.         }                            \
  167.     }
  168.  
  169.  
  170.  
  171. SV *
  172. filter_fetch_key(db, code)
  173.     ODBM_File    db
  174.     SV *        code
  175.     SV *        RETVAL = &PL_sv_undef ;
  176.     CODE:
  177.         setFilter(filter_fetch_key) ;
  178.  
  179. SV *
  180. filter_store_key(db, code)
  181.     ODBM_File    db
  182.     SV *        code
  183.     SV *        RETVAL =  &PL_sv_undef ;
  184.     CODE:
  185.         setFilter(filter_store_key) ;
  186.  
  187. SV *
  188. filter_fetch_value(db, code)
  189.     ODBM_File    db
  190.     SV *        code
  191.     SV *        RETVAL =  &PL_sv_undef ;
  192.     CODE:
  193.         setFilter(filter_fetch_value) ;
  194.  
  195. SV *
  196. filter_store_value(db, code)
  197.     ODBM_File    db
  198.     SV *        code
  199.     SV *        RETVAL =  &PL_sv_undef ;
  200.     CODE:
  201.         setFilter(filter_store_value) ;
  202.  
  203.