3 DB_File.xs -- Perl 5 interface to Berkeley DB
5 written by Paul Marquess <Paul.Marquess@btinternet.com>
6 last modified 27th April 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
94 # include "patchlevel.h"
95 # define PERL_REVISION 5
96 # define PERL_VERSION PATCHLEVEL
97 # define PERL_SUBVERSION SUBVERSION
100 #if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 ))
102 # define PL_sv_undef sv_undef
107 /* DEFSV appears first in 5.004_56 */
109 # define DEFSV GvSV(defgv)
112 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
113 * shortly #included by the <db.h>) __attribute__ to the possibly
114 * already defined __attribute__, for example by GNUC or by Perl. */
118 /* If Perl has been compiled with Threads support,the symbol op will
119 be defined here. This clashes with a field name in db.h, so get rid of it.
139 # define newSVpvn(a,b) newSVpv(a,b)
145 #define DBM_FILTERING
148 # define Trace(x) printf x
154 #define DBT_clear(x) Zero(&x, 1, DBT) ;
156 #ifdef DB_VERSION_MAJOR
158 #if DB_VERSION_MAJOR == 2
159 # define BERKELEY_DB_1_OR_2
162 /* map version 2 features & constants onto their version 1 equivalent */
167 #define DB_Prefix_t size_t
172 #define DB_Hash_t u_int32_t
174 /* DBTYPE stays the same */
175 /* HASHINFO, RECNOINFO and BTREEINFO map to DB_INFO */
176 #if DB_VERSION_MAJOR == 2
177 typedef DB_INFO INFO ;
178 #else /* DB_VERSION_MAJOR > 2 */
179 # define DB_FIXEDLEN (0x8000)
180 #endif /* DB_VERSION_MAJOR == 2 */
182 /* version 2 has db_recno_t in place of recno_t */
183 typedef db_recno_t recno_t;
186 #define R_CURSOR DB_SET_RANGE
187 #define R_FIRST DB_FIRST
188 #define R_IAFTER DB_AFTER
189 #define R_IBEFORE DB_BEFORE
190 #define R_LAST DB_LAST
191 #define R_NEXT DB_NEXT
192 #define R_NOOVERWRITE DB_NOOVERWRITE
193 #define R_PREV DB_PREV
195 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
196 # define R_SETCURSOR 0x800000
198 # define R_SETCURSOR (-100)
201 #define R_RECNOSYNC 0
202 #define R_FIXEDLEN DB_FIXEDLEN
206 #define db_HA_hash h_hash
207 #define db_HA_ffactor h_ffactor
208 #define db_HA_nelem h_nelem
209 #define db_HA_bsize db_pagesize
210 #define db_HA_cachesize db_cachesize
211 #define db_HA_lorder db_lorder
213 #define db_BT_compare bt_compare
214 #define db_BT_prefix bt_prefix
215 #define db_BT_flags flags
216 #define db_BT_psize db_pagesize
217 #define db_BT_cachesize db_cachesize
218 #define db_BT_lorder db_lorder
219 #define db_BT_maxkeypage
220 #define db_BT_minkeypage
223 #define db_RE_reclen re_len
224 #define db_RE_flags flags
225 #define db_RE_bval re_pad
226 #define db_RE_bfname re_source
227 #define db_RE_psize db_pagesize
228 #define db_RE_cachesize db_cachesize
229 #define db_RE_lorder db_lorder
233 #define do_SEQ(db, key, value, flag) (db->cursor->c_get)(db->cursor, &key, &value, flag)
236 #define DBT_flags(x) x.flags = 0
237 #define DB_flags(x, v) x |= v
239 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
240 # define flagSet(flags, bitmask) ((flags) & (bitmask))
242 # define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask))
245 #else /* db version 1.x */
247 #define BERKELEY_DB_1_OR_2
260 # define DB_Prefix_t mDB_Prefix_t
267 # define DB_Hash_t mDB_Hash_t
270 #define db_HA_hash hash.hash
271 #define db_HA_ffactor hash.ffactor
272 #define db_HA_nelem hash.nelem
273 #define db_HA_bsize hash.bsize
274 #define db_HA_cachesize hash.cachesize
275 #define db_HA_lorder hash.lorder
277 #define db_BT_compare btree.compare
278 #define db_BT_prefix btree.prefix
279 #define db_BT_flags btree.flags
280 #define db_BT_psize btree.psize
281 #define db_BT_cachesize btree.cachesize
282 #define db_BT_lorder btree.lorder
283 #define db_BT_maxkeypage btree.maxkeypage
284 #define db_BT_minkeypage btree.minkeypage
286 #define db_RE_reclen recno.reclen
287 #define db_RE_flags recno.flags
288 #define db_RE_bval recno.bval
289 #define db_RE_bfname recno.bfname
290 #define db_RE_psize recno.psize
291 #define db_RE_cachesize recno.cachesize
292 #define db_RE_lorder recno.lorder
296 #define do_SEQ(db, key, value, flag) (db->dbp->seq)(db->dbp, &key, &value, flag)
298 #define DB_flags(x, v)
299 #define flagSet(flags, bitmask) ((flags) & (bitmask))
301 #endif /* db version 1 */
305 #define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, TXN &key, flags)
306 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, flags)
307 #define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
309 #define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
310 #define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
312 #ifdef DB_VERSION_MAJOR
313 #define db_DESTROY(db) ( db->cursor->c_close(db->cursor),\
314 (db->dbp->close)(db->dbp, 0) )
315 #define db_close(db) ((db->dbp)->close)(db->dbp, 0)
316 #define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \
317 ? ((db->cursor)->c_del)(db->cursor, 0) \
318 : ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
320 #else /* ! DB_VERSION_MAJOR */
322 #define db_DESTROY(db) ((db->dbp)->close)(db->dbp)
323 #define db_close(db) ((db->dbp)->close)(db->dbp)
324 #define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
325 #define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
327 #endif /* ! DB_VERSION_MAJOR */
330 #define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags)
339 #ifdef BERKELEY_DB_1_OR_2
342 #ifdef DB_VERSION_MAJOR
346 SV * filter_fetch_key ;
347 SV * filter_store_key ;
348 SV * filter_fetch_value ;
349 SV * filter_store_value ;
351 #endif /* DBM_FILTERING */
355 typedef DB_File_type * DB_File ;
360 #define ckFilter(arg,type,name) \
363 /* printf("filtering %s\n", name) ;*/ \
365 croak("recursion detected in %s", name) ; \
366 db->filtering = TRUE ; \
367 save_defsv = newSVsv(DEFSV) ; \
368 sv_setsv(DEFSV, arg) ; \
370 (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \
371 sv_setsv(arg, DEFSV) ; \
372 sv_setsv(DEFSV, save_defsv) ; \
373 SvREFCNT_dec(save_defsv) ; \
374 db->filtering = FALSE ; \
375 /*printf("end of filtering %s\n", name) ;*/ \
380 #define ckFilter(arg,type, name)
382 #endif /* DBM_FILTERING */
384 #define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
386 #define OutputValue(arg, name) \
387 { if (RETVAL == 0) { \
388 my_sv_setpvn(arg, name.data, name.size) ; \
389 ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \
393 #define OutputKey(arg, name) \
396 if (db->type != DB_RECNO) { \
397 my_sv_setpvn(arg, name.data, name.size); \
400 sv_setiv(arg, (I32)*(I32*)name.data - 1); \
401 ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \
406 /* Internal Global Data */
407 static recno_t Value ;
408 static recno_t zero = 0 ;
409 static DB_File CurrentDB ;
410 static DBTKEY empty ;
412 #ifdef DB_VERSION_MAJOR
416 db_put(DB_File db, DBTKEY key, DBT value, u_int flags)
418 db_put(db, key, value, flags)
427 if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) {
431 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
432 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor) != 0)
434 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor, 0) != 0)
438 memset(&l_key, 0, sizeof(l_key));
439 l_key.data = key.data;
440 l_key.size = key.size;
441 memset(&l_value, 0, sizeof(l_value));
442 l_value.data = value.data;
443 l_value.size = value.size;
445 if ( temp_cursor->c_get(temp_cursor, &l_key, &l_value, DB_SET) != 0) {
446 (void)temp_cursor->c_close(temp_cursor);
450 status = temp_cursor->c_put(temp_cursor, &key, &value, flags);
451 (void)temp_cursor->c_close(temp_cursor);
457 if (flagSet(flags, R_CURSOR)) {
458 return ((db->cursor)->c_put)(db->cursor, &key, &value, DB_CURRENT);
461 if (flagSet(flags, R_SETCURSOR)) {
462 if ((db->dbp)->put(db->dbp, NULL, &key, &value, 0) != 0)
464 return ((db->cursor)->c_get)(db->cursor, &key, &value, DB_SET_RANGE);
468 return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
472 #endif /* DB_VERSION_MAJOR */
477 btree_compare(const DBT *key1, const DBT *key2)
479 btree_compare(key1, key2)
488 void * data1, * data2 ;
496 /* As newSVpv will assume that the data pointer is a null terminated C
497 string if the size parameter is 0, make sure that data points to an
498 empty string if the length is 0
511 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
512 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
515 count = perl_call_sv(CurrentDB->compare, G_SCALAR);
520 croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
533 btree_prefix(const DBT *key1, const DBT *key2)
535 btree_prefix(key1, key2)
544 void * data1, * data2 ;
552 /* As newSVpv will assume that the data pointer is a null terminated C
553 string if the size parameter is 0, make sure that data points to an
554 empty string if the length is 0
567 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
568 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
571 count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
576 croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
589 hash_cb(const void *data, u_int32_t size)
608 /* DGH - Next two lines added to fix corrupted stack problem */
614 XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
617 count = perl_call_sv(CurrentDB->hash, G_SCALAR);
622 croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
634 #if defined(TRACE) && defined(BERKELEY_DB_1_OR_2)
638 PrintHash(INFO *hash)
644 printf ("HASH Info\n") ;
645 printf (" hash = %s\n",
646 (hash->db_HA_hash != NULL ? "redefined" : "default")) ;
647 printf (" bsize = %d\n", hash->db_HA_bsize) ;
648 printf (" ffactor = %d\n", hash->db_HA_ffactor) ;
649 printf (" nelem = %d\n", hash->db_HA_nelem) ;
650 printf (" cachesize = %d\n", hash->db_HA_cachesize) ;
651 printf (" lorder = %d\n", hash->db_HA_lorder) ;
657 PrintRecno(INFO *recno)
663 printf ("RECNO Info\n") ;
664 printf (" flags = %d\n", recno->db_RE_flags) ;
665 printf (" cachesize = %d\n", recno->db_RE_cachesize) ;
666 printf (" psize = %d\n", recno->db_RE_psize) ;
667 printf (" lorder = %d\n", recno->db_RE_lorder) ;
668 printf (" reclen = %ul\n", (unsigned long)recno->db_RE_reclen) ;
669 printf (" bval = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
670 printf (" bfname = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
675 PrintBtree(INFO *btree)
681 printf ("BTREE Info\n") ;
682 printf (" compare = %s\n",
683 (btree->db_BT_compare ? "redefined" : "default")) ;
684 printf (" prefix = %s\n",
685 (btree->db_BT_prefix ? "redefined" : "default")) ;
686 printf (" flags = %d\n", btree->db_BT_flags) ;
687 printf (" cachesize = %d\n", btree->db_BT_cachesize) ;
688 printf (" psize = %d\n", btree->db_BT_psize) ;
689 #ifndef DB_VERSION_MAJOR
690 printf (" maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
691 printf (" minkeypage = %d\n", btree->db_BT_minkeypage) ;
693 printf (" lorder = %d\n", btree->db_BT_lorder) ;
698 #define PrintRecno(recno)
699 #define PrintHash(hash)
700 #define PrintBtree(btree)
707 GetArrayLength(pTHX_ DB_File db)
719 RETVAL = do_SEQ(db, key, value, R_LAST) ;
721 RETVAL = *(I32 *)key.data ;
722 else /* No key means empty file */
725 return ((I32)RETVAL) ;
730 GetRecnoKey(pTHX_ DB_File db, I32 value)
732 GetRecnoKey(db, value)
738 /* Get the length of the array */
739 I32 length = GetArrayLength(aTHX_ db) ;
741 /* check for attempt to write before start of array */
742 if (length + value + 1 <= 0)
743 croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
745 value = length + value + 1 ;
756 ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv)
758 ParseOpenInfo(isHASH, name, flags, mode, sv)
767 #ifdef BERKELEY_DB_1_OR_2 /* Berkeley DB Version 1 or 2 */
771 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
772 void * openinfo = NULL ;
773 INFO * info = &RETVAL->info ;
776 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
777 Zero(RETVAL, 1, DB_File_type) ;
779 /* Default to HASH */
781 RETVAL->filtering = 0 ;
782 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
783 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
784 #endif /* DBM_FILTERING */
785 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
786 RETVAL->type = DB_HASH ;
788 /* DGH - Next line added to avoid SEGV on existing hash DB */
791 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
792 RETVAL->in_memory = (name == NULL) ;
797 croak ("type parameter is not a reference") ;
799 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
800 if (svp && SvOK(*svp))
801 action = (HV*) SvRV(*svp) ;
803 croak("internal error") ;
805 if (sv_isa(sv, "DB_File::HASHINFO"))
809 croak("DB_File can only tie an associative array to a DB_HASH database") ;
811 RETVAL->type = DB_HASH ;
812 openinfo = (void*)info ;
814 svp = hv_fetch(action, "hash", 4, FALSE);
816 if (svp && SvOK(*svp))
818 info->db_HA_hash = hash_cb ;
819 RETVAL->hash = newSVsv(*svp) ;
822 info->db_HA_hash = NULL ;
824 svp = hv_fetch(action, "ffactor", 7, FALSE);
825 info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
827 svp = hv_fetch(action, "nelem", 5, FALSE);
828 info->db_HA_nelem = svp ? SvIV(*svp) : 0;
830 svp = hv_fetch(action, "bsize", 5, FALSE);
831 info->db_HA_bsize = svp ? SvIV(*svp) : 0;
833 svp = hv_fetch(action, "cachesize", 9, FALSE);
834 info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
836 svp = hv_fetch(action, "lorder", 6, FALSE);
837 info->db_HA_lorder = svp ? SvIV(*svp) : 0;
841 else if (sv_isa(sv, "DB_File::BTREEINFO"))
844 croak("DB_File can only tie an associative array to a DB_BTREE database");
846 RETVAL->type = DB_BTREE ;
847 openinfo = (void*)info ;
849 svp = hv_fetch(action, "compare", 7, FALSE);
850 if (svp && SvOK(*svp))
852 info->db_BT_compare = btree_compare ;
853 RETVAL->compare = newSVsv(*svp) ;
856 info->db_BT_compare = NULL ;
858 svp = hv_fetch(action, "prefix", 6, FALSE);
859 if (svp && SvOK(*svp))
861 info->db_BT_prefix = btree_prefix ;
862 RETVAL->prefix = newSVsv(*svp) ;
865 info->db_BT_prefix = NULL ;
867 svp = hv_fetch(action, "flags", 5, FALSE);
868 info->db_BT_flags = svp ? SvIV(*svp) : 0;
870 svp = hv_fetch(action, "cachesize", 9, FALSE);
871 info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
873 #ifndef DB_VERSION_MAJOR
874 svp = hv_fetch(action, "minkeypage", 10, FALSE);
875 info->btree.minkeypage = svp ? SvIV(*svp) : 0;
877 svp = hv_fetch(action, "maxkeypage", 10, FALSE);
878 info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
881 svp = hv_fetch(action, "psize", 5, FALSE);
882 info->db_BT_psize = svp ? SvIV(*svp) : 0;
884 svp = hv_fetch(action, "lorder", 6, FALSE);
885 info->db_BT_lorder = svp ? SvIV(*svp) : 0;
890 else if (sv_isa(sv, "DB_File::RECNOINFO"))
893 croak("DB_File can only tie an array to a DB_RECNO database");
895 RETVAL->type = DB_RECNO ;
896 openinfo = (void *)info ;
898 info->db_RE_flags = 0 ;
900 svp = hv_fetch(action, "flags", 5, FALSE);
901 info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
903 svp = hv_fetch(action, "reclen", 6, FALSE);
904 info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
906 svp = hv_fetch(action, "cachesize", 9, FALSE);
907 info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
909 svp = hv_fetch(action, "psize", 5, FALSE);
910 info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
912 svp = hv_fetch(action, "lorder", 6, FALSE);
913 info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
915 #ifdef DB_VERSION_MAJOR
916 info->re_source = name ;
919 svp = hv_fetch(action, "bfname", 6, FALSE);
920 if (svp && SvOK(*svp)) {
921 char * ptr = SvPV(*svp,n_a) ;
922 #ifdef DB_VERSION_MAJOR
923 name = (char*) n_a ? ptr : NULL ;
925 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
929 #ifdef DB_VERSION_MAJOR
932 info->db_RE_bfname = NULL ;
935 svp = hv_fetch(action, "bval", 4, FALSE);
936 #ifdef DB_VERSION_MAJOR
937 if (svp && SvOK(*svp))
941 value = (int)*SvPV(*svp, n_a) ;
945 if (info->flags & DB_FIXEDLEN) {
946 info->re_pad = value ;
947 info->flags |= DB_PAD ;
950 info->re_delim = value ;
951 info->flags |= DB_DELIMITER ;
956 if (svp && SvOK(*svp))
959 info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
961 info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
962 DB_flags(info->flags, DB_DELIMITER) ;
967 if (info->db_RE_flags & R_FIXEDLEN)
968 info->db_RE_bval = (u_char) ' ' ;
970 info->db_RE_bval = (u_char) '\n' ;
971 DB_flags(info->flags, DB_DELIMITER) ;
976 info->flags |= DB_RENUMBER ;
982 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
986 /* OS2 Specific Code */
993 #ifdef DB_VERSION_MAJOR
999 /* Map 1.x flags to 2.x flags */
1000 if ((flags & O_CREAT) == O_CREAT)
1001 Flags |= DB_CREATE ;
1004 if (flags == O_RDONLY)
1006 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1008 Flags |= DB_RDONLY ;
1011 if ((flags & O_TRUNC) == O_TRUNC)
1012 Flags |= DB_TRUNCATE ;
1015 status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
1017 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
1018 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
1020 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1025 RETVAL->dbp = NULL ;
1030 #if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2
1031 RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ;
1033 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
1034 #endif /* DB_LIBRARY_COMPATIBILITY_API */
1040 #else /* Berkeley DB Version > 2 */
1044 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
1049 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
1050 Zero(RETVAL, 1, DB_File_type) ;
1052 /* Default to HASH */
1053 #ifdef DBM_FILTERING
1054 RETVAL->filtering = 0 ;
1055 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
1056 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
1057 #endif /* DBM_FILTERING */
1058 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
1059 RETVAL->type = DB_HASH ;
1061 /* DGH - Next line added to avoid SEGV on existing hash DB */
1064 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
1065 RETVAL->in_memory = (name == NULL) ;
1067 status = db_create(&RETVAL->dbp, NULL,0) ;
1068 /* printf("db_create returned %d %s\n", status, db_strerror(status)) ; */
1070 RETVAL->dbp = NULL ;
1078 croak ("type parameter is not a reference") ;
1080 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
1081 if (svp && SvOK(*svp))
1082 action = (HV*) SvRV(*svp) ;
1084 croak("internal error") ;
1086 if (sv_isa(sv, "DB_File::HASHINFO"))
1090 croak("DB_File can only tie an associative array to a DB_HASH database") ;
1092 RETVAL->type = DB_HASH ;
1094 svp = hv_fetch(action, "hash", 4, FALSE);
1096 if (svp && SvOK(*svp))
1098 (void)dbp->set_h_hash(dbp, hash_cb) ;
1099 RETVAL->hash = newSVsv(*svp) ;
1102 svp = hv_fetch(action, "ffactor", 7, FALSE);
1104 (void)dbp->set_h_ffactor(dbp, SvIV(*svp)) ;
1106 svp = hv_fetch(action, "nelem", 5, FALSE);
1108 (void)dbp->set_h_nelem(dbp, SvIV(*svp)) ;
1110 svp = hv_fetch(action, "bsize", 5, FALSE);
1112 (void)dbp->set_pagesize(dbp, SvIV(*svp));
1114 svp = hv_fetch(action, "cachesize", 9, FALSE);
1116 (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1118 svp = hv_fetch(action, "lorder", 6, FALSE);
1120 (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
1124 else if (sv_isa(sv, "DB_File::BTREEINFO"))
1127 croak("DB_File can only tie an associative array to a DB_BTREE database");
1129 RETVAL->type = DB_BTREE ;
1131 svp = hv_fetch(action, "compare", 7, FALSE);
1132 if (svp && SvOK(*svp))
1134 (void)dbp->set_bt_compare(dbp, btree_compare) ;
1135 RETVAL->compare = newSVsv(*svp) ;
1138 svp = hv_fetch(action, "prefix", 6, FALSE);
1139 if (svp && SvOK(*svp))
1141 (void)dbp->set_bt_prefix(dbp, btree_prefix) ;
1142 RETVAL->prefix = newSVsv(*svp) ;
1145 svp = hv_fetch(action, "flags", 5, FALSE);
1147 (void)dbp->set_flags(dbp, SvIV(*svp)) ;
1149 svp = hv_fetch(action, "cachesize", 9, FALSE);
1151 (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1153 svp = hv_fetch(action, "psize", 5, FALSE);
1155 (void)dbp->set_pagesize(dbp, SvIV(*svp)) ;
1157 svp = hv_fetch(action, "lorder", 6, FALSE);
1159 (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
1164 else if (sv_isa(sv, "DB_File::RECNOINFO"))
1169 croak("DB_File can only tie an array to a DB_RECNO database");
1171 RETVAL->type = DB_RECNO ;
1173 svp = hv_fetch(action, "flags", 5, FALSE);
1175 int flags = SvIV(*svp) ;
1176 /* remove FIXDLEN, if present */
1177 if (flags & DB_FIXEDLEN) {
1179 flags &= ~DB_FIXEDLEN ;
1183 svp = hv_fetch(action, "cachesize", 9, FALSE);
1185 status = dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1188 svp = hv_fetch(action, "psize", 5, FALSE);
1190 status = dbp->set_pagesize(dbp, SvIV(*svp)) ;
1193 svp = hv_fetch(action, "lorder", 6, FALSE);
1195 status = dbp->set_lorder(dbp, SvIV(*svp)) ;
1198 svp = hv_fetch(action, "bval", 4, FALSE);
1199 if (svp && SvOK(*svp))
1203 value = (int)*SvPV(*svp, n_a) ;
1205 value = SvIV(*svp) ;
1208 status = dbp->set_re_pad(dbp, value) ;
1211 status = dbp->set_re_delim(dbp, value) ;
1217 svp = hv_fetch(action, "reclen", 6, FALSE);
1219 u_int32_t len = (u_int32_t)SvIV(*svp) ;
1220 status = dbp->set_re_len(dbp, len) ;
1225 status = dbp->set_re_source(dbp, name) ;
1229 svp = hv_fetch(action, "bfname", 6, FALSE);
1230 if (svp && SvOK(*svp)) {
1231 char * ptr = SvPV(*svp,n_a) ;
1232 name = (char*) n_a ? ptr : NULL ;
1238 status = dbp->set_flags(dbp, DB_RENUMBER) ;
1241 (void)dbp->set_flags(dbp, flags) ;
1246 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1253 /* Map 1.x flags to 3.x flags */
1254 if ((flags & O_CREAT) == O_CREAT)
1255 Flags |= DB_CREATE ;
1258 if (flags == O_RDONLY)
1260 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1262 Flags |= DB_RDONLY ;
1265 if ((flags & O_TRUNC) == O_TRUNC)
1266 Flags |= DB_TRUNCATE ;
1269 status = RETVAL->dbp->open(RETVAL->dbp, name, NULL, RETVAL->type,
1271 /* printf("open returned %d %s\n", status, db_strerror(status)) ; */
1274 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1276 /* printf("cursor returned %d %s\n", status, db_strerror(status)) ; */
1279 RETVAL->dbp = NULL ;
1285 #endif /* Berkeley DB Version > 2 */
1287 } /* ParseOpenInfo */
1291 #ifdef CAN_PROTOTYPE
1292 constant(char *name, int arg)
1304 if (strEQ(name, "BTREEMAGIC"))
1310 if (strEQ(name, "BTREEVERSION"))
1312 return BTREEVERSION;
1320 if (strEQ(name, "DB_LOCK"))
1326 if (strEQ(name, "DB_SHMEM"))
1332 if (strEQ(name, "DB_TXN"))
1346 if (strEQ(name, "HASHMAGIC"))
1352 if (strEQ(name, "HASHVERSION"))
1368 if (strEQ(name, "MAX_PAGE_NUMBER"))
1369 #ifdef MAX_PAGE_NUMBER
1370 return (U32)MAX_PAGE_NUMBER;
1374 if (strEQ(name, "MAX_PAGE_OFFSET"))
1375 #ifdef MAX_PAGE_OFFSET
1376 return MAX_PAGE_OFFSET;
1380 if (strEQ(name, "MAX_REC_NUMBER"))
1381 #ifdef MAX_REC_NUMBER
1382 return (U32)MAX_REC_NUMBER;
1396 if (strEQ(name, "RET_ERROR"))
1402 if (strEQ(name, "RET_SPECIAL"))
1408 if (strEQ(name, "RET_SUCCESS"))
1414 if (strEQ(name, "R_CURSOR"))
1420 if (strEQ(name, "R_DUP"))
1426 if (strEQ(name, "R_FIRST"))
1432 if (strEQ(name, "R_FIXEDLEN"))
1438 if (strEQ(name, "R_IAFTER"))
1444 if (strEQ(name, "R_IBEFORE"))
1450 if (strEQ(name, "R_LAST"))
1456 if (strEQ(name, "R_NEXT"))
1462 if (strEQ(name, "R_NOKEY"))
1468 if (strEQ(name, "R_NOOVERWRITE"))
1469 #ifdef R_NOOVERWRITE
1470 return R_NOOVERWRITE;
1474 if (strEQ(name, "R_PREV"))
1480 if (strEQ(name, "R_RECNOSYNC"))
1486 if (strEQ(name, "R_SETCURSOR"))
1492 if (strEQ(name, "R_SNAPSHOT"))
1526 MODULE = DB_File PACKAGE = DB_File PREFIX = db_
1530 __getBerkeleyDBInfo() ;
1533 empty.data = &zero ;
1534 empty.size = sizeof(recno_t) ;
1544 db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
1551 char * name = (char *) NULL ;
1552 SV * sv = (SV *) NULL ;
1555 if (items >= 3 && SvOK(ST(2)))
1556 name = (char*) SvPV(ST(2), n_a) ;
1561 RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
1562 if (RETVAL->dbp == NULL)
1575 SvREFCNT_dec(db->hash) ;
1577 SvREFCNT_dec(db->compare) ;
1579 SvREFCNT_dec(db->prefix) ;
1580 #ifdef DBM_FILTERING
1581 if (db->filter_fetch_key)
1582 SvREFCNT_dec(db->filter_fetch_key) ;
1583 if (db->filter_store_key)
1584 SvREFCNT_dec(db->filter_store_key) ;
1585 if (db->filter_fetch_value)
1586 SvREFCNT_dec(db->filter_fetch_value) ;
1587 if (db->filter_store_value)
1588 SvREFCNT_dec(db->filter_store_value) ;
1589 #endif /* DBM_FILTERING */
1591 #ifdef DB_VERSION_MAJOR
1598 db_DELETE(db, key, flags=0)
1616 RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
1622 db_FETCH(db, key, flags=0)
1632 /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */
1633 RETVAL = db_get(db, key, value, flags) ;
1634 ST(0) = sv_newmortal();
1635 OutputValue(ST(0), value)
1639 db_STORE(db, key, value, flags=0)
1659 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1660 ST(0) = sv_newmortal();
1661 OutputKey(ST(0), key) ;
1674 RETVAL = do_SEQ(db, key, value, R_NEXT) ;
1675 ST(0) = sv_newmortal();
1676 OutputKey(ST(0), key) ;
1680 # These would be nice for RECNO
1699 #ifdef DB_VERSION_MAJOR
1700 /* get the first value */
1701 RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1706 for (i = items-1 ; i > 0 ; --i)
1708 value.data = SvPV(ST(i), n_a) ;
1712 key.size = sizeof(int) ;
1713 #ifdef DB_VERSION_MAJOR
1714 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1716 RETVAL = (Db->put)(Db, &key, &value, R_IBEFORE) ;
1738 /* First get the final value */
1739 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1740 ST(0) = sv_newmortal();
1744 /* the call to del will trash value, so take a copy now */
1745 OutputValue(ST(0), value) ;
1746 RETVAL = db_del(db, key, R_CURSOR) ;
1748 sv_setsv(ST(0), &PL_sv_undef);
1764 /* get the first value */
1765 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1766 ST(0) = sv_newmortal();
1770 /* the call to del will trash value, so take a copy now */
1771 OutputValue(ST(0), value) ;
1772 RETVAL = db_del(db, key, R_CURSOR) ;
1774 sv_setsv (ST(0), &PL_sv_undef) ;
1795 /* Set the Cursor to the Last element */
1796 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1797 #ifndef DB_VERSION_MAJOR
1802 keyval = *(int*)key.data ;
1805 for (i = 1 ; i < items ; ++i)
1807 value.data = SvPV(ST(i), n_a) ;
1810 key.data = &keyval ;
1811 key.size = sizeof(int) ;
1812 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)
1843 RETVAL = db_del(db, key, flags) ;
1844 #ifdef DB_VERSION_MAJOR
1847 else if (RETVAL == DB_NOTFOUND)
1855 db_get(db, key, value, flags=0)
1863 RETVAL = db_get(db, key, value, flags) ;
1864 #ifdef DB_VERSION_MAJOR
1867 else if (RETVAL == DB_NOTFOUND)
1875 db_put(db, key, value, flags=0)
1882 RETVAL = db_put(db, key, value, flags) ;
1883 #ifdef DB_VERSION_MAJOR
1886 else if (RETVAL == DB_KEYEXIST)
1891 key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
1899 #ifdef DB_VERSION_MAJOR
1901 status = (db->in_memory
1903 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
1907 RETVAL = (db->in_memory
1909 : ((db->dbp)->fd)(db->dbp) ) ;
1915 db_sync(db, flags=0)
1920 RETVAL = db_sync(db, flags) ;
1921 #ifdef DB_VERSION_MAJOR
1930 db_seq(db, key, value, flags)
1938 RETVAL = db_seq(db, key, value, flags);
1939 #ifdef DB_VERSION_MAJOR
1942 else if (RETVAL == DB_NOTFOUND)
1950 #ifdef DBM_FILTERING
1952 #define setFilter(type) \
1955 RETVAL = sv_mortalcopy(db->type) ; \
1957 if (db->type && (code == &PL_sv_undef)) { \
1958 SvREFCNT_dec(db->type) ; \
1963 sv_setsv(db->type, code) ; \
1965 db->type = newSVsv(code) ; \
1971 filter_fetch_key(db, code)
1974 SV * RETVAL = &PL_sv_undef ;
1976 setFilter(filter_fetch_key) ;
1979 filter_store_key(db, code)
1982 SV * RETVAL = &PL_sv_undef ;
1984 setFilter(filter_store_key) ;
1987 filter_fetch_value(db, code)
1990 SV * RETVAL = &PL_sv_undef ;
1992 setFilter(filter_fetch_value) ;
1995 filter_store_value(db, code)
1998 SV * RETVAL = &PL_sv_undef ;
2000 setFilter(filter_store_value) ;
2002 #endif /* DBM_FILTERING */