3 DB_File.xs -- Perl 5 interface to Berkeley DB
5 written by Paul Marquess <pmqs@cpan.org>
6 last modified 11th November 2005
9 All comments/suggestions/problems are welcome
11 Copyright (c) 1995-2005 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
120 #define PERL_NO_GET_CONTEXT
129 /* Mention DB_VERSION_MAJOR_CFG, DB_VERSION_MINOR_CFG, and
130 DB_VERSION_PATCH_CFG here so that Configure pulls them all in. */
132 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
133 * shortly #included by the <db.h>) __attribute__ to the possibly
134 * already defined __attribute__, for example by GNUC or by Perl. */
136 /* #if DB_VERSION_MAJOR_CFG < 2 */
137 #ifndef DB_VERSION_MAJOR
138 # undef __attribute__
147 /* Wall starts with 5.7.x */
149 #if PERL_REVISION > 5 || (PERL_REVISION == 5 && PERL_VERSION >= 7)
151 /* Since we dropped the gccish definition of __attribute__ we will want
152 * to redefine dNOOP, however (so that dTHX continues to work). Yes,
153 * all this means that we can't do attribute checking on the DB_File,
155 # ifndef DB_VERSION_MAJOR
158 # define dNOOP extern int Perl___notused
160 /* Ditto for dXSARGS. */
164 I32 ax = mark - PL_stack_base + 1; \
165 I32 items = sp - mark
169 /* avoid -Wall; DB_File xsubs never make use of `ix' setup for ALIASes */
171 # define dXSI32 dNOOP
173 #endif /* Perl >= 5.7 */
180 # define Trace(x) printf x
186 #define DBT_clear(x) Zero(&x, 1, DBT) ;
188 #ifdef DB_VERSION_MAJOR
190 #if DB_VERSION_MAJOR == 2
191 # define BERKELEY_DB_1_OR_2
194 #if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 2)
195 # define AT_LEAST_DB_3_2
198 #if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 3)
199 # define AT_LEAST_DB_3_3
202 #if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 1)
203 # define AT_LEAST_DB_4_1
206 #if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 3)
207 # define AT_LEAST_DB_4_3
210 #ifdef AT_LEAST_DB_3_3
214 /* map version 2 features & constants onto their version 1 equivalent */
219 #define DB_Prefix_t size_t
224 #define DB_Hash_t u_int32_t
226 /* DBTYPE stays the same */
227 /* HASHINFO, RECNOINFO and BTREEINFO map to DB_INFO */
228 #if DB_VERSION_MAJOR == 2
229 typedef DB_INFO INFO ;
230 #else /* DB_VERSION_MAJOR > 2 */
231 # define DB_FIXEDLEN (0x8000)
232 #endif /* DB_VERSION_MAJOR == 2 */
234 /* version 2 has db_recno_t in place of recno_t */
235 typedef db_recno_t recno_t;
238 #define R_CURSOR DB_SET_RANGE
239 #define R_FIRST DB_FIRST
240 #define R_IAFTER DB_AFTER
241 #define R_IBEFORE DB_BEFORE
242 #define R_LAST DB_LAST
243 #define R_NEXT DB_NEXT
244 #define R_NOOVERWRITE DB_NOOVERWRITE
245 #define R_PREV DB_PREV
247 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
248 # define R_SETCURSOR 0x800000
250 # define R_SETCURSOR (-100)
253 #define R_RECNOSYNC 0
254 #define R_FIXEDLEN DB_FIXEDLEN
258 #define db_HA_hash h_hash
259 #define db_HA_ffactor h_ffactor
260 #define db_HA_nelem h_nelem
261 #define db_HA_bsize db_pagesize
262 #define db_HA_cachesize db_cachesize
263 #define db_HA_lorder db_lorder
265 #define db_BT_compare bt_compare
266 #define db_BT_prefix bt_prefix
267 #define db_BT_flags flags
268 #define db_BT_psize db_pagesize
269 #define db_BT_cachesize db_cachesize
270 #define db_BT_lorder db_lorder
271 #define db_BT_maxkeypage
272 #define db_BT_minkeypage
275 #define db_RE_reclen re_len
276 #define db_RE_flags flags
277 #define db_RE_bval re_pad
278 #define db_RE_bfname re_source
279 #define db_RE_psize db_pagesize
280 #define db_RE_cachesize db_cachesize
281 #define db_RE_lorder db_lorder
285 #define do_SEQ(db, key, value, flag) (db->cursor->c_get)(db->cursor, &key, &value, flag)
288 #define DBT_flags(x) x.flags = 0
289 #define DB_flags(x, v) x |= v
291 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
292 # define flagSet(flags, bitmask) ((flags) & (bitmask))
294 # define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask))
297 #else /* db version 1.x */
299 #define BERKELEY_DB_1
300 #define BERKELEY_DB_1_OR_2
313 # define DB_Prefix_t mDB_Prefix_t
320 # define DB_Hash_t mDB_Hash_t
323 #define db_HA_hash hash.hash
324 #define db_HA_ffactor hash.ffactor
325 #define db_HA_nelem hash.nelem
326 #define db_HA_bsize hash.bsize
327 #define db_HA_cachesize hash.cachesize
328 #define db_HA_lorder hash.lorder
330 #define db_BT_compare btree.compare
331 #define db_BT_prefix btree.prefix
332 #define db_BT_flags btree.flags
333 #define db_BT_psize btree.psize
334 #define db_BT_cachesize btree.cachesize
335 #define db_BT_lorder btree.lorder
336 #define db_BT_maxkeypage btree.maxkeypage
337 #define db_BT_minkeypage btree.minkeypage
339 #define db_RE_reclen recno.reclen
340 #define db_RE_flags recno.flags
341 #define db_RE_bval recno.bval
342 #define db_RE_bfname recno.bfname
343 #define db_RE_psize recno.psize
344 #define db_RE_cachesize recno.cachesize
345 #define db_RE_lorder recno.lorder
349 #define do_SEQ(db, key, value, flag) (db->dbp->seq)(db->dbp, &key, &value, flag)
351 #define DB_flags(x, v)
352 #define flagSet(flags, bitmask) ((flags) & (bitmask))
354 #endif /* db version 1 */
358 #define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, TXN &key, 0)
359 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, 0)
360 #define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, 0)
362 #define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
363 #define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
365 #ifdef DB_VERSION_MAJOR
366 #define db_DESTROY(db) (!db->aborted && ( db->cursor->c_close(db->cursor),\
367 (db->dbp->close)(db->dbp, 0) ))
368 #define db_close(db) ((db->dbp)->close)(db->dbp, 0)
369 #define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \
370 ? ((db->cursor)->c_del)(db->cursor, 0) \
371 : ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
373 #else /* ! DB_VERSION_MAJOR */
375 #define db_DESTROY(db) (!db->aborted && ((db->dbp)->close)(db->dbp))
376 #define db_close(db) ((db->dbp)->close)(db->dbp)
377 #define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
378 #define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
380 #endif /* ! DB_VERSION_MAJOR */
383 #define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags)
396 #ifdef BERKELEY_DB_1_OR_2
399 #ifdef DB_VERSION_MAJOR
402 SV * filter_fetch_key ;
403 SV * filter_store_key ;
404 SV * filter_fetch_value ;
405 SV * filter_store_value ;
410 typedef DB_File_type * DB_File ;
413 #define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (const char *)""), s)
415 #define OutputValue(arg, name) \
416 { if (RETVAL == 0) { \
418 my_sv_setpvn(arg, (const char *)name.data, name.size) ; \
422 DBM_ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \
426 #define OutputKey(arg, name) \
430 if (db->type != DB_RECNO) { \
431 my_sv_setpvn(arg, (const char *)name.data, name.size); \
434 sv_setiv(arg, (I32)*(I32*)name.data - 1); \
438 DBM_ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \
442 #define my_SvUV32(sv) ((u_int32_t)SvUV(sv))
445 extern void __getBerkeleyDBInfo(void);
448 /* Internal Global Data */
450 #define MY_CXT_KEY "DB_File::_guts" XS_VERSION
461 #define Value (MY_CXT.x_Value)
462 #define zero (MY_CXT.x_zero)
463 #define CurrentDB (MY_CXT.x_CurrentDB)
464 #define empty (MY_CXT.x_empty)
466 #define ERR_BUFF "DB_File::Error"
468 #ifdef DB_VERSION_MAJOR
472 db_put(DB_File db, DBTKEY key, DBT value, u_int flags)
474 db_put(db, key, value, flags)
483 if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) {
487 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
488 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor) != 0)
490 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor, 0) != 0)
494 memset(&l_key, 0, sizeof(l_key));
495 l_key.data = key.data;
496 l_key.size = key.size;
497 memset(&l_value, 0, sizeof(l_value));
498 l_value.data = value.data;
499 l_value.size = value.size;
501 if ( temp_cursor->c_get(temp_cursor, &l_key, &l_value, DB_SET) != 0) {
502 (void)temp_cursor->c_close(temp_cursor);
506 status = temp_cursor->c_put(temp_cursor, &key, &value, flags);
507 (void)temp_cursor->c_close(temp_cursor);
513 if (flagSet(flags, R_CURSOR)) {
514 return ((db->cursor)->c_put)(db->cursor, &key, &value, DB_CURRENT);
517 if (flagSet(flags, R_SETCURSOR)) {
518 if ((db->dbp)->put(db->dbp, NULL, &key, &value, 0) != 0)
520 return ((db->cursor)->c_get)(db->cursor, &key, &value, DB_SET_RANGE);
524 return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
528 #endif /* DB_VERSION_MAJOR */
538 #ifdef AT_LEAST_DB_3_2
541 btree_compare(DB * db, const DBT *key1, const DBT *key2)
543 btree_compare(db, key1, key2)
547 #endif /* CAN_PROTOTYPE */
549 #else /* Berkeley DB < 3.2 */
552 btree_compare(const DBT *key1, const DBT *key2)
554 btree_compare(key1, key2)
567 void * data1, * data2 ;
572 if (CurrentDB->in_compare) {
574 croak ("DB_File btree_compare: recursion detected\n") ;
577 data1 = (char *) key1->data ;
578 data2 = (char *) key2->data ;
581 /* As newSVpv will assume that the data pointer is a null terminated C
582 string if the size parameter is 0, make sure that data points to an
583 empty string if the length is 0
594 CurrentDB->in_compare = FALSE;
595 SAVEINT(CurrentDB->in_compare);
596 CurrentDB->in_compare = TRUE;
600 PUSHs(sv_2mortal(newSVpvn((const char*)data1,key1->size)));
601 PUSHs(sv_2mortal(newSVpvn((const char*)data2,key2->size)));
604 count = perl_call_sv(CurrentDB->compare, G_SCALAR);
610 croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
624 #ifdef AT_LEAST_DB_3_2
627 btree_prefix(DB * db, const DBT *key1, const DBT *key2)
629 btree_prefix(db, key1, key2)
635 #else /* Berkeley DB < 3.2 */
638 btree_prefix(const DBT *key1, const DBT *key2)
640 btree_prefix(key1, key2)
652 char * data1, * data2 ;
656 if (CurrentDB->in_prefix){
658 croak ("DB_File btree_prefix: recursion detected\n") ;
661 data1 = (char *) key1->data ;
662 data2 = (char *) key2->data ;
665 /* As newSVpv will assume that the data pointer is a null terminated C
666 string if the size parameter is 0, make sure that data points to an
667 empty string if the length is 0
678 CurrentDB->in_prefix = FALSE;
679 SAVEINT(CurrentDB->in_prefix);
680 CurrentDB->in_prefix = TRUE;
684 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
685 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
688 count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
694 croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
708 # define HASH_CB_SIZE_TYPE size_t
710 # define HASH_CB_SIZE_TYPE u_int32_t
714 #ifdef AT_LEAST_DB_3_2
717 hash_cb(DB * db, const void *data, u_int32_t size)
719 hash_cb(db, data, size)
722 HASH_CB_SIZE_TYPE size ;
725 #else /* Berkeley DB < 3.2 */
728 hash_cb(const void *data, HASH_CB_SIZE_TYPE size)
732 HASH_CB_SIZE_TYPE size ;
745 if (CurrentDB->in_hash){
747 croak ("DB_File hash callback: recursion detected\n") ;
755 /* DGH - Next two lines added to fix corrupted stack problem */
759 CurrentDB->in_hash = FALSE;
760 SAVEINT(CurrentDB->in_hash);
761 CurrentDB->in_hash = TRUE;
766 XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
769 count = perl_call_sv(CurrentDB->hash, G_SCALAR);
775 croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
790 #ifdef AT_LEAST_DB_4_3
791 db_errcall_cb(const DB_ENV* dbenv, const char * db_errpfx, const char * buffer)
793 db_errcall_cb(const char * db_errpfx, char * buffer)
799 SV * sv = perl_get_sv(ERR_BUFF, FALSE) ;
802 sv_setpvf(sv, "%s: %s", db_errpfx, buffer) ;
804 sv_setpv(sv, buffer) ;
809 #if defined(TRACE) && defined(BERKELEY_DB_1_OR_2)
813 PrintHash(INFO *hash)
819 printf ("HASH Info\n") ;
820 printf (" hash = %s\n",
821 (hash->db_HA_hash != NULL ? "redefined" : "default")) ;
822 printf (" bsize = %d\n", hash->db_HA_bsize) ;
823 printf (" ffactor = %d\n", hash->db_HA_ffactor) ;
824 printf (" nelem = %d\n", hash->db_HA_nelem) ;
825 printf (" cachesize = %d\n", hash->db_HA_cachesize) ;
826 printf (" lorder = %d\n", hash->db_HA_lorder) ;
832 PrintRecno(INFO *recno)
838 printf ("RECNO Info\n") ;
839 printf (" flags = %d\n", recno->db_RE_flags) ;
840 printf (" cachesize = %d\n", recno->db_RE_cachesize) ;
841 printf (" psize = %d\n", recno->db_RE_psize) ;
842 printf (" lorder = %d\n", recno->db_RE_lorder) ;
843 printf (" reclen = %lu\n", (unsigned long)recno->db_RE_reclen) ;
844 printf (" bval = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
845 printf (" bfname = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
850 PrintBtree(INFO *btree)
856 printf ("BTREE Info\n") ;
857 printf (" compare = %s\n",
858 (btree->db_BT_compare ? "redefined" : "default")) ;
859 printf (" prefix = %s\n",
860 (btree->db_BT_prefix ? "redefined" : "default")) ;
861 printf (" flags = %d\n", btree->db_BT_flags) ;
862 printf (" cachesize = %d\n", btree->db_BT_cachesize) ;
863 printf (" psize = %d\n", btree->db_BT_psize) ;
864 #ifndef DB_VERSION_MAJOR
865 printf (" maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
866 printf (" minkeypage = %d\n", btree->db_BT_minkeypage) ;
868 printf (" lorder = %d\n", btree->db_BT_lorder) ;
873 #define PrintRecno(recno)
874 #define PrintHash(hash)
875 #define PrintBtree(btree)
882 GetArrayLength(pTHX_ DB_File db)
894 RETVAL = do_SEQ(db, key, value, R_LAST) ;
896 RETVAL = *(I32 *)key.data ;
897 else /* No key means empty file */
900 return ((I32)RETVAL) ;
905 GetRecnoKey(pTHX_ DB_File db, I32 value)
907 GetRecnoKey(db, value)
913 /* Get the length of the array */
914 I32 length = GetArrayLength(aTHX_ db) ;
916 /* check for attempt to write before start of array */
917 if (length + value + 1 <= 0) {
919 croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
922 value = length + value + 1 ;
933 ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv)
935 ParseOpenInfo(isHASH, name, flags, mode, sv)
944 #ifdef BERKELEY_DB_1_OR_2 /* Berkeley DB Version 1 or 2 */
948 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
949 void * openinfo = NULL ;
950 INFO * info = &RETVAL->info ;
955 printf("In ParseOpenInfo name=[%s] flags=[%d] mode=[%d] SV NULL=[%d]\n",
956 name, flags, mode, sv == NULL) ;
958 Zero(RETVAL, 1, DB_File_type) ;
960 /* Default to HASH */
961 RETVAL->filtering = 0 ;
962 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
963 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
964 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
965 RETVAL->type = DB_HASH ;
967 /* DGH - Next line added to avoid SEGV on existing hash DB */
970 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
971 RETVAL->in_memory = (name == NULL) ;
976 croak ("type parameter is not a reference") ;
978 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
979 if (svp && SvOK(*svp))
980 action = (HV*) SvRV(*svp) ;
982 croak("internal error") ;
984 if (sv_isa(sv, "DB_File::HASHINFO"))
988 croak("DB_File can only tie an associative array to a DB_HASH database") ;
990 RETVAL->type = DB_HASH ;
991 openinfo = (void*)info ;
993 svp = hv_fetch(action, "hash", 4, FALSE);
995 if (svp && SvOK(*svp))
997 info->db_HA_hash = hash_cb ;
998 RETVAL->hash = newSVsv(*svp) ;
1001 info->db_HA_hash = NULL ;
1003 svp = hv_fetch(action, "ffactor", 7, FALSE);
1004 info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
1006 svp = hv_fetch(action, "nelem", 5, FALSE);
1007 info->db_HA_nelem = svp ? SvIV(*svp) : 0;
1009 svp = hv_fetch(action, "bsize", 5, FALSE);
1010 info->db_HA_bsize = svp ? SvIV(*svp) : 0;
1012 svp = hv_fetch(action, "cachesize", 9, FALSE);
1013 info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
1015 svp = hv_fetch(action, "lorder", 6, FALSE);
1016 info->db_HA_lorder = svp ? SvIV(*svp) : 0;
1020 else if (sv_isa(sv, "DB_File::BTREEINFO"))
1023 croak("DB_File can only tie an associative array to a DB_BTREE database");
1025 RETVAL->type = DB_BTREE ;
1026 openinfo = (void*)info ;
1028 svp = hv_fetch(action, "compare", 7, FALSE);
1029 if (svp && SvOK(*svp))
1031 info->db_BT_compare = btree_compare ;
1032 RETVAL->compare = newSVsv(*svp) ;
1035 info->db_BT_compare = NULL ;
1037 svp = hv_fetch(action, "prefix", 6, FALSE);
1038 if (svp && SvOK(*svp))
1040 info->db_BT_prefix = btree_prefix ;
1041 RETVAL->prefix = newSVsv(*svp) ;
1044 info->db_BT_prefix = NULL ;
1046 svp = hv_fetch(action, "flags", 5, FALSE);
1047 info->db_BT_flags = svp ? SvIV(*svp) : 0;
1049 svp = hv_fetch(action, "cachesize", 9, FALSE);
1050 info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
1052 #ifndef DB_VERSION_MAJOR
1053 svp = hv_fetch(action, "minkeypage", 10, FALSE);
1054 info->btree.minkeypage = svp ? SvIV(*svp) : 0;
1056 svp = hv_fetch(action, "maxkeypage", 10, FALSE);
1057 info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
1060 svp = hv_fetch(action, "psize", 5, FALSE);
1061 info->db_BT_psize = svp ? SvIV(*svp) : 0;
1063 svp = hv_fetch(action, "lorder", 6, FALSE);
1064 info->db_BT_lorder = svp ? SvIV(*svp) : 0;
1069 else if (sv_isa(sv, "DB_File::RECNOINFO"))
1072 croak("DB_File can only tie an array to a DB_RECNO database");
1074 RETVAL->type = DB_RECNO ;
1075 openinfo = (void *)info ;
1077 info->db_RE_flags = 0 ;
1079 svp = hv_fetch(action, "flags", 5, FALSE);
1080 info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
1082 svp = hv_fetch(action, "reclen", 6, FALSE);
1083 info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
1085 svp = hv_fetch(action, "cachesize", 9, FALSE);
1086 info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
1088 svp = hv_fetch(action, "psize", 5, FALSE);
1089 info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
1091 svp = hv_fetch(action, "lorder", 6, FALSE);
1092 info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
1094 #ifdef DB_VERSION_MAJOR
1095 info->re_source = name ;
1098 svp = hv_fetch(action, "bfname", 6, FALSE);
1099 if (svp && SvOK(*svp)) {
1100 char * ptr = SvPV(*svp,n_a) ;
1101 #ifdef DB_VERSION_MAJOR
1102 name = (char*) n_a ? ptr : NULL ;
1104 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
1108 #ifdef DB_VERSION_MAJOR
1111 info->db_RE_bfname = NULL ;
1114 svp = hv_fetch(action, "bval", 4, FALSE);
1115 #ifdef DB_VERSION_MAJOR
1116 if (svp && SvOK(*svp))
1120 value = (int)*SvPV(*svp, n_a) ;
1122 value = SvIV(*svp) ;
1124 if (info->flags & DB_FIXEDLEN) {
1125 info->re_pad = value ;
1126 info->flags |= DB_PAD ;
1129 info->re_delim = value ;
1130 info->flags |= DB_DELIMITER ;
1135 if (svp && SvOK(*svp))
1138 info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
1140 info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
1141 DB_flags(info->flags, DB_DELIMITER) ;
1146 if (info->db_RE_flags & R_FIXEDLEN)
1147 info->db_RE_bval = (u_char) ' ' ;
1149 info->db_RE_bval = (u_char) '\n' ;
1150 DB_flags(info->flags, DB_DELIMITER) ;
1155 info->flags |= DB_RENUMBER ;
1161 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1165 /* OS2 Specific Code */
1169 #endif /* __EMX__ */
1172 #ifdef DB_VERSION_MAJOR
1178 /* Map 1.x flags to 2.x flags */
1179 if ((flags & O_CREAT) == O_CREAT)
1180 Flags |= DB_CREATE ;
1183 if (flags == O_RDONLY)
1185 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1187 Flags |= DB_RDONLY ;
1190 if ((flags & O_TRUNC) == O_TRUNC)
1191 Flags |= DB_TRUNCATE ;
1194 status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
1196 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
1197 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
1199 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1204 RETVAL->dbp = NULL ;
1209 #if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2
1210 RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ;
1212 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
1213 #endif /* DB_LIBRARY_COMPATIBILITY_API */
1219 #else /* Berkeley DB Version > 2 */
1223 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
1229 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
1230 Zero(RETVAL, 1, DB_File_type) ;
1232 /* Default to HASH */
1233 RETVAL->filtering = 0 ;
1234 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
1235 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
1236 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
1237 RETVAL->type = DB_HASH ;
1239 /* DGH - Next line added to avoid SEGV on existing hash DB */
1242 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
1243 RETVAL->in_memory = (name == NULL) ;
1245 status = db_create(&RETVAL->dbp, NULL,0) ;
1246 /* printf("db_create returned %d %s\n", status, db_strerror(status)) ; */
1248 RETVAL->dbp = NULL ;
1254 RETVAL->dbp->set_errcall(RETVAL->dbp, db_errcall_cb) ;
1259 croak ("type parameter is not a reference") ;
1261 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
1262 if (svp && SvOK(*svp))
1263 action = (HV*) SvRV(*svp) ;
1265 croak("internal error") ;
1267 if (sv_isa(sv, "DB_File::HASHINFO"))
1271 croak("DB_File can only tie an associative array to a DB_HASH database") ;
1273 RETVAL->type = DB_HASH ;
1275 svp = hv_fetch(action, "hash", 4, FALSE);
1277 if (svp && SvOK(*svp))
1279 (void)dbp->set_h_hash(dbp, hash_cb) ;
1280 RETVAL->hash = newSVsv(*svp) ;
1283 svp = hv_fetch(action, "ffactor", 7, FALSE);
1285 (void)dbp->set_h_ffactor(dbp, my_SvUV32(*svp)) ;
1287 svp = hv_fetch(action, "nelem", 5, FALSE);
1289 (void)dbp->set_h_nelem(dbp, my_SvUV32(*svp)) ;
1291 svp = hv_fetch(action, "bsize", 5, FALSE);
1293 (void)dbp->set_pagesize(dbp, my_SvUV32(*svp));
1295 svp = hv_fetch(action, "cachesize", 9, FALSE);
1297 (void)dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
1299 svp = hv_fetch(action, "lorder", 6, FALSE);
1301 (void)dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
1305 else if (sv_isa(sv, "DB_File::BTREEINFO"))
1308 croak("DB_File can only tie an associative array to a DB_BTREE database");
1310 RETVAL->type = DB_BTREE ;
1312 svp = hv_fetch(action, "compare", 7, FALSE);
1313 if (svp && SvOK(*svp))
1315 (void)dbp->set_bt_compare(dbp, btree_compare) ;
1316 RETVAL->compare = newSVsv(*svp) ;
1319 svp = hv_fetch(action, "prefix", 6, FALSE);
1320 if (svp && SvOK(*svp))
1322 (void)dbp->set_bt_prefix(dbp, btree_prefix) ;
1323 RETVAL->prefix = newSVsv(*svp) ;
1326 svp = hv_fetch(action, "flags", 5, FALSE);
1328 (void)dbp->set_flags(dbp, my_SvUV32(*svp)) ;
1330 svp = hv_fetch(action, "cachesize", 9, FALSE);
1332 (void)dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
1334 svp = hv_fetch(action, "psize", 5, FALSE);
1336 (void)dbp->set_pagesize(dbp, my_SvUV32(*svp)) ;
1338 svp = hv_fetch(action, "lorder", 6, FALSE);
1340 (void)dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
1345 else if (sv_isa(sv, "DB_File::RECNOINFO"))
1350 croak("DB_File can only tie an array to a DB_RECNO database");
1352 RETVAL->type = DB_RECNO ;
1354 svp = hv_fetch(action, "flags", 5, FALSE);
1356 int flags = SvIV(*svp) ;
1357 /* remove FIXDLEN, if present */
1358 if (flags & DB_FIXEDLEN) {
1360 flags &= ~DB_FIXEDLEN ;
1364 svp = hv_fetch(action, "cachesize", 9, FALSE);
1366 status = dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
1369 svp = hv_fetch(action, "psize", 5, FALSE);
1371 status = dbp->set_pagesize(dbp, my_SvUV32(*svp)) ;
1374 svp = hv_fetch(action, "lorder", 6, FALSE);
1376 status = dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
1379 svp = hv_fetch(action, "bval", 4, FALSE);
1380 if (svp && SvOK(*svp))
1384 value = (int)*SvPV(*svp, n_a) ;
1386 value = (int)SvIV(*svp) ;
1389 status = dbp->set_re_pad(dbp, value) ;
1392 status = dbp->set_re_delim(dbp, value) ;
1398 svp = hv_fetch(action, "reclen", 6, FALSE);
1400 u_int32_t len = my_SvUV32(*svp) ;
1401 status = dbp->set_re_len(dbp, len) ;
1406 status = dbp->set_re_source(dbp, name) ;
1410 svp = hv_fetch(action, "bfname", 6, FALSE);
1411 if (svp && SvOK(*svp)) {
1412 char * ptr = SvPV(*svp,n_a) ;
1413 name = (char*) n_a ? ptr : NULL ;
1419 status = dbp->set_flags(dbp, (u_int32_t)DB_RENUMBER) ;
1422 (void)dbp->set_flags(dbp, (u_int32_t)flags) ;
1427 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1431 u_int32_t Flags = 0 ;
1434 /* Map 1.x flags to 3.x flags */
1435 if ((flags & O_CREAT) == O_CREAT)
1436 Flags |= DB_CREATE ;
1439 if (flags == O_RDONLY)
1441 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1443 Flags |= DB_RDONLY ;
1446 if ((flags & O_TRUNC) == O_TRUNC)
1447 Flags |= DB_TRUNCATE ;
1450 #ifdef AT_LEAST_DB_4_4
1451 /* need this for recno */
1452 if ((flags & O_TRUNC) == O_TRUNC)
1453 Flags |= DB_CREATE ;
1456 #ifdef AT_LEAST_DB_4_1
1457 status = (RETVAL->dbp->open)(RETVAL->dbp, NULL, name, NULL, RETVAL->type,
1460 status = (RETVAL->dbp->open)(RETVAL->dbp, name, NULL, RETVAL->type,
1463 /* printf("open returned %d %s\n", status, db_strerror(status)) ; */
1467 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1469 /* printf("cursor returned %d %s\n", status, db_strerror(status)) ; */
1473 RETVAL->dbp = NULL ;
1479 #endif /* Berkeley DB Version > 2 */
1481 } /* ParseOpenInfo */
1484 #include "constants.h"
1486 MODULE = DB_File PACKAGE = DB_File PREFIX = db_
1488 INCLUDE: constants.xs
1496 SV * sv_err = perl_get_sv(ERR_BUFF, GV_ADD|GV_ADDMULTI) ;
1499 __getBerkeleyDBInfo() ;
1502 empty.data = &zero ;
1503 empty.size = sizeof(recno_t) ;
1509 db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
1516 char * name = (char *) NULL ;
1517 SV * sv = (SV *) NULL ;
1520 if (items >= 3 && SvOK(ST(2)))
1521 name = (char*) SvPV(ST(2), n_a) ;
1526 RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
1527 if (RETVAL->dbp == NULL) {
1542 Trace(("DESTROY %p\n", db));
1544 Trace(("DESTROY %p done\n", db));
1546 SvREFCNT_dec(db->hash) ;
1548 SvREFCNT_dec(db->compare) ;
1550 SvREFCNT_dec(db->prefix) ;
1551 if (db->filter_fetch_key)
1552 SvREFCNT_dec(db->filter_fetch_key) ;
1553 if (db->filter_store_key)
1554 SvREFCNT_dec(db->filter_store_key) ;
1555 if (db->filter_fetch_value)
1556 SvREFCNT_dec(db->filter_fetch_value) ;
1557 if (db->filter_store_value)
1558 SvREFCNT_dec(db->filter_store_value) ;
1560 #ifdef DB_VERSION_MAJOR
1567 db_DELETE(db, key, flags=0)
1589 RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
1595 db_FETCH(db, key, flags=0)
1608 RETVAL = db_get(db, key, value, flags) ;
1609 ST(0) = sv_newmortal();
1610 OutputValue(ST(0), value)
1614 db_STORE(db, key, value, flags=0)
1639 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1640 ST(0) = sv_newmortal();
1641 OutputKey(ST(0), key) ;
1647 DBTKEY key = NO_INIT
1658 RETVAL = do_SEQ(db, key, value, R_NEXT) ;
1659 ST(0) = sv_newmortal();
1660 OutputKey(ST(0), key) ;
1664 # These would be nice for RECNO
1684 #ifdef DB_VERSION_MAJOR
1685 /* get the first value */
1686 RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1691 for (i = items-1 ; i > 0 ; --i)
1693 DBM_ckFilter(ST(i), filter_store_value, "filter_store_value");
1694 value.data = SvPVbyte(ST(i), n_a) ;
1698 key.size = sizeof(int) ;
1699 #ifdef DB_VERSION_MAJOR
1700 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1702 RETVAL = (db->dbp->put)(db->dbp, &key, &value, R_IBEFORE) ;
1728 /* First get the final value */
1729 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1730 ST(0) = sv_newmortal();
1734 /* the call to del will trash value, so take a copy now */
1735 OutputValue(ST(0), value) ;
1736 RETVAL = db_del(db, key, R_CURSOR) ;
1738 sv_setsv(ST(0), &PL_sv_undef);
1758 /* get the first value */
1759 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1760 ST(0) = sv_newmortal();
1764 /* the call to del will trash value, so take a copy now */
1765 OutputValue(ST(0), value) ;
1766 RETVAL = db_del(db, key, R_CURSOR) ;
1768 sv_setsv (ST(0), &PL_sv_undef) ;
1791 /* Set the Cursor to the Last element */
1792 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1793 #ifndef DB_VERSION_MAJOR
1798 keyval = *(int*)key.data ;
1801 for (i = 1 ; i < items ; ++i)
1803 DBM_ckFilter(ST(i), filter_store_value, "filter_store_value");
1804 value.data = SvPVbyte(ST(i), n_a) ;
1807 key.data = &keyval ;
1808 key.size = sizeof(int) ;
1809 RETVAL = (Db->put)(Db, TXN &key, &value, 0) ;
1823 ALIAS: FETCHSIZE = 1
1826 RETVAL = GetArrayLength(aTHX_ db) ;
1832 # Now provide an interface to the rest of the DB functionality
1836 db_del(db, key, flags=0)
1844 RETVAL = db_del(db, key, flags) ;
1845 #ifdef DB_VERSION_MAJOR
1848 else if (RETVAL == DB_NOTFOUND)
1856 db_get(db, key, value, flags=0)
1866 RETVAL = db_get(db, key, value, flags) ;
1867 #ifdef DB_VERSION_MAJOR
1870 else if (RETVAL == DB_NOTFOUND)
1878 db_put(db, key, value, flags=0)
1887 RETVAL = db_put(db, key, value, flags) ;
1888 #ifdef DB_VERSION_MAJOR
1891 else if (RETVAL == DB_KEYEXIST)
1896 key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
1905 #ifdef DB_VERSION_MAJOR
1909 status = (db->in_memory
1911 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
1916 RETVAL = (db->in_memory
1918 : ((db->dbp)->fd)(db->dbp) ) ;
1924 db_sync(db, flags=0)
1931 RETVAL = db_sync(db, flags) ;
1932 #ifdef DB_VERSION_MAJOR
1941 db_seq(db, key, value, flags)
1951 RETVAL = db_seq(db, key, value, flags);
1952 #ifdef DB_VERSION_MAJOR
1955 else if (RETVAL == DB_NOTFOUND)
1964 filter_fetch_key(db, code)
1967 SV * RETVAL = &PL_sv_undef ;
1969 DBM_setFilter(db->filter_fetch_key, code) ;
1972 filter_store_key(db, code)
1975 SV * RETVAL = &PL_sv_undef ;
1977 DBM_setFilter(db->filter_store_key, code) ;
1980 filter_fetch_value(db, code)
1983 SV * RETVAL = &PL_sv_undef ;
1985 DBM_setFilter(db->filter_fetch_value, code) ;
1988 filter_store_value(db, code)
1991 SV * RETVAL = &PL_sv_undef ;
1993 DBM_setFilter(db->filter_store_value, code) ;