3 DB_File.xs -- Perl 5 interface to Berkeley DB
5 written by Paul Marquess <Paul.Marquess@btinternet.com>
6 last modified 30th July 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.
99 #define PERL_NO_GET_CONTEXT
105 # include "patchlevel.h"
106 # define PERL_REVISION 5
107 # define PERL_VERSION PATCHLEVEL
108 # define PERL_SUBVERSION SUBVERSION
111 #if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 ))
113 # define PL_sv_undef sv_undef
118 /* DEFSV appears first in 5.004_56 */
120 # define DEFSV GvSV(defgv)
123 /* Mention DB_VERSION_MAJOR_CFG, DB_VERSION_MINOR_CFG, and
124 DB_VERSION_PATCH_CFG here so that Configure pulls them all in. */
126 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
127 * shortly #included by the <db.h>) __attribute__ to the possibly
128 * already defined __attribute__, for example by GNUC or by Perl. */
130 /* #if DB_VERSION_MAJOR_CFG < 2 */
131 #ifndef DB_VERSION_MAJOR
132 # undef __attribute__
137 /* If Perl has been compiled with Threads support,the symbol op will
138 be defined here. This clashes with a field name in db.h, so get rid of it.
150 /* Wall starts with 5.7.x */
152 #if PERL_REVISION > 5 || (PERL_REVISION == 5 && PERL_VERSION >= 7)
154 /* Since we dropped the gccish definition of __attribute__ we will want
155 * to redefine dNOOP, however (so that dTHX continues to work). Yes,
156 * all this means that we can't do attribute checking on the DB_File,
158 # ifndef DB_VERSION_MAJOR
161 # define dNOOP extern int Perl___notused
163 /* Ditto for dXSARGS. */
167 I32 ax = mark - PL_stack_base + 1; \
168 I32 items = sp - mark
172 /* avoid -Wall; DB_File xsubs never make use of `ix' setup for ALIASes */
174 # define dXSI32 dNOOP
176 #endif /* Perl >= 5.7 */
186 # define newSVpvn(a,b) newSVpv(a,b)
192 #define DBM_FILTERING
195 # define Trace(x) printf x
201 #define DBT_clear(x) Zero(&x, 1, DBT) ;
203 #ifdef DB_VERSION_MAJOR
205 #if DB_VERSION_MAJOR == 2
206 # define BERKELEY_DB_1_OR_2
209 #if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 2)
210 # define AT_LEAST_DB_3_2
213 /* map version 2 features & constants onto their version 1 equivalent */
218 #define DB_Prefix_t size_t
223 #define DB_Hash_t u_int32_t
225 /* DBTYPE stays the same */
226 /* HASHINFO, RECNOINFO and BTREEINFO map to DB_INFO */
227 #if DB_VERSION_MAJOR == 2
228 typedef DB_INFO INFO ;
229 #else /* DB_VERSION_MAJOR > 2 */
230 # define DB_FIXEDLEN (0x8000)
231 #endif /* DB_VERSION_MAJOR == 2 */
233 /* version 2 has db_recno_t in place of recno_t */
234 typedef db_recno_t recno_t;
237 #define R_CURSOR DB_SET_RANGE
238 #define R_FIRST DB_FIRST
239 #define R_IAFTER DB_AFTER
240 #define R_IBEFORE DB_BEFORE
241 #define R_LAST DB_LAST
242 #define R_NEXT DB_NEXT
243 #define R_NOOVERWRITE DB_NOOVERWRITE
244 #define R_PREV DB_PREV
246 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
247 # define R_SETCURSOR 0x800000
249 # define R_SETCURSOR (-100)
252 #define R_RECNOSYNC 0
253 #define R_FIXEDLEN DB_FIXEDLEN
257 #define db_HA_hash h_hash
258 #define db_HA_ffactor h_ffactor
259 #define db_HA_nelem h_nelem
260 #define db_HA_bsize db_pagesize
261 #define db_HA_cachesize db_cachesize
262 #define db_HA_lorder db_lorder
264 #define db_BT_compare bt_compare
265 #define db_BT_prefix bt_prefix
266 #define db_BT_flags flags
267 #define db_BT_psize db_pagesize
268 #define db_BT_cachesize db_cachesize
269 #define db_BT_lorder db_lorder
270 #define db_BT_maxkeypage
271 #define db_BT_minkeypage
274 #define db_RE_reclen re_len
275 #define db_RE_flags flags
276 #define db_RE_bval re_pad
277 #define db_RE_bfname re_source
278 #define db_RE_psize db_pagesize
279 #define db_RE_cachesize db_cachesize
280 #define db_RE_lorder db_lorder
284 #define do_SEQ(db, key, value, flag) (db->cursor->c_get)(db->cursor, &key, &value, flag)
287 #define DBT_flags(x) x.flags = 0
288 #define DB_flags(x, v) x |= v
290 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
291 # define flagSet(flags, bitmask) ((flags) & (bitmask))
293 # define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask))
296 #else /* db version 1.x */
298 #define BERKELEY_DB_1
299 #define BERKELEY_DB_1_OR_2
312 # define DB_Prefix_t mDB_Prefix_t
319 # define DB_Hash_t mDB_Hash_t
322 #define db_HA_hash hash.hash
323 #define db_HA_ffactor hash.ffactor
324 #define db_HA_nelem hash.nelem
325 #define db_HA_bsize hash.bsize
326 #define db_HA_cachesize hash.cachesize
327 #define db_HA_lorder hash.lorder
329 #define db_BT_compare btree.compare
330 #define db_BT_prefix btree.prefix
331 #define db_BT_flags btree.flags
332 #define db_BT_psize btree.psize
333 #define db_BT_cachesize btree.cachesize
334 #define db_BT_lorder btree.lorder
335 #define db_BT_maxkeypage btree.maxkeypage
336 #define db_BT_minkeypage btree.minkeypage
338 #define db_RE_reclen recno.reclen
339 #define db_RE_flags recno.flags
340 #define db_RE_bval recno.bval
341 #define db_RE_bfname recno.bfname
342 #define db_RE_psize recno.psize
343 #define db_RE_cachesize recno.cachesize
344 #define db_RE_lorder recno.lorder
348 #define do_SEQ(db, key, value, flag) (db->dbp->seq)(db->dbp, &key, &value, flag)
350 #define DB_flags(x, v)
351 #define flagSet(flags, bitmask) ((flags) & (bitmask))
353 #endif /* db version 1 */
357 #define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, TXN &key, flags)
358 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, flags)
359 #define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
361 #define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
362 #define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
364 #ifdef DB_VERSION_MAJOR
365 #define db_DESTROY(db) ( db->cursor->c_close(db->cursor),\
366 (db->dbp->close)(db->dbp, 0) )
367 #define db_close(db) ((db->dbp)->close)(db->dbp, 0)
368 #define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \
369 ? ((db->cursor)->c_del)(db->cursor, 0) \
370 : ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
372 #else /* ! DB_VERSION_MAJOR */
374 #define db_DESTROY(db) ((db->dbp)->close)(db->dbp)
375 #define db_close(db) ((db->dbp)->close)(db->dbp)
376 #define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
377 #define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
379 #endif /* ! DB_VERSION_MAJOR */
382 #define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags)
391 #ifdef BERKELEY_DB_1_OR_2
394 #ifdef DB_VERSION_MAJOR
398 SV * filter_fetch_key ;
399 SV * filter_store_key ;
400 SV * filter_fetch_value ;
401 SV * filter_store_value ;
403 #endif /* DBM_FILTERING */
407 typedef DB_File_type * DB_File ;
412 #define ckFilter(arg,type,name) \
415 /* printf("filtering %s\n", name) ;*/ \
417 croak("recursion detected in %s", name) ; \
418 db->filtering = TRUE ; \
419 save_defsv = newSVsv(DEFSV) ; \
420 sv_setsv(DEFSV, arg) ; \
422 (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \
423 sv_setsv(arg, DEFSV) ; \
424 sv_setsv(DEFSV, save_defsv) ; \
425 SvREFCNT_dec(save_defsv) ; \
426 db->filtering = FALSE ; \
427 /*printf("end of filtering %s\n", name) ;*/ \
432 #define ckFilter(arg,type, name)
434 #endif /* DBM_FILTERING */
436 #define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
438 #define OutputValue(arg, name) \
439 { if (RETVAL == 0) { \
440 my_sv_setpvn(arg, name.data, name.size) ; \
441 ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \
445 #define OutputKey(arg, name) \
448 if (db->type != DB_RECNO) { \
449 my_sv_setpvn(arg, name.data, name.size); \
452 sv_setiv(arg, (I32)*(I32*)name.data - 1); \
453 ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \
459 extern void __getBerkeleyDBInfo(void);
462 /* Internal Global Data */
463 static recno_t Value ;
464 static recno_t zero = 0 ;
465 static DB_File CurrentDB ;
466 static DBTKEY empty ;
468 #ifdef DB_VERSION_MAJOR
472 db_put(DB_File db, DBTKEY key, DBT value, u_int flags)
474 db_put(db, key, value, flags)
483 if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) {
487 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
488 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor) != 0)
490 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor, 0) != 0)
494 memset(&l_key, 0, sizeof(l_key));
495 l_key.data = key.data;
496 l_key.size = key.size;
497 memset(&l_value, 0, sizeof(l_value));
498 l_value.data = value.data;
499 l_value.size = value.size;
501 if ( temp_cursor->c_get(temp_cursor, &l_key, &l_value, DB_SET) != 0) {
502 (void)temp_cursor->c_close(temp_cursor);
506 status = temp_cursor->c_put(temp_cursor, &key, &value, flags);
507 (void)temp_cursor->c_close(temp_cursor);
513 if (flagSet(flags, R_CURSOR)) {
514 return ((db->cursor)->c_put)(db->cursor, &key, &value, DB_CURRENT);
517 if (flagSet(flags, R_SETCURSOR)) {
518 if ((db->dbp)->put(db->dbp, NULL, &key, &value, 0) != 0)
520 return ((db->cursor)->c_get)(db->cursor, &key, &value, DB_SET_RANGE);
524 return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
528 #endif /* DB_VERSION_MAJOR */
532 #ifdef AT_LEAST_DB_3_2
535 btree_compare(DB * db, const DBT *key1, const DBT *key2)
537 btree_compare(db, key1, key2)
541 #endif /* CAN_PROTOTYPE */
543 #else /* Berkeley DB < 3.2 */
546 btree_compare(const DBT *key1, const DBT *key2)
548 btree_compare(key1, key2)
560 char * data1, * data2 ;
564 data1 = (char *) key1->data ;
565 data2 = (char *) key2->data ;
568 /* As newSVpv will assume that the data pointer is a null terminated C
569 string if the size parameter is 0, make sure that data points to an
570 empty string if the length is 0
583 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
584 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
587 count = perl_call_sv(CurrentDB->compare, G_SCALAR);
592 croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
604 #ifdef AT_LEAST_DB_3_2
607 btree_prefix(DB * db, const DBT *key1, const DBT *key2)
609 btree_prefix(db, key1, key2)
615 #else /* Berkeley DB < 3.2 */
618 btree_prefix(const DBT *key1, const DBT *key2)
620 btree_prefix(key1, key2)
631 char * data1, * data2 ;
635 data1 = (char *) key1->data ;
636 data2 = (char *) key2->data ;
639 /* As newSVpv will assume that the data pointer is a null terminated C
640 string if the size parameter is 0, make sure that data points to an
641 empty string if the length is 0
654 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
655 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
658 count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
663 croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
676 # define HASH_CB_SIZE_TYPE size_t
678 # define HASH_CB_SIZE_TYPE u_int32_t
682 #ifdef AT_LEAST_DB_3_2
685 hash_cb(DB * db, const void *data, u_int32_t size)
687 hash_cb(db, data, size)
690 HASH_CB_SIZE_TYPE size ;
693 #else /* Berkeley DB < 3.2 */
696 hash_cb(const void *data, HASH_CB_SIZE_TYPE size)
700 HASH_CB_SIZE_TYPE size ;
717 /* DGH - Next two lines added to fix corrupted stack problem */
723 XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
726 count = perl_call_sv(CurrentDB->hash, G_SCALAR);
731 croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
743 #if defined(TRACE) && defined(BERKELEY_DB_1_OR_2)
747 PrintHash(INFO *hash)
753 printf ("HASH Info\n") ;
754 printf (" hash = %s\n",
755 (hash->db_HA_hash != NULL ? "redefined" : "default")) ;
756 printf (" bsize = %d\n", hash->db_HA_bsize) ;
757 printf (" ffactor = %d\n", hash->db_HA_ffactor) ;
758 printf (" nelem = %d\n", hash->db_HA_nelem) ;
759 printf (" cachesize = %d\n", hash->db_HA_cachesize) ;
760 printf (" lorder = %d\n", hash->db_HA_lorder) ;
766 PrintRecno(INFO *recno)
772 printf ("RECNO Info\n") ;
773 printf (" flags = %d\n", recno->db_RE_flags) ;
774 printf (" cachesize = %d\n", recno->db_RE_cachesize) ;
775 printf (" psize = %d\n", recno->db_RE_psize) ;
776 printf (" lorder = %d\n", recno->db_RE_lorder) ;
777 printf (" reclen = %ul\n", (unsigned long)recno->db_RE_reclen) ;
778 printf (" bval = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
779 printf (" bfname = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
784 PrintBtree(INFO *btree)
790 printf ("BTREE Info\n") ;
791 printf (" compare = %s\n",
792 (btree->db_BT_compare ? "redefined" : "default")) ;
793 printf (" prefix = %s\n",
794 (btree->db_BT_prefix ? "redefined" : "default")) ;
795 printf (" flags = %d\n", btree->db_BT_flags) ;
796 printf (" cachesize = %d\n", btree->db_BT_cachesize) ;
797 printf (" psize = %d\n", btree->db_BT_psize) ;
798 #ifndef DB_VERSION_MAJOR
799 printf (" maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
800 printf (" minkeypage = %d\n", btree->db_BT_minkeypage) ;
802 printf (" lorder = %d\n", btree->db_BT_lorder) ;
807 #define PrintRecno(recno)
808 #define PrintHash(hash)
809 #define PrintBtree(btree)
816 GetArrayLength(pTHX_ DB_File db)
828 RETVAL = do_SEQ(db, key, value, R_LAST) ;
830 RETVAL = *(I32 *)key.data ;
831 else /* No key means empty file */
834 return ((I32)RETVAL) ;
839 GetRecnoKey(pTHX_ DB_File db, I32 value)
841 GetRecnoKey(db, value)
847 /* Get the length of the array */
848 I32 length = GetArrayLength(aTHX_ db) ;
850 /* check for attempt to write before start of array */
851 if (length + value + 1 <= 0)
852 croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
854 value = length + value + 1 ;
865 ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv)
867 ParseOpenInfo(isHASH, name, flags, mode, sv)
876 #ifdef BERKELEY_DB_1_OR_2 /* Berkeley DB Version 1 or 2 */
880 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
881 void * openinfo = NULL ;
882 INFO * info = &RETVAL->info ;
885 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
886 Zero(RETVAL, 1, DB_File_type) ;
888 /* Default to HASH */
890 RETVAL->filtering = 0 ;
891 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
892 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
893 #endif /* DBM_FILTERING */
894 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
895 RETVAL->type = DB_HASH ;
897 /* DGH - Next line added to avoid SEGV on existing hash DB */
900 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
901 RETVAL->in_memory = (name == NULL) ;
906 croak ("type parameter is not a reference") ;
908 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
909 if (svp && SvOK(*svp))
910 action = (HV*) SvRV(*svp) ;
912 croak("internal error") ;
914 if (sv_isa(sv, "DB_File::HASHINFO"))
918 croak("DB_File can only tie an associative array to a DB_HASH database") ;
920 RETVAL->type = DB_HASH ;
921 openinfo = (void*)info ;
923 svp = hv_fetch(action, "hash", 4, FALSE);
925 if (svp && SvOK(*svp))
927 info->db_HA_hash = hash_cb ;
928 RETVAL->hash = newSVsv(*svp) ;
931 info->db_HA_hash = NULL ;
933 svp = hv_fetch(action, "ffactor", 7, FALSE);
934 info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
936 svp = hv_fetch(action, "nelem", 5, FALSE);
937 info->db_HA_nelem = svp ? SvIV(*svp) : 0;
939 svp = hv_fetch(action, "bsize", 5, FALSE);
940 info->db_HA_bsize = svp ? SvIV(*svp) : 0;
942 svp = hv_fetch(action, "cachesize", 9, FALSE);
943 info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
945 svp = hv_fetch(action, "lorder", 6, FALSE);
946 info->db_HA_lorder = svp ? SvIV(*svp) : 0;
950 else if (sv_isa(sv, "DB_File::BTREEINFO"))
953 croak("DB_File can only tie an associative array to a DB_BTREE database");
955 RETVAL->type = DB_BTREE ;
956 openinfo = (void*)info ;
958 svp = hv_fetch(action, "compare", 7, FALSE);
959 if (svp && SvOK(*svp))
961 info->db_BT_compare = btree_compare ;
962 RETVAL->compare = newSVsv(*svp) ;
965 info->db_BT_compare = NULL ;
967 svp = hv_fetch(action, "prefix", 6, FALSE);
968 if (svp && SvOK(*svp))
970 info->db_BT_prefix = btree_prefix ;
971 RETVAL->prefix = newSVsv(*svp) ;
974 info->db_BT_prefix = NULL ;
976 svp = hv_fetch(action, "flags", 5, FALSE);
977 info->db_BT_flags = svp ? SvIV(*svp) : 0;
979 svp = hv_fetch(action, "cachesize", 9, FALSE);
980 info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
982 #ifndef DB_VERSION_MAJOR
983 svp = hv_fetch(action, "minkeypage", 10, FALSE);
984 info->btree.minkeypage = svp ? SvIV(*svp) : 0;
986 svp = hv_fetch(action, "maxkeypage", 10, FALSE);
987 info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
990 svp = hv_fetch(action, "psize", 5, FALSE);
991 info->db_BT_psize = svp ? SvIV(*svp) : 0;
993 svp = hv_fetch(action, "lorder", 6, FALSE);
994 info->db_BT_lorder = svp ? SvIV(*svp) : 0;
999 else if (sv_isa(sv, "DB_File::RECNOINFO"))
1002 croak("DB_File can only tie an array to a DB_RECNO database");
1004 RETVAL->type = DB_RECNO ;
1005 openinfo = (void *)info ;
1007 info->db_RE_flags = 0 ;
1009 svp = hv_fetch(action, "flags", 5, FALSE);
1010 info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
1012 svp = hv_fetch(action, "reclen", 6, FALSE);
1013 info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
1015 svp = hv_fetch(action, "cachesize", 9, FALSE);
1016 info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
1018 svp = hv_fetch(action, "psize", 5, FALSE);
1019 info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
1021 svp = hv_fetch(action, "lorder", 6, FALSE);
1022 info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
1024 #ifdef DB_VERSION_MAJOR
1025 info->re_source = name ;
1028 svp = hv_fetch(action, "bfname", 6, FALSE);
1029 if (svp && SvOK(*svp)) {
1030 char * ptr = SvPV(*svp,n_a) ;
1031 #ifdef DB_VERSION_MAJOR
1032 name = (char*) n_a ? ptr : NULL ;
1034 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
1038 #ifdef DB_VERSION_MAJOR
1041 info->db_RE_bfname = NULL ;
1044 svp = hv_fetch(action, "bval", 4, FALSE);
1045 #ifdef DB_VERSION_MAJOR
1046 if (svp && SvOK(*svp))
1050 value = (int)*SvPV(*svp, n_a) ;
1052 value = SvIV(*svp) ;
1054 if (info->flags & DB_FIXEDLEN) {
1055 info->re_pad = value ;
1056 info->flags |= DB_PAD ;
1059 info->re_delim = value ;
1060 info->flags |= DB_DELIMITER ;
1065 if (svp && SvOK(*svp))
1068 info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
1070 info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
1071 DB_flags(info->flags, DB_DELIMITER) ;
1076 if (info->db_RE_flags & R_FIXEDLEN)
1077 info->db_RE_bval = (u_char) ' ' ;
1079 info->db_RE_bval = (u_char) '\n' ;
1080 DB_flags(info->flags, DB_DELIMITER) ;
1085 info->flags |= DB_RENUMBER ;
1091 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1095 /* OS2 Specific Code */
1099 #endif /* __EMX__ */
1102 #ifdef DB_VERSION_MAJOR
1108 /* Map 1.x flags to 2.x flags */
1109 if ((flags & O_CREAT) == O_CREAT)
1110 Flags |= DB_CREATE ;
1113 if (flags == O_RDONLY)
1115 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1117 Flags |= DB_RDONLY ;
1120 if ((flags & O_TRUNC) == O_TRUNC)
1121 Flags |= DB_TRUNCATE ;
1124 status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
1126 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
1127 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
1129 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1134 RETVAL->dbp = NULL ;
1139 #if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2
1140 RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ;
1142 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
1143 #endif /* DB_LIBRARY_COMPATIBILITY_API */
1149 #else /* Berkeley DB Version > 2 */
1153 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
1158 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
1159 Zero(RETVAL, 1, DB_File_type) ;
1161 /* Default to HASH */
1162 #ifdef DBM_FILTERING
1163 RETVAL->filtering = 0 ;
1164 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
1165 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
1166 #endif /* DBM_FILTERING */
1167 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
1168 RETVAL->type = DB_HASH ;
1170 /* DGH - Next line added to avoid SEGV on existing hash DB */
1173 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
1174 RETVAL->in_memory = (name == NULL) ;
1176 status = db_create(&RETVAL->dbp, NULL,0) ;
1177 /* printf("db_create returned %d %s\n", status, db_strerror(status)) ; */
1179 RETVAL->dbp = NULL ;
1187 croak ("type parameter is not a reference") ;
1189 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
1190 if (svp && SvOK(*svp))
1191 action = (HV*) SvRV(*svp) ;
1193 croak("internal error") ;
1195 if (sv_isa(sv, "DB_File::HASHINFO"))
1199 croak("DB_File can only tie an associative array to a DB_HASH database") ;
1201 RETVAL->type = DB_HASH ;
1203 svp = hv_fetch(action, "hash", 4, FALSE);
1205 if (svp && SvOK(*svp))
1207 (void)dbp->set_h_hash(dbp, hash_cb) ;
1208 RETVAL->hash = newSVsv(*svp) ;
1211 svp = hv_fetch(action, "ffactor", 7, FALSE);
1213 (void)dbp->set_h_ffactor(dbp, SvIV(*svp)) ;
1215 svp = hv_fetch(action, "nelem", 5, FALSE);
1217 (void)dbp->set_h_nelem(dbp, SvIV(*svp)) ;
1219 svp = hv_fetch(action, "bsize", 5, FALSE);
1221 (void)dbp->set_pagesize(dbp, SvIV(*svp));
1223 svp = hv_fetch(action, "cachesize", 9, FALSE);
1225 (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1227 svp = hv_fetch(action, "lorder", 6, FALSE);
1229 (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
1233 else if (sv_isa(sv, "DB_File::BTREEINFO"))
1236 croak("DB_File can only tie an associative array to a DB_BTREE database");
1238 RETVAL->type = DB_BTREE ;
1240 svp = hv_fetch(action, "compare", 7, FALSE);
1241 if (svp && SvOK(*svp))
1243 (void)dbp->set_bt_compare(dbp, btree_compare) ;
1244 RETVAL->compare = newSVsv(*svp) ;
1247 svp = hv_fetch(action, "prefix", 6, FALSE);
1248 if (svp && SvOK(*svp))
1250 (void)dbp->set_bt_prefix(dbp, btree_prefix) ;
1251 RETVAL->prefix = newSVsv(*svp) ;
1254 svp = hv_fetch(action, "flags", 5, FALSE);
1256 (void)dbp->set_flags(dbp, (u_int32_t)SvIV(*svp)) ;
1258 svp = hv_fetch(action, "cachesize", 9, FALSE);
1260 (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1262 svp = hv_fetch(action, "psize", 5, FALSE);
1264 (void)dbp->set_pagesize(dbp, SvIV(*svp)) ;
1266 svp = hv_fetch(action, "lorder", 6, FALSE);
1268 (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
1273 else if (sv_isa(sv, "DB_File::RECNOINFO"))
1278 croak("DB_File can only tie an array to a DB_RECNO database");
1280 RETVAL->type = DB_RECNO ;
1282 svp = hv_fetch(action, "flags", 5, FALSE);
1284 int flags = SvIV(*svp) ;
1285 /* remove FIXDLEN, if present */
1286 if (flags & DB_FIXEDLEN) {
1288 flags &= ~DB_FIXEDLEN ;
1292 svp = hv_fetch(action, "cachesize", 9, FALSE);
1294 status = dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1297 svp = hv_fetch(action, "psize", 5, FALSE);
1299 status = dbp->set_pagesize(dbp, SvIV(*svp)) ;
1302 svp = hv_fetch(action, "lorder", 6, FALSE);
1304 status = dbp->set_lorder(dbp, SvIV(*svp)) ;
1307 svp = hv_fetch(action, "bval", 4, FALSE);
1308 if (svp && SvOK(*svp))
1312 value = (int)*SvPV(*svp, n_a) ;
1314 value = SvIV(*svp) ;
1317 status = dbp->set_re_pad(dbp, value) ;
1320 status = dbp->set_re_delim(dbp, value) ;
1326 svp = hv_fetch(action, "reclen", 6, FALSE);
1328 u_int32_t len = (u_int32_t)SvIV(*svp) ;
1329 status = dbp->set_re_len(dbp, len) ;
1334 status = dbp->set_re_source(dbp, name) ;
1338 svp = hv_fetch(action, "bfname", 6, FALSE);
1339 if (svp && SvOK(*svp)) {
1340 char * ptr = SvPV(*svp,n_a) ;
1341 name = (char*) n_a ? ptr : NULL ;
1347 status = dbp->set_flags(dbp, DB_RENUMBER) ;
1350 (void)dbp->set_flags(dbp, flags) ;
1355 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1362 /* Map 1.x flags to 3.x flags */
1363 if ((flags & O_CREAT) == O_CREAT)
1364 Flags |= DB_CREATE ;
1367 if (flags == O_RDONLY)
1369 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1371 Flags |= DB_RDONLY ;
1374 if ((flags & O_TRUNC) == O_TRUNC)
1375 Flags |= DB_TRUNCATE ;
1378 status = (RETVAL->dbp->open)(RETVAL->dbp, name, NULL, RETVAL->type,
1380 /* printf("open returned %d %s\n", status, db_strerror(status)) ; */
1383 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1385 /* printf("cursor returned %d %s\n", status, db_strerror(status)) ; */
1388 RETVAL->dbp = NULL ;
1394 #endif /* Berkeley DB Version > 2 */
1396 } /* ParseOpenInfo */
1400 #ifdef CAN_PROTOTYPE
1401 constant(char *name, int arg)
1413 if (strEQ(name, "BTREEMAGIC"))
1419 if (strEQ(name, "BTREEVERSION"))
1421 return BTREEVERSION;
1429 if (strEQ(name, "DB_LOCK"))
1435 if (strEQ(name, "DB_SHMEM"))
1441 if (strEQ(name, "DB_TXN"))
1455 if (strEQ(name, "HASHMAGIC"))
1461 if (strEQ(name, "HASHVERSION"))
1477 if (strEQ(name, "MAX_PAGE_NUMBER"))
1478 #ifdef MAX_PAGE_NUMBER
1479 return (U32)MAX_PAGE_NUMBER;
1483 if (strEQ(name, "MAX_PAGE_OFFSET"))
1484 #ifdef MAX_PAGE_OFFSET
1485 return MAX_PAGE_OFFSET;
1489 if (strEQ(name, "MAX_REC_NUMBER"))
1490 #ifdef MAX_REC_NUMBER
1491 return (U32)MAX_REC_NUMBER;
1505 if (strEQ(name, "RET_ERROR"))
1511 if (strEQ(name, "RET_SPECIAL"))
1517 if (strEQ(name, "RET_SUCCESS"))
1523 if (strEQ(name, "R_CURSOR"))
1529 if (strEQ(name, "R_DUP"))
1535 if (strEQ(name, "R_FIRST"))
1541 if (strEQ(name, "R_FIXEDLEN"))
1547 if (strEQ(name, "R_IAFTER"))
1553 if (strEQ(name, "R_IBEFORE"))
1559 if (strEQ(name, "R_LAST"))
1565 if (strEQ(name, "R_NEXT"))
1571 if (strEQ(name, "R_NOKEY"))
1577 if (strEQ(name, "R_NOOVERWRITE"))
1578 #ifdef R_NOOVERWRITE
1579 return R_NOOVERWRITE;
1583 if (strEQ(name, "R_PREV"))
1589 if (strEQ(name, "R_RECNOSYNC"))
1595 if (strEQ(name, "R_SETCURSOR"))
1601 if (strEQ(name, "R_SNAPSHOT"))
1635 MODULE = DB_File PACKAGE = DB_File PREFIX = db_
1639 __getBerkeleyDBInfo() ;
1642 empty.data = &zero ;
1643 empty.size = sizeof(recno_t) ;
1653 db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
1660 char * name = (char *) NULL ;
1661 SV * sv = (SV *) NULL ;
1664 if (items >= 3 && SvOK(ST(2)))
1665 name = (char*) SvPV(ST(2), n_a) ;
1670 RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
1671 if (RETVAL->dbp == NULL)
1684 SvREFCNT_dec(db->hash) ;
1686 SvREFCNT_dec(db->compare) ;
1688 SvREFCNT_dec(db->prefix) ;
1689 #ifdef DBM_FILTERING
1690 if (db->filter_fetch_key)
1691 SvREFCNT_dec(db->filter_fetch_key) ;
1692 if (db->filter_store_key)
1693 SvREFCNT_dec(db->filter_store_key) ;
1694 if (db->filter_fetch_value)
1695 SvREFCNT_dec(db->filter_fetch_value) ;
1696 if (db->filter_store_value)
1697 SvREFCNT_dec(db->filter_store_value) ;
1698 #endif /* DBM_FILTERING */
1700 #ifdef DB_VERSION_MAJOR
1707 db_DELETE(db, key, flags=0)
1725 RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
1731 db_FETCH(db, key, flags=0)
1743 /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */
1744 RETVAL = db_get(db, key, value, flags) ;
1745 ST(0) = sv_newmortal();
1746 OutputValue(ST(0), value)
1750 db_STORE(db, key, value, flags=0)
1772 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1773 ST(0) = sv_newmortal();
1774 OutputKey(ST(0), key) ;
1780 DBTKEY key = NO_INIT
1790 RETVAL = do_SEQ(db, key, value, R_NEXT) ;
1791 ST(0) = sv_newmortal();
1792 OutputKey(ST(0), key) ;
1796 # These would be nice for RECNO
1814 #ifdef DB_VERSION_MAJOR
1815 /* get the first value */
1816 RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1821 for (i = items-1 ; i > 0 ; --i)
1823 value.data = SvPV(ST(i), n_a) ;
1827 key.size = sizeof(int) ;
1828 #ifdef DB_VERSION_MAJOR
1829 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1831 RETVAL = (db->dbp->put)(db->dbp, &key, &value, R_IBEFORE) ;
1855 /* First get the final value */
1856 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1857 ST(0) = sv_newmortal();
1861 /* the call to del will trash value, so take a copy now */
1862 OutputValue(ST(0), value) ;
1863 RETVAL = db_del(db, key, R_CURSOR) ;
1865 sv_setsv(ST(0), &PL_sv_undef);
1883 /* get the first value */
1884 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1885 ST(0) = sv_newmortal();
1889 /* the call to del will trash value, so take a copy now */
1890 OutputValue(ST(0), value) ;
1891 RETVAL = db_del(db, key, R_CURSOR) ;
1893 sv_setsv (ST(0), &PL_sv_undef) ;
1914 /* Set the Cursor to the Last element */
1915 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1916 #ifndef DB_VERSION_MAJOR
1921 keyval = *(int*)key.data ;
1924 for (i = 1 ; i < items ; ++i)
1926 value.data = SvPV(ST(i), n_a) ;
1929 key.data = &keyval ;
1930 key.size = sizeof(int) ;
1931 RETVAL = (Db->put)(Db, TXN &key, &value, 0) ;
1943 ALIAS: FETCHSIZE = 1
1946 RETVAL = GetArrayLength(aTHX_ db) ;
1952 # Now provide an interface to the rest of the DB functionality
1956 db_del(db, key, flags=0)
1962 RETVAL = db_del(db, key, flags) ;
1963 #ifdef DB_VERSION_MAJOR
1966 else if (RETVAL == DB_NOTFOUND)
1974 db_get(db, key, value, flags=0)
1982 RETVAL = db_get(db, key, value, flags) ;
1983 #ifdef DB_VERSION_MAJOR
1986 else if (RETVAL == DB_NOTFOUND)
1994 db_put(db, key, value, flags=0)
2001 RETVAL = db_put(db, key, value, flags) ;
2002 #ifdef DB_VERSION_MAJOR
2005 else if (RETVAL == DB_KEYEXIST)
2010 key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
2017 #ifdef DB_VERSION_MAJOR
2021 status = (db->in_memory
2023 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
2028 RETVAL = (db->in_memory
2030 : ((db->dbp)->fd)(db->dbp) ) ;
2036 db_sync(db, flags=0)
2041 RETVAL = db_sync(db, flags) ;
2042 #ifdef DB_VERSION_MAJOR
2051 db_seq(db, key, value, flags)
2059 RETVAL = db_seq(db, key, value, flags);
2060 #ifdef DB_VERSION_MAJOR
2063 else if (RETVAL == DB_NOTFOUND)
2071 #ifdef DBM_FILTERING
2073 #define setFilter(type) \
2076 RETVAL = sv_mortalcopy(db->type) ; \
2078 if (db->type && (code == &PL_sv_undef)) { \
2079 SvREFCNT_dec(db->type) ; \
2084 sv_setsv(db->type, code) ; \
2086 db->type = newSVsv(code) ; \
2092 filter_fetch_key(db, code)
2095 SV * RETVAL = &PL_sv_undef ;
2097 setFilter(filter_fetch_key) ;
2100 filter_store_key(db, code)
2103 SV * RETVAL = &PL_sv_undef ;
2105 setFilter(filter_store_key) ;
2108 filter_fetch_value(db, code)
2111 SV * RETVAL = &PL_sv_undef ;
2113 setFilter(filter_fetch_value) ;
2116 filter_store_value(db, code)
2119 SV * RETVAL = &PL_sv_undef ;
2121 setFilter(filter_store_value) ;
2123 #endif /* DBM_FILTERING */