home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / ext / GDBM_File / GDBM_File.xs < prev    next >
Text File  |  2000-02-14  |  7KB  |  356 lines
  1. #include "EXTERN.h"
  2. #include "perl.h"
  3. #include "XSUB.h"
  4.  
  5. #include <gdbm.h>
  6. #include <fcntl.h>
  7.  
  8. typedef struct {
  9.     GDBM_FILE     dbp ;
  10.     SV *    filter_fetch_key ;
  11.     SV *    filter_store_key ;
  12.     SV *    filter_fetch_value ;
  13.     SV *    filter_store_value ;
  14.     int     filtering ;
  15.     } GDBM_File_type;
  16.  
  17. typedef GDBM_File_type * GDBM_File ;
  18. typedef datum datum_key ;
  19. typedef datum datum_value ;
  20.  
  21. #define ckFilter(arg,type,name)                    \
  22.     if (db->type) {                        \
  23.         SV * save_defsv ;                    \
  24.             /* printf("filtering %s\n", name) ;*/        \
  25.         if (db->filtering)                    \
  26.             croak("recursion detected in %s", name) ;    \
  27.         db->filtering = TRUE ;                \
  28.         save_defsv = newSVsv(DEFSV) ;            \
  29.         sv_setsv(DEFSV, arg) ;                \
  30.         PUSHMARK(sp) ;                    \
  31.         (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS);     \
  32.         sv_setsv(arg, DEFSV) ;                \
  33.         sv_setsv(DEFSV, save_defsv) ;            \
  34.         SvREFCNT_dec(save_defsv) ;                \
  35.         db->filtering = FALSE ;                \
  36.         /*printf("end of filtering %s\n", name) ;*/        \
  37.     }
  38.  
  39.  
  40.  
  41. #define GDBM_BLOCKSIZE 0 /* gdbm defaults to stat blocksize */
  42.  
  43. typedef void (*FATALFUNC)();
  44.  
  45. static int
  46. not_here(char *s)
  47. {
  48.     croak("GDBM_File::%s not implemented on this architecture", s);
  49.     return -1;
  50. }
  51.  
  52. /* GDBM allocates the datum with system malloc() and expects the user
  53.  * to free() it.  So we either have to free() it immediately, or have
  54.  * perl free() it when it deallocates the SV, depending on whether
  55.  * perl uses malloc()/free() or not. */
  56. static void
  57. output_datum(pTHX_ SV *arg, char *str, int size)
  58. {
  59. #if !defined(MYMALLOC) || (defined(MYMALLOC) && defined(PERL_POLLUTE_MALLOC))
  60.     sv_usepvn(arg, str, size);
  61. #else
  62.     sv_setpvn(arg, str, size);
  63.     safesysfree(str);
  64. #endif
  65. }
  66.  
  67. /* Versions of gdbm prior to 1.7x might not have the gdbm_sync,
  68.    gdbm_exists, and gdbm_setopt functions.  Apparently Slackware
  69.    (Linux) 2.1 contains gdbm-1.5 (which dates back to 1991).
  70. */
  71. #ifndef GDBM_FAST
  72. #define gdbm_exists(db,key) not_here("gdbm_exists")
  73. #define gdbm_sync(db) (void) not_here("gdbm_sync")
  74. #define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt")
  75. #endif
  76.  
  77. static double
  78. constant(char *name, int arg)
  79. {
  80.     errno = 0;
  81.     switch (*name) {
  82.     case 'A':
  83.     break;
  84.     case 'B':
  85.     break;
  86.     case 'C':
  87.     break;
  88.     case 'D':
  89.     break;
  90.     case 'E':
  91.     break;
  92.     case 'F':
  93.     break;
  94.     case 'G':
  95.     if (strEQ(name, "GDBM_CACHESIZE"))
  96. #ifdef GDBM_CACHESIZE
  97.         return GDBM_CACHESIZE;
  98. #else
  99.         goto not_there;
  100. #endif
  101.     if (strEQ(name, "GDBM_FAST"))
  102. #ifdef GDBM_FAST
  103.         return GDBM_FAST;
  104. #else
  105.         goto not_there;
  106. #endif
  107.     if (strEQ(name, "GDBM_FASTMODE"))
  108. #ifdef GDBM_FASTMODE
  109.         return GDBM_FASTMODE;
  110. #else
  111.         goto not_there;
  112. #endif
  113.     if (strEQ(name, "GDBM_INSERT"))
  114. #ifdef GDBM_INSERT
  115.         return GDBM_INSERT;
  116. #else
  117.         goto not_there;
  118. #endif
  119.     if (strEQ(name, "GDBM_NEWDB"))
  120. #ifdef GDBM_NEWDB
  121.         return GDBM_NEWDB;
  122. #else
  123.         goto not_there;
  124. #endif
  125.     if (strEQ(name, "GDBM_READER"))
  126. #ifdef GDBM_READER
  127.         return GDBM_READER;
  128. #else
  129.         goto not_there;
  130. #endif
  131.     if (strEQ(name, "GDBM_REPLACE"))
  132. #ifdef GDBM_REPLACE
  133.         return GDBM_REPLACE;
  134. #else
  135.         goto not_there;
  136. #endif
  137.     if (strEQ(name, "GDBM_WRCREAT"))
  138. #ifdef GDBM_WRCREAT
  139.         return GDBM_WRCREAT;
  140. #else
  141.         goto not_there;
  142. #endif
  143.     if (strEQ(name, "GDBM_WRITER"))
  144. #ifdef GDBM_WRITER
  145.         return GDBM_WRITER;
  146. #else
  147.         goto not_there;
  148. #endif
  149.     break;
  150.     case 'H':
  151.     break;
  152.     case 'I':
  153.     break;
  154.     case 'J':
  155.     break;
  156.     case 'K':
  157.     break;
  158.     case 'L':
  159.     break;
  160.     case 'M':
  161.     break;
  162.     case 'N':
  163.     break;
  164.     case 'O':
  165.     break;
  166.     case 'P':
  167.     break;
  168.     case 'Q':
  169.     break;
  170.     case 'R':
  171.     break;
  172.     case 'S':
  173.     break;
  174.     case 'T':
  175.     break;
  176.     case 'U':
  177.     break;
  178.     case 'V':
  179.     break;
  180.     case 'W':
  181.     break;
  182.     case 'X':
  183.     break;
  184.     case 'Y':
  185.     break;
  186.     case 'Z':
  187.     break;
  188.     }
  189.     errno = EINVAL;
  190.     return 0;
  191.  
  192. not_there:
  193.     errno = ENOENT;
  194.     return 0;
  195. }
  196.  
  197. MODULE = GDBM_File    PACKAGE = GDBM_File    PREFIX = gdbm_
  198.  
  199. double
  200. constant(name,arg)
  201.     char *        name
  202.     int        arg
  203.  
  204.  
  205. GDBM_File
  206. gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak)
  207.     char *        dbtype
  208.     char *        name
  209.     int        read_write
  210.     int        mode
  211.     FATALFUNC    fatal_func
  212.     CODE:
  213.     {
  214.         GDBM_FILE      dbp ;
  215.  
  216.         RETVAL = NULL ;
  217.         if (dbp =  gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func)) {
  218.             RETVAL = (GDBM_File)safemalloc(sizeof(GDBM_File_type)) ;
  219.                 Zero(RETVAL, 1, GDBM_File_type) ;
  220.         RETVAL->dbp = dbp ;
  221.         }
  222.         
  223.     }
  224.     OUTPUT:
  225.       RETVAL
  226.     
  227.  
  228. #define gdbm_close(db)            gdbm_close(db->dbp)
  229. void
  230. gdbm_close(db)
  231.     GDBM_File    db
  232.     CLEANUP:
  233.  
  234. void
  235. gdbm_DESTROY(db)
  236.     GDBM_File    db
  237.     CODE:
  238.     gdbm_close(db);
  239.     safefree(db);
  240.  
  241. #define gdbm_FETCH(db,key)            gdbm_fetch(db->dbp,key)
  242. datum_value
  243. gdbm_FETCH(db, key)
  244.     GDBM_File    db
  245.     datum_key    key
  246.  
  247. #define gdbm_STORE(db,key,value,flags)        gdbm_store(db->dbp,key,value,flags)
  248. int
  249. gdbm_STORE(db, key, value, flags = GDBM_REPLACE)
  250.     GDBM_File    db
  251.     datum_key    key
  252.     datum_value    value
  253.     int        flags
  254.     CLEANUP:
  255.     if (RETVAL) {
  256.         if (RETVAL < 0 && errno == EPERM)
  257.         croak("No write permission to gdbm file");
  258.         croak("gdbm store returned %d, errno %d, key \"%.*s\"",
  259.             RETVAL,errno,key.dsize,key.dptr);
  260.     }
  261.  
  262. #define gdbm_DELETE(db,key)            gdbm_delete(db->dbp,key)
  263. int
  264. gdbm_DELETE(db, key)
  265.     GDBM_File    db
  266.     datum_key    key
  267.  
  268. #define gdbm_FIRSTKEY(db)            gdbm_firstkey(db->dbp)
  269. datum_key
  270. gdbm_FIRSTKEY(db)
  271.     GDBM_File    db
  272.  
  273. #define gdbm_NEXTKEY(db,key)            gdbm_nextkey(db->dbp,key)
  274. datum_key
  275. gdbm_NEXTKEY(db, key)
  276.     GDBM_File    db
  277.     datum_key    key
  278.  
  279. #define gdbm_reorganize(db)            gdbm_reorganize(db->dbp)
  280. int
  281. gdbm_reorganize(db)
  282.     GDBM_File    db
  283.  
  284.  
  285. #define gdbm_sync(db)                gdbm_sync(db->dbp)
  286. void
  287. gdbm_sync(db)
  288.     GDBM_File    db
  289.  
  290. #define gdbm_EXISTS(db,key)            gdbm_exists(db->dbp,key)
  291. int
  292. gdbm_EXISTS(db, key)
  293.     GDBM_File    db
  294.     datum_key    key
  295.  
  296. #define gdbm_setopt(db,optflag, optval, optlen)    gdbm_setopt(db->dbp,optflag, optval, optlen)
  297. int
  298. gdbm_setopt (db, optflag, optval, optlen)
  299.     GDBM_File    db
  300.     int        optflag
  301.     int        &optval
  302.     int        optlen
  303.  
  304.  
  305. #define setFilter(type)                    \
  306.     {                        \
  307.         if (db->type)                \
  308.             RETVAL = sv_mortalcopy(db->type) ;     \
  309.         ST(0) = RETVAL ;                \
  310.         if (db->type && (code == &PL_sv_undef)) {    \
  311.                 SvREFCNT_dec(db->type) ;        \
  312.             db->type = NULL ;            \
  313.         }                        \
  314.         else if (code) {                \
  315.             if (db->type)                \
  316.                 sv_setsv(db->type, code) ;        \
  317.             else                    \
  318.                 db->type = newSVsv(code) ;        \
  319.         }                            \
  320.     }
  321.  
  322.  
  323.  
  324. SV *
  325. filter_fetch_key(db, code)
  326.     GDBM_File    db
  327.     SV *        code
  328.     SV *        RETVAL = &PL_sv_undef ;
  329.     CODE:
  330.         setFilter(filter_fetch_key) ;
  331.  
  332. SV *
  333. filter_store_key(db, code)
  334.     GDBM_File    db
  335.     SV *        code
  336.     SV *        RETVAL =  &PL_sv_undef ;
  337.     CODE:
  338.         setFilter(filter_store_key) ;
  339.  
  340. SV *
  341. filter_fetch_value(db, code)
  342.     GDBM_File    db
  343.     SV *        code
  344.     SV *        RETVAL =  &PL_sv_undef ;
  345.     CODE:
  346.         setFilter(filter_fetch_value) ;
  347.  
  348. SV *
  349. filter_store_value(db, code)
  350.     GDBM_File    db
  351.     SV *        code
  352.     SV *        RETVAL =  &PL_sv_undef ;
  353.     CODE:
  354.         setFilter(filter_store_value) ;
  355.  
  356.