3 DB_File.xs -- Perl 5 interface to Berkeley DB
5 written by Paul Marquess <Paul.Marquess@btinternet.com>
6 last modified 26th Nov 2001
9 All comments/suggestions/problems are welcome
11 Copyright (c) 1995-2001 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.
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
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
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 &
81 1.71 - Support for Berkeley DB version 3.
82 Support for Berkeley DB 2/3's backward compatability mode.
84 1.72 - No change to DB_File.xs
85 1.73 - No change to DB_File.xs
86 1.74 - A call to open needed parenthesised to stop it clashing
88 Added Perl core patches 7703 & 7801.
89 1.75 - Fixed Perl core patch 7703.
90 Added suppport to allow DB_File to be built with
91 Berkeley DB 3.2 -- btree_compare, btree_prefix and hash_cb
93 1.76 - No change to DB_File.xs
94 1.77 - Tidied up a few types used in calling newSVpvn.
95 1.78 - Core patch 10335, 10372, 10534, 10549, 11051 included.
96 1.79 - NEXTKEY ignores the input key.
98 1.800 - Moved backward compatability code into ppport.h.
99 Use the new constants code.
100 1.801 - No change to DB_File.xs
104 #define PERL_NO_GET_CONTEXT
113 /* Mention DB_VERSION_MAJOR_CFG, DB_VERSION_MINOR_CFG, and
114 DB_VERSION_PATCH_CFG here so that Configure pulls them all in. */
116 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
117 * shortly #included by the <db.h>) __attribute__ to the possibly
118 * already defined __attribute__, for example by GNUC or by Perl. */
120 /* #if DB_VERSION_MAJOR_CFG < 2 */
121 #ifndef DB_VERSION_MAJOR
122 # undef __attribute__
133 /* Wall starts with 5.7.x */
135 #if PERL_REVISION > 5 || (PERL_REVISION == 5 && PERL_VERSION >= 7)
137 /* Since we dropped the gccish definition of __attribute__ we will want
138 * to redefine dNOOP, however (so that dTHX continues to work). Yes,
139 * all this means that we can't do attribute checking on the DB_File,
141 # ifndef DB_VERSION_MAJOR
144 # define dNOOP extern int Perl___notused
146 /* Ditto for dXSARGS. */
150 I32 ax = mark - PL_stack_base + 1; \
151 I32 items = sp - mark
155 /* avoid -Wall; DB_File xsubs never make use of `ix' setup for ALIASes */
157 # define dXSI32 dNOOP
159 #endif /* Perl >= 5.7 */
164 #define DBM_FILTERING
167 # define Trace(x) printf x
173 #define DBT_clear(x) Zero(&x, 1, DBT) ;
175 #ifdef DB_VERSION_MAJOR
177 #if DB_VERSION_MAJOR == 2
178 # define BERKELEY_DB_1_OR_2
181 #if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 2)
182 # define AT_LEAST_DB_3_2
185 /* map version 2 features & constants onto their version 1 equivalent */
190 #define DB_Prefix_t size_t
195 #define DB_Hash_t u_int32_t
197 /* DBTYPE stays the same */
198 /* HASHINFO, RECNOINFO and BTREEINFO map to DB_INFO */
199 #if DB_VERSION_MAJOR == 2
200 typedef DB_INFO INFO ;
201 #else /* DB_VERSION_MAJOR > 2 */
202 # define DB_FIXEDLEN (0x8000)
203 #endif /* DB_VERSION_MAJOR == 2 */
205 /* version 2 has db_recno_t in place of recno_t */
206 typedef db_recno_t recno_t;
209 #define R_CURSOR DB_SET_RANGE
210 #define R_FIRST DB_FIRST
211 #define R_IAFTER DB_AFTER
212 #define R_IBEFORE DB_BEFORE
213 #define R_LAST DB_LAST
214 #define R_NEXT DB_NEXT
215 #define R_NOOVERWRITE DB_NOOVERWRITE
216 #define R_PREV DB_PREV
218 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
219 # define R_SETCURSOR 0x800000
221 # define R_SETCURSOR (-100)
224 #define R_RECNOSYNC 0
225 #define R_FIXEDLEN DB_FIXEDLEN
229 #define db_HA_hash h_hash
230 #define db_HA_ffactor h_ffactor
231 #define db_HA_nelem h_nelem
232 #define db_HA_bsize db_pagesize
233 #define db_HA_cachesize db_cachesize
234 #define db_HA_lorder db_lorder
236 #define db_BT_compare bt_compare
237 #define db_BT_prefix bt_prefix
238 #define db_BT_flags flags
239 #define db_BT_psize db_pagesize
240 #define db_BT_cachesize db_cachesize
241 #define db_BT_lorder db_lorder
242 #define db_BT_maxkeypage
243 #define db_BT_minkeypage
246 #define db_RE_reclen re_len
247 #define db_RE_flags flags
248 #define db_RE_bval re_pad
249 #define db_RE_bfname re_source
250 #define db_RE_psize db_pagesize
251 #define db_RE_cachesize db_cachesize
252 #define db_RE_lorder db_lorder
256 #define do_SEQ(db, key, value, flag) (db->cursor->c_get)(db->cursor, &key, &value, flag)
259 #define DBT_flags(x) x.flags = 0
260 #define DB_flags(x, v) x |= v
262 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
263 # define flagSet(flags, bitmask) ((flags) & (bitmask))
265 # define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask))
268 #else /* db version 1.x */
270 #define BERKELEY_DB_1
271 #define BERKELEY_DB_1_OR_2
284 # define DB_Prefix_t mDB_Prefix_t
291 # define DB_Hash_t mDB_Hash_t
294 #define db_HA_hash hash.hash
295 #define db_HA_ffactor hash.ffactor
296 #define db_HA_nelem hash.nelem
297 #define db_HA_bsize hash.bsize
298 #define db_HA_cachesize hash.cachesize
299 #define db_HA_lorder hash.lorder
301 #define db_BT_compare btree.compare
302 #define db_BT_prefix btree.prefix
303 #define db_BT_flags btree.flags
304 #define db_BT_psize btree.psize
305 #define db_BT_cachesize btree.cachesize
306 #define db_BT_lorder btree.lorder
307 #define db_BT_maxkeypage btree.maxkeypage
308 #define db_BT_minkeypage btree.minkeypage
310 #define db_RE_reclen recno.reclen
311 #define db_RE_flags recno.flags
312 #define db_RE_bval recno.bval
313 #define db_RE_bfname recno.bfname
314 #define db_RE_psize recno.psize
315 #define db_RE_cachesize recno.cachesize
316 #define db_RE_lorder recno.lorder
320 #define do_SEQ(db, key, value, flag) (db->dbp->seq)(db->dbp, &key, &value, flag)
322 #define DB_flags(x, v)
323 #define flagSet(flags, bitmask) ((flags) & (bitmask))
325 #endif /* db version 1 */
329 #define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, TXN &key, flags)
330 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, flags)
331 #define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
333 #define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
334 #define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
336 #ifdef DB_VERSION_MAJOR
337 #define db_DESTROY(db) ( db->cursor->c_close(db->cursor),\
338 (db->dbp->close)(db->dbp, 0) )
339 #define db_close(db) ((db->dbp)->close)(db->dbp, 0)
340 #define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \
341 ? ((db->cursor)->c_del)(db->cursor, 0) \
342 : ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
344 #else /* ! DB_VERSION_MAJOR */
346 #define db_DESTROY(db) ((db->dbp)->close)(db->dbp)
347 #define db_close(db) ((db->dbp)->close)(db->dbp)
348 #define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
349 #define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
351 #endif /* ! DB_VERSION_MAJOR */
354 #define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags)
363 #ifdef BERKELEY_DB_1_OR_2
366 #ifdef DB_VERSION_MAJOR
370 SV * filter_fetch_key ;
371 SV * filter_store_key ;
372 SV * filter_fetch_value ;
373 SV * filter_store_value ;
375 #endif /* DBM_FILTERING */
379 typedef DB_File_type * DB_File ;
384 #define ckFilter(arg,type,name) \
387 /* printf("filtering %s\n", name) ; */ \
389 croak("recursion detected in %s", name) ; \
390 db->filtering = TRUE ; \
391 save_defsv = newSVsv(DEFSV) ; \
392 sv_setsv(DEFSV, arg) ; \
394 (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \
395 sv_setsv(arg, DEFSV) ; \
396 sv_setsv(DEFSV, save_defsv) ; \
397 SvREFCNT_dec(save_defsv) ; \
398 db->filtering = FALSE ; \
399 /* printf("end of filtering %s\n", name) ; */ \
404 #define ckFilter(arg,type, name)
406 #endif /* DBM_FILTERING */
408 #define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
410 #define OutputValue(arg, name) \
411 { if (RETVAL == 0) { \
412 my_sv_setpvn(arg, name.data, name.size) ; \
413 ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \
417 #define OutputKey(arg, name) \
420 if (db->type != DB_RECNO) { \
421 my_sv_setpvn(arg, name.data, name.size); \
424 sv_setiv(arg, (I32)*(I32*)name.data - 1); \
425 ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \
429 #define my_SvUV32(sv) ((u_int32_t)SvUV(sv))
432 extern void __getBerkeleyDBInfo(void);
435 /* Internal Global Data */
437 #define MY_CXT_KEY "DB_File::_guts" XS_VERSION
448 #define Value (MY_CXT.x_Value)
449 #define zero (MY_CXT.x_zero)
450 #define CurrentDB (MY_CXT.x_CurrentDB)
451 #define empty (MY_CXT.x_empty)
453 #ifdef DB_VERSION_MAJOR
457 db_put(DB_File db, DBTKEY key, DBT value, u_int flags)
459 db_put(db, key, value, flags)
468 if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) {
472 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
473 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor) != 0)
475 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor, 0) != 0)
479 memset(&l_key, 0, sizeof(l_key));
480 l_key.data = key.data;
481 l_key.size = key.size;
482 memset(&l_value, 0, sizeof(l_value));
483 l_value.data = value.data;
484 l_value.size = value.size;
486 if ( temp_cursor->c_get(temp_cursor, &l_key, &l_value, DB_SET) != 0) {
487 (void)temp_cursor->c_close(temp_cursor);
491 status = temp_cursor->c_put(temp_cursor, &key, &value, flags);
492 (void)temp_cursor->c_close(temp_cursor);
498 if (flagSet(flags, R_CURSOR)) {
499 return ((db->cursor)->c_put)(db->cursor, &key, &value, DB_CURRENT);
502 if (flagSet(flags, R_SETCURSOR)) {
503 if ((db->dbp)->put(db->dbp, NULL, &key, &value, 0) != 0)
505 return ((db->cursor)->c_get)(db->cursor, &key, &value, DB_SET_RANGE);
509 return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
513 #endif /* DB_VERSION_MAJOR */
517 #ifdef AT_LEAST_DB_3_2
520 btree_compare(DB * db, const DBT *key1, const DBT *key2)
522 btree_compare(db, key1, key2)
526 #endif /* CAN_PROTOTYPE */
528 #else /* Berkeley DB < 3.2 */
531 btree_compare(const DBT *key1, const DBT *key2)
533 btree_compare(key1, key2)
546 void * data1, * data2 ;
550 data1 = (char *) key1->data ;
551 data2 = (char *) key2->data ;
554 /* As newSVpv will assume that the data pointer is a null terminated C
555 string if the size parameter is 0, make sure that data points to an
556 empty string if the length is 0
569 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
570 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
573 count = perl_call_sv(CurrentDB->compare, G_SCALAR);
578 croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
590 #ifdef AT_LEAST_DB_3_2
593 btree_prefix(DB * db, const DBT *key1, const DBT *key2)
595 btree_prefix(db, key1, key2)
601 #else /* Berkeley DB < 3.2 */
604 btree_prefix(const DBT *key1, const DBT *key2)
606 btree_prefix(key1, key2)
618 char * data1, * data2 ;
622 data1 = (char *) key1->data ;
623 data2 = (char *) key2->data ;
626 /* As newSVpv will assume that the data pointer is a null terminated C
627 string if the size parameter is 0, make sure that data points to an
628 empty string if the length is 0
641 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
642 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
645 count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
650 croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
663 # define HASH_CB_SIZE_TYPE size_t
665 # define HASH_CB_SIZE_TYPE u_int32_t
669 #ifdef AT_LEAST_DB_3_2
672 hash_cb(DB * db, const void *data, u_int32_t size)
674 hash_cb(db, data, size)
677 HASH_CB_SIZE_TYPE size ;
680 #else /* Berkeley DB < 3.2 */
683 hash_cb(const void *data, HASH_CB_SIZE_TYPE size)
687 HASH_CB_SIZE_TYPE size ;
705 /* DGH - Next two lines added to fix corrupted stack problem */
711 XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
714 count = perl_call_sv(CurrentDB->hash, G_SCALAR);
719 croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
731 #if defined(TRACE) && defined(BERKELEY_DB_1_OR_2)
735 PrintHash(INFO *hash)
741 printf ("HASH Info\n") ;
742 printf (" hash = %s\n",
743 (hash->db_HA_hash != NULL ? "redefined" : "default")) ;
744 printf (" bsize = %d\n", hash->db_HA_bsize) ;
745 printf (" ffactor = %d\n", hash->db_HA_ffactor) ;
746 printf (" nelem = %d\n", hash->db_HA_nelem) ;
747 printf (" cachesize = %d\n", hash->db_HA_cachesize) ;
748 printf (" lorder = %d\n", hash->db_HA_lorder) ;
754 PrintRecno(INFO *recno)
760 printf ("RECNO Info\n") ;
761 printf (" flags = %d\n", recno->db_RE_flags) ;
762 printf (" cachesize = %d\n", recno->db_RE_cachesize) ;
763 printf (" psize = %d\n", recno->db_RE_psize) ;
764 printf (" lorder = %d\n", recno->db_RE_lorder) ;
765 printf (" reclen = %ul\n", (unsigned long)recno->db_RE_reclen) ;
766 printf (" bval = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
767 printf (" bfname = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
772 PrintBtree(INFO *btree)
778 printf ("BTREE Info\n") ;
779 printf (" compare = %s\n",
780 (btree->db_BT_compare ? "redefined" : "default")) ;
781 printf (" prefix = %s\n",
782 (btree->db_BT_prefix ? "redefined" : "default")) ;
783 printf (" flags = %d\n", btree->db_BT_flags) ;
784 printf (" cachesize = %d\n", btree->db_BT_cachesize) ;
785 printf (" psize = %d\n", btree->db_BT_psize) ;
786 #ifndef DB_VERSION_MAJOR
787 printf (" maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
788 printf (" minkeypage = %d\n", btree->db_BT_minkeypage) ;
790 printf (" lorder = %d\n", btree->db_BT_lorder) ;
795 #define PrintRecno(recno)
796 #define PrintHash(hash)
797 #define PrintBtree(btree)
804 GetArrayLength(pTHX_ DB_File db)
816 RETVAL = do_SEQ(db, key, value, R_LAST) ;
818 RETVAL = *(I32 *)key.data ;
819 else /* No key means empty file */
822 return ((I32)RETVAL) ;
827 GetRecnoKey(pTHX_ DB_File db, I32 value)
829 GetRecnoKey(db, value)
835 /* Get the length of the array */
836 I32 length = GetArrayLength(aTHX_ db) ;
838 /* check for attempt to write before start of array */
839 if (length + value + 1 <= 0)
840 croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
842 value = length + value + 1 ;
853 ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv)
855 ParseOpenInfo(isHASH, name, flags, mode, sv)
864 #ifdef BERKELEY_DB_1_OR_2 /* Berkeley DB Version 1 or 2 */
868 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
869 void * openinfo = NULL ;
870 INFO * info = &RETVAL->info ;
874 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
875 Zero(RETVAL, 1, DB_File_type) ;
877 /* Default to HASH */
879 RETVAL->filtering = 0 ;
880 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
881 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
882 #endif /* DBM_FILTERING */
883 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
884 RETVAL->type = DB_HASH ;
886 /* DGH - Next line added to avoid SEGV on existing hash DB */
889 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
890 RETVAL->in_memory = (name == NULL) ;
895 croak ("type parameter is not a reference") ;
897 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
898 if (svp && SvOK(*svp))
899 action = (HV*) SvRV(*svp) ;
901 croak("internal error") ;
903 if (sv_isa(sv, "DB_File::HASHINFO"))
907 croak("DB_File can only tie an associative array to a DB_HASH database") ;
909 RETVAL->type = DB_HASH ;
910 openinfo = (void*)info ;
912 svp = hv_fetch(action, "hash", 4, FALSE);
914 if (svp && SvOK(*svp))
916 info->db_HA_hash = hash_cb ;
917 RETVAL->hash = newSVsv(*svp) ;
920 info->db_HA_hash = NULL ;
922 svp = hv_fetch(action, "ffactor", 7, FALSE);
923 info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
925 svp = hv_fetch(action, "nelem", 5, FALSE);
926 info->db_HA_nelem = svp ? SvIV(*svp) : 0;
928 svp = hv_fetch(action, "bsize", 5, FALSE);
929 info->db_HA_bsize = svp ? SvIV(*svp) : 0;
931 svp = hv_fetch(action, "cachesize", 9, FALSE);
932 info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
934 svp = hv_fetch(action, "lorder", 6, FALSE);
935 info->db_HA_lorder = svp ? SvIV(*svp) : 0;
939 else if (sv_isa(sv, "DB_File::BTREEINFO"))
942 croak("DB_File can only tie an associative array to a DB_BTREE database");
944 RETVAL->type = DB_BTREE ;
945 openinfo = (void*)info ;
947 svp = hv_fetch(action, "compare", 7, FALSE);
948 if (svp && SvOK(*svp))
950 info->db_BT_compare = btree_compare ;
951 RETVAL->compare = newSVsv(*svp) ;
954 info->db_BT_compare = NULL ;
956 svp = hv_fetch(action, "prefix", 6, FALSE);
957 if (svp && SvOK(*svp))
959 info->db_BT_prefix = btree_prefix ;
960 RETVAL->prefix = newSVsv(*svp) ;
963 info->db_BT_prefix = NULL ;
965 svp = hv_fetch(action, "flags", 5, FALSE);
966 info->db_BT_flags = svp ? SvIV(*svp) : 0;
968 svp = hv_fetch(action, "cachesize", 9, FALSE);
969 info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
971 #ifndef DB_VERSION_MAJOR
972 svp = hv_fetch(action, "minkeypage", 10, FALSE);
973 info->btree.minkeypage = svp ? SvIV(*svp) : 0;
975 svp = hv_fetch(action, "maxkeypage", 10, FALSE);
976 info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
979 svp = hv_fetch(action, "psize", 5, FALSE);
980 info->db_BT_psize = svp ? SvIV(*svp) : 0;
982 svp = hv_fetch(action, "lorder", 6, FALSE);
983 info->db_BT_lorder = svp ? SvIV(*svp) : 0;
988 else if (sv_isa(sv, "DB_File::RECNOINFO"))
991 croak("DB_File can only tie an array to a DB_RECNO database");
993 RETVAL->type = DB_RECNO ;
994 openinfo = (void *)info ;
996 info->db_RE_flags = 0 ;
998 svp = hv_fetch(action, "flags", 5, FALSE);
999 info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
1001 svp = hv_fetch(action, "reclen", 6, FALSE);
1002 info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
1004 svp = hv_fetch(action, "cachesize", 9, FALSE);
1005 info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
1007 svp = hv_fetch(action, "psize", 5, FALSE);
1008 info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
1010 svp = hv_fetch(action, "lorder", 6, FALSE);
1011 info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
1013 #ifdef DB_VERSION_MAJOR
1014 info->re_source = name ;
1017 svp = hv_fetch(action, "bfname", 6, FALSE);
1018 if (svp && SvOK(*svp)) {
1019 char * ptr = SvPV(*svp,n_a) ;
1020 #ifdef DB_VERSION_MAJOR
1021 name = (char*) n_a ? ptr : NULL ;
1023 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
1027 #ifdef DB_VERSION_MAJOR
1030 info->db_RE_bfname = NULL ;
1033 svp = hv_fetch(action, "bval", 4, FALSE);
1034 #ifdef DB_VERSION_MAJOR
1035 if (svp && SvOK(*svp))
1039 value = (int)*SvPV(*svp, n_a) ;
1041 value = SvIV(*svp) ;
1043 if (info->flags & DB_FIXEDLEN) {
1044 info->re_pad = value ;
1045 info->flags |= DB_PAD ;
1048 info->re_delim = value ;
1049 info->flags |= DB_DELIMITER ;
1054 if (svp && SvOK(*svp))
1057 info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
1059 info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
1060 DB_flags(info->flags, DB_DELIMITER) ;
1065 if (info->db_RE_flags & R_FIXEDLEN)
1066 info->db_RE_bval = (u_char) ' ' ;
1068 info->db_RE_bval = (u_char) '\n' ;
1069 DB_flags(info->flags, DB_DELIMITER) ;
1074 info->flags |= DB_RENUMBER ;
1080 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1084 /* OS2 Specific Code */
1088 #endif /* __EMX__ */
1091 #ifdef DB_VERSION_MAJOR
1097 /* Map 1.x flags to 2.x flags */
1098 if ((flags & O_CREAT) == O_CREAT)
1099 Flags |= DB_CREATE ;
1102 if (flags == O_RDONLY)
1104 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1106 Flags |= DB_RDONLY ;
1109 if ((flags & O_TRUNC) == O_TRUNC)
1110 Flags |= DB_TRUNCATE ;
1113 status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
1115 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
1116 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
1118 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1123 RETVAL->dbp = NULL ;
1128 #if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2
1129 RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ;
1131 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
1132 #endif /* DB_LIBRARY_COMPATIBILITY_API */
1138 #else /* Berkeley DB Version > 2 */
1142 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
1148 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
1149 Zero(RETVAL, 1, DB_File_type) ;
1151 /* Default to HASH */
1152 #ifdef DBM_FILTERING
1153 RETVAL->filtering = 0 ;
1154 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
1155 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
1156 #endif /* DBM_FILTERING */
1157 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
1158 RETVAL->type = DB_HASH ;
1160 /* DGH - Next line added to avoid SEGV on existing hash DB */
1163 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
1164 RETVAL->in_memory = (name == NULL) ;
1166 status = db_create(&RETVAL->dbp, NULL,0) ;
1167 /* printf("db_create returned %d %s\n", status, db_strerror(status)) ; */
1169 RETVAL->dbp = NULL ;
1177 croak ("type parameter is not a reference") ;
1179 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
1180 if (svp && SvOK(*svp))
1181 action = (HV*) SvRV(*svp) ;
1183 croak("internal error") ;
1185 if (sv_isa(sv, "DB_File::HASHINFO"))
1189 croak("DB_File can only tie an associative array to a DB_HASH database") ;
1191 RETVAL->type = DB_HASH ;
1193 svp = hv_fetch(action, "hash", 4, FALSE);
1195 if (svp && SvOK(*svp))
1197 (void)dbp->set_h_hash(dbp, hash_cb) ;
1198 RETVAL->hash = newSVsv(*svp) ;
1201 svp = hv_fetch(action, "ffactor", 7, FALSE);
1203 (void)dbp->set_h_ffactor(dbp, my_SvUV32(*svp)) ;
1205 svp = hv_fetch(action, "nelem", 5, FALSE);
1207 (void)dbp->set_h_nelem(dbp, my_SvUV32(*svp)) ;
1209 svp = hv_fetch(action, "bsize", 5, FALSE);
1211 (void)dbp->set_pagesize(dbp, my_SvUV32(*svp));
1213 svp = hv_fetch(action, "cachesize", 9, FALSE);
1215 (void)dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
1217 svp = hv_fetch(action, "lorder", 6, FALSE);
1219 (void)dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
1223 else if (sv_isa(sv, "DB_File::BTREEINFO"))
1226 croak("DB_File can only tie an associative array to a DB_BTREE database");
1228 RETVAL->type = DB_BTREE ;
1230 svp = hv_fetch(action, "compare", 7, FALSE);
1231 if (svp && SvOK(*svp))
1233 (void)dbp->set_bt_compare(dbp, btree_compare) ;
1234 RETVAL->compare = newSVsv(*svp) ;
1237 svp = hv_fetch(action, "prefix", 6, FALSE);
1238 if (svp && SvOK(*svp))
1240 (void)dbp->set_bt_prefix(dbp, btree_prefix) ;
1241 RETVAL->prefix = newSVsv(*svp) ;
1244 svp = hv_fetch(action, "flags", 5, FALSE);
1246 (void)dbp->set_flags(dbp, my_SvUV32(*svp)) ;
1248 svp = hv_fetch(action, "cachesize", 9, FALSE);
1250 (void)dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
1252 svp = hv_fetch(action, "psize", 5, FALSE);
1254 (void)dbp->set_pagesize(dbp, my_SvUV32(*svp)) ;
1256 svp = hv_fetch(action, "lorder", 6, FALSE);
1258 (void)dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
1263 else if (sv_isa(sv, "DB_File::RECNOINFO"))
1268 croak("DB_File can only tie an array to a DB_RECNO database");
1270 RETVAL->type = DB_RECNO ;
1272 svp = hv_fetch(action, "flags", 5, FALSE);
1274 int flags = SvIV(*svp) ;
1275 /* remove FIXDLEN, if present */
1276 if (flags & DB_FIXEDLEN) {
1278 flags &= ~DB_FIXEDLEN ;
1282 svp = hv_fetch(action, "cachesize", 9, FALSE);
1284 status = dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
1287 svp = hv_fetch(action, "psize", 5, FALSE);
1289 status = dbp->set_pagesize(dbp, my_SvUV32(*svp)) ;
1292 svp = hv_fetch(action, "lorder", 6, FALSE);
1294 status = dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
1297 svp = hv_fetch(action, "bval", 4, FALSE);
1298 if (svp && SvOK(*svp))
1302 value = (int)*SvPV(*svp, n_a) ;
1304 value = (int)SvIV(*svp) ;
1307 status = dbp->set_re_pad(dbp, value) ;
1310 status = dbp->set_re_delim(dbp, value) ;
1316 svp = hv_fetch(action, "reclen", 6, FALSE);
1318 u_int32_t len = my_SvUV32(*svp) ;
1319 status = dbp->set_re_len(dbp, len) ;
1324 status = dbp->set_re_source(dbp, name) ;
1328 svp = hv_fetch(action, "bfname", 6, FALSE);
1329 if (svp && SvOK(*svp)) {
1330 char * ptr = SvPV(*svp,n_a) ;
1331 name = (char*) n_a ? ptr : NULL ;
1337 status = dbp->set_flags(dbp, (u_int32_t)DB_RENUMBER) ;
1340 (void)dbp->set_flags(dbp, (u_int32_t)flags) ;
1345 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1349 u_int32_t Flags = 0 ;
1352 /* Map 1.x flags to 3.x flags */
1353 if ((flags & O_CREAT) == O_CREAT)
1354 Flags |= DB_CREATE ;
1357 if (flags == O_RDONLY)
1359 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1361 Flags |= DB_RDONLY ;
1364 if ((flags & O_TRUNC) == O_TRUNC)
1365 Flags |= DB_TRUNCATE ;
1368 status = (RETVAL->dbp->open)(RETVAL->dbp, name, NULL, RETVAL->type,
1370 /* printf("open returned %d %s\n", status, db_strerror(status)) ; */
1373 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1375 /* printf("cursor returned %d %s\n", status, db_strerror(status)) ; */
1378 RETVAL->dbp = NULL ;
1384 #endif /* Berkeley DB Version > 2 */
1386 } /* ParseOpenInfo */
1389 #include "constants.h"
1391 MODULE = DB_File PACKAGE = DB_File PREFIX = db_
1393 INCLUDE: constants.xs
1398 __getBerkeleyDBInfo() ;
1401 empty.data = &zero ;
1402 empty.size = sizeof(recno_t) ;
1408 db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
1415 char * name = (char *) NULL ;
1416 SV * sv = (SV *) NULL ;
1419 if (items >= 3 && SvOK(ST(2)))
1420 name = (char*) SvPV(ST(2), n_a) ;
1425 RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
1426 if (RETVAL->dbp == NULL)
1441 SvREFCNT_dec(db->hash) ;
1443 SvREFCNT_dec(db->compare) ;
1445 SvREFCNT_dec(db->prefix) ;
1446 #ifdef DBM_FILTERING
1447 if (db->filter_fetch_key)
1448 SvREFCNT_dec(db->filter_fetch_key) ;
1449 if (db->filter_store_key)
1450 SvREFCNT_dec(db->filter_store_key) ;
1451 if (db->filter_fetch_value)
1452 SvREFCNT_dec(db->filter_fetch_value) ;
1453 if (db->filter_store_value)
1454 SvREFCNT_dec(db->filter_store_value) ;
1455 #endif /* DBM_FILTERING */
1457 #ifdef DB_VERSION_MAJOR
1464 db_DELETE(db, key, flags=0)
1486 RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
1492 db_FETCH(db, key, flags=0)
1505 /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */
1506 RETVAL = db_get(db, key, value, flags) ;
1507 ST(0) = sv_newmortal();
1508 OutputValue(ST(0), value)
1512 db_STORE(db, key, value, flags=0)
1537 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1538 ST(0) = sv_newmortal();
1539 OutputKey(ST(0), key) ;
1545 DBTKEY key = NO_INIT
1556 RETVAL = do_SEQ(db, key, value, R_NEXT) ;
1557 ST(0) = sv_newmortal();
1558 OutputKey(ST(0), key) ;
1562 # These would be nice for RECNO
1582 #ifdef DB_VERSION_MAJOR
1583 /* get the first value */
1584 RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1589 for (i = items-1 ; i > 0 ; --i)
1591 value.data = SvPV(ST(i), n_a) ;
1595 key.size = sizeof(int) ;
1596 #ifdef DB_VERSION_MAJOR
1597 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1599 RETVAL = (db->dbp->put)(db->dbp, &key, &value, R_IBEFORE) ;
1625 /* First get the final value */
1626 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1627 ST(0) = sv_newmortal();
1631 /* the call to del will trash value, so take a copy now */
1632 OutputValue(ST(0), value) ;
1633 RETVAL = db_del(db, key, R_CURSOR) ;
1635 sv_setsv(ST(0), &PL_sv_undef);
1655 /* get the first value */
1656 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1657 ST(0) = sv_newmortal();
1661 /* the call to del will trash value, so take a copy now */
1662 OutputValue(ST(0), value) ;
1663 RETVAL = db_del(db, key, R_CURSOR) ;
1665 sv_setsv (ST(0), &PL_sv_undef) ;
1688 /* Set the Cursor to the Last element */
1689 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1690 #ifndef DB_VERSION_MAJOR
1695 keyval = *(int*)key.data ;
1698 for (i = 1 ; i < items ; ++i)
1700 value.data = SvPV(ST(i), n_a) ;
1703 key.data = &keyval ;
1704 key.size = sizeof(int) ;
1705 RETVAL = (Db->put)(Db, TXN &key, &value, 0) ;
1719 ALIAS: FETCHSIZE = 1
1722 RETVAL = GetArrayLength(aTHX_ db) ;
1728 # Now provide an interface to the rest of the DB functionality
1732 db_del(db, key, flags=0)
1740 RETVAL = db_del(db, key, flags) ;
1741 #ifdef DB_VERSION_MAJOR
1744 else if (RETVAL == DB_NOTFOUND)
1752 db_get(db, key, value, flags=0)
1762 RETVAL = db_get(db, key, value, flags) ;
1763 #ifdef DB_VERSION_MAJOR
1766 else if (RETVAL == DB_NOTFOUND)
1774 db_put(db, key, value, flags=0)
1783 RETVAL = db_put(db, key, value, flags) ;
1784 #ifdef DB_VERSION_MAJOR
1787 else if (RETVAL == DB_KEYEXIST)
1792 key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
1801 #ifdef DB_VERSION_MAJOR
1805 status = (db->in_memory
1807 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
1812 RETVAL = (db->in_memory
1814 : ((db->dbp)->fd)(db->dbp) ) ;
1820 db_sync(db, flags=0)
1827 RETVAL = db_sync(db, flags) ;
1828 #ifdef DB_VERSION_MAJOR
1837 db_seq(db, key, value, flags)
1847 RETVAL = db_seq(db, key, value, flags);
1848 #ifdef DB_VERSION_MAJOR
1851 else if (RETVAL == DB_NOTFOUND)
1859 #ifdef DBM_FILTERING
1861 #define setFilter(type) \
1864 RETVAL = sv_mortalcopy(db->type) ; \
1866 if (db->type && (code == &PL_sv_undef)) { \
1867 SvREFCNT_dec(db->type) ; \
1872 sv_setsv(db->type, code) ; \
1874 db->type = newSVsv(code) ; \
1880 filter_fetch_key(db, code)
1883 SV * RETVAL = &PL_sv_undef ;
1885 setFilter(filter_fetch_key) ;
1888 filter_store_key(db, code)
1891 SV * RETVAL = &PL_sv_undef ;
1893 setFilter(filter_store_key) ;
1896 filter_fetch_value(db, code)
1899 SV * RETVAL = &PL_sv_undef ;
1901 setFilter(filter_fetch_value) ;
1904 filter_store_value(db, code)
1907 SV * RETVAL = &PL_sv_undef ;
1909 setFilter(filter_store_value) ;
1911 #endif /* DBM_FILTERING */