3 DB_File.xs -- Perl 5 interface to Berkeley DB
5 written by Paul Marquess <Paul.Marquess@btinternet.com>
6 last modified 6th Jan 2002
9 All comments/suggestions/problems are welcome
11 Copyright (c) 1995-2002 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
105 #define PERL_NO_GET_CONTEXT
114 /* Mention DB_VERSION_MAJOR_CFG, DB_VERSION_MINOR_CFG, and
115 DB_VERSION_PATCH_CFG here so that Configure pulls them all in. */
117 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
118 * shortly #included by the <db.h>) __attribute__ to the possibly
119 * already defined __attribute__, for example by GNUC or by Perl. */
121 /* #if DB_VERSION_MAJOR_CFG < 2 */
122 #ifndef DB_VERSION_MAJOR
123 # undef __attribute__
134 /* Wall starts with 5.7.x */
136 #if PERL_REVISION > 5 || (PERL_REVISION == 5 && PERL_VERSION >= 7)
138 /* Since we dropped the gccish definition of __attribute__ we will want
139 * to redefine dNOOP, however (so that dTHX continues to work). Yes,
140 * all this means that we can't do attribute checking on the DB_File,
142 # ifndef DB_VERSION_MAJOR
145 # define dNOOP extern int Perl___notused
147 /* Ditto for dXSARGS. */
151 I32 ax = mark - PL_stack_base + 1; \
152 I32 items = sp - mark
156 /* avoid -Wall; DB_File xsubs never make use of `ix' setup for ALIASes */
158 # define dXSI32 dNOOP
160 #endif /* Perl >= 5.7 */
165 #define DBM_FILTERING
168 # define Trace(x) printf x
174 #define DBT_clear(x) Zero(&x, 1, DBT) ;
176 #ifdef DB_VERSION_MAJOR
178 #if DB_VERSION_MAJOR == 2
179 # define BERKELEY_DB_1_OR_2
182 #if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 2)
183 # define AT_LEAST_DB_3_2
186 /* map version 2 features & constants onto their version 1 equivalent */
191 #define DB_Prefix_t size_t
196 #define DB_Hash_t u_int32_t
198 /* DBTYPE stays the same */
199 /* HASHINFO, RECNOINFO and BTREEINFO map to DB_INFO */
200 #if DB_VERSION_MAJOR == 2
201 typedef DB_INFO INFO ;
202 #else /* DB_VERSION_MAJOR > 2 */
203 # define DB_FIXEDLEN (0x8000)
204 #endif /* DB_VERSION_MAJOR == 2 */
206 /* version 2 has db_recno_t in place of recno_t */
207 typedef db_recno_t recno_t;
210 #define R_CURSOR DB_SET_RANGE
211 #define R_FIRST DB_FIRST
212 #define R_IAFTER DB_AFTER
213 #define R_IBEFORE DB_BEFORE
214 #define R_LAST DB_LAST
215 #define R_NEXT DB_NEXT
216 #define R_NOOVERWRITE DB_NOOVERWRITE
217 #define R_PREV DB_PREV
219 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
220 # define R_SETCURSOR 0x800000
222 # define R_SETCURSOR (-100)
225 #define R_RECNOSYNC 0
226 #define R_FIXEDLEN DB_FIXEDLEN
230 #define db_HA_hash h_hash
231 #define db_HA_ffactor h_ffactor
232 #define db_HA_nelem h_nelem
233 #define db_HA_bsize db_pagesize
234 #define db_HA_cachesize db_cachesize
235 #define db_HA_lorder db_lorder
237 #define db_BT_compare bt_compare
238 #define db_BT_prefix bt_prefix
239 #define db_BT_flags flags
240 #define db_BT_psize db_pagesize
241 #define db_BT_cachesize db_cachesize
242 #define db_BT_lorder db_lorder
243 #define db_BT_maxkeypage
244 #define db_BT_minkeypage
247 #define db_RE_reclen re_len
248 #define db_RE_flags flags
249 #define db_RE_bval re_pad
250 #define db_RE_bfname re_source
251 #define db_RE_psize db_pagesize
252 #define db_RE_cachesize db_cachesize
253 #define db_RE_lorder db_lorder
257 #define do_SEQ(db, key, value, flag) (db->cursor->c_get)(db->cursor, &key, &value, flag)
260 #define DBT_flags(x) x.flags = 0
261 #define DB_flags(x, v) x |= v
263 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
264 # define flagSet(flags, bitmask) ((flags) & (bitmask))
266 # define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask))
269 #else /* db version 1.x */
271 #define BERKELEY_DB_1
272 #define BERKELEY_DB_1_OR_2
285 # define DB_Prefix_t mDB_Prefix_t
292 # define DB_Hash_t mDB_Hash_t
295 #define db_HA_hash hash.hash
296 #define db_HA_ffactor hash.ffactor
297 #define db_HA_nelem hash.nelem
298 #define db_HA_bsize hash.bsize
299 #define db_HA_cachesize hash.cachesize
300 #define db_HA_lorder hash.lorder
302 #define db_BT_compare btree.compare
303 #define db_BT_prefix btree.prefix
304 #define db_BT_flags btree.flags
305 #define db_BT_psize btree.psize
306 #define db_BT_cachesize btree.cachesize
307 #define db_BT_lorder btree.lorder
308 #define db_BT_maxkeypage btree.maxkeypage
309 #define db_BT_minkeypage btree.minkeypage
311 #define db_RE_reclen recno.reclen
312 #define db_RE_flags recno.flags
313 #define db_RE_bval recno.bval
314 #define db_RE_bfname recno.bfname
315 #define db_RE_psize recno.psize
316 #define db_RE_cachesize recno.cachesize
317 #define db_RE_lorder recno.lorder
321 #define do_SEQ(db, key, value, flag) (db->dbp->seq)(db->dbp, &key, &value, flag)
323 #define DB_flags(x, v)
324 #define flagSet(flags, bitmask) ((flags) & (bitmask))
326 #endif /* db version 1 */
330 #define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, TXN &key, flags)
331 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, flags)
332 #define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
334 #define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
335 #define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
337 #ifdef DB_VERSION_MAJOR
338 #define db_DESTROY(db) ( db->cursor->c_close(db->cursor),\
339 (db->dbp->close)(db->dbp, 0) )
340 #define db_close(db) ((db->dbp)->close)(db->dbp, 0)
341 #define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \
342 ? ((db->cursor)->c_del)(db->cursor, 0) \
343 : ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
345 #else /* ! DB_VERSION_MAJOR */
347 #define db_DESTROY(db) ((db->dbp)->close)(db->dbp)
348 #define db_close(db) ((db->dbp)->close)(db->dbp)
349 #define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
350 #define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
352 #endif /* ! DB_VERSION_MAJOR */
355 #define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags)
364 #ifdef BERKELEY_DB_1_OR_2
367 #ifdef DB_VERSION_MAJOR
371 SV * filter_fetch_key ;
372 SV * filter_store_key ;
373 SV * filter_fetch_value ;
374 SV * filter_store_value ;
376 #endif /* DBM_FILTERING */
380 typedef DB_File_type * DB_File ;
385 #define ckFilter(arg,type,name) \
388 /* printf("filtering %s\n", name) ; */ \
390 croak("recursion detected in %s", name) ; \
391 db->filtering = TRUE ; \
392 save_defsv = newSVsv(DEFSV) ; \
393 sv_setsv(DEFSV, arg) ; \
395 (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \
396 sv_setsv(arg, DEFSV) ; \
397 sv_setsv(DEFSV, save_defsv) ; \
398 SvREFCNT_dec(save_defsv) ; \
399 db->filtering = FALSE ; \
400 /* printf("end of filtering %s\n", name) ; */ \
405 #define ckFilter(arg,type, name)
407 #endif /* DBM_FILTERING */
409 #define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
411 #define OutputValue(arg, name) \
412 { if (RETVAL == 0) { \
413 my_sv_setpvn(arg, name.data, name.size) ; \
414 ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \
418 #define OutputKey(arg, name) \
421 if (db->type != DB_RECNO) { \
422 my_sv_setpvn(arg, name.data, name.size); \
425 sv_setiv(arg, (I32)*(I32*)name.data - 1); \
426 ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \
430 #define my_SvUV32(sv) ((u_int32_t)SvUV(sv))
433 extern void __getBerkeleyDBInfo(void);
436 /* Internal Global Data */
438 #define MY_CXT_KEY "DB_File::_guts" XS_VERSION
449 #define Value (MY_CXT.x_Value)
450 #define zero (MY_CXT.x_zero)
451 #define CurrentDB (MY_CXT.x_CurrentDB)
452 #define empty (MY_CXT.x_empty)
454 #ifdef DB_VERSION_MAJOR
458 db_put(DB_File db, DBTKEY key, DBT value, u_int flags)
460 db_put(db, key, value, flags)
469 if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) {
473 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
474 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor) != 0)
476 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor, 0) != 0)
480 memset(&l_key, 0, sizeof(l_key));
481 l_key.data = key.data;
482 l_key.size = key.size;
483 memset(&l_value, 0, sizeof(l_value));
484 l_value.data = value.data;
485 l_value.size = value.size;
487 if ( temp_cursor->c_get(temp_cursor, &l_key, &l_value, DB_SET) != 0) {
488 (void)temp_cursor->c_close(temp_cursor);
492 status = temp_cursor->c_put(temp_cursor, &key, &value, flags);
493 (void)temp_cursor->c_close(temp_cursor);
499 if (flagSet(flags, R_CURSOR)) {
500 return ((db->cursor)->c_put)(db->cursor, &key, &value, DB_CURRENT);
503 if (flagSet(flags, R_SETCURSOR)) {
504 if ((db->dbp)->put(db->dbp, NULL, &key, &value, 0) != 0)
506 return ((db->cursor)->c_get)(db->cursor, &key, &value, DB_SET_RANGE);
510 return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
514 #endif /* DB_VERSION_MAJOR */
518 #ifdef AT_LEAST_DB_3_2
521 btree_compare(DB * db, const DBT *key1, const DBT *key2)
523 btree_compare(db, key1, key2)
527 #endif /* CAN_PROTOTYPE */
529 #else /* Berkeley DB < 3.2 */
532 btree_compare(const DBT *key1, const DBT *key2)
534 btree_compare(key1, key2)
547 void * 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)
619 char * data1, * data2 ;
623 data1 = (char *) key1->data ;
624 data2 = (char *) key2->data ;
627 /* As newSVpv will assume that the data pointer is a null terminated C
628 string if the size parameter is 0, make sure that data points to an
629 empty string if the length is 0
642 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
643 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
646 count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
651 croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
664 # define HASH_CB_SIZE_TYPE size_t
666 # define HASH_CB_SIZE_TYPE u_int32_t
670 #ifdef AT_LEAST_DB_3_2
673 hash_cb(DB * db, const void *data, u_int32_t size)
675 hash_cb(db, data, size)
678 HASH_CB_SIZE_TYPE size ;
681 #else /* Berkeley DB < 3.2 */
684 hash_cb(const void *data, HASH_CB_SIZE_TYPE size)
688 HASH_CB_SIZE_TYPE size ;
706 /* DGH - Next two lines added to fix corrupted stack problem */
712 XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
715 count = perl_call_sv(CurrentDB->hash, G_SCALAR);
720 croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
732 #if defined(TRACE) && defined(BERKELEY_DB_1_OR_2)
736 PrintHash(INFO *hash)
742 printf ("HASH Info\n") ;
743 printf (" hash = %s\n",
744 (hash->db_HA_hash != NULL ? "redefined" : "default")) ;
745 printf (" bsize = %d\n", hash->db_HA_bsize) ;
746 printf (" ffactor = %d\n", hash->db_HA_ffactor) ;
747 printf (" nelem = %d\n", hash->db_HA_nelem) ;
748 printf (" cachesize = %d\n", hash->db_HA_cachesize) ;
749 printf (" lorder = %d\n", hash->db_HA_lorder) ;
755 PrintRecno(INFO *recno)
761 printf ("RECNO Info\n") ;
762 printf (" flags = %d\n", recno->db_RE_flags) ;
763 printf (" cachesize = %d\n", recno->db_RE_cachesize) ;
764 printf (" psize = %d\n", recno->db_RE_psize) ;
765 printf (" lorder = %d\n", recno->db_RE_lorder) ;
766 printf (" reclen = %ul\n", (unsigned long)recno->db_RE_reclen) ;
767 printf (" bval = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
768 printf (" bfname = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
773 PrintBtree(INFO *btree)
779 printf ("BTREE Info\n") ;
780 printf (" compare = %s\n",
781 (btree->db_BT_compare ? "redefined" : "default")) ;
782 printf (" prefix = %s\n",
783 (btree->db_BT_prefix ? "redefined" : "default")) ;
784 printf (" flags = %d\n", btree->db_BT_flags) ;
785 printf (" cachesize = %d\n", btree->db_BT_cachesize) ;
786 printf (" psize = %d\n", btree->db_BT_psize) ;
787 #ifndef DB_VERSION_MAJOR
788 printf (" maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
789 printf (" minkeypage = %d\n", btree->db_BT_minkeypage) ;
791 printf (" lorder = %d\n", btree->db_BT_lorder) ;
796 #define PrintRecno(recno)
797 #define PrintHash(hash)
798 #define PrintBtree(btree)
805 GetArrayLength(pTHX_ DB_File db)
817 RETVAL = do_SEQ(db, key, value, R_LAST) ;
819 RETVAL = *(I32 *)key.data ;
820 else /* No key means empty file */
823 return ((I32)RETVAL) ;
828 GetRecnoKey(pTHX_ DB_File db, I32 value)
830 GetRecnoKey(db, value)
836 /* Get the length of the array */
837 I32 length = GetArrayLength(aTHX_ db) ;
839 /* check for attempt to write before start of array */
840 if (length + value + 1 <= 0)
841 croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
843 value = length + value + 1 ;
854 ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv)
856 ParseOpenInfo(isHASH, name, flags, mode, sv)
865 #ifdef BERKELEY_DB_1_OR_2 /* Berkeley DB Version 1 or 2 */
869 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
870 void * openinfo = NULL ;
871 INFO * info = &RETVAL->info ;
875 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
876 Zero(RETVAL, 1, DB_File_type) ;
878 /* Default to HASH */
880 RETVAL->filtering = 0 ;
881 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
882 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
883 #endif /* DBM_FILTERING */
884 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
885 RETVAL->type = DB_HASH ;
887 /* DGH - Next line added to avoid SEGV on existing hash DB */
890 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
891 RETVAL->in_memory = (name == NULL) ;
896 croak ("type parameter is not a reference") ;
898 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
899 if (svp && SvOK(*svp))
900 action = (HV*) SvRV(*svp) ;
902 croak("internal error") ;
904 if (sv_isa(sv, "DB_File::HASHINFO"))
908 croak("DB_File can only tie an associative array to a DB_HASH database") ;
910 RETVAL->type = DB_HASH ;
911 openinfo = (void*)info ;
913 svp = hv_fetch(action, "hash", 4, FALSE);
915 if (svp && SvOK(*svp))
917 info->db_HA_hash = hash_cb ;
918 RETVAL->hash = newSVsv(*svp) ;
921 info->db_HA_hash = NULL ;
923 svp = hv_fetch(action, "ffactor", 7, FALSE);
924 info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
926 svp = hv_fetch(action, "nelem", 5, FALSE);
927 info->db_HA_nelem = svp ? SvIV(*svp) : 0;
929 svp = hv_fetch(action, "bsize", 5, FALSE);
930 info->db_HA_bsize = svp ? SvIV(*svp) : 0;
932 svp = hv_fetch(action, "cachesize", 9, FALSE);
933 info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
935 svp = hv_fetch(action, "lorder", 6, FALSE);
936 info->db_HA_lorder = svp ? SvIV(*svp) : 0;
940 else if (sv_isa(sv, "DB_File::BTREEINFO"))
943 croak("DB_File can only tie an associative array to a DB_BTREE database");
945 RETVAL->type = DB_BTREE ;
946 openinfo = (void*)info ;
948 svp = hv_fetch(action, "compare", 7, FALSE);
949 if (svp && SvOK(*svp))
951 info->db_BT_compare = btree_compare ;
952 RETVAL->compare = newSVsv(*svp) ;
955 info->db_BT_compare = NULL ;
957 svp = hv_fetch(action, "prefix", 6, FALSE);
958 if (svp && SvOK(*svp))
960 info->db_BT_prefix = btree_prefix ;
961 RETVAL->prefix = newSVsv(*svp) ;
964 info->db_BT_prefix = NULL ;
966 svp = hv_fetch(action, "flags", 5, FALSE);
967 info->db_BT_flags = svp ? SvIV(*svp) : 0;
969 svp = hv_fetch(action, "cachesize", 9, FALSE);
970 info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
972 #ifndef DB_VERSION_MAJOR
973 svp = hv_fetch(action, "minkeypage", 10, FALSE);
974 info->btree.minkeypage = svp ? SvIV(*svp) : 0;
976 svp = hv_fetch(action, "maxkeypage", 10, FALSE);
977 info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
980 svp = hv_fetch(action, "psize", 5, FALSE);
981 info->db_BT_psize = svp ? SvIV(*svp) : 0;
983 svp = hv_fetch(action, "lorder", 6, FALSE);
984 info->db_BT_lorder = svp ? SvIV(*svp) : 0;
989 else if (sv_isa(sv, "DB_File::RECNOINFO"))
992 croak("DB_File can only tie an array to a DB_RECNO database");
994 RETVAL->type = DB_RECNO ;
995 openinfo = (void *)info ;
997 info->db_RE_flags = 0 ;
999 svp = hv_fetch(action, "flags", 5, FALSE);
1000 info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
1002 svp = hv_fetch(action, "reclen", 6, FALSE);
1003 info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
1005 svp = hv_fetch(action, "cachesize", 9, FALSE);
1006 info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
1008 svp = hv_fetch(action, "psize", 5, FALSE);
1009 info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
1011 svp = hv_fetch(action, "lorder", 6, FALSE);
1012 info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
1014 #ifdef DB_VERSION_MAJOR
1015 info->re_source = name ;
1018 svp = hv_fetch(action, "bfname", 6, FALSE);
1019 if (svp && SvOK(*svp)) {
1020 char * ptr = SvPV(*svp,n_a) ;
1021 #ifdef DB_VERSION_MAJOR
1022 name = (char*) n_a ? ptr : NULL ;
1024 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
1028 #ifdef DB_VERSION_MAJOR
1031 info->db_RE_bfname = NULL ;
1034 svp = hv_fetch(action, "bval", 4, FALSE);
1035 #ifdef DB_VERSION_MAJOR
1036 if (svp && SvOK(*svp))
1040 value = (int)*SvPV(*svp, n_a) ;
1042 value = SvIV(*svp) ;
1044 if (info->flags & DB_FIXEDLEN) {
1045 info->re_pad = value ;
1046 info->flags |= DB_PAD ;
1049 info->re_delim = value ;
1050 info->flags |= DB_DELIMITER ;
1055 if (svp && SvOK(*svp))
1058 info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
1060 info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
1061 DB_flags(info->flags, DB_DELIMITER) ;
1066 if (info->db_RE_flags & R_FIXEDLEN)
1067 info->db_RE_bval = (u_char) ' ' ;
1069 info->db_RE_bval = (u_char) '\n' ;
1070 DB_flags(info->flags, DB_DELIMITER) ;
1075 info->flags |= DB_RENUMBER ;
1081 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1085 /* OS2 Specific Code */
1089 #endif /* __EMX__ */
1092 #ifdef DB_VERSION_MAJOR
1098 /* Map 1.x flags to 2.x flags */
1099 if ((flags & O_CREAT) == O_CREAT)
1100 Flags |= DB_CREATE ;
1103 if (flags == O_RDONLY)
1105 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1107 Flags |= DB_RDONLY ;
1110 if ((flags & O_TRUNC) == O_TRUNC)
1111 Flags |= DB_TRUNCATE ;
1114 status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
1116 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
1117 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
1119 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1124 RETVAL->dbp = NULL ;
1129 #if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2
1130 RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ;
1132 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
1133 #endif /* DB_LIBRARY_COMPATIBILITY_API */
1139 #else /* Berkeley DB Version > 2 */
1143 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
1149 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
1150 Zero(RETVAL, 1, DB_File_type) ;
1152 /* Default to HASH */
1153 #ifdef DBM_FILTERING
1154 RETVAL->filtering = 0 ;
1155 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
1156 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
1157 #endif /* DBM_FILTERING */
1158 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
1159 RETVAL->type = DB_HASH ;
1161 /* DGH - Next line added to avoid SEGV on existing hash DB */
1164 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
1165 RETVAL->in_memory = (name == NULL) ;
1167 status = db_create(&RETVAL->dbp, NULL,0) ;
1168 /* printf("db_create returned %d %s\n", status, db_strerror(status)) ; */
1170 RETVAL->dbp = NULL ;
1178 croak ("type parameter is not a reference") ;
1180 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
1181 if (svp && SvOK(*svp))
1182 action = (HV*) SvRV(*svp) ;
1184 croak("internal error") ;
1186 if (sv_isa(sv, "DB_File::HASHINFO"))
1190 croak("DB_File can only tie an associative array to a DB_HASH database") ;
1192 RETVAL->type = DB_HASH ;
1194 svp = hv_fetch(action, "hash", 4, FALSE);
1196 if (svp && SvOK(*svp))
1198 (void)dbp->set_h_hash(dbp, hash_cb) ;
1199 RETVAL->hash = newSVsv(*svp) ;
1202 svp = hv_fetch(action, "ffactor", 7, FALSE);
1204 (void)dbp->set_h_ffactor(dbp, my_SvUV32(*svp)) ;
1206 svp = hv_fetch(action, "nelem", 5, FALSE);
1208 (void)dbp->set_h_nelem(dbp, my_SvUV32(*svp)) ;
1210 svp = hv_fetch(action, "bsize", 5, FALSE);
1212 (void)dbp->set_pagesize(dbp, my_SvUV32(*svp));
1214 svp = hv_fetch(action, "cachesize", 9, FALSE);
1216 (void)dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
1218 svp = hv_fetch(action, "lorder", 6, FALSE);
1220 (void)dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
1224 else if (sv_isa(sv, "DB_File::BTREEINFO"))
1227 croak("DB_File can only tie an associative array to a DB_BTREE database");
1229 RETVAL->type = DB_BTREE ;
1231 svp = hv_fetch(action, "compare", 7, FALSE);
1232 if (svp && SvOK(*svp))
1234 (void)dbp->set_bt_compare(dbp, btree_compare) ;
1235 RETVAL->compare = newSVsv(*svp) ;
1238 svp = hv_fetch(action, "prefix", 6, FALSE);
1239 if (svp && SvOK(*svp))
1241 (void)dbp->set_bt_prefix(dbp, btree_prefix) ;
1242 RETVAL->prefix = newSVsv(*svp) ;
1245 svp = hv_fetch(action, "flags", 5, FALSE);
1247 (void)dbp->set_flags(dbp, my_SvUV32(*svp)) ;
1249 svp = hv_fetch(action, "cachesize", 9, FALSE);
1251 (void)dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
1253 svp = hv_fetch(action, "psize", 5, FALSE);
1255 (void)dbp->set_pagesize(dbp, my_SvUV32(*svp)) ;
1257 svp = hv_fetch(action, "lorder", 6, FALSE);
1259 (void)dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
1264 else if (sv_isa(sv, "DB_File::RECNOINFO"))
1269 croak("DB_File can only tie an array to a DB_RECNO database");
1271 RETVAL->type = DB_RECNO ;
1273 svp = hv_fetch(action, "flags", 5, FALSE);
1275 int flags = SvIV(*svp) ;
1276 /* remove FIXDLEN, if present */
1277 if (flags & DB_FIXEDLEN) {
1279 flags &= ~DB_FIXEDLEN ;
1283 svp = hv_fetch(action, "cachesize", 9, FALSE);
1285 status = dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
1288 svp = hv_fetch(action, "psize", 5, FALSE);
1290 status = dbp->set_pagesize(dbp, my_SvUV32(*svp)) ;
1293 svp = hv_fetch(action, "lorder", 6, FALSE);
1295 status = dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
1298 svp = hv_fetch(action, "bval", 4, FALSE);
1299 if (svp && SvOK(*svp))
1303 value = (int)*SvPV(*svp, n_a) ;
1305 value = (int)SvIV(*svp) ;
1308 status = dbp->set_re_pad(dbp, value) ;
1311 status = dbp->set_re_delim(dbp, value) ;
1317 svp = hv_fetch(action, "reclen", 6, FALSE);
1319 u_int32_t len = my_SvUV32(*svp) ;
1320 status = dbp->set_re_len(dbp, len) ;
1325 status = dbp->set_re_source(dbp, name) ;
1329 svp = hv_fetch(action, "bfname", 6, FALSE);
1330 if (svp && SvOK(*svp)) {
1331 char * ptr = SvPV(*svp,n_a) ;
1332 name = (char*) n_a ? ptr : NULL ;
1338 status = dbp->set_flags(dbp, (u_int32_t)DB_RENUMBER) ;
1341 (void)dbp->set_flags(dbp, (u_int32_t)flags) ;
1346 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1350 u_int32_t Flags = 0 ;
1353 /* Map 1.x flags to 3.x flags */
1354 if ((flags & O_CREAT) == O_CREAT)
1355 Flags |= DB_CREATE ;
1358 if (flags == O_RDONLY)
1360 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1362 Flags |= DB_RDONLY ;
1365 if ((flags & O_TRUNC) == O_TRUNC)
1366 Flags |= DB_TRUNCATE ;
1369 status = (RETVAL->dbp->open)(RETVAL->dbp, name, NULL, RETVAL->type,
1371 /* printf("open returned %d %s\n", status, db_strerror(status)) ; */
1374 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1376 /* printf("cursor returned %d %s\n", status, db_strerror(status)) ; */
1379 RETVAL->dbp = NULL ;
1385 #endif /* Berkeley DB Version > 2 */
1387 } /* ParseOpenInfo */
1390 #include "constants.h"
1392 MODULE = DB_File PACKAGE = DB_File PREFIX = db_
1394 INCLUDE: constants.xs
1399 __getBerkeleyDBInfo() ;
1402 empty.data = &zero ;
1403 empty.size = sizeof(recno_t) ;
1409 db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
1416 char * name = (char *) NULL ;
1417 SV * sv = (SV *) NULL ;
1420 if (items >= 3 && SvOK(ST(2)))
1421 name = (char*) SvPV(ST(2), n_a) ;
1426 RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
1427 if (RETVAL->dbp == NULL)
1442 SvREFCNT_dec(db->hash) ;
1444 SvREFCNT_dec(db->compare) ;
1446 SvREFCNT_dec(db->prefix) ;
1447 #ifdef DBM_FILTERING
1448 if (db->filter_fetch_key)
1449 SvREFCNT_dec(db->filter_fetch_key) ;
1450 if (db->filter_store_key)
1451 SvREFCNT_dec(db->filter_store_key) ;
1452 if (db->filter_fetch_value)
1453 SvREFCNT_dec(db->filter_fetch_value) ;
1454 if (db->filter_store_value)
1455 SvREFCNT_dec(db->filter_store_value) ;
1456 #endif /* DBM_FILTERING */
1458 #ifdef DB_VERSION_MAJOR
1465 db_DELETE(db, key, flags=0)
1487 RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
1493 db_FETCH(db, key, flags=0)
1506 /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */
1507 RETVAL = db_get(db, key, value, flags) ;
1508 ST(0) = sv_newmortal();
1509 OutputValue(ST(0), value)
1513 db_STORE(db, key, value, flags=0)
1538 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1539 ST(0) = sv_newmortal();
1540 OutputKey(ST(0), key) ;
1546 DBTKEY key = NO_INIT
1557 RETVAL = do_SEQ(db, key, value, R_NEXT) ;
1558 ST(0) = sv_newmortal();
1559 OutputKey(ST(0), key) ;
1563 # These would be nice for RECNO
1583 #ifdef DB_VERSION_MAJOR
1584 /* get the first value */
1585 RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1590 for (i = items-1 ; i > 0 ; --i)
1592 value.data = SvPV(ST(i), n_a) ;
1596 key.size = sizeof(int) ;
1597 #ifdef DB_VERSION_MAJOR
1598 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1600 RETVAL = (db->dbp->put)(db->dbp, &key, &value, R_IBEFORE) ;
1626 /* First get the final value */
1627 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1628 ST(0) = sv_newmortal();
1632 /* the call to del will trash value, so take a copy now */
1633 OutputValue(ST(0), value) ;
1634 RETVAL = db_del(db, key, R_CURSOR) ;
1636 sv_setsv(ST(0), &PL_sv_undef);
1656 /* get the first value */
1657 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1658 ST(0) = sv_newmortal();
1662 /* the call to del will trash value, so take a copy now */
1663 OutputValue(ST(0), value) ;
1664 RETVAL = db_del(db, key, R_CURSOR) ;
1666 sv_setsv (ST(0), &PL_sv_undef) ;
1689 /* Set the Cursor to the Last element */
1690 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1691 #ifndef DB_VERSION_MAJOR
1696 keyval = *(int*)key.data ;
1699 for (i = 1 ; i < items ; ++i)
1701 value.data = SvPV(ST(i), n_a) ;
1704 key.data = &keyval ;
1705 key.size = sizeof(int) ;
1706 RETVAL = (Db->put)(Db, TXN &key, &value, 0) ;
1720 ALIAS: FETCHSIZE = 1
1723 RETVAL = GetArrayLength(aTHX_ db) ;
1729 # Now provide an interface to the rest of the DB functionality
1733 db_del(db, key, flags=0)
1741 RETVAL = db_del(db, key, flags) ;
1742 #ifdef DB_VERSION_MAJOR
1745 else if (RETVAL == DB_NOTFOUND)
1753 db_get(db, key, value, flags=0)
1763 RETVAL = db_get(db, key, value, flags) ;
1764 #ifdef DB_VERSION_MAJOR
1767 else if (RETVAL == DB_NOTFOUND)
1775 db_put(db, key, value, flags=0)
1784 RETVAL = db_put(db, key, value, flags) ;
1785 #ifdef DB_VERSION_MAJOR
1788 else if (RETVAL == DB_KEYEXIST)
1793 key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
1802 #ifdef DB_VERSION_MAJOR
1806 status = (db->in_memory
1808 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
1813 RETVAL = (db->in_memory
1815 : ((db->dbp)->fd)(db->dbp) ) ;
1821 db_sync(db, flags=0)
1828 RETVAL = db_sync(db, flags) ;
1829 #ifdef DB_VERSION_MAJOR
1838 db_seq(db, key, value, flags)
1848 RETVAL = db_seq(db, key, value, flags);
1849 #ifdef DB_VERSION_MAJOR
1852 else if (RETVAL == DB_NOTFOUND)
1860 #ifdef DBM_FILTERING
1862 #define setFilter(type) \
1865 RETVAL = sv_mortalcopy(db->type) ; \
1867 if (db->type && (code == &PL_sv_undef)) { \
1868 SvREFCNT_dec(db->type) ; \
1873 sv_setsv(db->type, code) ; \
1875 db->type = newSVsv(code) ; \
1881 filter_fetch_key(db, code)
1884 SV * RETVAL = &PL_sv_undef ;
1886 setFilter(filter_fetch_key) ;
1889 filter_store_key(db, code)
1892 SV * RETVAL = &PL_sv_undef ;
1894 setFilter(filter_store_key) ;
1897 filter_fetch_value(db, code)
1900 SV * RETVAL = &PL_sv_undef ;
1902 setFilter(filter_fetch_value) ;
1905 filter_store_value(db, code)
1908 SV * RETVAL = &PL_sv_undef ;
1910 setFilter(filter_store_value) ;
1912 #endif /* DBM_FILTERING */