3 DB_File.xs -- Perl 5 interface to Berkeley DB
5 written by Paul Marquess <Paul.Marquess@btinternet.com>
6 last modified 26th April 2001
9 All comments/suggestions/problems are welcome
11 Copyright (c) 1995-2001 Paul Marquess. All rights reserved.
12 This program is free software; you can redistribute it and/or
13 modify it under the same terms as Perl itself.
17 0.2 - No longer bombs out if dbopen returns an error.
18 0.3 - Added some support for multiple btree compares
19 1.0 - Complete support for multiple callbacks added.
20 Fixed a problem with pushing a value onto an empty list.
21 1.01 - Fixed a SunOS core dump problem.
22 The return value from TIEHASH wasn't set to NULL when
23 dbopen returned an error.
24 1.02 - Use ALIAS to define TIEARRAY.
25 Removed some redundant commented code.
26 Merged OS2 code into the main distribution.
27 Allow negative subscripts with RECNO interface.
28 Changed the default flags to O_CREAT|O_RDWR
30 1.04 - fixed a couple of bugs in hash_cb. Patches supplied by
31 Dave Hammen, hammen@gothamcity.jsc.nasa.gov
32 1.05 - Added logic to allow prefix & hash types to be specified via
34 1.06 - Minor namespace cleanup: Localized PrintBtree.
35 1.07 - Fixed bug with RECNO, where bval wasn't defaulting to "\n".
36 1.08 - No change to DB_File.xs
37 1.09 - Default mode for dbopen changed to 0666
38 1.10 - Fixed fd method so that it still returns -1 for
39 in-memory files when db 1.86 is used.
40 1.11 - No change to DB_File.xs
41 1.12 - No change to DB_File.xs
42 1.13 - Tidied up a few casts.
43 1.14 - Made it illegal to tie an associative array to a RECNO
44 database and an ordinary array to a HASH or BTREE database.
45 1.50 - Make work with both DB 1.x or DB 2.x
46 1.51 - Fixed a bug in mapping 1.x O_RDONLY flag to 2.x DB_RDONLY equivalent
47 1.52 - Patch from Gisle Aas <gisle@aas.no> to suppress "use of
48 undefined value" warning with db_get and db_seq.
49 1.53 - Added DB_RENUMBER to flags for recno.
50 1.54 - Fixed bug in the fd method
51 1.55 - Fix for AIX from Jarkko Hietaniemi
52 1.56 - No change to DB_File.xs
53 1.57 - added the #undef op to allow building with Threads support.
54 1.58 - Fixed a problem with the use of sv_setpvn. When the
55 size is specified as 0, it does a strlen on the data.
56 This was ok for DB 1.x, but isn't for DB 2.x.
57 1.59 - No change to DB_File.xs
58 1.60 - Some code tidy up
59 1.61 - added flagSet macro for DB 2.5.x
60 fixed typo in O_RDONLY test.
61 1.62 - No change to DB_File.xs
62 1.63 - Fix to alllow DB 2.6.x to build.
63 1.64 - Tidied up the 1.x to 2.x flags mapping code.
64 Added a patch from Mark Kettenis <kettenis@wins.uva.nl>
65 to fix a flag mapping problem with O_RDONLY on the Hurd
66 1.65 - Fixed a bug in the PUSH logic.
67 Added BOOT check that using 2.3.4 or greater
68 1.66 - Added DBM filter code
69 1.67 - Backed off the use of newSVpvn.
70 Fixed DBM Filter code for Perl 5.004.
71 Fixed a small memory leak in the filter code.
72 1.68 - fixed backward compatability bug with R_IAFTER & R_IBEFORE
73 merged in the 5.005_58 changes
74 1.69 - fixed a bug in push -- DB_APPEND wasn't working properly.
75 Fixed the R_SETCURSOR bug introduced in 1.68
76 Added a new Perl variable $DB_File::db_ver
77 1.70 - Initialise $DB_File::db_ver and $DB_File::db_version with
78 GV_ADD|GV_ADDMULT -- bug spotted by Nick Ing-Simmons.
79 Added a BOOT check to test for equivalent versions of db.h &
81 1.71 - Support for Berkeley DB version 3.
82 Support for Berkeley DB 2/3's backward compatability mode.
84 1.72 - No change to DB_File.xs
85 1.73 - No change to DB_File.xs
86 1.74 - A call to open needed parenthesised to stop it clashing
88 Added Perl core patches 7703 & 7801.
89 1.75 - Fixed Perl core patch 7703.
90 Added suppport to allow DB_File to be built with
91 Berkeley DB 3.2 -- btree_compare, btree_prefix and hash_cb
93 1.76 - No change to DB_File.xs
94 1.77 - Tidied up a few types used in calling newSVpvn.
103 # include "patchlevel.h"
104 # define PERL_REVISION 5
105 # define PERL_VERSION PATCHLEVEL
106 # define PERL_SUBVERSION SUBVERSION
109 #if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 ))
111 # define PL_sv_undef sv_undef
116 /* DEFSV appears first in 5.004_56 */
118 # define DEFSV GvSV(defgv)
121 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
122 * shortly #included by the <db.h>) __attribute__ to the possibly
123 * already defined __attribute__, for example by GNUC or by Perl. */
127 /* If Perl has been compiled with Threads support,the symbol op will
128 be defined here. This clashes with a field name in db.h, so get rid of it.
141 extern void __getBerkeleyDBInfo(void);
152 # define newSVpvn(a,b) newSVpv(a,b)
158 #define DBM_FILTERING
161 # define Trace(x) printf x
167 #define DBT_clear(x) Zero(&x, 1, DBT) ;
169 #ifdef DB_VERSION_MAJOR
171 #if DB_VERSION_MAJOR == 2
172 # define BERKELEY_DB_1_OR_2
175 #if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 2)
176 # define AT_LEAST_DB_3_2
179 /* map version 2 features & constants onto their version 1 equivalent */
184 #define DB_Prefix_t size_t
189 #define DB_Hash_t u_int32_t
191 /* DBTYPE stays the same */
192 /* HASHINFO, RECNOINFO and BTREEINFO map to DB_INFO */
193 #if DB_VERSION_MAJOR == 2
194 typedef DB_INFO INFO ;
195 #else /* DB_VERSION_MAJOR > 2 */
196 # define DB_FIXEDLEN (0x8000)
197 #endif /* DB_VERSION_MAJOR == 2 */
199 /* version 2 has db_recno_t in place of recno_t */
200 typedef db_recno_t recno_t;
203 #define R_CURSOR DB_SET_RANGE
204 #define R_FIRST DB_FIRST
205 #define R_IAFTER DB_AFTER
206 #define R_IBEFORE DB_BEFORE
207 #define R_LAST DB_LAST
208 #define R_NEXT DB_NEXT
209 #define R_NOOVERWRITE DB_NOOVERWRITE
210 #define R_PREV DB_PREV
212 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
213 # define R_SETCURSOR 0x800000
215 # define R_SETCURSOR (-100)
218 #define R_RECNOSYNC 0
219 #define R_FIXEDLEN DB_FIXEDLEN
223 #define db_HA_hash h_hash
224 #define db_HA_ffactor h_ffactor
225 #define db_HA_nelem h_nelem
226 #define db_HA_bsize db_pagesize
227 #define db_HA_cachesize db_cachesize
228 #define db_HA_lorder db_lorder
230 #define db_BT_compare bt_compare
231 #define db_BT_prefix bt_prefix
232 #define db_BT_flags flags
233 #define db_BT_psize db_pagesize
234 #define db_BT_cachesize db_cachesize
235 #define db_BT_lorder db_lorder
236 #define db_BT_maxkeypage
237 #define db_BT_minkeypage
240 #define db_RE_reclen re_len
241 #define db_RE_flags flags
242 #define db_RE_bval re_pad
243 #define db_RE_bfname re_source
244 #define db_RE_psize db_pagesize
245 #define db_RE_cachesize db_cachesize
246 #define db_RE_lorder db_lorder
250 #define do_SEQ(db, key, value, flag) (db->cursor->c_get)(db->cursor, &key, &value, flag)
253 #define DBT_flags(x) x.flags = 0
254 #define DB_flags(x, v) x |= v
256 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
257 # define flagSet(flags, bitmask) ((flags) & (bitmask))
259 # define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask))
262 #else /* db version 1.x */
264 #define BERKELEY_DB_1
265 #define BERKELEY_DB_1_OR_2
278 # define DB_Prefix_t mDB_Prefix_t
285 # define DB_Hash_t mDB_Hash_t
288 #define db_HA_hash hash.hash
289 #define db_HA_ffactor hash.ffactor
290 #define db_HA_nelem hash.nelem
291 #define db_HA_bsize hash.bsize
292 #define db_HA_cachesize hash.cachesize
293 #define db_HA_lorder hash.lorder
295 #define db_BT_compare btree.compare
296 #define db_BT_prefix btree.prefix
297 #define db_BT_flags btree.flags
298 #define db_BT_psize btree.psize
299 #define db_BT_cachesize btree.cachesize
300 #define db_BT_lorder btree.lorder
301 #define db_BT_maxkeypage btree.maxkeypage
302 #define db_BT_minkeypage btree.minkeypage
304 #define db_RE_reclen recno.reclen
305 #define db_RE_flags recno.flags
306 #define db_RE_bval recno.bval
307 #define db_RE_bfname recno.bfname
308 #define db_RE_psize recno.psize
309 #define db_RE_cachesize recno.cachesize
310 #define db_RE_lorder recno.lorder
314 #define do_SEQ(db, key, value, flag) (db->dbp->seq)(db->dbp, &key, &value, flag)
316 #define DB_flags(x, v)
317 #define flagSet(flags, bitmask) ((flags) & (bitmask))
319 #endif /* db version 1 */
323 #define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, TXN &key, flags)
324 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, flags)
325 #define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
327 #define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
328 #define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
330 #ifdef DB_VERSION_MAJOR
331 #define db_DESTROY(db) ( db->cursor->c_close(db->cursor),\
332 (db->dbp->close)(db->dbp, 0) )
333 #define db_close(db) ((db->dbp)->close)(db->dbp, 0)
334 #define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \
335 ? ((db->cursor)->c_del)(db->cursor, 0) \
336 : ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
338 #else /* ! DB_VERSION_MAJOR */
340 #define db_DESTROY(db) ((db->dbp)->close)(db->dbp)
341 #define db_close(db) ((db->dbp)->close)(db->dbp)
342 #define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
343 #define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
345 #endif /* ! DB_VERSION_MAJOR */
348 #define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags)
357 #ifdef BERKELEY_DB_1_OR_2
360 #ifdef DB_VERSION_MAJOR
364 SV * filter_fetch_key ;
365 SV * filter_store_key ;
366 SV * filter_fetch_value ;
367 SV * filter_store_value ;
369 #endif /* DBM_FILTERING */
373 typedef DB_File_type * DB_File ;
378 #define ckFilter(arg,type,name) \
381 /* printf("filtering %s\n", name) ;*/ \
383 croak("recursion detected in %s", name) ; \
384 db->filtering = TRUE ; \
385 save_defsv = newSVsv(DEFSV) ; \
386 sv_setsv(DEFSV, arg) ; \
388 (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \
389 sv_setsv(arg, DEFSV) ; \
390 sv_setsv(DEFSV, save_defsv) ; \
391 SvREFCNT_dec(save_defsv) ; \
392 db->filtering = FALSE ; \
393 /*printf("end of filtering %s\n", name) ;*/ \
398 #define ckFilter(arg,type, name)
400 #endif /* DBM_FILTERING */
402 #define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
404 #define OutputValue(arg, name) \
405 { if (RETVAL == 0) { \
406 my_sv_setpvn(arg, name.data, name.size) ; \
407 ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \
411 #define OutputKey(arg, name) \
414 if (db->type != DB_RECNO) { \
415 my_sv_setpvn(arg, name.data, name.size); \
418 sv_setiv(arg, (I32)*(I32*)name.data - 1); \
419 ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \
424 /* Internal Global Data */
425 static recno_t Value ;
426 static recno_t zero = 0 ;
427 static DB_File CurrentDB ;
428 static DBTKEY empty ;
430 #ifdef DB_VERSION_MAJOR
434 db_put(DB_File db, DBTKEY key, DBT value, u_int flags)
436 db_put(db, key, value, flags)
445 if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) {
449 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
450 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor) != 0)
452 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor, 0) != 0)
456 memset(&l_key, 0, sizeof(l_key));
457 l_key.data = key.data;
458 l_key.size = key.size;
459 memset(&l_value, 0, sizeof(l_value));
460 l_value.data = value.data;
461 l_value.size = value.size;
463 if ( temp_cursor->c_get(temp_cursor, &l_key, &l_value, DB_SET) != 0) {
464 (void)temp_cursor->c_close(temp_cursor);
468 status = temp_cursor->c_put(temp_cursor, &key, &value, flags);
469 (void)temp_cursor->c_close(temp_cursor);
475 if (flagSet(flags, R_CURSOR)) {
476 return ((db->cursor)->c_put)(db->cursor, &key, &value, DB_CURRENT);
479 if (flagSet(flags, R_SETCURSOR)) {
480 if ((db->dbp)->put(db->dbp, NULL, &key, &value, 0) != 0)
482 return ((db->cursor)->c_get)(db->cursor, &key, &value, DB_SET_RANGE);
486 return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
490 #endif /* DB_VERSION_MAJOR */
494 #ifdef AT_LEAST_DB_3_2
497 btree_compare(DB * db, const DBT *key1, const DBT *key2)
499 btree_compare(db, key1, key2)
503 #endif /* CAN_PROTOTYPE */
505 #else /* Berkeley DB < 3.2 */
508 btree_compare(const DBT *key1, const DBT *key2)
510 btree_compare(key1, key2)
522 char * data1, * data2 ;
526 data1 = (char *) key1->data ;
527 data2 = (char *) key2->data ;
530 /* As newSVpv will assume that the data pointer is a null terminated C
531 string if the size parameter is 0, make sure that data points to an
532 empty string if the length is 0
545 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
546 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
549 count = perl_call_sv(CurrentDB->compare, G_SCALAR);
554 croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
566 #ifdef AT_LEAST_DB_3_2
569 btree_prefix(DB * db, const DBT *key1, const DBT *key2)
571 btree_prefix(db, key1, key2)
577 #else /* Berkeley DB < 3.2 */
580 btree_prefix(const DBT *key1, const DBT *key2)
582 btree_prefix(key1, key2)
593 char * data1, * data2 ;
597 data1 = (char *) key1->data ;
598 data2 = (char *) key2->data ;
601 /* As newSVpv will assume that the data pointer is a null terminated C
602 string if the size parameter is 0, make sure that data points to an
603 empty string if the length is 0
616 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
617 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
620 count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
625 croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
638 # define HASH_CB_SIZE_TYPE size_t
640 # define HASH_CB_SIZE_TYPE u_int32_t
644 #ifdef AT_LEAST_DB_3_2
647 hash_cb(DB * db, const void *data, u_int32_t size)
649 hash_cb(db, data, size)
652 HASH_CB_SIZE_TYPE size ;
655 #else /* Berkeley DB < 3.2 */
658 hash_cb(const void *data, HASH_CB_SIZE_TYPE size)
662 HASH_CB_SIZE_TYPE size ;
679 /* DGH - Next two lines added to fix corrupted stack problem */
685 XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
688 count = perl_call_sv(CurrentDB->hash, G_SCALAR);
693 croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
705 #if defined(TRACE) && defined(BERKELEY_DB_1_OR_2)
709 PrintHash(INFO *hash)
715 printf ("HASH Info\n") ;
716 printf (" hash = %s\n",
717 (hash->db_HA_hash != NULL ? "redefined" : "default")) ;
718 printf (" bsize = %d\n", hash->db_HA_bsize) ;
719 printf (" ffactor = %d\n", hash->db_HA_ffactor) ;
720 printf (" nelem = %d\n", hash->db_HA_nelem) ;
721 printf (" cachesize = %d\n", hash->db_HA_cachesize) ;
722 printf (" lorder = %d\n", hash->db_HA_lorder) ;
728 PrintRecno(INFO *recno)
734 printf ("RECNO Info\n") ;
735 printf (" flags = %d\n", recno->db_RE_flags) ;
736 printf (" cachesize = %d\n", recno->db_RE_cachesize) ;
737 printf (" psize = %d\n", recno->db_RE_psize) ;
738 printf (" lorder = %d\n", recno->db_RE_lorder) ;
739 printf (" reclen = %ul\n", (unsigned long)recno->db_RE_reclen) ;
740 printf (" bval = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
741 printf (" bfname = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
746 PrintBtree(INFO *btree)
752 printf ("BTREE Info\n") ;
753 printf (" compare = %s\n",
754 (btree->db_BT_compare ? "redefined" : "default")) ;
755 printf (" prefix = %s\n",
756 (btree->db_BT_prefix ? "redefined" : "default")) ;
757 printf (" flags = %d\n", btree->db_BT_flags) ;
758 printf (" cachesize = %d\n", btree->db_BT_cachesize) ;
759 printf (" psize = %d\n", btree->db_BT_psize) ;
760 #ifndef DB_VERSION_MAJOR
761 printf (" maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
762 printf (" minkeypage = %d\n", btree->db_BT_minkeypage) ;
764 printf (" lorder = %d\n", btree->db_BT_lorder) ;
769 #define PrintRecno(recno)
770 #define PrintHash(hash)
771 #define PrintBtree(btree)
778 GetArrayLength(pTHX_ DB_File db)
790 RETVAL = do_SEQ(db, key, value, R_LAST) ;
792 RETVAL = *(I32 *)key.data ;
793 else /* No key means empty file */
796 return ((I32)RETVAL) ;
801 GetRecnoKey(pTHX_ DB_File db, I32 value)
803 GetRecnoKey(db, value)
809 /* Get the length of the array */
810 I32 length = GetArrayLength(aTHX_ db) ;
812 /* check for attempt to write before start of array */
813 if (length + value + 1 <= 0)
814 croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
816 value = length + value + 1 ;
827 ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv)
829 ParseOpenInfo(isHASH, name, flags, mode, sv)
838 #ifdef BERKELEY_DB_1_OR_2 /* Berkeley DB Version 1 or 2 */
842 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
843 void * openinfo = NULL ;
844 INFO * info = &RETVAL->info ;
847 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
848 Zero(RETVAL, 1, DB_File_type) ;
850 /* Default to HASH */
852 RETVAL->filtering = 0 ;
853 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
854 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
855 #endif /* DBM_FILTERING */
856 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
857 RETVAL->type = DB_HASH ;
859 /* DGH - Next line added to avoid SEGV on existing hash DB */
862 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
863 RETVAL->in_memory = (name == NULL) ;
868 croak ("type parameter is not a reference") ;
870 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
871 if (svp && SvOK(*svp))
872 action = (HV*) SvRV(*svp) ;
874 croak("internal error") ;
876 if (sv_isa(sv, "DB_File::HASHINFO"))
880 croak("DB_File can only tie an associative array to a DB_HASH database") ;
882 RETVAL->type = DB_HASH ;
883 openinfo = (void*)info ;
885 svp = hv_fetch(action, "hash", 4, FALSE);
887 if (svp && SvOK(*svp))
889 info->db_HA_hash = hash_cb ;
890 RETVAL->hash = newSVsv(*svp) ;
893 info->db_HA_hash = NULL ;
895 svp = hv_fetch(action, "ffactor", 7, FALSE);
896 info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
898 svp = hv_fetch(action, "nelem", 5, FALSE);
899 info->db_HA_nelem = svp ? SvIV(*svp) : 0;
901 svp = hv_fetch(action, "bsize", 5, FALSE);
902 info->db_HA_bsize = svp ? SvIV(*svp) : 0;
904 svp = hv_fetch(action, "cachesize", 9, FALSE);
905 info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
907 svp = hv_fetch(action, "lorder", 6, FALSE);
908 info->db_HA_lorder = svp ? SvIV(*svp) : 0;
912 else if (sv_isa(sv, "DB_File::BTREEINFO"))
915 croak("DB_File can only tie an associative array to a DB_BTREE database");
917 RETVAL->type = DB_BTREE ;
918 openinfo = (void*)info ;
920 svp = hv_fetch(action, "compare", 7, FALSE);
921 if (svp && SvOK(*svp))
923 info->db_BT_compare = btree_compare ;
924 RETVAL->compare = newSVsv(*svp) ;
927 info->db_BT_compare = NULL ;
929 svp = hv_fetch(action, "prefix", 6, FALSE);
930 if (svp && SvOK(*svp))
932 info->db_BT_prefix = btree_prefix ;
933 RETVAL->prefix = newSVsv(*svp) ;
936 info->db_BT_prefix = NULL ;
938 svp = hv_fetch(action, "flags", 5, FALSE);
939 info->db_BT_flags = svp ? SvIV(*svp) : 0;
941 svp = hv_fetch(action, "cachesize", 9, FALSE);
942 info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
944 #ifndef DB_VERSION_MAJOR
945 svp = hv_fetch(action, "minkeypage", 10, FALSE);
946 info->btree.minkeypage = svp ? SvIV(*svp) : 0;
948 svp = hv_fetch(action, "maxkeypage", 10, FALSE);
949 info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
952 svp = hv_fetch(action, "psize", 5, FALSE);
953 info->db_BT_psize = svp ? SvIV(*svp) : 0;
955 svp = hv_fetch(action, "lorder", 6, FALSE);
956 info->db_BT_lorder = svp ? SvIV(*svp) : 0;
961 else if (sv_isa(sv, "DB_File::RECNOINFO"))
964 croak("DB_File can only tie an array to a DB_RECNO database");
966 RETVAL->type = DB_RECNO ;
967 openinfo = (void *)info ;
969 info->db_RE_flags = 0 ;
971 svp = hv_fetch(action, "flags", 5, FALSE);
972 info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
974 svp = hv_fetch(action, "reclen", 6, FALSE);
975 info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
977 svp = hv_fetch(action, "cachesize", 9, FALSE);
978 info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
980 svp = hv_fetch(action, "psize", 5, FALSE);
981 info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
983 svp = hv_fetch(action, "lorder", 6, FALSE);
984 info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
986 #ifdef DB_VERSION_MAJOR
987 info->re_source = name ;
990 svp = hv_fetch(action, "bfname", 6, FALSE);
991 if (svp && SvOK(*svp)) {
992 char * ptr = SvPV(*svp,n_a) ;
993 #ifdef DB_VERSION_MAJOR
994 name = (char*) n_a ? ptr : NULL ;
996 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
1000 #ifdef DB_VERSION_MAJOR
1003 info->db_RE_bfname = NULL ;
1006 svp = hv_fetch(action, "bval", 4, FALSE);
1007 #ifdef DB_VERSION_MAJOR
1008 if (svp && SvOK(*svp))
1012 value = (int)*SvPV(*svp, n_a) ;
1014 value = SvIV(*svp) ;
1016 if (info->flags & DB_FIXEDLEN) {
1017 info->re_pad = value ;
1018 info->flags |= DB_PAD ;
1021 info->re_delim = value ;
1022 info->flags |= DB_DELIMITER ;
1027 if (svp && SvOK(*svp))
1030 info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
1032 info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
1033 DB_flags(info->flags, DB_DELIMITER) ;
1038 if (info->db_RE_flags & R_FIXEDLEN)
1039 info->db_RE_bval = (u_char) ' ' ;
1041 info->db_RE_bval = (u_char) '\n' ;
1042 DB_flags(info->flags, DB_DELIMITER) ;
1047 info->flags |= DB_RENUMBER ;
1053 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1057 /* OS2 Specific Code */
1061 #endif /* __EMX__ */
1064 #ifdef DB_VERSION_MAJOR
1070 /* Map 1.x flags to 2.x flags */
1071 if ((flags & O_CREAT) == O_CREAT)
1072 Flags |= DB_CREATE ;
1075 if (flags == O_RDONLY)
1077 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1079 Flags |= DB_RDONLY ;
1082 if ((flags & O_TRUNC) == O_TRUNC)
1083 Flags |= DB_TRUNCATE ;
1086 status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
1088 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
1089 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
1091 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1096 RETVAL->dbp = NULL ;
1101 #if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2
1102 RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ;
1104 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
1105 #endif /* DB_LIBRARY_COMPATIBILITY_API */
1111 #else /* Berkeley DB Version > 2 */
1115 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
1120 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
1121 Zero(RETVAL, 1, DB_File_type) ;
1123 /* Default to HASH */
1124 #ifdef DBM_FILTERING
1125 RETVAL->filtering = 0 ;
1126 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
1127 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
1128 #endif /* DBM_FILTERING */
1129 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
1130 RETVAL->type = DB_HASH ;
1132 /* DGH - Next line added to avoid SEGV on existing hash DB */
1135 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
1136 RETVAL->in_memory = (name == NULL) ;
1138 status = db_create(&RETVAL->dbp, NULL,0) ;
1139 /* printf("db_create returned %d %s\n", status, db_strerror(status)) ; */
1141 RETVAL->dbp = NULL ;
1149 croak ("type parameter is not a reference") ;
1151 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
1152 if (svp && SvOK(*svp))
1153 action = (HV*) SvRV(*svp) ;
1155 croak("internal error") ;
1157 if (sv_isa(sv, "DB_File::HASHINFO"))
1161 croak("DB_File can only tie an associative array to a DB_HASH database") ;
1163 RETVAL->type = DB_HASH ;
1165 svp = hv_fetch(action, "hash", 4, FALSE);
1167 if (svp && SvOK(*svp))
1169 (void)dbp->set_h_hash(dbp, hash_cb) ;
1170 RETVAL->hash = newSVsv(*svp) ;
1173 svp = hv_fetch(action, "ffactor", 7, FALSE);
1175 (void)dbp->set_h_ffactor(dbp, SvIV(*svp)) ;
1177 svp = hv_fetch(action, "nelem", 5, FALSE);
1179 (void)dbp->set_h_nelem(dbp, SvIV(*svp)) ;
1181 svp = hv_fetch(action, "bsize", 5, FALSE);
1183 (void)dbp->set_pagesize(dbp, SvIV(*svp));
1185 svp = hv_fetch(action, "cachesize", 9, FALSE);
1187 (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1189 svp = hv_fetch(action, "lorder", 6, FALSE);
1191 (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
1195 else if (sv_isa(sv, "DB_File::BTREEINFO"))
1198 croak("DB_File can only tie an associative array to a DB_BTREE database");
1200 RETVAL->type = DB_BTREE ;
1202 svp = hv_fetch(action, "compare", 7, FALSE);
1203 if (svp && SvOK(*svp))
1205 (void)dbp->set_bt_compare(dbp, btree_compare) ;
1206 RETVAL->compare = newSVsv(*svp) ;
1209 svp = hv_fetch(action, "prefix", 6, FALSE);
1210 if (svp && SvOK(*svp))
1212 (void)dbp->set_bt_prefix(dbp, btree_prefix) ;
1213 RETVAL->prefix = newSVsv(*svp) ;
1216 svp = hv_fetch(action, "flags", 5, FALSE);
1218 (void)dbp->set_flags(dbp, SvIV(*svp)) ;
1220 svp = hv_fetch(action, "cachesize", 9, FALSE);
1222 (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1224 svp = hv_fetch(action, "psize", 5, FALSE);
1226 (void)dbp->set_pagesize(dbp, SvIV(*svp)) ;
1228 svp = hv_fetch(action, "lorder", 6, FALSE);
1230 (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
1235 else if (sv_isa(sv, "DB_File::RECNOINFO"))
1240 croak("DB_File can only tie an array to a DB_RECNO database");
1242 RETVAL->type = DB_RECNO ;
1244 svp = hv_fetch(action, "flags", 5, FALSE);
1246 int flags = SvIV(*svp) ;
1247 /* remove FIXDLEN, if present */
1248 if (flags & DB_FIXEDLEN) {
1250 flags &= ~DB_FIXEDLEN ;
1254 svp = hv_fetch(action, "cachesize", 9, FALSE);
1256 status = dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1259 svp = hv_fetch(action, "psize", 5, FALSE);
1261 status = dbp->set_pagesize(dbp, SvIV(*svp)) ;
1264 svp = hv_fetch(action, "lorder", 6, FALSE);
1266 status = dbp->set_lorder(dbp, SvIV(*svp)) ;
1269 svp = hv_fetch(action, "bval", 4, FALSE);
1270 if (svp && SvOK(*svp))
1274 value = (int)*SvPV(*svp, n_a) ;
1276 value = SvIV(*svp) ;
1279 status = dbp->set_re_pad(dbp, value) ;
1282 status = dbp->set_re_delim(dbp, value) ;
1288 svp = hv_fetch(action, "reclen", 6, FALSE);
1290 u_int32_t len = (u_int32_t)SvIV(*svp) ;
1291 status = dbp->set_re_len(dbp, len) ;
1296 status = dbp->set_re_source(dbp, name) ;
1300 svp = hv_fetch(action, "bfname", 6, FALSE);
1301 if (svp && SvOK(*svp)) {
1302 char * ptr = SvPV(*svp,n_a) ;
1303 name = (char*) n_a ? ptr : NULL ;
1309 status = dbp->set_flags(dbp, DB_RENUMBER) ;
1312 (void)dbp->set_flags(dbp, flags) ;
1317 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1324 /* Map 1.x flags to 3.x flags */
1325 if ((flags & O_CREAT) == O_CREAT)
1326 Flags |= DB_CREATE ;
1329 if (flags == O_RDONLY)
1331 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1333 Flags |= DB_RDONLY ;
1336 if ((flags & O_TRUNC) == O_TRUNC)
1337 Flags |= DB_TRUNCATE ;
1340 status = (RETVAL->dbp->open)(RETVAL->dbp, name, NULL, RETVAL->type,
1342 /* printf("open returned %d %s\n", status, db_strerror(status)) ; */
1345 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1347 /* printf("cursor returned %d %s\n", status, db_strerror(status)) ; */
1350 RETVAL->dbp = NULL ;
1356 #endif /* Berkeley DB Version > 2 */
1358 } /* ParseOpenInfo */
1362 #ifdef CAN_PROTOTYPE
1363 constant(char *name, int arg)
1375 if (strEQ(name, "BTREEMAGIC"))
1381 if (strEQ(name, "BTREEVERSION"))
1383 return BTREEVERSION;
1391 if (strEQ(name, "DB_LOCK"))
1397 if (strEQ(name, "DB_SHMEM"))
1403 if (strEQ(name, "DB_TXN"))
1417 if (strEQ(name, "HASHMAGIC"))
1423 if (strEQ(name, "HASHVERSION"))
1439 if (strEQ(name, "MAX_PAGE_NUMBER"))
1440 #ifdef MAX_PAGE_NUMBER
1441 return (U32)MAX_PAGE_NUMBER;
1445 if (strEQ(name, "MAX_PAGE_OFFSET"))
1446 #ifdef MAX_PAGE_OFFSET
1447 return MAX_PAGE_OFFSET;
1451 if (strEQ(name, "MAX_REC_NUMBER"))
1452 #ifdef MAX_REC_NUMBER
1453 return (U32)MAX_REC_NUMBER;
1467 if (strEQ(name, "RET_ERROR"))
1473 if (strEQ(name, "RET_SPECIAL"))
1479 if (strEQ(name, "RET_SUCCESS"))
1485 if (strEQ(name, "R_CURSOR"))
1491 if (strEQ(name, "R_DUP"))
1497 if (strEQ(name, "R_FIRST"))
1503 if (strEQ(name, "R_FIXEDLEN"))
1509 if (strEQ(name, "R_IAFTER"))
1515 if (strEQ(name, "R_IBEFORE"))
1521 if (strEQ(name, "R_LAST"))
1527 if (strEQ(name, "R_NEXT"))
1533 if (strEQ(name, "R_NOKEY"))
1539 if (strEQ(name, "R_NOOVERWRITE"))
1540 #ifdef R_NOOVERWRITE
1541 return R_NOOVERWRITE;
1545 if (strEQ(name, "R_PREV"))
1551 if (strEQ(name, "R_RECNOSYNC"))
1557 if (strEQ(name, "R_SETCURSOR"))
1563 if (strEQ(name, "R_SNAPSHOT"))
1597 MODULE = DB_File PACKAGE = DB_File PREFIX = db_
1601 __getBerkeleyDBInfo() ;
1604 empty.data = &zero ;
1605 empty.size = sizeof(recno_t) ;
1615 db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
1622 char * name = (char *) NULL ;
1623 SV * sv = (SV *) NULL ;
1626 if (items >= 3 && SvOK(ST(2)))
1627 name = (char*) SvPV(ST(2), n_a) ;
1632 RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
1633 if (RETVAL->dbp == NULL)
1646 SvREFCNT_dec(db->hash) ;
1648 SvREFCNT_dec(db->compare) ;
1650 SvREFCNT_dec(db->prefix) ;
1651 #ifdef DBM_FILTERING
1652 if (db->filter_fetch_key)
1653 SvREFCNT_dec(db->filter_fetch_key) ;
1654 if (db->filter_store_key)
1655 SvREFCNT_dec(db->filter_store_key) ;
1656 if (db->filter_fetch_value)
1657 SvREFCNT_dec(db->filter_fetch_value) ;
1658 if (db->filter_store_value)
1659 SvREFCNT_dec(db->filter_store_value) ;
1660 #endif /* DBM_FILTERING */
1662 #ifdef DB_VERSION_MAJOR
1669 db_DELETE(db, key, flags=0)
1687 RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
1693 db_FETCH(db, key, flags=0)
1703 /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */
1704 RETVAL = db_get(db, key, value, flags) ;
1705 ST(0) = sv_newmortal();
1706 OutputValue(ST(0), value)
1710 db_STORE(db, key, value, flags=0)
1730 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1731 ST(0) = sv_newmortal();
1732 OutputKey(ST(0), key) ;
1745 RETVAL = do_SEQ(db, key, value, R_NEXT) ;
1746 ST(0) = sv_newmortal();
1747 OutputKey(ST(0), key) ;
1751 # These would be nice for RECNO
1770 #ifdef DB_VERSION_MAJOR
1771 /* get the first value */
1772 RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1777 for (i = items-1 ; i > 0 ; --i)
1779 value.data = SvPV(ST(i), n_a) ;
1783 key.size = sizeof(int) ;
1784 #ifdef DB_VERSION_MAJOR
1785 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1787 RETVAL = (Db->put)(Db, &key, &value, R_IBEFORE) ;
1809 /* First get the final value */
1810 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1811 ST(0) = sv_newmortal();
1815 /* the call to del will trash value, so take a copy now */
1816 OutputValue(ST(0), value) ;
1817 RETVAL = db_del(db, key, R_CURSOR) ;
1819 sv_setsv(ST(0), &PL_sv_undef);
1835 /* get the first value */
1836 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1837 ST(0) = sv_newmortal();
1841 /* the call to del will trash value, so take a copy now */
1842 OutputValue(ST(0), value) ;
1843 RETVAL = db_del(db, key, R_CURSOR) ;
1845 sv_setsv (ST(0), &PL_sv_undef) ;
1866 /* Set the Cursor to the Last element */
1867 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1868 #ifndef DB_VERSION_MAJOR
1873 keyval = *(int*)key.data ;
1876 for (i = 1 ; i < items ; ++i)
1878 value.data = SvPV(ST(i), n_a) ;
1881 key.data = &keyval ;
1882 key.size = sizeof(int) ;
1883 RETVAL = (Db->put)(Db, TXN &key, &value, 0) ;
1895 ALIAS: FETCHSIZE = 1
1898 RETVAL = GetArrayLength(aTHX_ db) ;
1904 # Now provide an interface to the rest of the DB functionality
1908 db_del(db, key, flags=0)
1914 RETVAL = db_del(db, key, flags) ;
1915 #ifdef DB_VERSION_MAJOR
1918 else if (RETVAL == DB_NOTFOUND)
1926 db_get(db, key, value, flags=0)
1934 RETVAL = db_get(db, key, value, flags) ;
1935 #ifdef DB_VERSION_MAJOR
1938 else if (RETVAL == DB_NOTFOUND)
1946 db_put(db, key, value, flags=0)
1953 RETVAL = db_put(db, key, value, flags) ;
1954 #ifdef DB_VERSION_MAJOR
1957 else if (RETVAL == DB_KEYEXIST)
1962 key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
1970 #ifdef DB_VERSION_MAJOR
1972 status = (db->in_memory
1974 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
1978 RETVAL = (db->in_memory
1980 : ((db->dbp)->fd)(db->dbp) ) ;
1986 db_sync(db, flags=0)
1991 RETVAL = db_sync(db, flags) ;
1992 #ifdef DB_VERSION_MAJOR
2001 db_seq(db, key, value, flags)
2009 RETVAL = db_seq(db, key, value, flags);
2010 #ifdef DB_VERSION_MAJOR
2013 else if (RETVAL == DB_NOTFOUND)
2021 #ifdef DBM_FILTERING
2023 #define setFilter(type) \
2026 RETVAL = sv_mortalcopy(db->type) ; \
2028 if (db->type && (code == &PL_sv_undef)) { \
2029 SvREFCNT_dec(db->type) ; \
2034 sv_setsv(db->type, code) ; \
2036 db->type = newSVsv(code) ; \
2042 filter_fetch_key(db, code)
2045 SV * RETVAL = &PL_sv_undef ;
2047 setFilter(filter_fetch_key) ;
2050 filter_store_key(db, code)
2053 SV * RETVAL = &PL_sv_undef ;
2055 setFilter(filter_store_key) ;
2058 filter_fetch_value(db, code)
2061 SV * RETVAL = &PL_sv_undef ;
2063 setFilter(filter_fetch_value) ;
2066 filter_store_value(db, code)
2069 SV * RETVAL = &PL_sv_undef ;
2071 setFilter(filter_store_value) ;
2073 #endif /* DBM_FILTERING */