3 DB_File.xs -- Perl 5 interface to Berkeley DB
5 written by Paul Marquess <Paul.Marquess@btinternet.com>
6 last modified 3rd August 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
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
88 # include "patchlevel.h"
89 # define PERL_REVISION 5
90 # define PERL_VERSION PATCHLEVEL
91 # define PERL_SUBVERSION SUBVERSION
94 #if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 ))
96 # define PL_sv_undef sv_undef
101 /* DEFSV appears first in 5.004_56 */
103 # define DEFSV GvSV(defgv)
106 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
107 * shortly #included by the <db.h>) __attribute__ to the possibly
108 * already defined __attribute__, for example by GNUC or by Perl. */
112 /* If Perl has been compiled with Threads support,the symbol op will
113 be defined here. This clashes with a field name in db.h, so get rid of it.
128 # define newSVpvn(a,b) newSVpv(a,b)
134 #define DBM_FILTERING
138 #ifdef DB_VERSION_MAJOR
140 /* map version 2 features & constants onto their version 1 equivalent */
145 #define DB_Prefix_t size_t
150 #define DB_Hash_t u_int32_t
152 /* DBTYPE stays the same */
153 /* HASHINFO, RECNOINFO and BTREEINFO map to DB_INFO */
154 typedef DB_INFO INFO ;
156 /* version 2 has db_recno_t in place of recno_t */
157 typedef db_recno_t recno_t;
160 #define R_CURSOR DB_SET_RANGE
161 #define R_FIRST DB_FIRST
162 #define R_IAFTER DB_AFTER
163 #define R_IBEFORE DB_BEFORE
164 #define R_LAST DB_LAST
165 #define R_NEXT DB_NEXT
166 #define R_NOOVERWRITE DB_NOOVERWRITE
167 #define R_PREV DB_PREV
168 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
169 #define R_SETCURSOR 0x800000
171 #define R_SETCURSOR (-100)
173 #define R_RECNOSYNC 0
174 #define R_FIXEDLEN DB_FIXEDLEN
177 #define db_HA_hash h_hash
178 #define db_HA_ffactor h_ffactor
179 #define db_HA_nelem h_nelem
180 #define db_HA_bsize db_pagesize
181 #define db_HA_cachesize db_cachesize
182 #define db_HA_lorder db_lorder
184 #define db_BT_compare bt_compare
185 #define db_BT_prefix bt_prefix
186 #define db_BT_flags flags
187 #define db_BT_psize db_pagesize
188 #define db_BT_cachesize db_cachesize
189 #define db_BT_lorder db_lorder
190 #define db_BT_maxkeypage
191 #define db_BT_minkeypage
194 #define db_RE_reclen re_len
195 #define db_RE_flags flags
196 #define db_RE_bval re_pad
197 #define db_RE_bfname re_source
198 #define db_RE_psize db_pagesize
199 #define db_RE_cachesize db_cachesize
200 #define db_RE_lorder db_lorder
204 #define do_SEQ(db, key, value, flag) (db->cursor->c_get)(db->cursor, &key, &value, flag)
207 #define DBT_flags(x) x.flags = 0
208 #define DB_flags(x, v) x |= v
210 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
211 #define flagSet(flags, bitmask) ((flags) & (bitmask))
213 #define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask))
216 #else /* db version 1.x */
229 #define DB_Prefix_t mDB_Prefix_t
236 #define DB_Hash_t mDB_Hash_t
239 #define db_HA_hash hash.hash
240 #define db_HA_ffactor hash.ffactor
241 #define db_HA_nelem hash.nelem
242 #define db_HA_bsize hash.bsize
243 #define db_HA_cachesize hash.cachesize
244 #define db_HA_lorder hash.lorder
246 #define db_BT_compare btree.compare
247 #define db_BT_prefix btree.prefix
248 #define db_BT_flags btree.flags
249 #define db_BT_psize btree.psize
250 #define db_BT_cachesize btree.cachesize
251 #define db_BT_lorder btree.lorder
252 #define db_BT_maxkeypage btree.maxkeypage
253 #define db_BT_minkeypage btree.minkeypage
255 #define db_RE_reclen recno.reclen
256 #define db_RE_flags recno.flags
257 #define db_RE_bval recno.bval
258 #define db_RE_bfname recno.bfname
259 #define db_RE_psize recno.psize
260 #define db_RE_cachesize recno.cachesize
261 #define db_RE_lorder recno.lorder
265 #define do_SEQ(db, key, value, flag) (db->dbp->seq)(db->dbp, &key, &value, flag)
267 #define DB_flags(x, v)
268 #define flagSet(flags, bitmask) ((flags) & (bitmask))
270 #endif /* db version 1 */
274 #define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, TXN &key, flags)
275 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, flags)
276 #define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
278 #define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
279 #define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
281 #ifdef DB_VERSION_MAJOR
282 #define db_DESTROY(db) ( db->cursor->c_close(db->cursor),\
283 db->dbp->close(db->dbp, 0) )
284 #define db_close(db) ((db->dbp)->close)(db->dbp, 0)
285 #define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \
286 ? ((db->cursor)->c_del)(db->cursor, 0) \
287 : ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
291 #define db_DESTROY(db) ((db->dbp)->close)(db->dbp)
292 #define db_close(db) ((db->dbp)->close)(db->dbp)
293 #define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
294 #define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
299 #define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags)
309 #ifdef DB_VERSION_MAJOR
313 SV * filter_fetch_key ;
314 SV * filter_store_key ;
315 SV * filter_fetch_value ;
316 SV * filter_store_value ;
318 #endif /* DBM_FILTERING */
322 typedef DB_File_type * DB_File ;
327 #define ckFilter(arg,type,name) \
330 /* printf("filtering %s\n", name) ;*/ \
332 croak("recursion detected in %s", name) ; \
333 db->filtering = TRUE ; \
334 save_defsv = newSVsv(DEFSV) ; \
335 sv_setsv(DEFSV, arg) ; \
337 (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \
338 sv_setsv(arg, DEFSV) ; \
339 sv_setsv(DEFSV, save_defsv) ; \
340 SvREFCNT_dec(save_defsv) ; \
341 db->filtering = FALSE ; \
342 /*printf("end of filtering %s\n", name) ;*/ \
347 #define ckFilter(arg,type, name)
349 #endif /* DBM_FILTERING */
351 #define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
353 #define OutputValue(arg, name) \
354 { if (RETVAL == 0) { \
355 my_sv_setpvn(arg, name.data, name.size) ; \
356 ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \
360 #define OutputKey(arg, name) \
363 if (db->type != DB_RECNO) { \
364 my_sv_setpvn(arg, name.data, name.size); \
367 sv_setiv(arg, (I32)*(I32*)name.data - 1); \
368 ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \
373 /* Internal Global Data */
374 static recno_t Value ;
375 static recno_t zero = 0 ;
376 static DB_File CurrentDB ;
377 static DBTKEY empty ;
379 #ifdef DB_VERSION_MAJOR
383 db_put(DB_File db, DBTKEY key, DBT value, u_int flags)
385 db_put(db, key, value, flags)
394 if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) {
398 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
399 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor) != 0)
401 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor, 0) != 0)
405 memset(&l_key, 0, sizeof(l_key));
406 l_key.data = key.data;
407 l_key.size = key.size;
408 memset(&l_value, 0, sizeof(l_value));
409 l_value.data = value.data;
410 l_value.size = value.size;
412 if ( temp_cursor->c_get(temp_cursor, &l_key, &l_value, DB_SET) != 0) {
413 (void)temp_cursor->c_close(temp_cursor);
417 status = temp_cursor->c_put(temp_cursor, &key, &value, flags);
418 (void)temp_cursor->c_close(temp_cursor);
424 if (flagSet(flags, R_CURSOR)) {
425 return ((db->cursor)->c_put)(db->cursor, &key, &value, DB_CURRENT);
428 if (flagSet(flags, R_SETCURSOR)) {
429 if ((db->dbp)->put(db->dbp, NULL, &key, &value, 0) != 0)
431 return ((db->cursor)->c_get)(db->cursor, &key, &value, DB_SET_RANGE);
435 return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
439 #endif /* DB_VERSION_MAJOR */
444 SV * version_sv = perl_get_sv("DB_File::db_version", TRUE) ;
445 SV * ver_sv = perl_get_sv("DB_File::db_ver", TRUE) ;
446 #ifdef DB_VERSION_MAJOR
447 int Major, Minor, Patch ;
449 (void)db_version(&Major, &Minor, &Patch) ;
451 /* check that libdb is recent enough -- we need 2.3.4 or greater */
452 if (Major == 2 && (Minor < 3 || (Minor == 3 && Patch < 4)))
453 croak("DB_File needs Berkeley DB 2.3.4 or greater, you have %d.%d.%d\n",
454 Major, Minor, Patch) ;
457 sv_setpvf(version_sv, "%d.%d", Major, Minor) ;
458 sv_setpvf(ver_sv, "%d.%03d%03d", Major, Minor, Patch) ;
462 sprintf(buffer, "%d.%d", Major, Minor) ;
463 sv_setpv(version_sv, buffer) ;
464 sprintf(buffer, "%d.%03d%03d", Major, Minor, Patch) ;
465 sv_setpv(ver_sv, buffer) ;
470 sv_setiv(version_sv, 1) ;
471 sv_setiv(ver_sv, 1) ;
479 btree_compare(const DBT *key1, const DBT *key2)
481 btree_compare(key1, key2)
490 void * data1, * data2 ;
498 /* As newSVpv will assume that the data pointer is a null terminated C
499 string if the size parameter is 0, make sure that data points to an
500 empty string if the length is 0
513 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
514 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
517 count = perl_call_sv(CurrentDB->compare, G_SCALAR);
522 croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
535 btree_prefix(const DBT *key1, const DBT *key2)
537 btree_prefix(key1, key2)
546 void * data1, * data2 ;
554 /* As newSVpv will assume that the data pointer is a null terminated C
555 string if the size parameter is 0, make sure that data points to an
556 empty string if the length is 0
569 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
570 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
573 count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
578 croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
591 hash_cb(const void *data, size_t size)
610 /* DGH - Next two lines added to fix corrupted stack problem */
616 XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
619 count = perl_call_sv(CurrentDB->hash, G_SCALAR);
624 croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
640 PrintHash(INFO *hash)
646 printf ("HASH Info\n") ;
647 printf (" hash = %s\n",
648 (hash->db_HA_hash != NULL ? "redefined" : "default")) ;
649 printf (" bsize = %d\n", hash->db_HA_bsize) ;
650 printf (" ffactor = %d\n", hash->db_HA_ffactor) ;
651 printf (" nelem = %d\n", hash->db_HA_nelem) ;
652 printf (" cachesize = %d\n", hash->db_HA_cachesize) ;
653 printf (" lorder = %d\n", hash->db_HA_lorder) ;
659 PrintRecno(INFO *recno)
665 printf ("RECNO Info\n") ;
666 printf (" flags = %d\n", recno->db_RE_flags) ;
667 printf (" cachesize = %d\n", recno->db_RE_cachesize) ;
668 printf (" psize = %d\n", recno->db_RE_psize) ;
669 printf (" lorder = %d\n", recno->db_RE_lorder) ;
670 printf (" reclen = %ul\n", (unsigned long)recno->db_RE_reclen) ;
671 printf (" bval = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
672 printf (" bfname = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
677 PrintBtree(INFO *btree)
683 printf ("BTREE Info\n") ;
684 printf (" compare = %s\n",
685 (btree->db_BT_compare ? "redefined" : "default")) ;
686 printf (" prefix = %s\n",
687 (btree->db_BT_prefix ? "redefined" : "default")) ;
688 printf (" flags = %d\n", btree->db_BT_flags) ;
689 printf (" cachesize = %d\n", btree->db_BT_cachesize) ;
690 printf (" psize = %d\n", btree->db_BT_psize) ;
691 #ifndef DB_VERSION_MAJOR
692 printf (" maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
693 printf (" minkeypage = %d\n", btree->db_BT_minkeypage) ;
695 printf (" lorder = %d\n", btree->db_BT_lorder) ;
700 #define PrintRecno(recno)
701 #define PrintHash(hash)
702 #define PrintBtree(btree)
709 GetArrayLength(pTHX_ DB_File db)
721 RETVAL = do_SEQ(db, key, value, R_LAST) ;
723 RETVAL = *(I32 *)key.data ;
724 else /* No key means empty file */
727 return ((I32)RETVAL) ;
732 GetRecnoKey(pTHX_ DB_File db, I32 value)
734 GetRecnoKey(db, value)
740 /* Get the length of the array */
741 I32 length = GetArrayLength(aTHX_ db) ;
743 /* check for attempt to write before start of array */
744 if (length + value + 1 <= 0)
745 croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
747 value = length + value + 1 ;
757 ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv)
759 ParseOpenInfo(isHASH, name, flags, mode, sv)
769 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
770 void * openinfo = NULL ;
771 INFO * info = &RETVAL->info ;
774 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
775 Zero(RETVAL, 1, DB_File_type) ;
777 /* Default to HASH */
779 RETVAL->filtering = 0 ;
780 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
781 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
782 #endif /* DBM_FILTERING */
783 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
784 RETVAL->type = DB_HASH ;
786 /* DGH - Next line added to avoid SEGV on existing hash DB */
789 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
790 RETVAL->in_memory = (name == NULL) ;
795 croak ("type parameter is not a reference") ;
797 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
798 if (svp && SvOK(*svp))
799 action = (HV*) SvRV(*svp) ;
801 croak("internal error") ;
803 if (sv_isa(sv, "DB_File::HASHINFO"))
807 croak("DB_File can only tie an associative array to a DB_HASH database") ;
809 RETVAL->type = DB_HASH ;
810 openinfo = (void*)info ;
812 svp = hv_fetch(action, "hash", 4, FALSE);
814 if (svp && SvOK(*svp))
816 info->db_HA_hash = hash_cb ;
817 RETVAL->hash = newSVsv(*svp) ;
820 info->db_HA_hash = NULL ;
822 svp = hv_fetch(action, "ffactor", 7, FALSE);
823 info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
825 svp = hv_fetch(action, "nelem", 5, FALSE);
826 info->db_HA_nelem = svp ? SvIV(*svp) : 0;
828 svp = hv_fetch(action, "bsize", 5, FALSE);
829 info->db_HA_bsize = svp ? SvIV(*svp) : 0;
831 svp = hv_fetch(action, "cachesize", 9, FALSE);
832 info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
834 svp = hv_fetch(action, "lorder", 6, FALSE);
835 info->db_HA_lorder = svp ? SvIV(*svp) : 0;
839 else if (sv_isa(sv, "DB_File::BTREEINFO"))
842 croak("DB_File can only tie an associative array to a DB_BTREE database");
844 RETVAL->type = DB_BTREE ;
845 openinfo = (void*)info ;
847 svp = hv_fetch(action, "compare", 7, FALSE);
848 if (svp && SvOK(*svp))
850 info->db_BT_compare = btree_compare ;
851 RETVAL->compare = newSVsv(*svp) ;
854 info->db_BT_compare = NULL ;
856 svp = hv_fetch(action, "prefix", 6, FALSE);
857 if (svp && SvOK(*svp))
859 info->db_BT_prefix = btree_prefix ;
860 RETVAL->prefix = newSVsv(*svp) ;
863 info->db_BT_prefix = NULL ;
865 svp = hv_fetch(action, "flags", 5, FALSE);
866 info->db_BT_flags = svp ? SvIV(*svp) : 0;
868 svp = hv_fetch(action, "cachesize", 9, FALSE);
869 info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
871 #ifndef DB_VERSION_MAJOR
872 svp = hv_fetch(action, "minkeypage", 10, FALSE);
873 info->btree.minkeypage = svp ? SvIV(*svp) : 0;
875 svp = hv_fetch(action, "maxkeypage", 10, FALSE);
876 info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
879 svp = hv_fetch(action, "psize", 5, FALSE);
880 info->db_BT_psize = svp ? SvIV(*svp) : 0;
882 svp = hv_fetch(action, "lorder", 6, FALSE);
883 info->db_BT_lorder = svp ? SvIV(*svp) : 0;
888 else if (sv_isa(sv, "DB_File::RECNOINFO"))
891 croak("DB_File can only tie an array to a DB_RECNO database");
893 RETVAL->type = DB_RECNO ;
894 openinfo = (void *)info ;
896 info->db_RE_flags = 0 ;
898 svp = hv_fetch(action, "flags", 5, FALSE);
899 info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
901 svp = hv_fetch(action, "reclen", 6, FALSE);
902 info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
904 svp = hv_fetch(action, "cachesize", 9, FALSE);
905 info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
907 svp = hv_fetch(action, "psize", 5, FALSE);
908 info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
910 svp = hv_fetch(action, "lorder", 6, FALSE);
911 info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
913 #ifdef DB_VERSION_MAJOR
914 info->re_source = name ;
917 svp = hv_fetch(action, "bfname", 6, FALSE);
918 if (svp && SvOK(*svp)) {
919 char * ptr = SvPV(*svp,n_a) ;
920 #ifdef DB_VERSION_MAJOR
921 name = (char*) n_a ? ptr : NULL ;
923 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
927 #ifdef DB_VERSION_MAJOR
930 info->db_RE_bfname = NULL ;
933 svp = hv_fetch(action, "bval", 4, FALSE);
934 #ifdef DB_VERSION_MAJOR
935 if (svp && SvOK(*svp))
939 value = (int)*SvPV(*svp, n_a) ;
943 if (info->flags & DB_FIXEDLEN) {
944 info->re_pad = value ;
945 info->flags |= DB_PAD ;
948 info->re_delim = value ;
949 info->flags |= DB_DELIMITER ;
954 if (svp && SvOK(*svp))
957 info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
959 info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
960 DB_flags(info->flags, DB_DELIMITER) ;
965 if (info->db_RE_flags & R_FIXEDLEN)
966 info->db_RE_bval = (u_char) ' ' ;
968 info->db_RE_bval = (u_char) '\n' ;
969 DB_flags(info->flags, DB_DELIMITER) ;
974 info->flags |= DB_RENUMBER ;
980 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
984 /* OS2 Specific Code */
991 #ifdef DB_VERSION_MAJOR
997 /* Map 1.x flags to 2.x flags */
998 if ((flags & O_CREAT) == O_CREAT)
1002 if (flags == O_RDONLY)
1004 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1006 Flags |= DB_RDONLY ;
1009 if ((flags & O_TRUNC) == O_TRUNC)
1010 Flags |= DB_TRUNCATE ;
1013 status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
1015 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
1016 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
1018 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1023 RETVAL->dbp = NULL ;
1027 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
1035 #ifdef CAN_PROTOTYPE
1036 constant(char *name, int arg)
1048 if (strEQ(name, "BTREEMAGIC"))
1054 if (strEQ(name, "BTREEVERSION"))
1056 return BTREEVERSION;
1064 if (strEQ(name, "DB_LOCK"))
1070 if (strEQ(name, "DB_SHMEM"))
1076 if (strEQ(name, "DB_TXN"))
1090 if (strEQ(name, "HASHMAGIC"))
1096 if (strEQ(name, "HASHVERSION"))
1112 if (strEQ(name, "MAX_PAGE_NUMBER"))
1113 #ifdef MAX_PAGE_NUMBER
1114 return (U32)MAX_PAGE_NUMBER;
1118 if (strEQ(name, "MAX_PAGE_OFFSET"))
1119 #ifdef MAX_PAGE_OFFSET
1120 return MAX_PAGE_OFFSET;
1124 if (strEQ(name, "MAX_REC_NUMBER"))
1125 #ifdef MAX_REC_NUMBER
1126 return (U32)MAX_REC_NUMBER;
1140 if (strEQ(name, "RET_ERROR"))
1146 if (strEQ(name, "RET_SPECIAL"))
1152 if (strEQ(name, "RET_SUCCESS"))
1158 if (strEQ(name, "R_CURSOR"))
1164 if (strEQ(name, "R_DUP"))
1170 if (strEQ(name, "R_FIRST"))
1176 if (strEQ(name, "R_FIXEDLEN"))
1182 if (strEQ(name, "R_IAFTER"))
1188 if (strEQ(name, "R_IBEFORE"))
1194 if (strEQ(name, "R_LAST"))
1200 if (strEQ(name, "R_NEXT"))
1206 if (strEQ(name, "R_NOKEY"))
1212 if (strEQ(name, "R_NOOVERWRITE"))
1213 #ifdef R_NOOVERWRITE
1214 return R_NOOVERWRITE;
1218 if (strEQ(name, "R_PREV"))
1224 if (strEQ(name, "R_RECNOSYNC"))
1230 if (strEQ(name, "R_SETCURSOR"))
1236 if (strEQ(name, "R_SNAPSHOT"))
1270 MODULE = DB_File PACKAGE = DB_File PREFIX = db_
1274 GetVersionInfo(aTHX) ;
1276 empty.data = &zero ;
1277 empty.size = sizeof(recno_t) ;
1288 db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
1295 char * name = (char *) NULL ;
1296 SV * sv = (SV *) NULL ;
1299 if (items >= 3 && SvOK(ST(2)))
1300 name = (char*) SvPV(ST(2), n_a) ;
1305 RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
1306 if (RETVAL->dbp == NULL)
1319 SvREFCNT_dec(db->hash) ;
1321 SvREFCNT_dec(db->compare) ;
1323 SvREFCNT_dec(db->prefix) ;
1324 #ifdef DBM_FILTERING
1325 if (db->filter_fetch_key)
1326 SvREFCNT_dec(db->filter_fetch_key) ;
1327 if (db->filter_store_key)
1328 SvREFCNT_dec(db->filter_store_key) ;
1329 if (db->filter_fetch_value)
1330 SvREFCNT_dec(db->filter_fetch_value) ;
1331 if (db->filter_store_value)
1332 SvREFCNT_dec(db->filter_store_value) ;
1333 #endif /* DBM_FILTERING */
1335 #ifdef DB_VERSION_MAJOR
1342 db_DELETE(db, key, flags=0)
1360 RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
1366 db_FETCH(db, key, flags=0)
1376 /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */
1377 RETVAL = db_get(db, key, value, flags) ;
1378 ST(0) = sv_newmortal();
1379 OutputValue(ST(0), value)
1383 db_STORE(db, key, value, flags=0)
1403 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1404 ST(0) = sv_newmortal();
1405 OutputKey(ST(0), key) ;
1418 RETVAL = do_SEQ(db, key, value, R_NEXT) ;
1419 ST(0) = sv_newmortal();
1420 OutputKey(ST(0), key) ;
1424 # These would be nice for RECNO
1443 #ifdef DB_VERSION_MAJOR
1444 /* get the first value */
1445 RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1450 for (i = items-1 ; i > 0 ; --i)
1452 value.data = SvPV(ST(i), n_a) ;
1456 key.size = sizeof(int) ;
1457 #ifdef DB_VERSION_MAJOR
1458 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1460 RETVAL = (Db->put)(Db, &key, &value, R_IBEFORE) ;
1482 /* First get the final value */
1483 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1484 ST(0) = sv_newmortal();
1488 /* the call to del will trash value, so take a copy now */
1489 OutputValue(ST(0), value) ;
1490 RETVAL = db_del(db, key, R_CURSOR) ;
1492 sv_setsv(ST(0), &PL_sv_undef);
1508 /* get the first value */
1509 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1510 ST(0) = sv_newmortal();
1514 /* the call to del will trash value, so take a copy now */
1515 OutputValue(ST(0), value) ;
1516 RETVAL = db_del(db, key, R_CURSOR) ;
1518 sv_setsv (ST(0), &PL_sv_undef) ;
1538 #ifdef DB_VERSION_MAJOR
1539 RETVAL = do_SEQ(db, key, value, DB_LAST) ;
1542 for (i = 1 ; i < items ; ++i)
1544 value.data = SvPV(ST(i), n_a) ;
1546 RETVAL = (Db->put)(Db, NULL, &key, &value, DB_APPEND) ;
1552 /* Set the Cursor to the Last element */
1553 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1558 for (i = items - 1 ; i > 0 ; --i)
1560 value.data = SvPV(ST(i), n_a) ;
1562 RETVAL = (Db->put)(Db, &key, &value, R_IAFTER) ;
1576 ALIAS: FETCHSIZE = 1
1579 RETVAL = GetArrayLength(aTHX_ db) ;
1585 # Now provide an interface to the rest of the DB functionality
1589 db_del(db, key, flags=0)
1595 RETVAL = db_del(db, key, flags) ;
1596 #ifdef DB_VERSION_MAJOR
1599 else if (RETVAL == DB_NOTFOUND)
1607 db_get(db, key, value, flags=0)
1615 RETVAL = db_get(db, key, value, flags) ;
1616 #ifdef DB_VERSION_MAJOR
1619 else if (RETVAL == DB_NOTFOUND)
1627 db_put(db, key, value, flags=0)
1634 RETVAL = db_put(db, key, value, flags) ;
1635 #ifdef DB_VERSION_MAJOR
1638 else if (RETVAL == DB_KEYEXIST)
1643 key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
1651 #ifdef DB_VERSION_MAJOR
1653 status = (db->in_memory
1655 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
1659 RETVAL = (db->in_memory
1661 : ((db->dbp)->fd)(db->dbp) ) ;
1667 db_sync(db, flags=0)
1672 RETVAL = db_sync(db, flags) ;
1673 #ifdef DB_VERSION_MAJOR
1682 db_seq(db, key, value, flags)
1690 RETVAL = db_seq(db, key, value, flags);
1691 #ifdef DB_VERSION_MAJOR
1694 else if (RETVAL == DB_NOTFOUND)
1702 #ifdef DBM_FILTERING
1704 #define setFilter(type) \
1707 RETVAL = sv_mortalcopy(db->type) ; \
1709 if (db->type && (code == &PL_sv_undef)) { \
1710 SvREFCNT_dec(db->type) ; \
1715 sv_setsv(db->type, code) ; \
1717 db->type = newSVsv(code) ; \
1723 filter_fetch_key(db, code)
1726 SV * RETVAL = &PL_sv_undef ;
1728 setFilter(filter_fetch_key) ;
1731 filter_store_key(db, code)
1734 SV * RETVAL = &PL_sv_undef ;
1736 setFilter(filter_store_key) ;
1739 filter_fetch_value(db, code)
1742 SV * RETVAL = &PL_sv_undef ;
1744 setFilter(filter_fetch_value) ;
1747 filter_store_value(db, code)
1750 SV * RETVAL = &PL_sv_undef ;
1752 setFilter(filter_store_value) ;
1754 #endif /* DBM_FILTERING */