3 DB_File.xs -- Perl 5 interface to Berkeley DB
5 written by Paul Marquess <Paul.Marquess@btinternet.com>
6 last modified 27th April 2000
9 All comments/suggestions/problems are welcome
11 Copyright (c) 1995-2000 Paul Marquess. All rights reserved.
12 This program is free software; you can redistribute it and/or
13 modify it under the same terms as Perl itself.
17 0.2 - No longer bombs out if dbopen returns an error.
18 0.3 - Added some support for multiple btree compares
19 1.0 - Complete support for multiple callbacks added.
20 Fixed a problem with pushing a value onto an empty list.
21 1.01 - Fixed a SunOS core dump problem.
22 The return value from TIEHASH wasn't set to NULL when
23 dbopen returned an error.
24 1.02 - Use ALIAS to define TIEARRAY.
25 Removed some redundant commented code.
26 Merged OS2 code into the main distribution.
27 Allow negative subscripts with RECNO interface.
28 Changed the default flags to O_CREAT|O_RDWR
30 1.04 - fixed a couple of bugs in hash_cb. Patches supplied by
31 Dave Hammen, hammen@gothamcity.jsc.nasa.gov
32 1.05 - Added logic to allow prefix & hash types to be specified via
34 1.06 - Minor namespace cleanup: Localized PrintBtree.
35 1.07 - Fixed bug with RECNO, where bval wasn't defaulting to "\n".
36 1.08 - No change to DB_File.xs
37 1.09 - Default mode for dbopen changed to 0666
38 1.10 - Fixed fd method so that it still returns -1 for
39 in-memory files when db 1.86 is used.
40 1.11 - No change to DB_File.xs
41 1.12 - No change to DB_File.xs
42 1.13 - Tidied up a few casts.
43 1.14 - Made it illegal to tie an associative array to a RECNO
44 database and an ordinary array to a HASH or BTREE database.
45 1.50 - Make work with both DB 1.x or DB 2.x
46 1.51 - Fixed a bug in mapping 1.x O_RDONLY flag to 2.x DB_RDONLY equivalent
47 1.52 - Patch from Gisle Aas <gisle@aas.no> to suppress "use of
48 undefined value" warning with db_get and db_seq.
49 1.53 - Added DB_RENUMBER to flags for recno.
50 1.54 - Fixed bug in the fd method
51 1.55 - Fix for AIX from Jarkko Hietaniemi
52 1.56 - No change to DB_File.xs
53 1.57 - added the #undef op to allow building with Threads support.
54 1.58 - Fixed a problem with the use of sv_setpvn. When the
55 size is specified as 0, it does a strlen on the data.
56 This was ok for DB 1.x, but isn't for DB 2.x.
57 1.59 - No change to DB_File.xs
58 1.60 - Some code tidy up
59 1.61 - added flagSet macro for DB 2.5.x
60 fixed typo in O_RDONLY test.
61 1.62 - No change to DB_File.xs
62 1.63 - Fix to alllow DB 2.6.x to build.
63 1.64 - Tidied up the 1.x to 2.x flags mapping code.
64 Added a patch from Mark Kettenis <kettenis@wins.uva.nl>
65 to fix a flag mapping problem with O_RDONLY on the Hurd
66 1.65 - Fixed a bug in the PUSH logic.
67 Added BOOT check that using 2.3.4 or greater
68 1.66 - Added DBM filter code
69 1.67 - Backed off the use of newSVpvn.
70 Fixed DBM Filter code for Perl 5.004.
71 Fixed a small memory leak in the filter code.
72 1.68 - fixed backward compatability bug with R_IAFTER & R_IBEFORE
73 merged in the 5.005_58 changes
74 1.69 - fixed a bug in push -- DB_APPEND wasn't working properly.
75 Fixed the R_SETCURSOR bug introduced in 1.68
76 Added a new Perl variable $DB_File::db_ver
77 1.70 - Initialise $DB_File::db_ver and $DB_File::db_version with
78 GV_ADD|GV_ADDMULT -- bug spotted by Nick Ing-Simmons.
79 Added a BOOT check to test for equivalent versions of db.h &
81 1.71 - Support for Berkeley DB version 3.
82 Support for Berkeley DB 2/3's backward compatability mode.
84 1.72 - No change to DB_File.xs
85 1.73 - No change to DB_File.xs
94 # include "patchlevel.h"
95 # define PERL_REVISION 5
96 # define PERL_VERSION PATCHLEVEL
97 # define PERL_SUBVERSION SUBVERSION
100 #if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 ))
102 # define PL_sv_undef sv_undef
107 /* DEFSV appears first in 5.004_56 */
109 # define DEFSV GvSV(defgv)
112 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
113 * shortly #included by the <db.h>) __attribute__ to the possibly
114 * already defined __attribute__, for example by GNUC or by Perl. */
118 /* If Perl has been compiled with Threads support,the symbol op will
119 be defined here. This clashes with a field name in db.h, so get rid of it.
131 extern void __getBerkeleyDBInfo(void);
141 # define newSVpvn(a,b) newSVpv(a,b)
147 #define DBM_FILTERING
150 # define Trace(x) printf x
156 #define DBT_clear(x) Zero(&x, 1, DBT) ;
158 #ifdef DB_VERSION_MAJOR
160 #if DB_VERSION_MAJOR == 2
161 # define BERKELEY_DB_1_OR_2
164 /* map version 2 features & constants onto their version 1 equivalent */
169 #define DB_Prefix_t size_t
174 #define DB_Hash_t u_int32_t
176 /* DBTYPE stays the same */
177 /* HASHINFO, RECNOINFO and BTREEINFO map to DB_INFO */
178 #if DB_VERSION_MAJOR == 2
179 typedef DB_INFO INFO ;
180 #else /* DB_VERSION_MAJOR > 2 */
181 # define DB_FIXEDLEN (0x8000)
182 #endif /* DB_VERSION_MAJOR == 2 */
184 /* version 2 has db_recno_t in place of recno_t */
185 typedef db_recno_t recno_t;
188 #define R_CURSOR DB_SET_RANGE
189 #define R_FIRST DB_FIRST
190 #define R_IAFTER DB_AFTER
191 #define R_IBEFORE DB_BEFORE
192 #define R_LAST DB_LAST
193 #define R_NEXT DB_NEXT
194 #define R_NOOVERWRITE DB_NOOVERWRITE
195 #define R_PREV DB_PREV
197 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
198 # define R_SETCURSOR 0x800000
200 # define R_SETCURSOR (-100)
203 #define R_RECNOSYNC 0
204 #define R_FIXEDLEN DB_FIXEDLEN
208 #define db_HA_hash h_hash
209 #define db_HA_ffactor h_ffactor
210 #define db_HA_nelem h_nelem
211 #define db_HA_bsize db_pagesize
212 #define db_HA_cachesize db_cachesize
213 #define db_HA_lorder db_lorder
215 #define db_BT_compare bt_compare
216 #define db_BT_prefix bt_prefix
217 #define db_BT_flags flags
218 #define db_BT_psize db_pagesize
219 #define db_BT_cachesize db_cachesize
220 #define db_BT_lorder db_lorder
221 #define db_BT_maxkeypage
222 #define db_BT_minkeypage
225 #define db_RE_reclen re_len
226 #define db_RE_flags flags
227 #define db_RE_bval re_pad
228 #define db_RE_bfname re_source
229 #define db_RE_psize db_pagesize
230 #define db_RE_cachesize db_cachesize
231 #define db_RE_lorder db_lorder
235 #define do_SEQ(db, key, value, flag) (db->cursor->c_get)(db->cursor, &key, &value, flag)
238 #define DBT_flags(x) x.flags = 0
239 #define DB_flags(x, v) x |= v
241 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
242 # define flagSet(flags, bitmask) ((flags) & (bitmask))
244 # define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask))
247 #else /* db version 1.x */
249 #define BERKELEY_DB_1_OR_2
262 # define DB_Prefix_t mDB_Prefix_t
269 # define DB_Hash_t mDB_Hash_t
272 #define db_HA_hash hash.hash
273 #define db_HA_ffactor hash.ffactor
274 #define db_HA_nelem hash.nelem
275 #define db_HA_bsize hash.bsize
276 #define db_HA_cachesize hash.cachesize
277 #define db_HA_lorder hash.lorder
279 #define db_BT_compare btree.compare
280 #define db_BT_prefix btree.prefix
281 #define db_BT_flags btree.flags
282 #define db_BT_psize btree.psize
283 #define db_BT_cachesize btree.cachesize
284 #define db_BT_lorder btree.lorder
285 #define db_BT_maxkeypage btree.maxkeypage
286 #define db_BT_minkeypage btree.minkeypage
288 #define db_RE_reclen recno.reclen
289 #define db_RE_flags recno.flags
290 #define db_RE_bval recno.bval
291 #define db_RE_bfname recno.bfname
292 #define db_RE_psize recno.psize
293 #define db_RE_cachesize recno.cachesize
294 #define db_RE_lorder recno.lorder
298 #define do_SEQ(db, key, value, flag) (db->dbp->seq)(db->dbp, &key, &value, flag)
300 #define DB_flags(x, v)
301 #define flagSet(flags, bitmask) ((flags) & (bitmask))
303 #endif /* db version 1 */
307 #define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, TXN &key, flags)
308 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, flags)
309 #define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
311 #define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
312 #define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
314 #ifdef DB_VERSION_MAJOR
315 #define db_DESTROY(db) ( db->cursor->c_close(db->cursor),\
316 (db->dbp->close)(db->dbp, 0) )
317 #define db_close(db) ((db->dbp)->close)(db->dbp, 0)
318 #define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \
319 ? ((db->cursor)->c_del)(db->cursor, 0) \
320 : ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
322 #else /* ! DB_VERSION_MAJOR */
324 #define db_DESTROY(db) ((db->dbp)->close)(db->dbp)
325 #define db_close(db) ((db->dbp)->close)(db->dbp)
326 #define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
327 #define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
329 #endif /* ! DB_VERSION_MAJOR */
332 #define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags)
341 #ifdef BERKELEY_DB_1_OR_2
344 #ifdef DB_VERSION_MAJOR
348 SV * filter_fetch_key ;
349 SV * filter_store_key ;
350 SV * filter_fetch_value ;
351 SV * filter_store_value ;
353 #endif /* DBM_FILTERING */
357 typedef DB_File_type * DB_File ;
362 #define ckFilter(arg,type,name) \
365 /* printf("filtering %s\n", name) ;*/ \
367 croak("recursion detected in %s", name) ; \
368 db->filtering = TRUE ; \
369 save_defsv = newSVsv(DEFSV) ; \
370 sv_setsv(DEFSV, arg) ; \
372 (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \
373 sv_setsv(arg, DEFSV) ; \
374 sv_setsv(DEFSV, save_defsv) ; \
375 SvREFCNT_dec(save_defsv) ; \
376 db->filtering = FALSE ; \
377 /*printf("end of filtering %s\n", name) ;*/ \
382 #define ckFilter(arg,type, name)
384 #endif /* DBM_FILTERING */
386 #define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
388 #define OutputValue(arg, name) \
389 { if (RETVAL == 0) { \
390 my_sv_setpvn(arg, name.data, name.size) ; \
391 ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \
395 #define OutputKey(arg, name) \
398 if (db->type != DB_RECNO) { \
399 my_sv_setpvn(arg, name.data, name.size); \
402 sv_setiv(arg, (I32)*(I32*)name.data - 1); \
403 ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \
408 /* Internal Global Data */
409 static recno_t Value ;
410 static recno_t zero = 0 ;
411 static DB_File CurrentDB ;
412 static DBTKEY empty ;
414 #ifdef DB_VERSION_MAJOR
418 db_put(DB_File db, DBTKEY key, DBT value, u_int flags)
420 db_put(db, key, value, flags)
429 if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) {
433 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
434 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor) != 0)
436 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor, 0) != 0)
440 memset(&l_key, 0, sizeof(l_key));
441 l_key.data = key.data;
442 l_key.size = key.size;
443 memset(&l_value, 0, sizeof(l_value));
444 l_value.data = value.data;
445 l_value.size = value.size;
447 if ( temp_cursor->c_get(temp_cursor, &l_key, &l_value, DB_SET) != 0) {
448 (void)temp_cursor->c_close(temp_cursor);
452 status = temp_cursor->c_put(temp_cursor, &key, &value, flags);
453 (void)temp_cursor->c_close(temp_cursor);
459 if (flagSet(flags, R_CURSOR)) {
460 return ((db->cursor)->c_put)(db->cursor, &key, &value, DB_CURRENT);
463 if (flagSet(flags, R_SETCURSOR)) {
464 if ((db->dbp)->put(db->dbp, NULL, &key, &value, 0) != 0)
466 return ((db->cursor)->c_get)(db->cursor, &key, &value, DB_SET_RANGE);
470 return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
474 #endif /* DB_VERSION_MAJOR */
479 btree_compare(const DBT *key1, const DBT *key2)
481 btree_compare(key1, key2)
490 void * data1, * data2 ;
498 /* As newSVpv will assume that the data pointer is a null terminated C
499 string if the size parameter is 0, make sure that data points to an
500 empty string if the length is 0
513 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
514 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
517 count = perl_call_sv(CurrentDB->compare, G_SCALAR);
522 croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
535 btree_prefix(const DBT *key1, const DBT *key2)
537 btree_prefix(key1, key2)
546 void * data1, * data2 ;
554 /* As newSVpv will assume that the data pointer is a null terminated C
555 string if the size parameter is 0, make sure that data points to an
556 empty string if the length is 0
569 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
570 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
573 count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
578 croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
589 #ifdef BERKELEY_DB_1_OR_2
590 # define HASH_CB_SIZE_TYPE size_t
592 # define HASH_CB_SIZE_TYPE u_int32_t
597 hash_cb(const void *data, HASH_CB_SIZE_TYPE size)
601 HASH_CB_SIZE_TYPE size ;
616 /* DGH - Next two lines added to fix corrupted stack problem */
622 XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
625 count = perl_call_sv(CurrentDB->hash, G_SCALAR);
630 croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
642 #if defined(TRACE) && defined(BERKELEY_DB_1_OR_2)
646 PrintHash(INFO *hash)
652 printf ("HASH Info\n") ;
653 printf (" hash = %s\n",
654 (hash->db_HA_hash != NULL ? "redefined" : "default")) ;
655 printf (" bsize = %d\n", hash->db_HA_bsize) ;
656 printf (" ffactor = %d\n", hash->db_HA_ffactor) ;
657 printf (" nelem = %d\n", hash->db_HA_nelem) ;
658 printf (" cachesize = %d\n", hash->db_HA_cachesize) ;
659 printf (" lorder = %d\n", hash->db_HA_lorder) ;
665 PrintRecno(INFO *recno)
671 printf ("RECNO Info\n") ;
672 printf (" flags = %d\n", recno->db_RE_flags) ;
673 printf (" cachesize = %d\n", recno->db_RE_cachesize) ;
674 printf (" psize = %d\n", recno->db_RE_psize) ;
675 printf (" lorder = %d\n", recno->db_RE_lorder) ;
676 printf (" reclen = %ul\n", (unsigned long)recno->db_RE_reclen) ;
677 printf (" bval = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
678 printf (" bfname = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
683 PrintBtree(INFO *btree)
689 printf ("BTREE Info\n") ;
690 printf (" compare = %s\n",
691 (btree->db_BT_compare ? "redefined" : "default")) ;
692 printf (" prefix = %s\n",
693 (btree->db_BT_prefix ? "redefined" : "default")) ;
694 printf (" flags = %d\n", btree->db_BT_flags) ;
695 printf (" cachesize = %d\n", btree->db_BT_cachesize) ;
696 printf (" psize = %d\n", btree->db_BT_psize) ;
697 #ifndef DB_VERSION_MAJOR
698 printf (" maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
699 printf (" minkeypage = %d\n", btree->db_BT_minkeypage) ;
701 printf (" lorder = %d\n", btree->db_BT_lorder) ;
706 #define PrintRecno(recno)
707 #define PrintHash(hash)
708 #define PrintBtree(btree)
715 GetArrayLength(pTHX_ DB_File db)
727 RETVAL = do_SEQ(db, key, value, R_LAST) ;
729 RETVAL = *(I32 *)key.data ;
730 else /* No key means empty file */
733 return ((I32)RETVAL) ;
738 GetRecnoKey(pTHX_ DB_File db, I32 value)
740 GetRecnoKey(db, value)
746 /* Get the length of the array */
747 I32 length = GetArrayLength(aTHX_ db) ;
749 /* check for attempt to write before start of array */
750 if (length + value + 1 <= 0)
751 croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
753 value = length + value + 1 ;
764 ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv)
766 ParseOpenInfo(isHASH, name, flags, mode, sv)
775 #ifdef BERKELEY_DB_1_OR_2 /* Berkeley DB Version 1 or 2 */
779 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
780 void * openinfo = NULL ;
781 INFO * info = &RETVAL->info ;
784 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
785 Zero(RETVAL, 1, DB_File_type) ;
787 /* Default to HASH */
789 RETVAL->filtering = 0 ;
790 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
791 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
792 #endif /* DBM_FILTERING */
793 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
794 RETVAL->type = DB_HASH ;
796 /* DGH - Next line added to avoid SEGV on existing hash DB */
799 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
800 RETVAL->in_memory = (name == NULL) ;
805 croak ("type parameter is not a reference") ;
807 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
808 if (svp && SvOK(*svp))
809 action = (HV*) SvRV(*svp) ;
811 croak("internal error") ;
813 if (sv_isa(sv, "DB_File::HASHINFO"))
817 croak("DB_File can only tie an associative array to a DB_HASH database") ;
819 RETVAL->type = DB_HASH ;
820 openinfo = (void*)info ;
822 svp = hv_fetch(action, "hash", 4, FALSE);
824 if (svp && SvOK(*svp))
826 info->db_HA_hash = hash_cb ;
827 RETVAL->hash = newSVsv(*svp) ;
830 info->db_HA_hash = NULL ;
832 svp = hv_fetch(action, "ffactor", 7, FALSE);
833 info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
835 svp = hv_fetch(action, "nelem", 5, FALSE);
836 info->db_HA_nelem = svp ? SvIV(*svp) : 0;
838 svp = hv_fetch(action, "bsize", 5, FALSE);
839 info->db_HA_bsize = svp ? SvIV(*svp) : 0;
841 svp = hv_fetch(action, "cachesize", 9, FALSE);
842 info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
844 svp = hv_fetch(action, "lorder", 6, FALSE);
845 info->db_HA_lorder = svp ? SvIV(*svp) : 0;
849 else if (sv_isa(sv, "DB_File::BTREEINFO"))
852 croak("DB_File can only tie an associative array to a DB_BTREE database");
854 RETVAL->type = DB_BTREE ;
855 openinfo = (void*)info ;
857 svp = hv_fetch(action, "compare", 7, FALSE);
858 if (svp && SvOK(*svp))
860 info->db_BT_compare = btree_compare ;
861 RETVAL->compare = newSVsv(*svp) ;
864 info->db_BT_compare = NULL ;
866 svp = hv_fetch(action, "prefix", 6, FALSE);
867 if (svp && SvOK(*svp))
869 info->db_BT_prefix = btree_prefix ;
870 RETVAL->prefix = newSVsv(*svp) ;
873 info->db_BT_prefix = NULL ;
875 svp = hv_fetch(action, "flags", 5, FALSE);
876 info->db_BT_flags = svp ? SvIV(*svp) : 0;
878 svp = hv_fetch(action, "cachesize", 9, FALSE);
879 info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
881 #ifndef DB_VERSION_MAJOR
882 svp = hv_fetch(action, "minkeypage", 10, FALSE);
883 info->btree.minkeypage = svp ? SvIV(*svp) : 0;
885 svp = hv_fetch(action, "maxkeypage", 10, FALSE);
886 info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
889 svp = hv_fetch(action, "psize", 5, FALSE);
890 info->db_BT_psize = svp ? SvIV(*svp) : 0;
892 svp = hv_fetch(action, "lorder", 6, FALSE);
893 info->db_BT_lorder = svp ? SvIV(*svp) : 0;
898 else if (sv_isa(sv, "DB_File::RECNOINFO"))
901 croak("DB_File can only tie an array to a DB_RECNO database");
903 RETVAL->type = DB_RECNO ;
904 openinfo = (void *)info ;
906 info->db_RE_flags = 0 ;
908 svp = hv_fetch(action, "flags", 5, FALSE);
909 info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
911 svp = hv_fetch(action, "reclen", 6, FALSE);
912 info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
914 svp = hv_fetch(action, "cachesize", 9, FALSE);
915 info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
917 svp = hv_fetch(action, "psize", 5, FALSE);
918 info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
920 svp = hv_fetch(action, "lorder", 6, FALSE);
921 info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
923 #ifdef DB_VERSION_MAJOR
924 info->re_source = name ;
927 svp = hv_fetch(action, "bfname", 6, FALSE);
928 if (svp && SvOK(*svp)) {
929 char * ptr = SvPV(*svp,n_a) ;
930 #ifdef DB_VERSION_MAJOR
931 name = (char*) n_a ? ptr : NULL ;
933 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
937 #ifdef DB_VERSION_MAJOR
940 info->db_RE_bfname = NULL ;
943 svp = hv_fetch(action, "bval", 4, FALSE);
944 #ifdef DB_VERSION_MAJOR
945 if (svp && SvOK(*svp))
949 value = (int)*SvPV(*svp, n_a) ;
953 if (info->flags & DB_FIXEDLEN) {
954 info->re_pad = value ;
955 info->flags |= DB_PAD ;
958 info->re_delim = value ;
959 info->flags |= DB_DELIMITER ;
964 if (svp && SvOK(*svp))
967 info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
969 info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
970 DB_flags(info->flags, DB_DELIMITER) ;
975 if (info->db_RE_flags & R_FIXEDLEN)
976 info->db_RE_bval = (u_char) ' ' ;
978 info->db_RE_bval = (u_char) '\n' ;
979 DB_flags(info->flags, DB_DELIMITER) ;
984 info->flags |= DB_RENUMBER ;
990 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
994 /* OS2 Specific Code */
1001 #ifdef DB_VERSION_MAJOR
1007 /* Map 1.x flags to 2.x flags */
1008 if ((flags & O_CREAT) == O_CREAT)
1009 Flags |= DB_CREATE ;
1012 if (flags == O_RDONLY)
1014 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1016 Flags |= DB_RDONLY ;
1019 if ((flags & O_TRUNC) == O_TRUNC)
1020 Flags |= DB_TRUNCATE ;
1023 status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
1025 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
1026 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
1028 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1033 RETVAL->dbp = NULL ;
1038 #if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2
1039 RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ;
1041 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
1042 #endif /* DB_LIBRARY_COMPATIBILITY_API */
1048 #else /* Berkeley DB Version > 2 */
1052 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
1057 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
1058 Zero(RETVAL, 1, DB_File_type) ;
1060 /* Default to HASH */
1061 #ifdef DBM_FILTERING
1062 RETVAL->filtering = 0 ;
1063 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
1064 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
1065 #endif /* DBM_FILTERING */
1066 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
1067 RETVAL->type = DB_HASH ;
1069 /* DGH - Next line added to avoid SEGV on existing hash DB */
1072 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
1073 RETVAL->in_memory = (name == NULL) ;
1075 status = db_create(&RETVAL->dbp, NULL,0) ;
1076 /* printf("db_create returned %d %s\n", status, db_strerror(status)) ; */
1078 RETVAL->dbp = NULL ;
1086 croak ("type parameter is not a reference") ;
1088 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
1089 if (svp && SvOK(*svp))
1090 action = (HV*) SvRV(*svp) ;
1092 croak("internal error") ;
1094 if (sv_isa(sv, "DB_File::HASHINFO"))
1098 croak("DB_File can only tie an associative array to a DB_HASH database") ;
1100 RETVAL->type = DB_HASH ;
1102 svp = hv_fetch(action, "hash", 4, FALSE);
1104 if (svp && SvOK(*svp))
1106 (void)dbp->set_h_hash(dbp, hash_cb) ;
1107 RETVAL->hash = newSVsv(*svp) ;
1110 svp = hv_fetch(action, "ffactor", 7, FALSE);
1112 (void)dbp->set_h_ffactor(dbp, SvIV(*svp)) ;
1114 svp = hv_fetch(action, "nelem", 5, FALSE);
1116 (void)dbp->set_h_nelem(dbp, SvIV(*svp)) ;
1118 svp = hv_fetch(action, "bsize", 5, FALSE);
1120 (void)dbp->set_pagesize(dbp, SvIV(*svp));
1122 svp = hv_fetch(action, "cachesize", 9, FALSE);
1124 (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1126 svp = hv_fetch(action, "lorder", 6, FALSE);
1128 (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
1132 else if (sv_isa(sv, "DB_File::BTREEINFO"))
1135 croak("DB_File can only tie an associative array to a DB_BTREE database");
1137 RETVAL->type = DB_BTREE ;
1139 svp = hv_fetch(action, "compare", 7, FALSE);
1140 if (svp && SvOK(*svp))
1142 (void)dbp->set_bt_compare(dbp, btree_compare) ;
1143 RETVAL->compare = newSVsv(*svp) ;
1146 svp = hv_fetch(action, "prefix", 6, FALSE);
1147 if (svp && SvOK(*svp))
1149 (void)dbp->set_bt_prefix(dbp, btree_prefix) ;
1150 RETVAL->prefix = newSVsv(*svp) ;
1153 svp = hv_fetch(action, "flags", 5, FALSE);
1155 (void)dbp->set_flags(dbp, SvIV(*svp)) ;
1157 svp = hv_fetch(action, "cachesize", 9, FALSE);
1159 (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1161 svp = hv_fetch(action, "psize", 5, FALSE);
1163 (void)dbp->set_pagesize(dbp, SvIV(*svp)) ;
1165 svp = hv_fetch(action, "lorder", 6, FALSE);
1167 (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
1172 else if (sv_isa(sv, "DB_File::RECNOINFO"))
1177 croak("DB_File can only tie an array to a DB_RECNO database");
1179 RETVAL->type = DB_RECNO ;
1181 svp = hv_fetch(action, "flags", 5, FALSE);
1183 int flags = SvIV(*svp) ;
1184 /* remove FIXDLEN, if present */
1185 if (flags & DB_FIXEDLEN) {
1187 flags &= ~DB_FIXEDLEN ;
1191 svp = hv_fetch(action, "cachesize", 9, FALSE);
1193 status = dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1196 svp = hv_fetch(action, "psize", 5, FALSE);
1198 status = dbp->set_pagesize(dbp, SvIV(*svp)) ;
1201 svp = hv_fetch(action, "lorder", 6, FALSE);
1203 status = dbp->set_lorder(dbp, SvIV(*svp)) ;
1206 svp = hv_fetch(action, "bval", 4, FALSE);
1207 if (svp && SvOK(*svp))
1211 value = (int)*SvPV(*svp, n_a) ;
1213 value = SvIV(*svp) ;
1216 status = dbp->set_re_pad(dbp, value) ;
1219 status = dbp->set_re_delim(dbp, value) ;
1225 svp = hv_fetch(action, "reclen", 6, FALSE);
1227 u_int32_t len = (u_int32_t)SvIV(*svp) ;
1228 status = dbp->set_re_len(dbp, len) ;
1233 status = dbp->set_re_source(dbp, name) ;
1237 svp = hv_fetch(action, "bfname", 6, FALSE);
1238 if (svp && SvOK(*svp)) {
1239 char * ptr = SvPV(*svp,n_a) ;
1240 name = (char*) n_a ? ptr : NULL ;
1246 status = dbp->set_flags(dbp, DB_RENUMBER) ;
1249 (void)dbp->set_flags(dbp, flags) ;
1254 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1261 /* Map 1.x flags to 3.x flags */
1262 if ((flags & O_CREAT) == O_CREAT)
1263 Flags |= DB_CREATE ;
1266 if (flags == O_RDONLY)
1268 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1270 Flags |= DB_RDONLY ;
1273 if ((flags & O_TRUNC) == O_TRUNC)
1274 Flags |= DB_TRUNCATE ;
1277 status = RETVAL->dbp->open(RETVAL->dbp, name, NULL, RETVAL->type,
1279 /* printf("open returned %d %s\n", status, db_strerror(status)) ; */
1282 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1284 /* printf("cursor returned %d %s\n", status, db_strerror(status)) ; */
1287 RETVAL->dbp = NULL ;
1293 #endif /* Berkeley DB Version > 2 */
1295 } /* ParseOpenInfo */
1299 #ifdef CAN_PROTOTYPE
1300 constant(char *name, int arg)
1312 if (strEQ(name, "BTREEMAGIC"))
1318 if (strEQ(name, "BTREEVERSION"))
1320 return BTREEVERSION;
1328 if (strEQ(name, "DB_LOCK"))
1334 if (strEQ(name, "DB_SHMEM"))
1340 if (strEQ(name, "DB_TXN"))
1354 if (strEQ(name, "HASHMAGIC"))
1360 if (strEQ(name, "HASHVERSION"))
1376 if (strEQ(name, "MAX_PAGE_NUMBER"))
1377 #ifdef MAX_PAGE_NUMBER
1378 return (U32)MAX_PAGE_NUMBER;
1382 if (strEQ(name, "MAX_PAGE_OFFSET"))
1383 #ifdef MAX_PAGE_OFFSET
1384 return MAX_PAGE_OFFSET;
1388 if (strEQ(name, "MAX_REC_NUMBER"))
1389 #ifdef MAX_REC_NUMBER
1390 return (U32)MAX_REC_NUMBER;
1404 if (strEQ(name, "RET_ERROR"))
1410 if (strEQ(name, "RET_SPECIAL"))
1416 if (strEQ(name, "RET_SUCCESS"))
1422 if (strEQ(name, "R_CURSOR"))
1428 if (strEQ(name, "R_DUP"))
1434 if (strEQ(name, "R_FIRST"))
1440 if (strEQ(name, "R_FIXEDLEN"))
1446 if (strEQ(name, "R_IAFTER"))
1452 if (strEQ(name, "R_IBEFORE"))
1458 if (strEQ(name, "R_LAST"))
1464 if (strEQ(name, "R_NEXT"))
1470 if (strEQ(name, "R_NOKEY"))
1476 if (strEQ(name, "R_NOOVERWRITE"))
1477 #ifdef R_NOOVERWRITE
1478 return R_NOOVERWRITE;
1482 if (strEQ(name, "R_PREV"))
1488 if (strEQ(name, "R_RECNOSYNC"))
1494 if (strEQ(name, "R_SETCURSOR"))
1500 if (strEQ(name, "R_SNAPSHOT"))
1534 MODULE = DB_File PACKAGE = DB_File PREFIX = db_
1538 __getBerkeleyDBInfo() ;
1541 empty.data = &zero ;
1542 empty.size = sizeof(recno_t) ;
1552 db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
1559 char * name = (char *) NULL ;
1560 SV * sv = (SV *) NULL ;
1563 if (items >= 3 && SvOK(ST(2)))
1564 name = (char*) SvPV(ST(2), n_a) ;
1569 RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
1570 if (RETVAL->dbp == NULL)
1583 SvREFCNT_dec(db->hash) ;
1585 SvREFCNT_dec(db->compare) ;
1587 SvREFCNT_dec(db->prefix) ;
1588 #ifdef DBM_FILTERING
1589 if (db->filter_fetch_key)
1590 SvREFCNT_dec(db->filter_fetch_key) ;
1591 if (db->filter_store_key)
1592 SvREFCNT_dec(db->filter_store_key) ;
1593 if (db->filter_fetch_value)
1594 SvREFCNT_dec(db->filter_fetch_value) ;
1595 if (db->filter_store_value)
1596 SvREFCNT_dec(db->filter_store_value) ;
1597 #endif /* DBM_FILTERING */
1599 #ifdef DB_VERSION_MAJOR
1606 db_DELETE(db, key, flags=0)
1624 RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
1630 db_FETCH(db, key, flags=0)
1640 /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */
1641 RETVAL = db_get(db, key, value, flags) ;
1642 ST(0) = sv_newmortal();
1643 OutputValue(ST(0), value)
1647 db_STORE(db, key, value, flags=0)
1667 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1668 ST(0) = sv_newmortal();
1669 OutputKey(ST(0), key) ;
1682 RETVAL = do_SEQ(db, key, value, R_NEXT) ;
1683 ST(0) = sv_newmortal();
1684 OutputKey(ST(0), key) ;
1688 # These would be nice for RECNO
1707 #ifdef DB_VERSION_MAJOR
1708 /* get the first value */
1709 RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1714 for (i = items-1 ; i > 0 ; --i)
1716 value.data = SvPV(ST(i), n_a) ;
1720 key.size = sizeof(int) ;
1721 #ifdef DB_VERSION_MAJOR
1722 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1724 RETVAL = (Db->put)(Db, &key, &value, R_IBEFORE) ;
1746 /* First get the final value */
1747 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1748 ST(0) = sv_newmortal();
1752 /* the call to del will trash value, so take a copy now */
1753 OutputValue(ST(0), value) ;
1754 RETVAL = db_del(db, key, R_CURSOR) ;
1756 sv_setsv(ST(0), &PL_sv_undef);
1772 /* get the first value */
1773 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1774 ST(0) = sv_newmortal();
1778 /* the call to del will trash value, so take a copy now */
1779 OutputValue(ST(0), value) ;
1780 RETVAL = db_del(db, key, R_CURSOR) ;
1782 sv_setsv (ST(0), &PL_sv_undef) ;
1803 /* Set the Cursor to the Last element */
1804 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1805 #ifndef DB_VERSION_MAJOR
1810 keyval = *(int*)key.data ;
1813 for (i = 1 ; i < items ; ++i)
1815 value.data = SvPV(ST(i), n_a) ;
1818 key.data = &keyval ;
1819 key.size = sizeof(int) ;
1820 RETVAL = (Db->put)(Db, TXN &key, &value, 0) ;
1832 ALIAS: FETCHSIZE = 1
1835 RETVAL = GetArrayLength(aTHX_ db) ;
1841 # Now provide an interface to the rest of the DB functionality
1845 db_del(db, key, flags=0)
1851 RETVAL = db_del(db, key, flags) ;
1852 #ifdef DB_VERSION_MAJOR
1855 else if (RETVAL == DB_NOTFOUND)
1863 db_get(db, key, value, flags=0)
1871 RETVAL = db_get(db, key, value, flags) ;
1872 #ifdef DB_VERSION_MAJOR
1875 else if (RETVAL == DB_NOTFOUND)
1883 db_put(db, key, value, flags=0)
1890 RETVAL = db_put(db, key, value, flags) ;
1891 #ifdef DB_VERSION_MAJOR
1894 else if (RETVAL == DB_KEYEXIST)
1899 key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
1907 #ifdef DB_VERSION_MAJOR
1909 status = (db->in_memory
1911 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
1915 RETVAL = (db->in_memory
1917 : ((db->dbp)->fd)(db->dbp) ) ;
1923 db_sync(db, flags=0)
1928 RETVAL = db_sync(db, flags) ;
1929 #ifdef DB_VERSION_MAJOR
1938 db_seq(db, key, value, flags)
1946 RETVAL = db_seq(db, key, value, flags);
1947 #ifdef DB_VERSION_MAJOR
1950 else if (RETVAL == DB_NOTFOUND)
1958 #ifdef DBM_FILTERING
1960 #define setFilter(type) \
1963 RETVAL = sv_mortalcopy(db->type) ; \
1965 if (db->type && (code == &PL_sv_undef)) { \
1966 SvREFCNT_dec(db->type) ; \
1971 sv_setsv(db->type, code) ; \
1973 db->type = newSVsv(code) ; \
1979 filter_fetch_key(db, code)
1982 SV * RETVAL = &PL_sv_undef ;
1984 setFilter(filter_fetch_key) ;
1987 filter_store_key(db, code)
1990 SV * RETVAL = &PL_sv_undef ;
1992 setFilter(filter_store_key) ;
1995 filter_fetch_value(db, code)
1998 SV * RETVAL = &PL_sv_undef ;
2000 setFilter(filter_fetch_value) ;
2003 filter_store_value(db, code)
2006 SV * RETVAL = &PL_sv_undef ;
2008 setFilter(filter_store_value) ;
2010 #endif /* DBM_FILTERING */