3 DB_File.xs -- Perl 5 interface to Berkeley DB
5 written by Paul Marquess <pmqs@cpan.org>
6 last modified 4th February 2007
9 All comments/suggestions/problems are welcome
11 Copyright (c) 1995-2008 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
117 1.814 - C++ casting fixes
121 #define PERL_NO_GET_CONTEXT
130 /* Mention DB_VERSION_MAJOR_CFG, DB_VERSION_MINOR_CFG, and
131 DB_VERSION_PATCH_CFG here so that Configure pulls them all in. */
133 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
134 * shortly #included by the <db.h>) __attribute__ to the possibly
135 * already defined __attribute__, for example by GNUC or by Perl. */
137 /* #if DB_VERSION_MAJOR_CFG < 2 */
138 #ifndef DB_VERSION_MAJOR
139 # undef __attribute__
148 /* Wall starts with 5.7.x */
150 #if PERL_REVISION > 5 || (PERL_REVISION == 5 && PERL_VERSION >= 7)
152 /* Since we dropped the gccish definition of __attribute__ we will want
153 * to redefine dNOOP, however (so that dTHX continues to work). Yes,
154 * all this means that we can't do attribute checking on the DB_File,
156 # ifndef DB_VERSION_MAJOR
159 # define dNOOP extern int Perl___notused
161 /* Ditto for dXSARGS. */
165 I32 ax = mark - PL_stack_base + 1; \
166 I32 items = sp - mark
170 /* avoid -Wall; DB_File xsubs never make use of `ix' setup for ALIASes */
172 # define dXSI32 dNOOP
174 #endif /* Perl >= 5.7 */
181 # define Trace(x) printf x
187 #define DBT_clear(x) Zero(&x, 1, DBT) ;
189 #ifdef DB_VERSION_MAJOR
191 #if DB_VERSION_MAJOR == 2
192 # define BERKELEY_DB_1_OR_2
195 #if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 2)
196 # define AT_LEAST_DB_3_2
199 #if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 3)
200 # define AT_LEAST_DB_3_3
203 #if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 1)
204 # define AT_LEAST_DB_4_1
207 #if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 3)
208 # define AT_LEAST_DB_4_3
211 #ifdef AT_LEAST_DB_3_3
215 /* map version 2 features & constants onto their version 1 equivalent */
220 #define DB_Prefix_t size_t
225 #define DB_Hash_t u_int32_t
227 /* DBTYPE stays the same */
228 /* HASHINFO, RECNOINFO and BTREEINFO map to DB_INFO */
229 #if DB_VERSION_MAJOR == 2
230 typedef DB_INFO INFO ;
231 #else /* DB_VERSION_MAJOR > 2 */
232 # define DB_FIXEDLEN (0x8000)
233 #endif /* DB_VERSION_MAJOR == 2 */
235 /* version 2 has db_recno_t in place of recno_t */
236 typedef db_recno_t recno_t;
239 #define R_CURSOR DB_SET_RANGE
240 #define R_FIRST DB_FIRST
241 #define R_IAFTER DB_AFTER
242 #define R_IBEFORE DB_BEFORE
243 #define R_LAST DB_LAST
244 #define R_NEXT DB_NEXT
245 #define R_NOOVERWRITE DB_NOOVERWRITE
246 #define R_PREV DB_PREV
248 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
249 # define R_SETCURSOR 0x800000
251 # define R_SETCURSOR (-100)
254 #define R_RECNOSYNC 0
255 #define R_FIXEDLEN DB_FIXEDLEN
259 #define db_HA_hash h_hash
260 #define db_HA_ffactor h_ffactor
261 #define db_HA_nelem h_nelem
262 #define db_HA_bsize db_pagesize
263 #define db_HA_cachesize db_cachesize
264 #define db_HA_lorder db_lorder
266 #define db_BT_compare bt_compare
267 #define db_BT_prefix bt_prefix
268 #define db_BT_flags flags
269 #define db_BT_psize db_pagesize
270 #define db_BT_cachesize db_cachesize
271 #define db_BT_lorder db_lorder
272 #define db_BT_maxkeypage
273 #define db_BT_minkeypage
276 #define db_RE_reclen re_len
277 #define db_RE_flags flags
278 #define db_RE_bval re_pad
279 #define db_RE_bfname re_source
280 #define db_RE_psize db_pagesize
281 #define db_RE_cachesize db_cachesize
282 #define db_RE_lorder db_lorder
286 #define do_SEQ(db, key, value, flag) (db->cursor->c_get)(db->cursor, &key, &value, flag)
289 #define DBT_flags(x) x.flags = 0
290 #define DB_flags(x, v) x |= v
292 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
293 # define flagSet(flags, bitmask) ((flags) & (bitmask))
295 # define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask))
298 #else /* db version 1.x */
300 #define BERKELEY_DB_1
301 #define BERKELEY_DB_1_OR_2
314 # define DB_Prefix_t mDB_Prefix_t
321 # define DB_Hash_t mDB_Hash_t
324 #define db_HA_hash hash.hash
325 #define db_HA_ffactor hash.ffactor
326 #define db_HA_nelem hash.nelem
327 #define db_HA_bsize hash.bsize
328 #define db_HA_cachesize hash.cachesize
329 #define db_HA_lorder hash.lorder
331 #define db_BT_compare btree.compare
332 #define db_BT_prefix btree.prefix
333 #define db_BT_flags btree.flags
334 #define db_BT_psize btree.psize
335 #define db_BT_cachesize btree.cachesize
336 #define db_BT_lorder btree.lorder
337 #define db_BT_maxkeypage btree.maxkeypage
338 #define db_BT_minkeypage btree.minkeypage
340 #define db_RE_reclen recno.reclen
341 #define db_RE_flags recno.flags
342 #define db_RE_bval recno.bval
343 #define db_RE_bfname recno.bfname
344 #define db_RE_psize recno.psize
345 #define db_RE_cachesize recno.cachesize
346 #define db_RE_lorder recno.lorder
350 #define do_SEQ(db, key, value, flag) (db->dbp->seq)(db->dbp, &key, &value, flag)
352 #define DB_flags(x, v)
353 #define flagSet(flags, bitmask) ((flags) & (bitmask))
355 #endif /* db version 1 */
359 #define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, TXN &key, 0)
360 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, 0)
361 #define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, 0)
363 #define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
364 #define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
366 #ifdef DB_VERSION_MAJOR
367 #define db_DESTROY(db) (!db->aborted && ( db->cursor->c_close(db->cursor),\
368 (db->dbp->close)(db->dbp, 0) ))
369 #define db_close(db) ((db->dbp)->close)(db->dbp, 0)
370 #define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \
371 ? ((db->cursor)->c_del)(db->cursor, 0) \
372 : ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
374 #else /* ! DB_VERSION_MAJOR */
376 #define db_DESTROY(db) (!db->aborted && ((db->dbp)->close)(db->dbp))
377 #define db_close(db) ((db->dbp)->close)(db->dbp)
378 #define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
379 #define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
381 #endif /* ! DB_VERSION_MAJOR */
384 #define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags)
397 #ifdef BERKELEY_DB_1_OR_2
400 #ifdef DB_VERSION_MAJOR
403 SV * filter_fetch_key ;
404 SV * filter_store_key ;
405 SV * filter_fetch_value ;
406 SV * filter_store_value ;
411 typedef DB_File_type * DB_File ;
414 #define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (const char *)""), s)
416 #define OutputValue(arg, name) \
417 { if (RETVAL == 0) { \
419 my_sv_setpvn(arg, (const char *)name.data, name.size) ; \
423 DBM_ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \
427 #define OutputKey(arg, name) \
431 if (db->type != DB_RECNO) { \
432 my_sv_setpvn(arg, (const char *)name.data, name.size); \
435 sv_setiv(arg, (I32)*(I32*)name.data - 1); \
439 DBM_ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \
443 #define my_SvUV32(sv) ((u_int32_t)SvUV(sv))
446 extern void __getBerkeleyDBInfo(void);
449 /* Internal Global Data */
451 #define MY_CXT_KEY "DB_File::_guts" XS_VERSION
462 #define Value (MY_CXT.x_Value)
463 #define zero (MY_CXT.x_zero)
464 #define CurrentDB (MY_CXT.x_CurrentDB)
465 #define empty (MY_CXT.x_empty)
467 #define ERR_BUFF "DB_File::Error"
469 #ifdef DB_VERSION_MAJOR
473 db_put(DB_File db, DBTKEY key, DBT value, u_int flags)
475 db_put(db, key, value, flags)
484 if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) {
488 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
489 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor) != 0)
491 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor, 0) != 0)
495 memset(&l_key, 0, sizeof(l_key));
496 l_key.data = key.data;
497 l_key.size = key.size;
498 memset(&l_value, 0, sizeof(l_value));
499 l_value.data = value.data;
500 l_value.size = value.size;
502 if ( temp_cursor->c_get(temp_cursor, &l_key, &l_value, DB_SET) != 0) {
503 (void)temp_cursor->c_close(temp_cursor);
507 status = temp_cursor->c_put(temp_cursor, &key, &value, flags);
508 (void)temp_cursor->c_close(temp_cursor);
514 if (flagSet(flags, R_CURSOR)) {
515 return ((db->cursor)->c_put)(db->cursor, &key, &value, DB_CURRENT);
518 if (flagSet(flags, R_SETCURSOR)) {
519 if ((db->dbp)->put(db->dbp, NULL, &key, &value, 0) != 0)
521 return ((db->cursor)->c_get)(db->cursor, &key, &value, DB_SET_RANGE);
525 return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
529 #endif /* DB_VERSION_MAJOR */
539 #ifdef AT_LEAST_DB_3_2
542 btree_compare(DB * db, const DBT *key1, const DBT *key2)
544 btree_compare(db, key1, key2)
548 #endif /* CAN_PROTOTYPE */
550 #else /* Berkeley DB < 3.2 */
553 btree_compare(const DBT *key1, const DBT *key2)
555 btree_compare(key1, key2)
568 void * data1, * data2 ;
573 if (CurrentDB->in_compare) {
575 croak ("DB_File btree_compare: recursion detected\n") ;
578 data1 = (char *) key1->data ;
579 data2 = (char *) key2->data ;
582 /* As newSVpv will assume that the data pointer is a null terminated C
583 string if the size parameter is 0, make sure that data points to an
584 empty string if the length is 0
595 CurrentDB->in_compare = FALSE;
596 SAVEINT(CurrentDB->in_compare);
597 CurrentDB->in_compare = TRUE;
601 PUSHs(sv_2mortal(newSVpvn((const char*)data1,key1->size)));
602 PUSHs(sv_2mortal(newSVpvn((const char*)data2,key2->size)));
605 count = perl_call_sv(CurrentDB->compare, G_SCALAR);
611 croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
625 #ifdef AT_LEAST_DB_3_2
628 btree_prefix(DB * db, const DBT *key1, const DBT *key2)
630 btree_prefix(db, key1, key2)
636 #else /* Berkeley DB < 3.2 */
639 btree_prefix(const DBT *key1, const DBT *key2)
641 btree_prefix(key1, key2)
653 char * data1, * data2 ;
657 if (CurrentDB->in_prefix){
659 croak ("DB_File btree_prefix: recursion detected\n") ;
662 data1 = (char *) key1->data ;
663 data2 = (char *) key2->data ;
666 /* As newSVpv will assume that the data pointer is a null terminated C
667 string if the size parameter is 0, make sure that data points to an
668 empty string if the length is 0
679 CurrentDB->in_prefix = FALSE;
680 SAVEINT(CurrentDB->in_prefix);
681 CurrentDB->in_prefix = TRUE;
685 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
686 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
689 count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
695 croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
709 # define HASH_CB_SIZE_TYPE size_t
711 # define HASH_CB_SIZE_TYPE u_int32_t
715 #ifdef AT_LEAST_DB_3_2
718 hash_cb(DB * db, const void *data, u_int32_t size)
720 hash_cb(db, data, size)
723 HASH_CB_SIZE_TYPE size ;
726 #else /* Berkeley DB < 3.2 */
729 hash_cb(const void *data, HASH_CB_SIZE_TYPE size)
733 HASH_CB_SIZE_TYPE size ;
746 if (CurrentDB->in_hash){
748 croak ("DB_File hash callback: recursion detected\n") ;
756 /* DGH - Next two lines added to fix corrupted stack problem */
760 CurrentDB->in_hash = FALSE;
761 SAVEINT(CurrentDB->in_hash);
762 CurrentDB->in_hash = TRUE;
767 XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
770 count = perl_call_sv(CurrentDB->hash, G_SCALAR);
776 croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
791 #ifdef AT_LEAST_DB_4_3
792 db_errcall_cb(const DB_ENV* dbenv, const char * db_errpfx, const char * buffer)
794 db_errcall_cb(const char * db_errpfx, char * buffer)
800 SV * sv = perl_get_sv(ERR_BUFF, FALSE) ;
803 sv_setpvf(sv, "%s: %s", db_errpfx, buffer) ;
805 sv_setpv(sv, buffer) ;
810 #if defined(TRACE) && defined(BERKELEY_DB_1_OR_2)
814 PrintHash(INFO *hash)
820 printf ("HASH Info\n") ;
821 printf (" hash = %s\n",
822 (hash->db_HA_hash != NULL ? "redefined" : "default")) ;
823 printf (" bsize = %d\n", hash->db_HA_bsize) ;
824 printf (" ffactor = %d\n", hash->db_HA_ffactor) ;
825 printf (" nelem = %d\n", hash->db_HA_nelem) ;
826 printf (" cachesize = %d\n", hash->db_HA_cachesize) ;
827 printf (" lorder = %d\n", hash->db_HA_lorder) ;
833 PrintRecno(INFO *recno)
839 printf ("RECNO Info\n") ;
840 printf (" flags = %d\n", recno->db_RE_flags) ;
841 printf (" cachesize = %d\n", recno->db_RE_cachesize) ;
842 printf (" psize = %d\n", recno->db_RE_psize) ;
843 printf (" lorder = %d\n", recno->db_RE_lorder) ;
844 printf (" reclen = %lu\n", (unsigned long)recno->db_RE_reclen) ;
845 printf (" bval = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
846 printf (" bfname = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
851 PrintBtree(INFO *btree)
857 printf ("BTREE Info\n") ;
858 printf (" compare = %s\n",
859 (btree->db_BT_compare ? "redefined" : "default")) ;
860 printf (" prefix = %s\n",
861 (btree->db_BT_prefix ? "redefined" : "default")) ;
862 printf (" flags = %d\n", btree->db_BT_flags) ;
863 printf (" cachesize = %d\n", btree->db_BT_cachesize) ;
864 printf (" psize = %d\n", btree->db_BT_psize) ;
865 #ifndef DB_VERSION_MAJOR
866 printf (" maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
867 printf (" minkeypage = %d\n", btree->db_BT_minkeypage) ;
869 printf (" lorder = %d\n", btree->db_BT_lorder) ;
874 #define PrintRecno(recno)
875 #define PrintHash(hash)
876 #define PrintBtree(btree)
883 GetArrayLength(pTHX_ DB_File db)
895 RETVAL = do_SEQ(db, key, value, R_LAST) ;
897 RETVAL = *(I32 *)key.data ;
898 else /* No key means empty file */
901 return ((I32)RETVAL) ;
906 GetRecnoKey(pTHX_ DB_File db, I32 value)
908 GetRecnoKey(db, value)
914 /* Get the length of the array */
915 I32 length = GetArrayLength(aTHX_ db) ;
917 /* check for attempt to write before start of array */
918 if (length + value + 1 <= 0) {
920 croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
923 value = length + value + 1 ;
934 ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv)
936 ParseOpenInfo(isHASH, name, flags, mode, sv)
945 #ifdef BERKELEY_DB_1_OR_2 /* Berkeley DB Version 1 or 2 */
949 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
950 void * openinfo = NULL ;
951 INFO * info = &RETVAL->info ;
956 printf("In ParseOpenInfo name=[%s] flags=[%d] mode=[%d] SV NULL=[%d]\n",
957 name, flags, mode, sv == NULL) ;
959 Zero(RETVAL, 1, DB_File_type) ;
961 /* Default to HASH */
962 RETVAL->filtering = 0 ;
963 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
964 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
965 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
966 RETVAL->type = DB_HASH ;
968 /* DGH - Next line added to avoid SEGV on existing hash DB */
971 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
972 RETVAL->in_memory = (name == NULL) ;
977 croak ("type parameter is not a reference") ;
979 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
980 if (svp && SvOK(*svp))
981 action = (HV*) SvRV(*svp) ;
983 croak("internal error") ;
985 if (sv_isa(sv, "DB_File::HASHINFO"))
989 croak("DB_File can only tie an associative array to a DB_HASH database") ;
991 RETVAL->type = DB_HASH ;
992 openinfo = (void*)info ;
994 svp = hv_fetch(action, "hash", 4, FALSE);
996 if (svp && SvOK(*svp))
998 info->db_HA_hash = hash_cb ;
999 RETVAL->hash = newSVsv(*svp) ;
1002 info->db_HA_hash = NULL ;
1004 svp = hv_fetch(action, "ffactor", 7, FALSE);
1005 info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
1007 svp = hv_fetch(action, "nelem", 5, FALSE);
1008 info->db_HA_nelem = svp ? SvIV(*svp) : 0;
1010 svp = hv_fetch(action, "bsize", 5, FALSE);
1011 info->db_HA_bsize = svp ? SvIV(*svp) : 0;
1013 svp = hv_fetch(action, "cachesize", 9, FALSE);
1014 info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
1016 svp = hv_fetch(action, "lorder", 6, FALSE);
1017 info->db_HA_lorder = svp ? SvIV(*svp) : 0;
1021 else if (sv_isa(sv, "DB_File::BTREEINFO"))
1024 croak("DB_File can only tie an associative array to a DB_BTREE database");
1026 RETVAL->type = DB_BTREE ;
1027 openinfo = (void*)info ;
1029 svp = hv_fetch(action, "compare", 7, FALSE);
1030 if (svp && SvOK(*svp))
1032 info->db_BT_compare = btree_compare ;
1033 RETVAL->compare = newSVsv(*svp) ;
1036 info->db_BT_compare = NULL ;
1038 svp = hv_fetch(action, "prefix", 6, FALSE);
1039 if (svp && SvOK(*svp))
1041 info->db_BT_prefix = btree_prefix ;
1042 RETVAL->prefix = newSVsv(*svp) ;
1045 info->db_BT_prefix = NULL ;
1047 svp = hv_fetch(action, "flags", 5, FALSE);
1048 info->db_BT_flags = svp ? SvIV(*svp) : 0;
1050 svp = hv_fetch(action, "cachesize", 9, FALSE);
1051 info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
1053 #ifndef DB_VERSION_MAJOR
1054 svp = hv_fetch(action, "minkeypage", 10, FALSE);
1055 info->btree.minkeypage = svp ? SvIV(*svp) : 0;
1057 svp = hv_fetch(action, "maxkeypage", 10, FALSE);
1058 info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
1061 svp = hv_fetch(action, "psize", 5, FALSE);
1062 info->db_BT_psize = svp ? SvIV(*svp) : 0;
1064 svp = hv_fetch(action, "lorder", 6, FALSE);
1065 info->db_BT_lorder = svp ? SvIV(*svp) : 0;
1070 else if (sv_isa(sv, "DB_File::RECNOINFO"))
1073 croak("DB_File can only tie an array to a DB_RECNO database");
1075 RETVAL->type = DB_RECNO ;
1076 openinfo = (void *)info ;
1078 info->db_RE_flags = 0 ;
1080 svp = hv_fetch(action, "flags", 5, FALSE);
1081 info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
1083 svp = hv_fetch(action, "reclen", 6, FALSE);
1084 info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
1086 svp = hv_fetch(action, "cachesize", 9, FALSE);
1087 info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
1089 svp = hv_fetch(action, "psize", 5, FALSE);
1090 info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
1092 svp = hv_fetch(action, "lorder", 6, FALSE);
1093 info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
1095 #ifdef DB_VERSION_MAJOR
1096 info->re_source = name ;
1099 svp = hv_fetch(action, "bfname", 6, FALSE);
1100 if (svp && SvOK(*svp)) {
1101 char * ptr = SvPV(*svp,n_a) ;
1102 #ifdef DB_VERSION_MAJOR
1103 name = (char*) n_a ? ptr : NULL ;
1105 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
1109 #ifdef DB_VERSION_MAJOR
1112 info->db_RE_bfname = NULL ;
1115 svp = hv_fetch(action, "bval", 4, FALSE);
1116 #ifdef DB_VERSION_MAJOR
1117 if (svp && SvOK(*svp))
1121 value = (int)*SvPV(*svp, n_a) ;
1123 value = SvIV(*svp) ;
1125 if (info->flags & DB_FIXEDLEN) {
1126 info->re_pad = value ;
1127 info->flags |= DB_PAD ;
1130 info->re_delim = value ;
1131 info->flags |= DB_DELIMITER ;
1136 if (svp && SvOK(*svp))
1139 info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
1141 info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
1142 DB_flags(info->flags, DB_DELIMITER) ;
1147 if (info->db_RE_flags & R_FIXEDLEN)
1148 info->db_RE_bval = (u_char) ' ' ;
1150 info->db_RE_bval = (u_char) '\n' ;
1151 DB_flags(info->flags, DB_DELIMITER) ;
1156 info->flags |= DB_RENUMBER ;
1162 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1166 /* OS2 Specific Code */
1170 #endif /* __EMX__ */
1173 #ifdef DB_VERSION_MAJOR
1179 /* Map 1.x flags to 2.x flags */
1180 if ((flags & O_CREAT) == O_CREAT)
1181 Flags |= DB_CREATE ;
1184 if (flags == O_RDONLY)
1186 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1188 Flags |= DB_RDONLY ;
1191 if ((flags & O_TRUNC) == O_TRUNC)
1192 Flags |= DB_TRUNCATE ;
1195 status = db_open(name, RETVAL->type, Flags, mode, NULL, (DB_INFO*)openinfo, &RETVAL->dbp) ;
1197 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
1198 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
1200 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1205 RETVAL->dbp = NULL ;
1210 #if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2
1211 RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ;
1213 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
1214 #endif /* DB_LIBRARY_COMPATIBILITY_API */
1220 #else /* Berkeley DB Version > 2 */
1224 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
1230 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
1231 Zero(RETVAL, 1, DB_File_type) ;
1233 /* Default to HASH */
1234 RETVAL->filtering = 0 ;
1235 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
1236 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
1237 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
1238 RETVAL->type = DB_HASH ;
1240 /* DGH - Next line added to avoid SEGV on existing hash DB */
1243 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
1244 RETVAL->in_memory = (name == NULL) ;
1246 status = db_create(&RETVAL->dbp, NULL,0) ;
1247 /* printf("db_create returned %d %s\n", status, db_strerror(status)) ; */
1249 RETVAL->dbp = NULL ;
1255 RETVAL->dbp->set_errcall(RETVAL->dbp, db_errcall_cb) ;
1260 croak ("type parameter is not a reference") ;
1262 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
1263 if (svp && SvOK(*svp))
1264 action = (HV*) SvRV(*svp) ;
1266 croak("internal error") ;
1268 if (sv_isa(sv, "DB_File::HASHINFO"))
1272 croak("DB_File can only tie an associative array to a DB_HASH database") ;
1274 RETVAL->type = DB_HASH ;
1276 svp = hv_fetch(action, "hash", 4, FALSE);
1278 if (svp && SvOK(*svp))
1280 (void)dbp->set_h_hash(dbp, hash_cb) ;
1281 RETVAL->hash = newSVsv(*svp) ;
1284 svp = hv_fetch(action, "ffactor", 7, FALSE);
1286 (void)dbp->set_h_ffactor(dbp, my_SvUV32(*svp)) ;
1288 svp = hv_fetch(action, "nelem", 5, FALSE);
1290 (void)dbp->set_h_nelem(dbp, my_SvUV32(*svp)) ;
1292 svp = hv_fetch(action, "bsize", 5, FALSE);
1294 (void)dbp->set_pagesize(dbp, my_SvUV32(*svp));
1296 svp = hv_fetch(action, "cachesize", 9, FALSE);
1298 (void)dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
1300 svp = hv_fetch(action, "lorder", 6, FALSE);
1302 (void)dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
1306 else if (sv_isa(sv, "DB_File::BTREEINFO"))
1309 croak("DB_File can only tie an associative array to a DB_BTREE database");
1311 RETVAL->type = DB_BTREE ;
1313 svp = hv_fetch(action, "compare", 7, FALSE);
1314 if (svp && SvOK(*svp))
1316 (void)dbp->set_bt_compare(dbp, btree_compare) ;
1317 RETVAL->compare = newSVsv(*svp) ;
1320 svp = hv_fetch(action, "prefix", 6, FALSE);
1321 if (svp && SvOK(*svp))
1323 (void)dbp->set_bt_prefix(dbp, btree_prefix) ;
1324 RETVAL->prefix = newSVsv(*svp) ;
1327 svp = hv_fetch(action, "flags", 5, FALSE);
1329 (void)dbp->set_flags(dbp, my_SvUV32(*svp)) ;
1331 svp = hv_fetch(action, "cachesize", 9, FALSE);
1333 (void)dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
1335 svp = hv_fetch(action, "psize", 5, FALSE);
1337 (void)dbp->set_pagesize(dbp, my_SvUV32(*svp)) ;
1339 svp = hv_fetch(action, "lorder", 6, FALSE);
1341 (void)dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
1346 else if (sv_isa(sv, "DB_File::RECNOINFO"))
1351 croak("DB_File can only tie an array to a DB_RECNO database");
1353 RETVAL->type = DB_RECNO ;
1355 svp = hv_fetch(action, "flags", 5, FALSE);
1357 int flags = SvIV(*svp) ;
1358 /* remove FIXDLEN, if present */
1359 if (flags & DB_FIXEDLEN) {
1361 flags &= ~DB_FIXEDLEN ;
1365 svp = hv_fetch(action, "cachesize", 9, FALSE);
1367 status = dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
1370 svp = hv_fetch(action, "psize", 5, FALSE);
1372 status = dbp->set_pagesize(dbp, my_SvUV32(*svp)) ;
1375 svp = hv_fetch(action, "lorder", 6, FALSE);
1377 status = dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
1380 svp = hv_fetch(action, "bval", 4, FALSE);
1381 if (svp && SvOK(*svp))
1385 value = (int)*SvPV(*svp, n_a) ;
1387 value = (int)SvIV(*svp) ;
1390 status = dbp->set_re_pad(dbp, value) ;
1393 status = dbp->set_re_delim(dbp, value) ;
1399 svp = hv_fetch(action, "reclen", 6, FALSE);
1401 u_int32_t len = my_SvUV32(*svp) ;
1402 status = dbp->set_re_len(dbp, len) ;
1407 status = dbp->set_re_source(dbp, name) ;
1411 svp = hv_fetch(action, "bfname", 6, FALSE);
1412 if (svp && SvOK(*svp)) {
1413 char * ptr = SvPV(*svp,n_a) ;
1414 name = (char*) n_a ? ptr : NULL ;
1420 status = dbp->set_flags(dbp, (u_int32_t)DB_RENUMBER) ;
1423 (void)dbp->set_flags(dbp, (u_int32_t)flags) ;
1428 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1432 u_int32_t Flags = 0 ;
1435 /* Map 1.x flags to 3.x flags */
1436 if ((flags & O_CREAT) == O_CREAT)
1437 Flags |= DB_CREATE ;
1440 if (flags == O_RDONLY)
1442 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1444 Flags |= DB_RDONLY ;
1447 if ((flags & O_TRUNC) == O_TRUNC)
1448 Flags |= DB_TRUNCATE ;
1451 #ifdef AT_LEAST_DB_4_4
1452 /* need this for recno */
1453 if ((flags & O_TRUNC) == O_TRUNC)
1454 Flags |= DB_CREATE ;
1457 #ifdef AT_LEAST_DB_4_1
1458 status = (RETVAL->dbp->open)(RETVAL->dbp, NULL, name, NULL, RETVAL->type,
1461 status = (RETVAL->dbp->open)(RETVAL->dbp, name, NULL, RETVAL->type,
1464 /* printf("open returned %d %s\n", status, db_strerror(status)) ; */
1468 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1470 /* printf("cursor returned %d %s\n", status, db_strerror(status)) ; */
1474 RETVAL->dbp = NULL ;
1480 #endif /* Berkeley DB Version > 2 */
1482 } /* ParseOpenInfo */
1485 #include "constants.h"
1487 MODULE = DB_File PACKAGE = DB_File PREFIX = db_
1489 INCLUDE: constants.xs
1497 SV * sv_err = perl_get_sv(ERR_BUFF, GV_ADD|GV_ADDMULTI) ;
1500 __getBerkeleyDBInfo() ;
1503 empty.data = &zero ;
1504 empty.size = sizeof(recno_t) ;
1510 db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
1517 char * name = (char *) NULL ;
1518 SV * sv = (SV *) NULL ;
1521 if (items >= 3 && SvOK(ST(2)))
1522 name = (char*) SvPV(ST(2), n_a) ;
1527 RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
1528 if (RETVAL->dbp == NULL) {
1543 Trace(("DESTROY %p\n", db));
1545 Trace(("DESTROY %p done\n", db));
1547 SvREFCNT_dec(db->hash) ;
1549 SvREFCNT_dec(db->compare) ;
1551 SvREFCNT_dec(db->prefix) ;
1552 if (db->filter_fetch_key)
1553 SvREFCNT_dec(db->filter_fetch_key) ;
1554 if (db->filter_store_key)
1555 SvREFCNT_dec(db->filter_store_key) ;
1556 if (db->filter_fetch_value)
1557 SvREFCNT_dec(db->filter_fetch_value) ;
1558 if (db->filter_store_value)
1559 SvREFCNT_dec(db->filter_store_value) ;
1561 #ifdef DB_VERSION_MAJOR
1568 db_DELETE(db, key, flags=0)
1590 RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
1596 db_FETCH(db, key, flags=0)
1609 RETVAL = db_get(db, key, value, flags) ;
1610 ST(0) = sv_newmortal();
1611 OutputValue(ST(0), value)
1615 db_STORE(db, key, value, flags=0)
1640 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1641 ST(0) = sv_newmortal();
1642 OutputKey(ST(0), key) ;
1648 DBTKEY key = NO_INIT
1659 RETVAL = do_SEQ(db, key, value, R_NEXT) ;
1660 ST(0) = sv_newmortal();
1661 OutputKey(ST(0), key) ;
1665 # These would be nice for RECNO
1685 #ifdef DB_VERSION_MAJOR
1686 /* get the first value */
1687 RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1692 for (i = items-1 ; i > 0 ; --i)
1694 DBM_ckFilter(ST(i), filter_store_value, "filter_store_value");
1695 value.data = SvPVbyte(ST(i), n_a) ;
1699 key.size = sizeof(int) ;
1700 #ifdef DB_VERSION_MAJOR
1701 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1703 RETVAL = (db->dbp->put)(db->dbp, &key, &value, R_IBEFORE) ;
1729 /* First get the final value */
1730 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1731 ST(0) = sv_newmortal();
1735 /* the call to del will trash value, so take a copy now */
1736 OutputValue(ST(0), value) ;
1737 RETVAL = db_del(db, key, R_CURSOR) ;
1739 sv_setsv(ST(0), &PL_sv_undef);
1759 /* get the first value */
1760 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1761 ST(0) = sv_newmortal();
1765 /* the call to del will trash value, so take a copy now */
1766 OutputValue(ST(0), value) ;
1767 RETVAL = db_del(db, key, R_CURSOR) ;
1769 sv_setsv (ST(0), &PL_sv_undef) ;
1792 /* Set the Cursor to the Last element */
1793 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1794 #ifndef DB_VERSION_MAJOR
1799 keyval = *(int*)key.data ;
1802 for (i = 1 ; i < items ; ++i)
1804 DBM_ckFilter(ST(i), filter_store_value, "filter_store_value");
1805 value.data = SvPVbyte(ST(i), n_a) ;
1808 key.data = &keyval ;
1809 key.size = sizeof(int) ;
1810 RETVAL = (Db->put)(Db, TXN &key, &value, 0) ;
1824 ALIAS: FETCHSIZE = 1
1827 RETVAL = GetArrayLength(aTHX_ db) ;
1833 # Now provide an interface to the rest of the DB functionality
1837 db_del(db, key, flags=0)
1845 RETVAL = db_del(db, key, flags) ;
1846 #ifdef DB_VERSION_MAJOR
1849 else if (RETVAL == DB_NOTFOUND)
1857 db_get(db, key, value, flags=0)
1867 RETVAL = db_get(db, key, value, flags) ;
1868 #ifdef DB_VERSION_MAJOR
1871 else if (RETVAL == DB_NOTFOUND)
1879 db_put(db, key, value, flags=0)
1888 RETVAL = db_put(db, key, value, flags) ;
1889 #ifdef DB_VERSION_MAJOR
1892 else if (RETVAL == DB_KEYEXIST)
1897 key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
1906 #ifdef DB_VERSION_MAJOR
1910 status = (db->in_memory
1912 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
1917 RETVAL = (db->in_memory
1919 : ((db->dbp)->fd)(db->dbp) ) ;
1925 db_sync(db, flags=0)
1932 RETVAL = db_sync(db, flags) ;
1933 #ifdef DB_VERSION_MAJOR
1942 db_seq(db, key, value, flags)
1952 RETVAL = db_seq(db, key, value, flags);
1953 #ifdef DB_VERSION_MAJOR
1956 else if (RETVAL == DB_NOTFOUND)
1965 filter_fetch_key(db, code)
1968 SV * RETVAL = &PL_sv_undef ;
1970 DBM_setFilter(db->filter_fetch_key, code) ;
1973 filter_store_key(db, code)
1976 SV * RETVAL = &PL_sv_undef ;
1978 DBM_setFilter(db->filter_store_key, code) ;
1981 filter_fetch_value(db, code)
1984 SV * RETVAL = &PL_sv_undef ;
1986 DBM_setFilter(db->filter_fetch_value, code) ;
1989 filter_store_value(db, code)
1992 SV * RETVAL = &PL_sv_undef ;
1994 DBM_setFilter(db->filter_store_value, code) ;