3 DB_File.xs -- Perl 5 interface to Berkeley DB
5 written by Paul Marquess <Paul.Marquess@btinternet.com>
6 last modified 22nd July 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.
72 1.68 - fixed backward compatability bug with R_IAFTER & R_IBEFORE
73 merged in the 5.005_58 changes
84 # include "patchlevel.h"
85 # define PERL_REVISION 5
86 # define PERL_VERSION PATCHLEVEL
87 # define PERL_SUBVERSION SUBVERSION
90 #if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 ))
92 # define PL_sv_undef sv_undef
97 /* DEFSV appears first in 5.004_56 */
99 # define DEFSV GvSV(defgv)
102 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
103 * shortly #included by the <db.h>) __attribute__ to the possibly
104 * already defined __attribute__, for example by GNUC or by Perl. */
108 /* If Perl has been compiled with Threads support,the symbol op will
109 be defined here. This clashes with a field name in db.h, so get rid of it.
124 # define newSVpvn(a,b) newSVpv(a,b)
130 #define DBM_FILTERING
134 #ifdef DB_VERSION_MAJOR
136 /* map version 2 features & constants onto their version 1 equivalent */
141 #define DB_Prefix_t size_t
146 #define DB_Hash_t u_int32_t
148 /* DBTYPE stays the same */
149 /* HASHINFO, RECNOINFO and BTREEINFO map to DB_INFO */
150 typedef DB_INFO INFO ;
152 /* version 2 has db_recno_t in place of recno_t */
153 typedef db_recno_t recno_t;
156 #define R_CURSOR DB_SET_RANGE
157 #define R_FIRST DB_FIRST
158 #define R_IAFTER DB_AFTER
159 #define R_IBEFORE DB_BEFORE
160 #define R_LAST DB_LAST
161 #define R_NEXT DB_NEXT
162 #define R_NOOVERWRITE DB_NOOVERWRITE
163 #define R_PREV DB_PREV
164 #define R_SETCURSOR (-1 )
165 #define R_RECNOSYNC 0
166 #define R_FIXEDLEN DB_FIXEDLEN
169 #define db_HA_hash h_hash
170 #define db_HA_ffactor h_ffactor
171 #define db_HA_nelem h_nelem
172 #define db_HA_bsize db_pagesize
173 #define db_HA_cachesize db_cachesize
174 #define db_HA_lorder db_lorder
176 #define db_BT_compare bt_compare
177 #define db_BT_prefix bt_prefix
178 #define db_BT_flags flags
179 #define db_BT_psize db_pagesize
180 #define db_BT_cachesize db_cachesize
181 #define db_BT_lorder db_lorder
182 #define db_BT_maxkeypage
183 #define db_BT_minkeypage
186 #define db_RE_reclen re_len
187 #define db_RE_flags flags
188 #define db_RE_bval re_pad
189 #define db_RE_bfname re_source
190 #define db_RE_psize db_pagesize
191 #define db_RE_cachesize db_cachesize
192 #define db_RE_lorder db_lorder
196 #define do_SEQ(db, key, value, flag) (db->cursor->c_get)(db->cursor, &key, &value, flag)
199 #define DBT_flags(x) x.flags = 0
200 #define DB_flags(x, v) x |= v
202 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
203 #define flagSet(flags, bitmask) ((flags) & (bitmask))
205 #define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask))
208 #else /* db version 1.x */
221 #define DB_Prefix_t mDB_Prefix_t
228 #define DB_Hash_t mDB_Hash_t
231 #define db_HA_hash hash.hash
232 #define db_HA_ffactor hash.ffactor
233 #define db_HA_nelem hash.nelem
234 #define db_HA_bsize hash.bsize
235 #define db_HA_cachesize hash.cachesize
236 #define db_HA_lorder hash.lorder
238 #define db_BT_compare btree.compare
239 #define db_BT_prefix btree.prefix
240 #define db_BT_flags btree.flags
241 #define db_BT_psize btree.psize
242 #define db_BT_cachesize btree.cachesize
243 #define db_BT_lorder btree.lorder
244 #define db_BT_maxkeypage btree.maxkeypage
245 #define db_BT_minkeypage btree.minkeypage
247 #define db_RE_reclen recno.reclen
248 #define db_RE_flags recno.flags
249 #define db_RE_bval recno.bval
250 #define db_RE_bfname recno.bfname
251 #define db_RE_psize recno.psize
252 #define db_RE_cachesize recno.cachesize
253 #define db_RE_lorder recno.lorder
257 #define do_SEQ(db, key, value, flag) (db->dbp->seq)(db->dbp, &key, &value, flag)
259 #define DB_flags(x, v)
260 #define flagSet(flags, bitmask) ((flags) & (bitmask))
262 #endif /* db version 1 */
266 #define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, TXN &key, flags)
267 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, flags)
268 #define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
270 #define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
271 #define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
273 #ifdef DB_VERSION_MAJOR
274 #define db_DESTROY(db) ((db->dbp)->close)(db->dbp, 0)
275 #define db_close(db) ((db->dbp)->close)(db->dbp, 0)
276 #define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \
277 ? ((db->cursor)->c_del)(db->cursor, 0) \
278 : ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
282 #define db_DESTROY(db) ((db->dbp)->close)(db->dbp)
283 #define db_close(db) ((db->dbp)->close)(db->dbp)
284 #define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
285 #define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
290 #define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags)
300 #ifdef DB_VERSION_MAJOR
304 SV * filter_fetch_key ;
305 SV * filter_store_key ;
306 SV * filter_fetch_value ;
307 SV * filter_store_value ;
309 #endif /* DBM_FILTERING */
313 typedef DB_File_type * DB_File ;
318 #define ckFilter(arg,type,name) \
321 /* printf("filtering %s\n", name) ;*/ \
323 croak("recursion detected in %s", name) ; \
324 db->filtering = TRUE ; \
325 save_defsv = newSVsv(DEFSV) ; \
326 sv_setsv(DEFSV, arg) ; \
328 (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \
329 sv_setsv(arg, DEFSV) ; \
330 sv_setsv(DEFSV, save_defsv) ; \
331 SvREFCNT_dec(save_defsv) ; \
332 db->filtering = FALSE ; \
333 /*printf("end of filtering %s\n", name) ;*/ \
338 #define ckFilter(arg,type, name)
340 #endif /* DBM_FILTERING */
342 #define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
344 #define OutputValue(arg, name) \
345 { if (RETVAL == 0) { \
346 my_sv_setpvn(arg, name.data, name.size) ; \
347 ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \
351 #define OutputKey(arg, name) \
354 if (db->type != DB_RECNO) { \
355 my_sv_setpvn(arg, name.data, name.size); \
358 sv_setiv(arg, (I32)*(I32*)name.data - 1); \
359 ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \
364 /* Internal Global Data */
365 static recno_t Value ;
366 static recno_t zero = 0 ;
367 static DB_File CurrentDB ;
368 static DBTKEY empty ;
370 #ifdef DB_VERSION_MAJOR
374 db_put(DB_File db, DBTKEY key, DBT value, u_int flags)
376 db_put(db, key, value, flags)
385 if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) {
389 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
390 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor) != 0)
392 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor, 0) != 0)
396 memset(&l_key, 0, sizeof(l_key));
397 l_key.data = key.data;
398 l_key.size = key.size;
399 memset(&l_value, 0, sizeof(l_value));
400 l_value.data = value.data;
401 l_value.size = value.size;
403 if ( temp_cursor->c_get(temp_cursor, &l_key, &l_value, DB_SET) != 0) {
404 (void)temp_cursor->c_close(temp_cursor);
408 status = temp_cursor->c_put(temp_cursor, &key, &value, flags);
409 (void)temp_cursor->c_close(temp_cursor);
415 if (flagSet(flags, R_CURSOR)) {
416 return ((db->cursor)->c_put)(db->cursor, &key, &value, DB_CURRENT);
419 if (flagSet(flags, R_SETCURSOR)) {
420 if ((db->dbp)->put(db->dbp, NULL, &key, &value, 0) != 0)
422 return ((db->cursor)->c_get)(db->cursor, &key, &value, DB_SET_RANGE);
426 return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
430 #endif /* DB_VERSION_MAJOR */
435 SV * ver_sv = perl_get_sv("DB_File::db_version", TRUE) ;
436 #ifdef DB_VERSION_MAJOR
437 int Major, Minor, Patch ;
439 (void)db_version(&Major, &Minor, &Patch) ;
441 /* check that libdb is recent enough -- we need 2.3.4 or greater */
442 if (Major == 2 && (Minor < 3 || (Minor == 3 && Patch < 4)))
443 croak("DB_File needs Berkeley DB 2.3.4 or greater, you have %d.%d.%d\n",
444 Major, Minor, Patch) ;
447 sv_setpvf(ver_sv, "%d.%d", Major, Minor) ;
451 sprintf(buffer, "%d.%d", Major, Minor) ;
452 sv_setpv(ver_sv, buffer) ;
457 sv_setiv(ver_sv, 1) ;
465 btree_compare(const DBT *key1, const DBT *key2)
467 btree_compare(key1, key2)
476 void * data1, * data2 ;
484 /* As newSVpv will assume that the data pointer is a null terminated C
485 string if the size parameter is 0, make sure that data points to an
486 empty string if the length is 0
499 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
500 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
503 count = perl_call_sv(CurrentDB->compare, G_SCALAR);
508 croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
521 btree_prefix(const DBT *key1, const DBT *key2)
523 btree_prefix(key1, key2)
532 void * data1, * data2 ;
540 /* As newSVpv will assume that the data pointer is a null terminated C
541 string if the size parameter is 0, make sure that data points to an
542 empty string if the length is 0
555 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
556 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
559 count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
564 croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
577 hash_cb(const void *data, size_t size)
596 /* DGH - Next two lines added to fix corrupted stack problem */
602 XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
605 count = perl_call_sv(CurrentDB->hash, G_SCALAR);
610 croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
626 PrintHash(INFO *hash)
632 printf ("HASH Info\n") ;
633 printf (" hash = %s\n",
634 (hash->db_HA_hash != NULL ? "redefined" : "default")) ;
635 printf (" bsize = %d\n", hash->db_HA_bsize) ;
636 printf (" ffactor = %d\n", hash->db_HA_ffactor) ;
637 printf (" nelem = %d\n", hash->db_HA_nelem) ;
638 printf (" cachesize = %d\n", hash->db_HA_cachesize) ;
639 printf (" lorder = %d\n", hash->db_HA_lorder) ;
645 PrintRecno(INFO *recno)
651 printf ("RECNO Info\n") ;
652 printf (" flags = %d\n", recno->db_RE_flags) ;
653 printf (" cachesize = %d\n", recno->db_RE_cachesize) ;
654 printf (" psize = %d\n", recno->db_RE_psize) ;
655 printf (" lorder = %d\n", recno->db_RE_lorder) ;
656 printf (" reclen = %ul\n", (unsigned long)recno->db_RE_reclen) ;
657 printf (" bval = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
658 printf (" bfname = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
663 PrintBtree(INFO *btree)
669 printf ("BTREE Info\n") ;
670 printf (" compare = %s\n",
671 (btree->db_BT_compare ? "redefined" : "default")) ;
672 printf (" prefix = %s\n",
673 (btree->db_BT_prefix ? "redefined" : "default")) ;
674 printf (" flags = %d\n", btree->db_BT_flags) ;
675 printf (" cachesize = %d\n", btree->db_BT_cachesize) ;
676 printf (" psize = %d\n", btree->db_BT_psize) ;
677 #ifndef DB_VERSION_MAJOR
678 printf (" maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
679 printf (" minkeypage = %d\n", btree->db_BT_minkeypage) ;
681 printf (" lorder = %d\n", btree->db_BT_lorder) ;
686 #define PrintRecno(recno)
687 #define PrintHash(hash)
688 #define PrintBtree(btree)
695 GetArrayLength(pTHX_ DB_File db)
707 RETVAL = do_SEQ(db, key, value, R_LAST) ;
709 RETVAL = *(I32 *)key.data ;
710 else /* No key means empty file */
713 return ((I32)RETVAL) ;
718 GetRecnoKey(pTHX_ DB_File db, I32 value)
720 GetRecnoKey(db, value)
726 /* Get the length of the array */
727 I32 length = GetArrayLength(aTHX_ db) ;
729 /* check for attempt to write before start of array */
730 if (length + value + 1 <= 0)
731 croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
733 value = length + value + 1 ;
743 ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv)
745 ParseOpenInfo(isHASH, name, flags, mode, sv)
755 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
756 void * openinfo = NULL ;
757 INFO * info = &RETVAL->info ;
760 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
761 Zero(RETVAL, 1, DB_File_type) ;
763 /* Default to HASH */
765 RETVAL->filtering = 0 ;
766 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
767 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
768 #endif /* DBM_FILTERING */
769 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
770 RETVAL->type = DB_HASH ;
772 /* DGH - Next line added to avoid SEGV on existing hash DB */
775 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
776 RETVAL->in_memory = (name == NULL) ;
781 croak ("type parameter is not a reference") ;
783 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
784 if (svp && SvOK(*svp))
785 action = (HV*) SvRV(*svp) ;
787 croak("internal error") ;
789 if (sv_isa(sv, "DB_File::HASHINFO"))
793 croak("DB_File can only tie an associative array to a DB_HASH database") ;
795 RETVAL->type = DB_HASH ;
796 openinfo = (void*)info ;
798 svp = hv_fetch(action, "hash", 4, FALSE);
800 if (svp && SvOK(*svp))
802 info->db_HA_hash = hash_cb ;
803 RETVAL->hash = newSVsv(*svp) ;
806 info->db_HA_hash = NULL ;
808 svp = hv_fetch(action, "ffactor", 7, FALSE);
809 info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
811 svp = hv_fetch(action, "nelem", 5, FALSE);
812 info->db_HA_nelem = svp ? SvIV(*svp) : 0;
814 svp = hv_fetch(action, "bsize", 5, FALSE);
815 info->db_HA_bsize = svp ? SvIV(*svp) : 0;
817 svp = hv_fetch(action, "cachesize", 9, FALSE);
818 info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
820 svp = hv_fetch(action, "lorder", 6, FALSE);
821 info->db_HA_lorder = svp ? SvIV(*svp) : 0;
825 else if (sv_isa(sv, "DB_File::BTREEINFO"))
828 croak("DB_File can only tie an associative array to a DB_BTREE database");
830 RETVAL->type = DB_BTREE ;
831 openinfo = (void*)info ;
833 svp = hv_fetch(action, "compare", 7, FALSE);
834 if (svp && SvOK(*svp))
836 info->db_BT_compare = btree_compare ;
837 RETVAL->compare = newSVsv(*svp) ;
840 info->db_BT_compare = NULL ;
842 svp = hv_fetch(action, "prefix", 6, FALSE);
843 if (svp && SvOK(*svp))
845 info->db_BT_prefix = btree_prefix ;
846 RETVAL->prefix = newSVsv(*svp) ;
849 info->db_BT_prefix = NULL ;
851 svp = hv_fetch(action, "flags", 5, FALSE);
852 info->db_BT_flags = svp ? SvIV(*svp) : 0;
854 svp = hv_fetch(action, "cachesize", 9, FALSE);
855 info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
857 #ifndef DB_VERSION_MAJOR
858 svp = hv_fetch(action, "minkeypage", 10, FALSE);
859 info->btree.minkeypage = svp ? SvIV(*svp) : 0;
861 svp = hv_fetch(action, "maxkeypage", 10, FALSE);
862 info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
865 svp = hv_fetch(action, "psize", 5, FALSE);
866 info->db_BT_psize = svp ? SvIV(*svp) : 0;
868 svp = hv_fetch(action, "lorder", 6, FALSE);
869 info->db_BT_lorder = svp ? SvIV(*svp) : 0;
874 else if (sv_isa(sv, "DB_File::RECNOINFO"))
877 croak("DB_File can only tie an array to a DB_RECNO database");
879 RETVAL->type = DB_RECNO ;
880 openinfo = (void *)info ;
882 info->db_RE_flags = 0 ;
884 svp = hv_fetch(action, "flags", 5, FALSE);
885 info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
887 svp = hv_fetch(action, "reclen", 6, FALSE);
888 info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
890 svp = hv_fetch(action, "cachesize", 9, FALSE);
891 info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
893 svp = hv_fetch(action, "psize", 5, FALSE);
894 info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
896 svp = hv_fetch(action, "lorder", 6, FALSE);
897 info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
899 #ifdef DB_VERSION_MAJOR
900 info->re_source = name ;
903 svp = hv_fetch(action, "bfname", 6, FALSE);
904 if (svp && SvOK(*svp)) {
905 char * ptr = SvPV(*svp,n_a) ;
906 #ifdef DB_VERSION_MAJOR
907 name = (char*) n_a ? ptr : NULL ;
909 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
913 #ifdef DB_VERSION_MAJOR
916 info->db_RE_bfname = NULL ;
919 svp = hv_fetch(action, "bval", 4, FALSE);
920 #ifdef DB_VERSION_MAJOR
921 if (svp && SvOK(*svp))
925 value = (int)*SvPV(*svp, n_a) ;
929 if (info->flags & DB_FIXEDLEN) {
930 info->re_pad = value ;
931 info->flags |= DB_PAD ;
934 info->re_delim = value ;
935 info->flags |= DB_DELIMITER ;
940 if (svp && SvOK(*svp))
943 info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
945 info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
946 DB_flags(info->flags, DB_DELIMITER) ;
951 if (info->db_RE_flags & R_FIXEDLEN)
952 info->db_RE_bval = (u_char) ' ' ;
954 info->db_RE_bval = (u_char) '\n' ;
955 DB_flags(info->flags, DB_DELIMITER) ;
960 info->flags |= DB_RENUMBER ;
966 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
970 /* OS2 Specific Code */
977 #ifdef DB_VERSION_MAJOR
983 /* Map 1.x flags to 2.x flags */
984 if ((flags & O_CREAT) == O_CREAT)
988 if (flags == O_RDONLY)
990 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
995 if ((flags & O_TRUNC) == O_TRUNC)
996 Flags |= DB_TRUNCATE ;
999 status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
1001 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
1002 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
1004 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1009 RETVAL->dbp = NULL ;
1013 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
1021 #ifdef CAN_PROTOTYPE
1022 constant(char *name, int arg)
1034 if (strEQ(name, "BTREEMAGIC"))
1040 if (strEQ(name, "BTREEVERSION"))
1042 return BTREEVERSION;
1050 if (strEQ(name, "DB_LOCK"))
1056 if (strEQ(name, "DB_SHMEM"))
1062 if (strEQ(name, "DB_TXN"))
1076 if (strEQ(name, "HASHMAGIC"))
1082 if (strEQ(name, "HASHVERSION"))
1098 if (strEQ(name, "MAX_PAGE_NUMBER"))
1099 #ifdef MAX_PAGE_NUMBER
1100 return (U32)MAX_PAGE_NUMBER;
1104 if (strEQ(name, "MAX_PAGE_OFFSET"))
1105 #ifdef MAX_PAGE_OFFSET
1106 return MAX_PAGE_OFFSET;
1110 if (strEQ(name, "MAX_REC_NUMBER"))
1111 #ifdef MAX_REC_NUMBER
1112 return (U32)MAX_REC_NUMBER;
1126 if (strEQ(name, "RET_ERROR"))
1132 if (strEQ(name, "RET_SPECIAL"))
1138 if (strEQ(name, "RET_SUCCESS"))
1144 if (strEQ(name, "R_CURSOR"))
1150 if (strEQ(name, "R_DUP"))
1156 if (strEQ(name, "R_FIRST"))
1162 if (strEQ(name, "R_FIXEDLEN"))
1168 if (strEQ(name, "R_IAFTER"))
1174 if (strEQ(name, "R_IBEFORE"))
1180 if (strEQ(name, "R_LAST"))
1186 if (strEQ(name, "R_NEXT"))
1192 if (strEQ(name, "R_NOKEY"))
1198 if (strEQ(name, "R_NOOVERWRITE"))
1199 #ifdef R_NOOVERWRITE
1200 return R_NOOVERWRITE;
1204 if (strEQ(name, "R_PREV"))
1210 if (strEQ(name, "R_RECNOSYNC"))
1216 if (strEQ(name, "R_SETCURSOR"))
1222 if (strEQ(name, "R_SNAPSHOT"))
1256 MODULE = DB_File PACKAGE = DB_File PREFIX = db_
1260 GetVersionInfo(aTHX) ;
1262 empty.data = &zero ;
1263 empty.size = sizeof(recno_t) ;
1274 db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
1281 char * name = (char *) NULL ;
1282 SV * sv = (SV *) NULL ;
1285 if (items >= 3 && SvOK(ST(2)))
1286 name = (char*) SvPV(ST(2), n_a) ;
1291 RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
1292 if (RETVAL->dbp == NULL)
1305 SvREFCNT_dec(db->hash) ;
1307 SvREFCNT_dec(db->compare) ;
1309 SvREFCNT_dec(db->prefix) ;
1310 #ifdef DBM_FILTERING
1311 if (db->filter_fetch_key)
1312 SvREFCNT_dec(db->filter_fetch_key) ;
1313 if (db->filter_store_key)
1314 SvREFCNT_dec(db->filter_store_key) ;
1315 if (db->filter_fetch_value)
1316 SvREFCNT_dec(db->filter_fetch_value) ;
1317 if (db->filter_store_value)
1318 SvREFCNT_dec(db->filter_store_value) ;
1319 #endif /* DBM_FILTERING */
1321 #ifdef DB_VERSION_MAJOR
1328 db_DELETE(db, key, flags=0)
1346 RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
1352 db_FETCH(db, key, flags=0)
1362 /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */
1363 RETVAL = db_get(db, key, value, flags) ;
1364 ST(0) = sv_newmortal();
1365 OutputValue(ST(0), value)
1369 db_STORE(db, key, value, flags=0)
1389 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1390 ST(0) = sv_newmortal();
1391 OutputKey(ST(0), key) ;
1404 RETVAL = do_SEQ(db, key, value, R_NEXT) ;
1405 ST(0) = sv_newmortal();
1406 OutputKey(ST(0), key) ;
1410 # These would be nice for RECNO
1429 #ifdef DB_VERSION_MAJOR
1430 /* get the first value */
1431 RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1436 for (i = items-1 ; i > 0 ; --i)
1438 value.data = SvPV(ST(i), n_a) ;
1442 key.size = sizeof(int) ;
1443 #ifdef DB_VERSION_MAJOR
1444 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1446 RETVAL = (Db->put)(Db, &key, &value, R_IBEFORE) ;
1468 /* First get the final value */
1469 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1470 ST(0) = sv_newmortal();
1474 /* the call to del will trash value, so take a copy now */
1475 OutputValue(ST(0), value) ;
1476 RETVAL = db_del(db, key, R_CURSOR) ;
1478 sv_setsv(ST(0), &PL_sv_undef);
1494 /* get the first value */
1495 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1496 ST(0) = sv_newmortal();
1500 /* the call to del will trash value, so take a copy now */
1501 OutputValue(ST(0), value) ;
1502 RETVAL = db_del(db, key, R_CURSOR) ;
1504 sv_setsv (ST(0), &PL_sv_undef) ;
1524 #ifdef DB_VERSION_MAJOR
1527 for (i = 1 ; i < items ; ++i)
1529 value.data = SvPV(ST(i), n_a) ;
1531 RETVAL = (Db->put)(Db, NULL, &key, &value, DB_APPEND) ;
1537 /* Set the Cursor to the Last element */
1538 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1543 for (i = items - 1 ; i > 0 ; --i)
1545 value.data = SvPV(ST(i), n_a) ;
1547 RETVAL = (Db->put)(Db, &key, &value, R_IAFTER) ;
1561 ALIAS: FETCHSIZE = 1
1564 RETVAL = GetArrayLength(aTHX_ db) ;
1570 # Now provide an interface to the rest of the DB functionality
1574 db_del(db, key, flags=0)
1580 RETVAL = db_del(db, key, flags) ;
1581 #ifdef DB_VERSION_MAJOR
1584 else if (RETVAL == DB_NOTFOUND)
1592 db_get(db, key, value, flags=0)
1600 RETVAL = db_get(db, key, value, flags) ;
1601 #ifdef DB_VERSION_MAJOR
1604 else if (RETVAL == DB_NOTFOUND)
1612 db_put(db, key, value, flags=0)
1619 RETVAL = db_put(db, key, value, flags) ;
1620 #ifdef DB_VERSION_MAJOR
1623 else if (RETVAL == DB_KEYEXIST)
1628 key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
1636 #ifdef DB_VERSION_MAJOR
1638 status = (db->in_memory
1640 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
1644 RETVAL = (db->in_memory
1646 : ((db->dbp)->fd)(db->dbp) ) ;
1652 db_sync(db, flags=0)
1657 RETVAL = db_sync(db, flags) ;
1658 #ifdef DB_VERSION_MAJOR
1667 db_seq(db, key, value, flags)
1675 RETVAL = db_seq(db, key, value, flags);
1676 #ifdef DB_VERSION_MAJOR
1679 else if (RETVAL == DB_NOTFOUND)
1687 #ifdef DBM_FILTERING
1689 #define setFilter(type) \
1692 RETVAL = sv_mortalcopy(db->type) ; \
1694 if (db->type && (code == &PL_sv_undef)) { \
1695 SvREFCNT_dec(db->type) ; \
1700 sv_setsv(db->type, code) ; \
1702 db->type = newSVsv(code) ; \
1708 filter_fetch_key(db, code)
1711 SV * RETVAL = &PL_sv_undef ;
1713 setFilter(filter_fetch_key) ;
1716 filter_store_key(db, code)
1719 SV * RETVAL = &PL_sv_undef ;
1721 setFilter(filter_store_key) ;
1724 filter_fetch_value(db, code)
1727 SV * RETVAL = &PL_sv_undef ;
1729 setFilter(filter_fetch_value) ;
1732 filter_store_value(db, code)
1735 SV * RETVAL = &PL_sv_undef ;
1737 setFilter(filter_store_value) ;
1739 #endif /* DBM_FILTERING */