3 DB_File.xs -- Perl 5 interface to Berkeley DB
5 written by Paul Marquess <Paul.Marquess@btinternet.com>
6 last modified 17 December 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
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
101 # include "patchlevel.h"
102 # define PERL_REVISION 5
103 # define PERL_VERSION PATCHLEVEL
104 # define PERL_SUBVERSION SUBVERSION
107 #if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 ))
109 # define PL_sv_undef sv_undef
114 /* DEFSV appears first in 5.004_56 */
116 # define DEFSV GvSV(defgv)
119 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
120 * shortly #included by the <db.h>) __attribute__ to the possibly
121 * already defined __attribute__, for example by GNUC or by Perl. */
125 /* If Perl has been compiled with Threads support,the symbol op will
126 be defined here. This clashes with a field name in db.h, so get rid of it.
139 extern void __getBerkeleyDBInfo(void);
150 # define newSVpvn(a,b) newSVpv(a,b)
156 #define DBM_FILTERING
159 # define Trace(x) printf x
165 #define DBT_clear(x) Zero(&x, 1, DBT) ;
167 #ifdef DB_VERSION_MAJOR
169 #if DB_VERSION_MAJOR == 2
170 # define BERKELEY_DB_1_OR_2
173 #if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 2)
174 # define AT_LEAST_DB_3_2
177 /* map version 2 features & constants onto their version 1 equivalent */
182 #define DB_Prefix_t size_t
187 #define DB_Hash_t u_int32_t
189 /* DBTYPE stays the same */
190 /* HASHINFO, RECNOINFO and BTREEINFO map to DB_INFO */
191 #if DB_VERSION_MAJOR == 2
192 typedef DB_INFO INFO ;
193 #else /* DB_VERSION_MAJOR > 2 */
194 # define DB_FIXEDLEN (0x8000)
195 #endif /* DB_VERSION_MAJOR == 2 */
197 /* version 2 has db_recno_t in place of recno_t */
198 typedef db_recno_t recno_t;
201 #define R_CURSOR DB_SET_RANGE
202 #define R_FIRST DB_FIRST
203 #define R_IAFTER DB_AFTER
204 #define R_IBEFORE DB_BEFORE
205 #define R_LAST DB_LAST
206 #define R_NEXT DB_NEXT
207 #define R_NOOVERWRITE DB_NOOVERWRITE
208 #define R_PREV DB_PREV
210 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
211 # define R_SETCURSOR 0x800000
213 # define R_SETCURSOR (-100)
216 #define R_RECNOSYNC 0
217 #define R_FIXEDLEN DB_FIXEDLEN
221 #define db_HA_hash h_hash
222 #define db_HA_ffactor h_ffactor
223 #define db_HA_nelem h_nelem
224 #define db_HA_bsize db_pagesize
225 #define db_HA_cachesize db_cachesize
226 #define db_HA_lorder db_lorder
228 #define db_BT_compare bt_compare
229 #define db_BT_prefix bt_prefix
230 #define db_BT_flags flags
231 #define db_BT_psize db_pagesize
232 #define db_BT_cachesize db_cachesize
233 #define db_BT_lorder db_lorder
234 #define db_BT_maxkeypage
235 #define db_BT_minkeypage
238 #define db_RE_reclen re_len
239 #define db_RE_flags flags
240 #define db_RE_bval re_pad
241 #define db_RE_bfname re_source
242 #define db_RE_psize db_pagesize
243 #define db_RE_cachesize db_cachesize
244 #define db_RE_lorder db_lorder
248 #define do_SEQ(db, key, value, flag) (db->cursor->c_get)(db->cursor, &key, &value, flag)
251 #define DBT_flags(x) x.flags = 0
252 #define DB_flags(x, v) x |= v
254 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
255 # define flagSet(flags, bitmask) ((flags) & (bitmask))
257 # define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask))
260 #else /* db version 1.x */
262 #define BERKELEY_DB_1
263 #define BERKELEY_DB_1_OR_2
276 # define DB_Prefix_t mDB_Prefix_t
283 # define DB_Hash_t mDB_Hash_t
286 #define db_HA_hash hash.hash
287 #define db_HA_ffactor hash.ffactor
288 #define db_HA_nelem hash.nelem
289 #define db_HA_bsize hash.bsize
290 #define db_HA_cachesize hash.cachesize
291 #define db_HA_lorder hash.lorder
293 #define db_BT_compare btree.compare
294 #define db_BT_prefix btree.prefix
295 #define db_BT_flags btree.flags
296 #define db_BT_psize btree.psize
297 #define db_BT_cachesize btree.cachesize
298 #define db_BT_lorder btree.lorder
299 #define db_BT_maxkeypage btree.maxkeypage
300 #define db_BT_minkeypage btree.minkeypage
302 #define db_RE_reclen recno.reclen
303 #define db_RE_flags recno.flags
304 #define db_RE_bval recno.bval
305 #define db_RE_bfname recno.bfname
306 #define db_RE_psize recno.psize
307 #define db_RE_cachesize recno.cachesize
308 #define db_RE_lorder recno.lorder
312 #define do_SEQ(db, key, value, flag) (db->dbp->seq)(db->dbp, &key, &value, flag)
314 #define DB_flags(x, v)
315 #define flagSet(flags, bitmask) ((flags) & (bitmask))
317 #endif /* db version 1 */
321 #define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, TXN &key, flags)
322 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, flags)
323 #define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
325 #define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
326 #define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
328 #ifdef DB_VERSION_MAJOR
329 #define db_DESTROY(db) ( db->cursor->c_close(db->cursor),\
330 (db->dbp->close)(db->dbp, 0) )
331 #define db_close(db) ((db->dbp)->close)(db->dbp, 0)
332 #define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \
333 ? ((db->cursor)->c_del)(db->cursor, 0) \
334 : ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
336 #else /* ! DB_VERSION_MAJOR */
338 #define db_DESTROY(db) ((db->dbp)->close)(db->dbp)
339 #define db_close(db) ((db->dbp)->close)(db->dbp)
340 #define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
341 #define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
343 #endif /* ! DB_VERSION_MAJOR */
346 #define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags)
355 #ifdef BERKELEY_DB_1_OR_2
358 #ifdef DB_VERSION_MAJOR
362 SV * filter_fetch_key ;
363 SV * filter_store_key ;
364 SV * filter_fetch_value ;
365 SV * filter_store_value ;
367 #endif /* DBM_FILTERING */
371 typedef DB_File_type * DB_File ;
376 #define ckFilter(arg,type,name) \
379 /* printf("filtering %s\n", name) ;*/ \
381 croak("recursion detected in %s", name) ; \
382 db->filtering = TRUE ; \
383 save_defsv = newSVsv(DEFSV) ; \
384 sv_setsv(DEFSV, arg) ; \
386 (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \
387 sv_setsv(arg, DEFSV) ; \
388 sv_setsv(DEFSV, save_defsv) ; \
389 SvREFCNT_dec(save_defsv) ; \
390 db->filtering = FALSE ; \
391 /*printf("end of filtering %s\n", name) ;*/ \
396 #define ckFilter(arg,type, name)
398 #endif /* DBM_FILTERING */
400 #define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
402 #define OutputValue(arg, name) \
403 { if (RETVAL == 0) { \
404 my_sv_setpvn(arg, name.data, name.size) ; \
405 ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \
409 #define OutputKey(arg, name) \
412 if (db->type != DB_RECNO) { \
413 my_sv_setpvn(arg, name.data, name.size); \
416 sv_setiv(arg, (I32)*(I32*)name.data - 1); \
417 ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \
422 /* Internal Global Data */
423 static recno_t Value ;
424 static recno_t zero = 0 ;
425 static DB_File CurrentDB ;
426 static DBTKEY empty ;
428 #ifdef DB_VERSION_MAJOR
432 db_put(DB_File db, DBTKEY key, DBT value, u_int flags)
434 db_put(db, key, value, flags)
443 if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) {
447 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
448 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor) != 0)
450 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor, 0) != 0)
454 memset(&l_key, 0, sizeof(l_key));
455 l_key.data = key.data;
456 l_key.size = key.size;
457 memset(&l_value, 0, sizeof(l_value));
458 l_value.data = value.data;
459 l_value.size = value.size;
461 if ( temp_cursor->c_get(temp_cursor, &l_key, &l_value, DB_SET) != 0) {
462 (void)temp_cursor->c_close(temp_cursor);
466 status = temp_cursor->c_put(temp_cursor, &key, &value, flags);
467 (void)temp_cursor->c_close(temp_cursor);
473 if (flagSet(flags, R_CURSOR)) {
474 return ((db->cursor)->c_put)(db->cursor, &key, &value, DB_CURRENT);
477 if (flagSet(flags, R_SETCURSOR)) {
478 if ((db->dbp)->put(db->dbp, NULL, &key, &value, 0) != 0)
480 return ((db->cursor)->c_get)(db->cursor, &key, &value, DB_SET_RANGE);
484 return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
488 #endif /* DB_VERSION_MAJOR */
492 #ifdef AT_LEAST_DB_3_2
495 btree_compare(DB * db, const DBT *key1, const DBT *key2)
497 btree_compare(db, key1, key2)
501 #endif /* CAN_PROTOTYPE */
503 #else /* Berkeley DB < 3.2 */
506 btree_compare(const DBT *key1, const DBT *key2)
508 btree_compare(key1, key2)
520 void * data1, * data2 ;
528 /* As newSVpv will assume that the data pointer is a null terminated C
529 string if the size parameter is 0, make sure that data points to an
530 empty string if the length is 0
543 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
544 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
547 count = perl_call_sv(CurrentDB->compare, G_SCALAR);
552 croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
564 #ifdef AT_LEAST_DB_3_2
567 btree_prefix(DB * db, const DBT *key1, const DBT *key2)
569 btree_prefix(db, key1, key2)
575 #else /* Berkeley DB < 3.2 */
578 btree_prefix(const DBT *key1, const DBT *key2)
580 btree_prefix(key1, key2)
591 void * data1, * data2 ;
599 /* As newSVpv will assume that the data pointer is a null terminated C
600 string if the size parameter is 0, make sure that data points to an
601 empty string if the length is 0
614 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
615 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
618 count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
623 croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
636 # define HASH_CB_SIZE_TYPE size_t
638 # define HASH_CB_SIZE_TYPE u_int32_t
642 #ifdef AT_LEAST_DB_3_2
645 hash_cb(DB * db, const void *data, u_int32_t size)
647 hash_cb(db, data, size)
650 HASH_CB_SIZE_TYPE size ;
653 #else /* Berkeley DB < 3.2 */
656 hash_cb(const void *data, HASH_CB_SIZE_TYPE size)
660 HASH_CB_SIZE_TYPE size ;
677 /* DGH - Next two lines added to fix corrupted stack problem */
683 XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
686 count = perl_call_sv(CurrentDB->hash, G_SCALAR);
691 croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
703 #if defined(TRACE) && defined(BERKELEY_DB_1_OR_2)
707 PrintHash(INFO *hash)
713 printf ("HASH Info\n") ;
714 printf (" hash = %s\n",
715 (hash->db_HA_hash != NULL ? "redefined" : "default")) ;
716 printf (" bsize = %d\n", hash->db_HA_bsize) ;
717 printf (" ffactor = %d\n", hash->db_HA_ffactor) ;
718 printf (" nelem = %d\n", hash->db_HA_nelem) ;
719 printf (" cachesize = %d\n", hash->db_HA_cachesize) ;
720 printf (" lorder = %d\n", hash->db_HA_lorder) ;
726 PrintRecno(INFO *recno)
732 printf ("RECNO Info\n") ;
733 printf (" flags = %d\n", recno->db_RE_flags) ;
734 printf (" cachesize = %d\n", recno->db_RE_cachesize) ;
735 printf (" psize = %d\n", recno->db_RE_psize) ;
736 printf (" lorder = %d\n", recno->db_RE_lorder) ;
737 printf (" reclen = %ul\n", (unsigned long)recno->db_RE_reclen) ;
738 printf (" bval = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
739 printf (" bfname = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
744 PrintBtree(INFO *btree)
750 printf ("BTREE Info\n") ;
751 printf (" compare = %s\n",
752 (btree->db_BT_compare ? "redefined" : "default")) ;
753 printf (" prefix = %s\n",
754 (btree->db_BT_prefix ? "redefined" : "default")) ;
755 printf (" flags = %d\n", btree->db_BT_flags) ;
756 printf (" cachesize = %d\n", btree->db_BT_cachesize) ;
757 printf (" psize = %d\n", btree->db_BT_psize) ;
758 #ifndef DB_VERSION_MAJOR
759 printf (" maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
760 printf (" minkeypage = %d\n", btree->db_BT_minkeypage) ;
762 printf (" lorder = %d\n", btree->db_BT_lorder) ;
767 #define PrintRecno(recno)
768 #define PrintHash(hash)
769 #define PrintBtree(btree)
776 GetArrayLength(pTHX_ DB_File db)
788 RETVAL = do_SEQ(db, key, value, R_LAST) ;
790 RETVAL = *(I32 *)key.data ;
791 else /* No key means empty file */
794 return ((I32)RETVAL) ;
799 GetRecnoKey(pTHX_ DB_File db, I32 value)
801 GetRecnoKey(db, value)
807 /* Get the length of the array */
808 I32 length = GetArrayLength(aTHX_ db) ;
810 /* check for attempt to write before start of array */
811 if (length + value + 1 <= 0)
812 croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
814 value = length + value + 1 ;
825 ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv)
827 ParseOpenInfo(isHASH, name, flags, mode, sv)
836 #ifdef BERKELEY_DB_1_OR_2 /* Berkeley DB Version 1 or 2 */
840 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
841 void * openinfo = NULL ;
842 INFO * info = &RETVAL->info ;
845 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
846 Zero(RETVAL, 1, DB_File_type) ;
848 /* Default to HASH */
850 RETVAL->filtering = 0 ;
851 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
852 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
853 #endif /* DBM_FILTERING */
854 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
855 RETVAL->type = DB_HASH ;
857 /* DGH - Next line added to avoid SEGV on existing hash DB */
860 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
861 RETVAL->in_memory = (name == NULL) ;
866 croak ("type parameter is not a reference") ;
868 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
869 if (svp && SvOK(*svp))
870 action = (HV*) SvRV(*svp) ;
872 croak("internal error") ;
874 if (sv_isa(sv, "DB_File::HASHINFO"))
878 croak("DB_File can only tie an associative array to a DB_HASH database") ;
880 RETVAL->type = DB_HASH ;
881 openinfo = (void*)info ;
883 svp = hv_fetch(action, "hash", 4, FALSE);
885 if (svp && SvOK(*svp))
887 info->db_HA_hash = hash_cb ;
888 RETVAL->hash = newSVsv(*svp) ;
891 info->db_HA_hash = NULL ;
893 svp = hv_fetch(action, "ffactor", 7, FALSE);
894 info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
896 svp = hv_fetch(action, "nelem", 5, FALSE);
897 info->db_HA_nelem = svp ? SvIV(*svp) : 0;
899 svp = hv_fetch(action, "bsize", 5, FALSE);
900 info->db_HA_bsize = svp ? SvIV(*svp) : 0;
902 svp = hv_fetch(action, "cachesize", 9, FALSE);
903 info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
905 svp = hv_fetch(action, "lorder", 6, FALSE);
906 info->db_HA_lorder = svp ? SvIV(*svp) : 0;
910 else if (sv_isa(sv, "DB_File::BTREEINFO"))
913 croak("DB_File can only tie an associative array to a DB_BTREE database");
915 RETVAL->type = DB_BTREE ;
916 openinfo = (void*)info ;
918 svp = hv_fetch(action, "compare", 7, FALSE);
919 if (svp && SvOK(*svp))
921 info->db_BT_compare = btree_compare ;
922 RETVAL->compare = newSVsv(*svp) ;
925 info->db_BT_compare = NULL ;
927 svp = hv_fetch(action, "prefix", 6, FALSE);
928 if (svp && SvOK(*svp))
930 info->db_BT_prefix = btree_prefix ;
931 RETVAL->prefix = newSVsv(*svp) ;
934 info->db_BT_prefix = NULL ;
936 svp = hv_fetch(action, "flags", 5, FALSE);
937 info->db_BT_flags = svp ? SvIV(*svp) : 0;
939 svp = hv_fetch(action, "cachesize", 9, FALSE);
940 info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
942 #ifndef DB_VERSION_MAJOR
943 svp = hv_fetch(action, "minkeypage", 10, FALSE);
944 info->btree.minkeypage = svp ? SvIV(*svp) : 0;
946 svp = hv_fetch(action, "maxkeypage", 10, FALSE);
947 info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
950 svp = hv_fetch(action, "psize", 5, FALSE);
951 info->db_BT_psize = svp ? SvIV(*svp) : 0;
953 svp = hv_fetch(action, "lorder", 6, FALSE);
954 info->db_BT_lorder = svp ? SvIV(*svp) : 0;
959 else if (sv_isa(sv, "DB_File::RECNOINFO"))
962 croak("DB_File can only tie an array to a DB_RECNO database");
964 RETVAL->type = DB_RECNO ;
965 openinfo = (void *)info ;
967 info->db_RE_flags = 0 ;
969 svp = hv_fetch(action, "flags", 5, FALSE);
970 info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
972 svp = hv_fetch(action, "reclen", 6, FALSE);
973 info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
975 svp = hv_fetch(action, "cachesize", 9, FALSE);
976 info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
978 svp = hv_fetch(action, "psize", 5, FALSE);
979 info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
981 svp = hv_fetch(action, "lorder", 6, FALSE);
982 info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
984 #ifdef DB_VERSION_MAJOR
985 info->re_source = name ;
988 svp = hv_fetch(action, "bfname", 6, FALSE);
989 if (svp && SvOK(*svp)) {
990 char * ptr = SvPV(*svp,n_a) ;
991 #ifdef DB_VERSION_MAJOR
992 name = (char*) n_a ? ptr : NULL ;
994 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
998 #ifdef DB_VERSION_MAJOR
1001 info->db_RE_bfname = NULL ;
1004 svp = hv_fetch(action, "bval", 4, FALSE);
1005 #ifdef DB_VERSION_MAJOR
1006 if (svp && SvOK(*svp))
1010 value = (int)*SvPV(*svp, n_a) ;
1012 value = SvIV(*svp) ;
1014 if (info->flags & DB_FIXEDLEN) {
1015 info->re_pad = value ;
1016 info->flags |= DB_PAD ;
1019 info->re_delim = value ;
1020 info->flags |= DB_DELIMITER ;
1025 if (svp && SvOK(*svp))
1028 info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
1030 info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
1031 DB_flags(info->flags, DB_DELIMITER) ;
1036 if (info->db_RE_flags & R_FIXEDLEN)
1037 info->db_RE_bval = (u_char) ' ' ;
1039 info->db_RE_bval = (u_char) '\n' ;
1040 DB_flags(info->flags, DB_DELIMITER) ;
1045 info->flags |= DB_RENUMBER ;
1051 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1055 /* OS2 Specific Code */
1059 #endif /* __EMX__ */
1062 #ifdef DB_VERSION_MAJOR
1068 /* Map 1.x flags to 2.x flags */
1069 if ((flags & O_CREAT) == O_CREAT)
1070 Flags |= DB_CREATE ;
1073 if (flags == O_RDONLY)
1075 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1077 Flags |= DB_RDONLY ;
1080 if ((flags & O_TRUNC) == O_TRUNC)
1081 Flags |= DB_TRUNCATE ;
1084 status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
1086 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
1087 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
1089 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1094 RETVAL->dbp = NULL ;
1099 #if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2
1100 RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ;
1102 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
1103 #endif /* DB_LIBRARY_COMPATIBILITY_API */
1109 #else /* Berkeley DB Version > 2 */
1113 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
1118 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
1119 Zero(RETVAL, 1, DB_File_type) ;
1121 /* Default to HASH */
1122 #ifdef DBM_FILTERING
1123 RETVAL->filtering = 0 ;
1124 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
1125 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
1126 #endif /* DBM_FILTERING */
1127 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
1128 RETVAL->type = DB_HASH ;
1130 /* DGH - Next line added to avoid SEGV on existing hash DB */
1133 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
1134 RETVAL->in_memory = (name == NULL) ;
1136 status = db_create(&RETVAL->dbp, NULL,0) ;
1137 /* printf("db_create returned %d %s\n", status, db_strerror(status)) ; */
1139 RETVAL->dbp = NULL ;
1147 croak ("type parameter is not a reference") ;
1149 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
1150 if (svp && SvOK(*svp))
1151 action = (HV*) SvRV(*svp) ;
1153 croak("internal error") ;
1155 if (sv_isa(sv, "DB_File::HASHINFO"))
1159 croak("DB_File can only tie an associative array to a DB_HASH database") ;
1161 RETVAL->type = DB_HASH ;
1163 svp = hv_fetch(action, "hash", 4, FALSE);
1165 if (svp && SvOK(*svp))
1167 (void)dbp->set_h_hash(dbp, hash_cb) ;
1168 RETVAL->hash = newSVsv(*svp) ;
1171 svp = hv_fetch(action, "ffactor", 7, FALSE);
1173 (void)dbp->set_h_ffactor(dbp, SvIV(*svp)) ;
1175 svp = hv_fetch(action, "nelem", 5, FALSE);
1177 (void)dbp->set_h_nelem(dbp, SvIV(*svp)) ;
1179 svp = hv_fetch(action, "bsize", 5, FALSE);
1181 (void)dbp->set_pagesize(dbp, SvIV(*svp));
1183 svp = hv_fetch(action, "cachesize", 9, FALSE);
1185 (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1187 svp = hv_fetch(action, "lorder", 6, FALSE);
1189 (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
1193 else if (sv_isa(sv, "DB_File::BTREEINFO"))
1196 croak("DB_File can only tie an associative array to a DB_BTREE database");
1198 RETVAL->type = DB_BTREE ;
1200 svp = hv_fetch(action, "compare", 7, FALSE);
1201 if (svp && SvOK(*svp))
1203 (void)dbp->set_bt_compare(dbp, btree_compare) ;
1204 RETVAL->compare = newSVsv(*svp) ;
1207 svp = hv_fetch(action, "prefix", 6, FALSE);
1208 if (svp && SvOK(*svp))
1210 (void)dbp->set_bt_prefix(dbp, btree_prefix) ;
1211 RETVAL->prefix = newSVsv(*svp) ;
1214 svp = hv_fetch(action, "flags", 5, FALSE);
1216 (void)dbp->set_flags(dbp, SvIV(*svp)) ;
1218 svp = hv_fetch(action, "cachesize", 9, FALSE);
1220 (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1222 svp = hv_fetch(action, "psize", 5, FALSE);
1224 (void)dbp->set_pagesize(dbp, SvIV(*svp)) ;
1226 svp = hv_fetch(action, "lorder", 6, FALSE);
1228 (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
1233 else if (sv_isa(sv, "DB_File::RECNOINFO"))
1238 croak("DB_File can only tie an array to a DB_RECNO database");
1240 RETVAL->type = DB_RECNO ;
1242 svp = hv_fetch(action, "flags", 5, FALSE);
1244 int flags = SvIV(*svp) ;
1245 /* remove FIXDLEN, if present */
1246 if (flags & DB_FIXEDLEN) {
1248 flags &= ~DB_FIXEDLEN ;
1252 svp = hv_fetch(action, "cachesize", 9, FALSE);
1254 status = dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1257 svp = hv_fetch(action, "psize", 5, FALSE);
1259 status = dbp->set_pagesize(dbp, SvIV(*svp)) ;
1262 svp = hv_fetch(action, "lorder", 6, FALSE);
1264 status = dbp->set_lorder(dbp, SvIV(*svp)) ;
1267 svp = hv_fetch(action, "bval", 4, FALSE);
1268 if (svp && SvOK(*svp))
1272 value = (int)*SvPV(*svp, n_a) ;
1274 value = SvIV(*svp) ;
1277 status = dbp->set_re_pad(dbp, value) ;
1280 status = dbp->set_re_delim(dbp, value) ;
1286 svp = hv_fetch(action, "reclen", 6, FALSE);
1288 u_int32_t len = (u_int32_t)SvIV(*svp) ;
1289 status = dbp->set_re_len(dbp, len) ;
1294 status = dbp->set_re_source(dbp, name) ;
1298 svp = hv_fetch(action, "bfname", 6, FALSE);
1299 if (svp && SvOK(*svp)) {
1300 char * ptr = SvPV(*svp,n_a) ;
1301 name = (char*) n_a ? ptr : NULL ;
1307 status = dbp->set_flags(dbp, DB_RENUMBER) ;
1310 (void)dbp->set_flags(dbp, flags) ;
1315 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1322 /* Map 1.x flags to 3.x flags */
1323 if ((flags & O_CREAT) == O_CREAT)
1324 Flags |= DB_CREATE ;
1327 if (flags == O_RDONLY)
1329 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1331 Flags |= DB_RDONLY ;
1334 if ((flags & O_TRUNC) == O_TRUNC)
1335 Flags |= DB_TRUNCATE ;
1338 status = (RETVAL->dbp->open)(RETVAL->dbp, name, NULL, RETVAL->type,
1340 /* printf("open returned %d %s\n", status, db_strerror(status)) ; */
1343 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1345 /* printf("cursor returned %d %s\n", status, db_strerror(status)) ; */
1348 RETVAL->dbp = NULL ;
1354 #endif /* Berkeley DB Version > 2 */
1356 } /* ParseOpenInfo */
1360 #ifdef CAN_PROTOTYPE
1361 constant(char *name, int arg)
1373 if (strEQ(name, "BTREEMAGIC"))
1379 if (strEQ(name, "BTREEVERSION"))
1381 return BTREEVERSION;
1389 if (strEQ(name, "DB_LOCK"))
1395 if (strEQ(name, "DB_SHMEM"))
1401 if (strEQ(name, "DB_TXN"))
1415 if (strEQ(name, "HASHMAGIC"))
1421 if (strEQ(name, "HASHVERSION"))
1437 if (strEQ(name, "MAX_PAGE_NUMBER"))
1438 #ifdef MAX_PAGE_NUMBER
1439 return (U32)MAX_PAGE_NUMBER;
1443 if (strEQ(name, "MAX_PAGE_OFFSET"))
1444 #ifdef MAX_PAGE_OFFSET
1445 return MAX_PAGE_OFFSET;
1449 if (strEQ(name, "MAX_REC_NUMBER"))
1450 #ifdef MAX_REC_NUMBER
1451 return (U32)MAX_REC_NUMBER;
1465 if (strEQ(name, "RET_ERROR"))
1471 if (strEQ(name, "RET_SPECIAL"))
1477 if (strEQ(name, "RET_SUCCESS"))
1483 if (strEQ(name, "R_CURSOR"))
1489 if (strEQ(name, "R_DUP"))
1495 if (strEQ(name, "R_FIRST"))
1501 if (strEQ(name, "R_FIXEDLEN"))
1507 if (strEQ(name, "R_IAFTER"))
1513 if (strEQ(name, "R_IBEFORE"))
1519 if (strEQ(name, "R_LAST"))
1525 if (strEQ(name, "R_NEXT"))
1531 if (strEQ(name, "R_NOKEY"))
1537 if (strEQ(name, "R_NOOVERWRITE"))
1538 #ifdef R_NOOVERWRITE
1539 return R_NOOVERWRITE;
1543 if (strEQ(name, "R_PREV"))
1549 if (strEQ(name, "R_RECNOSYNC"))
1555 if (strEQ(name, "R_SETCURSOR"))
1561 if (strEQ(name, "R_SNAPSHOT"))
1595 MODULE = DB_File PACKAGE = DB_File PREFIX = db_
1599 __getBerkeleyDBInfo() ;
1602 empty.data = &zero ;
1603 empty.size = sizeof(recno_t) ;
1613 db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
1620 char * name = (char *) NULL ;
1621 SV * sv = (SV *) NULL ;
1624 if (items >= 3 && SvOK(ST(2)))
1625 name = (char*) SvPV(ST(2), n_a) ;
1630 RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
1631 if (RETVAL->dbp == NULL)
1644 SvREFCNT_dec(db->hash) ;
1646 SvREFCNT_dec(db->compare) ;
1648 SvREFCNT_dec(db->prefix) ;
1649 #ifdef DBM_FILTERING
1650 if (db->filter_fetch_key)
1651 SvREFCNT_dec(db->filter_fetch_key) ;
1652 if (db->filter_store_key)
1653 SvREFCNT_dec(db->filter_store_key) ;
1654 if (db->filter_fetch_value)
1655 SvREFCNT_dec(db->filter_fetch_value) ;
1656 if (db->filter_store_value)
1657 SvREFCNT_dec(db->filter_store_value) ;
1658 #endif /* DBM_FILTERING */
1660 #ifdef DB_VERSION_MAJOR
1667 db_DELETE(db, key, flags=0)
1685 RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
1691 db_FETCH(db, key, flags=0)
1701 /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */
1702 RETVAL = db_get(db, key, value, flags) ;
1703 ST(0) = sv_newmortal();
1704 OutputValue(ST(0), value)
1708 db_STORE(db, key, value, flags=0)
1728 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1729 ST(0) = sv_newmortal();
1730 OutputKey(ST(0), key) ;
1743 RETVAL = do_SEQ(db, key, value, R_NEXT) ;
1744 ST(0) = sv_newmortal();
1745 OutputKey(ST(0), key) ;
1749 # These would be nice for RECNO
1768 #ifdef DB_VERSION_MAJOR
1769 /* get the first value */
1770 RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1775 for (i = items-1 ; i > 0 ; --i)
1777 value.data = SvPV(ST(i), n_a) ;
1781 key.size = sizeof(int) ;
1782 #ifdef DB_VERSION_MAJOR
1783 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1785 RETVAL = (Db->put)(Db, &key, &value, R_IBEFORE) ;
1807 /* First get the final value */
1808 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1809 ST(0) = sv_newmortal();
1813 /* the call to del will trash value, so take a copy now */
1814 OutputValue(ST(0), value) ;
1815 RETVAL = db_del(db, key, R_CURSOR) ;
1817 sv_setsv(ST(0), &PL_sv_undef);
1833 /* get the first value */
1834 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1835 ST(0) = sv_newmortal();
1839 /* the call to del will trash value, so take a copy now */
1840 OutputValue(ST(0), value) ;
1841 RETVAL = db_del(db, key, R_CURSOR) ;
1843 sv_setsv (ST(0), &PL_sv_undef) ;
1864 /* Set the Cursor to the Last element */
1865 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1866 #ifndef DB_VERSION_MAJOR
1871 keyval = *(int*)key.data ;
1874 for (i = 1 ; i < items ; ++i)
1876 value.data = SvPV(ST(i), n_a) ;
1879 key.data = &keyval ;
1880 key.size = sizeof(int) ;
1881 RETVAL = (Db->put)(Db, TXN &key, &value, 0) ;
1893 ALIAS: FETCHSIZE = 1
1896 RETVAL = GetArrayLength(aTHX_ db) ;
1902 # Now provide an interface to the rest of the DB functionality
1906 db_del(db, key, flags=0)
1912 RETVAL = db_del(db, key, flags) ;
1913 #ifdef DB_VERSION_MAJOR
1916 else if (RETVAL == DB_NOTFOUND)
1924 db_get(db, key, value, flags=0)
1932 RETVAL = db_get(db, key, value, flags) ;
1933 #ifdef DB_VERSION_MAJOR
1936 else if (RETVAL == DB_NOTFOUND)
1944 db_put(db, key, value, flags=0)
1951 RETVAL = db_put(db, key, value, flags) ;
1952 #ifdef DB_VERSION_MAJOR
1955 else if (RETVAL == DB_KEYEXIST)
1960 key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
1968 #ifdef DB_VERSION_MAJOR
1970 status = (db->in_memory
1972 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
1976 RETVAL = (db->in_memory
1978 : ((db->dbp)->fd)(db->dbp) ) ;
1984 db_sync(db, flags=0)
1989 RETVAL = db_sync(db, flags) ;
1990 #ifdef DB_VERSION_MAJOR
1999 db_seq(db, key, value, flags)
2007 RETVAL = db_seq(db, key, value, flags);
2008 #ifdef DB_VERSION_MAJOR
2011 else if (RETVAL == DB_NOTFOUND)
2019 #ifdef DBM_FILTERING
2021 #define setFilter(type) \
2024 RETVAL = sv_mortalcopy(db->type) ; \
2026 if (db->type && (code == &PL_sv_undef)) { \
2027 SvREFCNT_dec(db->type) ; \
2032 sv_setsv(db->type, code) ; \
2034 db->type = newSVsv(code) ; \
2040 filter_fetch_key(db, code)
2043 SV * RETVAL = &PL_sv_undef ;
2045 setFilter(filter_fetch_key) ;
2048 filter_store_key(db, code)
2051 SV * RETVAL = &PL_sv_undef ;
2053 setFilter(filter_store_key) ;
2056 filter_fetch_value(db, code)
2059 SV * RETVAL = &PL_sv_undef ;
2061 setFilter(filter_fetch_value) ;
2064 filter_store_value(db, code)
2067 SV * RETVAL = &PL_sv_undef ;
2069 setFilter(filter_store_value) ;
2071 #endif /* DBM_FILTERING */