3 DB_File.xs -- Perl 5 interface to Berkeley DB
5 written by Paul Marquess <Paul.Marquess@btinternet.com>
6 last modified 6th June 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
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.
82 #include "patchlevel.h"
83 #define PERL_REVISION 5
84 #define PERL_VERSION PATCHLEVEL
85 #define PERL_SUBVERSION SUBVERSION
88 #if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 ))
90 # define PL_sv_undef sv_undef
95 /* DEFSV appears first in 5.004_56 */
97 #define DEFSV GvSV(defgv)
100 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
101 * shortly #included by the <db.h>) __attribute__ to the possibly
102 * already defined __attribute__, for example by GNUC or by Perl. */
106 /* If Perl has been compiled with Threads support,the symbol op will
107 be defined here. This clashes with a field name in db.h, so get rid of it.
117 #define DBM_FILTERING
121 #ifdef DB_VERSION_MAJOR
123 /* map version 2 features & constants onto their version 1 equivalent */
128 #define DB_Prefix_t size_t
133 #define DB_Hash_t u_int32_t
135 /* DBTYPE stays the same */
136 /* HASHINFO, RECNOINFO and BTREEINFO map to DB_INFO */
137 typedef DB_INFO INFO ;
139 /* version 2 has db_recno_t in place of recno_t */
140 typedef db_recno_t recno_t;
143 #define R_CURSOR DB_SET_RANGE
144 #define R_FIRST DB_FIRST
145 #define R_IAFTER DB_AFTER
146 #define R_IBEFORE DB_BEFORE
147 #define R_LAST DB_LAST
148 #define R_NEXT DB_NEXT
149 #define R_NOOVERWRITE DB_NOOVERWRITE
150 #define R_PREV DB_PREV
151 #define R_SETCURSOR 0
152 #define R_RECNOSYNC 0
153 #define R_FIXEDLEN DB_FIXEDLEN
156 #define db_HA_hash h_hash
157 #define db_HA_ffactor h_ffactor
158 #define db_HA_nelem h_nelem
159 #define db_HA_bsize db_pagesize
160 #define db_HA_cachesize db_cachesize
161 #define db_HA_lorder db_lorder
163 #define db_BT_compare bt_compare
164 #define db_BT_prefix bt_prefix
165 #define db_BT_flags flags
166 #define db_BT_psize db_pagesize
167 #define db_BT_cachesize db_cachesize
168 #define db_BT_lorder db_lorder
169 #define db_BT_maxkeypage
170 #define db_BT_minkeypage
173 #define db_RE_reclen re_len
174 #define db_RE_flags flags
175 #define db_RE_bval re_pad
176 #define db_RE_bfname re_source
177 #define db_RE_psize db_pagesize
178 #define db_RE_cachesize db_cachesize
179 #define db_RE_lorder db_lorder
183 #define do_SEQ(db, key, value, flag) (db->cursor->c_get)(db->cursor, &key, &value, flag)
186 #define DBT_flags(x) x.flags = 0
187 #define DB_flags(x, v) x |= v
189 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
190 #define flagSet(flags, bitmask) ((flags) & (bitmask))
192 #define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask))
195 #else /* db version 1.x */
208 #define DB_Prefix_t mDB_Prefix_t
215 #define DB_Hash_t mDB_Hash_t
218 #define db_HA_hash hash.hash
219 #define db_HA_ffactor hash.ffactor
220 #define db_HA_nelem hash.nelem
221 #define db_HA_bsize hash.bsize
222 #define db_HA_cachesize hash.cachesize
223 #define db_HA_lorder hash.lorder
225 #define db_BT_compare btree.compare
226 #define db_BT_prefix btree.prefix
227 #define db_BT_flags btree.flags
228 #define db_BT_psize btree.psize
229 #define db_BT_cachesize btree.cachesize
230 #define db_BT_lorder btree.lorder
231 #define db_BT_maxkeypage btree.maxkeypage
232 #define db_BT_minkeypage btree.minkeypage
234 #define db_RE_reclen recno.reclen
235 #define db_RE_flags recno.flags
236 #define db_RE_bval recno.bval
237 #define db_RE_bfname recno.bfname
238 #define db_RE_psize recno.psize
239 #define db_RE_cachesize recno.cachesize
240 #define db_RE_lorder recno.lorder
244 #define do_SEQ(db, key, value, flag) (db->dbp->seq)(db->dbp, &key, &value, flag)
246 #define DB_flags(x, v)
247 #define flagSet(flags, bitmask) ((flags) & (bitmask))
249 #endif /* db version 1 */
253 #define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, TXN &key, flags)
254 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, flags)
255 #define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
257 #define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
258 #define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
260 #ifdef DB_VERSION_MAJOR
261 #define db_DESTROY(db) ((db->dbp)->close)(db->dbp, 0)
262 #define db_close(db) ((db->dbp)->close)(db->dbp, 0)
263 #define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \
264 ? ((db->cursor)->c_del)(db->cursor, 0) \
265 : ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
269 #define db_DESTROY(db) ((db->dbp)->close)(db->dbp)
270 #define db_close(db) ((db->dbp)->close)(db->dbp)
271 #define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
272 #define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
277 #define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags)
287 #ifdef DB_VERSION_MAJOR
291 SV * filter_fetch_key ;
292 SV * filter_store_key ;
293 SV * filter_fetch_value ;
294 SV * filter_store_value ;
296 #endif /* DBM_FILTERING */
300 typedef DB_File_type * DB_File ;
305 #define ckFilter(arg,type,name) \
308 /* printf("filtering %s\n", name) ;*/ \
310 croak("recursion detected in %s", name) ; \
311 db->filtering = TRUE ; \
312 save_defsv = newSVsv(DEFSV) ; \
313 sv_setsv(DEFSV, arg) ; \
315 (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \
316 sv_setsv(arg, DEFSV) ; \
317 sv_setsv(DEFSV, save_defsv) ; \
318 SvREFCNT_dec(save_defsv) ; \
319 db->filtering = FALSE ; \
320 /*printf("end of filtering %s\n", name) ;*/ \
325 #define ckFilter(arg,type, name)
327 #endif /* DBM_FILTERING */
329 #define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
331 #define OutputValue(arg, name) \
332 { if (RETVAL == 0) { \
333 my_sv_setpvn(arg, name.data, name.size) ; \
334 ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \
338 #define OutputKey(arg, name) \
341 if (db->type != DB_RECNO) { \
342 my_sv_setpvn(arg, name.data, name.size); \
345 sv_setiv(arg, (I32)*(I32*)name.data - 1); \
346 ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \
351 /* Internal Global Data */
352 static recno_t Value ;
353 static recno_t zero = 0 ;
354 static DB_File CurrentDB ;
355 static DBTKEY empty ;
357 #ifdef DB_VERSION_MAJOR
360 db_put(DB_File db, DBTKEY key, DBT value, u_int flags)
364 if (flagSet(flags, R_CURSOR)) {
365 status = ((db->cursor)->c_del)(db->cursor, 0);
369 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
372 flags &= ~DB_OPFLAGS_MASK ;
377 return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
381 #endif /* DB_VERSION_MAJOR */
386 SV * ver_sv = perl_get_sv("DB_File::db_version", TRUE) ;
387 #ifdef DB_VERSION_MAJOR
388 int Major, Minor, Patch ;
390 (void)db_version(&Major, &Minor, &Patch) ;
392 /* check that libdb is recent enough -- we need 2.3.4 or greater */
393 if (Major == 2 && (Minor < 3 || (Minor == 3 && Patch < 4)))
394 croak("DB_File needs Berkeley DB 2.3.4 or greater, you have %d.%d.%d\n",
395 Major, Minor, Patch) ;
398 sv_setpvf(ver_sv, "%d.%d", Major, Minor) ;
402 sprintf(buffer, "%d.%d", Major, Minor) ;
403 sv_setpv(ver_sv, buffer) ;
408 sv_setiv(ver_sv, 1) ;
415 btree_compare(const DBT *key1, const DBT *key2)
419 void * data1, * data2 ;
426 /* As newSVpv will assume that the data pointer is a null terminated C
427 string if the size parameter is 0, make sure that data points to an
428 empty string if the length is 0
440 PUSHs(sv_2mortal(newSVpv(data1,key1->size)));
441 PUSHs(sv_2mortal(newSVpv(data2,key2->size)));
444 count = perl_call_sv(CurrentDB->compare, G_SCALAR);
449 croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
461 btree_prefix(const DBT *key1, const DBT *key2)
465 void * data1, * data2 ;
472 /* As newSVpv will assume that the data pointer is a null terminated C
473 string if the size parameter is 0, make sure that data points to an
474 empty string if the length is 0
486 PUSHs(sv_2mortal(newSVpv(data1,key1->size)));
487 PUSHs(sv_2mortal(newSVpv(data2,key2->size)));
490 count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
495 croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
507 hash_cb(const void *data, size_t size)
517 /* DGH - Next two lines added to fix corrupted stack problem */
523 XPUSHs(sv_2mortal(newSVpv((char*)data,size)));
526 count = perl_call_sv(CurrentDB->hash, G_SCALAR);
531 croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
546 PrintHash(INFO *hash)
548 printf ("HASH Info\n") ;
549 printf (" hash = %s\n",
550 (hash->db_HA_hash != NULL ? "redefined" : "default")) ;
551 printf (" bsize = %d\n", hash->db_HA_bsize) ;
552 printf (" ffactor = %d\n", hash->db_HA_ffactor) ;
553 printf (" nelem = %d\n", hash->db_HA_nelem) ;
554 printf (" cachesize = %d\n", hash->db_HA_cachesize) ;
555 printf (" lorder = %d\n", hash->db_HA_lorder) ;
560 PrintRecno(INFO *recno)
562 printf ("RECNO Info\n") ;
563 printf (" flags = %d\n", recno->db_RE_flags) ;
564 printf (" cachesize = %d\n", recno->db_RE_cachesize) ;
565 printf (" psize = %d\n", recno->db_RE_psize) ;
566 printf (" lorder = %d\n", recno->db_RE_lorder) ;
567 printf (" reclen = %ul\n", (unsigned long)recno->db_RE_reclen) ;
568 printf (" bval = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
569 printf (" bfname = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
573 PrintBtree(INFO *btree)
575 printf ("BTREE Info\n") ;
576 printf (" compare = %s\n",
577 (btree->db_BT_compare ? "redefined" : "default")) ;
578 printf (" prefix = %s\n",
579 (btree->db_BT_prefix ? "redefined" : "default")) ;
580 printf (" flags = %d\n", btree->db_BT_flags) ;
581 printf (" cachesize = %d\n", btree->db_BT_cachesize) ;
582 printf (" psize = %d\n", btree->db_BT_psize) ;
583 #ifndef DB_VERSION_MAJOR
584 printf (" maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
585 printf (" minkeypage = %d\n", btree->db_BT_minkeypage) ;
587 printf (" lorder = %d\n", btree->db_BT_lorder) ;
592 #define PrintRecno(recno)
593 #define PrintHash(hash)
594 #define PrintBtree(btree)
600 GetArrayLength(pTHX_ DB_File db)
608 RETVAL = do_SEQ(db, key, value, R_LAST) ;
610 RETVAL = *(I32 *)key.data ;
611 else /* No key means empty file */
614 return ((I32)RETVAL) ;
618 GetRecnoKey(pTHX_ DB_File db, I32 value)
621 /* Get the length of the array */
622 I32 length = GetArrayLength(aTHX_ db) ;
624 /* check for attempt to write before start of array */
625 if (length + value + 1 <= 0)
626 croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
628 value = length + value + 1 ;
637 ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv)
641 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
642 void * openinfo = NULL ;
643 INFO * info = &RETVAL->info ;
646 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
647 Zero(RETVAL, 1, DB_File_type) ;
649 /* Default to HASH */
651 RETVAL->filtering = 0 ;
652 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
653 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
654 #endif /* DBM_FILTERING */
655 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
656 RETVAL->type = DB_HASH ;
658 /* DGH - Next line added to avoid SEGV on existing hash DB */
661 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
662 RETVAL->in_memory = (name == NULL) ;
667 croak ("type parameter is not a reference") ;
669 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
670 if (svp && SvOK(*svp))
671 action = (HV*) SvRV(*svp) ;
673 croak("internal error") ;
675 if (sv_isa(sv, "DB_File::HASHINFO"))
679 croak("DB_File can only tie an associative array to a DB_HASH database") ;
681 RETVAL->type = DB_HASH ;
682 openinfo = (void*)info ;
684 svp = hv_fetch(action, "hash", 4, FALSE);
686 if (svp && SvOK(*svp))
688 info->db_HA_hash = hash_cb ;
689 RETVAL->hash = newSVsv(*svp) ;
692 info->db_HA_hash = NULL ;
694 svp = hv_fetch(action, "ffactor", 7, FALSE);
695 info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
697 svp = hv_fetch(action, "nelem", 5, FALSE);
698 info->db_HA_nelem = svp ? SvIV(*svp) : 0;
700 svp = hv_fetch(action, "bsize", 5, FALSE);
701 info->db_HA_bsize = svp ? SvIV(*svp) : 0;
703 svp = hv_fetch(action, "cachesize", 9, FALSE);
704 info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
706 svp = hv_fetch(action, "lorder", 6, FALSE);
707 info->db_HA_lorder = svp ? SvIV(*svp) : 0;
711 else if (sv_isa(sv, "DB_File::BTREEINFO"))
714 croak("DB_File can only tie an associative array to a DB_BTREE database");
716 RETVAL->type = DB_BTREE ;
717 openinfo = (void*)info ;
719 svp = hv_fetch(action, "compare", 7, FALSE);
720 if (svp && SvOK(*svp))
722 info->db_BT_compare = btree_compare ;
723 RETVAL->compare = newSVsv(*svp) ;
726 info->db_BT_compare = NULL ;
728 svp = hv_fetch(action, "prefix", 6, FALSE);
729 if (svp && SvOK(*svp))
731 info->db_BT_prefix = btree_prefix ;
732 RETVAL->prefix = newSVsv(*svp) ;
735 info->db_BT_prefix = NULL ;
737 svp = hv_fetch(action, "flags", 5, FALSE);
738 info->db_BT_flags = svp ? SvIV(*svp) : 0;
740 svp = hv_fetch(action, "cachesize", 9, FALSE);
741 info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
743 #ifndef DB_VERSION_MAJOR
744 svp = hv_fetch(action, "minkeypage", 10, FALSE);
745 info->btree.minkeypage = svp ? SvIV(*svp) : 0;
747 svp = hv_fetch(action, "maxkeypage", 10, FALSE);
748 info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
751 svp = hv_fetch(action, "psize", 5, FALSE);
752 info->db_BT_psize = svp ? SvIV(*svp) : 0;
754 svp = hv_fetch(action, "lorder", 6, FALSE);
755 info->db_BT_lorder = svp ? SvIV(*svp) : 0;
760 else if (sv_isa(sv, "DB_File::RECNOINFO"))
763 croak("DB_File can only tie an array to a DB_RECNO database");
765 RETVAL->type = DB_RECNO ;
766 openinfo = (void *)info ;
768 info->db_RE_flags = 0 ;
770 svp = hv_fetch(action, "flags", 5, FALSE);
771 info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
773 svp = hv_fetch(action, "reclen", 6, FALSE);
774 info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
776 svp = hv_fetch(action, "cachesize", 9, FALSE);
777 info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
779 svp = hv_fetch(action, "psize", 5, FALSE);
780 info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
782 svp = hv_fetch(action, "lorder", 6, FALSE);
783 info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
785 #ifdef DB_VERSION_MAJOR
786 info->re_source = name ;
789 svp = hv_fetch(action, "bfname", 6, FALSE);
790 if (svp && SvOK(*svp)) {
791 char * ptr = SvPV(*svp,n_a) ;
792 #ifdef DB_VERSION_MAJOR
793 name = (char*) n_a ? ptr : NULL ;
795 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
799 #ifdef DB_VERSION_MAJOR
802 info->db_RE_bfname = NULL ;
805 svp = hv_fetch(action, "bval", 4, FALSE);
806 #ifdef DB_VERSION_MAJOR
807 if (svp && SvOK(*svp))
811 value = (int)*SvPV(*svp, n_a) ;
815 if (info->flags & DB_FIXEDLEN) {
816 info->re_pad = value ;
817 info->flags |= DB_PAD ;
820 info->re_delim = value ;
821 info->flags |= DB_DELIMITER ;
826 if (svp && SvOK(*svp))
829 info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
831 info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
832 DB_flags(info->flags, DB_DELIMITER) ;
837 if (info->db_RE_flags & R_FIXEDLEN)
838 info->db_RE_bval = (u_char) ' ' ;
840 info->db_RE_bval = (u_char) '\n' ;
841 DB_flags(info->flags, DB_DELIMITER) ;
846 info->flags |= DB_RENUMBER ;
852 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
856 /* OS2 Specific Code */
863 #ifdef DB_VERSION_MAJOR
869 /* Map 1.x flags to 2.x flags */
870 if ((flags & O_CREAT) == O_CREAT)
874 if (flags == O_RDONLY)
876 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
881 if ((flags & O_TRUNC) == O_TRUNC)
882 Flags |= DB_TRUNCATE ;
885 status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
887 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
888 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
890 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
899 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
907 constant(char *name, int arg)
914 if (strEQ(name, "BTREEMAGIC"))
920 if (strEQ(name, "BTREEVERSION"))
930 if (strEQ(name, "DB_LOCK"))
936 if (strEQ(name, "DB_SHMEM"))
942 if (strEQ(name, "DB_TXN"))
956 if (strEQ(name, "HASHMAGIC"))
962 if (strEQ(name, "HASHVERSION"))
978 if (strEQ(name, "MAX_PAGE_NUMBER"))
979 #ifdef MAX_PAGE_NUMBER
980 return (U32)MAX_PAGE_NUMBER;
984 if (strEQ(name, "MAX_PAGE_OFFSET"))
985 #ifdef MAX_PAGE_OFFSET
986 return MAX_PAGE_OFFSET;
990 if (strEQ(name, "MAX_REC_NUMBER"))
991 #ifdef MAX_REC_NUMBER
992 return (U32)MAX_REC_NUMBER;
1006 if (strEQ(name, "RET_ERROR"))
1012 if (strEQ(name, "RET_SPECIAL"))
1018 if (strEQ(name, "RET_SUCCESS"))
1024 if (strEQ(name, "R_CURSOR"))
1030 if (strEQ(name, "R_DUP"))
1036 if (strEQ(name, "R_FIRST"))
1042 if (strEQ(name, "R_FIXEDLEN"))
1048 if (strEQ(name, "R_IAFTER"))
1054 if (strEQ(name, "R_IBEFORE"))
1060 if (strEQ(name, "R_LAST"))
1066 if (strEQ(name, "R_NEXT"))
1072 if (strEQ(name, "R_NOKEY"))
1078 if (strEQ(name, "R_NOOVERWRITE"))
1079 #ifdef R_NOOVERWRITE
1080 return R_NOOVERWRITE;
1084 if (strEQ(name, "R_PREV"))
1090 if (strEQ(name, "R_RECNOSYNC"))
1096 if (strEQ(name, "R_SETCURSOR"))
1102 if (strEQ(name, "R_SNAPSHOT"))
1136 MODULE = DB_File PACKAGE = DB_File PREFIX = db_
1140 GetVersionInfo(aTHX) ;
1142 empty.data = &zero ;
1143 empty.size = sizeof(recno_t) ;
1154 db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
1161 char * name = (char *) NULL ;
1162 SV * sv = (SV *) NULL ;
1165 if (items >= 3 && SvOK(ST(2)))
1166 name = (char*) SvPV(ST(2), n_a) ;
1171 RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
1172 if (RETVAL->dbp == NULL)
1185 SvREFCNT_dec(db->hash) ;
1187 SvREFCNT_dec(db->compare) ;
1189 SvREFCNT_dec(db->prefix) ;
1190 #ifdef DBM_FILTERING
1191 if (db->filter_fetch_key)
1192 SvREFCNT_dec(db->filter_fetch_key) ;
1193 if (db->filter_store_key)
1194 SvREFCNT_dec(db->filter_store_key) ;
1195 if (db->filter_fetch_value)
1196 SvREFCNT_dec(db->filter_fetch_value) ;
1197 if (db->filter_store_value)
1198 SvREFCNT_dec(db->filter_store_value) ;
1199 #endif /* DBM_FILTERING */
1201 #ifdef DB_VERSION_MAJOR
1208 db_DELETE(db, key, flags=0)
1226 RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
1232 db_FETCH(db, key, flags=0)
1242 /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */
1243 RETVAL = db_get(db, key, value, flags) ;
1244 ST(0) = sv_newmortal();
1245 OutputValue(ST(0), value)
1249 db_STORE(db, key, value, flags=0)
1269 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1270 ST(0) = sv_newmortal();
1271 OutputKey(ST(0), key) ;
1284 RETVAL = do_SEQ(db, key, value, R_NEXT) ;
1285 ST(0) = sv_newmortal();
1286 OutputKey(ST(0), key) ;
1290 # These would be nice for RECNO
1309 #ifdef DB_VERSION_MAJOR
1310 /* get the first value */
1311 RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1316 for (i = items-1 ; i > 0 ; --i)
1318 value.data = SvPV(ST(i), n_a) ;
1322 key.size = sizeof(int) ;
1323 #ifdef DB_VERSION_MAJOR
1324 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1326 RETVAL = (Db->put)(Db, &key, &value, R_IBEFORE) ;
1348 /* First get the final value */
1349 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1350 ST(0) = sv_newmortal();
1354 /* the call to del will trash value, so take a copy now */
1355 OutputValue(ST(0), value) ;
1356 RETVAL = db_del(db, key, R_CURSOR) ;
1358 sv_setsv(ST(0), &PL_sv_undef);
1374 /* get the first value */
1375 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1376 ST(0) = sv_newmortal();
1380 /* the call to del will trash value, so take a copy now */
1381 OutputValue(ST(0), value) ;
1382 RETVAL = db_del(db, key, R_CURSOR) ;
1384 sv_setsv (ST(0), &PL_sv_undef) ;
1404 #ifdef DB_VERSION_MAJOR
1407 for (i = 1 ; i < items ; ++i)
1409 value.data = SvPV(ST(i), n_a) ;
1411 RETVAL = (Db->put)(Db, NULL, &key, &value, DB_APPEND) ;
1417 /* Set the Cursor to the Last element */
1418 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1423 for (i = items - 1 ; i > 0 ; --i)
1425 value.data = SvPV(ST(i), n_a) ;
1427 RETVAL = (Db->put)(Db, &key, &value, R_IAFTER) ;
1441 ALIAS: FETCHSIZE = 1
1444 RETVAL = GetArrayLength(aTHX_ db) ;
1450 # Now provide an interface to the rest of the DB functionality
1454 db_del(db, key, flags=0)
1460 RETVAL = db_del(db, key, flags) ;
1461 #ifdef DB_VERSION_MAJOR
1464 else if (RETVAL == DB_NOTFOUND)
1472 db_get(db, key, value, flags=0)
1480 RETVAL = db_get(db, key, value, flags) ;
1481 #ifdef DB_VERSION_MAJOR
1484 else if (RETVAL == DB_NOTFOUND)
1492 db_put(db, key, value, flags=0)
1499 RETVAL = db_put(db, key, value, flags) ;
1500 #ifdef DB_VERSION_MAJOR
1503 else if (RETVAL == DB_KEYEXIST)
1508 key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
1516 #ifdef DB_VERSION_MAJOR
1518 status = (db->in_memory
1520 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
1524 RETVAL = (db->in_memory
1526 : ((db->dbp)->fd)(db->dbp) ) ;
1532 db_sync(db, flags=0)
1537 RETVAL = db_sync(db, flags) ;
1538 #ifdef DB_VERSION_MAJOR
1547 db_seq(db, key, value, flags)
1555 RETVAL = db_seq(db, key, value, flags);
1556 #ifdef DB_VERSION_MAJOR
1559 else if (RETVAL == DB_NOTFOUND)
1567 #ifdef DBM_FILTERING
1569 #define setFilter(type) \
1572 RETVAL = sv_mortalcopy(db->type) ; \
1574 if (db->type && (code == &PL_sv_undef)) { \
1575 SvREFCNT_dec(db->type) ; \
1580 sv_setsv(db->type, code) ; \
1582 db->type = newSVsv(code) ; \
1588 filter_fetch_key(db, code)
1591 SV * RETVAL = &PL_sv_undef ;
1593 setFilter(filter_fetch_key) ;
1596 filter_store_key(db, code)
1599 SV * RETVAL = &PL_sv_undef ;
1601 setFilter(filter_store_key) ;
1604 filter_fetch_value(db, code)
1607 SV * RETVAL = &PL_sv_undef ;
1609 setFilter(filter_fetch_value) ;
1612 filter_store_value(db, code)
1615 SV * RETVAL = &PL_sv_undef ;
1617 setFilter(filter_store_value) ;
1619 #endif /* DBM_FILTERING */