3 DB_File.xs -- Perl 5 interface to Berkeley DB
5 written by Paul Marquess <pmqs@cpan.org>
6 last modified 20th June 2004
9 All comments/suggestions/problems are welcome
11 Copyright (c) 1995-2004 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
101 1.802 - No change to DB_File.xs
102 1.803 - FETCH, STORE & DELETE don't map the flags parameter
103 into the equivalent Berkeley DB function anymore.
105 1.805 - recursion detection added to the callbacks
106 Support for 4.1.X added.
107 Filter code can now cope with read-only $_
108 1.806 - recursion detection beefed up.
110 1.808 - leak fixed in ParseOpenInfo
115 #define PERL_NO_GET_CONTEXT
124 /* Mention DB_VERSION_MAJOR_CFG, DB_VERSION_MINOR_CFG, and
125 DB_VERSION_PATCH_CFG here so that Configure pulls them all in. */
127 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
128 * shortly #included by the <db.h>) __attribute__ to the possibly
129 * already defined __attribute__, for example by GNUC or by Perl. */
131 /* #if DB_VERSION_MAJOR_CFG < 2 */
132 #ifndef DB_VERSION_MAJOR
133 # undef __attribute__
142 /* Wall starts with 5.7.x */
144 #if PERL_REVISION > 5 || (PERL_REVISION == 5 && PERL_VERSION >= 7)
146 /* Since we dropped the gccish definition of __attribute__ we will want
147 * to redefine dNOOP, however (so that dTHX continues to work). Yes,
148 * all this means that we can't do attribute checking on the DB_File,
150 # ifndef DB_VERSION_MAJOR
153 # define dNOOP extern int Perl___notused
155 /* Ditto for dXSARGS. */
159 I32 ax = mark - PL_stack_base + 1; \
160 I32 items = sp - mark
164 /* avoid -Wall; DB_File xsubs never make use of `ix' setup for ALIASes */
166 # define dXSI32 dNOOP
168 #endif /* Perl >= 5.7 */
175 # define Trace(x) printf x
181 #define DBT_clear(x) Zero(&x, 1, DBT) ;
183 #ifdef DB_VERSION_MAJOR
185 #if DB_VERSION_MAJOR == 2
186 # define BERKELEY_DB_1_OR_2
189 #if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 2)
190 # define AT_LEAST_DB_3_2
193 #if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 1)
194 # define AT_LEAST_DB_4_1
197 /* map version 2 features & constants onto their version 1 equivalent */
202 #define DB_Prefix_t size_t
207 #define DB_Hash_t u_int32_t
209 /* DBTYPE stays the same */
210 /* HASHINFO, RECNOINFO and BTREEINFO map to DB_INFO */
211 #if DB_VERSION_MAJOR == 2
212 typedef DB_INFO INFO ;
213 #else /* DB_VERSION_MAJOR > 2 */
214 # define DB_FIXEDLEN (0x8000)
215 #endif /* DB_VERSION_MAJOR == 2 */
217 /* version 2 has db_recno_t in place of recno_t */
218 typedef db_recno_t recno_t;
221 #define R_CURSOR DB_SET_RANGE
222 #define R_FIRST DB_FIRST
223 #define R_IAFTER DB_AFTER
224 #define R_IBEFORE DB_BEFORE
225 #define R_LAST DB_LAST
226 #define R_NEXT DB_NEXT
227 #define R_NOOVERWRITE DB_NOOVERWRITE
228 #define R_PREV DB_PREV
230 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
231 # define R_SETCURSOR 0x800000
233 # define R_SETCURSOR (-100)
236 #define R_RECNOSYNC 0
237 #define R_FIXEDLEN DB_FIXEDLEN
241 #define db_HA_hash h_hash
242 #define db_HA_ffactor h_ffactor
243 #define db_HA_nelem h_nelem
244 #define db_HA_bsize db_pagesize
245 #define db_HA_cachesize db_cachesize
246 #define db_HA_lorder db_lorder
248 #define db_BT_compare bt_compare
249 #define db_BT_prefix bt_prefix
250 #define db_BT_flags flags
251 #define db_BT_psize db_pagesize
252 #define db_BT_cachesize db_cachesize
253 #define db_BT_lorder db_lorder
254 #define db_BT_maxkeypage
255 #define db_BT_minkeypage
258 #define db_RE_reclen re_len
259 #define db_RE_flags flags
260 #define db_RE_bval re_pad
261 #define db_RE_bfname re_source
262 #define db_RE_psize db_pagesize
263 #define db_RE_cachesize db_cachesize
264 #define db_RE_lorder db_lorder
268 #define do_SEQ(db, key, value, flag) (db->cursor->c_get)(db->cursor, &key, &value, flag)
271 #define DBT_flags(x) x.flags = 0
272 #define DB_flags(x, v) x |= v
274 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
275 # define flagSet(flags, bitmask) ((flags) & (bitmask))
277 # define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask))
280 #else /* db version 1.x */
282 #define BERKELEY_DB_1
283 #define BERKELEY_DB_1_OR_2
296 # define DB_Prefix_t mDB_Prefix_t
303 # define DB_Hash_t mDB_Hash_t
306 #define db_HA_hash hash.hash
307 #define db_HA_ffactor hash.ffactor
308 #define db_HA_nelem hash.nelem
309 #define db_HA_bsize hash.bsize
310 #define db_HA_cachesize hash.cachesize
311 #define db_HA_lorder hash.lorder
313 #define db_BT_compare btree.compare
314 #define db_BT_prefix btree.prefix
315 #define db_BT_flags btree.flags
316 #define db_BT_psize btree.psize
317 #define db_BT_cachesize btree.cachesize
318 #define db_BT_lorder btree.lorder
319 #define db_BT_maxkeypage btree.maxkeypage
320 #define db_BT_minkeypage btree.minkeypage
322 #define db_RE_reclen recno.reclen
323 #define db_RE_flags recno.flags
324 #define db_RE_bval recno.bval
325 #define db_RE_bfname recno.bfname
326 #define db_RE_psize recno.psize
327 #define db_RE_cachesize recno.cachesize
328 #define db_RE_lorder recno.lorder
332 #define do_SEQ(db, key, value, flag) (db->dbp->seq)(db->dbp, &key, &value, flag)
334 #define DB_flags(x, v)
335 #define flagSet(flags, bitmask) ((flags) & (bitmask))
337 #endif /* db version 1 */
341 #define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, TXN &key, 0)
342 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, 0)
343 #define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, 0)
345 #define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
346 #define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
348 #ifdef DB_VERSION_MAJOR
349 #define db_DESTROY(db) (!db->aborted && ( db->cursor->c_close(db->cursor),\
350 (db->dbp->close)(db->dbp, 0) ))
351 #define db_close(db) ((db->dbp)->close)(db->dbp, 0)
352 #define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \
353 ? ((db->cursor)->c_del)(db->cursor, 0) \
354 : ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
356 #else /* ! DB_VERSION_MAJOR */
358 #define db_DESTROY(db) (!db->aborted && ((db->dbp)->close)(db->dbp))
359 #define db_close(db) ((db->dbp)->close)(db->dbp)
360 #define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
361 #define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
363 #endif /* ! DB_VERSION_MAJOR */
366 #define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags)
379 #ifdef BERKELEY_DB_1_OR_2
382 #ifdef DB_VERSION_MAJOR
385 SV * filter_fetch_key ;
386 SV * filter_store_key ;
387 SV * filter_fetch_value ;
388 SV * filter_store_value ;
393 typedef DB_File_type * DB_File ;
396 #define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
398 #define OutputValue(arg, name) \
399 { if (RETVAL == 0) { \
400 my_sv_setpvn(arg, name.data, name.size) ; \
404 DBM_ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \
408 #define OutputKey(arg, name) \
411 if (db->type != DB_RECNO) { \
412 my_sv_setpvn(arg, name.data, name.size); \
415 sv_setiv(arg, (I32)*(I32*)name.data - 1); \
419 DBM_ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \
423 #define my_SvUV32(sv) ((u_int32_t)SvUV(sv))
426 extern void __getBerkeleyDBInfo(void);
429 /* Internal Global Data */
431 #define MY_CXT_KEY "DB_File::_guts" XS_VERSION
442 #define Value (MY_CXT.x_Value)
443 #define zero (MY_CXT.x_zero)
444 #define CurrentDB (MY_CXT.x_CurrentDB)
445 #define empty (MY_CXT.x_empty)
447 #define ERR_BUFF "DB_File::Error"
449 #ifdef DB_VERSION_MAJOR
453 db_put(DB_File db, DBTKEY key, DBT value, u_int flags)
455 db_put(db, key, value, flags)
464 if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) {
468 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
469 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor) != 0)
471 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor, 0) != 0)
475 memset(&l_key, 0, sizeof(l_key));
476 l_key.data = key.data;
477 l_key.size = key.size;
478 memset(&l_value, 0, sizeof(l_value));
479 l_value.data = value.data;
480 l_value.size = value.size;
482 if ( temp_cursor->c_get(temp_cursor, &l_key, &l_value, DB_SET) != 0) {
483 (void)temp_cursor->c_close(temp_cursor);
487 status = temp_cursor->c_put(temp_cursor, &key, &value, flags);
488 (void)temp_cursor->c_close(temp_cursor);
494 if (flagSet(flags, R_CURSOR)) {
495 return ((db->cursor)->c_put)(db->cursor, &key, &value, DB_CURRENT);
498 if (flagSet(flags, R_SETCURSOR)) {
499 if ((db->dbp)->put(db->dbp, NULL, &key, &value, 0) != 0)
501 return ((db->cursor)->c_get)(db->cursor, &key, &value, DB_SET_RANGE);
505 return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
509 #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)
548 void * data1, * data2 ;
553 if (CurrentDB->in_compare) {
555 croak ("DB_File btree_compare: recursion detected\n") ;
558 data1 = (char *) key1->data ;
559 data2 = (char *) key2->data ;
562 /* As newSVpv will assume that the data pointer is a null terminated C
563 string if the size parameter is 0, make sure that data points to an
564 empty string if the length is 0
575 CurrentDB->in_compare = FALSE;
576 SAVEINT(CurrentDB->in_compare);
577 CurrentDB->in_compare = TRUE;
581 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
582 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
585 count = perl_call_sv(CurrentDB->compare, G_SCALAR);
591 croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
605 #ifdef AT_LEAST_DB_3_2
608 btree_prefix(DB * db, const DBT *key1, const DBT *key2)
610 btree_prefix(db, key1, key2)
616 #else /* Berkeley DB < 3.2 */
619 btree_prefix(const DBT *key1, const DBT *key2)
621 btree_prefix(key1, key2)
633 char * data1, * data2 ;
637 if (CurrentDB->in_prefix){
639 croak ("DB_File btree_prefix: recursion detected\n") ;
642 data1 = (char *) key1->data ;
643 data2 = (char *) key2->data ;
646 /* As newSVpv will assume that the data pointer is a null terminated C
647 string if the size parameter is 0, make sure that data points to an
648 empty string if the length is 0
659 CurrentDB->in_prefix = FALSE;
660 SAVEINT(CurrentDB->in_prefix);
661 CurrentDB->in_prefix = TRUE;
665 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
666 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
669 count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
675 croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
689 # define HASH_CB_SIZE_TYPE size_t
691 # define HASH_CB_SIZE_TYPE u_int32_t
695 #ifdef AT_LEAST_DB_3_2
698 hash_cb(DB * db, const void *data, u_int32_t size)
700 hash_cb(db, data, size)
703 HASH_CB_SIZE_TYPE size ;
706 #else /* Berkeley DB < 3.2 */
709 hash_cb(const void *data, HASH_CB_SIZE_TYPE size)
713 HASH_CB_SIZE_TYPE size ;
726 if (CurrentDB->in_hash){
728 croak ("DB_File hash callback: recursion detected\n") ;
736 /* DGH - Next two lines added to fix corrupted stack problem */
740 CurrentDB->in_hash = FALSE;
741 SAVEINT(CurrentDB->in_hash);
742 CurrentDB->in_hash = TRUE;
747 XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
750 count = perl_call_sv(CurrentDB->hash, G_SCALAR);
756 croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
771 db_errcall_cb(const char * db_errpfx, char * buffer)
773 db_errcall_cb(db_errpfx, buffer)
774 const char * db_errpfx;
781 SV * sv = perl_get_sv(ERR_BUFF, FALSE) ;
784 sv_setpvf(sv, "%s: %s", db_errpfx, buffer) ;
786 sv_setpv(sv, buffer) ;
791 #if defined(TRACE) && defined(BERKELEY_DB_1_OR_2)
795 PrintHash(INFO *hash)
801 printf ("HASH Info\n") ;
802 printf (" hash = %s\n",
803 (hash->db_HA_hash != NULL ? "redefined" : "default")) ;
804 printf (" bsize = %d\n", hash->db_HA_bsize) ;
805 printf (" ffactor = %d\n", hash->db_HA_ffactor) ;
806 printf (" nelem = %d\n", hash->db_HA_nelem) ;
807 printf (" cachesize = %d\n", hash->db_HA_cachesize) ;
808 printf (" lorder = %d\n", hash->db_HA_lorder) ;
814 PrintRecno(INFO *recno)
820 printf ("RECNO Info\n") ;
821 printf (" flags = %d\n", recno->db_RE_flags) ;
822 printf (" cachesize = %d\n", recno->db_RE_cachesize) ;
823 printf (" psize = %d\n", recno->db_RE_psize) ;
824 printf (" lorder = %d\n", recno->db_RE_lorder) ;
825 printf (" reclen = %lu\n", (unsigned long)recno->db_RE_reclen) ;
826 printf (" bval = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
827 printf (" bfname = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
832 PrintBtree(INFO *btree)
838 printf ("BTREE Info\n") ;
839 printf (" compare = %s\n",
840 (btree->db_BT_compare ? "redefined" : "default")) ;
841 printf (" prefix = %s\n",
842 (btree->db_BT_prefix ? "redefined" : "default")) ;
843 printf (" flags = %d\n", btree->db_BT_flags) ;
844 printf (" cachesize = %d\n", btree->db_BT_cachesize) ;
845 printf (" psize = %d\n", btree->db_BT_psize) ;
846 #ifndef DB_VERSION_MAJOR
847 printf (" maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
848 printf (" minkeypage = %d\n", btree->db_BT_minkeypage) ;
850 printf (" lorder = %d\n", btree->db_BT_lorder) ;
855 #define PrintRecno(recno)
856 #define PrintHash(hash)
857 #define PrintBtree(btree)
864 GetArrayLength(pTHX_ DB_File db)
876 RETVAL = do_SEQ(db, key, value, R_LAST) ;
878 RETVAL = *(I32 *)key.data ;
879 else /* No key means empty file */
882 return ((I32)RETVAL) ;
887 GetRecnoKey(pTHX_ DB_File db, I32 value)
889 GetRecnoKey(db, value)
895 /* Get the length of the array */
896 I32 length = GetArrayLength(aTHX_ db) ;
898 /* check for attempt to write before start of array */
899 if (length + value + 1 <= 0) {
901 croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
904 value = length + value + 1 ;
915 ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv)
917 ParseOpenInfo(isHASH, name, flags, mode, sv)
926 #ifdef BERKELEY_DB_1_OR_2 /* Berkeley DB Version 1 or 2 */
930 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
931 void * openinfo = NULL ;
932 INFO * info = &RETVAL->info ;
937 printf("In ParseOpenInfo name=[%s] flags=[%d] mode=[%d] SV NULL=[%d]\n",
938 name, flags, mode, sv == NULL) ;
940 Zero(RETVAL, 1, DB_File_type) ;
942 /* Default to HASH */
943 RETVAL->filtering = 0 ;
944 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
945 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
946 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
947 RETVAL->type = DB_HASH ;
949 /* DGH - Next line added to avoid SEGV on existing hash DB */
952 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
953 RETVAL->in_memory = (name == NULL) ;
958 croak ("type parameter is not a reference") ;
960 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
961 if (svp && SvOK(*svp))
962 action = (HV*) SvRV(*svp) ;
964 croak("internal error") ;
966 if (sv_isa(sv, "DB_File::HASHINFO"))
970 croak("DB_File can only tie an associative array to a DB_HASH database") ;
972 RETVAL->type = DB_HASH ;
973 openinfo = (void*)info ;
975 svp = hv_fetch(action, "hash", 4, FALSE);
977 if (svp && SvOK(*svp))
979 info->db_HA_hash = hash_cb ;
980 RETVAL->hash = newSVsv(*svp) ;
983 info->db_HA_hash = NULL ;
985 svp = hv_fetch(action, "ffactor", 7, FALSE);
986 info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
988 svp = hv_fetch(action, "nelem", 5, FALSE);
989 info->db_HA_nelem = svp ? SvIV(*svp) : 0;
991 svp = hv_fetch(action, "bsize", 5, FALSE);
992 info->db_HA_bsize = svp ? SvIV(*svp) : 0;
994 svp = hv_fetch(action, "cachesize", 9, FALSE);
995 info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
997 svp = hv_fetch(action, "lorder", 6, FALSE);
998 info->db_HA_lorder = svp ? SvIV(*svp) : 0;
1002 else if (sv_isa(sv, "DB_File::BTREEINFO"))
1005 croak("DB_File can only tie an associative array to a DB_BTREE database");
1007 RETVAL->type = DB_BTREE ;
1008 openinfo = (void*)info ;
1010 svp = hv_fetch(action, "compare", 7, FALSE);
1011 if (svp && SvOK(*svp))
1013 info->db_BT_compare = btree_compare ;
1014 RETVAL->compare = newSVsv(*svp) ;
1017 info->db_BT_compare = NULL ;
1019 svp = hv_fetch(action, "prefix", 6, FALSE);
1020 if (svp && SvOK(*svp))
1022 info->db_BT_prefix = btree_prefix ;
1023 RETVAL->prefix = newSVsv(*svp) ;
1026 info->db_BT_prefix = NULL ;
1028 svp = hv_fetch(action, "flags", 5, FALSE);
1029 info->db_BT_flags = svp ? SvIV(*svp) : 0;
1031 svp = hv_fetch(action, "cachesize", 9, FALSE);
1032 info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
1034 #ifndef DB_VERSION_MAJOR
1035 svp = hv_fetch(action, "minkeypage", 10, FALSE);
1036 info->btree.minkeypage = svp ? SvIV(*svp) : 0;
1038 svp = hv_fetch(action, "maxkeypage", 10, FALSE);
1039 info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
1042 svp = hv_fetch(action, "psize", 5, FALSE);
1043 info->db_BT_psize = svp ? SvIV(*svp) : 0;
1045 svp = hv_fetch(action, "lorder", 6, FALSE);
1046 info->db_BT_lorder = svp ? SvIV(*svp) : 0;
1051 else if (sv_isa(sv, "DB_File::RECNOINFO"))
1054 croak("DB_File can only tie an array to a DB_RECNO database");
1056 RETVAL->type = DB_RECNO ;
1057 openinfo = (void *)info ;
1059 info->db_RE_flags = 0 ;
1061 svp = hv_fetch(action, "flags", 5, FALSE);
1062 info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
1064 svp = hv_fetch(action, "reclen", 6, FALSE);
1065 info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
1067 svp = hv_fetch(action, "cachesize", 9, FALSE);
1068 info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
1070 svp = hv_fetch(action, "psize", 5, FALSE);
1071 info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
1073 svp = hv_fetch(action, "lorder", 6, FALSE);
1074 info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
1076 #ifdef DB_VERSION_MAJOR
1077 info->re_source = name ;
1080 svp = hv_fetch(action, "bfname", 6, FALSE);
1081 if (svp && SvOK(*svp)) {
1082 char * ptr = SvPV(*svp,n_a) ;
1083 #ifdef DB_VERSION_MAJOR
1084 name = (char*) n_a ? ptr : NULL ;
1086 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
1090 #ifdef DB_VERSION_MAJOR
1093 info->db_RE_bfname = NULL ;
1096 svp = hv_fetch(action, "bval", 4, FALSE);
1097 #ifdef DB_VERSION_MAJOR
1098 if (svp && SvOK(*svp))
1102 value = (int)*SvPV(*svp, n_a) ;
1104 value = SvIV(*svp) ;
1106 if (info->flags & DB_FIXEDLEN) {
1107 info->re_pad = value ;
1108 info->flags |= DB_PAD ;
1111 info->re_delim = value ;
1112 info->flags |= DB_DELIMITER ;
1117 if (svp && SvOK(*svp))
1120 info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
1122 info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
1123 DB_flags(info->flags, DB_DELIMITER) ;
1128 if (info->db_RE_flags & R_FIXEDLEN)
1129 info->db_RE_bval = (u_char) ' ' ;
1131 info->db_RE_bval = (u_char) '\n' ;
1132 DB_flags(info->flags, DB_DELIMITER) ;
1137 info->flags |= DB_RENUMBER ;
1143 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1147 /* OS2 Specific Code */
1151 #endif /* __EMX__ */
1154 #ifdef DB_VERSION_MAJOR
1160 /* Map 1.x flags to 2.x flags */
1161 if ((flags & O_CREAT) == O_CREAT)
1162 Flags |= DB_CREATE ;
1165 if (flags == O_RDONLY)
1167 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1169 Flags |= DB_RDONLY ;
1172 if ((flags & O_TRUNC) == O_TRUNC)
1173 Flags |= DB_TRUNCATE ;
1176 status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
1178 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
1179 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
1181 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1186 RETVAL->dbp = NULL ;
1191 #if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2
1192 RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ;
1194 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
1195 #endif /* DB_LIBRARY_COMPATIBILITY_API */
1201 #else /* Berkeley DB Version > 2 */
1205 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
1211 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
1212 Zero(RETVAL, 1, DB_File_type) ;
1214 /* Default to HASH */
1215 RETVAL->filtering = 0 ;
1216 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
1217 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
1218 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
1219 RETVAL->type = DB_HASH ;
1221 /* DGH - Next line added to avoid SEGV on existing hash DB */
1224 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
1225 RETVAL->in_memory = (name == NULL) ;
1227 status = db_create(&RETVAL->dbp, NULL,0) ;
1228 /* printf("db_create returned %d %s\n", status, db_strerror(status)) ; */
1230 RETVAL->dbp = NULL ;
1238 croak ("type parameter is not a reference") ;
1240 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
1241 if (svp && SvOK(*svp))
1242 action = (HV*) SvRV(*svp) ;
1244 croak("internal error") ;
1246 if (sv_isa(sv, "DB_File::HASHINFO"))
1250 croak("DB_File can only tie an associative array to a DB_HASH database") ;
1252 RETVAL->type = DB_HASH ;
1254 svp = hv_fetch(action, "hash", 4, FALSE);
1256 if (svp && SvOK(*svp))
1258 (void)dbp->set_h_hash(dbp, hash_cb) ;
1259 RETVAL->hash = newSVsv(*svp) ;
1262 svp = hv_fetch(action, "ffactor", 7, FALSE);
1264 (void)dbp->set_h_ffactor(dbp, my_SvUV32(*svp)) ;
1266 svp = hv_fetch(action, "nelem", 5, FALSE);
1268 (void)dbp->set_h_nelem(dbp, my_SvUV32(*svp)) ;
1270 svp = hv_fetch(action, "bsize", 5, FALSE);
1272 (void)dbp->set_pagesize(dbp, my_SvUV32(*svp));
1274 svp = hv_fetch(action, "cachesize", 9, FALSE);
1276 (void)dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
1278 svp = hv_fetch(action, "lorder", 6, FALSE);
1280 (void)dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
1284 else if (sv_isa(sv, "DB_File::BTREEINFO"))
1287 croak("DB_File can only tie an associative array to a DB_BTREE database");
1289 RETVAL->type = DB_BTREE ;
1291 svp = hv_fetch(action, "compare", 7, FALSE);
1292 if (svp && SvOK(*svp))
1294 (void)dbp->set_bt_compare(dbp, btree_compare) ;
1295 RETVAL->compare = newSVsv(*svp) ;
1298 svp = hv_fetch(action, "prefix", 6, FALSE);
1299 if (svp && SvOK(*svp))
1301 (void)dbp->set_bt_prefix(dbp, btree_prefix) ;
1302 RETVAL->prefix = newSVsv(*svp) ;
1305 svp = hv_fetch(action, "flags", 5, FALSE);
1307 (void)dbp->set_flags(dbp, my_SvUV32(*svp)) ;
1309 svp = hv_fetch(action, "cachesize", 9, FALSE);
1311 (void)dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
1313 svp = hv_fetch(action, "psize", 5, FALSE);
1315 (void)dbp->set_pagesize(dbp, my_SvUV32(*svp)) ;
1317 svp = hv_fetch(action, "lorder", 6, FALSE);
1319 (void)dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
1324 else if (sv_isa(sv, "DB_File::RECNOINFO"))
1329 croak("DB_File can only tie an array to a DB_RECNO database");
1331 RETVAL->type = DB_RECNO ;
1333 svp = hv_fetch(action, "flags", 5, FALSE);
1335 int flags = SvIV(*svp) ;
1336 /* remove FIXDLEN, if present */
1337 if (flags & DB_FIXEDLEN) {
1339 flags &= ~DB_FIXEDLEN ;
1343 svp = hv_fetch(action, "cachesize", 9, FALSE);
1345 status = dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
1348 svp = hv_fetch(action, "psize", 5, FALSE);
1350 status = dbp->set_pagesize(dbp, my_SvUV32(*svp)) ;
1353 svp = hv_fetch(action, "lorder", 6, FALSE);
1355 status = dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
1358 svp = hv_fetch(action, "bval", 4, FALSE);
1359 if (svp && SvOK(*svp))
1363 value = (int)*SvPV(*svp, n_a) ;
1365 value = (int)SvIV(*svp) ;
1368 status = dbp->set_re_pad(dbp, value) ;
1371 status = dbp->set_re_delim(dbp, value) ;
1377 svp = hv_fetch(action, "reclen", 6, FALSE);
1379 u_int32_t len = my_SvUV32(*svp) ;
1380 status = dbp->set_re_len(dbp, len) ;
1385 status = dbp->set_re_source(dbp, name) ;
1389 svp = hv_fetch(action, "bfname", 6, FALSE);
1390 if (svp && SvOK(*svp)) {
1391 char * ptr = SvPV(*svp,n_a) ;
1392 name = (char*) n_a ? ptr : NULL ;
1398 status = dbp->set_flags(dbp, (u_int32_t)DB_RENUMBER) ;
1401 (void)dbp->set_flags(dbp, (u_int32_t)flags) ;
1406 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1410 u_int32_t Flags = 0 ;
1413 /* Map 1.x flags to 3.x flags */
1414 if ((flags & O_CREAT) == O_CREAT)
1415 Flags |= DB_CREATE ;
1418 if (flags == O_RDONLY)
1420 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1422 Flags |= DB_RDONLY ;
1425 if ((flags & O_TRUNC) == O_TRUNC)
1426 Flags |= DB_TRUNCATE ;
1429 #ifdef AT_LEAST_DB_4_1
1430 status = (RETVAL->dbp->open)(RETVAL->dbp, NULL, name, NULL, RETVAL->type,
1433 status = (RETVAL->dbp->open)(RETVAL->dbp, name, NULL, RETVAL->type,
1436 /* printf("open returned %d %s\n", status, db_strerror(status)) ; */
1439 /* RETVAL->dbp->set_errcall(RETVAL->dbp, db_errcall_cb) ;*/
1441 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1443 /* printf("cursor returned %d %s\n", status, db_strerror(status)) ; */
1447 RETVAL->dbp = NULL ;
1453 #endif /* Berkeley DB Version > 2 */
1455 } /* ParseOpenInfo */
1458 #include "constants.h"
1460 MODULE = DB_File PACKAGE = DB_File PREFIX = db_
1462 INCLUDE: constants.xs
1469 /* SV * sv_err = perl_get_sv(ERR_BUFF, GV_ADD|GV_ADDMULTI) ; */
1471 __getBerkeleyDBInfo() ;
1474 empty.data = &zero ;
1475 empty.size = sizeof(recno_t) ;
1481 db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
1488 char * name = (char *) NULL ;
1489 SV * sv = (SV *) NULL ;
1492 if (items >= 3 && SvOK(ST(2)))
1493 name = (char*) SvPV(ST(2), n_a) ;
1498 RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
1499 if (RETVAL->dbp == NULL) {
1514 Trace(("DESTROY %p\n", db));
1516 Trace(("DESTROY %p done\n", db));
1518 SvREFCNT_dec(db->hash) ;
1520 SvREFCNT_dec(db->compare) ;
1522 SvREFCNT_dec(db->prefix) ;
1523 if (db->filter_fetch_key)
1524 SvREFCNT_dec(db->filter_fetch_key) ;
1525 if (db->filter_store_key)
1526 SvREFCNT_dec(db->filter_store_key) ;
1527 if (db->filter_fetch_value)
1528 SvREFCNT_dec(db->filter_fetch_value) ;
1529 if (db->filter_store_value)
1530 SvREFCNT_dec(db->filter_store_value) ;
1532 #ifdef DB_VERSION_MAJOR
1539 db_DELETE(db, key, flags=0)
1561 RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
1567 db_FETCH(db, key, flags=0)
1580 RETVAL = db_get(db, key, value, flags) ;
1581 ST(0) = sv_newmortal();
1582 OutputValue(ST(0), value)
1586 db_STORE(db, key, value, flags=0)
1611 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1612 ST(0) = sv_newmortal();
1613 OutputKey(ST(0), key) ;
1619 DBTKEY key = NO_INIT
1630 RETVAL = do_SEQ(db, key, value, R_NEXT) ;
1631 ST(0) = sv_newmortal();
1632 OutputKey(ST(0), key) ;
1636 # These would be nice for RECNO
1656 #ifdef DB_VERSION_MAJOR
1657 /* get the first value */
1658 RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1663 for (i = items-1 ; i > 0 ; --i)
1665 DBM_ckFilter(ST(i), filter_store_value, "filter_store_value");
1666 value.data = SvPVbyte(ST(i), n_a) ;
1670 key.size = sizeof(int) ;
1671 #ifdef DB_VERSION_MAJOR
1672 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1674 RETVAL = (db->dbp->put)(db->dbp, &key, &value, R_IBEFORE) ;
1700 /* First get the final value */
1701 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1702 ST(0) = sv_newmortal();
1706 /* the call to del will trash value, so take a copy now */
1707 OutputValue(ST(0), value) ;
1708 RETVAL = db_del(db, key, R_CURSOR) ;
1710 sv_setsv(ST(0), &PL_sv_undef);
1730 /* get the first value */
1731 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1732 ST(0) = sv_newmortal();
1736 /* the call to del will trash value, so take a copy now */
1737 OutputValue(ST(0), value) ;
1738 RETVAL = db_del(db, key, R_CURSOR) ;
1740 sv_setsv (ST(0), &PL_sv_undef) ;
1763 /* Set the Cursor to the Last element */
1764 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1765 #ifndef DB_VERSION_MAJOR
1770 keyval = *(int*)key.data ;
1773 for (i = 1 ; i < items ; ++i)
1775 DBM_ckFilter(ST(i), filter_store_value, "filter_store_value");
1776 value.data = SvPVbyte(ST(i), n_a) ;
1779 key.data = &keyval ;
1780 key.size = sizeof(int) ;
1781 RETVAL = (Db->put)(Db, TXN &key, &value, 0) ;
1795 ALIAS: FETCHSIZE = 1
1798 RETVAL = GetArrayLength(aTHX_ db) ;
1804 # Now provide an interface to the rest of the DB functionality
1808 db_del(db, key, flags=0)
1816 RETVAL = db_del(db, key, flags) ;
1817 #ifdef DB_VERSION_MAJOR
1820 else if (RETVAL == DB_NOTFOUND)
1828 db_get(db, key, value, flags=0)
1838 RETVAL = db_get(db, key, value, flags) ;
1839 #ifdef DB_VERSION_MAJOR
1842 else if (RETVAL == DB_NOTFOUND)
1850 db_put(db, key, value, flags=0)
1859 RETVAL = db_put(db, key, value, flags) ;
1860 #ifdef DB_VERSION_MAJOR
1863 else if (RETVAL == DB_KEYEXIST)
1868 key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
1877 #ifdef DB_VERSION_MAJOR
1881 status = (db->in_memory
1883 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
1888 RETVAL = (db->in_memory
1890 : ((db->dbp)->fd)(db->dbp) ) ;
1896 db_sync(db, flags=0)
1903 RETVAL = db_sync(db, flags) ;
1904 #ifdef DB_VERSION_MAJOR
1913 db_seq(db, key, value, flags)
1923 RETVAL = db_seq(db, key, value, flags);
1924 #ifdef DB_VERSION_MAJOR
1927 else if (RETVAL == DB_NOTFOUND)
1936 filter_fetch_key(db, code)
1939 SV * RETVAL = &PL_sv_undef ;
1941 DBM_setFilter(db->filter_fetch_key, code) ;
1944 filter_store_key(db, code)
1947 SV * RETVAL = &PL_sv_undef ;
1949 DBM_setFilter(db->filter_store_key, code) ;
1952 filter_fetch_value(db, code)
1955 SV * RETVAL = &PL_sv_undef ;
1957 DBM_setFilter(db->filter_fetch_value, code) ;
1960 filter_store_value(db, code)
1963 SV * RETVAL = &PL_sv_undef ;
1965 DBM_setFilter(db->filter_store_value, code) ;