3 DB_File.xs -- Perl 5 interface to Berkeley DB
5 written by Paul Marquess <Paul.Marquess@btinternet.com>
6 last modified 10 December 2000
9 All comments/suggestions/problems are welcome
11 Copyright (c) 1995-2000 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.
97 # include "patchlevel.h"
98 # define PERL_REVISION 5
99 # define PERL_VERSION PATCHLEVEL
100 # define PERL_SUBVERSION SUBVERSION
103 #if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 ))
105 # define PL_sv_undef sv_undef
110 /* DEFSV appears first in 5.004_56 */
112 # define DEFSV GvSV(defgv)
115 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
116 * shortly #included by the <db.h>) __attribute__ to the possibly
117 * already defined __attribute__, for example by GNUC or by Perl. */
121 /* If Perl has been compiled with Threads support,the symbol op will
122 be defined here. This clashes with a field name in db.h, so get rid of it.
135 extern void __getBerkeleyDBInfo(void);
146 # define newSVpvn(a,b) newSVpv(a,b)
152 #define DBM_FILTERING
155 # define Trace(x) printf x
161 #define DBT_clear(x) Zero(&x, 1, DBT) ;
163 #ifdef DB_VERSION_MAJOR
165 #if DB_VERSION_MAJOR == 2
166 # define BERKELEY_DB_1_OR_2
169 /* map version 2 features & constants onto their version 1 equivalent */
174 #define DB_Prefix_t size_t
179 #define DB_Hash_t u_int32_t
181 /* DBTYPE stays the same */
182 /* HASHINFO, RECNOINFO and BTREEINFO map to DB_INFO */
183 #if DB_VERSION_MAJOR == 2
184 typedef DB_INFO INFO ;
185 #else /* DB_VERSION_MAJOR > 2 */
186 # define DB_FIXEDLEN (0x8000)
187 #endif /* DB_VERSION_MAJOR == 2 */
189 /* version 2 has db_recno_t in place of recno_t */
190 typedef db_recno_t recno_t;
193 #define R_CURSOR DB_SET_RANGE
194 #define R_FIRST DB_FIRST
195 #define R_IAFTER DB_AFTER
196 #define R_IBEFORE DB_BEFORE
197 #define R_LAST DB_LAST
198 #define R_NEXT DB_NEXT
199 #define R_NOOVERWRITE DB_NOOVERWRITE
200 #define R_PREV DB_PREV
202 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
203 # define R_SETCURSOR 0x800000
205 # define R_SETCURSOR (-100)
208 #define R_RECNOSYNC 0
209 #define R_FIXEDLEN DB_FIXEDLEN
213 #define db_HA_hash h_hash
214 #define db_HA_ffactor h_ffactor
215 #define db_HA_nelem h_nelem
216 #define db_HA_bsize db_pagesize
217 #define db_HA_cachesize db_cachesize
218 #define db_HA_lorder db_lorder
220 #define db_BT_compare bt_compare
221 #define db_BT_prefix bt_prefix
222 #define db_BT_flags flags
223 #define db_BT_psize db_pagesize
224 #define db_BT_cachesize db_cachesize
225 #define db_BT_lorder db_lorder
226 #define db_BT_maxkeypage
227 #define db_BT_minkeypage
230 #define db_RE_reclen re_len
231 #define db_RE_flags flags
232 #define db_RE_bval re_pad
233 #define db_RE_bfname re_source
234 #define db_RE_psize db_pagesize
235 #define db_RE_cachesize db_cachesize
236 #define db_RE_lorder db_lorder
240 #define do_SEQ(db, key, value, flag) (db->cursor->c_get)(db->cursor, &key, &value, flag)
243 #define DBT_flags(x) x.flags = 0
244 #define DB_flags(x, v) x |= v
246 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
247 # define flagSet(flags, bitmask) ((flags) & (bitmask))
249 # define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask))
252 #else /* db version 1.x */
254 #define BERKELEY_DB_1_OR_2
267 # define DB_Prefix_t mDB_Prefix_t
274 # define DB_Hash_t mDB_Hash_t
277 #define db_HA_hash hash.hash
278 #define db_HA_ffactor hash.ffactor
279 #define db_HA_nelem hash.nelem
280 #define db_HA_bsize hash.bsize
281 #define db_HA_cachesize hash.cachesize
282 #define db_HA_lorder hash.lorder
284 #define db_BT_compare btree.compare
285 #define db_BT_prefix btree.prefix
286 #define db_BT_flags btree.flags
287 #define db_BT_psize btree.psize
288 #define db_BT_cachesize btree.cachesize
289 #define db_BT_lorder btree.lorder
290 #define db_BT_maxkeypage btree.maxkeypage
291 #define db_BT_minkeypage btree.minkeypage
293 #define db_RE_reclen recno.reclen
294 #define db_RE_flags recno.flags
295 #define db_RE_bval recno.bval
296 #define db_RE_bfname recno.bfname
297 #define db_RE_psize recno.psize
298 #define db_RE_cachesize recno.cachesize
299 #define db_RE_lorder recno.lorder
303 #define do_SEQ(db, key, value, flag) (db->dbp->seq)(db->dbp, &key, &value, flag)
305 #define DB_flags(x, v)
306 #define flagSet(flags, bitmask) ((flags) & (bitmask))
308 #endif /* db version 1 */
312 #define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, TXN &key, flags)
313 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, flags)
314 #define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
316 #define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
317 #define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
319 #ifdef DB_VERSION_MAJOR
320 #define db_DESTROY(db) ( db->cursor->c_close(db->cursor),\
321 (db->dbp->close)(db->dbp, 0) )
322 #define db_close(db) ((db->dbp)->close)(db->dbp, 0)
323 #define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \
324 ? ((db->cursor)->c_del)(db->cursor, 0) \
325 : ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
327 #else /* ! DB_VERSION_MAJOR */
329 #define db_DESTROY(db) ((db->dbp)->close)(db->dbp)
330 #define db_close(db) ((db->dbp)->close)(db->dbp)
331 #define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
332 #define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
334 #endif /* ! DB_VERSION_MAJOR */
337 #define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags)
346 #ifdef BERKELEY_DB_1_OR_2
349 #ifdef DB_VERSION_MAJOR
353 SV * filter_fetch_key ;
354 SV * filter_store_key ;
355 SV * filter_fetch_value ;
356 SV * filter_store_value ;
358 #endif /* DBM_FILTERING */
362 typedef DB_File_type * DB_File ;
367 #define ckFilter(arg,type,name) \
370 /* printf("filtering %s\n", name) ;*/ \
372 croak("recursion detected in %s", name) ; \
373 db->filtering = TRUE ; \
374 save_defsv = newSVsv(DEFSV) ; \
375 sv_setsv(DEFSV, arg) ; \
377 (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \
378 sv_setsv(arg, DEFSV) ; \
379 sv_setsv(DEFSV, save_defsv) ; \
380 SvREFCNT_dec(save_defsv) ; \
381 db->filtering = FALSE ; \
382 /*printf("end of filtering %s\n", name) ;*/ \
387 #define ckFilter(arg,type, name)
389 #endif /* DBM_FILTERING */
391 #define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
393 #define OutputValue(arg, name) \
394 { if (RETVAL == 0) { \
395 my_sv_setpvn(arg, name.data, name.size) ; \
396 ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \
400 #define OutputKey(arg, name) \
403 if (db->type != DB_RECNO) { \
404 my_sv_setpvn(arg, name.data, name.size); \
407 sv_setiv(arg, (I32)*(I32*)name.data - 1); \
408 ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \
413 /* Internal Global Data */
414 static recno_t Value ;
415 static recno_t zero = 0 ;
416 static DB_File CurrentDB ;
417 static DBTKEY empty ;
419 #ifdef DB_VERSION_MAJOR
423 db_put(DB_File db, DBTKEY key, DBT value, u_int flags)
425 db_put(db, key, value, flags)
434 if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) {
438 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
439 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor) != 0)
441 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor, 0) != 0)
445 memset(&l_key, 0, sizeof(l_key));
446 l_key.data = key.data;
447 l_key.size = key.size;
448 memset(&l_value, 0, sizeof(l_value));
449 l_value.data = value.data;
450 l_value.size = value.size;
452 if ( temp_cursor->c_get(temp_cursor, &l_key, &l_value, DB_SET) != 0) {
453 (void)temp_cursor->c_close(temp_cursor);
457 status = temp_cursor->c_put(temp_cursor, &key, &value, flags);
458 (void)temp_cursor->c_close(temp_cursor);
464 if (flagSet(flags, R_CURSOR)) {
465 return ((db->cursor)->c_put)(db->cursor, &key, &value, DB_CURRENT);
468 if (flagSet(flags, R_SETCURSOR)) {
469 if ((db->dbp)->put(db->dbp, NULL, &key, &value, 0) != 0)
471 return ((db->cursor)->c_get)(db->cursor, &key, &value, DB_SET_RANGE);
475 return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
479 #endif /* DB_VERSION_MAJOR */
484 btree_compare(const DBT *key1, const DBT *key2)
486 btree_compare(key1, key2)
495 void * data1, * data2 ;
503 /* As newSVpv will assume that the data pointer is a null terminated C
504 string if the size parameter is 0, make sure that data points to an
505 empty string if the length is 0
518 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
519 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
522 count = perl_call_sv(CurrentDB->compare, G_SCALAR);
527 croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
540 btree_prefix(const DBT *key1, const DBT *key2)
542 btree_prefix(key1, key2)
551 void * data1, * data2 ;
559 /* As newSVpv will assume that the data pointer is a null terminated C
560 string if the size parameter is 0, make sure that data points to an
561 empty string if the length is 0
574 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
575 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
578 count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
583 croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
595 #if defined(BERKELEY_DB_1_OR_2) && !(DB_VERSION_MINOR == 7 && DB_VERSION_PATCH >= 7)
596 # define HASH_CB_SIZE_TYPE size_t
598 # define HASH_CB_SIZE_TYPE u_int32_t
603 hash_cb(const void *data, HASH_CB_SIZE_TYPE size)
607 HASH_CB_SIZE_TYPE size ;
622 /* DGH - Next two lines added to fix corrupted stack problem */
628 XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
631 count = perl_call_sv(CurrentDB->hash, G_SCALAR);
636 croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
648 #if defined(TRACE) && defined(BERKELEY_DB_1_OR_2)
652 PrintHash(INFO *hash)
658 printf ("HASH Info\n") ;
659 printf (" hash = %s\n",
660 (hash->db_HA_hash != NULL ? "redefined" : "default")) ;
661 printf (" bsize = %d\n", hash->db_HA_bsize) ;
662 printf (" ffactor = %d\n", hash->db_HA_ffactor) ;
663 printf (" nelem = %d\n", hash->db_HA_nelem) ;
664 printf (" cachesize = %d\n", hash->db_HA_cachesize) ;
665 printf (" lorder = %d\n", hash->db_HA_lorder) ;
671 PrintRecno(INFO *recno)
677 printf ("RECNO Info\n") ;
678 printf (" flags = %d\n", recno->db_RE_flags) ;
679 printf (" cachesize = %d\n", recno->db_RE_cachesize) ;
680 printf (" psize = %d\n", recno->db_RE_psize) ;
681 printf (" lorder = %d\n", recno->db_RE_lorder) ;
682 printf (" reclen = %ul\n", (unsigned long)recno->db_RE_reclen) ;
683 printf (" bval = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
684 printf (" bfname = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
689 PrintBtree(INFO *btree)
695 printf ("BTREE Info\n") ;
696 printf (" compare = %s\n",
697 (btree->db_BT_compare ? "redefined" : "default")) ;
698 printf (" prefix = %s\n",
699 (btree->db_BT_prefix ? "redefined" : "default")) ;
700 printf (" flags = %d\n", btree->db_BT_flags) ;
701 printf (" cachesize = %d\n", btree->db_BT_cachesize) ;
702 printf (" psize = %d\n", btree->db_BT_psize) ;
703 #ifndef DB_VERSION_MAJOR
704 printf (" maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
705 printf (" minkeypage = %d\n", btree->db_BT_minkeypage) ;
707 printf (" lorder = %d\n", btree->db_BT_lorder) ;
712 #define PrintRecno(recno)
713 #define PrintHash(hash)
714 #define PrintBtree(btree)
721 GetArrayLength(pTHX_ DB_File db)
733 RETVAL = do_SEQ(db, key, value, R_LAST) ;
735 RETVAL = *(I32 *)key.data ;
736 else /* No key means empty file */
739 return ((I32)RETVAL) ;
744 GetRecnoKey(pTHX_ DB_File db, I32 value)
746 GetRecnoKey(db, value)
752 /* Get the length of the array */
753 I32 length = GetArrayLength(aTHX_ db) ;
755 /* check for attempt to write before start of array */
756 if (length + value + 1 <= 0)
757 croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
759 value = length + value + 1 ;
770 ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv)
772 ParseOpenInfo(isHASH, name, flags, mode, sv)
781 #ifdef BERKELEY_DB_1_OR_2 /* Berkeley DB Version 1 or 2 */
785 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
786 void * openinfo = NULL ;
787 INFO * info = &RETVAL->info ;
790 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
791 Zero(RETVAL, 1, DB_File_type) ;
793 /* Default to HASH */
795 RETVAL->filtering = 0 ;
796 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
797 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
798 #endif /* DBM_FILTERING */
799 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
800 RETVAL->type = DB_HASH ;
802 /* DGH - Next line added to avoid SEGV on existing hash DB */
805 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
806 RETVAL->in_memory = (name == NULL) ;
811 croak ("type parameter is not a reference") ;
813 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
814 if (svp && SvOK(*svp))
815 action = (HV*) SvRV(*svp) ;
817 croak("internal error") ;
819 if (sv_isa(sv, "DB_File::HASHINFO"))
823 croak("DB_File can only tie an associative array to a DB_HASH database") ;
825 RETVAL->type = DB_HASH ;
826 openinfo = (void*)info ;
828 svp = hv_fetch(action, "hash", 4, FALSE);
830 if (svp && SvOK(*svp))
832 info->db_HA_hash = hash_cb ;
833 RETVAL->hash = newSVsv(*svp) ;
836 info->db_HA_hash = NULL ;
838 svp = hv_fetch(action, "ffactor", 7, FALSE);
839 info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
841 svp = hv_fetch(action, "nelem", 5, FALSE);
842 info->db_HA_nelem = svp ? SvIV(*svp) : 0;
844 svp = hv_fetch(action, "bsize", 5, FALSE);
845 info->db_HA_bsize = svp ? SvIV(*svp) : 0;
847 svp = hv_fetch(action, "cachesize", 9, FALSE);
848 info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
850 svp = hv_fetch(action, "lorder", 6, FALSE);
851 info->db_HA_lorder = svp ? SvIV(*svp) : 0;
855 else if (sv_isa(sv, "DB_File::BTREEINFO"))
858 croak("DB_File can only tie an associative array to a DB_BTREE database");
860 RETVAL->type = DB_BTREE ;
861 openinfo = (void*)info ;
863 svp = hv_fetch(action, "compare", 7, FALSE);
864 if (svp && SvOK(*svp))
866 info->db_BT_compare = btree_compare ;
867 RETVAL->compare = newSVsv(*svp) ;
870 info->db_BT_compare = NULL ;
872 svp = hv_fetch(action, "prefix", 6, FALSE);
873 if (svp && SvOK(*svp))
875 info->db_BT_prefix = btree_prefix ;
876 RETVAL->prefix = newSVsv(*svp) ;
879 info->db_BT_prefix = NULL ;
881 svp = hv_fetch(action, "flags", 5, FALSE);
882 info->db_BT_flags = svp ? SvIV(*svp) : 0;
884 svp = hv_fetch(action, "cachesize", 9, FALSE);
885 info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
887 #ifndef DB_VERSION_MAJOR
888 svp = hv_fetch(action, "minkeypage", 10, FALSE);
889 info->btree.minkeypage = svp ? SvIV(*svp) : 0;
891 svp = hv_fetch(action, "maxkeypage", 10, FALSE);
892 info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
895 svp = hv_fetch(action, "psize", 5, FALSE);
896 info->db_BT_psize = svp ? SvIV(*svp) : 0;
898 svp = hv_fetch(action, "lorder", 6, FALSE);
899 info->db_BT_lorder = svp ? SvIV(*svp) : 0;
904 else if (sv_isa(sv, "DB_File::RECNOINFO"))
907 croak("DB_File can only tie an array to a DB_RECNO database");
909 RETVAL->type = DB_RECNO ;
910 openinfo = (void *)info ;
912 info->db_RE_flags = 0 ;
914 svp = hv_fetch(action, "flags", 5, FALSE);
915 info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
917 svp = hv_fetch(action, "reclen", 6, FALSE);
918 info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
920 svp = hv_fetch(action, "cachesize", 9, FALSE);
921 info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
923 svp = hv_fetch(action, "psize", 5, FALSE);
924 info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
926 svp = hv_fetch(action, "lorder", 6, FALSE);
927 info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
929 #ifdef DB_VERSION_MAJOR
930 info->re_source = name ;
933 svp = hv_fetch(action, "bfname", 6, FALSE);
934 if (svp && SvOK(*svp)) {
935 char * ptr = SvPV(*svp,n_a) ;
936 #ifdef DB_VERSION_MAJOR
937 name = (char*) n_a ? ptr : NULL ;
939 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
943 #ifdef DB_VERSION_MAJOR
946 info->db_RE_bfname = NULL ;
949 svp = hv_fetch(action, "bval", 4, FALSE);
950 #ifdef DB_VERSION_MAJOR
951 if (svp && SvOK(*svp))
955 value = (int)*SvPV(*svp, n_a) ;
959 if (info->flags & DB_FIXEDLEN) {
960 info->re_pad = value ;
961 info->flags |= DB_PAD ;
964 info->re_delim = value ;
965 info->flags |= DB_DELIMITER ;
970 if (svp && SvOK(*svp))
973 info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
975 info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
976 DB_flags(info->flags, DB_DELIMITER) ;
981 if (info->db_RE_flags & R_FIXEDLEN)
982 info->db_RE_bval = (u_char) ' ' ;
984 info->db_RE_bval = (u_char) '\n' ;
985 DB_flags(info->flags, DB_DELIMITER) ;
990 info->flags |= DB_RENUMBER ;
996 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1000 /* OS2 Specific Code */
1004 #endif /* __EMX__ */
1007 #ifdef DB_VERSION_MAJOR
1013 /* Map 1.x flags to 2.x flags */
1014 if ((flags & O_CREAT) == O_CREAT)
1015 Flags |= DB_CREATE ;
1018 if (flags == O_RDONLY)
1020 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1022 Flags |= DB_RDONLY ;
1025 if ((flags & O_TRUNC) == O_TRUNC)
1026 Flags |= DB_TRUNCATE ;
1029 status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
1031 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
1032 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
1034 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1039 RETVAL->dbp = NULL ;
1044 #if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2
1045 RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ;
1047 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
1048 #endif /* DB_LIBRARY_COMPATIBILITY_API */
1054 #else /* Berkeley DB Version > 2 */
1058 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
1063 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
1064 Zero(RETVAL, 1, DB_File_type) ;
1066 /* Default to HASH */
1067 #ifdef DBM_FILTERING
1068 RETVAL->filtering = 0 ;
1069 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
1070 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
1071 #endif /* DBM_FILTERING */
1072 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
1073 RETVAL->type = DB_HASH ;
1075 /* DGH - Next line added to avoid SEGV on existing hash DB */
1078 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
1079 RETVAL->in_memory = (name == NULL) ;
1081 status = db_create(&RETVAL->dbp, NULL,0) ;
1082 /* printf("db_create returned %d %s\n", status, db_strerror(status)) ; */
1084 RETVAL->dbp = NULL ;
1092 croak ("type parameter is not a reference") ;
1094 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
1095 if (svp && SvOK(*svp))
1096 action = (HV*) SvRV(*svp) ;
1098 croak("internal error") ;
1100 if (sv_isa(sv, "DB_File::HASHINFO"))
1104 croak("DB_File can only tie an associative array to a DB_HASH database") ;
1106 RETVAL->type = DB_HASH ;
1108 svp = hv_fetch(action, "hash", 4, FALSE);
1110 if (svp && SvOK(*svp))
1112 (void)dbp->set_h_hash(dbp, hash_cb) ;
1113 RETVAL->hash = newSVsv(*svp) ;
1116 svp = hv_fetch(action, "ffactor", 7, FALSE);
1118 (void)dbp->set_h_ffactor(dbp, SvIV(*svp)) ;
1120 svp = hv_fetch(action, "nelem", 5, FALSE);
1122 (void)dbp->set_h_nelem(dbp, SvIV(*svp)) ;
1124 svp = hv_fetch(action, "bsize", 5, FALSE);
1126 (void)dbp->set_pagesize(dbp, SvIV(*svp));
1128 svp = hv_fetch(action, "cachesize", 9, FALSE);
1130 (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1132 svp = hv_fetch(action, "lorder", 6, FALSE);
1134 (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
1138 else if (sv_isa(sv, "DB_File::BTREEINFO"))
1141 croak("DB_File can only tie an associative array to a DB_BTREE database");
1143 RETVAL->type = DB_BTREE ;
1145 svp = hv_fetch(action, "compare", 7, FALSE);
1146 if (svp && SvOK(*svp))
1148 (void)dbp->set_bt_compare(dbp, btree_compare) ;
1149 RETVAL->compare = newSVsv(*svp) ;
1152 svp = hv_fetch(action, "prefix", 6, FALSE);
1153 if (svp && SvOK(*svp))
1155 (void)dbp->set_bt_prefix(dbp, btree_prefix) ;
1156 RETVAL->prefix = newSVsv(*svp) ;
1159 svp = hv_fetch(action, "flags", 5, FALSE);
1161 (void)dbp->set_flags(dbp, SvIV(*svp)) ;
1163 svp = hv_fetch(action, "cachesize", 9, FALSE);
1165 (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1167 svp = hv_fetch(action, "psize", 5, FALSE);
1169 (void)dbp->set_pagesize(dbp, SvIV(*svp)) ;
1171 svp = hv_fetch(action, "lorder", 6, FALSE);
1173 (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
1178 else if (sv_isa(sv, "DB_File::RECNOINFO"))
1183 croak("DB_File can only tie an array to a DB_RECNO database");
1185 RETVAL->type = DB_RECNO ;
1187 svp = hv_fetch(action, "flags", 5, FALSE);
1189 int flags = SvIV(*svp) ;
1190 /* remove FIXDLEN, if present */
1191 if (flags & DB_FIXEDLEN) {
1193 flags &= ~DB_FIXEDLEN ;
1197 svp = hv_fetch(action, "cachesize", 9, FALSE);
1199 status = dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1202 svp = hv_fetch(action, "psize", 5, FALSE);
1204 status = dbp->set_pagesize(dbp, SvIV(*svp)) ;
1207 svp = hv_fetch(action, "lorder", 6, FALSE);
1209 status = dbp->set_lorder(dbp, SvIV(*svp)) ;
1212 svp = hv_fetch(action, "bval", 4, FALSE);
1213 if (svp && SvOK(*svp))
1217 value = (int)*SvPV(*svp, n_a) ;
1219 value = SvIV(*svp) ;
1222 status = dbp->set_re_pad(dbp, value) ;
1225 status = dbp->set_re_delim(dbp, value) ;
1231 svp = hv_fetch(action, "reclen", 6, FALSE);
1233 u_int32_t len = (u_int32_t)SvIV(*svp) ;
1234 status = dbp->set_re_len(dbp, len) ;
1239 status = dbp->set_re_source(dbp, name) ;
1243 svp = hv_fetch(action, "bfname", 6, FALSE);
1244 if (svp && SvOK(*svp)) {
1245 char * ptr = SvPV(*svp,n_a) ;
1246 name = (char*) n_a ? ptr : NULL ;
1252 status = dbp->set_flags(dbp, DB_RENUMBER) ;
1255 (void)dbp->set_flags(dbp, flags) ;
1260 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1267 /* Map 1.x flags to 3.x flags */
1268 if ((flags & O_CREAT) == O_CREAT)
1269 Flags |= DB_CREATE ;
1272 if (flags == O_RDONLY)
1274 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1276 Flags |= DB_RDONLY ;
1279 if ((flags & O_TRUNC) == O_TRUNC)
1280 Flags |= DB_TRUNCATE ;
1283 status = (RETVAL->dbp->open)(RETVAL->dbp, name, NULL, RETVAL->type,
1285 /* printf("open returned %d %s\n", status, db_strerror(status)) ; */
1288 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1290 /* printf("cursor returned %d %s\n", status, db_strerror(status)) ; */
1293 RETVAL->dbp = NULL ;
1299 #endif /* Berkeley DB Version > 2 */
1301 } /* ParseOpenInfo */
1305 #ifdef CAN_PROTOTYPE
1306 constant(char *name, int arg)
1318 if (strEQ(name, "BTREEMAGIC"))
1324 if (strEQ(name, "BTREEVERSION"))
1326 return BTREEVERSION;
1334 if (strEQ(name, "DB_LOCK"))
1340 if (strEQ(name, "DB_SHMEM"))
1346 if (strEQ(name, "DB_TXN"))
1360 if (strEQ(name, "HASHMAGIC"))
1366 if (strEQ(name, "HASHVERSION"))
1382 if (strEQ(name, "MAX_PAGE_NUMBER"))
1383 #ifdef MAX_PAGE_NUMBER
1384 return (U32)MAX_PAGE_NUMBER;
1388 if (strEQ(name, "MAX_PAGE_OFFSET"))
1389 #ifdef MAX_PAGE_OFFSET
1390 return MAX_PAGE_OFFSET;
1394 if (strEQ(name, "MAX_REC_NUMBER"))
1395 #ifdef MAX_REC_NUMBER
1396 return (U32)MAX_REC_NUMBER;
1410 if (strEQ(name, "RET_ERROR"))
1416 if (strEQ(name, "RET_SPECIAL"))
1422 if (strEQ(name, "RET_SUCCESS"))
1428 if (strEQ(name, "R_CURSOR"))
1434 if (strEQ(name, "R_DUP"))
1440 if (strEQ(name, "R_FIRST"))
1446 if (strEQ(name, "R_FIXEDLEN"))
1452 if (strEQ(name, "R_IAFTER"))
1458 if (strEQ(name, "R_IBEFORE"))
1464 if (strEQ(name, "R_LAST"))
1470 if (strEQ(name, "R_NEXT"))
1476 if (strEQ(name, "R_NOKEY"))
1482 if (strEQ(name, "R_NOOVERWRITE"))
1483 #ifdef R_NOOVERWRITE
1484 return R_NOOVERWRITE;
1488 if (strEQ(name, "R_PREV"))
1494 if (strEQ(name, "R_RECNOSYNC"))
1500 if (strEQ(name, "R_SETCURSOR"))
1506 if (strEQ(name, "R_SNAPSHOT"))
1540 MODULE = DB_File PACKAGE = DB_File PREFIX = db_
1544 __getBerkeleyDBInfo() ;
1547 empty.data = &zero ;
1548 empty.size = sizeof(recno_t) ;
1558 db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
1565 char * name = (char *) NULL ;
1566 SV * sv = (SV *) NULL ;
1569 if (items >= 3 && SvOK(ST(2)))
1570 name = (char*) SvPV(ST(2), n_a) ;
1575 RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
1576 if (RETVAL->dbp == NULL)
1589 SvREFCNT_dec(db->hash) ;
1591 SvREFCNT_dec(db->compare) ;
1593 SvREFCNT_dec(db->prefix) ;
1594 #ifdef DBM_FILTERING
1595 if (db->filter_fetch_key)
1596 SvREFCNT_dec(db->filter_fetch_key) ;
1597 if (db->filter_store_key)
1598 SvREFCNT_dec(db->filter_store_key) ;
1599 if (db->filter_fetch_value)
1600 SvREFCNT_dec(db->filter_fetch_value) ;
1601 if (db->filter_store_value)
1602 SvREFCNT_dec(db->filter_store_value) ;
1603 #endif /* DBM_FILTERING */
1605 #ifdef DB_VERSION_MAJOR
1612 db_DELETE(db, key, flags=0)
1630 RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
1636 db_FETCH(db, key, flags=0)
1646 /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */
1647 RETVAL = db_get(db, key, value, flags) ;
1648 ST(0) = sv_newmortal();
1649 OutputValue(ST(0), value)
1653 db_STORE(db, key, value, flags=0)
1673 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1674 ST(0) = sv_newmortal();
1675 OutputKey(ST(0), key) ;
1688 RETVAL = do_SEQ(db, key, value, R_NEXT) ;
1689 ST(0) = sv_newmortal();
1690 OutputKey(ST(0), key) ;
1694 # These would be nice for RECNO
1713 #ifdef DB_VERSION_MAJOR
1714 /* get the first value */
1715 RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1720 for (i = items-1 ; i > 0 ; --i)
1722 value.data = SvPV(ST(i), n_a) ;
1726 key.size = sizeof(int) ;
1727 #ifdef DB_VERSION_MAJOR
1728 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1730 RETVAL = (Db->put)(Db, &key, &value, R_IBEFORE) ;
1752 /* First get the final value */
1753 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1754 ST(0) = sv_newmortal();
1758 /* the call to del will trash value, so take a copy now */
1759 OutputValue(ST(0), value) ;
1760 RETVAL = db_del(db, key, R_CURSOR) ;
1762 sv_setsv(ST(0), &PL_sv_undef);
1778 /* get the first value */
1779 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1780 ST(0) = sv_newmortal();
1784 /* the call to del will trash value, so take a copy now */
1785 OutputValue(ST(0), value) ;
1786 RETVAL = db_del(db, key, R_CURSOR) ;
1788 sv_setsv (ST(0), &PL_sv_undef) ;
1809 /* Set the Cursor to the Last element */
1810 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1811 #ifndef DB_VERSION_MAJOR
1816 keyval = *(int*)key.data ;
1819 for (i = 1 ; i < items ; ++i)
1821 value.data = SvPV(ST(i), n_a) ;
1824 key.data = &keyval ;
1825 key.size = sizeof(int) ;
1826 RETVAL = (Db->put)(Db, TXN &key, &value, 0) ;
1838 ALIAS: FETCHSIZE = 1
1841 RETVAL = GetArrayLength(aTHX_ db) ;
1847 # Now provide an interface to the rest of the DB functionality
1851 db_del(db, key, flags=0)
1857 RETVAL = db_del(db, key, flags) ;
1858 #ifdef DB_VERSION_MAJOR
1861 else if (RETVAL == DB_NOTFOUND)
1869 db_get(db, key, value, flags=0)
1877 RETVAL = db_get(db, key, value, flags) ;
1878 #ifdef DB_VERSION_MAJOR
1881 else if (RETVAL == DB_NOTFOUND)
1889 db_put(db, key, value, flags=0)
1896 RETVAL = db_put(db, key, value, flags) ;
1897 #ifdef DB_VERSION_MAJOR
1900 else if (RETVAL == DB_KEYEXIST)
1905 key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
1913 #ifdef DB_VERSION_MAJOR
1915 status = (db->in_memory
1917 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
1921 RETVAL = (db->in_memory
1923 : ((db->dbp)->fd)(db->dbp) ) ;
1929 db_sync(db, flags=0)
1934 RETVAL = db_sync(db, flags) ;
1935 #ifdef DB_VERSION_MAJOR
1944 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)
1964 #ifdef DBM_FILTERING
1966 #define setFilter(type) \
1969 RETVAL = sv_mortalcopy(db->type) ; \
1971 if (db->type && (code == &PL_sv_undef)) { \
1972 SvREFCNT_dec(db->type) ; \
1977 sv_setsv(db->type, code) ; \
1979 db->type = newSVsv(code) ; \
1985 filter_fetch_key(db, code)
1988 SV * RETVAL = &PL_sv_undef ;
1990 setFilter(filter_fetch_key) ;
1993 filter_store_key(db, code)
1996 SV * RETVAL = &PL_sv_undef ;
1998 setFilter(filter_store_key) ;
2001 filter_fetch_value(db, code)
2004 SV * RETVAL = &PL_sv_undef ;
2006 setFilter(filter_fetch_value) ;
2009 filter_store_value(db, code)
2012 SV * RETVAL = &PL_sv_undef ;
2014 setFilter(filter_store_value) ;
2016 #endif /* DBM_FILTERING */