home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / ext / DB_File / DB_File.xs < prev    next >
Text File  |  2000-02-14  |  46KB  |  2,002 lines
  1. /* 
  2.  
  3.  DB_File.xs -- Perl 5 interface to Berkeley DB 
  4.  
  5.  written by Paul Marquess <Paul.Marquess@btinternet.com>
  6.  last modified 16th January 2000
  7.  version 1.72
  8.  
  9.  All comments/suggestions/problems are welcome
  10.  
  11.      Copyright (c) 1995-2000 Paul Marquess. All rights reserved.
  12.      This program is free software; you can redistribute it and/or
  13.      modify it under the same terms as Perl itself.
  14.  
  15.  Changes:
  16.     0.1 -     Initial Release
  17.     0.2 -     No longer bombs out if dbopen returns an error.
  18.     0.3 -     Added some support for multiple btree compares
  19.     1.0 -     Complete support for multiple callbacks added.
  20.               Fixed a problem with pushing a value onto an empty list.
  21.     1.01 -     Fixed a SunOS core dump problem.
  22.         The return value from TIEHASH wasn't set to NULL when
  23.         dbopen returned an error.
  24.     1.02 -     Use ALIAS to define TIEARRAY.
  25.         Removed some redundant commented code.
  26.         Merged OS2 code into the main distribution.
  27.         Allow negative subscripts with RECNO interface.
  28.         Changed the default flags to O_CREAT|O_RDWR
  29.     1.03 -     Added EXISTS
  30.     1.04 -  fixed a couple of bugs in hash_cb. Patches supplied by
  31.         Dave Hammen, hammen@gothamcity.jsc.nasa.gov
  32.     1.05 -  Added logic to allow prefix & hash types to be specified via
  33.         Makefile.PL
  34.     1.06 -  Minor namespace cleanup: Localized PrintBtree.
  35.     1.07 -  Fixed bug with RECNO, where bval wasn't defaulting to "\n". 
  36.     1.08 -  No change to DB_File.xs
  37.     1.09 -  Default mode for dbopen changed to 0666
  38.     1.10 -  Fixed fd method so that it still returns -1 for
  39.         in-memory files when db 1.86 is used.
  40.     1.11 -  No change to DB_File.xs
  41.     1.12 -  No change to DB_File.xs
  42.     1.13 -  Tidied up a few casts.     
  43.     1.14 -    Made it illegal to tie an associative array to a RECNO
  44.         database and an ordinary array to a HASH or BTREE database.
  45.     1.50 -  Make work with both DB 1.x or DB 2.x
  46.     1.51 -  Fixed a bug in mapping 1.x O_RDONLY flag to 2.x DB_RDONLY equivalent
  47.     1.52 -  Patch from Gisle Aas <gisle@aas.no> to suppress "use of 
  48.         undefined value" warning with db_get and db_seq.
  49.     1.53 -  Added DB_RENUMBER to flags for recno.
  50.     1.54 -  Fixed bug in the fd method
  51.         1.55 -  Fix for AIX from Jarkko Hietaniemi
  52.         1.56 -  No change to DB_File.xs
  53.         1.57 -  added the #undef op to allow building with Threads support.
  54.     1.58 -  Fixed a problem with the use of sv_setpvn. When the
  55.         size is specified as 0, it does a strlen on the data.
  56.         This was ok for DB 1.x, but isn't for DB 2.x.
  57.         1.59 -  No change to DB_File.xs
  58.         1.60 -  Some code tidy up
  59.         1.61 -  added flagSet macro for DB 2.5.x
  60.         fixed typo in O_RDONLY test.
  61.         1.62 -  No change to DB_File.xs
  62.         1.63 -  Fix to alllow DB 2.6.x to build.
  63.         1.64 -  Tidied up the 1.x to 2.x flags mapping code.
  64.         Added a patch from Mark Kettenis <kettenis@wins.uva.nl>
  65.         to fix a flag mapping problem with O_RDONLY on the Hurd
  66.         1.65 -  Fixed a bug in the PUSH logic.
  67.         Added BOOT check that using 2.3.4 or greater
  68.         1.66 -  Added DBM filter code
  69.         1.67 -  Backed off the use of newSVpvn.
  70.         Fixed DBM Filter code for Perl 5.004.
  71.         Fixed a small memory leak in the filter code.
  72.         1.68 -  fixed backward compatability bug with R_IAFTER & R_IBEFORE
  73.         merged in the 5.005_58 changes
  74.         1.69 -  fixed a bug in push -- DB_APPEND wasn't working properly.
  75.         Fixed the R_SETCURSOR bug introduced in 1.68
  76.         Added a new Perl variable $DB_File::db_ver 
  77.         1.70 -  Initialise $DB_File::db_ver and $DB_File::db_version with 
  78.         GV_ADD|GV_ADDMULT -- bug spotted by Nick Ing-Simmons.
  79.         Added a BOOT check to test for equivalent versions of db.h &
  80.         libdb.a/so.
  81.         1.71 -  Support for Berkeley DB version 3.
  82.         Support for Berkeley DB 2/3's backward compatability mode.
  83.         Rewrote push
  84.         1.72 -  No change to DB_File.xs
  85.  
  86. */
  87.  
  88. #include "EXTERN.h"  
  89. #include "perl.h"
  90. #include "XSUB.h"
  91.  
  92. #ifndef PERL_VERSION
  93. #    include "patchlevel.h"
  94. #    define PERL_REVISION    5
  95. #    define PERL_VERSION    PATCHLEVEL
  96. #    define PERL_SUBVERSION    SUBVERSION
  97. #endif
  98.  
  99. #if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 ))
  100.  
  101. #    define PL_sv_undef        sv_undef
  102. #    define PL_na        na
  103.  
  104. #endif
  105.  
  106. /* DEFSV appears first in 5.004_56 */
  107. #ifndef DEFSV
  108. #    define DEFSV        GvSV(defgv)
  109. #endif
  110.  
  111. /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
  112.  * shortly #included by the <db.h>) __attribute__ to the possibly
  113.  * already defined __attribute__, for example by GNUC or by Perl. */
  114.  
  115. #undef __attribute__
  116.  
  117. /* If Perl has been compiled with Threads support,the symbol op will
  118.    be defined here. This clashes with a field name in db.h, so get rid of it.
  119.  */
  120. #ifdef op
  121. #    undef op
  122. #endif
  123.  
  124. #ifdef COMPAT185
  125. #    include <db_185.h>
  126. #else
  127. #    include <db.h>
  128. #endif
  129.  
  130. #ifndef pTHX
  131. #    define pTHX
  132. #    define pTHX_
  133. #    define aTHX
  134. #    define aTHX_
  135. #endif
  136.  
  137. #ifndef newSVpvn
  138. #    define newSVpvn(a,b)    newSVpv(a,b)
  139. #endif
  140.  
  141. #include <fcntl.h> 
  142.  
  143. /* #define TRACE */
  144. #define DBM_FILTERING
  145.  
  146. #ifdef TRACE
  147. #    define Trace(x)        printf x
  148. #else
  149. #    define Trace(x)
  150. #endif
  151.  
  152.  
  153. #define DBT_clear(x)    Zero(&x, 1, DBT) ;
  154.  
  155. #ifdef DB_VERSION_MAJOR
  156.  
  157. #if DB_VERSION_MAJOR == 2
  158. #    define BERKELEY_DB_1_OR_2
  159. #endif
  160.  
  161. /* map version 2 features & constants onto their version 1 equivalent */
  162.  
  163. #ifdef DB_Prefix_t
  164. #    undef DB_Prefix_t
  165. #endif
  166. #define DB_Prefix_t    size_t
  167.  
  168. #ifdef DB_Hash_t
  169. #    undef DB_Hash_t
  170. #endif
  171. #define DB_Hash_t    u_int32_t
  172.  
  173. /* DBTYPE stays the same */
  174. /* HASHINFO, RECNOINFO and BTREEINFO  map to DB_INFO */
  175. #if DB_VERSION_MAJOR == 2
  176.     typedef DB_INFO    INFO ;
  177. #else /* DB_VERSION_MAJOR > 2 */
  178. #    define DB_FIXEDLEN    (0x8000)
  179. #endif /* DB_VERSION_MAJOR == 2 */
  180.  
  181. /* version 2 has db_recno_t in place of recno_t    */
  182. typedef db_recno_t    recno_t;
  183.  
  184.  
  185. #define R_CURSOR        DB_SET_RANGE
  186. #define R_FIRST         DB_FIRST
  187. #define R_IAFTER        DB_AFTER
  188. #define R_IBEFORE       DB_BEFORE
  189. #define R_LAST          DB_LAST
  190. #define R_NEXT          DB_NEXT
  191. #define R_NOOVERWRITE   DB_NOOVERWRITE
  192. #define R_PREV          DB_PREV
  193.  
  194. #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
  195. #  define R_SETCURSOR    0x800000
  196. #else
  197. #  define R_SETCURSOR    (-100)
  198. #endif
  199.  
  200. #define R_RECNOSYNC     0
  201. #define R_FIXEDLEN    DB_FIXEDLEN
  202. #define R_DUP        DB_DUP
  203.  
  204.  
  205. #define db_HA_hash     h_hash
  206. #define db_HA_ffactor    h_ffactor
  207. #define db_HA_nelem    h_nelem
  208. #define db_HA_bsize    db_pagesize
  209. #define db_HA_cachesize    db_cachesize
  210. #define db_HA_lorder    db_lorder
  211.  
  212. #define db_BT_compare    bt_compare
  213. #define db_BT_prefix    bt_prefix
  214. #define db_BT_flags    flags
  215. #define db_BT_psize    db_pagesize
  216. #define db_BT_cachesize    db_cachesize
  217. #define db_BT_lorder    db_lorder
  218. #define db_BT_maxkeypage
  219. #define db_BT_minkeypage
  220.  
  221.  
  222. #define db_RE_reclen    re_len
  223. #define db_RE_flags    flags
  224. #define db_RE_bval    re_pad
  225. #define db_RE_bfname    re_source
  226. #define db_RE_psize    db_pagesize
  227. #define db_RE_cachesize    db_cachesize
  228. #define db_RE_lorder    db_lorder
  229.  
  230. #define TXN    NULL,
  231.  
  232. #define do_SEQ(db, key, value, flag)    (db->cursor->c_get)(db->cursor, &key, &value, flag)
  233.  
  234.  
  235. #define DBT_flags(x)    x.flags = 0
  236. #define DB_flags(x, v)    x |= v 
  237.  
  238. #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
  239. #    define flagSet(flags, bitmask)    ((flags) & (bitmask))
  240. #else
  241. #    define flagSet(flags, bitmask)    (((flags) & DB_OPFLAGS_MASK) == (bitmask))
  242. #endif
  243.  
  244. #else /* db version 1.x */
  245.  
  246. #define BERKELEY_DB_1_OR_2
  247.  
  248. typedef union INFO {
  249.         HASHINFO     hash ;
  250.         RECNOINFO     recno ;
  251.         BTREEINFO     btree ;
  252.       } INFO ;
  253.  
  254.  
  255. #ifdef mDB_Prefix_t 
  256. #  ifdef DB_Prefix_t
  257. #    undef DB_Prefix_t
  258. #  endif
  259. #  define DB_Prefix_t    mDB_Prefix_t 
  260. #endif
  261.  
  262. #ifdef mDB_Hash_t
  263. #  ifdef DB_Hash_t
  264. #    undef DB_Hash_t
  265. #  endif
  266. #  define DB_Hash_t    mDB_Hash_t
  267. #endif
  268.  
  269. #define db_HA_hash     hash.hash
  270. #define db_HA_ffactor    hash.ffactor
  271. #define db_HA_nelem    hash.nelem
  272. #define db_HA_bsize    hash.bsize
  273. #define db_HA_cachesize    hash.cachesize
  274. #define db_HA_lorder    hash.lorder
  275.  
  276. #define db_BT_compare    btree.compare
  277. #define db_BT_prefix    btree.prefix
  278. #define db_BT_flags    btree.flags
  279. #define db_BT_psize    btree.psize
  280. #define db_BT_cachesize    btree.cachesize
  281. #define db_BT_lorder    btree.lorder
  282. #define db_BT_maxkeypage btree.maxkeypage
  283. #define db_BT_minkeypage btree.minkeypage
  284.  
  285. #define db_RE_reclen    recno.reclen
  286. #define db_RE_flags    recno.flags
  287. #define db_RE_bval    recno.bval
  288. #define db_RE_bfname    recno.bfname
  289. #define db_RE_psize    recno.psize
  290. #define db_RE_cachesize    recno.cachesize
  291. #define db_RE_lorder    recno.lorder
  292.  
  293. #define TXN    
  294.  
  295. #define do_SEQ(db, key, value, flag)    (db->dbp->seq)(db->dbp, &key, &value, flag)
  296. #define DBT_flags(x)    
  297. #define DB_flags(x, v)    
  298. #define flagSet(flags, bitmask)        ((flags) & (bitmask))
  299.  
  300. #endif /* db version 1 */
  301.  
  302.  
  303.  
  304. #define db_DELETE(db, key, flags)       ((db->dbp)->del)(db->dbp, TXN &key, flags)
  305. #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, flags)
  306. #define db_FETCH(db, key, flags)        ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
  307.  
  308. #define db_sync(db, flags)              ((db->dbp)->sync)(db->dbp, flags)
  309. #define db_get(db, key, value, flags)   ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
  310.  
  311. #ifdef DB_VERSION_MAJOR
  312. #define db_DESTROY(db)                  ( db->cursor->c_close(db->cursor),\
  313.                       (db->dbp->close)(db->dbp, 0) )
  314. #define db_close(db)            ((db->dbp)->close)(db->dbp, 0)
  315. #define db_del(db, key, flags)          (flagSet(flags, R_CURSOR)                     \
  316.                         ? ((db->cursor)->c_del)(db->cursor, 0)        \
  317.                         : ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
  318.  
  319. #else /* ! DB_VERSION_MAJOR */
  320.  
  321. #define db_DESTROY(db)                  ((db->dbp)->close)(db->dbp)
  322. #define db_close(db)            ((db->dbp)->close)(db->dbp)
  323. #define db_del(db, key, flags)          ((db->dbp)->del)(db->dbp, &key, flags)
  324. #define db_put(db, key, value, flags)   ((db->dbp)->put)(db->dbp, &key, &value, flags)
  325.  
  326. #endif /* ! DB_VERSION_MAJOR */
  327.  
  328.  
  329. #define db_seq(db, key, value, flags)   do_SEQ(db, key, value, flags)
  330.  
  331. typedef struct {
  332.     DBTYPE    type ;
  333.     DB *     dbp ;
  334.     SV *    compare ;
  335.     SV *    prefix ;
  336.     SV *    hash ;
  337.     int    in_memory ;
  338. #ifdef BERKELEY_DB_1_OR_2
  339.     INFO     info ;
  340. #endif    
  341. #ifdef DB_VERSION_MAJOR
  342.     DBC *    cursor ;
  343. #endif
  344. #ifdef DBM_FILTERING
  345.     SV *    filter_fetch_key ;
  346.     SV *    filter_store_key ;
  347.     SV *    filter_fetch_value ;
  348.     SV *    filter_store_value ;
  349.     int     filtering ;
  350. #endif /* DBM_FILTERING */
  351.  
  352.     } DB_File_type;
  353.  
  354. typedef DB_File_type * DB_File ;
  355. typedef DBT DBTKEY ;
  356.  
  357. #ifdef DBM_FILTERING
  358.  
  359. #define ckFilter(arg,type,name)                    \
  360.     if (db->type) {                        \
  361.         SV * save_defsv ;                    \
  362.             /* printf("filtering %s\n", name) ;*/        \
  363.         if (db->filtering)                    \
  364.             croak("recursion detected in %s", name) ;    \
  365.         db->filtering = TRUE ;                \
  366.         save_defsv = newSVsv(DEFSV) ;            \
  367.         sv_setsv(DEFSV, arg) ;                \
  368.         PUSHMARK(sp) ;                    \
  369.         (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS);     \
  370.         sv_setsv(arg, DEFSV) ;                \
  371.         sv_setsv(DEFSV, save_defsv) ;            \
  372.         SvREFCNT_dec(save_defsv) ;                \
  373.         db->filtering = FALSE ;                \
  374.         /*printf("end of filtering %s\n", name) ;*/        \
  375.     }
  376.  
  377. #else
  378.  
  379. #define ckFilter(arg,type, name)
  380.  
  381. #endif /* DBM_FILTERING */
  382.  
  383. #define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
  384.  
  385. #define OutputValue(arg, name)                      \
  386.     { if (RETVAL == 0) {                        \
  387.           my_sv_setpvn(arg, name.data, name.size) ;            \
  388.           ckFilter(arg, filter_fetch_value,"filter_fetch_value") ;     \
  389.       }                                \
  390.     }
  391.  
  392. #define OutputKey(arg, name)                         \
  393.     { if (RETVAL == 0)                         \
  394.       {                                 \
  395.         if (db->type != DB_RECNO) {                \
  396.             my_sv_setpvn(arg, name.data, name.size);         \
  397.         }                            \
  398.         else                             \
  399.             sv_setiv(arg, (I32)*(I32*)name.data - 1);         \
  400.           ckFilter(arg, filter_fetch_key,"filter_fetch_key") ;     \
  401.       }                                 \
  402.     }
  403.  
  404.  
  405. /* Internal Global Data */
  406. static recno_t Value ; 
  407. static recno_t zero = 0 ;
  408. static DB_File CurrentDB ;
  409. static DBTKEY empty ;
  410.  
  411. #ifdef DB_VERSION_MAJOR
  412.  
  413. static int
  414. #ifdef CAN_PROTOTYPE
  415. db_put(DB_File db, DBTKEY key, DBT value, u_int flags)
  416. #else
  417. db_put(db, key, value, flags)
  418. DB_File        db ;
  419. DBTKEY        key ;
  420. DBT        value ;
  421. u_int        flags ;
  422. #endif
  423. {
  424.     int status ;
  425.  
  426.     if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) {
  427.         DBC * temp_cursor ;
  428.     DBT l_key, l_value;
  429.         
  430. #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
  431.         if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor) != 0)
  432. #else
  433.         if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor, 0) != 0)
  434. #endif
  435.         return (-1) ;
  436.  
  437.     memset(&l_key, 0, sizeof(l_key));
  438.     l_key.data = key.data;
  439.     l_key.size = key.size;
  440.     memset(&l_value, 0, sizeof(l_value));
  441.     l_value.data = value.data;
  442.     l_value.size = value.size;
  443.  
  444.     if ( temp_cursor->c_get(temp_cursor, &l_key, &l_value, DB_SET) != 0) {
  445.         (void)temp_cursor->c_close(temp_cursor);
  446.         return (-1);
  447.     }
  448.  
  449.     status = temp_cursor->c_put(temp_cursor, &key, &value, flags);
  450.     (void)temp_cursor->c_close(temp_cursor);
  451.         
  452.         return (status) ;
  453.     }    
  454.     
  455.     
  456.     if (flagSet(flags, R_CURSOR)) {
  457.     return ((db->cursor)->c_put)(db->cursor, &key, &value, DB_CURRENT);
  458.     }
  459.  
  460.     if (flagSet(flags, R_SETCURSOR)) {
  461.     if ((db->dbp)->put(db->dbp, NULL, &key, &value, 0) != 0)
  462.         return -1 ;
  463.         return ((db->cursor)->c_get)(db->cursor, &key, &value, DB_SET_RANGE);
  464.     
  465.     }
  466.  
  467.     return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
  468.  
  469. }
  470.  
  471. #endif /* DB_VERSION_MAJOR */
  472.  
  473.  
  474. static int
  475. #ifdef CAN_PROTOTYPE
  476. btree_compare(const DBT *key1, const DBT *key2)
  477. #else
  478. btree_compare(key1, key2)
  479. const DBT * key1 ;
  480. const DBT * key2 ;
  481. #endif
  482. {
  483. #ifdef dTHX
  484.     dTHX;
  485. #endif    
  486.     dSP ;
  487.     void * data1, * data2 ;
  488.     int retval ;
  489.     int count ;
  490.     
  491.     data1 = key1->data ;
  492.     data2 = key2->data ;
  493.  
  494. #ifndef newSVpvn
  495.     /* As newSVpv will assume that the data pointer is a null terminated C 
  496.        string if the size parameter is 0, make sure that data points to an 
  497.        empty string if the length is 0
  498.     */
  499.     if (key1->size == 0)
  500.         data1 = "" ; 
  501.     if (key2->size == 0)
  502.         data2 = "" ;
  503. #endif    
  504.  
  505.     ENTER ;
  506.     SAVETMPS;
  507.  
  508.     PUSHMARK(SP) ;
  509.     EXTEND(SP,2) ;
  510.     PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
  511.     PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
  512.     PUTBACK ;
  513.  
  514.     count = perl_call_sv(CurrentDB->compare, G_SCALAR); 
  515.  
  516.     SPAGAIN ;
  517.  
  518.     if (count != 1)
  519.         croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
  520.  
  521.     retval = POPi ;
  522.  
  523.     PUTBACK ;
  524.     FREETMPS ;
  525.     LEAVE ;
  526.     return (retval) ;
  527.  
  528. }
  529.  
  530. static DB_Prefix_t
  531. #ifdef CAN_PROTOTYPE
  532. btree_prefix(const DBT *key1, const DBT *key2)
  533. #else
  534. btree_prefix(key1, key2)
  535. const DBT * key1 ;
  536. const DBT * key2 ;
  537. #endif
  538. {
  539. #ifdef dTHX
  540.     dTHX;
  541. #endif    
  542.     dSP ;
  543.     void * data1, * data2 ;
  544.     int retval ;
  545.     int count ;
  546.     
  547.     data1 = key1->data ;
  548.     data2 = key2->data ;
  549.  
  550. #ifndef newSVpvn
  551.     /* As newSVpv will assume that the data pointer is a null terminated C 
  552.        string if the size parameter is 0, make sure that data points to an 
  553.        empty string if the length is 0
  554.     */
  555.     if (key1->size == 0)
  556.         data1 = "" ;
  557.     if (key2->size == 0)
  558.         data2 = "" ;
  559. #endif    
  560.  
  561.     ENTER ;
  562.     SAVETMPS;
  563.  
  564.     PUSHMARK(SP) ;
  565.     EXTEND(SP,2) ;
  566.     PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
  567.     PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
  568.     PUTBACK ;
  569.  
  570.     count = perl_call_sv(CurrentDB->prefix, G_SCALAR); 
  571.  
  572.     SPAGAIN ;
  573.  
  574.     if (count != 1)
  575.         croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
  576.  
  577.     retval = POPi ;
  578.  
  579.     PUTBACK ;
  580.     FREETMPS ;
  581.     LEAVE ;
  582.  
  583.     return (retval) ;
  584. }
  585.  
  586. static DB_Hash_t
  587. #ifdef CAN_PROTOTYPE
  588. hash_cb(const void *data, size_t size)
  589. #else
  590. hash_cb(data, size)
  591. const void * data ;
  592. size_t size ;
  593. #endif
  594. {
  595. #ifdef dTHX
  596.     dTHX;
  597. #endif    
  598.     dSP ;
  599.     int retval ;
  600.     int count ;
  601.  
  602. #ifndef newSVpvn
  603.     if (size == 0)
  604.         data = "" ;
  605. #endif    
  606.  
  607.      /* DGH - Next two lines added to fix corrupted stack problem */
  608.     ENTER ;
  609.     SAVETMPS;
  610.  
  611.     PUSHMARK(SP) ;
  612.  
  613.     XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
  614.     PUTBACK ;
  615.  
  616.     count = perl_call_sv(CurrentDB->hash, G_SCALAR); 
  617.  
  618.     SPAGAIN ;
  619.  
  620.     if (count != 1)
  621.         croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
  622.  
  623.     retval = POPi ;
  624.  
  625.     PUTBACK ;
  626.     FREETMPS ;
  627.     LEAVE ;
  628.  
  629.     return (retval) ;
  630. }
  631.  
  632.  
  633. #if defined(TRACE) && defined(BERKELEY_DB_1_OR_2)
  634.  
  635. static void
  636. #ifdef CAN_PROTOTYPE
  637. PrintHash(INFO *hash)
  638. #else
  639. PrintHash(hash)
  640. INFO * hash ;
  641. #endif
  642. {
  643.     printf ("HASH Info\n") ;
  644.     printf ("  hash      = %s\n", 
  645.         (hash->db_HA_hash != NULL ? "redefined" : "default")) ;
  646.     printf ("  bsize     = %d\n", hash->db_HA_bsize) ;
  647.     printf ("  ffactor   = %d\n", hash->db_HA_ffactor) ;
  648.     printf ("  nelem     = %d\n", hash->db_HA_nelem) ;
  649.     printf ("  cachesize = %d\n", hash->db_HA_cachesize) ;
  650.     printf ("  lorder    = %d\n", hash->db_HA_lorder) ;
  651.  
  652. }
  653.  
  654. static void
  655. #ifdef CAN_PROTOTYPE
  656. PrintRecno(INFO *recno)
  657. #else
  658. PrintRecno(recno)
  659. INFO * recno ;
  660. #endif
  661. {
  662.     printf ("RECNO Info\n") ;
  663.     printf ("  flags     = %d\n", recno->db_RE_flags) ;
  664.     printf ("  cachesize = %d\n", recno->db_RE_cachesize) ;
  665.     printf ("  psize     = %d\n", recno->db_RE_psize) ;
  666.     printf ("  lorder    = %d\n", recno->db_RE_lorder) ;
  667.     printf ("  reclen    = %ul\n", (unsigned long)recno->db_RE_reclen) ;
  668.     printf ("  bval      = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
  669.     printf ("  bfname    = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
  670. }
  671.  
  672. static void
  673. #ifdef CAN_PROTOTYPE
  674. PrintBtree(INFO *btree)
  675. #else
  676. PrintBtree(btree)
  677. INFO * btree ;
  678. #endif
  679. {
  680.     printf ("BTREE Info\n") ;
  681.     printf ("  compare    = %s\n", 
  682.         (btree->db_BT_compare ? "redefined" : "default")) ;
  683.     printf ("  prefix     = %s\n", 
  684.         (btree->db_BT_prefix ? "redefined" : "default")) ;
  685.     printf ("  flags      = %d\n", btree->db_BT_flags) ;
  686.     printf ("  cachesize  = %d\n", btree->db_BT_cachesize) ;
  687.     printf ("  psize      = %d\n", btree->db_BT_psize) ;
  688. #ifndef DB_VERSION_MAJOR
  689.     printf ("  maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
  690.     printf ("  minkeypage = %d\n", btree->db_BT_minkeypage) ;
  691. #endif
  692.     printf ("  lorder     = %d\n", btree->db_BT_lorder) ;
  693. }
  694.  
  695. #else
  696.  
  697. #define PrintRecno(recno)
  698. #define PrintHash(hash)
  699. #define PrintBtree(btree)
  700.  
  701. #endif /* TRACE */
  702.  
  703.  
  704. static I32
  705. #ifdef CAN_PROTOTYPE
  706. GetArrayLength(pTHX_ DB_File db)
  707. #else
  708. GetArrayLength(db)
  709. DB_File db ;
  710. #endif
  711. {
  712.     DBT        key ;
  713.     DBT        value ;
  714.     int        RETVAL ;
  715.  
  716.     DBT_clear(key) ;
  717.     DBT_clear(value) ;
  718.     RETVAL = do_SEQ(db, key, value, R_LAST) ;
  719.     if (RETVAL == 0)
  720.         RETVAL = *(I32 *)key.data ;
  721.     else /* No key means empty file */
  722.         RETVAL = 0 ;
  723.  
  724.     return ((I32)RETVAL) ;
  725. }
  726.  
  727. static recno_t
  728. #ifdef CAN_PROTOTYPE
  729. GetRecnoKey(pTHX_ DB_File db, I32 value)
  730. #else
  731. GetRecnoKey(db, value)
  732. DB_File  db ;
  733. I32      value ;
  734. #endif
  735. {
  736.     if (value < 0) {
  737.     /* Get the length of the array */
  738.     I32 length = GetArrayLength(aTHX_ db) ;
  739.  
  740.     /* check for attempt to write before start of array */
  741.     if (length + value + 1 <= 0)
  742.         croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
  743.  
  744.     value = length + value + 1 ;
  745.     }
  746.     else
  747.         ++ value ;
  748.  
  749.     return value ;
  750. }
  751.  
  752.  
  753. static DB_File
  754. #ifdef CAN_PROTOTYPE
  755. ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv)
  756. #else
  757. ParseOpenInfo(isHASH, name, flags, mode, sv)
  758. int    isHASH ;
  759. char * name ;
  760. int    flags ;
  761. int    mode ;
  762. SV *   sv ;
  763. #endif
  764. {
  765.  
  766. #ifdef BERKELEY_DB_1_OR_2 /* Berkeley DB Version 1  or 2 */
  767.  
  768.     SV **    svp;
  769.     HV *    action ;
  770.     DB_File    RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
  771.     void *    openinfo = NULL ;
  772.     INFO    * info  = &RETVAL->info ;
  773.     STRLEN    n_a;
  774.  
  775. /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ;  */
  776.     Zero(RETVAL, 1, DB_File_type) ;
  777.  
  778.     /* Default to HASH */
  779. #ifdef DBM_FILTERING
  780.     RETVAL->filtering = 0 ;
  781.     RETVAL->filter_fetch_key = RETVAL->filter_store_key = 
  782.     RETVAL->filter_fetch_value = RETVAL->filter_store_value =
  783. #endif /* DBM_FILTERING */
  784.     RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
  785.     RETVAL->type = DB_HASH ;
  786.  
  787.      /* DGH - Next line added to avoid SEGV on existing hash DB */
  788.     CurrentDB = RETVAL; 
  789.  
  790.     /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
  791.     RETVAL->in_memory = (name == NULL) ;
  792.  
  793.     if (sv)
  794.     {
  795.         if (! SvROK(sv) )
  796.             croak ("type parameter is not a reference") ;
  797.  
  798.         svp  = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
  799.         if (svp && SvOK(*svp))
  800.             action  = (HV*) SvRV(*svp) ;
  801.     else
  802.         croak("internal error") ;
  803.  
  804.         if (sv_isa(sv, "DB_File::HASHINFO"))
  805.         {
  806.  
  807.         if (!isHASH)
  808.             croak("DB_File can only tie an associative array to a DB_HASH database") ;
  809.  
  810.             RETVAL->type = DB_HASH ;
  811.             openinfo = (void*)info ;
  812.   
  813.             svp = hv_fetch(action, "hash", 4, FALSE); 
  814.  
  815.             if (svp && SvOK(*svp))
  816.             {
  817.                 info->db_HA_hash = hash_cb ;
  818.         RETVAL->hash = newSVsv(*svp) ;
  819.             }
  820.             else
  821.             info->db_HA_hash = NULL ;
  822.  
  823.            svp = hv_fetch(action, "ffactor", 7, FALSE);
  824.            info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
  825.          
  826.            svp = hv_fetch(action, "nelem", 5, FALSE);
  827.            info->db_HA_nelem = svp ? SvIV(*svp) : 0;
  828.          
  829.            svp = hv_fetch(action, "bsize", 5, FALSE);
  830.            info->db_HA_bsize = svp ? SvIV(*svp) : 0;
  831.            
  832.            svp = hv_fetch(action, "cachesize", 9, FALSE);
  833.            info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
  834.          
  835.            svp = hv_fetch(action, "lorder", 6, FALSE);
  836.            info->db_HA_lorder = svp ? SvIV(*svp) : 0;
  837.  
  838.            PrintHash(info) ; 
  839.         }
  840.         else if (sv_isa(sv, "DB_File::BTREEINFO"))
  841.         {
  842.         if (!isHASH)
  843.             croak("DB_File can only tie an associative array to a DB_BTREE database");
  844.  
  845.             RETVAL->type = DB_BTREE ;
  846.             openinfo = (void*)info ;
  847.    
  848.             svp = hv_fetch(action, "compare", 7, FALSE);
  849.             if (svp && SvOK(*svp))
  850.             {
  851.                 info->db_BT_compare = btree_compare ;
  852.         RETVAL->compare = newSVsv(*svp) ;
  853.             }
  854.             else
  855.                 info->db_BT_compare = NULL ;
  856.  
  857.             svp = hv_fetch(action, "prefix", 6, FALSE);
  858.             if (svp && SvOK(*svp))
  859.             {
  860.                 info->db_BT_prefix = btree_prefix ;
  861.         RETVAL->prefix = newSVsv(*svp) ;
  862.             }
  863.             else
  864.                 info->db_BT_prefix = NULL ;
  865.  
  866.             svp = hv_fetch(action, "flags", 5, FALSE);
  867.             info->db_BT_flags = svp ? SvIV(*svp) : 0;
  868.    
  869.             svp = hv_fetch(action, "cachesize", 9, FALSE);
  870.             info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
  871.          
  872. #ifndef DB_VERSION_MAJOR
  873.             svp = hv_fetch(action, "minkeypage", 10, FALSE);
  874.             info->btree.minkeypage = svp ? SvIV(*svp) : 0;
  875.         
  876.             svp = hv_fetch(action, "maxkeypage", 10, FALSE);
  877.             info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
  878. #endif
  879.  
  880.             svp = hv_fetch(action, "psize", 5, FALSE);
  881.             info->db_BT_psize = svp ? SvIV(*svp) : 0;
  882.          
  883.             svp = hv_fetch(action, "lorder", 6, FALSE);
  884.             info->db_BT_lorder = svp ? SvIV(*svp) : 0;
  885.  
  886.             PrintBtree(info) ;
  887.          
  888.         }
  889.         else if (sv_isa(sv, "DB_File::RECNOINFO"))
  890.         {
  891.         if (isHASH)
  892.             croak("DB_File can only tie an array to a DB_RECNO database");
  893.  
  894.             RETVAL->type = DB_RECNO ;
  895.             openinfo = (void *)info ;
  896.  
  897.         info->db_RE_flags = 0 ;
  898.  
  899.             svp = hv_fetch(action, "flags", 5, FALSE);
  900.             info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
  901.          
  902.             svp = hv_fetch(action, "reclen", 6, FALSE);
  903.             info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
  904.          
  905.             svp = hv_fetch(action, "cachesize", 9, FALSE);
  906.             info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
  907.          
  908.             svp = hv_fetch(action, "psize", 5, FALSE);
  909.             info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
  910.          
  911.             svp = hv_fetch(action, "lorder", 6, FALSE);
  912.             info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
  913.  
  914. #ifdef DB_VERSION_MAJOR
  915.         info->re_source = name ;
  916.         name = NULL ;
  917. #endif
  918.             svp = hv_fetch(action, "bfname", 6, FALSE); 
  919.             if (svp && SvOK(*svp)) {
  920.         char * ptr = SvPV(*svp,n_a) ;
  921. #ifdef DB_VERSION_MAJOR
  922.         name = (char*) n_a ? ptr : NULL ;
  923. #else
  924.                 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
  925. #endif
  926.         }
  927.         else
  928. #ifdef DB_VERSION_MAJOR
  929.         name = NULL ;
  930. #else
  931.                 info->db_RE_bfname = NULL ;
  932. #endif
  933.          
  934.         svp = hv_fetch(action, "bval", 4, FALSE);
  935. #ifdef DB_VERSION_MAJOR
  936.             if (svp && SvOK(*svp))
  937.             {
  938.         int value ;
  939.                 if (SvPOK(*svp))
  940.             value = (int)*SvPV(*svp, n_a) ;
  941.         else
  942.             value = SvIV(*svp) ;
  943.  
  944.         if (info->flags & DB_FIXEDLEN) {
  945.             info->re_pad = value ;
  946.             info->flags |= DB_PAD ;
  947.         }
  948.         else {
  949.             info->re_delim = value ;
  950.             info->flags |= DB_DELIMITER ;
  951.         }
  952.  
  953.             }
  954. #else
  955.             if (svp && SvOK(*svp))
  956.             {
  957.                 if (SvPOK(*svp))
  958.             info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
  959.         else
  960.             info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
  961.         DB_flags(info->flags, DB_DELIMITER) ;
  962.  
  963.             }
  964.             else
  965.          {
  966.         if (info->db_RE_flags & R_FIXEDLEN)
  967.                     info->db_RE_bval = (u_char) ' ' ;
  968.         else
  969.                     info->db_RE_bval = (u_char) '\n' ;
  970.         DB_flags(info->flags, DB_DELIMITER) ;
  971.         }
  972. #endif
  973.  
  974. #ifdef DB_RENUMBER
  975.         info->flags |= DB_RENUMBER ;
  976. #endif
  977.          
  978.             PrintRecno(info) ;
  979.         }
  980.         else
  981.             croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
  982.     }
  983.  
  984.  
  985.     /* OS2 Specific Code */
  986. #ifdef OS2
  987. #ifdef __EMX__
  988.     flags |= O_BINARY;
  989. #endif /* __EMX__ */
  990. #endif /* OS2 */
  991.  
  992. #ifdef DB_VERSION_MAJOR
  993.  
  994.     {
  995.         int         Flags = 0 ;
  996.         int        status ;
  997.  
  998.         /* Map 1.x flags to 2.x flags */
  999.         if ((flags & O_CREAT) == O_CREAT)
  1000.             Flags |= DB_CREATE ;
  1001.  
  1002. #if O_RDONLY == 0
  1003.         if (flags == O_RDONLY)
  1004. #else
  1005.         if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
  1006. #endif
  1007.             Flags |= DB_RDONLY ;
  1008.  
  1009. #ifdef O_TRUNC
  1010.         if ((flags & O_TRUNC) == O_TRUNC)
  1011.             Flags |= DB_TRUNCATE ;
  1012. #endif
  1013.  
  1014.         status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ; 
  1015.         if (status == 0)
  1016. #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
  1017.             status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
  1018. #else
  1019.             status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
  1020.             0) ;
  1021. #endif
  1022.  
  1023.         if (status)
  1024.         RETVAL->dbp = NULL ;
  1025.  
  1026.     }
  1027. #else
  1028.  
  1029. #if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2
  1030.     RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ; 
  1031. #else    
  1032.     RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ; 
  1033. #endif /* DB_LIBRARY_COMPATIBILITY_API */
  1034.  
  1035. #endif
  1036.  
  1037.     return (RETVAL) ;
  1038.  
  1039. #else /* Berkeley DB Version > 2 */
  1040.  
  1041.     SV **    svp;
  1042.     HV *    action ;
  1043.     DB_File    RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
  1044.     DB *    dbp ;
  1045.     STRLEN    n_a;
  1046.     int        status ;
  1047.  
  1048. /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ;  */
  1049.     Zero(RETVAL, 1, DB_File_type) ;
  1050.  
  1051.     /* Default to HASH */
  1052. #ifdef DBM_FILTERING
  1053.     RETVAL->filtering = 0 ;
  1054.     RETVAL->filter_fetch_key = RETVAL->filter_store_key = 
  1055.     RETVAL->filter_fetch_value = RETVAL->filter_store_value =
  1056. #endif /* DBM_FILTERING */
  1057.     RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
  1058.     RETVAL->type = DB_HASH ;
  1059.  
  1060.      /* DGH - Next line added to avoid SEGV on existing hash DB */
  1061.     CurrentDB = RETVAL; 
  1062.  
  1063.     /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
  1064.     RETVAL->in_memory = (name == NULL) ;
  1065.  
  1066.     status = db_create(&RETVAL->dbp, NULL,0) ;
  1067.     /* printf("db_create returned %d %s\n", status, db_strerror(status)) ; */
  1068.     if (status) {
  1069.     RETVAL->dbp = NULL ;
  1070.         return (RETVAL) ;
  1071.     }    
  1072.     dbp = RETVAL->dbp ;
  1073.  
  1074.     if (sv)
  1075.     {
  1076.         if (! SvROK(sv) )
  1077.             croak ("type parameter is not a reference") ;
  1078.  
  1079.         svp  = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
  1080.         if (svp && SvOK(*svp))
  1081.             action  = (HV*) SvRV(*svp) ;
  1082.     else
  1083.         croak("internal error") ;
  1084.  
  1085.         if (sv_isa(sv, "DB_File::HASHINFO"))
  1086.         {
  1087.  
  1088.         if (!isHASH)
  1089.             croak("DB_File can only tie an associative array to a DB_HASH database") ;
  1090.  
  1091.             RETVAL->type = DB_HASH ;
  1092.   
  1093.             svp = hv_fetch(action, "hash", 4, FALSE); 
  1094.  
  1095.             if (svp && SvOK(*svp))
  1096.             {
  1097.         (void)dbp->set_h_hash(dbp, hash_cb) ;
  1098.         RETVAL->hash = newSVsv(*svp) ;
  1099.             }
  1100.  
  1101.            svp = hv_fetch(action, "ffactor", 7, FALSE);
  1102.        if (svp)
  1103.            (void)dbp->set_h_ffactor(dbp, SvIV(*svp)) ;
  1104.          
  1105.            svp = hv_fetch(action, "nelem", 5, FALSE);
  1106.        if (svp)
  1107.                (void)dbp->set_h_nelem(dbp, SvIV(*svp)) ;
  1108.          
  1109.            svp = hv_fetch(action, "bsize", 5, FALSE);
  1110.        if (svp)
  1111.                (void)dbp->set_pagesize(dbp, SvIV(*svp));
  1112.            
  1113.            svp = hv_fetch(action, "cachesize", 9, FALSE);
  1114.        if (svp)
  1115.                (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
  1116.          
  1117.            svp = hv_fetch(action, "lorder", 6, FALSE);
  1118.        if (svp)
  1119.                (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
  1120.  
  1121.            PrintHash(info) ; 
  1122.         }
  1123.         else if (sv_isa(sv, "DB_File::BTREEINFO"))
  1124.         {
  1125.         if (!isHASH)
  1126.             croak("DB_File can only tie an associative array to a DB_BTREE database");
  1127.  
  1128.             RETVAL->type = DB_BTREE ;
  1129.    
  1130.             svp = hv_fetch(action, "compare", 7, FALSE);
  1131.             if (svp && SvOK(*svp))
  1132.             {
  1133.                 (void)dbp->set_bt_compare(dbp, btree_compare) ;
  1134.         RETVAL->compare = newSVsv(*svp) ;
  1135.             }
  1136.  
  1137.             svp = hv_fetch(action, "prefix", 6, FALSE);
  1138.             if (svp && SvOK(*svp))
  1139.             {
  1140.                 (void)dbp->set_bt_prefix(dbp, btree_prefix) ;
  1141.         RETVAL->prefix = newSVsv(*svp) ;
  1142.             }
  1143.  
  1144.            svp = hv_fetch(action, "flags", 5, FALSE);
  1145.        if (svp)
  1146.            (void)dbp->set_flags(dbp, SvIV(*svp)) ;
  1147.    
  1148.            svp = hv_fetch(action, "cachesize", 9, FALSE);
  1149.        if (svp)
  1150.                (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
  1151.          
  1152.            svp = hv_fetch(action, "psize", 5, FALSE);
  1153.        if (svp)
  1154.                (void)dbp->set_pagesize(dbp, SvIV(*svp)) ;
  1155.          
  1156.            svp = hv_fetch(action, "lorder", 6, FALSE);
  1157.        if (svp)
  1158.                (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
  1159.  
  1160.             PrintBtree(info) ;
  1161.          
  1162.         }
  1163.         else if (sv_isa(sv, "DB_File::RECNOINFO"))
  1164.         {
  1165.         int fixed = FALSE ;
  1166.  
  1167.         if (isHASH)
  1168.             croak("DB_File can only tie an array to a DB_RECNO database");
  1169.  
  1170.             RETVAL->type = DB_RECNO ;
  1171.  
  1172.            svp = hv_fetch(action, "flags", 5, FALSE);
  1173.        if (svp) {
  1174.         int flags = SvIV(*svp) ;
  1175.         /* remove FIXDLEN, if present */
  1176.         if (flags & DB_FIXEDLEN) {
  1177.             fixed = TRUE ;
  1178.             flags &= ~DB_FIXEDLEN ;
  1179.            }
  1180.        }
  1181.  
  1182.            svp = hv_fetch(action, "cachesize", 9, FALSE);
  1183.        if (svp) {
  1184.                status = dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
  1185.        }
  1186.          
  1187.            svp = hv_fetch(action, "psize", 5, FALSE);
  1188.        if (svp) {
  1189.                status = dbp->set_pagesize(dbp, SvIV(*svp)) ;
  1190.         }
  1191.          
  1192.            svp = hv_fetch(action, "lorder", 6, FALSE);
  1193.        if (svp) {
  1194.                status = dbp->set_lorder(dbp, SvIV(*svp)) ;
  1195.        }
  1196.  
  1197.         svp = hv_fetch(action, "bval", 4, FALSE);
  1198.             if (svp && SvOK(*svp))
  1199.             {
  1200.         int value ;
  1201.                 if (SvPOK(*svp))
  1202.             value = (int)*SvPV(*svp, n_a) ;
  1203.         else
  1204.             value = SvIV(*svp) ;
  1205.  
  1206.         if (fixed) {
  1207.             status = dbp->set_re_pad(dbp, value) ;
  1208.         }
  1209.         else {
  1210.             status = dbp->set_re_delim(dbp, value) ;
  1211.         }
  1212.  
  1213.             }
  1214.  
  1215.        if (fixed) {
  1216.                svp = hv_fetch(action, "reclen", 6, FALSE);
  1217.            if (svp) {
  1218.            u_int32_t len =  (u_int32_t)SvIV(*svp) ;
  1219.                    status = dbp->set_re_len(dbp, len) ;
  1220.            }    
  1221.        }
  1222.          
  1223.         if (name != NULL) {
  1224.             status = dbp->set_re_source(dbp, name) ;
  1225.             name = NULL ;
  1226.         }    
  1227.  
  1228.             svp = hv_fetch(action, "bfname", 6, FALSE); 
  1229.             if (svp && SvOK(*svp)) {
  1230.         char * ptr = SvPV(*svp,n_a) ;
  1231.         name = (char*) n_a ? ptr : NULL ;
  1232.         }
  1233.         else
  1234.         name = NULL ;
  1235.          
  1236.  
  1237.         status = dbp->set_flags(dbp, DB_RENUMBER) ;
  1238.          
  1239.         if (flags){
  1240.                 (void)dbp->set_flags(dbp, flags) ;
  1241.         }
  1242.             PrintRecno(info) ;
  1243.         }
  1244.         else
  1245.             croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
  1246.     }
  1247.  
  1248.     {
  1249.         int         Flags = 0 ;
  1250.         int        status ;
  1251.  
  1252.         /* Map 1.x flags to 3.x flags */
  1253.         if ((flags & O_CREAT) == O_CREAT)
  1254.             Flags |= DB_CREATE ;
  1255.  
  1256. #if O_RDONLY == 0
  1257.         if (flags == O_RDONLY)
  1258. #else
  1259.         if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
  1260. #endif
  1261.             Flags |= DB_RDONLY ;
  1262.  
  1263. #ifdef O_TRUNC
  1264.         if ((flags & O_TRUNC) == O_TRUNC)
  1265.             Flags |= DB_TRUNCATE ;
  1266. #endif
  1267.  
  1268.         status = RETVAL->dbp->open(RETVAL->dbp, name, NULL, RETVAL->type, 
  1269.                     Flags, mode) ; 
  1270.     /* printf("open returned %d %s\n", status, db_strerror(status)) ; */
  1271.  
  1272.         if (status == 0)
  1273.             status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
  1274.             0) ;
  1275.     /* printf("cursor returned %d %s\n", status, db_strerror(status)) ; */
  1276.  
  1277.         if (status)
  1278.         RETVAL->dbp = NULL ;
  1279.  
  1280.     }
  1281.  
  1282.     return (RETVAL) ;
  1283.  
  1284. #endif /* Berkeley DB Version > 2 */
  1285.  
  1286. } /* ParseOpenInfo */
  1287.  
  1288.  
  1289. static double 
  1290. #ifdef CAN_PROTOTYPE
  1291. constant(char *name, int arg)
  1292. #else
  1293. constant(name, arg)
  1294. char *name;
  1295. int arg;
  1296. #endif
  1297. {
  1298.     errno = 0;
  1299.     switch (*name) {
  1300.     case 'A':
  1301.     break;
  1302.     case 'B':
  1303.     if (strEQ(name, "BTREEMAGIC"))
  1304. #ifdef BTREEMAGIC
  1305.         return BTREEMAGIC;
  1306. #else
  1307.         goto not_there;
  1308. #endif
  1309.     if (strEQ(name, "BTREEVERSION"))
  1310. #ifdef BTREEVERSION
  1311.         return BTREEVERSION;
  1312. #else
  1313.         goto not_there;
  1314. #endif
  1315.     break;
  1316.     case 'C':
  1317.     break;
  1318.     case 'D':
  1319.     if (strEQ(name, "DB_LOCK"))
  1320. #ifdef DB_LOCK
  1321.         return DB_LOCK;
  1322. #else
  1323.         goto not_there;
  1324. #endif
  1325.     if (strEQ(name, "DB_SHMEM"))
  1326. #ifdef DB_SHMEM
  1327.         return DB_SHMEM;
  1328. #else
  1329.         goto not_there;
  1330. #endif
  1331.     if (strEQ(name, "DB_TXN"))
  1332. #ifdef DB_TXN
  1333.         return (U32)DB_TXN;
  1334. #else
  1335.         goto not_there;
  1336. #endif
  1337.     break;
  1338.     case 'E':
  1339.     break;
  1340.     case 'F':
  1341.     break;
  1342.     case 'G':
  1343.     break;
  1344.     case 'H':
  1345.     if (strEQ(name, "HASHMAGIC"))
  1346. #ifdef HASHMAGIC
  1347.         return HASHMAGIC;
  1348. #else
  1349.         goto not_there;
  1350. #endif
  1351.     if (strEQ(name, "HASHVERSION"))
  1352. #ifdef HASHVERSION
  1353.         return HASHVERSION;
  1354. #else
  1355.         goto not_there;
  1356. #endif
  1357.     break;
  1358.     case 'I':
  1359.     break;
  1360.     case 'J':
  1361.     break;
  1362.     case 'K':
  1363.     break;
  1364.     case 'L':
  1365.     break;
  1366.     case 'M':
  1367.     if (strEQ(name, "MAX_PAGE_NUMBER"))
  1368. #ifdef MAX_PAGE_NUMBER
  1369.         return (U32)MAX_PAGE_NUMBER;
  1370. #else
  1371.         goto not_there;
  1372. #endif
  1373.     if (strEQ(name, "MAX_PAGE_OFFSET"))
  1374. #ifdef MAX_PAGE_OFFSET
  1375.         return MAX_PAGE_OFFSET;
  1376. #else
  1377.         goto not_there;
  1378. #endif
  1379.     if (strEQ(name, "MAX_REC_NUMBER"))
  1380. #ifdef MAX_REC_NUMBER
  1381.         return (U32)MAX_REC_NUMBER;
  1382. #else
  1383.         goto not_there;
  1384. #endif
  1385.     break;
  1386.     case 'N':
  1387.     break;
  1388.     case 'O':
  1389.     break;
  1390.     case 'P':
  1391.     break;
  1392.     case 'Q':
  1393.     break;
  1394.     case 'R':
  1395.     if (strEQ(name, "RET_ERROR"))
  1396. #ifdef RET_ERROR
  1397.         return RET_ERROR;
  1398. #else
  1399.         goto not_there;
  1400. #endif
  1401.     if (strEQ(name, "RET_SPECIAL"))
  1402. #ifdef RET_SPECIAL
  1403.         return RET_SPECIAL;
  1404. #else
  1405.         goto not_there;
  1406. #endif
  1407.     if (strEQ(name, "RET_SUCCESS"))
  1408. #ifdef RET_SUCCESS
  1409.         return RET_SUCCESS;
  1410. #else
  1411.         goto not_there;
  1412. #endif
  1413.     if (strEQ(name, "R_CURSOR"))
  1414. #ifdef R_CURSOR
  1415.         return R_CURSOR;
  1416. #else
  1417.         goto not_there;
  1418. #endif
  1419.     if (strEQ(name, "R_DUP"))
  1420. #ifdef R_DUP
  1421.         return R_DUP;
  1422. #else
  1423.         goto not_there;
  1424. #endif
  1425.     if (strEQ(name, "R_FIRST"))
  1426. #ifdef R_FIRST
  1427.         return R_FIRST;
  1428. #else
  1429.         goto not_there;
  1430. #endif
  1431.     if (strEQ(name, "R_FIXEDLEN"))
  1432. #ifdef R_FIXEDLEN
  1433.         return R_FIXEDLEN;
  1434. #else
  1435.         goto not_there;
  1436. #endif
  1437.     if (strEQ(name, "R_IAFTER"))
  1438. #ifdef R_IAFTER
  1439.         return R_IAFTER;
  1440. #else
  1441.         goto not_there;
  1442. #endif
  1443.     if (strEQ(name, "R_IBEFORE"))
  1444. #ifdef R_IBEFORE
  1445.         return R_IBEFORE;
  1446. #else
  1447.         goto not_there;
  1448. #endif
  1449.     if (strEQ(name, "R_LAST"))
  1450. #ifdef R_LAST
  1451.         return R_LAST;
  1452. #else
  1453.         goto not_there;
  1454. #endif
  1455.     if (strEQ(name, "R_NEXT"))
  1456. #ifdef R_NEXT
  1457.         return R_NEXT;
  1458. #else
  1459.         goto not_there;
  1460. #endif
  1461.     if (strEQ(name, "R_NOKEY"))
  1462. #ifdef R_NOKEY
  1463.         return R_NOKEY;
  1464. #else
  1465.         goto not_there;
  1466. #endif
  1467.     if (strEQ(name, "R_NOOVERWRITE"))
  1468. #ifdef R_NOOVERWRITE
  1469.         return R_NOOVERWRITE;
  1470. #else
  1471.         goto not_there;
  1472. #endif
  1473.     if (strEQ(name, "R_PREV"))
  1474. #ifdef R_PREV
  1475.         return R_PREV;
  1476. #else
  1477.         goto not_there;
  1478. #endif
  1479.     if (strEQ(name, "R_RECNOSYNC"))
  1480. #ifdef R_RECNOSYNC
  1481.         return R_RECNOSYNC;
  1482. #else
  1483.         goto not_there;
  1484. #endif
  1485.     if (strEQ(name, "R_SETCURSOR"))
  1486. #ifdef R_SETCURSOR
  1487.         return R_SETCURSOR;
  1488. #else
  1489.         goto not_there;
  1490. #endif
  1491.     if (strEQ(name, "R_SNAPSHOT"))
  1492. #ifdef R_SNAPSHOT
  1493.         return R_SNAPSHOT;
  1494. #else
  1495.         goto not_there;
  1496. #endif
  1497.     break;
  1498.     case 'S':
  1499.     break;
  1500.     case 'T':
  1501.     break;
  1502.     case 'U':
  1503.     break;
  1504.     case 'V':
  1505.     break;
  1506.     case 'W':
  1507.     break;
  1508.     case 'X':
  1509.     break;
  1510.     case 'Y':
  1511.     break;
  1512.     case 'Z':
  1513.     break;
  1514.     case '_':
  1515.     break;
  1516.     }
  1517.     errno = EINVAL;
  1518.     return 0;
  1519.  
  1520. not_there:
  1521.     errno = ENOENT;
  1522.     return 0;
  1523. }
  1524.  
  1525. MODULE = DB_File    PACKAGE = DB_File    PREFIX = db_
  1526.  
  1527. BOOT:
  1528.   {
  1529.     __getBerkeleyDBInfo() ;
  1530.  
  1531.     DBT_clear(empty) ; 
  1532.     empty.data = &zero ;
  1533.     empty.size =  sizeof(recno_t) ;
  1534.   }
  1535.  
  1536. double
  1537. constant(name,arg)
  1538.     char *        name
  1539.     int        arg
  1540.  
  1541.  
  1542. DB_File
  1543. db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
  1544.     int        isHASH
  1545.     char *        dbtype
  1546.     int        flags
  1547.     int        mode
  1548.     CODE:
  1549.     {
  1550.         char *    name = (char *) NULL ; 
  1551.         SV *    sv = (SV *) NULL ; 
  1552.         STRLEN    n_a;
  1553.  
  1554.         if (items >= 3 && SvOK(ST(2))) 
  1555.             name = (char*) SvPV(ST(2), n_a) ; 
  1556.  
  1557.             if (items == 6)
  1558.             sv = ST(5) ;
  1559.  
  1560.         RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
  1561.         if (RETVAL->dbp == NULL)
  1562.             RETVAL = NULL ;
  1563.     }
  1564.     OUTPUT:    
  1565.         RETVAL
  1566.  
  1567. int
  1568. db_DESTROY(db)
  1569.     DB_File        db
  1570.     INIT:
  1571.       CurrentDB = db ;
  1572.     CLEANUP:
  1573.       if (db->hash)
  1574.         SvREFCNT_dec(db->hash) ;
  1575.       if (db->compare)
  1576.         SvREFCNT_dec(db->compare) ;
  1577.       if (db->prefix)
  1578.         SvREFCNT_dec(db->prefix) ;
  1579. #ifdef DBM_FILTERING
  1580.       if (db->filter_fetch_key)
  1581.         SvREFCNT_dec(db->filter_fetch_key) ;
  1582.       if (db->filter_store_key)
  1583.         SvREFCNT_dec(db->filter_store_key) ;
  1584.       if (db->filter_fetch_value)
  1585.         SvREFCNT_dec(db->filter_fetch_value) ;
  1586.       if (db->filter_store_value)
  1587.         SvREFCNT_dec(db->filter_store_value) ;
  1588. #endif /* DBM_FILTERING */
  1589.       safefree(db) ;
  1590. #ifdef DB_VERSION_MAJOR
  1591.       if (RETVAL > 0)
  1592.         RETVAL = -1 ;
  1593. #endif
  1594.  
  1595.  
  1596. int
  1597. db_DELETE(db, key, flags=0)
  1598.     DB_File        db
  1599.     DBTKEY        key
  1600.     u_int        flags
  1601.     INIT:
  1602.       CurrentDB = db ;
  1603.  
  1604.  
  1605. int
  1606. db_EXISTS(db, key)
  1607.     DB_File        db
  1608.     DBTKEY        key
  1609.     CODE:
  1610.     {
  1611.           DBT        value ;
  1612.     
  1613.       DBT_clear(value) ; 
  1614.       CurrentDB = db ;
  1615.       RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
  1616.     }
  1617.     OUTPUT:
  1618.       RETVAL
  1619.  
  1620. int
  1621. db_FETCH(db, key, flags=0)
  1622.     DB_File        db
  1623.     DBTKEY        key
  1624.     u_int        flags
  1625.     CODE:
  1626.     {
  1627.             DBT        value ;
  1628.  
  1629.         DBT_clear(value) ; 
  1630.         CurrentDB = db ;
  1631.         /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */
  1632.         RETVAL = db_get(db, key, value, flags) ;
  1633.         ST(0) = sv_newmortal();
  1634.         OutputValue(ST(0), value)
  1635.     }
  1636.  
  1637. int
  1638. db_STORE(db, key, value, flags=0)
  1639.     DB_File        db
  1640.     DBTKEY        key
  1641.     DBT        value
  1642.     u_int        flags
  1643.     INIT:
  1644.       CurrentDB = db ;
  1645.  
  1646.  
  1647. int
  1648. db_FIRSTKEY(db)
  1649.     DB_File        db
  1650.     CODE:
  1651.     {
  1652.         DBTKEY    key ;
  1653.         DBT        value ;
  1654.  
  1655.         DBT_clear(key) ; 
  1656.         DBT_clear(value) ; 
  1657.         CurrentDB = db ;
  1658.         RETVAL = do_SEQ(db, key, value, R_FIRST) ;
  1659.         ST(0) = sv_newmortal();
  1660.         OutputKey(ST(0), key) ;
  1661.     }
  1662.  
  1663. int
  1664. db_NEXTKEY(db, key)
  1665.     DB_File        db
  1666.     DBTKEY        key
  1667.     CODE:
  1668.     {
  1669.         DBT        value ;
  1670.  
  1671.         DBT_clear(value) ; 
  1672.         CurrentDB = db ;
  1673.         RETVAL = do_SEQ(db, key, value, R_NEXT) ;
  1674.         ST(0) = sv_newmortal();
  1675.         OutputKey(ST(0), key) ;
  1676.     }
  1677.  
  1678. #
  1679. # These would be nice for RECNO
  1680. #
  1681.  
  1682. int
  1683. unshift(db, ...)
  1684.     DB_File        db
  1685.     ALIAS:        UNSHIFT = 1
  1686.     CODE:
  1687.     {
  1688.         DBTKEY    key ;
  1689.         DBT        value ;
  1690.         int        i ;
  1691.         int        One ;
  1692.         DB *    Db = db->dbp ;
  1693.         STRLEN    n_a;
  1694.  
  1695.         DBT_clear(key) ; 
  1696.         DBT_clear(value) ; 
  1697.         CurrentDB = db ;
  1698. #ifdef DB_VERSION_MAJOR
  1699.         /* get the first value */
  1700.         RETVAL = do_SEQ(db, key, value, DB_FIRST) ;     
  1701.         RETVAL = 0 ;
  1702. #else
  1703.         RETVAL = -1 ;
  1704. #endif
  1705.         for (i = items-1 ; i > 0 ; --i)
  1706.         {
  1707.             value.data = SvPV(ST(i), n_a) ;
  1708.             value.size = n_a ;
  1709.             One = 1 ;
  1710.             key.data = &One ;
  1711.             key.size = sizeof(int) ;
  1712. #ifdef DB_VERSION_MAJOR
  1713.                RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
  1714. #else
  1715.             RETVAL = (Db->put)(Db, &key, &value, R_IBEFORE) ;
  1716. #endif
  1717.             if (RETVAL != 0)
  1718.                 break;
  1719.         }
  1720.     }
  1721.     OUTPUT:
  1722.         RETVAL
  1723.  
  1724. I32
  1725. pop(db)
  1726.     DB_File        db
  1727.     ALIAS:        POP = 1
  1728.     CODE:
  1729.     {
  1730.         DBTKEY    key ;
  1731.         DBT        value ;
  1732.  
  1733.         DBT_clear(key) ; 
  1734.         DBT_clear(value) ; 
  1735.         CurrentDB = db ;
  1736.  
  1737.         /* First get the final value */
  1738.         RETVAL = do_SEQ(db, key, value, R_LAST) ;     
  1739.         ST(0) = sv_newmortal();
  1740.         /* Now delete it */
  1741.         if (RETVAL == 0)
  1742.         {
  1743.         /* the call to del will trash value, so take a copy now */
  1744.         OutputValue(ST(0), value) ;
  1745.             RETVAL = db_del(db, key, R_CURSOR) ;
  1746.             if (RETVAL != 0) 
  1747.                 sv_setsv(ST(0), &PL_sv_undef); 
  1748.         }
  1749.     }
  1750.  
  1751. I32
  1752. shift(db)
  1753.     DB_File        db
  1754.     ALIAS:        SHIFT = 1
  1755.     CODE:
  1756.     {
  1757.         DBT        value ;
  1758.         DBTKEY    key ;
  1759.  
  1760.         DBT_clear(key) ; 
  1761.         DBT_clear(value) ; 
  1762.         CurrentDB = db ;
  1763.         /* get the first value */
  1764.         RETVAL = do_SEQ(db, key, value, R_FIRST) ;     
  1765.         ST(0) = sv_newmortal();
  1766.         /* Now delete it */
  1767.         if (RETVAL == 0)
  1768.         {
  1769.         /* the call to del will trash value, so take a copy now */
  1770.         OutputValue(ST(0), value) ;
  1771.             RETVAL = db_del(db, key, R_CURSOR) ;
  1772.             if (RETVAL != 0)
  1773.                 sv_setsv (ST(0), &PL_sv_undef) ;
  1774.         }
  1775.     }
  1776.  
  1777.  
  1778. I32
  1779. push(db, ...)
  1780.     DB_File        db
  1781.     ALIAS:        PUSH = 1
  1782.     CODE:
  1783.     {
  1784.         DBTKEY    key ;
  1785.         DBT        value ;
  1786.         DB *    Db = db->dbp ;
  1787.         int        i ;
  1788.         STRLEN    n_a;
  1789.         int        keyval ;
  1790.  
  1791.         DBT_flags(key) ; 
  1792.         DBT_flags(value) ; 
  1793.         CurrentDB = db ;
  1794.         /* Set the Cursor to the Last element */
  1795.         RETVAL = do_SEQ(db, key, value, R_LAST) ;
  1796. #ifndef DB_VERSION_MAJOR                        
  1797.         if (RETVAL >= 0)
  1798. #endif        
  1799.         {
  1800.             if (RETVAL == 0)
  1801.             keyval = *(int*)key.data ;
  1802.         else
  1803.             keyval = 0 ;
  1804.             for (i = 1 ; i < items ; ++i)
  1805.             {
  1806.                 value.data = SvPV(ST(i), n_a) ;
  1807.                 value.size = n_a ;
  1808.             ++ keyval ;
  1809.                 key.data = &keyval ;
  1810.                 key.size = sizeof(int) ;
  1811.             RETVAL = (Db->put)(Db, TXN &key, &value, 0) ;
  1812.                 if (RETVAL != 0)
  1813.                     break;
  1814.             }
  1815.         }
  1816.     }
  1817.     OUTPUT:
  1818.         RETVAL
  1819.  
  1820. I32
  1821. length(db)
  1822.     DB_File        db
  1823.     ALIAS:        FETCHSIZE = 1
  1824.     CODE:
  1825.         CurrentDB = db ;
  1826.         RETVAL = GetArrayLength(aTHX_ db) ;
  1827.     OUTPUT:
  1828.         RETVAL
  1829.  
  1830.  
  1831. #
  1832. # Now provide an interface to the rest of the DB functionality
  1833. #
  1834.  
  1835. int
  1836. db_del(db, key, flags=0)
  1837.     DB_File        db
  1838.     DBTKEY        key
  1839.     u_int        flags
  1840.     CODE:
  1841.       CurrentDB = db ;
  1842.       RETVAL = db_del(db, key, flags) ;
  1843. #ifdef DB_VERSION_MAJOR
  1844.       if (RETVAL > 0)
  1845.         RETVAL = -1 ;
  1846.       else if (RETVAL == DB_NOTFOUND)
  1847.         RETVAL = 1 ;
  1848. #endif
  1849.     OUTPUT:
  1850.       RETVAL
  1851.  
  1852.  
  1853. int
  1854. db_get(db, key, value, flags=0)
  1855.     DB_File        db
  1856.     DBTKEY        key
  1857.     DBT        value = NO_INIT
  1858.     u_int        flags
  1859.     CODE:
  1860.       CurrentDB = db ;
  1861.       DBT_clear(value) ; 
  1862.       RETVAL = db_get(db, key, value, flags) ;
  1863. #ifdef DB_VERSION_MAJOR
  1864.       if (RETVAL > 0)
  1865.         RETVAL = -1 ;
  1866.       else if (RETVAL == DB_NOTFOUND)
  1867.         RETVAL = 1 ;
  1868. #endif
  1869.     OUTPUT:
  1870.       RETVAL
  1871.       value
  1872.  
  1873. int
  1874. db_put(db, key, value, flags=0)
  1875.     DB_File        db
  1876.     DBTKEY        key
  1877.     DBT        value
  1878.     u_int        flags
  1879.     CODE:
  1880.       CurrentDB = db ;
  1881.       RETVAL = db_put(db, key, value, flags) ;
  1882. #ifdef DB_VERSION_MAJOR
  1883.       if (RETVAL > 0)
  1884.         RETVAL = -1 ;
  1885.       else if (RETVAL == DB_KEYEXIST)
  1886.         RETVAL = 1 ;
  1887. #endif
  1888.     OUTPUT:
  1889.       RETVAL
  1890.       key        if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
  1891.  
  1892. int
  1893. db_fd(db)
  1894.     DB_File        db
  1895.     int        status = 0 ;
  1896.     CODE:
  1897.       CurrentDB = db ;
  1898. #ifdef DB_VERSION_MAJOR
  1899.       RETVAL = -1 ;
  1900.       status = (db->in_memory
  1901.         ? -1 
  1902.         : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
  1903.       if (status != 0)
  1904.         RETVAL = -1 ;
  1905. #else
  1906.       RETVAL = (db->in_memory
  1907.         ? -1 
  1908.         : ((db->dbp)->fd)(db->dbp) ) ;
  1909. #endif
  1910.     OUTPUT:
  1911.       RETVAL
  1912.  
  1913. int
  1914. db_sync(db, flags=0)
  1915.     DB_File        db
  1916.     u_int        flags
  1917.     CODE:
  1918.       CurrentDB = db ;
  1919.       RETVAL = db_sync(db, flags) ;
  1920. #ifdef DB_VERSION_MAJOR
  1921.       if (RETVAL > 0)
  1922.         RETVAL = -1 ;
  1923. #endif
  1924.     OUTPUT:
  1925.       RETVAL
  1926.  
  1927.  
  1928. int
  1929. db_seq(db, key, value, flags)
  1930.     DB_File        db
  1931.     DBTKEY        key 
  1932.     DBT        value = NO_INIT
  1933.     u_int        flags
  1934.     CODE:
  1935.       CurrentDB = db ;
  1936.       DBT_clear(value) ; 
  1937.       RETVAL = db_seq(db, key, value, flags);
  1938. #ifdef DB_VERSION_MAJOR
  1939.       if (RETVAL > 0)
  1940.         RETVAL = -1 ;
  1941.       else if (RETVAL == DB_NOTFOUND)
  1942.         RETVAL = 1 ;
  1943. #endif
  1944.     OUTPUT:
  1945.       RETVAL
  1946.       key
  1947.       value
  1948.  
  1949. #ifdef DBM_FILTERING
  1950.  
  1951. #define setFilter(type)                    \
  1952.     {                        \
  1953.         if (db->type)                \
  1954.             RETVAL = sv_mortalcopy(db->type) ;    \
  1955.         ST(0) = RETVAL ;                \
  1956.         if (db->type && (code == &PL_sv_undef)) {    \
  1957.                 SvREFCNT_dec(db->type) ;        \
  1958.             db->type = NULL ;            \
  1959.         }                        \
  1960.         else if (code) {                \
  1961.             if (db->type)                \
  1962.                 sv_setsv(db->type, code) ;        \
  1963.             else                    \
  1964.                 db->type = newSVsv(code) ;        \
  1965.         }                            \
  1966.     }
  1967.  
  1968.  
  1969. SV *
  1970. filter_fetch_key(db, code)
  1971.     DB_File        db
  1972.     SV *        code
  1973.     SV *        RETVAL = &PL_sv_undef ;
  1974.     CODE:
  1975.         setFilter(filter_fetch_key) ;
  1976.  
  1977. SV *
  1978. filter_store_key(db, code)
  1979.     DB_File        db
  1980.     SV *        code
  1981.     SV *        RETVAL = &PL_sv_undef ;
  1982.     CODE:
  1983.         setFilter(filter_store_key) ;
  1984.  
  1985. SV *
  1986. filter_fetch_value(db, code)
  1987.     DB_File        db
  1988.     SV *        code
  1989.     SV *        RETVAL = &PL_sv_undef ;
  1990.     CODE:
  1991.         setFilter(filter_fetch_value) ;
  1992.  
  1993. SV *
  1994. filter_store_value(db, code)
  1995.     DB_File        db
  1996.     SV *        code
  1997.     SV *        RETVAL = &PL_sv_undef ;
  1998.     CODE:
  1999.         setFilter(filter_store_value) ;
  2000.  
  2001. #endif /* DBM_FILTERING */
  2002.