3 DB_File.xs -- Perl 5 interface to Berkeley DB
5 written by Paul Marquess <Paul.Marquess@btinternet.com>
6 last modified 16th January 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
93 # include "patchlevel.h"
94 # define PERL_REVISION 5
95 # define PERL_VERSION PATCHLEVEL
96 # define PERL_SUBVERSION SUBVERSION
99 #if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 ))
101 # define PL_sv_undef sv_undef
106 /* DEFSV appears first in 5.004_56 */
108 # define DEFSV GvSV(defgv)
111 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
112 * shortly #included by the <db.h>) __attribute__ to the possibly
113 * already defined __attribute__, for example by GNUC or by Perl. */
117 /* If Perl has been compiled with Threads support,the symbol op will
118 be defined here. This clashes with a field name in db.h, so get rid of it.
138 # define newSVpvn(a,b) newSVpv(a,b)
144 #define DBM_FILTERING
147 # define Trace(x) printf x
153 #define DBT_clear(x) Zero(&x, 1, DBT) ;
155 #ifdef DB_VERSION_MAJOR
157 #if DB_VERSION_MAJOR == 2
158 # define BERKELEY_DB_1_OR_2
161 /* map version 2 features & constants onto their version 1 equivalent */
166 #define DB_Prefix_t size_t
171 #define DB_Hash_t u_int32_t
173 /* DBTYPE stays the same */
174 /* HASHINFO, RECNOINFO and BTREEINFO map to DB_INFO */
175 #if DB_VERSION_MAJOR == 2
176 typedef DB_INFO INFO ;
177 #else /* DB_VERSION_MAJOR > 2 */
178 # define DB_FIXEDLEN (0x8000)
179 #endif /* DB_VERSION_MAJOR == 2 */
181 /* version 2 has db_recno_t in place of recno_t */
182 typedef db_recno_t recno_t;
185 #define R_CURSOR DB_SET_RANGE
186 #define R_FIRST DB_FIRST
187 #define R_IAFTER DB_AFTER
188 #define R_IBEFORE DB_BEFORE
189 #define R_LAST DB_LAST
190 #define R_NEXT DB_NEXT
191 #define R_NOOVERWRITE DB_NOOVERWRITE
192 #define R_PREV DB_PREV
194 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
195 # define R_SETCURSOR 0x800000
197 # define R_SETCURSOR (-100)
200 #define R_RECNOSYNC 0
201 #define R_FIXEDLEN DB_FIXEDLEN
205 #define db_HA_hash h_hash
206 #define db_HA_ffactor h_ffactor
207 #define db_HA_nelem h_nelem
208 #define db_HA_bsize db_pagesize
209 #define db_HA_cachesize db_cachesize
210 #define db_HA_lorder db_lorder
212 #define db_BT_compare bt_compare
213 #define db_BT_prefix bt_prefix
214 #define db_BT_flags flags
215 #define db_BT_psize db_pagesize
216 #define db_BT_cachesize db_cachesize
217 #define db_BT_lorder db_lorder
218 #define db_BT_maxkeypage
219 #define db_BT_minkeypage
222 #define db_RE_reclen re_len
223 #define db_RE_flags flags
224 #define db_RE_bval re_pad
225 #define db_RE_bfname re_source
226 #define db_RE_psize db_pagesize
227 #define db_RE_cachesize db_cachesize
228 #define db_RE_lorder db_lorder
232 #define do_SEQ(db, key, value, flag) (db->cursor->c_get)(db->cursor, &key, &value, flag)
235 #define DBT_flags(x) x.flags = 0
236 #define DB_flags(x, v) x |= v
238 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
239 # define flagSet(flags, bitmask) ((flags) & (bitmask))
241 # define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask))
244 #else /* db version 1.x */
246 #define BERKELEY_DB_1_OR_2
259 # define DB_Prefix_t mDB_Prefix_t
266 # define DB_Hash_t mDB_Hash_t
269 #define db_HA_hash hash.hash
270 #define db_HA_ffactor hash.ffactor
271 #define db_HA_nelem hash.nelem
272 #define db_HA_bsize hash.bsize
273 #define db_HA_cachesize hash.cachesize
274 #define db_HA_lorder hash.lorder
276 #define db_BT_compare btree.compare
277 #define db_BT_prefix btree.prefix
278 #define db_BT_flags btree.flags
279 #define db_BT_psize btree.psize
280 #define db_BT_cachesize btree.cachesize
281 #define db_BT_lorder btree.lorder
282 #define db_BT_maxkeypage btree.maxkeypage
283 #define db_BT_minkeypage btree.minkeypage
285 #define db_RE_reclen recno.reclen
286 #define db_RE_flags recno.flags
287 #define db_RE_bval recno.bval
288 #define db_RE_bfname recno.bfname
289 #define db_RE_psize recno.psize
290 #define db_RE_cachesize recno.cachesize
291 #define db_RE_lorder recno.lorder
295 #define do_SEQ(db, key, value, flag) (db->dbp->seq)(db->dbp, &key, &value, flag)
297 #define DB_flags(x, v)
298 #define flagSet(flags, bitmask) ((flags) & (bitmask))
300 #endif /* db version 1 */
304 #define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, TXN &key, flags)
305 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, flags)
306 #define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
308 #define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
309 #define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
311 #ifdef DB_VERSION_MAJOR
312 #define db_DESTROY(db) ( db->cursor->c_close(db->cursor),\
313 (db->dbp->close)(db->dbp, 0) )
314 #define db_close(db) ((db->dbp)->close)(db->dbp, 0)
315 #define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \
316 ? ((db->cursor)->c_del)(db->cursor, 0) \
317 : ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
319 #else /* ! DB_VERSION_MAJOR */
321 #define db_DESTROY(db) ((db->dbp)->close)(db->dbp)
322 #define db_close(db) ((db->dbp)->close)(db->dbp)
323 #define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
324 #define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
326 #endif /* ! DB_VERSION_MAJOR */
329 #define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags)
338 #ifdef BERKELEY_DB_1_OR_2
341 #ifdef DB_VERSION_MAJOR
345 SV * filter_fetch_key ;
346 SV * filter_store_key ;
347 SV * filter_fetch_value ;
348 SV * filter_store_value ;
350 #endif /* DBM_FILTERING */
354 typedef DB_File_type * DB_File ;
359 #define ckFilter(arg,type,name) \
362 /* printf("filtering %s\n", name) ;*/ \
364 croak("recursion detected in %s", name) ; \
365 db->filtering = TRUE ; \
366 save_defsv = newSVsv(DEFSV) ; \
367 sv_setsv(DEFSV, arg) ; \
369 (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \
370 sv_setsv(arg, DEFSV) ; \
371 sv_setsv(DEFSV, save_defsv) ; \
372 SvREFCNT_dec(save_defsv) ; \
373 db->filtering = FALSE ; \
374 /*printf("end of filtering %s\n", name) ;*/ \
379 #define ckFilter(arg,type, name)
381 #endif /* DBM_FILTERING */
383 #define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
385 #define OutputValue(arg, name) \
386 { if (RETVAL == 0) { \
387 my_sv_setpvn(arg, name.data, name.size) ; \
388 ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \
392 #define OutputKey(arg, name) \
395 if (db->type != DB_RECNO) { \
396 my_sv_setpvn(arg, name.data, name.size); \
399 sv_setiv(arg, (I32)*(I32*)name.data - 1); \
400 ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \
405 /* Internal Global Data */
406 static recno_t Value ;
407 static recno_t zero = 0 ;
408 static DB_File CurrentDB ;
409 static DBTKEY empty ;
411 #ifdef DB_VERSION_MAJOR
415 db_put(DB_File db, DBTKEY key, DBT value, u_int flags)
417 db_put(db, key, value, flags)
426 if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) {
430 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
431 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor) != 0)
433 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor, 0) != 0)
437 memset(&l_key, 0, sizeof(l_key));
438 l_key.data = key.data;
439 l_key.size = key.size;
440 memset(&l_value, 0, sizeof(l_value));
441 l_value.data = value.data;
442 l_value.size = value.size;
444 if ( temp_cursor->c_get(temp_cursor, &l_key, &l_value, DB_SET) != 0) {
445 (void)temp_cursor->c_close(temp_cursor);
449 status = temp_cursor->c_put(temp_cursor, &key, &value, flags);
450 (void)temp_cursor->c_close(temp_cursor);
456 if (flagSet(flags, R_CURSOR)) {
457 return ((db->cursor)->c_put)(db->cursor, &key, &value, DB_CURRENT);
460 if (flagSet(flags, R_SETCURSOR)) {
461 if ((db->dbp)->put(db->dbp, NULL, &key, &value, 0) != 0)
463 return ((db->cursor)->c_get)(db->cursor, &key, &value, DB_SET_RANGE);
467 return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
471 #endif /* DB_VERSION_MAJOR */
476 btree_compare(const DBT *key1, const DBT *key2)
478 btree_compare(key1, key2)
487 void * data1, * data2 ;
495 /* As newSVpv will assume that the data pointer is a null terminated C
496 string if the size parameter is 0, make sure that data points to an
497 empty string if the length is 0
510 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
511 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
514 count = perl_call_sv(CurrentDB->compare, G_SCALAR);
519 croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
532 btree_prefix(const DBT *key1, const DBT *key2)
534 btree_prefix(key1, key2)
543 void * data1, * data2 ;
551 /* As newSVpv will assume that the data pointer is a null terminated C
552 string if the size parameter is 0, make sure that data points to an
553 empty string if the length is 0
566 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
567 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
570 count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
575 croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
588 hash_cb(const void *data, size_t size)
607 /* DGH - Next two lines added to fix corrupted stack problem */
613 XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
616 count = perl_call_sv(CurrentDB->hash, G_SCALAR);
621 croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
633 #if defined(TRACE) && defined(BERKELEY_DB_1_OR_2)
637 PrintHash(INFO *hash)
643 printf ("HASH Info\n") ;
644 printf (" hash = %s\n",
645 (hash->db_HA_hash != NULL ? "redefined" : "default")) ;
646 printf (" bsize = %d\n", hash->db_HA_bsize) ;
647 printf (" ffactor = %d\n", hash->db_HA_ffactor) ;
648 printf (" nelem = %d\n", hash->db_HA_nelem) ;
649 printf (" cachesize = %d\n", hash->db_HA_cachesize) ;
650 printf (" lorder = %d\n", hash->db_HA_lorder) ;
656 PrintRecno(INFO *recno)
662 printf ("RECNO Info\n") ;
663 printf (" flags = %d\n", recno->db_RE_flags) ;
664 printf (" cachesize = %d\n", recno->db_RE_cachesize) ;
665 printf (" psize = %d\n", recno->db_RE_psize) ;
666 printf (" lorder = %d\n", recno->db_RE_lorder) ;
667 printf (" reclen = %ul\n", (unsigned long)recno->db_RE_reclen) ;
668 printf (" bval = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
669 printf (" bfname = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
674 PrintBtree(INFO *btree)
680 printf ("BTREE Info\n") ;
681 printf (" compare = %s\n",
682 (btree->db_BT_compare ? "redefined" : "default")) ;
683 printf (" prefix = %s\n",
684 (btree->db_BT_prefix ? "redefined" : "default")) ;
685 printf (" flags = %d\n", btree->db_BT_flags) ;
686 printf (" cachesize = %d\n", btree->db_BT_cachesize) ;
687 printf (" psize = %d\n", btree->db_BT_psize) ;
688 #ifndef DB_VERSION_MAJOR
689 printf (" maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
690 printf (" minkeypage = %d\n", btree->db_BT_minkeypage) ;
692 printf (" lorder = %d\n", btree->db_BT_lorder) ;
697 #define PrintRecno(recno)
698 #define PrintHash(hash)
699 #define PrintBtree(btree)
706 GetArrayLength(pTHX_ DB_File db)
718 RETVAL = do_SEQ(db, key, value, R_LAST) ;
720 RETVAL = *(I32 *)key.data ;
721 else /* No key means empty file */
724 return ((I32)RETVAL) ;
729 GetRecnoKey(pTHX_ DB_File db, I32 value)
731 GetRecnoKey(db, value)
737 /* Get the length of the array */
738 I32 length = GetArrayLength(aTHX_ db) ;
740 /* check for attempt to write before start of array */
741 if (length + value + 1 <= 0)
742 croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
744 value = length + value + 1 ;
755 ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv)
757 ParseOpenInfo(isHASH, name, flags, mode, sv)
766 #ifdef BERKELEY_DB_1_OR_2 /* Berkeley DB Version 1 or 2 */
770 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
771 void * openinfo = NULL ;
772 INFO * info = &RETVAL->info ;
775 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
776 Zero(RETVAL, 1, DB_File_type) ;
778 /* Default to HASH */
780 RETVAL->filtering = 0 ;
781 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
782 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
783 #endif /* DBM_FILTERING */
784 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
785 RETVAL->type = DB_HASH ;
787 /* DGH - Next line added to avoid SEGV on existing hash DB */
790 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
791 RETVAL->in_memory = (name == NULL) ;
796 croak ("type parameter is not a reference") ;
798 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
799 if (svp && SvOK(*svp))
800 action = (HV*) SvRV(*svp) ;
802 croak("internal error") ;
804 if (sv_isa(sv, "DB_File::HASHINFO"))
808 croak("DB_File can only tie an associative array to a DB_HASH database") ;
810 RETVAL->type = DB_HASH ;
811 openinfo = (void*)info ;
813 svp = hv_fetch(action, "hash", 4, FALSE);
815 if (svp && SvOK(*svp))
817 info->db_HA_hash = hash_cb ;
818 RETVAL->hash = newSVsv(*svp) ;
821 info->db_HA_hash = NULL ;
823 svp = hv_fetch(action, "ffactor", 7, FALSE);
824 info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
826 svp = hv_fetch(action, "nelem", 5, FALSE);
827 info->db_HA_nelem = svp ? SvIV(*svp) : 0;
829 svp = hv_fetch(action, "bsize", 5, FALSE);
830 info->db_HA_bsize = svp ? SvIV(*svp) : 0;
832 svp = hv_fetch(action, "cachesize", 9, FALSE);
833 info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
835 svp = hv_fetch(action, "lorder", 6, FALSE);
836 info->db_HA_lorder = svp ? SvIV(*svp) : 0;
840 else if (sv_isa(sv, "DB_File::BTREEINFO"))
843 croak("DB_File can only tie an associative array to a DB_BTREE database");
845 RETVAL->type = DB_BTREE ;
846 openinfo = (void*)info ;
848 svp = hv_fetch(action, "compare", 7, FALSE);
849 if (svp && SvOK(*svp))
851 info->db_BT_compare = btree_compare ;
852 RETVAL->compare = newSVsv(*svp) ;
855 info->db_BT_compare = NULL ;
857 svp = hv_fetch(action, "prefix", 6, FALSE);
858 if (svp && SvOK(*svp))
860 info->db_BT_prefix = btree_prefix ;
861 RETVAL->prefix = newSVsv(*svp) ;
864 info->db_BT_prefix = NULL ;
866 svp = hv_fetch(action, "flags", 5, FALSE);
867 info->db_BT_flags = svp ? SvIV(*svp) : 0;
869 svp = hv_fetch(action, "cachesize", 9, FALSE);
870 info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
872 #ifndef DB_VERSION_MAJOR
873 svp = hv_fetch(action, "minkeypage", 10, FALSE);
874 info->btree.minkeypage = svp ? SvIV(*svp) : 0;
876 svp = hv_fetch(action, "maxkeypage", 10, FALSE);
877 info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
880 svp = hv_fetch(action, "psize", 5, FALSE);
881 info->db_BT_psize = svp ? SvIV(*svp) : 0;
883 svp = hv_fetch(action, "lorder", 6, FALSE);
884 info->db_BT_lorder = svp ? SvIV(*svp) : 0;
889 else if (sv_isa(sv, "DB_File::RECNOINFO"))
892 croak("DB_File can only tie an array to a DB_RECNO database");
894 RETVAL->type = DB_RECNO ;
895 openinfo = (void *)info ;
897 info->db_RE_flags = 0 ;
899 svp = hv_fetch(action, "flags", 5, FALSE);
900 info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
902 svp = hv_fetch(action, "reclen", 6, FALSE);
903 info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
905 svp = hv_fetch(action, "cachesize", 9, FALSE);
906 info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
908 svp = hv_fetch(action, "psize", 5, FALSE);
909 info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
911 svp = hv_fetch(action, "lorder", 6, FALSE);
912 info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
914 #ifdef DB_VERSION_MAJOR
915 info->re_source = name ;
918 svp = hv_fetch(action, "bfname", 6, FALSE);
919 if (svp && SvOK(*svp)) {
920 char * ptr = SvPV(*svp,n_a) ;
921 #ifdef DB_VERSION_MAJOR
922 name = (char*) n_a ? ptr : NULL ;
924 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
928 #ifdef DB_VERSION_MAJOR
931 info->db_RE_bfname = NULL ;
934 svp = hv_fetch(action, "bval", 4, FALSE);
935 #ifdef DB_VERSION_MAJOR
936 if (svp && SvOK(*svp))
940 value = (int)*SvPV(*svp, n_a) ;
944 if (info->flags & DB_FIXEDLEN) {
945 info->re_pad = value ;
946 info->flags |= DB_PAD ;
949 info->re_delim = value ;
950 info->flags |= DB_DELIMITER ;
955 if (svp && SvOK(*svp))
958 info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
960 info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
961 DB_flags(info->flags, DB_DELIMITER) ;
966 if (info->db_RE_flags & R_FIXEDLEN)
967 info->db_RE_bval = (u_char) ' ' ;
969 info->db_RE_bval = (u_char) '\n' ;
970 DB_flags(info->flags, DB_DELIMITER) ;
975 info->flags |= DB_RENUMBER ;
981 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
985 /* OS2 Specific Code */
992 #ifdef DB_VERSION_MAJOR
998 /* Map 1.x flags to 2.x flags */
999 if ((flags & O_CREAT) == O_CREAT)
1000 Flags |= DB_CREATE ;
1003 if (flags == O_RDONLY)
1005 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1007 Flags |= DB_RDONLY ;
1010 if ((flags & O_TRUNC) == O_TRUNC)
1011 Flags |= DB_TRUNCATE ;
1014 status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
1016 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
1017 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
1019 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1024 RETVAL->dbp = NULL ;
1029 #if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2
1030 RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ;
1032 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
1033 #endif /* DB_LIBRARY_COMPATIBILITY_API */
1039 #else /* Berkeley DB Version > 2 */
1043 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
1048 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
1049 Zero(RETVAL, 1, DB_File_type) ;
1051 /* Default to HASH */
1052 #ifdef DBM_FILTERING
1053 RETVAL->filtering = 0 ;
1054 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
1055 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
1056 #endif /* DBM_FILTERING */
1057 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
1058 RETVAL->type = DB_HASH ;
1060 /* DGH - Next line added to avoid SEGV on existing hash DB */
1063 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
1064 RETVAL->in_memory = (name == NULL) ;
1066 status = db_create(&RETVAL->dbp, NULL,0) ;
1067 /* printf("db_create returned %d %s\n", status, db_strerror(status)) ; */
1069 RETVAL->dbp = NULL ;
1077 croak ("type parameter is not a reference") ;
1079 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
1080 if (svp && SvOK(*svp))
1081 action = (HV*) SvRV(*svp) ;
1083 croak("internal error") ;
1085 if (sv_isa(sv, "DB_File::HASHINFO"))
1089 croak("DB_File can only tie an associative array to a DB_HASH database") ;
1091 RETVAL->type = DB_HASH ;
1093 svp = hv_fetch(action, "hash", 4, FALSE);
1095 if (svp && SvOK(*svp))
1097 (void)dbp->set_h_hash(dbp, hash_cb) ;
1098 RETVAL->hash = newSVsv(*svp) ;
1101 svp = hv_fetch(action, "ffactor", 7, FALSE);
1103 (void)dbp->set_h_ffactor(dbp, SvIV(*svp)) ;
1105 svp = hv_fetch(action, "nelem", 5, FALSE);
1107 (void)dbp->set_h_nelem(dbp, SvIV(*svp)) ;
1109 svp = hv_fetch(action, "bsize", 5, FALSE);
1111 (void)dbp->set_pagesize(dbp, SvIV(*svp));
1113 svp = hv_fetch(action, "cachesize", 9, FALSE);
1115 (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1117 svp = hv_fetch(action, "lorder", 6, FALSE);
1119 (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
1123 else if (sv_isa(sv, "DB_File::BTREEINFO"))
1126 croak("DB_File can only tie an associative array to a DB_BTREE database");
1128 RETVAL->type = DB_BTREE ;
1130 svp = hv_fetch(action, "compare", 7, FALSE);
1131 if (svp && SvOK(*svp))
1133 (void)dbp->set_bt_compare(dbp, btree_compare) ;
1134 RETVAL->compare = newSVsv(*svp) ;
1137 svp = hv_fetch(action, "prefix", 6, FALSE);
1138 if (svp && SvOK(*svp))
1140 (void)dbp->set_bt_prefix(dbp, btree_prefix) ;
1141 RETVAL->prefix = newSVsv(*svp) ;
1144 svp = hv_fetch(action, "flags", 5, FALSE);
1146 (void)dbp->set_flags(dbp, SvIV(*svp)) ;
1148 svp = hv_fetch(action, "cachesize", 9, FALSE);
1150 (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1152 svp = hv_fetch(action, "psize", 5, FALSE);
1154 (void)dbp->set_pagesize(dbp, SvIV(*svp)) ;
1156 svp = hv_fetch(action, "lorder", 6, FALSE);
1158 (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
1163 else if (sv_isa(sv, "DB_File::RECNOINFO"))
1168 croak("DB_File can only tie an array to a DB_RECNO database");
1170 RETVAL->type = DB_RECNO ;
1172 svp = hv_fetch(action, "flags", 5, FALSE);
1174 int flags = SvIV(*svp) ;
1175 /* remove FIXDLEN, if present */
1176 if (flags & DB_FIXEDLEN) {
1178 flags &= ~DB_FIXEDLEN ;
1182 svp = hv_fetch(action, "cachesize", 9, FALSE);
1184 status = dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1187 svp = hv_fetch(action, "psize", 5, FALSE);
1189 status = dbp->set_pagesize(dbp, SvIV(*svp)) ;
1192 svp = hv_fetch(action, "lorder", 6, FALSE);
1194 status = dbp->set_lorder(dbp, SvIV(*svp)) ;
1197 svp = hv_fetch(action, "bval", 4, FALSE);
1198 if (svp && SvOK(*svp))
1202 value = (int)*SvPV(*svp, n_a) ;
1204 value = SvIV(*svp) ;
1207 status = dbp->set_re_pad(dbp, value) ;
1210 status = dbp->set_re_delim(dbp, value) ;
1216 svp = hv_fetch(action, "reclen", 6, FALSE);
1218 u_int32_t len = (u_int32_t)SvIV(*svp) ;
1219 status = dbp->set_re_len(dbp, len) ;
1224 status = dbp->set_re_source(dbp, name) ;
1228 svp = hv_fetch(action, "bfname", 6, FALSE);
1229 if (svp && SvOK(*svp)) {
1230 char * ptr = SvPV(*svp,n_a) ;
1231 name = (char*) n_a ? ptr : NULL ;
1237 status = dbp->set_flags(dbp, DB_RENUMBER) ;
1240 (void)dbp->set_flags(dbp, flags) ;
1245 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1252 /* Map 1.x flags to 3.x flags */
1253 if ((flags & O_CREAT) == O_CREAT)
1254 Flags |= DB_CREATE ;
1257 if (flags == O_RDONLY)
1259 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1261 Flags |= DB_RDONLY ;
1264 if ((flags & O_TRUNC) == O_TRUNC)
1265 Flags |= DB_TRUNCATE ;
1268 status = RETVAL->dbp->open(RETVAL->dbp, name, NULL, RETVAL->type,
1270 /* printf("open returned %d %s\n", status, db_strerror(status)) ; */
1273 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1275 /* printf("cursor returned %d %s\n", status, db_strerror(status)) ; */
1278 RETVAL->dbp = NULL ;
1284 #endif /* Berkeley DB Version > 2 */
1286 } /* ParseOpenInfo */
1290 #ifdef CAN_PROTOTYPE
1291 constant(char *name, int arg)
1303 if (strEQ(name, "BTREEMAGIC"))
1309 if (strEQ(name, "BTREEVERSION"))
1311 return BTREEVERSION;
1319 if (strEQ(name, "DB_LOCK"))
1325 if (strEQ(name, "DB_SHMEM"))
1331 if (strEQ(name, "DB_TXN"))
1345 if (strEQ(name, "HASHMAGIC"))
1351 if (strEQ(name, "HASHVERSION"))
1367 if (strEQ(name, "MAX_PAGE_NUMBER"))
1368 #ifdef MAX_PAGE_NUMBER
1369 return (U32)MAX_PAGE_NUMBER;
1373 if (strEQ(name, "MAX_PAGE_OFFSET"))
1374 #ifdef MAX_PAGE_OFFSET
1375 return MAX_PAGE_OFFSET;
1379 if (strEQ(name, "MAX_REC_NUMBER"))
1380 #ifdef MAX_REC_NUMBER
1381 return (U32)MAX_REC_NUMBER;
1395 if (strEQ(name, "RET_ERROR"))
1401 if (strEQ(name, "RET_SPECIAL"))
1407 if (strEQ(name, "RET_SUCCESS"))
1413 if (strEQ(name, "R_CURSOR"))
1419 if (strEQ(name, "R_DUP"))
1425 if (strEQ(name, "R_FIRST"))
1431 if (strEQ(name, "R_FIXEDLEN"))
1437 if (strEQ(name, "R_IAFTER"))
1443 if (strEQ(name, "R_IBEFORE"))
1449 if (strEQ(name, "R_LAST"))
1455 if (strEQ(name, "R_NEXT"))
1461 if (strEQ(name, "R_NOKEY"))
1467 if (strEQ(name, "R_NOOVERWRITE"))
1468 #ifdef R_NOOVERWRITE
1469 return R_NOOVERWRITE;
1473 if (strEQ(name, "R_PREV"))
1479 if (strEQ(name, "R_RECNOSYNC"))
1485 if (strEQ(name, "R_SETCURSOR"))
1491 if (strEQ(name, "R_SNAPSHOT"))
1525 MODULE = DB_File PACKAGE = DB_File PREFIX = db_
1529 __getBerkeleyDBInfo() ;
1532 empty.data = &zero ;
1533 empty.size = sizeof(recno_t) ;
1543 db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
1550 char * name = (char *) NULL ;
1551 SV * sv = (SV *) NULL ;
1554 if (items >= 3 && SvOK(ST(2)))
1555 name = (char*) SvPV(ST(2), n_a) ;
1560 RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
1561 if (RETVAL->dbp == NULL)
1574 SvREFCNT_dec(db->hash) ;
1576 SvREFCNT_dec(db->compare) ;
1578 SvREFCNT_dec(db->prefix) ;
1579 #ifdef DBM_FILTERING
1580 if (db->filter_fetch_key)
1581 SvREFCNT_dec(db->filter_fetch_key) ;
1582 if (db->filter_store_key)
1583 SvREFCNT_dec(db->filter_store_key) ;
1584 if (db->filter_fetch_value)
1585 SvREFCNT_dec(db->filter_fetch_value) ;
1586 if (db->filter_store_value)
1587 SvREFCNT_dec(db->filter_store_value) ;
1588 #endif /* DBM_FILTERING */
1590 #ifdef DB_VERSION_MAJOR
1597 db_DELETE(db, key, flags=0)
1615 RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
1621 db_FETCH(db, key, flags=0)
1631 /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */
1632 RETVAL = db_get(db, key, value, flags) ;
1633 ST(0) = sv_newmortal();
1634 OutputValue(ST(0), value)
1638 db_STORE(db, key, value, flags=0)
1658 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1659 ST(0) = sv_newmortal();
1660 OutputKey(ST(0), key) ;
1673 RETVAL = do_SEQ(db, key, value, R_NEXT) ;
1674 ST(0) = sv_newmortal();
1675 OutputKey(ST(0), key) ;
1679 # These would be nice for RECNO
1698 #ifdef DB_VERSION_MAJOR
1699 /* get the first value */
1700 RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1705 for (i = items-1 ; i > 0 ; --i)
1707 value.data = SvPV(ST(i), n_a) ;
1711 key.size = sizeof(int) ;
1712 #ifdef DB_VERSION_MAJOR
1713 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1715 RETVAL = (Db->put)(Db, &key, &value, R_IBEFORE) ;
1737 /* First get the final value */
1738 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1739 ST(0) = sv_newmortal();
1743 /* the call to del will trash value, so take a copy now */
1744 OutputValue(ST(0), value) ;
1745 RETVAL = db_del(db, key, R_CURSOR) ;
1747 sv_setsv(ST(0), &PL_sv_undef);
1763 /* get the first value */
1764 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1765 ST(0) = sv_newmortal();
1769 /* the call to del will trash value, so take a copy now */
1770 OutputValue(ST(0), value) ;
1771 RETVAL = db_del(db, key, R_CURSOR) ;
1773 sv_setsv (ST(0), &PL_sv_undef) ;
1794 /* Set the Cursor to the Last element */
1795 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1796 #ifndef DB_VERSION_MAJOR
1801 keyval = *(int*)key.data ;
1804 for (i = 1 ; i < items ; ++i)
1806 value.data = SvPV(ST(i), n_a) ;
1809 key.data = &keyval ;
1810 key.size = sizeof(int) ;
1811 RETVAL = (Db->put)(Db, TXN &key, &value, 0) ;
1823 ALIAS: FETCHSIZE = 1
1826 RETVAL = GetArrayLength(aTHX_ db) ;
1832 # Now provide an interface to the rest of the DB functionality
1836 db_del(db, key, flags=0)
1842 RETVAL = db_del(db, key, flags) ;
1843 #ifdef DB_VERSION_MAJOR
1846 else if (RETVAL == DB_NOTFOUND)
1854 db_get(db, key, value, flags=0)
1862 RETVAL = db_get(db, key, value, flags) ;
1863 #ifdef DB_VERSION_MAJOR
1866 else if (RETVAL == DB_NOTFOUND)
1874 db_put(db, key, value, flags=0)
1881 RETVAL = db_put(db, key, value, flags) ;
1882 #ifdef DB_VERSION_MAJOR
1885 else if (RETVAL == DB_KEYEXIST)
1890 key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
1898 #ifdef DB_VERSION_MAJOR
1900 status = (db->in_memory
1902 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
1906 RETVAL = (db->in_memory
1908 : ((db->dbp)->fd)(db->dbp) ) ;
1914 db_sync(db, flags=0)
1919 RETVAL = db_sync(db, flags) ;
1920 #ifdef DB_VERSION_MAJOR
1929 db_seq(db, key, value, flags)
1937 RETVAL = db_seq(db, key, value, flags);
1938 #ifdef DB_VERSION_MAJOR
1941 else if (RETVAL == DB_NOTFOUND)
1949 #ifdef DBM_FILTERING
1951 #define setFilter(type) \
1954 RETVAL = sv_mortalcopy(db->type) ; \
1956 if (db->type && (code == &PL_sv_undef)) { \
1957 SvREFCNT_dec(db->type) ; \
1962 sv_setsv(db->type, code) ; \
1964 db->type = newSVsv(code) ; \
1970 filter_fetch_key(db, code)
1973 SV * RETVAL = &PL_sv_undef ;
1975 setFilter(filter_fetch_key) ;
1978 filter_store_key(db, code)
1981 SV * RETVAL = &PL_sv_undef ;
1983 setFilter(filter_store_key) ;
1986 filter_fetch_value(db, code)
1989 SV * RETVAL = &PL_sv_undef ;
1991 setFilter(filter_fetch_value) ;
1994 filter_store_value(db, code)
1997 SV * RETVAL = &PL_sv_undef ;
1999 setFilter(filter_store_value) ;
2001 #endif /* DBM_FILTERING */