3 DB_File.xs -- Perl 5 interface to Berkeley DB
5 written by Paul Marquess <Paul.Marquess@btinternet.com>
6 last modified 23rd Nov 2001
9 All comments/suggestions/problems are welcome
11 Copyright (c) 1995-2001 Paul Marquess. All rights reserved.
12 This program is free software; you can redistribute it and/or
13 modify it under the same terms as Perl itself.
17 0.2 - No longer bombs out if dbopen returns an error.
18 0.3 - Added some support for multiple btree compares
19 1.0 - Complete support for multiple callbacks added.
20 Fixed a problem with pushing a value onto an empty list.
21 1.01 - Fixed a SunOS core dump problem.
22 The return value from TIEHASH wasn't set to NULL when
23 dbopen returned an error.
24 1.02 - Use ALIAS to define TIEARRAY.
25 Removed some redundant commented code.
26 Merged OS2 code into the main distribution.
27 Allow negative subscripts with RECNO interface.
28 Changed the default flags to O_CREAT|O_RDWR
30 1.04 - fixed a couple of bugs in hash_cb. Patches supplied by
31 Dave Hammen, hammen@gothamcity.jsc.nasa.gov
32 1.05 - Added logic to allow prefix & hash types to be specified via
34 1.06 - Minor namespace cleanup: Localized PrintBtree.
35 1.07 - Fixed bug with RECNO, where bval wasn't defaulting to "\n".
36 1.08 - No change to DB_File.xs
37 1.09 - Default mode for dbopen changed to 0666
38 1.10 - Fixed fd method so that it still returns -1 for
39 in-memory files when db 1.86 is used.
40 1.11 - No change to DB_File.xs
41 1.12 - No change to DB_File.xs
42 1.13 - Tidied up a few casts.
43 1.14 - Made it illegal to tie an associative array to a RECNO
44 database and an ordinary array to a HASH or BTREE database.
45 1.50 - Make work with both DB 1.x or DB 2.x
46 1.51 - Fixed a bug in mapping 1.x O_RDONLY flag to 2.x DB_RDONLY equivalent
47 1.52 - Patch from Gisle Aas <gisle@aas.no> to suppress "use of
48 undefined value" warning with db_get and db_seq.
49 1.53 - Added DB_RENUMBER to flags for recno.
50 1.54 - Fixed bug in the fd method
51 1.55 - Fix for AIX from Jarkko Hietaniemi
52 1.56 - No change to DB_File.xs
53 1.57 - added the #undef op to allow building with Threads support.
54 1.58 - Fixed a problem with the use of sv_setpvn. When the
55 size is specified as 0, it does a strlen on the data.
56 This was ok for DB 1.x, but isn't for DB 2.x.
57 1.59 - No change to DB_File.xs
58 1.60 - Some code tidy up
59 1.61 - added flagSet macro for DB 2.5.x
60 fixed typo in O_RDONLY test.
61 1.62 - No change to DB_File.xs
62 1.63 - Fix to alllow DB 2.6.x to build.
63 1.64 - Tidied up the 1.x to 2.x flags mapping code.
64 Added a patch from Mark Kettenis <kettenis@wins.uva.nl>
65 to fix a flag mapping problem with O_RDONLY on the Hurd
66 1.65 - Fixed a bug in the PUSH logic.
67 Added BOOT check that using 2.3.4 or greater
68 1.66 - Added DBM filter code
69 1.67 - Backed off the use of newSVpvn.
70 Fixed DBM Filter code for Perl 5.004.
71 Fixed a small memory leak in the filter code.
72 1.68 - fixed backward compatability bug with R_IAFTER & R_IBEFORE
73 merged in the 5.005_58 changes
74 1.69 - fixed a bug in push -- DB_APPEND wasn't working properly.
75 Fixed the R_SETCURSOR bug introduced in 1.68
76 Added a new Perl variable $DB_File::db_ver
77 1.70 - Initialise $DB_File::db_ver and $DB_File::db_version with
78 GV_ADD|GV_ADDMULT -- bug spotted by Nick Ing-Simmons.
79 Added a BOOT check to test for equivalent versions of db.h &
81 1.71 - Support for Berkeley DB version 3.
82 Support for Berkeley DB 2/3's backward compatability mode.
84 1.72 - No change to DB_File.xs
85 1.73 - No change to DB_File.xs
86 1.74 - A call to open needed parenthesised to stop it clashing
88 Added Perl core patches 7703 & 7801.
89 1.75 - Fixed Perl core patch 7703.
90 Added suppport to allow DB_File to be built with
91 Berkeley DB 3.2 -- btree_compare, btree_prefix and hash_cb
93 1.76 - No change to DB_File.xs
94 1.77 - Tidied up a few types used in calling newSVpvn.
95 1.78 - Core patch 10335, 10372, 10534, 10549, 11051 included.
96 1.79 - NEXTKEY ignores the input key.
98 1.800 - Moved backward compatability code into ppport.h.
99 Use the new constants code.
103 #define PERL_NO_GET_CONTEXT
112 /* Mention DB_VERSION_MAJOR_CFG, DB_VERSION_MINOR_CFG, and
113 DB_VERSION_PATCH_CFG here so that Configure pulls them all in. */
115 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
116 * shortly #included by the <db.h>) __attribute__ to the possibly
117 * already defined __attribute__, for example by GNUC or by Perl. */
119 /* #if DB_VERSION_MAJOR_CFG < 2 */
120 #ifndef DB_VERSION_MAJOR
121 # undef __attribute__
132 /* Wall starts with 5.7.x */
134 #if PERL_REVISION > 5 || (PERL_REVISION == 5 && PERL_VERSION >= 7)
136 /* Since we dropped the gccish definition of __attribute__ we will want
137 * to redefine dNOOP, however (so that dTHX continues to work). Yes,
138 * all this means that we can't do attribute checking on the DB_File,
140 # ifndef DB_VERSION_MAJOR
143 # define dNOOP extern int Perl___notused
145 /* Ditto for dXSARGS. */
149 I32 ax = mark - PL_stack_base + 1; \
150 I32 items = sp - mark
154 /* avoid -Wall; DB_File xsubs never make use of `ix' setup for ALIASes */
156 # define dXSI32 dNOOP
158 #endif /* Perl >= 5.7 */
163 #define DBM_FILTERING
166 # define Trace(x) printf x
172 #define DBT_clear(x) Zero(&x, 1, DBT) ;
174 #ifdef DB_VERSION_MAJOR
176 #if DB_VERSION_MAJOR == 2
177 # define BERKELEY_DB_1_OR_2
180 #if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 2)
181 # define AT_LEAST_DB_3_2
184 /* map version 2 features & constants onto their version 1 equivalent */
189 #define DB_Prefix_t size_t
194 #define DB_Hash_t u_int32_t
196 /* DBTYPE stays the same */
197 /* HASHINFO, RECNOINFO and BTREEINFO map to DB_INFO */
198 #if DB_VERSION_MAJOR == 2
199 typedef DB_INFO INFO ;
200 #else /* DB_VERSION_MAJOR > 2 */
201 # define DB_FIXEDLEN (0x8000)
202 #endif /* DB_VERSION_MAJOR == 2 */
204 /* version 2 has db_recno_t in place of recno_t */
205 typedef db_recno_t recno_t;
208 #define R_CURSOR DB_SET_RANGE
209 #define R_FIRST DB_FIRST
210 #define R_IAFTER DB_AFTER
211 #define R_IBEFORE DB_BEFORE
212 #define R_LAST DB_LAST
213 #define R_NEXT DB_NEXT
214 #define R_NOOVERWRITE DB_NOOVERWRITE
215 #define R_PREV DB_PREV
217 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
218 # define R_SETCURSOR 0x800000
220 # define R_SETCURSOR (-100)
223 #define R_RECNOSYNC 0
224 #define R_FIXEDLEN DB_FIXEDLEN
228 #define db_HA_hash h_hash
229 #define db_HA_ffactor h_ffactor
230 #define db_HA_nelem h_nelem
231 #define db_HA_bsize db_pagesize
232 #define db_HA_cachesize db_cachesize
233 #define db_HA_lorder db_lorder
235 #define db_BT_compare bt_compare
236 #define db_BT_prefix bt_prefix
237 #define db_BT_flags flags
238 #define db_BT_psize db_pagesize
239 #define db_BT_cachesize db_cachesize
240 #define db_BT_lorder db_lorder
241 #define db_BT_maxkeypage
242 #define db_BT_minkeypage
245 #define db_RE_reclen re_len
246 #define db_RE_flags flags
247 #define db_RE_bval re_pad
248 #define db_RE_bfname re_source
249 #define db_RE_psize db_pagesize
250 #define db_RE_cachesize db_cachesize
251 #define db_RE_lorder db_lorder
255 #define do_SEQ(db, key, value, flag) (db->cursor->c_get)(db->cursor, &key, &value, flag)
258 #define DBT_flags(x) x.flags = 0
259 #define DB_flags(x, v) x |= v
261 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
262 # define flagSet(flags, bitmask) ((flags) & (bitmask))
264 # define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask))
267 #else /* db version 1.x */
269 #define BERKELEY_DB_1
270 #define BERKELEY_DB_1_OR_2
283 # define DB_Prefix_t mDB_Prefix_t
290 # define DB_Hash_t mDB_Hash_t
293 #define db_HA_hash hash.hash
294 #define db_HA_ffactor hash.ffactor
295 #define db_HA_nelem hash.nelem
296 #define db_HA_bsize hash.bsize
297 #define db_HA_cachesize hash.cachesize
298 #define db_HA_lorder hash.lorder
300 #define db_BT_compare btree.compare
301 #define db_BT_prefix btree.prefix
302 #define db_BT_flags btree.flags
303 #define db_BT_psize btree.psize
304 #define db_BT_cachesize btree.cachesize
305 #define db_BT_lorder btree.lorder
306 #define db_BT_maxkeypage btree.maxkeypage
307 #define db_BT_minkeypage btree.minkeypage
309 #define db_RE_reclen recno.reclen
310 #define db_RE_flags recno.flags
311 #define db_RE_bval recno.bval
312 #define db_RE_bfname recno.bfname
313 #define db_RE_psize recno.psize
314 #define db_RE_cachesize recno.cachesize
315 #define db_RE_lorder recno.lorder
319 #define do_SEQ(db, key, value, flag) (db->dbp->seq)(db->dbp, &key, &value, flag)
321 #define DB_flags(x, v)
322 #define flagSet(flags, bitmask) ((flags) & (bitmask))
324 #endif /* db version 1 */
328 #define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, TXN &key, flags)
329 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, flags)
330 #define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
332 #define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
333 #define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
335 #ifdef DB_VERSION_MAJOR
336 #define db_DESTROY(db) ( db->cursor->c_close(db->cursor),\
337 (db->dbp->close)(db->dbp, 0) )
338 #define db_close(db) ((db->dbp)->close)(db->dbp, 0)
339 #define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \
340 ? ((db->cursor)->c_del)(db->cursor, 0) \
341 : ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
343 #else /* ! DB_VERSION_MAJOR */
345 #define db_DESTROY(db) ((db->dbp)->close)(db->dbp)
346 #define db_close(db) ((db->dbp)->close)(db->dbp)
347 #define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
348 #define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
350 #endif /* ! DB_VERSION_MAJOR */
353 #define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags)
362 #ifdef BERKELEY_DB_1_OR_2
365 #ifdef DB_VERSION_MAJOR
369 SV * filter_fetch_key ;
370 SV * filter_store_key ;
371 SV * filter_fetch_value ;
372 SV * filter_store_value ;
374 #endif /* DBM_FILTERING */
378 typedef DB_File_type * DB_File ;
383 #define ckFilter(arg,type,name) \
386 /* printf("filtering %s\n", name) ; */ \
388 croak("recursion detected in %s", name) ; \
389 db->filtering = TRUE ; \
390 save_defsv = newSVsv(DEFSV) ; \
391 sv_setsv(DEFSV, arg) ; \
393 (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \
394 sv_setsv(arg, DEFSV) ; \
395 sv_setsv(DEFSV, save_defsv) ; \
396 SvREFCNT_dec(save_defsv) ; \
397 db->filtering = FALSE ; \
398 /* printf("end of filtering %s\n", name) ; */ \
403 #define ckFilter(arg,type, name)
405 #endif /* DBM_FILTERING */
407 #define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
409 #define OutputValue(arg, name) \
410 { if (RETVAL == 0) { \
411 my_sv_setpvn(arg, name.data, name.size) ; \
412 ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \
416 #define OutputKey(arg, name) \
419 if (db->type != DB_RECNO) { \
420 my_sv_setpvn(arg, name.data, name.size); \
423 sv_setiv(arg, (I32)*(I32*)name.data - 1); \
424 ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \
428 #define my_SvUV32(sv) ((u_int32_t)SvUV(sv))
431 extern void __getBerkeleyDBInfo(void);
434 /* Internal Global Data */
436 #define MY_CXT_KEY "DB_File::_guts" XS_VERSION
447 #define Value (MY_CXT.x_Value)
448 #define zero (MY_CXT.x_zero)
449 #define CurrentDB (MY_CXT.x_CurrentDB)
450 #define empty (MY_CXT.x_empty)
452 #ifdef DB_VERSION_MAJOR
456 db_put(DB_File db, DBTKEY key, DBT value, u_int flags)
458 db_put(db, key, value, flags)
467 if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) {
471 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
472 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor) != 0)
474 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor, 0) != 0)
478 memset(&l_key, 0, sizeof(l_key));
479 l_key.data = key.data;
480 l_key.size = key.size;
481 memset(&l_value, 0, sizeof(l_value));
482 l_value.data = value.data;
483 l_value.size = value.size;
485 if ( temp_cursor->c_get(temp_cursor, &l_key, &l_value, DB_SET) != 0) {
486 (void)temp_cursor->c_close(temp_cursor);
490 status = temp_cursor->c_put(temp_cursor, &key, &value, flags);
491 (void)temp_cursor->c_close(temp_cursor);
497 if (flagSet(flags, R_CURSOR)) {
498 return ((db->cursor)->c_put)(db->cursor, &key, &value, DB_CURRENT);
501 if (flagSet(flags, R_SETCURSOR)) {
502 if ((db->dbp)->put(db->dbp, NULL, &key, &value, 0) != 0)
504 return ((db->cursor)->c_get)(db->cursor, &key, &value, DB_SET_RANGE);
508 return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
512 #endif /* DB_VERSION_MAJOR */
516 #ifdef AT_LEAST_DB_3_2
519 btree_compare(DB * db, const DBT *key1, const DBT *key2)
521 btree_compare(db, key1, key2)
525 #endif /* CAN_PROTOTYPE */
527 #else /* Berkeley DB < 3.2 */
530 btree_compare(const DBT *key1, const DBT *key2)
532 btree_compare(key1, key2)
545 void * data1, * data2 ;
549 data1 = (char *) key1->data ;
550 data2 = (char *) key2->data ;
553 /* As newSVpv will assume that the data pointer is a null terminated C
554 string if the size parameter is 0, make sure that data points to an
555 empty string if the length is 0
568 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
569 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
572 count = perl_call_sv(CurrentDB->compare, G_SCALAR);
577 croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
589 #ifdef AT_LEAST_DB_3_2
592 btree_prefix(DB * db, const DBT *key1, const DBT *key2)
594 btree_prefix(db, key1, key2)
600 #else /* Berkeley DB < 3.2 */
603 btree_prefix(const DBT *key1, const DBT *key2)
605 btree_prefix(key1, key2)
617 char * data1, * data2 ;
621 data1 = (char *) key1->data ;
622 data2 = (char *) key2->data ;
625 /* As newSVpv will assume that the data pointer is a null terminated C
626 string if the size parameter is 0, make sure that data points to an
627 empty string if the length is 0
640 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
641 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
644 count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
649 croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
662 # define HASH_CB_SIZE_TYPE size_t
664 # define HASH_CB_SIZE_TYPE u_int32_t
668 #ifdef AT_LEAST_DB_3_2
671 hash_cb(DB * db, const void *data, u_int32_t size)
673 hash_cb(db, data, size)
676 HASH_CB_SIZE_TYPE size ;
679 #else /* Berkeley DB < 3.2 */
682 hash_cb(const void *data, HASH_CB_SIZE_TYPE size)
686 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 ;
873 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
874 Zero(RETVAL, 1, DB_File_type) ;
876 /* Default to HASH */
878 RETVAL->filtering = 0 ;
879 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
880 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
881 #endif /* DBM_FILTERING */
882 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
883 RETVAL->type = DB_HASH ;
885 /* DGH - Next line added to avoid SEGV on existing hash DB */
888 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
889 RETVAL->in_memory = (name == NULL) ;
894 croak ("type parameter is not a reference") ;
896 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
897 if (svp && SvOK(*svp))
898 action = (HV*) SvRV(*svp) ;
900 croak("internal error") ;
902 if (sv_isa(sv, "DB_File::HASHINFO"))
906 croak("DB_File can only tie an associative array to a DB_HASH database") ;
908 RETVAL->type = DB_HASH ;
909 openinfo = (void*)info ;
911 svp = hv_fetch(action, "hash", 4, FALSE);
913 if (svp && SvOK(*svp))
915 info->db_HA_hash = hash_cb ;
916 RETVAL->hash = newSVsv(*svp) ;
919 info->db_HA_hash = NULL ;
921 svp = hv_fetch(action, "ffactor", 7, FALSE);
922 info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
924 svp = hv_fetch(action, "nelem", 5, FALSE);
925 info->db_HA_nelem = svp ? SvIV(*svp) : 0;
927 svp = hv_fetch(action, "bsize", 5, FALSE);
928 info->db_HA_bsize = svp ? SvIV(*svp) : 0;
930 svp = hv_fetch(action, "cachesize", 9, FALSE);
931 info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
933 svp = hv_fetch(action, "lorder", 6, FALSE);
934 info->db_HA_lorder = svp ? SvIV(*svp) : 0;
938 else if (sv_isa(sv, "DB_File::BTREEINFO"))
941 croak("DB_File can only tie an associative array to a DB_BTREE database");
943 RETVAL->type = DB_BTREE ;
944 openinfo = (void*)info ;
946 svp = hv_fetch(action, "compare", 7, FALSE);
947 if (svp && SvOK(*svp))
949 info->db_BT_compare = btree_compare ;
950 RETVAL->compare = newSVsv(*svp) ;
953 info->db_BT_compare = NULL ;
955 svp = hv_fetch(action, "prefix", 6, FALSE);
956 if (svp && SvOK(*svp))
958 info->db_BT_prefix = btree_prefix ;
959 RETVAL->prefix = newSVsv(*svp) ;
962 info->db_BT_prefix = NULL ;
964 svp = hv_fetch(action, "flags", 5, FALSE);
965 info->db_BT_flags = svp ? SvIV(*svp) : 0;
967 svp = hv_fetch(action, "cachesize", 9, FALSE);
968 info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
970 #ifndef DB_VERSION_MAJOR
971 svp = hv_fetch(action, "minkeypage", 10, FALSE);
972 info->btree.minkeypage = svp ? SvIV(*svp) : 0;
974 svp = hv_fetch(action, "maxkeypage", 10, FALSE);
975 info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
978 svp = hv_fetch(action, "psize", 5, FALSE);
979 info->db_BT_psize = svp ? SvIV(*svp) : 0;
981 svp = hv_fetch(action, "lorder", 6, FALSE);
982 info->db_BT_lorder = svp ? SvIV(*svp) : 0;
987 else if (sv_isa(sv, "DB_File::RECNOINFO"))
990 croak("DB_File can only tie an array to a DB_RECNO database");
992 RETVAL->type = DB_RECNO ;
993 openinfo = (void *)info ;
995 info->db_RE_flags = 0 ;
997 svp = hv_fetch(action, "flags", 5, FALSE);
998 info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
1000 svp = hv_fetch(action, "reclen", 6, FALSE);
1001 info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
1003 svp = hv_fetch(action, "cachesize", 9, FALSE);
1004 info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
1006 svp = hv_fetch(action, "psize", 5, FALSE);
1007 info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
1009 svp = hv_fetch(action, "lorder", 6, FALSE);
1010 info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
1012 #ifdef DB_VERSION_MAJOR
1013 info->re_source = name ;
1016 svp = hv_fetch(action, "bfname", 6, FALSE);
1017 if (svp && SvOK(*svp)) {
1018 char * ptr = SvPV(*svp,n_a) ;
1019 #ifdef DB_VERSION_MAJOR
1020 name = (char*) n_a ? ptr : NULL ;
1022 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
1026 #ifdef DB_VERSION_MAJOR
1029 info->db_RE_bfname = NULL ;
1032 svp = hv_fetch(action, "bval", 4, FALSE);
1033 #ifdef DB_VERSION_MAJOR
1034 if (svp && SvOK(*svp))
1038 value = (int)*SvPV(*svp, n_a) ;
1040 value = SvIV(*svp) ;
1042 if (info->flags & DB_FIXEDLEN) {
1043 info->re_pad = value ;
1044 info->flags |= DB_PAD ;
1047 info->re_delim = value ;
1048 info->flags |= DB_DELIMITER ;
1053 if (svp && SvOK(*svp))
1056 info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
1058 info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
1059 DB_flags(info->flags, DB_DELIMITER) ;
1064 if (info->db_RE_flags & R_FIXEDLEN)
1065 info->db_RE_bval = (u_char) ' ' ;
1067 info->db_RE_bval = (u_char) '\n' ;
1068 DB_flags(info->flags, DB_DELIMITER) ;
1073 info->flags |= DB_RENUMBER ;
1079 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1083 /* OS2 Specific Code */
1087 #endif /* __EMX__ */
1090 #ifdef DB_VERSION_MAJOR
1096 /* Map 1.x flags to 2.x flags */
1097 if ((flags & O_CREAT) == O_CREAT)
1098 Flags |= DB_CREATE ;
1101 if (flags == O_RDONLY)
1103 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1105 Flags |= DB_RDONLY ;
1108 if ((flags & O_TRUNC) == O_TRUNC)
1109 Flags |= DB_TRUNCATE ;
1112 status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
1114 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
1115 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
1117 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1122 RETVAL->dbp = NULL ;
1127 #if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2
1128 RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ;
1130 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
1131 #endif /* DB_LIBRARY_COMPATIBILITY_API */
1137 #else /* Berkeley DB Version > 2 */
1141 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
1147 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
1148 Zero(RETVAL, 1, DB_File_type) ;
1150 /* Default to HASH */
1151 #ifdef DBM_FILTERING
1152 RETVAL->filtering = 0 ;
1153 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
1154 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
1155 #endif /* DBM_FILTERING */
1156 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
1157 RETVAL->type = DB_HASH ;
1159 /* DGH - Next line added to avoid SEGV on existing hash DB */
1162 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
1163 RETVAL->in_memory = (name == NULL) ;
1165 status = db_create(&RETVAL->dbp, NULL,0) ;
1166 /* printf("db_create returned %d %s\n", status, db_strerror(status)) ; */
1168 RETVAL->dbp = NULL ;
1176 croak ("type parameter is not a reference") ;
1178 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
1179 if (svp && SvOK(*svp))
1180 action = (HV*) SvRV(*svp) ;
1182 croak("internal error") ;
1184 if (sv_isa(sv, "DB_File::HASHINFO"))
1188 croak("DB_File can only tie an associative array to a DB_HASH database") ;
1190 RETVAL->type = DB_HASH ;
1192 svp = hv_fetch(action, "hash", 4, FALSE);
1194 if (svp && SvOK(*svp))
1196 (void)dbp->set_h_hash(dbp, hash_cb) ;
1197 RETVAL->hash = newSVsv(*svp) ;
1200 svp = hv_fetch(action, "ffactor", 7, FALSE);
1202 (void)dbp->set_h_ffactor(dbp, my_SvUV32(*svp)) ;
1204 svp = hv_fetch(action, "nelem", 5, FALSE);
1206 (void)dbp->set_h_nelem(dbp, my_SvUV32(*svp)) ;
1208 svp = hv_fetch(action, "bsize", 5, FALSE);
1210 (void)dbp->set_pagesize(dbp, my_SvUV32(*svp));
1212 svp = hv_fetch(action, "cachesize", 9, FALSE);
1214 (void)dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
1216 svp = hv_fetch(action, "lorder", 6, FALSE);
1218 (void)dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
1222 else if (sv_isa(sv, "DB_File::BTREEINFO"))
1225 croak("DB_File can only tie an associative array to a DB_BTREE database");
1227 RETVAL->type = DB_BTREE ;
1229 svp = hv_fetch(action, "compare", 7, FALSE);
1230 if (svp && SvOK(*svp))
1232 (void)dbp->set_bt_compare(dbp, btree_compare) ;
1233 RETVAL->compare = newSVsv(*svp) ;
1236 svp = hv_fetch(action, "prefix", 6, FALSE);
1237 if (svp && SvOK(*svp))
1239 (void)dbp->set_bt_prefix(dbp, btree_prefix) ;
1240 RETVAL->prefix = newSVsv(*svp) ;
1243 svp = hv_fetch(action, "flags", 5, FALSE);
1245 (void)dbp->set_flags(dbp, my_SvUV32(*svp)) ;
1247 svp = hv_fetch(action, "cachesize", 9, FALSE);
1249 (void)dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
1251 svp = hv_fetch(action, "psize", 5, FALSE);
1253 (void)dbp->set_pagesize(dbp, my_SvUV32(*svp)) ;
1255 svp = hv_fetch(action, "lorder", 6, FALSE);
1257 (void)dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
1262 else if (sv_isa(sv, "DB_File::RECNOINFO"))
1267 croak("DB_File can only tie an array to a DB_RECNO database");
1269 RETVAL->type = DB_RECNO ;
1271 svp = hv_fetch(action, "flags", 5, FALSE);
1273 int flags = SvIV(*svp) ;
1274 /* remove FIXDLEN, if present */
1275 if (flags & DB_FIXEDLEN) {
1277 flags &= ~DB_FIXEDLEN ;
1281 svp = hv_fetch(action, "cachesize", 9, FALSE);
1283 status = dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
1286 svp = hv_fetch(action, "psize", 5, FALSE);
1288 status = dbp->set_pagesize(dbp, my_SvUV32(*svp)) ;
1291 svp = hv_fetch(action, "lorder", 6, FALSE);
1293 status = dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
1296 svp = hv_fetch(action, "bval", 4, FALSE);
1297 if (svp && SvOK(*svp))
1301 value = (int)*SvPV(*svp, n_a) ;
1303 value = (int)SvIV(*svp) ;
1306 status = dbp->set_re_pad(dbp, value) ;
1309 status = dbp->set_re_delim(dbp, value) ;
1315 svp = hv_fetch(action, "reclen", 6, FALSE);
1317 u_int32_t len = my_SvUV32(*svp) ;
1318 status = dbp->set_re_len(dbp, len) ;
1323 status = dbp->set_re_source(dbp, name) ;
1327 svp = hv_fetch(action, "bfname", 6, FALSE);
1328 if (svp && SvOK(*svp)) {
1329 char * ptr = SvPV(*svp,n_a) ;
1330 name = (char*) n_a ? ptr : NULL ;
1336 status = dbp->set_flags(dbp, (u_int32_t)DB_RENUMBER) ;
1339 (void)dbp->set_flags(dbp, (u_int32_t)flags) ;
1344 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1348 u_int32_t Flags = 0 ;
1351 /* Map 1.x flags to 3.x flags */
1352 if ((flags & O_CREAT) == O_CREAT)
1353 Flags |= DB_CREATE ;
1356 if (flags == O_RDONLY)
1358 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1360 Flags |= DB_RDONLY ;
1363 if ((flags & O_TRUNC) == O_TRUNC)
1364 Flags |= DB_TRUNCATE ;
1367 status = (RETVAL->dbp->open)(RETVAL->dbp, name, NULL, RETVAL->type,
1369 /* printf("open returned %d %s\n", status, db_strerror(status)) ; */
1372 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1374 /* printf("cursor returned %d %s\n", status, db_strerror(status)) ; */
1377 RETVAL->dbp = NULL ;
1383 #endif /* Berkeley DB Version > 2 */
1385 } /* ParseOpenInfo */
1388 #include "constants.h"
1390 MODULE = DB_File PACKAGE = DB_File PREFIX = db_
1392 INCLUDE: constants.xs
1397 __getBerkeleyDBInfo() ;
1400 empty.data = &zero ;
1401 empty.size = sizeof(recno_t) ;
1407 db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
1414 char * name = (char *) NULL ;
1415 SV * sv = (SV *) NULL ;
1418 if (items >= 3 && SvOK(ST(2)))
1419 name = (char*) SvPV(ST(2), n_a) ;
1424 RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
1425 if (RETVAL->dbp == NULL)
1440 SvREFCNT_dec(db->hash) ;
1442 SvREFCNT_dec(db->compare) ;
1444 SvREFCNT_dec(db->prefix) ;
1445 #ifdef DBM_FILTERING
1446 if (db->filter_fetch_key)
1447 SvREFCNT_dec(db->filter_fetch_key) ;
1448 if (db->filter_store_key)
1449 SvREFCNT_dec(db->filter_store_key) ;
1450 if (db->filter_fetch_value)
1451 SvREFCNT_dec(db->filter_fetch_value) ;
1452 if (db->filter_store_value)
1453 SvREFCNT_dec(db->filter_store_value) ;
1454 #endif /* DBM_FILTERING */
1456 #ifdef DB_VERSION_MAJOR
1463 db_DELETE(db, key, flags=0)
1485 RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
1491 db_FETCH(db, key, flags=0)
1504 /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */
1505 RETVAL = db_get(db, key, value, flags) ;
1506 ST(0) = sv_newmortal();
1507 OutputValue(ST(0), value)
1511 db_STORE(db, key, value, flags=0)
1536 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1537 ST(0) = sv_newmortal();
1538 OutputKey(ST(0), key) ;
1544 DBTKEY key = NO_INIT
1555 RETVAL = do_SEQ(db, key, value, R_NEXT) ;
1556 ST(0) = sv_newmortal();
1557 OutputKey(ST(0), key) ;
1561 # These would be nice for RECNO
1581 #ifdef DB_VERSION_MAJOR
1582 /* get the first value */
1583 RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1588 for (i = items-1 ; i > 0 ; --i)
1590 value.data = SvPV(ST(i), n_a) ;
1594 key.size = sizeof(int) ;
1595 #ifdef DB_VERSION_MAJOR
1596 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1598 RETVAL = (db->dbp->put)(db->dbp, &key, &value, R_IBEFORE) ;
1624 /* First get the final value */
1625 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1626 ST(0) = sv_newmortal();
1630 /* the call to del will trash value, so take a copy now */
1631 OutputValue(ST(0), value) ;
1632 RETVAL = db_del(db, key, R_CURSOR) ;
1634 sv_setsv(ST(0), &PL_sv_undef);
1654 /* get the first value */
1655 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1656 ST(0) = sv_newmortal();
1660 /* the call to del will trash value, so take a copy now */
1661 OutputValue(ST(0), value) ;
1662 RETVAL = db_del(db, key, R_CURSOR) ;
1664 sv_setsv (ST(0), &PL_sv_undef) ;
1687 /* Set the Cursor to the Last element */
1688 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1689 #ifndef DB_VERSION_MAJOR
1694 keyval = *(int*)key.data ;
1697 for (i = 1 ; i < items ; ++i)
1699 value.data = SvPV(ST(i), n_a) ;
1702 key.data = &keyval ;
1703 key.size = sizeof(int) ;
1704 RETVAL = (Db->put)(Db, TXN &key, &value, 0) ;
1718 ALIAS: FETCHSIZE = 1
1721 RETVAL = GetArrayLength(aTHX_ db) ;
1727 # Now provide an interface to the rest of the DB functionality
1731 db_del(db, key, flags=0)
1739 RETVAL = db_del(db, key, flags) ;
1740 #ifdef DB_VERSION_MAJOR
1743 else if (RETVAL == DB_NOTFOUND)
1751 db_get(db, key, value, flags=0)
1761 RETVAL = db_get(db, key, value, flags) ;
1762 #ifdef DB_VERSION_MAJOR
1765 else if (RETVAL == DB_NOTFOUND)
1773 db_put(db, key, value, flags=0)
1782 RETVAL = db_put(db, key, value, flags) ;
1783 #ifdef DB_VERSION_MAJOR
1786 else if (RETVAL == DB_KEYEXIST)
1791 key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
1800 #ifdef DB_VERSION_MAJOR
1804 status = (db->in_memory
1806 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
1811 RETVAL = (db->in_memory
1813 : ((db->dbp)->fd)(db->dbp) ) ;
1819 db_sync(db, flags=0)
1826 RETVAL = db_sync(db, flags) ;
1827 #ifdef DB_VERSION_MAJOR
1836 db_seq(db, key, value, flags)
1846 RETVAL = db_seq(db, key, value, flags);
1847 #ifdef DB_VERSION_MAJOR
1850 else if (RETVAL == DB_NOTFOUND)
1858 #ifdef DBM_FILTERING
1860 #define setFilter(type) \
1863 RETVAL = sv_mortalcopy(db->type) ; \
1865 if (db->type && (code == &PL_sv_undef)) { \
1866 SvREFCNT_dec(db->type) ; \
1871 sv_setsv(db->type, code) ; \
1873 db->type = newSVsv(code) ; \
1879 filter_fetch_key(db, code)
1882 SV * RETVAL = &PL_sv_undef ;
1884 setFilter(filter_fetch_key) ;
1887 filter_store_key(db, code)
1890 SV * RETVAL = &PL_sv_undef ;
1892 setFilter(filter_store_key) ;
1895 filter_fetch_value(db, code)
1898 SV * RETVAL = &PL_sv_undef ;
1900 setFilter(filter_fetch_value) ;
1903 filter_store_value(db, code)
1906 SV * RETVAL = &PL_sv_undef ;
1908 setFilter(filter_store_value) ;
1910 #endif /* DBM_FILTERING */