3 DB_File.xs -- Perl 5 interface to Berkeley DB
5 written by Paul Marquess <Paul.Marquess@btinternet.com>
6 last modified 6th March 1999
9 All comments/suggestions/problems are welcome
11 Copyright (c) 1995-9 Paul Marquess. All rights reserved.
12 This program is free software; you can redistribute it and/or
13 modify it under the same terms as Perl itself.
17 0.2 - No longer bombs out if dbopen returns an error.
18 0.3 - Added some support for multiple btree compares
19 1.0 - Complete support for multiple callbacks added.
20 Fixed a problem with pushing a value onto an empty list.
21 1.01 - Fixed a SunOS core dump problem.
22 The return value from TIEHASH wasn't set to NULL when
23 dbopen returned an error.
24 1.02 - Use ALIAS to define TIEARRAY.
25 Removed some redundant commented code.
26 Merged OS2 code into the main distribution.
27 Allow negative subscripts with RECNO interface.
28 Changed the default flags to O_CREAT|O_RDWR
30 1.04 - fixed a couple of bugs in hash_cb. Patches supplied by
31 Dave Hammen, hammen@gothamcity.jsc.nasa.gov
32 1.05 - Added logic to allow prefix & hash types to be specified via
34 1.06 - Minor namespace cleanup: Localized PrintBtree.
35 1.07 - Fixed bug with RECNO, where bval wasn't defaulting to "\n".
36 1.08 - No change to DB_File.xs
37 1.09 - Default mode for dbopen changed to 0666
38 1.10 - Fixed fd method so that it still returns -1 for
39 in-memory files when db 1.86 is used.
40 1.11 - No change to DB_File.xs
41 1.12 - No change to DB_File.xs
42 1.13 - Tidied up a few casts.
43 1.14 - Made it illegal to tie an associative array to a RECNO
44 database and an ordinary array to a HASH or BTREE database.
45 1.50 - Make work with both DB 1.x or DB 2.x
46 1.51 - Fixed a bug in mapping 1.x O_RDONLY flag to 2.x DB_RDONLY equivalent
47 1.52 - Patch from Gisle Aas <gisle@aas.no> to suppress "use of
48 undefined value" warning with db_get and db_seq.
49 1.53 - Added DB_RENUMBER to flags for recno.
50 1.54 - Fixed bug in the fd method
51 1.55 - Fix for AIX from Jarkko Hietaniemi
52 1.56 - No change to DB_File.xs
53 1.57 - added the #undef op to allow building with Threads support.
54 1.58 - Fixed a problem with the use of sv_setpvn. When the
55 size is specified as 0, it does a strlen on the data.
56 This was ok for DB 1.x, but isn't for DB 2.x.
57 1.59 - No change to DB_File.xs
58 1.60 - Some code tidy up
59 1.61 - added flagSet macro for DB 2.5.x
60 fixed typo in O_RDONLY test.
61 1.62 - No change to DB_File.xs
62 1.63 - Fix to alllow DB 2.6.x to build.
63 1.64 - Tidied up the 1.x to 2.x flags mapping code.
64 Added a patch from Mark Kettenis <kettenis@wins.uva.nl>
65 to fix a flag mapping problem with O_RDONLY on the Hurd
66 1.65 - Fixed a bug in the PUSH logic.
67 Added BOOT check that using 2.3.4 or greater
68 1.66 - Added DBM filter code
79 #include "patchlevel.h"
80 #define PERL_REVISION 5
81 #define PERL_VERSION PATCHLEVEL
82 #define PERL_SUBVERSION SUBVERSION
85 #if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 ))
87 # define PL_sv_undef sv_undef
92 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
93 * shortly #included by the <db.h>) __attribute__ to the possibly
94 * already defined __attribute__, for example by GNUC or by Perl. */
98 /* If Perl has been compiled with Threads support,the symbol op will
99 be defined here. This clashes with a field name in db.h, so get rid of it.
109 #define DBM_FILTERING
113 #ifdef DB_VERSION_MAJOR
115 /* map version 2 features & constants onto their version 1 equivalent */
120 #define DB_Prefix_t size_t
125 #define DB_Hash_t u_int32_t
127 /* DBTYPE stays the same */
128 /* HASHINFO, RECNOINFO and BTREEINFO map to DB_INFO */
129 typedef DB_INFO INFO ;
131 /* version 2 has db_recno_t in place of recno_t */
132 typedef db_recno_t recno_t;
135 #define R_CURSOR DB_SET_RANGE
136 #define R_FIRST DB_FIRST
137 #define R_IAFTER DB_AFTER
138 #define R_IBEFORE DB_BEFORE
139 #define R_LAST DB_LAST
140 #define R_NEXT DB_NEXT
141 #define R_NOOVERWRITE DB_NOOVERWRITE
142 #define R_PREV DB_PREV
143 #define R_SETCURSOR 0
144 #define R_RECNOSYNC 0
145 #define R_FIXEDLEN DB_FIXEDLEN
148 #define db_HA_hash h_hash
149 #define db_HA_ffactor h_ffactor
150 #define db_HA_nelem h_nelem
151 #define db_HA_bsize db_pagesize
152 #define db_HA_cachesize db_cachesize
153 #define db_HA_lorder db_lorder
155 #define db_BT_compare bt_compare
156 #define db_BT_prefix bt_prefix
157 #define db_BT_flags flags
158 #define db_BT_psize db_pagesize
159 #define db_BT_cachesize db_cachesize
160 #define db_BT_lorder db_lorder
161 #define db_BT_maxkeypage
162 #define db_BT_minkeypage
165 #define db_RE_reclen re_len
166 #define db_RE_flags flags
167 #define db_RE_bval re_pad
168 #define db_RE_bfname re_source
169 #define db_RE_psize db_pagesize
170 #define db_RE_cachesize db_cachesize
171 #define db_RE_lorder db_lorder
175 #define do_SEQ(db, key, value, flag) (db->cursor->c_get)(db->cursor, &key, &value, flag)
178 #define DBT_flags(x) x.flags = 0
179 #define DB_flags(x, v) x |= v
181 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
182 #define flagSet(flags, bitmask) ((flags) & (bitmask))
184 #define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask))
187 #else /* db version 1.x */
200 #define DB_Prefix_t mDB_Prefix_t
207 #define DB_Hash_t mDB_Hash_t
210 #define db_HA_hash hash.hash
211 #define db_HA_ffactor hash.ffactor
212 #define db_HA_nelem hash.nelem
213 #define db_HA_bsize hash.bsize
214 #define db_HA_cachesize hash.cachesize
215 #define db_HA_lorder hash.lorder
217 #define db_BT_compare btree.compare
218 #define db_BT_prefix btree.prefix
219 #define db_BT_flags btree.flags
220 #define db_BT_psize btree.psize
221 #define db_BT_cachesize btree.cachesize
222 #define db_BT_lorder btree.lorder
223 #define db_BT_maxkeypage btree.maxkeypage
224 #define db_BT_minkeypage btree.minkeypage
226 #define db_RE_reclen recno.reclen
227 #define db_RE_flags recno.flags
228 #define db_RE_bval recno.bval
229 #define db_RE_bfname recno.bfname
230 #define db_RE_psize recno.psize
231 #define db_RE_cachesize recno.cachesize
232 #define db_RE_lorder recno.lorder
236 #define do_SEQ(db, key, value, flag) (db->dbp->seq)(db->dbp, &key, &value, flag)
238 #define DB_flags(x, v)
239 #define flagSet(flags, bitmask) ((flags) & (bitmask))
241 #endif /* db version 1 */
245 #define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, TXN &key, flags)
246 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, flags)
247 #define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
249 #define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
250 #define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
252 #ifdef DB_VERSION_MAJOR
253 #define db_DESTROY(db) ((db->dbp)->close)(db->dbp, 0)
254 #define db_close(db) ((db->dbp)->close)(db->dbp, 0)
255 #define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \
256 ? ((db->cursor)->c_del)(db->cursor, 0) \
257 : ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
261 #define db_DESTROY(db) ((db->dbp)->close)(db->dbp)
262 #define db_close(db) ((db->dbp)->close)(db->dbp)
263 #define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
264 #define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
269 #define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags)
279 #ifdef DB_VERSION_MAJOR
283 SV * filter_fetch_key ;
284 SV * filter_store_key ;
285 SV * filter_fetch_value ;
286 SV * filter_store_value ;
288 #endif /* DBM_FILTERING */
292 typedef DB_File_type * DB_File ;
297 #define ckFilter(arg,type,name) \
300 /* printf("filtering %s\n", name) ;*/ \
302 croak("recursion detected in %s", name) ; \
303 db->filtering = TRUE ; \
304 /* SAVE_DEFSV ;*/ /* save $_ */ \
305 save_defsv = newSVsv(DEFSV) ; \
306 sv_setsv(DEFSV, arg) ; \
308 (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \
310 sv_setsv(arg, DEFSV) ; \
311 sv_setsv(DEFSV, save_defsv) ; \
312 SvREFCNT_dec(save_defsv) ; \
314 db->filtering = FALSE ; \
315 /*printf("end of filtering %s\n", name) ;*/ \
320 #define ckFilter(arg,type, name)
322 #endif /* DBM_FILTERING */
324 #define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
326 #define OutputValue(arg, name) \
327 { if (RETVAL == 0) { \
328 my_sv_setpvn(arg, name.data, name.size) ; \
329 ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \
333 #define OutputKey(arg, name) \
336 if (db->type != DB_RECNO) { \
337 my_sv_setpvn(arg, name.data, name.size); \
340 sv_setiv(arg, (I32)*(I32*)name.data - 1); \
341 ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \
346 /* Internal Global Data */
347 static recno_t Value ;
348 static recno_t zero = 0 ;
349 static DB_File CurrentDB ;
350 static DBTKEY empty ;
352 #ifdef DB_VERSION_MAJOR
355 db_put(DB_File db, DBTKEY key, DBT value, u_int flags)
359 if (flagSet(flags, R_CURSOR)) {
360 status = ((db->cursor)->c_del)(db->cursor, 0);
364 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
367 flags &= ~DB_OPFLAGS_MASK ;
372 return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
376 #endif /* DB_VERSION_MAJOR */
381 SV * ver_sv = perl_get_sv("DB_File::db_version", TRUE) ;
382 #ifdef DB_VERSION_MAJOR
383 int Major, Minor, Patch ;
385 (void)db_version(&Major, &Minor, &Patch) ;
387 /* check that libdb is recent enough -- we need 2.3.4 or greater */
388 if (Major == 2 && (Minor < 3 || (Minor == 3 && Patch < 4)))
389 croak("DB_File needs Berkeley DB 2.3.4 or greater, you have %d.%d.%d\n",
390 Major, Minor, Patch) ;
393 sv_setpvf(ver_sv, "%d.%d", Major, Minor) ;
397 sprintf(buffer, "%d.%d", Major, Minor) ;
398 sv_setpv(ver_sv, buffer) ;
403 sv_setiv(ver_sv, 1) ;
410 btree_compare(const DBT *key1, const DBT *key2)
414 void * data1, * data2 ;
421 /* As newSVpv will assume that the data pointer is a null terminated C
422 string if the size parameter is 0, make sure that data points to an
423 empty string if the length is 0
435 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
436 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
439 count = perl_call_sv(CurrentDB->compare, G_SCALAR);
444 croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
456 btree_prefix(const DBT *key1, const DBT *key2)
460 void * data1, * data2 ;
467 /* As newSVpv will assume that the data pointer is a null terminated C
468 string if the size parameter is 0, make sure that data points to an
469 empty string if the length is 0
481 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
482 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
485 count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
490 croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
502 hash_cb(const void *data, size_t size)
512 /* DGH - Next two lines added to fix corrupted stack problem */
518 XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
521 count = perl_call_sv(CurrentDB->hash, G_SCALAR);
526 croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
541 PrintHash(INFO *hash)
543 printf ("HASH Info\n") ;
544 printf (" hash = %s\n",
545 (hash->db_HA_hash != NULL ? "redefined" : "default")) ;
546 printf (" bsize = %d\n", hash->db_HA_bsize) ;
547 printf (" ffactor = %d\n", hash->db_HA_ffactor) ;
548 printf (" nelem = %d\n", hash->db_HA_nelem) ;
549 printf (" cachesize = %d\n", hash->db_HA_cachesize) ;
550 printf (" lorder = %d\n", hash->db_HA_lorder) ;
555 PrintRecno(INFO *recno)
557 printf ("RECNO Info\n") ;
558 printf (" flags = %d\n", recno->db_RE_flags) ;
559 printf (" cachesize = %d\n", recno->db_RE_cachesize) ;
560 printf (" psize = %d\n", recno->db_RE_psize) ;
561 printf (" lorder = %d\n", recno->db_RE_lorder) ;
562 printf (" reclen = %ul\n", (unsigned long)recno->db_RE_reclen) ;
563 printf (" bval = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
564 printf (" bfname = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
568 PrintBtree(INFO *btree)
570 printf ("BTREE Info\n") ;
571 printf (" compare = %s\n",
572 (btree->db_BT_compare ? "redefined" : "default")) ;
573 printf (" prefix = %s\n",
574 (btree->db_BT_prefix ? "redefined" : "default")) ;
575 printf (" flags = %d\n", btree->db_BT_flags) ;
576 printf (" cachesize = %d\n", btree->db_BT_cachesize) ;
577 printf (" psize = %d\n", btree->db_BT_psize) ;
578 #ifndef DB_VERSION_MAJOR
579 printf (" maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
580 printf (" minkeypage = %d\n", btree->db_BT_minkeypage) ;
582 printf (" lorder = %d\n", btree->db_BT_lorder) ;
587 #define PrintRecno(recno)
588 #define PrintHash(hash)
589 #define PrintBtree(btree)
595 GetArrayLength(pTHX_ DB_File db)
603 RETVAL = do_SEQ(db, key, value, R_LAST) ;
605 RETVAL = *(I32 *)key.data ;
606 else /* No key means empty file */
609 return ((I32)RETVAL) ;
613 GetRecnoKey(pTHX_ DB_File db, I32 value)
616 /* Get the length of the array */
617 I32 length = GetArrayLength(aTHX_ db) ;
619 /* check for attempt to write before start of array */
620 if (length + value + 1 <= 0)
621 croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
623 value = length + value + 1 ;
632 ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv)
636 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
637 void * openinfo = NULL ;
638 INFO * info = &RETVAL->info ;
641 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
642 Zero(RETVAL, 1, DB_File_type) ;
644 /* Default to HASH */
646 RETVAL->filtering = 0 ;
647 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
648 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
649 #endif /* DBM_FILTERING */
650 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
651 RETVAL->type = DB_HASH ;
653 /* DGH - Next line added to avoid SEGV on existing hash DB */
656 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
657 RETVAL->in_memory = (name == NULL) ;
662 croak ("type parameter is not a reference") ;
664 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
665 if (svp && SvOK(*svp))
666 action = (HV*) SvRV(*svp) ;
668 croak("internal error") ;
670 if (sv_isa(sv, "DB_File::HASHINFO"))
674 croak("DB_File can only tie an associative array to a DB_HASH database") ;
676 RETVAL->type = DB_HASH ;
677 openinfo = (void*)info ;
679 svp = hv_fetch(action, "hash", 4, FALSE);
681 if (svp && SvOK(*svp))
683 info->db_HA_hash = hash_cb ;
684 RETVAL->hash = newSVsv(*svp) ;
687 info->db_HA_hash = NULL ;
689 svp = hv_fetch(action, "ffactor", 7, FALSE);
690 info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
692 svp = hv_fetch(action, "nelem", 5, FALSE);
693 info->db_HA_nelem = svp ? SvIV(*svp) : 0;
695 svp = hv_fetch(action, "bsize", 5, FALSE);
696 info->db_HA_bsize = svp ? SvIV(*svp) : 0;
698 svp = hv_fetch(action, "cachesize", 9, FALSE);
699 info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
701 svp = hv_fetch(action, "lorder", 6, FALSE);
702 info->db_HA_lorder = svp ? SvIV(*svp) : 0;
706 else if (sv_isa(sv, "DB_File::BTREEINFO"))
709 croak("DB_File can only tie an associative array to a DB_BTREE database");
711 RETVAL->type = DB_BTREE ;
712 openinfo = (void*)info ;
714 svp = hv_fetch(action, "compare", 7, FALSE);
715 if (svp && SvOK(*svp))
717 info->db_BT_compare = btree_compare ;
718 RETVAL->compare = newSVsv(*svp) ;
721 info->db_BT_compare = NULL ;
723 svp = hv_fetch(action, "prefix", 6, FALSE);
724 if (svp && SvOK(*svp))
726 info->db_BT_prefix = btree_prefix ;
727 RETVAL->prefix = newSVsv(*svp) ;
730 info->db_BT_prefix = NULL ;
732 svp = hv_fetch(action, "flags", 5, FALSE);
733 info->db_BT_flags = svp ? SvIV(*svp) : 0;
735 svp = hv_fetch(action, "cachesize", 9, FALSE);
736 info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
738 #ifndef DB_VERSION_MAJOR
739 svp = hv_fetch(action, "minkeypage", 10, FALSE);
740 info->btree.minkeypage = svp ? SvIV(*svp) : 0;
742 svp = hv_fetch(action, "maxkeypage", 10, FALSE);
743 info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
746 svp = hv_fetch(action, "psize", 5, FALSE);
747 info->db_BT_psize = svp ? SvIV(*svp) : 0;
749 svp = hv_fetch(action, "lorder", 6, FALSE);
750 info->db_BT_lorder = svp ? SvIV(*svp) : 0;
755 else if (sv_isa(sv, "DB_File::RECNOINFO"))
758 croak("DB_File can only tie an array to a DB_RECNO database");
760 RETVAL->type = DB_RECNO ;
761 openinfo = (void *)info ;
763 info->db_RE_flags = 0 ;
765 svp = hv_fetch(action, "flags", 5, FALSE);
766 info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
768 svp = hv_fetch(action, "reclen", 6, FALSE);
769 info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
771 svp = hv_fetch(action, "cachesize", 9, FALSE);
772 info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
774 svp = hv_fetch(action, "psize", 5, FALSE);
775 info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
777 svp = hv_fetch(action, "lorder", 6, FALSE);
778 info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
780 #ifdef DB_VERSION_MAJOR
781 info->re_source = name ;
784 svp = hv_fetch(action, "bfname", 6, FALSE);
785 if (svp && SvOK(*svp)) {
786 char * ptr = SvPV(*svp,n_a) ;
787 #ifdef DB_VERSION_MAJOR
788 name = (char*) n_a ? ptr : NULL ;
790 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
794 #ifdef DB_VERSION_MAJOR
797 info->db_RE_bfname = NULL ;
800 svp = hv_fetch(action, "bval", 4, FALSE);
801 #ifdef DB_VERSION_MAJOR
802 if (svp && SvOK(*svp))
806 value = (int)*SvPV(*svp, n_a) ;
810 if (info->flags & DB_FIXEDLEN) {
811 info->re_pad = value ;
812 info->flags |= DB_PAD ;
815 info->re_delim = value ;
816 info->flags |= DB_DELIMITER ;
821 if (svp && SvOK(*svp))
824 info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
826 info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
827 DB_flags(info->flags, DB_DELIMITER) ;
832 if (info->db_RE_flags & R_FIXEDLEN)
833 info->db_RE_bval = (u_char) ' ' ;
835 info->db_RE_bval = (u_char) '\n' ;
836 DB_flags(info->flags, DB_DELIMITER) ;
841 info->flags |= DB_RENUMBER ;
847 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
851 /* OS2 Specific Code */
858 #ifdef DB_VERSION_MAJOR
864 /* Map 1.x flags to 2.x flags */
865 if ((flags & O_CREAT) == O_CREAT)
869 if (flags == O_RDONLY)
871 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
876 if ((flags & O_TRUNC) == O_TRUNC)
877 Flags |= DB_TRUNCATE ;
880 status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
882 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
883 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
885 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
894 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
902 constant(char *name, int arg)
909 if (strEQ(name, "BTREEMAGIC"))
915 if (strEQ(name, "BTREEVERSION"))
925 if (strEQ(name, "DB_LOCK"))
931 if (strEQ(name, "DB_SHMEM"))
937 if (strEQ(name, "DB_TXN"))
951 if (strEQ(name, "HASHMAGIC"))
957 if (strEQ(name, "HASHVERSION"))
973 if (strEQ(name, "MAX_PAGE_NUMBER"))
974 #ifdef MAX_PAGE_NUMBER
975 return (U32)MAX_PAGE_NUMBER;
979 if (strEQ(name, "MAX_PAGE_OFFSET"))
980 #ifdef MAX_PAGE_OFFSET
981 return MAX_PAGE_OFFSET;
985 if (strEQ(name, "MAX_REC_NUMBER"))
986 #ifdef MAX_REC_NUMBER
987 return (U32)MAX_REC_NUMBER;
1001 if (strEQ(name, "RET_ERROR"))
1007 if (strEQ(name, "RET_SPECIAL"))
1013 if (strEQ(name, "RET_SUCCESS"))
1019 if (strEQ(name, "R_CURSOR"))
1025 if (strEQ(name, "R_DUP"))
1031 if (strEQ(name, "R_FIRST"))
1037 if (strEQ(name, "R_FIXEDLEN"))
1043 if (strEQ(name, "R_IAFTER"))
1049 if (strEQ(name, "R_IBEFORE"))
1055 if (strEQ(name, "R_LAST"))
1061 if (strEQ(name, "R_NEXT"))
1067 if (strEQ(name, "R_NOKEY"))
1073 if (strEQ(name, "R_NOOVERWRITE"))
1074 #ifdef R_NOOVERWRITE
1075 return R_NOOVERWRITE;
1079 if (strEQ(name, "R_PREV"))
1085 if (strEQ(name, "R_RECNOSYNC"))
1091 if (strEQ(name, "R_SETCURSOR"))
1097 if (strEQ(name, "R_SNAPSHOT"))
1131 MODULE = DB_File PACKAGE = DB_File PREFIX = db_
1135 GetVersionInfo(aTHX) ;
1137 empty.data = &zero ;
1138 empty.size = sizeof(recno_t) ;
1149 db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
1156 char * name = (char *) NULL ;
1157 SV * sv = (SV *) NULL ;
1160 if (items >= 3 && SvOK(ST(2)))
1161 name = (char*) SvPV(ST(2), n_a) ;
1166 RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
1167 if (RETVAL->dbp == NULL)
1180 SvREFCNT_dec(db->hash) ;
1182 SvREFCNT_dec(db->compare) ;
1184 SvREFCNT_dec(db->prefix) ;
1185 #ifdef DBM_FILTERING
1186 if (db->filter_fetch_key)
1187 SvREFCNT_dec(db->filter_fetch_key) ;
1188 if (db->filter_store_key)
1189 SvREFCNT_dec(db->filter_store_key) ;
1190 if (db->filter_fetch_value)
1191 SvREFCNT_dec(db->filter_fetch_value) ;
1192 if (db->filter_store_value)
1193 SvREFCNT_dec(db->filter_store_value) ;
1194 #endif /* DBM_FILTERING */
1196 #ifdef DB_VERSION_MAJOR
1203 db_DELETE(db, key, flags=0)
1221 RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
1227 db_FETCH(db, key, flags=0)
1237 /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */
1238 RETVAL = db_get(db, key, value, flags) ;
1239 ST(0) = sv_newmortal();
1240 OutputValue(ST(0), value)
1244 db_STORE(db, key, value, flags=0)
1264 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1265 ST(0) = sv_newmortal();
1266 OutputKey(ST(0), key) ;
1279 RETVAL = do_SEQ(db, key, value, R_NEXT) ;
1280 ST(0) = sv_newmortal();
1281 OutputKey(ST(0), key) ;
1285 # These would be nice for RECNO
1304 #ifdef DB_VERSION_MAJOR
1305 /* get the first value */
1306 RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1311 for (i = items-1 ; i > 0 ; --i)
1313 value.data = SvPV(ST(i), n_a) ;
1317 key.size = sizeof(int) ;
1318 #ifdef DB_VERSION_MAJOR
1319 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1321 RETVAL = (Db->put)(Db, &key, &value, R_IBEFORE) ;
1343 /* First get the final value */
1344 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1345 ST(0) = sv_newmortal();
1349 /* the call to del will trash value, so take a copy now */
1350 OutputValue(ST(0), value) ;
1351 RETVAL = db_del(db, key, R_CURSOR) ;
1353 sv_setsv(ST(0), &PL_sv_undef);
1369 /* get the first value */
1370 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1371 ST(0) = sv_newmortal();
1375 /* the call to del will trash value, so take a copy now */
1376 OutputValue(ST(0), value) ;
1377 RETVAL = db_del(db, key, R_CURSOR) ;
1379 sv_setsv (ST(0), &PL_sv_undef) ;
1399 #ifdef DB_VERSION_MAJOR
1402 for (i = 1 ; i < items ; ++i)
1404 value.data = SvPV(ST(i), n_a) ;
1406 RETVAL = (Db->put)(Db, NULL, &key, &value, DB_APPEND) ;
1412 /* Set the Cursor to the Last element */
1413 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1418 for (i = items - 1 ; i > 0 ; --i)
1420 value.data = SvPV(ST(i), n_a) ;
1422 RETVAL = (Db->put)(Db, &key, &value, R_IAFTER) ;
1436 ALIAS: FETCHSIZE = 1
1439 RETVAL = GetArrayLength(aTHX_ db) ;
1445 # Now provide an interface to the rest of the DB functionality
1449 db_del(db, key, flags=0)
1455 RETVAL = db_del(db, key, flags) ;
1456 #ifdef DB_VERSION_MAJOR
1459 else if (RETVAL == DB_NOTFOUND)
1467 db_get(db, key, value, flags=0)
1475 RETVAL = db_get(db, key, value, flags) ;
1476 #ifdef DB_VERSION_MAJOR
1479 else if (RETVAL == DB_NOTFOUND)
1487 db_put(db, key, value, flags=0)
1494 RETVAL = db_put(db, key, value, flags) ;
1495 #ifdef DB_VERSION_MAJOR
1498 else if (RETVAL == DB_KEYEXIST)
1503 key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
1511 #ifdef DB_VERSION_MAJOR
1513 status = (db->in_memory
1515 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
1519 RETVAL = (db->in_memory
1521 : ((db->dbp)->fd)(db->dbp) ) ;
1527 db_sync(db, flags=0)
1532 RETVAL = db_sync(db, flags) ;
1533 #ifdef DB_VERSION_MAJOR
1542 db_seq(db, key, value, flags)
1550 RETVAL = db_seq(db, key, value, flags);
1551 #ifdef DB_VERSION_MAJOR
1554 else if (RETVAL == DB_NOTFOUND)
1562 #ifdef DBM_FILTERING
1564 #define setFilter(type) \
1567 RETVAL = newSVsv(db->type) ; \
1568 if (db->type && (code == &PL_sv_undef)) { \
1569 SvREFCNT_dec(db->type) ; \
1574 sv_setsv(db->type, code) ; \
1576 db->type = newSVsv(code) ; \
1582 filter_fetch_key(db, code)
1585 SV * RETVAL = &PL_sv_undef ;
1587 setFilter(filter_fetch_key) ;
1592 filter_store_key(db, code)
1595 SV * RETVAL = &PL_sv_undef ;
1597 setFilter(filter_store_key) ;
1602 filter_fetch_value(db, code)
1605 SV * RETVAL = &PL_sv_undef ;
1607 setFilter(filter_fetch_value) ;
1612 filter_store_value(db, code)
1615 SV * RETVAL = &PL_sv_undef ;
1617 setFilter(filter_store_value) ;
1621 #endif /* DBM_FILTERING */