3 DB_File.xs -- Perl 5 interface to Berkeley DB
5 written by Paul Marquess <Paul.Marquess@btinternet.com>
6 last modified 7th September 1999
9 All comments/suggestions/problems are welcome
11 Copyright (c) 1995-9 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.
92 # include "patchlevel.h"
93 # define PERL_REVISION 5
94 # define PERL_VERSION PATCHLEVEL
95 # define PERL_SUBVERSION SUBVERSION
98 #if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 ))
100 # define PL_sv_undef sv_undef
105 /* DEFSV appears first in 5.004_56 */
107 # define DEFSV GvSV(defgv)
110 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
111 * shortly #included by the <db.h>) __attribute__ to the possibly
112 * already defined __attribute__, for example by GNUC or by Perl. */
116 /* If Perl has been compiled with Threads support,the symbol op will
117 be defined here. This clashes with a field name in db.h, so get rid of it.
137 # define newSVpvn(a,b) newSVpv(a,b)
143 #define DBM_FILTERING
146 # define Trace(x) printf x
152 #define DBT_clear(x) Zero(&x, 1, DBT) ;
154 #ifdef DB_VERSION_MAJOR
156 #if DB_VERSION_MAJOR == 2
157 # define BERKELEY_DB_1_OR_2
160 /* map version 2 features & constants onto their version 1 equivalent */
165 #define DB_Prefix_t size_t
170 #define DB_Hash_t u_int32_t
172 /* DBTYPE stays the same */
173 /* HASHINFO, RECNOINFO and BTREEINFO map to DB_INFO */
174 #if DB_VERSION_MAJOR == 2
175 typedef DB_INFO INFO ;
176 #else /* DB_VERSION_MAJOR > 2 */
177 # define DB_FIXEDLEN (0x8000)
178 #endif /* DB_VERSION_MAJOR == 2 */
180 /* version 2 has db_recno_t in place of recno_t */
181 typedef db_recno_t recno_t;
184 #define R_CURSOR DB_SET_RANGE
185 #define R_FIRST DB_FIRST
186 #define R_IAFTER DB_AFTER
187 #define R_IBEFORE DB_BEFORE
188 #define R_LAST DB_LAST
189 #define R_NEXT DB_NEXT
190 #define R_NOOVERWRITE DB_NOOVERWRITE
191 #define R_PREV DB_PREV
193 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
194 # define R_SETCURSOR 0x800000
196 # define R_SETCURSOR (-100)
199 #define R_RECNOSYNC 0
200 #define R_FIXEDLEN DB_FIXEDLEN
204 #define db_HA_hash h_hash
205 #define db_HA_ffactor h_ffactor
206 #define db_HA_nelem h_nelem
207 #define db_HA_bsize db_pagesize
208 #define db_HA_cachesize db_cachesize
209 #define db_HA_lorder db_lorder
211 #define db_BT_compare bt_compare
212 #define db_BT_prefix bt_prefix
213 #define db_BT_flags flags
214 #define db_BT_psize db_pagesize
215 #define db_BT_cachesize db_cachesize
216 #define db_BT_lorder db_lorder
217 #define db_BT_maxkeypage
218 #define db_BT_minkeypage
221 #define db_RE_reclen re_len
222 #define db_RE_flags flags
223 #define db_RE_bval re_pad
224 #define db_RE_bfname re_source
225 #define db_RE_psize db_pagesize
226 #define db_RE_cachesize db_cachesize
227 #define db_RE_lorder db_lorder
231 #define do_SEQ(db, key, value, flag) (db->cursor->c_get)(db->cursor, &key, &value, flag)
234 #define DBT_flags(x) x.flags = 0
235 #define DB_flags(x, v) x |= v
237 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
238 # define flagSet(flags, bitmask) ((flags) & (bitmask))
240 # define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask))
243 #else /* db version 1.x */
245 #define BERKELEY_DB_1_OR_2
258 # define DB_Prefix_t mDB_Prefix_t
265 # define DB_Hash_t mDB_Hash_t
268 #define db_HA_hash hash.hash
269 #define db_HA_ffactor hash.ffactor
270 #define db_HA_nelem hash.nelem
271 #define db_HA_bsize hash.bsize
272 #define db_HA_cachesize hash.cachesize
273 #define db_HA_lorder hash.lorder
275 #define db_BT_compare btree.compare
276 #define db_BT_prefix btree.prefix
277 #define db_BT_flags btree.flags
278 #define db_BT_psize btree.psize
279 #define db_BT_cachesize btree.cachesize
280 #define db_BT_lorder btree.lorder
281 #define db_BT_maxkeypage btree.maxkeypage
282 #define db_BT_minkeypage btree.minkeypage
284 #define db_RE_reclen recno.reclen
285 #define db_RE_flags recno.flags
286 #define db_RE_bval recno.bval
287 #define db_RE_bfname recno.bfname
288 #define db_RE_psize recno.psize
289 #define db_RE_cachesize recno.cachesize
290 #define db_RE_lorder recno.lorder
294 #define do_SEQ(db, key, value, flag) (db->dbp->seq)(db->dbp, &key, &value, flag)
296 #define DB_flags(x, v)
297 #define flagSet(flags, bitmask) ((flags) & (bitmask))
299 #endif /* db version 1 */
303 #define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, TXN &key, flags)
304 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, flags)
305 #define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
307 #define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
308 #define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
310 #ifdef DB_VERSION_MAJOR
311 #define db_DESTROY(db) ( db->cursor->c_close(db->cursor),\
312 (db->dbp->close)(db->dbp, 0) )
313 #define db_close(db) ((db->dbp)->close)(db->dbp, 0)
314 #define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \
315 ? ((db->cursor)->c_del)(db->cursor, 0) \
316 : ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
318 #else /* ! DB_VERSION_MAJOR */
320 #define db_DESTROY(db) ((db->dbp)->close)(db->dbp)
321 #define db_close(db) ((db->dbp)->close)(db->dbp)
322 #define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
323 #define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
325 #endif /* ! DB_VERSION_MAJOR */
328 #define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags)
337 #ifdef BERKELEY_DB_1_OR_2
340 #ifdef DB_VERSION_MAJOR
344 SV * filter_fetch_key ;
345 SV * filter_store_key ;
346 SV * filter_fetch_value ;
347 SV * filter_store_value ;
349 #endif /* DBM_FILTERING */
353 typedef DB_File_type * DB_File ;
358 #define ckFilter(arg,type,name) \
361 /* printf("filtering %s\n", name) ;*/ \
363 croak("recursion detected in %s", name) ; \
364 db->filtering = TRUE ; \
365 save_defsv = newSVsv(DEFSV) ; \
366 sv_setsv(DEFSV, arg) ; \
368 (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \
369 sv_setsv(arg, DEFSV) ; \
370 sv_setsv(DEFSV, save_defsv) ; \
371 SvREFCNT_dec(save_defsv) ; \
372 db->filtering = FALSE ; \
373 /*printf("end of filtering %s\n", name) ;*/ \
378 #define ckFilter(arg,type, name)
380 #endif /* DBM_FILTERING */
382 #define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
384 #define OutputValue(arg, name) \
385 { if (RETVAL == 0) { \
386 my_sv_setpvn(arg, name.data, name.size) ; \
387 ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \
391 #define OutputKey(arg, name) \
394 if (db->type != DB_RECNO) { \
395 my_sv_setpvn(arg, name.data, name.size); \
398 sv_setiv(arg, (I32)*(I32*)name.data - 1); \
399 ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \
404 /* Internal Global Data */
405 static recno_t Value ;
406 static recno_t zero = 0 ;
407 static DB_File CurrentDB ;
408 static DBTKEY empty ;
410 #ifdef DB_VERSION_MAJOR
414 db_put(DB_File db, DBTKEY key, DBT value, u_int flags)
416 db_put(db, key, value, flags)
425 if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) {
429 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
430 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor) != 0)
432 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor, 0) != 0)
436 memset(&l_key, 0, sizeof(l_key));
437 l_key.data = key.data;
438 l_key.size = key.size;
439 memset(&l_value, 0, sizeof(l_value));
440 l_value.data = value.data;
441 l_value.size = value.size;
443 if ( temp_cursor->c_get(temp_cursor, &l_key, &l_value, DB_SET) != 0) {
444 (void)temp_cursor->c_close(temp_cursor);
448 status = temp_cursor->c_put(temp_cursor, &key, &value, flags);
449 (void)temp_cursor->c_close(temp_cursor);
455 if (flagSet(flags, R_CURSOR)) {
456 return ((db->cursor)->c_put)(db->cursor, &key, &value, DB_CURRENT);
459 if (flagSet(flags, R_SETCURSOR)) {
460 if ((db->dbp)->put(db->dbp, NULL, &key, &value, 0) != 0)
462 return ((db->cursor)->c_get)(db->cursor, &key, &value, DB_SET_RANGE);
466 return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
470 #endif /* DB_VERSION_MAJOR */
475 btree_compare(const DBT *key1, const DBT *key2)
477 btree_compare(key1, key2)
486 void * data1, * data2 ;
494 /* As newSVpv will assume that the data pointer is a null terminated C
495 string if the size parameter is 0, make sure that data points to an
496 empty string if the length is 0
509 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
510 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
513 count = perl_call_sv(CurrentDB->compare, G_SCALAR);
518 croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
531 btree_prefix(const DBT *key1, const DBT *key2)
533 btree_prefix(key1, key2)
542 void * data1, * data2 ;
550 /* As newSVpv will assume that the data pointer is a null terminated C
551 string if the size parameter is 0, make sure that data points to an
552 empty string if the length is 0
565 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
566 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
569 count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
574 croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
587 hash_cb(const void *data, size_t size)
606 /* DGH - Next two lines added to fix corrupted stack problem */
612 XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
615 count = perl_call_sv(CurrentDB->hash, G_SCALAR);
620 croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
632 #if defined(TRACE) && defined(BERKELEY_DB_1_OR_2)
636 PrintHash(INFO *hash)
642 printf ("HASH Info\n") ;
643 printf (" hash = %s\n",
644 (hash->db_HA_hash != NULL ? "redefined" : "default")) ;
645 printf (" bsize = %d\n", hash->db_HA_bsize) ;
646 printf (" ffactor = %d\n", hash->db_HA_ffactor) ;
647 printf (" nelem = %d\n", hash->db_HA_nelem) ;
648 printf (" cachesize = %d\n", hash->db_HA_cachesize) ;
649 printf (" lorder = %d\n", hash->db_HA_lorder) ;
655 PrintRecno(INFO *recno)
661 printf ("RECNO Info\n") ;
662 printf (" flags = %d\n", recno->db_RE_flags) ;
663 printf (" cachesize = %d\n", recno->db_RE_cachesize) ;
664 printf (" psize = %d\n", recno->db_RE_psize) ;
665 printf (" lorder = %d\n", recno->db_RE_lorder) ;
666 printf (" reclen = %ul\n", (unsigned long)recno->db_RE_reclen) ;
667 printf (" bval = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
668 printf (" bfname = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
673 PrintBtree(INFO *btree)
679 printf ("BTREE Info\n") ;
680 printf (" compare = %s\n",
681 (btree->db_BT_compare ? "redefined" : "default")) ;
682 printf (" prefix = %s\n",
683 (btree->db_BT_prefix ? "redefined" : "default")) ;
684 printf (" flags = %d\n", btree->db_BT_flags) ;
685 printf (" cachesize = %d\n", btree->db_BT_cachesize) ;
686 printf (" psize = %d\n", btree->db_BT_psize) ;
687 #ifndef DB_VERSION_MAJOR
688 printf (" maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
689 printf (" minkeypage = %d\n", btree->db_BT_minkeypage) ;
691 printf (" lorder = %d\n", btree->db_BT_lorder) ;
696 #define PrintRecno(recno)
697 #define PrintHash(hash)
698 #define PrintBtree(btree)
705 GetArrayLength(pTHX_ DB_File db)
717 RETVAL = do_SEQ(db, key, value, R_LAST) ;
719 RETVAL = *(I32 *)key.data ;
720 else /* No key means empty file */
723 return ((I32)RETVAL) ;
728 GetRecnoKey(pTHX_ DB_File db, I32 value)
730 GetRecnoKey(db, value)
736 /* Get the length of the array */
737 I32 length = GetArrayLength(aTHX_ db) ;
739 /* check for attempt to write before start of array */
740 if (length + value + 1 <= 0)
741 croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
743 value = length + value + 1 ;
754 ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv)
756 ParseOpenInfo(isHASH, name, flags, mode, sv)
765 #ifdef BERKELEY_DB_1_OR_2 /* Berkeley DB Version 1 or 2 */
769 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
770 void * openinfo = NULL ;
771 INFO * info = &RETVAL->info ;
774 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
775 Zero(RETVAL, 1, DB_File_type) ;
777 /* Default to HASH */
779 RETVAL->filtering = 0 ;
780 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
781 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
782 #endif /* DBM_FILTERING */
783 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
784 RETVAL->type = DB_HASH ;
786 /* DGH - Next line added to avoid SEGV on existing hash DB */
789 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
790 RETVAL->in_memory = (name == NULL) ;
795 croak ("type parameter is not a reference") ;
797 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
798 if (svp && SvOK(*svp))
799 action = (HV*) SvRV(*svp) ;
801 croak("internal error") ;
803 if (sv_isa(sv, "DB_File::HASHINFO"))
807 croak("DB_File can only tie an associative array to a DB_HASH database") ;
809 RETVAL->type = DB_HASH ;
810 openinfo = (void*)info ;
812 svp = hv_fetch(action, "hash", 4, FALSE);
814 if (svp && SvOK(*svp))
816 info->db_HA_hash = hash_cb ;
817 RETVAL->hash = newSVsv(*svp) ;
820 info->db_HA_hash = NULL ;
822 svp = hv_fetch(action, "ffactor", 7, FALSE);
823 info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
825 svp = hv_fetch(action, "nelem", 5, FALSE);
826 info->db_HA_nelem = svp ? SvIV(*svp) : 0;
828 svp = hv_fetch(action, "bsize", 5, FALSE);
829 info->db_HA_bsize = svp ? SvIV(*svp) : 0;
831 svp = hv_fetch(action, "cachesize", 9, FALSE);
832 info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
834 svp = hv_fetch(action, "lorder", 6, FALSE);
835 info->db_HA_lorder = svp ? SvIV(*svp) : 0;
839 else if (sv_isa(sv, "DB_File::BTREEINFO"))
842 croak("DB_File can only tie an associative array to a DB_BTREE database");
844 RETVAL->type = DB_BTREE ;
845 openinfo = (void*)info ;
847 svp = hv_fetch(action, "compare", 7, FALSE);
848 if (svp && SvOK(*svp))
850 info->db_BT_compare = btree_compare ;
851 RETVAL->compare = newSVsv(*svp) ;
854 info->db_BT_compare = NULL ;
856 svp = hv_fetch(action, "prefix", 6, FALSE);
857 if (svp && SvOK(*svp))
859 info->db_BT_prefix = btree_prefix ;
860 RETVAL->prefix = newSVsv(*svp) ;
863 info->db_BT_prefix = NULL ;
865 svp = hv_fetch(action, "flags", 5, FALSE);
866 info->db_BT_flags = svp ? SvIV(*svp) : 0;
868 svp = hv_fetch(action, "cachesize", 9, FALSE);
869 info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
871 #ifndef DB_VERSION_MAJOR
872 svp = hv_fetch(action, "minkeypage", 10, FALSE);
873 info->btree.minkeypage = svp ? SvIV(*svp) : 0;
875 svp = hv_fetch(action, "maxkeypage", 10, FALSE);
876 info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
879 svp = hv_fetch(action, "psize", 5, FALSE);
880 info->db_BT_psize = svp ? SvIV(*svp) : 0;
882 svp = hv_fetch(action, "lorder", 6, FALSE);
883 info->db_BT_lorder = svp ? SvIV(*svp) : 0;
888 else if (sv_isa(sv, "DB_File::RECNOINFO"))
891 croak("DB_File can only tie an array to a DB_RECNO database");
893 RETVAL->type = DB_RECNO ;
894 openinfo = (void *)info ;
896 info->db_RE_flags = 0 ;
898 svp = hv_fetch(action, "flags", 5, FALSE);
899 info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
901 svp = hv_fetch(action, "reclen", 6, FALSE);
902 info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
904 svp = hv_fetch(action, "cachesize", 9, FALSE);
905 info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
907 svp = hv_fetch(action, "psize", 5, FALSE);
908 info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
910 svp = hv_fetch(action, "lorder", 6, FALSE);
911 info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
913 #ifdef DB_VERSION_MAJOR
914 info->re_source = name ;
917 svp = hv_fetch(action, "bfname", 6, FALSE);
918 if (svp && SvOK(*svp)) {
919 char * ptr = SvPV(*svp,n_a) ;
920 #ifdef DB_VERSION_MAJOR
921 name = (char*) n_a ? ptr : NULL ;
923 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
927 #ifdef DB_VERSION_MAJOR
930 info->db_RE_bfname = NULL ;
933 svp = hv_fetch(action, "bval", 4, FALSE);
934 #ifdef DB_VERSION_MAJOR
935 if (svp && SvOK(*svp))
939 value = (int)*SvPV(*svp, n_a) ;
943 if (info->flags & DB_FIXEDLEN) {
944 info->re_pad = value ;
945 info->flags |= DB_PAD ;
948 info->re_delim = value ;
949 info->flags |= DB_DELIMITER ;
954 if (svp && SvOK(*svp))
957 info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
959 info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
960 DB_flags(info->flags, DB_DELIMITER) ;
965 if (info->db_RE_flags & R_FIXEDLEN)
966 info->db_RE_bval = (u_char) ' ' ;
968 info->db_RE_bval = (u_char) '\n' ;
969 DB_flags(info->flags, DB_DELIMITER) ;
974 info->flags |= DB_RENUMBER ;
980 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
984 /* OS2 Specific Code */
991 #ifdef DB_VERSION_MAJOR
997 /* Map 1.x flags to 2.x flags */
998 if ((flags & O_CREAT) == O_CREAT)
1002 if (flags == O_RDONLY)
1004 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1006 Flags |= DB_RDONLY ;
1009 if ((flags & O_TRUNC) == O_TRUNC)
1010 Flags |= DB_TRUNCATE ;
1013 status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
1015 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
1016 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
1018 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1023 RETVAL->dbp = NULL ;
1028 #if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2
1029 RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ;
1031 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
1032 #endif /* DB_LIBRARY_COMPATIBILITY_API */
1038 #else /* Berkeley DB Version > 2 */
1042 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
1047 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
1048 Zero(RETVAL, 1, DB_File_type) ;
1050 /* Default to HASH */
1051 #ifdef DBM_FILTERING
1052 RETVAL->filtering = 0 ;
1053 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
1054 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
1055 #endif /* DBM_FILTERING */
1056 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
1057 RETVAL->type = DB_HASH ;
1059 /* DGH - Next line added to avoid SEGV on existing hash DB */
1062 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
1063 RETVAL->in_memory = (name == NULL) ;
1065 status = db_create(&RETVAL->dbp, NULL,0) ;
1066 /* printf("db_create returned %d %s\n", status, db_strerror(status)) ; */
1068 RETVAL->dbp = NULL ;
1076 croak ("type parameter is not a reference") ;
1078 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
1079 if (svp && SvOK(*svp))
1080 action = (HV*) SvRV(*svp) ;
1082 croak("internal error") ;
1084 if (sv_isa(sv, "DB_File::HASHINFO"))
1088 croak("DB_File can only tie an associative array to a DB_HASH database") ;
1090 RETVAL->type = DB_HASH ;
1092 svp = hv_fetch(action, "hash", 4, FALSE);
1094 if (svp && SvOK(*svp))
1096 (void)dbp->set_h_hash(dbp, hash_cb) ;
1097 RETVAL->hash = newSVsv(*svp) ;
1100 svp = hv_fetch(action, "ffactor", 7, FALSE);
1102 (void)dbp->set_h_ffactor(dbp, SvIV(*svp)) ;
1104 svp = hv_fetch(action, "nelem", 5, FALSE);
1106 (void)dbp->set_h_nelem(dbp, SvIV(*svp)) ;
1108 svp = hv_fetch(action, "bsize", 5, FALSE);
1110 (void)dbp->set_pagesize(dbp, SvIV(*svp));
1112 svp = hv_fetch(action, "cachesize", 9, FALSE);
1114 (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1116 svp = hv_fetch(action, "lorder", 6, FALSE);
1118 (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
1122 else if (sv_isa(sv, "DB_File::BTREEINFO"))
1125 croak("DB_File can only tie an associative array to a DB_BTREE database");
1127 RETVAL->type = DB_BTREE ;
1129 svp = hv_fetch(action, "compare", 7, FALSE);
1130 if (svp && SvOK(*svp))
1132 (void)dbp->set_bt_compare(dbp, btree_compare) ;
1133 RETVAL->compare = newSVsv(*svp) ;
1136 svp = hv_fetch(action, "prefix", 6, FALSE);
1137 if (svp && SvOK(*svp))
1139 (void)dbp->set_bt_prefix(dbp, btree_prefix) ;
1140 RETVAL->prefix = newSVsv(*svp) ;
1143 svp = hv_fetch(action, "flags", 5, FALSE);
1145 (void)dbp->set_flags(dbp, SvIV(*svp)) ;
1147 svp = hv_fetch(action, "cachesize", 9, FALSE);
1149 (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1151 svp = hv_fetch(action, "psize", 5, FALSE);
1153 (void)dbp->set_pagesize(dbp, SvIV(*svp)) ;
1155 svp = hv_fetch(action, "lorder", 6, FALSE);
1157 (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
1162 else if (sv_isa(sv, "DB_File::RECNOINFO"))
1167 croak("DB_File can only tie an array to a DB_RECNO database");
1169 RETVAL->type = DB_RECNO ;
1171 svp = hv_fetch(action, "flags", 5, FALSE);
1173 int flags = SvIV(*svp) ;
1174 /* remove FIXDLEN, if present */
1175 if (flags & DB_FIXEDLEN) {
1177 flags &= ~DB_FIXEDLEN ;
1181 svp = hv_fetch(action, "cachesize", 9, FALSE);
1183 status = dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1186 svp = hv_fetch(action, "psize", 5, FALSE);
1188 status = dbp->set_pagesize(dbp, SvIV(*svp)) ;
1191 svp = hv_fetch(action, "lorder", 6, FALSE);
1193 status = dbp->set_lorder(dbp, SvIV(*svp)) ;
1196 svp = hv_fetch(action, "bval", 4, FALSE);
1197 if (svp && SvOK(*svp))
1201 value = (int)*SvPV(*svp, n_a) ;
1203 value = SvIV(*svp) ;
1206 status = dbp->set_re_pad(dbp, value) ;
1209 status = dbp->set_re_delim(dbp, value) ;
1215 svp = hv_fetch(action, "reclen", 6, FALSE);
1217 u_int32_t len = (u_int32_t)SvIV(*svp) ;
1218 status = dbp->set_re_len(dbp, len) ;
1223 status = dbp->set_re_source(dbp, name) ;
1227 svp = hv_fetch(action, "bfname", 6, FALSE);
1228 if (svp && SvOK(*svp)) {
1229 char * ptr = SvPV(*svp,n_a) ;
1230 name = (char*) n_a ? ptr : NULL ;
1236 status = dbp->set_flags(dbp, DB_RENUMBER) ;
1239 (void)dbp->set_flags(dbp, flags) ;
1244 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1251 /* Map 1.x flags to 3.x flags */
1252 if ((flags & O_CREAT) == O_CREAT)
1253 Flags |= DB_CREATE ;
1256 if (flags == O_RDONLY)
1258 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1260 Flags |= DB_RDONLY ;
1263 if ((flags & O_TRUNC) == O_TRUNC)
1264 Flags |= DB_TRUNCATE ;
1267 status = RETVAL->dbp->open(RETVAL->dbp, name, NULL, RETVAL->type,
1269 /* printf("open returned %d %s\n", status, db_strerror(status)) ; */
1272 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1274 /* printf("cursor returned %d %s\n", status, db_strerror(status)) ; */
1277 RETVAL->dbp = NULL ;
1283 #endif /* Berkeley DB Version > 2 */
1285 } /* ParseOpenInfo */
1289 #ifdef CAN_PROTOTYPE
1290 constant(char *name, int arg)
1302 if (strEQ(name, "BTREEMAGIC"))
1308 if (strEQ(name, "BTREEVERSION"))
1310 return BTREEVERSION;
1318 if (strEQ(name, "DB_LOCK"))
1324 if (strEQ(name, "DB_SHMEM"))
1330 if (strEQ(name, "DB_TXN"))
1344 if (strEQ(name, "HASHMAGIC"))
1350 if (strEQ(name, "HASHVERSION"))
1366 if (strEQ(name, "MAX_PAGE_NUMBER"))
1367 #ifdef MAX_PAGE_NUMBER
1368 return (U32)MAX_PAGE_NUMBER;
1372 if (strEQ(name, "MAX_PAGE_OFFSET"))
1373 #ifdef MAX_PAGE_OFFSET
1374 return MAX_PAGE_OFFSET;
1378 if (strEQ(name, "MAX_REC_NUMBER"))
1379 #ifdef MAX_REC_NUMBER
1380 return (U32)MAX_REC_NUMBER;
1394 if (strEQ(name, "RET_ERROR"))
1400 if (strEQ(name, "RET_SPECIAL"))
1406 if (strEQ(name, "RET_SUCCESS"))
1412 if (strEQ(name, "R_CURSOR"))
1418 if (strEQ(name, "R_DUP"))
1424 if (strEQ(name, "R_FIRST"))
1430 if (strEQ(name, "R_FIXEDLEN"))
1436 if (strEQ(name, "R_IAFTER"))
1442 if (strEQ(name, "R_IBEFORE"))
1448 if (strEQ(name, "R_LAST"))
1454 if (strEQ(name, "R_NEXT"))
1460 if (strEQ(name, "R_NOKEY"))
1466 if (strEQ(name, "R_NOOVERWRITE"))
1467 #ifdef R_NOOVERWRITE
1468 return R_NOOVERWRITE;
1472 if (strEQ(name, "R_PREV"))
1478 if (strEQ(name, "R_RECNOSYNC"))
1484 if (strEQ(name, "R_SETCURSOR"))
1490 if (strEQ(name, "R_SNAPSHOT"))
1524 MODULE = DB_File PACKAGE = DB_File PREFIX = db_
1528 __getBerkeleyDBInfo() ;
1531 empty.data = &zero ;
1532 empty.size = sizeof(recno_t) ;
1542 db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
1549 char * name = (char *) NULL ;
1550 SV * sv = (SV *) NULL ;
1553 if (items >= 3 && SvOK(ST(2)))
1554 name = (char*) SvPV(ST(2), n_a) ;
1559 RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
1560 if (RETVAL->dbp == NULL)
1573 SvREFCNT_dec(db->hash) ;
1575 SvREFCNT_dec(db->compare) ;
1577 SvREFCNT_dec(db->prefix) ;
1578 #ifdef DBM_FILTERING
1579 if (db->filter_fetch_key)
1580 SvREFCNT_dec(db->filter_fetch_key) ;
1581 if (db->filter_store_key)
1582 SvREFCNT_dec(db->filter_store_key) ;
1583 if (db->filter_fetch_value)
1584 SvREFCNT_dec(db->filter_fetch_value) ;
1585 if (db->filter_store_value)
1586 SvREFCNT_dec(db->filter_store_value) ;
1587 #endif /* DBM_FILTERING */
1589 #ifdef DB_VERSION_MAJOR
1596 db_DELETE(db, key, flags=0)
1614 RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
1620 db_FETCH(db, key, flags=0)
1630 /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */
1631 RETVAL = db_get(db, key, value, flags) ;
1632 ST(0) = sv_newmortal();
1633 OutputValue(ST(0), value)
1637 db_STORE(db, key, value, flags=0)
1657 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1658 ST(0) = sv_newmortal();
1659 OutputKey(ST(0), key) ;
1672 RETVAL = do_SEQ(db, key, value, R_NEXT) ;
1673 ST(0) = sv_newmortal();
1674 OutputKey(ST(0), key) ;
1678 # These would be nice for RECNO
1697 #ifdef DB_VERSION_MAJOR
1698 /* get the first value */
1699 RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1704 for (i = items-1 ; i > 0 ; --i)
1706 value.data = SvPV(ST(i), n_a) ;
1710 key.size = sizeof(int) ;
1711 #ifdef DB_VERSION_MAJOR
1712 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1714 RETVAL = (Db->put)(Db, &key, &value, R_IBEFORE) ;
1736 /* First get the final value */
1737 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1738 ST(0) = sv_newmortal();
1742 /* the call to del will trash value, so take a copy now */
1743 OutputValue(ST(0), value) ;
1744 RETVAL = db_del(db, key, R_CURSOR) ;
1746 sv_setsv(ST(0), &PL_sv_undef);
1762 /* get the first value */
1763 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1764 ST(0) = sv_newmortal();
1768 /* the call to del will trash value, so take a copy now */
1769 OutputValue(ST(0), value) ;
1770 RETVAL = db_del(db, key, R_CURSOR) ;
1772 sv_setsv (ST(0), &PL_sv_undef) ;
1793 /* Set the Cursor to the Last element */
1794 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1795 #ifndef DB_VERSION_MAJOR
1800 keyval = *(int*)key.data ;
1803 for (i = 1 ; i < items ; ++i)
1805 value.data = SvPV(ST(i), n_a) ;
1808 key.data = &keyval ;
1809 key.size = sizeof(int) ;
1810 RETVAL = (Db->put)(Db, TXN &key, &value, 0) ;
1822 ALIAS: FETCHSIZE = 1
1825 RETVAL = GetArrayLength(aTHX_ db) ;
1831 # Now provide an interface to the rest of the DB functionality
1835 db_del(db, key, flags=0)
1841 RETVAL = db_del(db, key, flags) ;
1842 #ifdef DB_VERSION_MAJOR
1845 else if (RETVAL == DB_NOTFOUND)
1853 db_get(db, key, value, flags=0)
1861 RETVAL = db_get(db, key, value, flags) ;
1862 #ifdef DB_VERSION_MAJOR
1865 else if (RETVAL == DB_NOTFOUND)
1873 db_put(db, key, value, flags=0)
1880 RETVAL = db_put(db, key, value, flags) ;
1881 #ifdef DB_VERSION_MAJOR
1884 else if (RETVAL == DB_KEYEXIST)
1889 key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
1897 #ifdef DB_VERSION_MAJOR
1899 status = (db->in_memory
1901 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
1905 RETVAL = (db->in_memory
1907 : ((db->dbp)->fd)(db->dbp) ) ;
1913 db_sync(db, flags=0)
1918 RETVAL = db_sync(db, flags) ;
1919 #ifdef DB_VERSION_MAJOR
1928 db_seq(db, key, value, flags)
1936 RETVAL = db_seq(db, key, value, flags);
1937 #ifdef DB_VERSION_MAJOR
1940 else if (RETVAL == DB_NOTFOUND)
1948 #ifdef DBM_FILTERING
1950 #define setFilter(type) \
1953 RETVAL = sv_mortalcopy(db->type) ; \
1955 if (db->type && (code == &PL_sv_undef)) { \
1956 SvREFCNT_dec(db->type) ; \
1961 sv_setsv(db->type, code) ; \
1963 db->type = newSVsv(code) ; \
1969 filter_fetch_key(db, code)
1972 SV * RETVAL = &PL_sv_undef ;
1974 setFilter(filter_fetch_key) ;
1977 filter_store_key(db, code)
1980 SV * RETVAL = &PL_sv_undef ;
1982 setFilter(filter_store_key) ;
1985 filter_fetch_value(db, code)
1988 SV * RETVAL = &PL_sv_undef ;
1990 setFilter(filter_fetch_value) ;
1993 filter_store_value(db, code)
1996 SV * RETVAL = &PL_sv_undef ;
1998 setFilter(filter_store_value) ;
2000 #endif /* DBM_FILTERING */