3 DB_File.xs -- Perl 5 interface to Berkeley DB
5 written by Paul Marquess <Paul.Marquess@btinternet.com>
6 last modified 26th April 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.
98 #define PERL_NO_GET_CONTEXT
104 # include "patchlevel.h"
105 # define PERL_REVISION 5
106 # define PERL_VERSION PATCHLEVEL
107 # define PERL_SUBVERSION SUBVERSION
110 #if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 ))
112 # define PL_sv_undef sv_undef
117 /* DEFSV appears first in 5.004_56 */
119 # define DEFSV GvSV(defgv)
122 /* Mention DB_VERSION_MAJOR_CFG, DB_VERSION_MINOR_CFG, and
123 DB_VERSION_PATCH_CFG here so that Configure pulls them all in. */
125 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
126 * shortly #included by the <db.h>) __attribute__ to the possibly
127 * already defined __attribute__, for example by GNUC or by Perl. */
129 #if DB_VERSION_MAJOR_CFG < 2
133 /* Since we dropped the gccish definition of __attribute__ we will want
134 * to redefine dNOOP, however (so that dTHX continues to work). Yes,
135 * all this means that we can't do attribute checking on the DB_File,
138 #define dNOOP extern int Perl___notused
139 /* Ditto for dXSARGS. */
143 I32 ax = mark - PL_stack_base + 1; \
144 I32 items = sp - mark
148 /* avoid -Wall; DB_File xsubs never make use of `ix' setup for ALIASes */
152 /* If Perl has been compiled with Threads support,the symbol op will
153 be defined here. This clashes with a field name in db.h, so get rid of it.
166 extern void __getBerkeleyDBInfo(void);
177 # define newSVpvn(a,b) newSVpv(a,b)
183 #define DBM_FILTERING
186 # define Trace(x) printf x
192 #define DBT_clear(x) Zero(&x, 1, DBT) ;
194 #ifdef DB_VERSION_MAJOR
196 #if DB_VERSION_MAJOR == 2
197 # define BERKELEY_DB_1_OR_2
200 #if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 2)
201 # define AT_LEAST_DB_3_2
204 /* map version 2 features & constants onto their version 1 equivalent */
209 #define DB_Prefix_t size_t
214 #define DB_Hash_t u_int32_t
216 /* DBTYPE stays the same */
217 /* HASHINFO, RECNOINFO and BTREEINFO map to DB_INFO */
218 #if DB_VERSION_MAJOR == 2
219 typedef DB_INFO INFO ;
220 #else /* DB_VERSION_MAJOR > 2 */
221 # define DB_FIXEDLEN (0x8000)
222 #endif /* DB_VERSION_MAJOR == 2 */
224 /* version 2 has db_recno_t in place of recno_t */
225 typedef db_recno_t recno_t;
228 #define R_CURSOR DB_SET_RANGE
229 #define R_FIRST DB_FIRST
230 #define R_IAFTER DB_AFTER
231 #define R_IBEFORE DB_BEFORE
232 #define R_LAST DB_LAST
233 #define R_NEXT DB_NEXT
234 #define R_NOOVERWRITE DB_NOOVERWRITE
235 #define R_PREV DB_PREV
237 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
238 # define R_SETCURSOR 0x800000
240 # define R_SETCURSOR (-100)
243 #define R_RECNOSYNC 0
244 #define R_FIXEDLEN DB_FIXEDLEN
248 #define db_HA_hash h_hash
249 #define db_HA_ffactor h_ffactor
250 #define db_HA_nelem h_nelem
251 #define db_HA_bsize db_pagesize
252 #define db_HA_cachesize db_cachesize
253 #define db_HA_lorder db_lorder
255 #define db_BT_compare bt_compare
256 #define db_BT_prefix bt_prefix
257 #define db_BT_flags flags
258 #define db_BT_psize db_pagesize
259 #define db_BT_cachesize db_cachesize
260 #define db_BT_lorder db_lorder
261 #define db_BT_maxkeypage
262 #define db_BT_minkeypage
265 #define db_RE_reclen re_len
266 #define db_RE_flags flags
267 #define db_RE_bval re_pad
268 #define db_RE_bfname re_source
269 #define db_RE_psize db_pagesize
270 #define db_RE_cachesize db_cachesize
271 #define db_RE_lorder db_lorder
275 #define do_SEQ(db, key, value, flag) (db->cursor->c_get)(db->cursor, &key, &value, flag)
278 #define DBT_flags(x) x.flags = 0
279 #define DB_flags(x, v) x |= v
281 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
282 # define flagSet(flags, bitmask) ((flags) & (bitmask))
284 # define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask))
287 #else /* db version 1.x */
289 #define BERKELEY_DB_1
290 #define BERKELEY_DB_1_OR_2
303 # define DB_Prefix_t mDB_Prefix_t
310 # define DB_Hash_t mDB_Hash_t
313 #define db_HA_hash hash.hash
314 #define db_HA_ffactor hash.ffactor
315 #define db_HA_nelem hash.nelem
316 #define db_HA_bsize hash.bsize
317 #define db_HA_cachesize hash.cachesize
318 #define db_HA_lorder hash.lorder
320 #define db_BT_compare btree.compare
321 #define db_BT_prefix btree.prefix
322 #define db_BT_flags btree.flags
323 #define db_BT_psize btree.psize
324 #define db_BT_cachesize btree.cachesize
325 #define db_BT_lorder btree.lorder
326 #define db_BT_maxkeypage btree.maxkeypage
327 #define db_BT_minkeypage btree.minkeypage
329 #define db_RE_reclen recno.reclen
330 #define db_RE_flags recno.flags
331 #define db_RE_bval recno.bval
332 #define db_RE_bfname recno.bfname
333 #define db_RE_psize recno.psize
334 #define db_RE_cachesize recno.cachesize
335 #define db_RE_lorder recno.lorder
339 #define do_SEQ(db, key, value, flag) (db->dbp->seq)(db->dbp, &key, &value, flag)
341 #define DB_flags(x, v)
342 #define flagSet(flags, bitmask) ((flags) & (bitmask))
344 #endif /* db version 1 */
348 #define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, TXN &key, flags)
349 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, flags)
350 #define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
352 #define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
353 #define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
355 #ifdef DB_VERSION_MAJOR
356 #define db_DESTROY(db) ( db->cursor->c_close(db->cursor),\
357 (db->dbp->close)(db->dbp, 0) )
358 #define db_close(db) ((db->dbp)->close)(db->dbp, 0)
359 #define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \
360 ? ((db->cursor)->c_del)(db->cursor, 0) \
361 : ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
363 #else /* ! DB_VERSION_MAJOR */
365 #define db_DESTROY(db) ((db->dbp)->close)(db->dbp)
366 #define db_close(db) ((db->dbp)->close)(db->dbp)
367 #define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
368 #define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
370 #endif /* ! DB_VERSION_MAJOR */
373 #define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags)
382 #ifdef BERKELEY_DB_1_OR_2
385 #ifdef DB_VERSION_MAJOR
389 SV * filter_fetch_key ;
390 SV * filter_store_key ;
391 SV * filter_fetch_value ;
392 SV * filter_store_value ;
394 #endif /* DBM_FILTERING */
398 typedef DB_File_type * DB_File ;
403 #define ckFilter(arg,type,name) \
406 /* printf("filtering %s\n", name) ;*/ \
408 croak("recursion detected in %s", name) ; \
409 db->filtering = TRUE ; \
410 save_defsv = newSVsv(DEFSV) ; \
411 sv_setsv(DEFSV, arg) ; \
413 (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \
414 sv_setsv(arg, DEFSV) ; \
415 sv_setsv(DEFSV, save_defsv) ; \
416 SvREFCNT_dec(save_defsv) ; \
417 db->filtering = FALSE ; \
418 /*printf("end of filtering %s\n", name) ;*/ \
423 #define ckFilter(arg,type, name)
425 #endif /* DBM_FILTERING */
427 #define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
429 #define OutputValue(arg, name) \
430 { if (RETVAL == 0) { \
431 my_sv_setpvn(arg, name.data, name.size) ; \
432 ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \
436 #define OutputKey(arg, name) \
439 if (db->type != DB_RECNO) { \
440 my_sv_setpvn(arg, name.data, name.size); \
443 sv_setiv(arg, (I32)*(I32*)name.data - 1); \
444 ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \
449 /* Internal Global Data */
450 static recno_t Value ;
451 static recno_t zero = 0 ;
452 static DB_File CurrentDB ;
453 static DBTKEY empty ;
455 #ifdef DB_VERSION_MAJOR
459 db_put(DB_File db, DBTKEY key, DBT value, u_int flags)
461 db_put(db, key, value, flags)
470 if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) {
474 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
475 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor) != 0)
477 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor, 0) != 0)
481 memset(&l_key, 0, sizeof(l_key));
482 l_key.data = key.data;
483 l_key.size = key.size;
484 memset(&l_value, 0, sizeof(l_value));
485 l_value.data = value.data;
486 l_value.size = value.size;
488 if ( temp_cursor->c_get(temp_cursor, &l_key, &l_value, DB_SET) != 0) {
489 (void)temp_cursor->c_close(temp_cursor);
493 status = temp_cursor->c_put(temp_cursor, &key, &value, flags);
494 (void)temp_cursor->c_close(temp_cursor);
500 if (flagSet(flags, R_CURSOR)) {
501 return ((db->cursor)->c_put)(db->cursor, &key, &value, DB_CURRENT);
504 if (flagSet(flags, R_SETCURSOR)) {
505 if ((db->dbp)->put(db->dbp, NULL, &key, &value, 0) != 0)
507 return ((db->cursor)->c_get)(db->cursor, &key, &value, DB_SET_RANGE);
511 return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
515 #endif /* DB_VERSION_MAJOR */
519 #ifdef AT_LEAST_DB_3_2
522 btree_compare(DB * db, const DBT *key1, const DBT *key2)
524 btree_compare(db, key1, key2)
528 #endif /* CAN_PROTOTYPE */
530 #else /* Berkeley DB < 3.2 */
533 btree_compare(const DBT *key1, const DBT *key2)
535 btree_compare(key1, key2)
547 char * data1, * data2 ;
551 data1 = (char *) key1->data ;
552 data2 = (char *) key2->data ;
555 /* As newSVpv will assume that the data pointer is a null terminated C
556 string if the size parameter is 0, make sure that data points to an
557 empty string if the length is 0
570 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
571 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
574 count = perl_call_sv(CurrentDB->compare, G_SCALAR);
579 croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
591 #ifdef AT_LEAST_DB_3_2
594 btree_prefix(DB * db, const DBT *key1, const DBT *key2)
596 btree_prefix(db, key1, key2)
602 #else /* Berkeley DB < 3.2 */
605 btree_prefix(const DBT *key1, const DBT *key2)
607 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 ;
704 /* DGH - Next two lines added to fix corrupted stack problem */
710 XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
713 count = perl_call_sv(CurrentDB->hash, G_SCALAR);
718 croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
730 #if defined(TRACE) && defined(BERKELEY_DB_1_OR_2)
734 PrintHash(INFO *hash)
740 printf ("HASH Info\n") ;
741 printf (" hash = %s\n",
742 (hash->db_HA_hash != NULL ? "redefined" : "default")) ;
743 printf (" bsize = %d\n", hash->db_HA_bsize) ;
744 printf (" ffactor = %d\n", hash->db_HA_ffactor) ;
745 printf (" nelem = %d\n", hash->db_HA_nelem) ;
746 printf (" cachesize = %d\n", hash->db_HA_cachesize) ;
747 printf (" lorder = %d\n", hash->db_HA_lorder) ;
753 PrintRecno(INFO *recno)
759 printf ("RECNO Info\n") ;
760 printf (" flags = %d\n", recno->db_RE_flags) ;
761 printf (" cachesize = %d\n", recno->db_RE_cachesize) ;
762 printf (" psize = %d\n", recno->db_RE_psize) ;
763 printf (" lorder = %d\n", recno->db_RE_lorder) ;
764 printf (" reclen = %ul\n", (unsigned long)recno->db_RE_reclen) ;
765 printf (" bval = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
766 printf (" bfname = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
771 PrintBtree(INFO *btree)
777 printf ("BTREE Info\n") ;
778 printf (" compare = %s\n",
779 (btree->db_BT_compare ? "redefined" : "default")) ;
780 printf (" prefix = %s\n",
781 (btree->db_BT_prefix ? "redefined" : "default")) ;
782 printf (" flags = %d\n", btree->db_BT_flags) ;
783 printf (" cachesize = %d\n", btree->db_BT_cachesize) ;
784 printf (" psize = %d\n", btree->db_BT_psize) ;
785 #ifndef DB_VERSION_MAJOR
786 printf (" maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
787 printf (" minkeypage = %d\n", btree->db_BT_minkeypage) ;
789 printf (" lorder = %d\n", btree->db_BT_lorder) ;
794 #define PrintRecno(recno)
795 #define PrintHash(hash)
796 #define PrintBtree(btree)
803 GetArrayLength(pTHX_ DB_File db)
815 RETVAL = do_SEQ(db, key, value, R_LAST) ;
817 RETVAL = *(I32 *)key.data ;
818 else /* No key means empty file */
821 return ((I32)RETVAL) ;
826 GetRecnoKey(pTHX_ DB_File db, I32 value)
828 GetRecnoKey(db, value)
834 /* Get the length of the array */
835 I32 length = GetArrayLength(aTHX_ db) ;
837 /* check for attempt to write before start of array */
838 if (length + value + 1 <= 0)
839 croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
841 value = length + value + 1 ;
852 ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv)
854 ParseOpenInfo(isHASH, name, flags, mode, sv)
863 #ifdef BERKELEY_DB_1_OR_2 /* Berkeley DB Version 1 or 2 */
867 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
868 void * openinfo = NULL ;
869 INFO * info = &RETVAL->info ;
872 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
873 Zero(RETVAL, 1, DB_File_type) ;
875 /* Default to HASH */
877 RETVAL->filtering = 0 ;
878 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
879 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
880 #endif /* DBM_FILTERING */
881 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
882 RETVAL->type = DB_HASH ;
884 /* DGH - Next line added to avoid SEGV on existing hash DB */
887 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
888 RETVAL->in_memory = (name == NULL) ;
893 croak ("type parameter is not a reference") ;
895 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
896 if (svp && SvOK(*svp))
897 action = (HV*) SvRV(*svp) ;
899 croak("internal error") ;
901 if (sv_isa(sv, "DB_File::HASHINFO"))
905 croak("DB_File can only tie an associative array to a DB_HASH database") ;
907 RETVAL->type = DB_HASH ;
908 openinfo = (void*)info ;
910 svp = hv_fetch(action, "hash", 4, FALSE);
912 if (svp && SvOK(*svp))
914 info->db_HA_hash = hash_cb ;
915 RETVAL->hash = newSVsv(*svp) ;
918 info->db_HA_hash = NULL ;
920 svp = hv_fetch(action, "ffactor", 7, FALSE);
921 info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
923 svp = hv_fetch(action, "nelem", 5, FALSE);
924 info->db_HA_nelem = svp ? SvIV(*svp) : 0;
926 svp = hv_fetch(action, "bsize", 5, FALSE);
927 info->db_HA_bsize = svp ? SvIV(*svp) : 0;
929 svp = hv_fetch(action, "cachesize", 9, FALSE);
930 info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
932 svp = hv_fetch(action, "lorder", 6, FALSE);
933 info->db_HA_lorder = svp ? SvIV(*svp) : 0;
937 else if (sv_isa(sv, "DB_File::BTREEINFO"))
940 croak("DB_File can only tie an associative array to a DB_BTREE database");
942 RETVAL->type = DB_BTREE ;
943 openinfo = (void*)info ;
945 svp = hv_fetch(action, "compare", 7, FALSE);
946 if (svp && SvOK(*svp))
948 info->db_BT_compare = btree_compare ;
949 RETVAL->compare = newSVsv(*svp) ;
952 info->db_BT_compare = NULL ;
954 svp = hv_fetch(action, "prefix", 6, FALSE);
955 if (svp && SvOK(*svp))
957 info->db_BT_prefix = btree_prefix ;
958 RETVAL->prefix = newSVsv(*svp) ;
961 info->db_BT_prefix = NULL ;
963 svp = hv_fetch(action, "flags", 5, FALSE);
964 info->db_BT_flags = svp ? SvIV(*svp) : 0;
966 svp = hv_fetch(action, "cachesize", 9, FALSE);
967 info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
969 #ifndef DB_VERSION_MAJOR
970 svp = hv_fetch(action, "minkeypage", 10, FALSE);
971 info->btree.minkeypage = svp ? SvIV(*svp) : 0;
973 svp = hv_fetch(action, "maxkeypage", 10, FALSE);
974 info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
977 svp = hv_fetch(action, "psize", 5, FALSE);
978 info->db_BT_psize = svp ? SvIV(*svp) : 0;
980 svp = hv_fetch(action, "lorder", 6, FALSE);
981 info->db_BT_lorder = svp ? SvIV(*svp) : 0;
986 else if (sv_isa(sv, "DB_File::RECNOINFO"))
989 croak("DB_File can only tie an array to a DB_RECNO database");
991 RETVAL->type = DB_RECNO ;
992 openinfo = (void *)info ;
994 info->db_RE_flags = 0 ;
996 svp = hv_fetch(action, "flags", 5, FALSE);
997 info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
999 svp = hv_fetch(action, "reclen", 6, FALSE);
1000 info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
1002 svp = hv_fetch(action, "cachesize", 9, FALSE);
1003 info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
1005 svp = hv_fetch(action, "psize", 5, FALSE);
1006 info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
1008 svp = hv_fetch(action, "lorder", 6, FALSE);
1009 info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
1011 #ifdef DB_VERSION_MAJOR
1012 info->re_source = name ;
1015 svp = hv_fetch(action, "bfname", 6, FALSE);
1016 if (svp && SvOK(*svp)) {
1017 char * ptr = SvPV(*svp,n_a) ;
1018 #ifdef DB_VERSION_MAJOR
1019 name = (char*) n_a ? ptr : NULL ;
1021 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
1025 #ifdef DB_VERSION_MAJOR
1028 info->db_RE_bfname = NULL ;
1031 svp = hv_fetch(action, "bval", 4, FALSE);
1032 #ifdef DB_VERSION_MAJOR
1033 if (svp && SvOK(*svp))
1037 value = (int)*SvPV(*svp, n_a) ;
1039 value = SvIV(*svp) ;
1041 if (info->flags & DB_FIXEDLEN) {
1042 info->re_pad = value ;
1043 info->flags |= DB_PAD ;
1046 info->re_delim = value ;
1047 info->flags |= DB_DELIMITER ;
1052 if (svp && SvOK(*svp))
1055 info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
1057 info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
1058 DB_flags(info->flags, DB_DELIMITER) ;
1063 if (info->db_RE_flags & R_FIXEDLEN)
1064 info->db_RE_bval = (u_char) ' ' ;
1066 info->db_RE_bval = (u_char) '\n' ;
1067 DB_flags(info->flags, DB_DELIMITER) ;
1072 info->flags |= DB_RENUMBER ;
1078 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1082 /* OS2 Specific Code */
1086 #endif /* __EMX__ */
1089 #ifdef DB_VERSION_MAJOR
1095 /* Map 1.x flags to 2.x flags */
1096 if ((flags & O_CREAT) == O_CREAT)
1097 Flags |= DB_CREATE ;
1100 if (flags == O_RDONLY)
1102 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1104 Flags |= DB_RDONLY ;
1107 if ((flags & O_TRUNC) == O_TRUNC)
1108 Flags |= DB_TRUNCATE ;
1111 status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
1113 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
1114 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
1116 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1121 RETVAL->dbp = NULL ;
1126 #if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2
1127 RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ;
1129 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
1130 #endif /* DB_LIBRARY_COMPATIBILITY_API */
1136 #else /* Berkeley DB Version > 2 */
1140 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
1145 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
1146 Zero(RETVAL, 1, DB_File_type) ;
1148 /* Default to HASH */
1149 #ifdef DBM_FILTERING
1150 RETVAL->filtering = 0 ;
1151 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
1152 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
1153 #endif /* DBM_FILTERING */
1154 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
1155 RETVAL->type = DB_HASH ;
1157 /* DGH - Next line added to avoid SEGV on existing hash DB */
1160 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
1161 RETVAL->in_memory = (name == NULL) ;
1163 status = db_create(&RETVAL->dbp, NULL,0) ;
1164 /* printf("db_create returned %d %s\n", status, db_strerror(status)) ; */
1166 RETVAL->dbp = NULL ;
1174 croak ("type parameter is not a reference") ;
1176 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
1177 if (svp && SvOK(*svp))
1178 action = (HV*) SvRV(*svp) ;
1180 croak("internal error") ;
1182 if (sv_isa(sv, "DB_File::HASHINFO"))
1186 croak("DB_File can only tie an associative array to a DB_HASH database") ;
1188 RETVAL->type = DB_HASH ;
1190 svp = hv_fetch(action, "hash", 4, FALSE);
1192 if (svp && SvOK(*svp))
1194 (void)dbp->set_h_hash(dbp, hash_cb) ;
1195 RETVAL->hash = newSVsv(*svp) ;
1198 svp = hv_fetch(action, "ffactor", 7, FALSE);
1200 (void)dbp->set_h_ffactor(dbp, SvIV(*svp)) ;
1202 svp = hv_fetch(action, "nelem", 5, FALSE);
1204 (void)dbp->set_h_nelem(dbp, SvIV(*svp)) ;
1206 svp = hv_fetch(action, "bsize", 5, FALSE);
1208 (void)dbp->set_pagesize(dbp, SvIV(*svp));
1210 svp = hv_fetch(action, "cachesize", 9, FALSE);
1212 (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1214 svp = hv_fetch(action, "lorder", 6, FALSE);
1216 (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
1220 else if (sv_isa(sv, "DB_File::BTREEINFO"))
1223 croak("DB_File can only tie an associative array to a DB_BTREE database");
1225 RETVAL->type = DB_BTREE ;
1227 svp = hv_fetch(action, "compare", 7, FALSE);
1228 if (svp && SvOK(*svp))
1230 (void)dbp->set_bt_compare(dbp, btree_compare) ;
1231 RETVAL->compare = newSVsv(*svp) ;
1234 svp = hv_fetch(action, "prefix", 6, FALSE);
1235 if (svp && SvOK(*svp))
1237 (void)dbp->set_bt_prefix(dbp, btree_prefix) ;
1238 RETVAL->prefix = newSVsv(*svp) ;
1241 svp = hv_fetch(action, "flags", 5, FALSE);
1243 (void)dbp->set_flags(dbp, SvIV(*svp)) ;
1245 svp = hv_fetch(action, "cachesize", 9, FALSE);
1247 (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1249 svp = hv_fetch(action, "psize", 5, FALSE);
1251 (void)dbp->set_pagesize(dbp, SvIV(*svp)) ;
1253 svp = hv_fetch(action, "lorder", 6, FALSE);
1255 (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
1260 else if (sv_isa(sv, "DB_File::RECNOINFO"))
1265 croak("DB_File can only tie an array to a DB_RECNO database");
1267 RETVAL->type = DB_RECNO ;
1269 svp = hv_fetch(action, "flags", 5, FALSE);
1271 int flags = SvIV(*svp) ;
1272 /* remove FIXDLEN, if present */
1273 if (flags & DB_FIXEDLEN) {
1275 flags &= ~DB_FIXEDLEN ;
1279 svp = hv_fetch(action, "cachesize", 9, FALSE);
1281 status = dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1284 svp = hv_fetch(action, "psize", 5, FALSE);
1286 status = dbp->set_pagesize(dbp, SvIV(*svp)) ;
1289 svp = hv_fetch(action, "lorder", 6, FALSE);
1291 status = dbp->set_lorder(dbp, SvIV(*svp)) ;
1294 svp = hv_fetch(action, "bval", 4, FALSE);
1295 if (svp && SvOK(*svp))
1299 value = (int)*SvPV(*svp, n_a) ;
1301 value = SvIV(*svp) ;
1304 status = dbp->set_re_pad(dbp, value) ;
1307 status = dbp->set_re_delim(dbp, value) ;
1313 svp = hv_fetch(action, "reclen", 6, FALSE);
1315 u_int32_t len = (u_int32_t)SvIV(*svp) ;
1316 status = dbp->set_re_len(dbp, len) ;
1321 status = dbp->set_re_source(dbp, name) ;
1325 svp = hv_fetch(action, "bfname", 6, FALSE);
1326 if (svp && SvOK(*svp)) {
1327 char * ptr = SvPV(*svp,n_a) ;
1328 name = (char*) n_a ? ptr : NULL ;
1334 status = dbp->set_flags(dbp, DB_RENUMBER) ;
1337 (void)dbp->set_flags(dbp, flags) ;
1342 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1349 /* Map 1.x flags to 3.x flags */
1350 if ((flags & O_CREAT) == O_CREAT)
1351 Flags |= DB_CREATE ;
1354 if (flags == O_RDONLY)
1356 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1358 Flags |= DB_RDONLY ;
1361 if ((flags & O_TRUNC) == O_TRUNC)
1362 Flags |= DB_TRUNCATE ;
1365 status = (RETVAL->dbp->open)(RETVAL->dbp, name, NULL, RETVAL->type,
1367 /* printf("open returned %d %s\n", status, db_strerror(status)) ; */
1370 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1372 /* printf("cursor returned %d %s\n", status, db_strerror(status)) ; */
1375 RETVAL->dbp = NULL ;
1381 #endif /* Berkeley DB Version > 2 */
1383 } /* ParseOpenInfo */
1387 #ifdef CAN_PROTOTYPE
1388 constant(char *name, int arg)
1400 if (strEQ(name, "BTREEMAGIC"))
1406 if (strEQ(name, "BTREEVERSION"))
1408 return BTREEVERSION;
1416 if (strEQ(name, "DB_LOCK"))
1422 if (strEQ(name, "DB_SHMEM"))
1428 if (strEQ(name, "DB_TXN"))
1442 if (strEQ(name, "HASHMAGIC"))
1448 if (strEQ(name, "HASHVERSION"))
1464 if (strEQ(name, "MAX_PAGE_NUMBER"))
1465 #ifdef MAX_PAGE_NUMBER
1466 return (U32)MAX_PAGE_NUMBER;
1470 if (strEQ(name, "MAX_PAGE_OFFSET"))
1471 #ifdef MAX_PAGE_OFFSET
1472 return MAX_PAGE_OFFSET;
1476 if (strEQ(name, "MAX_REC_NUMBER"))
1477 #ifdef MAX_REC_NUMBER
1478 return (U32)MAX_REC_NUMBER;
1492 if (strEQ(name, "RET_ERROR"))
1498 if (strEQ(name, "RET_SPECIAL"))
1504 if (strEQ(name, "RET_SUCCESS"))
1510 if (strEQ(name, "R_CURSOR"))
1516 if (strEQ(name, "R_DUP"))
1522 if (strEQ(name, "R_FIRST"))
1528 if (strEQ(name, "R_FIXEDLEN"))
1534 if (strEQ(name, "R_IAFTER"))
1540 if (strEQ(name, "R_IBEFORE"))
1546 if (strEQ(name, "R_LAST"))
1552 if (strEQ(name, "R_NEXT"))
1558 if (strEQ(name, "R_NOKEY"))
1564 if (strEQ(name, "R_NOOVERWRITE"))
1565 #ifdef R_NOOVERWRITE
1566 return R_NOOVERWRITE;
1570 if (strEQ(name, "R_PREV"))
1576 if (strEQ(name, "R_RECNOSYNC"))
1582 if (strEQ(name, "R_SETCURSOR"))
1588 if (strEQ(name, "R_SNAPSHOT"))
1622 MODULE = DB_File PACKAGE = DB_File PREFIX = db_
1626 __getBerkeleyDBInfo() ;
1629 empty.data = &zero ;
1630 empty.size = sizeof(recno_t) ;
1640 db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
1647 char * name = (char *) NULL ;
1648 SV * sv = (SV *) NULL ;
1651 if (items >= 3 && SvOK(ST(2)))
1652 name = (char*) SvPV(ST(2), n_a) ;
1657 RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
1658 if (RETVAL->dbp == NULL)
1671 SvREFCNT_dec(db->hash) ;
1673 SvREFCNT_dec(db->compare) ;
1675 SvREFCNT_dec(db->prefix) ;
1676 #ifdef DBM_FILTERING
1677 if (db->filter_fetch_key)
1678 SvREFCNT_dec(db->filter_fetch_key) ;
1679 if (db->filter_store_key)
1680 SvREFCNT_dec(db->filter_store_key) ;
1681 if (db->filter_fetch_value)
1682 SvREFCNT_dec(db->filter_fetch_value) ;
1683 if (db->filter_store_value)
1684 SvREFCNT_dec(db->filter_store_value) ;
1685 #endif /* DBM_FILTERING */
1687 #ifdef DB_VERSION_MAJOR
1694 db_DELETE(db, key, flags=0)
1712 RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
1718 db_FETCH(db, key, flags=0)
1730 /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */
1731 RETVAL = db_get(db, key, value, flags) ;
1732 ST(0) = sv_newmortal();
1733 OutputValue(ST(0), value)
1737 db_STORE(db, key, value, flags=0)
1759 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1760 ST(0) = sv_newmortal();
1761 OutputKey(ST(0), key) ;
1776 RETVAL = do_SEQ(db, key, value, R_NEXT) ;
1777 ST(0) = sv_newmortal();
1778 OutputKey(ST(0), key) ;
1782 # These would be nice for RECNO
1800 #ifdef DB_VERSION_MAJOR
1801 /* get the first value */
1802 RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1807 for (i = items-1 ; i > 0 ; --i)
1809 value.data = SvPV(ST(i), n_a) ;
1813 key.size = sizeof(int) ;
1814 #ifdef DB_VERSION_MAJOR
1815 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1817 RETVAL = (db->dbp->put)(db->dbp, &key, &value, R_IBEFORE) ;
1841 /* First get the final value */
1842 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1843 ST(0) = sv_newmortal();
1847 /* the call to del will trash value, so take a copy now */
1848 OutputValue(ST(0), value) ;
1849 RETVAL = db_del(db, key, R_CURSOR) ;
1851 sv_setsv(ST(0), &PL_sv_undef);
1869 /* get the first value */
1870 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1871 ST(0) = sv_newmortal();
1875 /* the call to del will trash value, so take a copy now */
1876 OutputValue(ST(0), value) ;
1877 RETVAL = db_del(db, key, R_CURSOR) ;
1879 sv_setsv (ST(0), &PL_sv_undef) ;
1900 /* Set the Cursor to the Last element */
1901 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1902 #ifndef DB_VERSION_MAJOR
1907 keyval = *(int*)key.data ;
1910 for (i = 1 ; i < items ; ++i)
1912 value.data = SvPV(ST(i), n_a) ;
1915 key.data = &keyval ;
1916 key.size = sizeof(int) ;
1917 RETVAL = (Db->put)(Db, TXN &key, &value, 0) ;
1929 ALIAS: FETCHSIZE = 1
1932 RETVAL = GetArrayLength(aTHX_ db) ;
1938 # Now provide an interface to the rest of the DB functionality
1942 db_del(db, key, flags=0)
1948 RETVAL = db_del(db, key, flags) ;
1949 #ifdef DB_VERSION_MAJOR
1952 else if (RETVAL == DB_NOTFOUND)
1960 db_get(db, key, value, flags=0)
1968 RETVAL = db_get(db, key, value, flags) ;
1969 #ifdef DB_VERSION_MAJOR
1972 else if (RETVAL == DB_NOTFOUND)
1980 db_put(db, key, value, flags=0)
1987 RETVAL = db_put(db, key, value, flags) ;
1988 #ifdef DB_VERSION_MAJOR
1991 else if (RETVAL == DB_KEYEXIST)
1996 key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
2004 #ifdef DB_VERSION_MAJOR
2006 status = (db->in_memory
2008 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
2012 RETVAL = (db->in_memory
2014 : ((db->dbp)->fd)(db->dbp) ) ;
2020 db_sync(db, flags=0)
2025 RETVAL = db_sync(db, flags) ;
2026 #ifdef DB_VERSION_MAJOR
2035 db_seq(db, key, value, flags)
2043 RETVAL = db_seq(db, key, value, flags);
2044 #ifdef DB_VERSION_MAJOR
2047 else if (RETVAL == DB_NOTFOUND)
2055 #ifdef DBM_FILTERING
2057 #define setFilter(type) \
2060 RETVAL = sv_mortalcopy(db->type) ; \
2062 if (db->type && (code == &PL_sv_undef)) { \
2063 SvREFCNT_dec(db->type) ; \
2068 sv_setsv(db->type, code) ; \
2070 db->type = newSVsv(code) ; \
2076 filter_fetch_key(db, code)
2079 SV * RETVAL = &PL_sv_undef ;
2081 setFilter(filter_fetch_key) ;
2084 filter_store_key(db, code)
2087 SV * RETVAL = &PL_sv_undef ;
2089 setFilter(filter_store_key) ;
2092 filter_fetch_value(db, code)
2095 SV * RETVAL = &PL_sv_undef ;
2097 setFilter(filter_fetch_value) ;
2100 filter_store_value(db, code)
2103 SV * RETVAL = &PL_sv_undef ;
2105 setFilter(filter_store_value) ;
2107 #endif /* DBM_FILTERING */