projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Configure tweaks; record the Berkeley DB version,
[p5sagit/p5-mst-13.2.git] / ext / DB_File / DB_File.xs
CommitLineData
a0d0e21e 1/*
2
3 DB_File.xs -- Perl 5 interface to Berkeley DB
4
6ca2e664 5 written by Paul Marquess <Paul.Marquess@btinternet.com>
c5da4faf 6 last modified 26th April 2001
7 version 1.77
a0d0e21e 8
9 All comments/suggestions/problems are welcome
10
c5da4faf 11 Copyright (c) 1995-2001 Paul Marquess. All rights reserved.
36477c24 12 This program is free software; you can redistribute it and/or
13 modify it under the same terms as Perl itself.
14
3b35bae3 15 Changes:
4633a7c4 16 0.1 - Initial Release
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.
88108326 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
f6b705ef 29 1.03 - Added EXISTS
610ab055 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
33 Makefile.PL
ff68c719 34 1.06 - Minor namespace cleanup: Localized PrintBtree.
36477c24 35 1.07 - Fixed bug with RECNO, where bval wasn't defaulting to "\n".
36 1.08 - No change to DB_File.xs
18d2dc8c 37 1.09 - Default mode for dbopen changed to 0666
a0b8c8c1 38 1.10 - Fixed fd method so that it still returns -1 for
39 in-memory files when db 1.86 is used.
778183f3 40 1.11 - No change to DB_File.xs
68dc0745 41 1.12 - No change to DB_File.xs
1f70e1ea 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
a6ed719b 48 undefined value" warning with db_get and db_seq.
1f70e1ea 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
045291aa 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.
a9fd575d 57 1.59 - No change to DB_File.xs
58 1.60 - Some code tidy up
9d9477b1 59 1.61 - added flagSet macro for DB 2.5.x
60 fixed typo in O_RDONLY test.
6ca2e664 61 1.62 - No change to DB_File.xs
62 1.63 - Fix to alllow DB 2.6.x to build.
20896112 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
ca63f0d2 66 1.65 - Fixed a bug in the PUSH logic.
67 Added BOOT check that using 2.3.4 or greater
9fe6733a 68 1.66 - Added DBM filter code
cad2e5aa 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.
2c2d71f5 72 1.68 - fixed backward compatability bug with R_IAFTER & R_IBEFORE
73 merged in the 5.005_58 changes
a62982a8 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
e07e3419 77 1.70 - Initialise $DB_File::db_ver and $DB_File::db_version with
78 GV_ADD|GV_ADDMULT -- bug spotted by Nick Ing-Simmons.
79 Added a BOOT check to test for equivalent versions of db.h &
80 libdb.a/so.
ccb44e3b 81 1.71 - Support for Berkeley DB version 3.
82 Support for Berkeley DB 2/3's backward compatability mode.
83 Rewrote push
b90e71be 84 1.72 - No change to DB_File.xs
88c74d4b 85 1.73 - No change to DB_File.xs
3245f058 86 1.74 - A call to open needed parenthesised to stop it clashing
87 with a win32 macro.
88 Added Perl core patches 7703 & 7801.
73969f8f 89 1.75 - Fixed Perl core patch 7703.
90 Added suppport to allow DB_File to be built with
91 Berkeley DB 3.2 -- btree_compare, btree_prefix and hash_cb
92 needed to be changed.
c5da4faf 93 1.76 - No change to DB_File.xs
94 1.77 - Tidied up a few types used in calling newSVpvn.
f6b705ef 95
a0d0e21e 96*/
97
98#include "EXTERN.h"
99#include "perl.h"
100#include "XSUB.h"
101
cceca5ed 102#ifndef PERL_VERSION
2c2d71f5 103# include "patchlevel.h"
104# define PERL_REVISION 5
105# define PERL_VERSION PATCHLEVEL
106# define PERL_SUBVERSION SUBVERSION
20896112 107#endif
108
109#if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 ))
110
111# define PL_sv_undef sv_undef
112# define PL_na na
113
cceca5ed 114#endif
115
cad2e5aa 116/* DEFSV appears first in 5.004_56 */
117#ifndef DEFSV
2c2d71f5 118# define DEFSV GvSV(defgv)
cad2e5aa 119#endif
120
640374d0 121/* Mention DB_VERSION_MAJOR_CFG, DB_VERSION_MINOR_CFG, and
122 DB_VERSION_PATCH_CFG here so that Configure pulls them all in. */
123
52e1cb5e 124/* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
125 * shortly #included by the <db.h>) __attribute__ to the possibly
126 * already defined __attribute__, for example by GNUC or by Perl. */
1f70e1ea 127
640374d0 128#if DB_VERSION_MAJOR_CFG < 2
129
52e1cb5e 130#undef __attribute__
131
45c68e7c 132/* Since we dropped the gccish definition of __attribute__ we will want
133 * to redefine dNOOP, however (so that dTHX continues to work). Yes,
134 * all this means that we can't do attribute checking on the DB_File,
135 * boo, hiss. */
136#undef dNOOP
137#define dNOOP extern int Perl___notused
138
640374d0 139#endif
140
045291aa 141/* If Perl has been compiled with Threads support,the symbol op will
142 be defined here. This clashes with a field name in db.h, so get rid of it.
143 */
144#ifdef op
2c2d71f5 145# undef op
045291aa 146#endif
ccb44e3b 147
148#ifdef COMPAT185
149# include <db_185.h>
150#else
151# include <db.h>
152#endif
a0d0e21e 153
3245f058 154#ifdef CAN_PROTOTYPE
b92372bc 155extern void __getBerkeleyDBInfo(void);
3245f058 156#endif
b92372bc 157
2c2d71f5 158#ifndef pTHX
159# define pTHX
160# define pTHX_
161# define aTHX
162# define aTHX_
163#endif
164
165#ifndef newSVpvn
166# define newSVpvn(a,b) newSVpv(a,b)
167#endif
168
a0d0e21e 169#include <fcntl.h>
170
1f70e1ea 171/* #define TRACE */
9fe6733a 172#define DBM_FILTERING
1f70e1ea 173
ccb44e3b 174#ifdef TRACE
175# define Trace(x) printf x
176#else
177# define Trace(x)
178#endif
179
1f70e1ea 180
ccb44e3b 181#define DBT_clear(x) Zero(&x, 1, DBT) ;
1f70e1ea 182
183#ifdef DB_VERSION_MAJOR
184
ccb44e3b 185#if DB_VERSION_MAJOR == 2
186# define BERKELEY_DB_1_OR_2
187#endif
188
73969f8f 189#if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 2)
190# define AT_LEAST_DB_3_2
191#endif
192
1f70e1ea 193/* map version 2 features & constants onto their version 1 equivalent */
194
195#ifdef DB_Prefix_t
2c2d71f5 196# undef DB_Prefix_t
1f70e1ea 197#endif
198#define DB_Prefix_t size_t
199
200#ifdef DB_Hash_t
2c2d71f5 201# undef DB_Hash_t
1f70e1ea 202#endif
203#define DB_Hash_t u_int32_t
204
205/* DBTYPE stays the same */
206/* HASHINFO, RECNOINFO and BTREEINFO map to DB_INFO */
ccb44e3b 207#if DB_VERSION_MAJOR == 2
208 typedef DB_INFO INFO ;
209#else /* DB_VERSION_MAJOR > 2 */
210# define DB_FIXEDLEN (0x8000)
211#endif /* DB_VERSION_MAJOR == 2 */
1f70e1ea 212
213/* version 2 has db_recno_t in place of recno_t */
214typedef db_recno_t recno_t;
215
216
217#define R_CURSOR DB_SET_RANGE
218#define R_FIRST DB_FIRST
219#define R_IAFTER DB_AFTER
220#define R_IBEFORE DB_BEFORE
221#define R_LAST DB_LAST
222#define R_NEXT DB_NEXT
223#define R_NOOVERWRITE DB_NOOVERWRITE
224#define R_PREV DB_PREV
ccb44e3b 225
a62982a8 226#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
ccb44e3b 227# define R_SETCURSOR 0x800000
a62982a8 228#else
ccb44e3b 229# define R_SETCURSOR (-100)
a62982a8 230#endif
ccb44e3b 231
1f70e1ea 232#define R_RECNOSYNC 0
233#define R_FIXEDLEN DB_FIXEDLEN
234#define R_DUP DB_DUP
235
ccb44e3b 236
1f70e1ea 237#define db_HA_hash h_hash
238#define db_HA_ffactor h_ffactor
239#define db_HA_nelem h_nelem
240#define db_HA_bsize db_pagesize
241#define db_HA_cachesize db_cachesize
242#define db_HA_lorder db_lorder
243
244#define db_BT_compare bt_compare
245#define db_BT_prefix bt_prefix
246#define db_BT_flags flags
247#define db_BT_psize db_pagesize
248#define db_BT_cachesize db_cachesize
249#define db_BT_lorder db_lorder
250#define db_BT_maxkeypage
251#define db_BT_minkeypage
252
253
254#define db_RE_reclen re_len
255#define db_RE_flags flags
256#define db_RE_bval re_pad
257#define db_RE_bfname re_source
258#define db_RE_psize db_pagesize
259#define db_RE_cachesize db_cachesize
260#define db_RE_lorder db_lorder
261
262#define TXN NULL,
263
264#define do_SEQ(db, key, value, flag) (db->cursor->c_get)(db->cursor, &key, &value, flag)
265
266
267#define DBT_flags(x) x.flags = 0
268#define DB_flags(x, v) x |= v
269
9d9477b1 270#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
ccb44e3b 271# define flagSet(flags, bitmask) ((flags) & (bitmask))
9d9477b1 272#else
ccb44e3b 273# define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask))
9d9477b1 274#endif
275
1f70e1ea 276#else /* db version 1.x */
277
73969f8f 278#define BERKELEY_DB_1
ccb44e3b 279#define BERKELEY_DB_1_OR_2
280
1f70e1ea 281typedef union INFO {
282 HASHINFO hash ;
283 RECNOINFO recno ;
284 BTREEINFO btree ;
285 } INFO ;
286
287
610ab055 288#ifdef mDB_Prefix_t
ccb44e3b 289# ifdef DB_Prefix_t
290# undef DB_Prefix_t
291# endif
292# define DB_Prefix_t mDB_Prefix_t
610ab055 293#endif
294
295#ifdef mDB_Hash_t
ccb44e3b 296# ifdef DB_Hash_t
297# undef DB_Hash_t
298# endif
299# define DB_Hash_t mDB_Hash_t
610ab055 300#endif
301
1f70e1ea 302#define db_HA_hash hash.hash
303#define db_HA_ffactor hash.ffactor
304#define db_HA_nelem hash.nelem
305#define db_HA_bsize hash.bsize
306#define db_HA_cachesize hash.cachesize
307#define db_HA_lorder hash.lorder
308
309#define db_BT_compare btree.compare
310#define db_BT_prefix btree.prefix
311#define db_BT_flags btree.flags
312#define db_BT_psize btree.psize
313#define db_BT_cachesize btree.cachesize
314#define db_BT_lorder btree.lorder
315#define db_BT_maxkeypage btree.maxkeypage
316#define db_BT_minkeypage btree.minkeypage
317
318#define db_RE_reclen recno.reclen
319#define db_RE_flags recno.flags
320#define db_RE_bval recno.bval
321#define db_RE_bfname recno.bfname
322#define db_RE_psize recno.psize
323#define db_RE_cachesize recno.cachesize
324#define db_RE_lorder recno.lorder
325
326#define TXN
327
328#define do_SEQ(db, key, value, flag) (db->dbp->seq)(db->dbp, &key, &value, flag)
329#define DBT_flags(x)
330#define DB_flags(x, v)
9d9477b1 331#define flagSet(flags, bitmask) ((flags) & (bitmask))
1f70e1ea 332
333#endif /* db version 1 */
334
335
336
337#define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, TXN &key, flags)
338#define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, flags)
339#define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
340
341#define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
342#define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
9d9477b1 343
1f70e1ea 344#ifdef DB_VERSION_MAJOR
a62982a8 345#define db_DESTROY(db) ( db->cursor->c_close(db->cursor),\
ccb44e3b 346 (db->dbp->close)(db->dbp, 0) )
1f70e1ea 347#define db_close(db) ((db->dbp)->close)(db->dbp, 0)
9d9477b1 348#define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \
1f70e1ea 349 ? ((db->cursor)->c_del)(db->cursor, 0) \
350 : ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
351
ccb44e3b 352#else /* ! DB_VERSION_MAJOR */
1f70e1ea 353
354#define db_DESTROY(db) ((db->dbp)->close)(db->dbp)
355#define db_close(db) ((db->dbp)->close)(db->dbp)
356#define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
357#define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
358
ccb44e3b 359#endif /* ! DB_VERSION_MAJOR */
1f70e1ea 360
9d9477b1 361
1f70e1ea 362#define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags)
610ab055 363
8e07c86e 364typedef struct {
365 DBTYPE type ;
366 DB * dbp ;
367 SV * compare ;
368 SV * prefix ;
369 SV * hash ;
a0b8c8c1 370 int in_memory ;
ccb44e3b 371#ifdef BERKELEY_DB_1_OR_2
1f70e1ea 372 INFO info ;
ccb44e3b 373#endif
1f70e1ea 374#ifdef DB_VERSION_MAJOR
375 DBC * cursor ;
376#endif
9fe6733a 377#ifdef DBM_FILTERING
378 SV * filter_fetch_key ;
379 SV * filter_store_key ;
380 SV * filter_fetch_value ;
381 SV * filter_store_value ;
382 int filtering ;
383#endif /* DBM_FILTERING */
384
8e07c86e 385 } DB_File_type;
386
387typedef DB_File_type * DB_File ;
a0d0e21e 388typedef DBT DBTKEY ;
389
9fe6733a 390#ifdef DBM_FILTERING
391
392#define ckFilter(arg,type,name) \
393 if (db->type) { \
394 SV * save_defsv ; \
395 /* printf("filtering %s\n", name) ;*/ \
396 if (db->filtering) \
397 croak("recursion detected in %s", name) ; \
398 db->filtering = TRUE ; \
9fe6733a 399 save_defsv = newSVsv(DEFSV) ; \
400 sv_setsv(DEFSV, arg) ; \
401 PUSHMARK(sp) ; \
402 (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \
9fe6733a 403 sv_setsv(arg, DEFSV) ; \
cad2e5aa 404 sv_setsv(DEFSV, save_defsv) ; \
9fe6733a 405 SvREFCNT_dec(save_defsv) ; \
9fe6733a 406 db->filtering = FALSE ; \
407 /*printf("end of filtering %s\n", name) ;*/ \
408 }
409
410#else
411
412#define ckFilter(arg,type, name)
413
414#endif /* DBM_FILTERING */
415
045291aa 416#define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
a0d0e21e 417
9fe6733a 418#define OutputValue(arg, name) \
419 { if (RETVAL == 0) { \
420 my_sv_setpvn(arg, name.data, name.size) ; \
421 ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \
422 } \
88108326 423 }
a0d0e21e 424
9fe6733a 425#define OutputKey(arg, name) \
426 { if (RETVAL == 0) \
427 { \
428 if (db->type != DB_RECNO) { \
429 my_sv_setpvn(arg, name.data, name.size); \
430 } \
431 else \
432 sv_setiv(arg, (I32)*(I32*)name.data - 1); \
433 ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \
434 } \
a0d0e21e 435 }
436
045291aa 437
a0d0e21e 438/* Internal Global Data */
8e07c86e 439static recno_t Value ;
8e07c86e 440static recno_t zero = 0 ;
1f70e1ea 441static DB_File CurrentDB ;
442static DBTKEY empty ;
443
444#ifdef DB_VERSION_MAJOR
445
446static int
2c2d71f5 447#ifdef CAN_PROTOTYPE
b76802f5 448db_put(DB_File db, DBTKEY key, DBT value, u_int flags)
2c2d71f5 449#else
450db_put(db, key, value, flags)
451DB_File db ;
452DBTKEY key ;
453DBT value ;
454u_int flags ;
455#endif
1f70e1ea 456{
457 int status ;
458
2c2d71f5 459 if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) {
460 DBC * temp_cursor ;
461 DBT l_key, l_value;
462
463#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
464 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor) != 0)
9d9477b1 465#else
2c2d71f5 466 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor, 0) != 0)
9d9477b1 467#endif
2c2d71f5 468 return (-1) ;
469
470 memset(&l_key, 0, sizeof(l_key));
471 l_key.data = key.data;
472 l_key.size = key.size;
473 memset(&l_value, 0, sizeof(l_value));
474 l_value.data = value.data;
475 l_value.size = value.size;
476
477 if ( temp_cursor->c_get(temp_cursor, &l_key, &l_value, DB_SET) != 0) {
478 (void)temp_cursor->c_close(temp_cursor);
479 return (-1);
480 }
481
482 status = temp_cursor->c_put(temp_cursor, &key, &value, flags);
483 (void)temp_cursor->c_close(temp_cursor);
484
485 return (status) ;
486 }
487
488
489 if (flagSet(flags, R_CURSOR)) {
490 return ((db->cursor)->c_put)(db->cursor, &key, &value, DB_CURRENT);
491 }
9d9477b1 492
2c2d71f5 493 if (flagSet(flags, R_SETCURSOR)) {
494 if ((db->dbp)->put(db->dbp, NULL, &key, &value, 0) != 0)
495 return -1 ;
496 return ((db->cursor)->c_get)(db->cursor, &key, &value, DB_SET_RANGE);
497
1f70e1ea 498 }
499
500 return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
501
502}
503
504#endif /* DB_VERSION_MAJOR */
505
a0d0e21e 506
507static int
73969f8f 508#ifdef AT_LEAST_DB_3_2
509
510#ifdef CAN_PROTOTYPE
511btree_compare(DB * db, const DBT *key1, const DBT *key2)
512#else
513btree_compare(db, key1, key2)
514DB * db ;
515const DBT * key1 ;
516const DBT * key2 ;
517#endif /* CAN_PROTOTYPE */
518
519#else /* Berkeley DB < 3.2 */
520
2c2d71f5 521#ifdef CAN_PROTOTYPE
b76802f5 522btree_compare(const DBT *key1, const DBT *key2)
2c2d71f5 523#else
524btree_compare(key1, key2)
525const DBT * key1 ;
526const DBT * key2 ;
527#endif
73969f8f 528
529#endif
530
a0d0e21e 531{
2c2d71f5 532#ifdef dTHX
b76802f5 533 dTHX;
2c2d71f5 534#endif
a0d0e21e 535 dSP ;
c5da4faf 536 char * data1, * data2 ;
a0d0e21e 537 int retval ;
538 int count ;
539
c5da4faf 540 data1 = (char *) key1->data ;
541 data2 = (char *) key2->data ;
cad2e5aa 542
2c2d71f5 543#ifndef newSVpvn
a0d0e21e 544 /* As newSVpv will assume that the data pointer is a null terminated C
545 string if the size parameter is 0, make sure that data points to an
546 empty string if the length is 0
547 */
548 if (key1->size == 0)
549 data1 = "" ;
550 if (key2->size == 0)
551 data2 = "" ;
2c2d71f5 552#endif
cad2e5aa 553
a0d0e21e 554 ENTER ;
555 SAVETMPS;
556
924508f0 557 PUSHMARK(SP) ;
558 EXTEND(SP,2) ;
2c2d71f5 559 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
560 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
a0d0e21e 561 PUTBACK ;
562
8e07c86e 563 count = perl_call_sv(CurrentDB->compare, G_SCALAR);
a0d0e21e 564
565 SPAGAIN ;
566
567 if (count != 1)
ff0cee69 568 croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
a0d0e21e 569
570 retval = POPi ;
571
572 PUTBACK ;
573 FREETMPS ;
574 LEAVE ;
575 return (retval) ;
576
577}
578
ecfc5424 579static DB_Prefix_t
73969f8f 580#ifdef AT_LEAST_DB_3_2
581
582#ifdef CAN_PROTOTYPE
583btree_prefix(DB * db, const DBT *key1, const DBT *key2)
584#else
585btree_prefix(db, key1, key2)
586Db * db ;
587const DBT * key1 ;
588const DBT * key2 ;
589#endif
590
591#else /* Berkeley DB < 3.2 */
592
2c2d71f5 593#ifdef CAN_PROTOTYPE
b76802f5 594btree_prefix(const DBT *key1, const DBT *key2)
2c2d71f5 595#else
596btree_prefix(key1, key2)
597const DBT * key1 ;
598const DBT * key2 ;
599#endif
73969f8f 600
601#endif
a0d0e21e 602{
2c2d71f5 603#ifdef dTHX
b76802f5 604 dTHX;
2c2d71f5 605#endif
a0d0e21e 606 dSP ;
c5da4faf 607 char * data1, * data2 ;
a0d0e21e 608 int retval ;
609 int count ;
610
c5da4faf 611 data1 = (char *) key1->data ;
612 data2 = (char *) key2->data ;
cad2e5aa 613
2c2d71f5 614#ifndef newSVpvn
a0d0e21e 615 /* As newSVpv will assume that the data pointer is a null terminated C
616 string if the size parameter is 0, make sure that data points to an
617 empty string if the length is 0
618 */
619 if (key1->size == 0)
620 data1 = "" ;
621 if (key2->size == 0)
622 data2 = "" ;
2c2d71f5 623#endif
cad2e5aa 624
a0d0e21e 625 ENTER ;
626 SAVETMPS;
627
924508f0 628 PUSHMARK(SP) ;
629 EXTEND(SP,2) ;
2c2d71f5 630 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
631 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
a0d0e21e 632 PUTBACK ;
633
8e07c86e 634 count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
a0d0e21e 635
636 SPAGAIN ;
637
638 if (count != 1)
ff0cee69 639 croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
a0d0e21e 640
641 retval = POPi ;
642
643 PUTBACK ;
644 FREETMPS ;
645 LEAVE ;
646
647 return (retval) ;
648}
649
3245f058 650
73969f8f 651#ifdef BERKELEY_DB_1
a56128cb 652# define HASH_CB_SIZE_TYPE size_t
653#else
654# define HASH_CB_SIZE_TYPE u_int32_t
655#endif
656
ecfc5424 657static DB_Hash_t
73969f8f 658#ifdef AT_LEAST_DB_3_2
659
660#ifdef CAN_PROTOTYPE
661hash_cb(DB * db, const void *data, u_int32_t size)
662#else
663hash_cb(db, data, size)
664DB * db ;
665const void * data ;
666HASH_CB_SIZE_TYPE size ;
667#endif
668
669#else /* Berkeley DB < 3.2 */
670
2c2d71f5 671#ifdef CAN_PROTOTYPE
a56128cb 672hash_cb(const void *data, HASH_CB_SIZE_TYPE size)
2c2d71f5 673#else
674hash_cb(data, size)
675const void * data ;
a56128cb 676HASH_CB_SIZE_TYPE size ;
2c2d71f5 677#endif
73969f8f 678
679#endif
a0d0e21e 680{
2c2d71f5 681#ifdef dTHX
b76802f5 682 dTHX;
2c2d71f5 683#endif
a0d0e21e 684 dSP ;
685 int retval ;
686 int count ;
cad2e5aa 687
2c2d71f5 688#ifndef newSVpvn
a0d0e21e 689 if (size == 0)
690 data = "" ;
2c2d71f5 691#endif
cad2e5aa 692
610ab055 693 /* DGH - Next two lines added to fix corrupted stack problem */
694 ENTER ;
695 SAVETMPS;
696
924508f0 697 PUSHMARK(SP) ;
610ab055 698
2c2d71f5 699 XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
a0d0e21e 700 PUTBACK ;
701
8e07c86e 702 count = perl_call_sv(CurrentDB->hash, G_SCALAR);
a0d0e21e 703
704 SPAGAIN ;
705
706 if (count != 1)
ff0cee69 707 croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
a0d0e21e 708
709 retval = POPi ;
710
711 PUTBACK ;
712 FREETMPS ;
713 LEAVE ;
714
715 return (retval) ;
716}
717
718
ccb44e3b 719#if defined(TRACE) && defined(BERKELEY_DB_1_OR_2)
a0d0e21e 720
721static void
2c2d71f5 722#ifdef CAN_PROTOTYPE
b76802f5 723PrintHash(INFO *hash)
2c2d71f5 724#else
725PrintHash(hash)
726INFO * hash ;
727#endif
a0d0e21e 728{
729 printf ("HASH Info\n") ;
1f70e1ea 730 printf (" hash = %s\n",
731 (hash->db_HA_hash != NULL ? "redefined" : "default")) ;
732 printf (" bsize = %d\n", hash->db_HA_bsize) ;
733 printf (" ffactor = %d\n", hash->db_HA_ffactor) ;
734 printf (" nelem = %d\n", hash->db_HA_nelem) ;
735 printf (" cachesize = %d\n", hash->db_HA_cachesize) ;
736 printf (" lorder = %d\n", hash->db_HA_lorder) ;
a0d0e21e 737
738}
739
740static void
2c2d71f5 741#ifdef CAN_PROTOTYPE
b76802f5 742PrintRecno(INFO *recno)
2c2d71f5 743#else
744PrintRecno(recno)
745INFO * recno ;
746#endif
a0d0e21e 747{
748 printf ("RECNO Info\n") ;
1f70e1ea 749 printf (" flags = %d\n", recno->db_RE_flags) ;
750 printf (" cachesize = %d\n", recno->db_RE_cachesize) ;
751 printf (" psize = %d\n", recno->db_RE_psize) ;
752 printf (" lorder = %d\n", recno->db_RE_lorder) ;
753 printf (" reclen = %ul\n", (unsigned long)recno->db_RE_reclen) ;
754 printf (" bval = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
755 printf (" bfname = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
a0d0e21e 756}
757
ff68c719 758static void
2c2d71f5 759#ifdef CAN_PROTOTYPE
b76802f5 760PrintBtree(INFO *btree)
2c2d71f5 761#else
762PrintBtree(btree)
763INFO * btree ;
764#endif
a0d0e21e 765{
766 printf ("BTREE Info\n") ;
1f70e1ea 767 printf (" compare = %s\n",
768 (btree->db_BT_compare ? "redefined" : "default")) ;
769 printf (" prefix = %s\n",
770 (btree->db_BT_prefix ? "redefined" : "default")) ;
771 printf (" flags = %d\n", btree->db_BT_flags) ;
772 printf (" cachesize = %d\n", btree->db_BT_cachesize) ;
773 printf (" psize = %d\n", btree->db_BT_psize) ;
774#ifndef DB_VERSION_MAJOR
775 printf (" maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
776 printf (" minkeypage = %d\n", btree->db_BT_minkeypage) ;
777#endif
778 printf (" lorder = %d\n", btree->db_BT_lorder) ;
a0d0e21e 779}
780
781#else
782
783#define PrintRecno(recno)
784#define PrintHash(hash)
785#define PrintBtree(btree)
786
787#endif /* TRACE */
788
789
790static I32
2c2d71f5 791#ifdef CAN_PROTOTYPE
b76802f5 792GetArrayLength(pTHX_ DB_File db)
2c2d71f5 793#else
794GetArrayLength(db)
795DB_File db ;
796#endif
a0d0e21e 797{
798 DBT key ;
799 DBT value ;
800 int RETVAL ;
801
ccb44e3b 802 DBT_clear(key) ;
803 DBT_clear(value) ;
1f70e1ea 804 RETVAL = do_SEQ(db, key, value, R_LAST) ;
a0d0e21e 805 if (RETVAL == 0)
806 RETVAL = *(I32 *)key.data ;
1f70e1ea 807 else /* No key means empty file */
a0d0e21e 808 RETVAL = 0 ;
809
a0b8c8c1 810 return ((I32)RETVAL) ;
a0d0e21e 811}
812
88108326 813static recno_t
2c2d71f5 814#ifdef CAN_PROTOTYPE
b76802f5 815GetRecnoKey(pTHX_ DB_File db, I32 value)
2c2d71f5 816#else
817GetRecnoKey(db, value)
818DB_File db ;
819I32 value ;
820#endif
88108326 821{
822 if (value < 0) {
823 /* Get the length of the array */
b76802f5 824 I32 length = GetArrayLength(aTHX_ db) ;
88108326 825
826 /* check for attempt to write before start of array */
827 if (length + value + 1 <= 0)
ff0cee69 828 croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
88108326 829
830 value = length + value + 1 ;
831 }
832 else
833 ++ value ;
834
835 return value ;
a0d0e21e 836}
837
ccb44e3b 838
a0d0e21e 839static DB_File
2c2d71f5 840#ifdef CAN_PROTOTYPE
b76802f5 841ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv)
2c2d71f5 842#else
843ParseOpenInfo(isHASH, name, flags, mode, sv)
844int isHASH ;
845char * name ;
846int flags ;
847int mode ;
848SV * sv ;
849#endif
a0d0e21e 850{
ccb44e3b 851
852#ifdef BERKELEY_DB_1_OR_2 /* Berkeley DB Version 1 or 2 */
853
a0d0e21e 854 SV ** svp;
855 HV * action ;
045291aa 856 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
a0d0e21e 857 void * openinfo = NULL ;
045291aa 858 INFO * info = &RETVAL->info ;
2d8e6c8d 859 STRLEN n_a;
1f70e1ea 860
861/* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
045291aa 862 Zero(RETVAL, 1, DB_File_type) ;
a0d0e21e 863
88108326 864 /* Default to HASH */
9fe6733a 865#ifdef DBM_FILTERING
866 RETVAL->filtering = 0 ;
867 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
868 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
869#endif /* DBM_FILTERING */
8e07c86e 870 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
871 RETVAL->type = DB_HASH ;
a0d0e21e 872
610ab055 873 /* DGH - Next line added to avoid SEGV on existing hash DB */
874 CurrentDB = RETVAL;
875
a0b8c8c1 876 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
877 RETVAL->in_memory = (name == NULL) ;
878
a0d0e21e 879 if (sv)
880 {
881 if (! SvROK(sv) )
882 croak ("type parameter is not a reference") ;
883
36477c24 884 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
885 if (svp && SvOK(*svp))
886 action = (HV*) SvRV(*svp) ;
887 else
888 croak("internal error") ;
610ab055 889
a0d0e21e 890 if (sv_isa(sv, "DB_File::HASHINFO"))
891 {
05475680 892
893 if (!isHASH)
894 croak("DB_File can only tie an associative array to a DB_HASH database") ;
895
8e07c86e 896 RETVAL->type = DB_HASH ;
610ab055 897 openinfo = (void*)info ;
a0d0e21e 898
899 svp = hv_fetch(action, "hash", 4, FALSE);
900
901 if (svp && SvOK(*svp))
902 {
1f70e1ea 903 info->db_HA_hash = hash_cb ;
8e07c86e 904 RETVAL->hash = newSVsv(*svp) ;
a0d0e21e 905 }
906 else
1f70e1ea 907 info->db_HA_hash = NULL ;
a0d0e21e 908
a0d0e21e 909 svp = hv_fetch(action, "ffactor", 7, FALSE);
1f70e1ea 910 info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
a0d0e21e 911
912 svp = hv_fetch(action, "nelem", 5, FALSE);
1f70e1ea 913 info->db_HA_nelem = svp ? SvIV(*svp) : 0;
a0d0e21e 914
1f70e1ea 915 svp = hv_fetch(action, "bsize", 5, FALSE);
916 info->db_HA_bsize = svp ? SvIV(*svp) : 0;
917
a0d0e21e 918 svp = hv_fetch(action, "cachesize", 9, FALSE);
1f70e1ea 919 info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
a0d0e21e 920
921 svp = hv_fetch(action, "lorder", 6, FALSE);
1f70e1ea 922 info->db_HA_lorder = svp ? SvIV(*svp) : 0;
a0d0e21e 923
924 PrintHash(info) ;
925 }
926 else if (sv_isa(sv, "DB_File::BTREEINFO"))
927 {
05475680 928 if (!isHASH)
929 croak("DB_File can only tie an associative array to a DB_BTREE database");
930
8e07c86e 931 RETVAL->type = DB_BTREE ;
610ab055 932 openinfo = (void*)info ;
a0d0e21e 933
934 svp = hv_fetch(action, "compare", 7, FALSE);
935 if (svp && SvOK(*svp))
936 {
1f70e1ea 937 info->db_BT_compare = btree_compare ;
8e07c86e 938 RETVAL->compare = newSVsv(*svp) ;
a0d0e21e 939 }
940 else
1f70e1ea 941 info->db_BT_compare = NULL ;
a0d0e21e 942
943 svp = hv_fetch(action, "prefix", 6, FALSE);
944 if (svp && SvOK(*svp))
945 {
1f70e1ea 946 info->db_BT_prefix = btree_prefix ;
8e07c86e 947 RETVAL->prefix = newSVsv(*svp) ;
a0d0e21e 948 }
949 else
1f70e1ea 950 info->db_BT_prefix = NULL ;
a0d0e21e 951
952 svp = hv_fetch(action, "flags", 5, FALSE);
1f70e1ea 953 info->db_BT_flags = svp ? SvIV(*svp) : 0;
a0d0e21e 954
955 svp = hv_fetch(action, "cachesize", 9, FALSE);
1f70e1ea 956 info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
a0d0e21e 957
1f70e1ea 958#ifndef DB_VERSION_MAJOR
a0d0e21e 959 svp = hv_fetch(action, "minkeypage", 10, FALSE);
610ab055 960 info->btree.minkeypage = svp ? SvIV(*svp) : 0;
a0d0e21e 961
962 svp = hv_fetch(action, "maxkeypage", 10, FALSE);
610ab055 963 info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
1f70e1ea 964#endif
a0d0e21e 965
966 svp = hv_fetch(action, "psize", 5, FALSE);
1f70e1ea 967 info->db_BT_psize = svp ? SvIV(*svp) : 0;
a0d0e21e 968
969 svp = hv_fetch(action, "lorder", 6, FALSE);
1f70e1ea 970 info->db_BT_lorder = svp ? SvIV(*svp) : 0;
a0d0e21e 971
972 PrintBtree(info) ;
973
974 }
975 else if (sv_isa(sv, "DB_File::RECNOINFO"))
976 {
05475680 977 if (isHASH)
978 croak("DB_File can only tie an array to a DB_RECNO database");
979
8e07c86e 980 RETVAL->type = DB_RECNO ;
610ab055 981 openinfo = (void *)info ;
a0d0e21e 982
1f70e1ea 983 info->db_RE_flags = 0 ;
984
a0d0e21e 985 svp = hv_fetch(action, "flags", 5, FALSE);
1f70e1ea 986 info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
987
988 svp = hv_fetch(action, "reclen", 6, FALSE);
989 info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
a0d0e21e 990
991 svp = hv_fetch(action, "cachesize", 9, FALSE);
1f70e1ea 992 info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
a0d0e21e 993
994 svp = hv_fetch(action, "psize", 5, FALSE);
1f70e1ea 995 info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
a0d0e21e 996
997 svp = hv_fetch(action, "lorder", 6, FALSE);
1f70e1ea 998 info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
999
1000#ifdef DB_VERSION_MAJOR
1001 info->re_source = name ;
1002 name = NULL ;
1003#endif
1004 svp = hv_fetch(action, "bfname", 6, FALSE);
1005 if (svp && SvOK(*svp)) {
2d8e6c8d 1006 char * ptr = SvPV(*svp,n_a) ;
1f70e1ea 1007#ifdef DB_VERSION_MAJOR
2d8e6c8d 1008 name = (char*) n_a ? ptr : NULL ;
1f70e1ea 1009#else
2d8e6c8d 1010 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
1f70e1ea 1011#endif
1012 }
1013 else
1014#ifdef DB_VERSION_MAJOR
1015 name = NULL ;
1016#else
1017 info->db_RE_bfname = NULL ;
1018#endif
a0d0e21e 1019
1020 svp = hv_fetch(action, "bval", 4, FALSE);
1f70e1ea 1021#ifdef DB_VERSION_MAJOR
a0d0e21e 1022 if (svp && SvOK(*svp))
1023 {
1f70e1ea 1024 int value ;
a0d0e21e 1025 if (SvPOK(*svp))
2d8e6c8d 1026 value = (int)*SvPV(*svp, n_a) ;
a0d0e21e 1027 else
1f70e1ea 1028 value = SvIV(*svp) ;
1029
1030 if (info->flags & DB_FIXEDLEN) {
1031 info->re_pad = value ;
1032 info->flags |= DB_PAD ;
1033 }
1034 else {
1035 info->re_delim = value ;
1036 info->flags |= DB_DELIMITER ;
1037 }
1038
1039 }
1040#else
1041 if (svp && SvOK(*svp))
1042 {
1043 if (SvPOK(*svp))
2d8e6c8d 1044 info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
1f70e1ea 1045 else
1046 info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
1047 DB_flags(info->flags, DB_DELIMITER) ;
1048
a0d0e21e 1049 }
1050 else
1051 {
1f70e1ea 1052 if (info->db_RE_flags & R_FIXEDLEN)
1053 info->db_RE_bval = (u_char) ' ' ;
a0d0e21e 1054 else
1f70e1ea 1055 info->db_RE_bval = (u_char) '\n' ;
1056 DB_flags(info->flags, DB_DELIMITER) ;
a0d0e21e 1057 }
1f70e1ea 1058#endif
a0d0e21e 1059
1f70e1ea 1060#ifdef DB_RENUMBER
1061 info->flags |= DB_RENUMBER ;
1062#endif
1063
a0d0e21e 1064 PrintRecno(info) ;
1065 }
1066 else
1067 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1068 }
1069
1070
88108326 1071 /* OS2 Specific Code */
1072#ifdef OS2
1073#ifdef __EMX__
1074 flags |= O_BINARY;
1075#endif /* __EMX__ */
1076#endif /* OS2 */
a0d0e21e 1077
1f70e1ea 1078#ifdef DB_VERSION_MAJOR
1079
1080 {
1081 int Flags = 0 ;
1082 int status ;
1083
1084 /* Map 1.x flags to 2.x flags */
1085 if ((flags & O_CREAT) == O_CREAT)
1086 Flags |= DB_CREATE ;
1087
1f70e1ea 1088#if O_RDONLY == 0
1089 if (flags == O_RDONLY)
1090#else
20896112 1091 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1f70e1ea 1092#endif
1093 Flags |= DB_RDONLY ;
1094
20896112 1095#ifdef O_TRUNC
1f70e1ea 1096 if ((flags & O_TRUNC) == O_TRUNC)
1097 Flags |= DB_TRUNCATE ;
1098#endif
1099
1100 status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
1101 if (status == 0)
6ca2e664 1102#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
1f70e1ea 1103 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
6ca2e664 1104#else
1105 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1106 0) ;
1107#endif
1f70e1ea 1108
1109 if (status)
1110 RETVAL->dbp = NULL ;
1111
1112 }
1113#else
ccb44e3b 1114
1115#if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2
1116 RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ;
1117#else
88108326 1118 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
ccb44e3b 1119#endif /* DB_LIBRARY_COMPATIBILITY_API */
1120
1f70e1ea 1121#endif
a0d0e21e 1122
1123 return (RETVAL) ;
ccb44e3b 1124
1125#else /* Berkeley DB Version > 2 */
1126
1127 SV ** svp;
1128 HV * action ;
1129 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
1130 DB * dbp ;
1131 STRLEN n_a;
1132 int status ;
1133
1134/* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
1135 Zero(RETVAL, 1, DB_File_type) ;
1136
1137 /* Default to HASH */
1138#ifdef DBM_FILTERING
1139 RETVAL->filtering = 0 ;
1140 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
1141 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
1142#endif /* DBM_FILTERING */
1143 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
1144 RETVAL->type = DB_HASH ;
1145
1146 /* DGH - Next line added to avoid SEGV on existing hash DB */
1147 CurrentDB = RETVAL;
1148
1149 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
1150 RETVAL->in_memory = (name == NULL) ;
1151
1152 status = db_create(&RETVAL->dbp, NULL,0) ;
1153 /* printf("db_create returned %d %s\n", status, db_strerror(status)) ; */
1154 if (status) {
1155 RETVAL->dbp = NULL ;
1156 return (RETVAL) ;
1157 }
1158 dbp = RETVAL->dbp ;
1159
1160 if (sv)
1161 {
1162 if (! SvROK(sv) )
1163 croak ("type parameter is not a reference") ;
1164
1165 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
1166 if (svp && SvOK(*svp))
1167 action = (HV*) SvRV(*svp) ;
1168 else
1169 croak("internal error") ;
1170
1171 if (sv_isa(sv, "DB_File::HASHINFO"))
1172 {
1173
1174 if (!isHASH)
1175 croak("DB_File can only tie an associative array to a DB_HASH database") ;
1176
1177 RETVAL->type = DB_HASH ;
1178
1179 svp = hv_fetch(action, "hash", 4, FALSE);
1180
1181 if (svp && SvOK(*svp))
1182 {
1183 (void)dbp->set_h_hash(dbp, hash_cb) ;
1184 RETVAL->hash = newSVsv(*svp) ;
1185 }
1186
1187 svp = hv_fetch(action, "ffactor", 7, FALSE);
1188 if (svp)
1189 (void)dbp->set_h_ffactor(dbp, SvIV(*svp)) ;
1190
1191 svp = hv_fetch(action, "nelem", 5, FALSE);
1192 if (svp)
1193 (void)dbp->set_h_nelem(dbp, SvIV(*svp)) ;
1194
1195 svp = hv_fetch(action, "bsize", 5, FALSE);
1196 if (svp)
1197 (void)dbp->set_pagesize(dbp, SvIV(*svp));
1198
1199 svp = hv_fetch(action, "cachesize", 9, FALSE);
1200 if (svp)
1201 (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1202
1203 svp = hv_fetch(action, "lorder", 6, FALSE);
1204 if (svp)
1205 (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
1206
1207 PrintHash(info) ;
1208 }
1209 else if (sv_isa(sv, "DB_File::BTREEINFO"))
1210 {
1211 if (!isHASH)
1212 croak("DB_File can only tie an associative array to a DB_BTREE database");
1213
1214 RETVAL->type = DB_BTREE ;
1215
1216 svp = hv_fetch(action, "compare", 7, FALSE);
1217 if (svp && SvOK(*svp))
1218 {
1219 (void)dbp->set_bt_compare(dbp, btree_compare) ;
1220 RETVAL->compare = newSVsv(*svp) ;
1221 }
1222
1223 svp = hv_fetch(action, "prefix", 6, FALSE);
1224 if (svp && SvOK(*svp))
1225 {
1226 (void)dbp->set_bt_prefix(dbp, btree_prefix) ;
1227 RETVAL->prefix = newSVsv(*svp) ;
1228 }
1229
1230 svp = hv_fetch(action, "flags", 5, FALSE);
1231 if (svp)
1232 (void)dbp->set_flags(dbp, SvIV(*svp)) ;
1233
1234 svp = hv_fetch(action, "cachesize", 9, FALSE);
1235 if (svp)
1236 (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1237
1238 svp = hv_fetch(action, "psize", 5, FALSE);
1239 if (svp)
1240 (void)dbp->set_pagesize(dbp, SvIV(*svp)) ;
1241
1242 svp = hv_fetch(action, "lorder", 6, FALSE);
1243 if (svp)
1244 (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
1245
1246 PrintBtree(info) ;
1247
1248 }
1249 else if (sv_isa(sv, "DB_File::RECNOINFO"))
1250 {
1251 int fixed = FALSE ;
1252
1253 if (isHASH)
1254 croak("DB_File can only tie an array to a DB_RECNO database");
1255
1256 RETVAL->type = DB_RECNO ;
1257
1258 svp = hv_fetch(action, "flags", 5, FALSE);
1259 if (svp) {
1260 int flags = SvIV(*svp) ;
1261 /* remove FIXDLEN, if present */
1262 if (flags & DB_FIXEDLEN) {
1263 fixed = TRUE ;
1264 flags &= ~DB_FIXEDLEN ;
1265 }
1266 }
1267
1268 svp = hv_fetch(action, "cachesize", 9, FALSE);
1269 if (svp) {
1270 status = dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1271 }
1272
1273 svp = hv_fetch(action, "psize", 5, FALSE);
1274 if (svp) {
1275 status = dbp->set_pagesize(dbp, SvIV(*svp)) ;
1276 }
1277
1278 svp = hv_fetch(action, "lorder", 6, FALSE);
1279 if (svp) {
1280 status = dbp->set_lorder(dbp, SvIV(*svp)) ;
1281 }
1282
1283 svp = hv_fetch(action, "bval", 4, FALSE);
1284 if (svp && SvOK(*svp))
1285 {
1286 int value ;
1287 if (SvPOK(*svp))
1288 value = (int)*SvPV(*svp, n_a) ;
1289 else
1290 value = SvIV(*svp) ;
1291
1292 if (fixed) {
1293 status = dbp->set_re_pad(dbp, value) ;
1294 }
1295 else {
1296 status = dbp->set_re_delim(dbp, value) ;
1297 }
1298
1299 }
1300
1301 if (fixed) {
1302 svp = hv_fetch(action, "reclen", 6, FALSE);
1303 if (svp) {
1304 u_int32_t len = (u_int32_t)SvIV(*svp) ;
1305 status = dbp->set_re_len(dbp, len) ;
1306 }
1307 }
1308
1309 if (name != NULL) {
1310 status = dbp->set_re_source(dbp, name) ;
1311 name = NULL ;
1312 }
1313
1314 svp = hv_fetch(action, "bfname", 6, FALSE);
1315 if (svp && SvOK(*svp)) {
1316 char * ptr = SvPV(*svp,n_a) ;
1317 name = (char*) n_a ? ptr : NULL ;
1318 }
1319 else
1320 name = NULL ;
1321
1322
1323 status = dbp->set_flags(dbp, DB_RENUMBER) ;
1324
1325 if (flags){
1326 (void)dbp->set_flags(dbp, flags) ;
1327 }
1328 PrintRecno(info) ;
1329 }
1330 else
1331 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1332 }
1333
1334 {
1335 int Flags = 0 ;
1336 int status ;
1337
1338 /* Map 1.x flags to 3.x flags */
1339 if ((flags & O_CREAT) == O_CREAT)
1340 Flags |= DB_CREATE ;
1341
1342#if O_RDONLY == 0
1343 if (flags == O_RDONLY)
1344#else
1345 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1346#endif
1347 Flags |= DB_RDONLY ;
1348
1349#ifdef O_TRUNC
1350 if ((flags & O_TRUNC) == O_TRUNC)
1351 Flags |= DB_TRUNCATE ;
1352#endif
1353
3245f058 1354 status = (RETVAL->dbp->open)(RETVAL->dbp, name, NULL, RETVAL->type,
ccb44e3b 1355 Flags, mode) ;
1356 /* printf("open returned %d %s\n", status, db_strerror(status)) ; */
1357
1358 if (status == 0)
1359 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1360 0) ;
1361 /* printf("cursor returned %d %s\n", status, db_strerror(status)) ; */
1362
1363 if (status)
1364 RETVAL->dbp = NULL ;
1365
1366 }
1367
1368 return (RETVAL) ;
1369
1370#endif /* Berkeley DB Version > 2 */
1371
1372} /* ParseOpenInfo */
a0d0e21e 1373
1374
a0d0e21e 1375static double
2c2d71f5 1376#ifdef CAN_PROTOTYPE
b76802f5 1377constant(char *name, int arg)
2c2d71f5 1378#else
1379constant(name, arg)
1380char *name;
1381int arg;
1382#endif
a0d0e21e 1383{
1384 errno = 0;
1385 switch (*name) {
1386 case 'A':
1387 break;
1388 case 'B':
1389 if (strEQ(name, "BTREEMAGIC"))
1390#ifdef BTREEMAGIC
1391 return BTREEMAGIC;
1392#else
1393 goto not_there;
1394#endif
1395 if (strEQ(name, "BTREEVERSION"))
1396#ifdef BTREEVERSION
1397 return BTREEVERSION;
1398#else
1399 goto not_there;
1400#endif
1401 break;
1402 case 'C':
1403 break;
1404 case 'D':
1405 if (strEQ(name, "DB_LOCK"))
1406#ifdef DB_LOCK
1407 return DB_LOCK;
1408#else
1409 goto not_there;
1410#endif
1411 if (strEQ(name, "DB_SHMEM"))
1412#ifdef DB_SHMEM
1413 return DB_SHMEM;
1414#else
1415 goto not_there;
1416#endif
1417 if (strEQ(name, "DB_TXN"))
1418#ifdef DB_TXN
1419 return (U32)DB_TXN;
1420#else
1421 goto not_there;
1422#endif
1423 break;
1424 case 'E':
1425 break;
1426 case 'F':
1427 break;
1428 case 'G':
1429 break;
1430 case 'H':
1431 if (strEQ(name, "HASHMAGIC"))
1432#ifdef HASHMAGIC
1433 return HASHMAGIC;
1434#else
1435 goto not_there;
1436#endif
1437 if (strEQ(name, "HASHVERSION"))
1438#ifdef HASHVERSION
1439 return HASHVERSION;
1440#else
1441 goto not_there;
1442#endif
1443 break;
1444 case 'I':
1445 break;
1446 case 'J':
1447 break;
1448 case 'K':
1449 break;
1450 case 'L':
1451 break;
1452 case 'M':
1453 if (strEQ(name, "MAX_PAGE_NUMBER"))
1454#ifdef MAX_PAGE_NUMBER
1455 return (U32)MAX_PAGE_NUMBER;
1456#else
1457 goto not_there;
1458#endif
1459 if (strEQ(name, "MAX_PAGE_OFFSET"))
1460#ifdef MAX_PAGE_OFFSET
1461 return MAX_PAGE_OFFSET;
1462#else
1463 goto not_there;
1464#endif
1465 if (strEQ(name, "MAX_REC_NUMBER"))
1466#ifdef MAX_REC_NUMBER
1467 return (U32)MAX_REC_NUMBER;
1468#else
1469 goto not_there;
1470#endif
1471 break;
1472 case 'N':
1473 break;
1474 case 'O':
1475 break;
1476 case 'P':
1477 break;
1478 case 'Q':
1479 break;
1480 case 'R':
1481 if (strEQ(name, "RET_ERROR"))
1482#ifdef RET_ERROR
1483 return RET_ERROR;
1484#else
1485 goto not_there;
1486#endif
1487 if (strEQ(name, "RET_SPECIAL"))
1488#ifdef RET_SPECIAL
1489 return RET_SPECIAL;
1490#else
1491 goto not_there;
1492#endif
1493 if (strEQ(name, "RET_SUCCESS"))
1494#ifdef RET_SUCCESS
1495 return RET_SUCCESS;
1496#else
1497 goto not_there;
1498#endif
1499 if (strEQ(name, "R_CURSOR"))
1500#ifdef R_CURSOR
1501 return R_CURSOR;
1502#else
1503 goto not_there;
1504#endif
1505 if (strEQ(name, "R_DUP"))
1506#ifdef R_DUP
1507 return R_DUP;
1508#else
1509 goto not_there;
1510#endif
1511 if (strEQ(name, "R_FIRST"))
1512#ifdef R_FIRST
1513 return R_FIRST;
1514#else
1515 goto not_there;
1516#endif
1517 if (strEQ(name, "R_FIXEDLEN"))
1518#ifdef R_FIXEDLEN
1519 return R_FIXEDLEN;
1520#else
1521 goto not_there;
1522#endif
1523 if (strEQ(name, "R_IAFTER"))
1524#ifdef R_IAFTER
1525 return R_IAFTER;
1526#else
1527 goto not_there;
1528#endif
1529 if (strEQ(name, "R_IBEFORE"))
1530#ifdef R_IBEFORE
1531 return R_IBEFORE;
1532#else
1533 goto not_there;
1534#endif
1535 if (strEQ(name, "R_LAST"))
1536#ifdef R_LAST
1537 return R_LAST;
1538#else
1539 goto not_there;
1540#endif
1541 if (strEQ(name, "R_NEXT"))
1542#ifdef R_NEXT
1543 return R_NEXT;
1544#else
1545 goto not_there;
1546#endif
1547 if (strEQ(name, "R_NOKEY"))
1548#ifdef R_NOKEY
1549 return R_NOKEY;
1550#else
1551 goto not_there;
1552#endif
1553 if (strEQ(name, "R_NOOVERWRITE"))
1554#ifdef R_NOOVERWRITE
1555 return R_NOOVERWRITE;
1556#else
1557 goto not_there;
1558#endif
1559 if (strEQ(name, "R_PREV"))
1560#ifdef R_PREV
1561 return R_PREV;
1562#else
1563 goto not_there;
1564#endif
1565 if (strEQ(name, "R_RECNOSYNC"))
1566#ifdef R_RECNOSYNC
1567 return R_RECNOSYNC;
1568#else
1569 goto not_there;
1570#endif
1571 if (strEQ(name, "R_SETCURSOR"))
1572#ifdef R_SETCURSOR
1573 return R_SETCURSOR;
1574#else
1575 goto not_there;
1576#endif
1577 if (strEQ(name, "R_SNAPSHOT"))
1578#ifdef R_SNAPSHOT
1579 return R_SNAPSHOT;
1580#else
1581 goto not_there;
1582#endif
1583 break;
1584 case 'S':
1585 break;
1586 case 'T':
1587 break;
1588 case 'U':
1589 break;
1590 case 'V':
1591 break;
1592 case 'W':
1593 break;
1594 case 'X':
1595 break;
1596 case 'Y':
1597 break;
1598 case 'Z':
1599 break;
1600 case '_':
a0d0e21e 1601 break;
1602 }
1603 errno = EINVAL;
1604 return 0;
1605
1606not_there:
1607 errno = ENOENT;
1608 return 0;
1609}
1610
1611MODULE = DB_File PACKAGE = DB_File PREFIX = db_
1612
1f70e1ea 1613BOOT:
1614 {
ccb44e3b 1615 __getBerkeleyDBInfo() ;
1f70e1ea 1616
ccb44e3b 1617 DBT_clear(empty) ;
1f70e1ea 1618 empty.data = &zero ;
1619 empty.size = sizeof(recno_t) ;
1f70e1ea 1620 }
1621
a0d0e21e 1622double
1623constant(name,arg)
1624 char * name
1625 int arg
1626
1627
1628DB_File
05475680 1629db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
1630 int isHASH
a0d0e21e 1631 char * dbtype
1632 int flags
1633 int mode
1634 CODE:
1635 {
1636 char * name = (char *) NULL ;
1637 SV * sv = (SV *) NULL ;
2d8e6c8d 1638 STRLEN n_a;
a0d0e21e 1639
05475680 1640 if (items >= 3 && SvOK(ST(2)))
2d8e6c8d 1641 name = (char*) SvPV(ST(2), n_a) ;
a0d0e21e 1642
05475680 1643 if (items == 6)
1644 sv = ST(5) ;
a0d0e21e 1645
b76802f5 1646 RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
4633a7c4 1647 if (RETVAL->dbp == NULL)
1648 RETVAL = NULL ;
a0d0e21e 1649 }
1650 OUTPUT:
1651 RETVAL
1652
a0d0e21e 1653int
1654db_DESTROY(db)
1655 DB_File db
8e07c86e 1656 INIT:
1657 CurrentDB = db ;
1658 CLEANUP:
1659 if (db->hash)
1660 SvREFCNT_dec(db->hash) ;
1661 if (db->compare)
1662 SvREFCNT_dec(db->compare) ;
1663 if (db->prefix)
1664 SvREFCNT_dec(db->prefix) ;
9fe6733a 1665#ifdef DBM_FILTERING
1666 if (db->filter_fetch_key)
1667 SvREFCNT_dec(db->filter_fetch_key) ;
1668 if (db->filter_store_key)
1669 SvREFCNT_dec(db->filter_store_key) ;
1670 if (db->filter_fetch_value)
1671 SvREFCNT_dec(db->filter_fetch_value) ;
1672 if (db->filter_store_value)
1673 SvREFCNT_dec(db->filter_store_value) ;
1674#endif /* DBM_FILTERING */
eb99164f 1675 safefree(db) ;
1f70e1ea 1676#ifdef DB_VERSION_MAJOR
1677 if (RETVAL > 0)
1678 RETVAL = -1 ;
1679#endif
a0d0e21e 1680
1681
1682int
1683db_DELETE(db, key, flags=0)
1684 DB_File db
1685 DBTKEY key
1686 u_int flags
8e07c86e 1687 INIT:
1688 CurrentDB = db ;
a0d0e21e 1689
f6b705ef 1690
1691int
1692db_EXISTS(db, key)
1693 DB_File db
1694 DBTKEY key
1695 CODE:
1696 {
1697 DBT value ;
1698
ccb44e3b 1699 DBT_clear(value) ;
f6b705ef 1700 CurrentDB = db ;
1f70e1ea 1701 RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
f6b705ef 1702 }
1703 OUTPUT:
1704 RETVAL
1705
a0d0e21e 1706int
1707db_FETCH(db, key, flags=0)
1708 DB_File db
1709 DBTKEY key
1710 u_int flags
1711 CODE:
1712 {
1f70e1ea 1713 DBT value ;
a0d0e21e 1714
ccb44e3b 1715 DBT_clear(value) ;
8e07c86e 1716 CurrentDB = db ;
1f70e1ea 1717 /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */
1718 RETVAL = db_get(db, key, value, flags) ;
a0d0e21e 1719 ST(0) = sv_newmortal();
a9fd575d 1720 OutputValue(ST(0), value)
a0d0e21e 1721 }
1722
1723int
1724db_STORE(db, key, value, flags=0)
1725 DB_File db
1726 DBTKEY key
1727 DBT value
1728 u_int flags
8e07c86e 1729 INIT:
1730 CurrentDB = db ;
a0d0e21e 1731
1732
1733int
1734db_FIRSTKEY(db)
1735 DB_File db
1736 CODE:
1737 {
1f70e1ea 1738 DBTKEY key ;
a0d0e21e 1739 DBT value ;
1740
ccb44e3b 1741 DBT_clear(key) ;
1742 DBT_clear(value) ;
8e07c86e 1743 CurrentDB = db ;
1f70e1ea 1744 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
a0d0e21e 1745 ST(0) = sv_newmortal();
a9fd575d 1746 OutputKey(ST(0), key) ;
a0d0e21e 1747 }
1748
1749int
1750db_NEXTKEY(db, key)
1751 DB_File db
1752 DBTKEY key
1753 CODE:
1754 {
1755 DBT value ;
1756
ccb44e3b 1757 DBT_clear(value) ;
8e07c86e 1758 CurrentDB = db ;
1f70e1ea 1759 RETVAL = do_SEQ(db, key, value, R_NEXT) ;
a0d0e21e 1760 ST(0) = sv_newmortal();
a9fd575d 1761 OutputKey(ST(0), key) ;
a0d0e21e 1762 }
1763
1764#
1765# These would be nice for RECNO
1766#
1767
1768int
1769unshift(db, ...)
1770 DB_File db
045291aa 1771 ALIAS: UNSHIFT = 1
a0d0e21e 1772 CODE:
1773 {
1774 DBTKEY key ;
1775 DBT value ;
1776 int i ;
1777 int One ;
2d8e6c8d 1778 STRLEN n_a;
a0d0e21e 1779
ccb44e3b 1780 DBT_clear(key) ;
1781 DBT_clear(value) ;
8e07c86e 1782 CurrentDB = db ;
1f70e1ea 1783#ifdef DB_VERSION_MAJOR
1784 /* get the first value */
1785 RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1786 RETVAL = 0 ;
1787#else
a0d0e21e 1788 RETVAL = -1 ;
1f70e1ea 1789#endif
a0d0e21e 1790 for (i = items-1 ; i > 0 ; --i)
1791 {
2d8e6c8d 1792 value.data = SvPV(ST(i), n_a) ;
1793 value.size = n_a ;
a0d0e21e 1794 One = 1 ;
1795 key.data = &One ;
1796 key.size = sizeof(int) ;
1f70e1ea 1797#ifdef DB_VERSION_MAJOR
1798 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1799#else
b7953727 1800 RETVAL = (db->dbp->put)(db->dbp, &key, &value, R_IBEFORE) ;
1f70e1ea 1801#endif
a0d0e21e 1802 if (RETVAL != 0)
1803 break;
1804 }
1805 }
1806 OUTPUT:
1807 RETVAL
1808
1809I32
1810pop(db)
1811 DB_File db
045291aa 1812 ALIAS: POP = 1
a0d0e21e 1813 CODE:
1814 {
1815 DBTKEY key ;
1816 DBT value ;
1817
ccb44e3b 1818 DBT_clear(key) ;
1819 DBT_clear(value) ;
8e07c86e 1820 CurrentDB = db ;
1f70e1ea 1821
a0d0e21e 1822 /* First get the final value */
1f70e1ea 1823 RETVAL = do_SEQ(db, key, value, R_LAST) ;
a0d0e21e 1824 ST(0) = sv_newmortal();
1825 /* Now delete it */
1826 if (RETVAL == 0)
1827 {
f6b705ef 1828 /* the call to del will trash value, so take a copy now */
a9fd575d 1829 OutputValue(ST(0), value) ;
1f70e1ea 1830 RETVAL = db_del(db, key, R_CURSOR) ;
f6b705ef 1831 if (RETVAL != 0)
6b88bc9c 1832 sv_setsv(ST(0), &PL_sv_undef);
a0d0e21e 1833 }
1834 }
1835
1836I32
1837shift(db)
1838 DB_File db
045291aa 1839 ALIAS: SHIFT = 1
a0d0e21e 1840 CODE:
1841 {
a0d0e21e 1842 DBT value ;
f6b705ef 1843 DBTKEY key ;
a0d0e21e 1844
ccb44e3b 1845 DBT_clear(key) ;
1846 DBT_clear(value) ;
8e07c86e 1847 CurrentDB = db ;
a0d0e21e 1848 /* get the first value */
1f70e1ea 1849 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
a0d0e21e 1850 ST(0) = sv_newmortal();
1851 /* Now delete it */
1852 if (RETVAL == 0)
1853 {
f6b705ef 1854 /* the call to del will trash value, so take a copy now */
a9fd575d 1855 OutputValue(ST(0), value) ;
1f70e1ea 1856 RETVAL = db_del(db, key, R_CURSOR) ;
f6b705ef 1857 if (RETVAL != 0)
6b88bc9c 1858 sv_setsv (ST(0), &PL_sv_undef) ;
a0d0e21e 1859 }
1860 }
1861
1862
1863I32
1864push(db, ...)
1865 DB_File db
045291aa 1866 ALIAS: PUSH = 1
a0d0e21e 1867 CODE:
1868 {
1869 DBTKEY key ;
1870 DBT value ;
4633a7c4 1871 DB * Db = db->dbp ;
a0d0e21e 1872 int i ;
2d8e6c8d 1873 STRLEN n_a;
ccb44e3b 1874 int keyval ;
a0d0e21e 1875
1f70e1ea 1876 DBT_flags(key) ;
1877 DBT_flags(value) ;
8e07c86e 1878 CurrentDB = db ;
ca63f0d2 1879 /* Set the Cursor to the Last element */
1880 RETVAL = do_SEQ(db, key, value, R_LAST) ;
ccb44e3b 1881#ifndef DB_VERSION_MAJOR
ca63f0d2 1882 if (RETVAL >= 0)
ccb44e3b 1883#endif
ca63f0d2 1884 {
ccb44e3b 1885 if (RETVAL == 0)
1886 keyval = *(int*)key.data ;
1887 else
1888 keyval = 0 ;
1889 for (i = 1 ; i < items ; ++i)
8e07c86e 1890 {
2d8e6c8d 1891 value.data = SvPV(ST(i), n_a) ;
1892 value.size = n_a ;
ccb44e3b 1893 ++ keyval ;
1894 key.data = &keyval ;
1895 key.size = sizeof(int) ;
1896 RETVAL = (Db->put)(Db, TXN &key, &value, 0) ;
8e07c86e 1897 if (RETVAL != 0)
1898 break;
1899 }
a0d0e21e 1900 }
1901 }
1902 OUTPUT:
1903 RETVAL
1904
a0d0e21e 1905I32
1906length(db)
1907 DB_File db
045291aa 1908 ALIAS: FETCHSIZE = 1
a0d0e21e 1909 CODE:
8e07c86e 1910 CurrentDB = db ;
b76802f5 1911 RETVAL = GetArrayLength(aTHX_ db) ;
a0d0e21e 1912 OUTPUT:
1913 RETVAL
1914
1915
1916#
1917# Now provide an interface to the rest of the DB functionality
1918#
1919
1920int
1921db_del(db, key, flags=0)
1922 DB_File db
1923 DBTKEY key
1924 u_int flags
1f70e1ea 1925 CODE:
8e07c86e 1926 CurrentDB = db ;
1f70e1ea 1927 RETVAL = db_del(db, key, flags) ;
1928#ifdef DB_VERSION_MAJOR
1929 if (RETVAL > 0)
1930 RETVAL = -1 ;
1931 else if (RETVAL == DB_NOTFOUND)
1932 RETVAL = 1 ;
1933#endif
1934 OUTPUT:
1935 RETVAL
a0d0e21e 1936
1937
1938int
1939db_get(db, key, value, flags=0)
1940 DB_File db
1941 DBTKEY key
a6ed719b 1942 DBT value = NO_INIT
a0d0e21e 1943 u_int flags
1f70e1ea 1944 CODE:
8e07c86e 1945 CurrentDB = db ;
ccb44e3b 1946 DBT_clear(value) ;
1f70e1ea 1947 RETVAL = db_get(db, key, value, flags) ;
1948#ifdef DB_VERSION_MAJOR
1949 if (RETVAL > 0)
1950 RETVAL = -1 ;
1951 else if (RETVAL == DB_NOTFOUND)
1952 RETVAL = 1 ;
1953#endif
a0d0e21e 1954 OUTPUT:
1f70e1ea 1955 RETVAL
a0d0e21e 1956 value
1957
1958int
1959db_put(db, key, value, flags=0)
1960 DB_File db
1961 DBTKEY key
1962 DBT value
1963 u_int flags
1f70e1ea 1964 CODE:
8e07c86e 1965 CurrentDB = db ;
1f70e1ea 1966 RETVAL = db_put(db, key, value, flags) ;
1967#ifdef DB_VERSION_MAJOR
1968 if (RETVAL > 0)
1969 RETVAL = -1 ;
1970 else if (RETVAL == DB_KEYEXIST)
1971 RETVAL = 1 ;
1972#endif
a0d0e21e 1973 OUTPUT:
1f70e1ea 1974 RETVAL
9d9477b1 1975 key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
a0d0e21e 1976
1977int
1978db_fd(db)
1979 DB_File db
1f70e1ea 1980 int status = 0 ;
1981 CODE:
8e07c86e 1982 CurrentDB = db ;
1f70e1ea 1983#ifdef DB_VERSION_MAJOR
1984 RETVAL = -1 ;
1985 status = (db->in_memory
1986 ? -1
1987 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
1988 if (status != 0)
1989 RETVAL = -1 ;
1990#else
1991 RETVAL = (db->in_memory
1992 ? -1
1993 : ((db->dbp)->fd)(db->dbp) ) ;
1994#endif
1995 OUTPUT:
1996 RETVAL
a0d0e21e 1997
1998int
1999db_sync(db, flags=0)
2000 DB_File db
2001 u_int flags
1f70e1ea 2002 CODE:
8e07c86e 2003 CurrentDB = db ;
1f70e1ea 2004 RETVAL = db_sync(db, flags) ;
2005#ifdef DB_VERSION_MAJOR
2006 if (RETVAL > 0)
2007 RETVAL = -1 ;
2008#endif
2009 OUTPUT:
2010 RETVAL
a0d0e21e 2011
2012
2013int
2014db_seq(db, key, value, flags)
2015 DB_File db
2016 DBTKEY key
a6ed719b 2017 DBT value = NO_INIT
a0d0e21e 2018 u_int flags
1f70e1ea 2019 CODE:
8e07c86e 2020 CurrentDB = db ;
ccb44e3b 2021 DBT_clear(value) ;
1f70e1ea 2022 RETVAL = db_seq(db, key, value, flags);
2023#ifdef DB_VERSION_MAJOR
2024 if (RETVAL > 0)
2025 RETVAL = -1 ;
2026 else if (RETVAL == DB_NOTFOUND)
2027 RETVAL = 1 ;
2028#endif
a0d0e21e 2029 OUTPUT:
1f70e1ea 2030 RETVAL
a0d0e21e 2031 key
2032 value
610ab055 2033
9fe6733a 2034#ifdef DBM_FILTERING
2035
2036#define setFilter(type) \
2037 { \
2038 if (db->type) \
cad2e5aa 2039 RETVAL = sv_mortalcopy(db->type) ; \
2040 ST(0) = RETVAL ; \
9fe6733a 2041 if (db->type && (code == &PL_sv_undef)) { \
2042 SvREFCNT_dec(db->type) ; \
2043 db->type = NULL ; \
2044 } \
2045 else if (code) { \
2046 if (db->type) \
2047 sv_setsv(db->type, code) ; \
2048 else \
2049 db->type = newSVsv(code) ; \
2050 } \
2051 }
2052
2053
2054SV *
2055filter_fetch_key(db, code)
2056 DB_File db
2057 SV * code
2058 SV * RETVAL = &PL_sv_undef ;
2059 CODE:
2060 setFilter(filter_fetch_key) ;
9fe6733a 2061
2062SV *
2063filter_store_key(db, code)
2064 DB_File db
2065 SV * code
2066 SV * RETVAL = &PL_sv_undef ;
2067 CODE:
2068 setFilter(filter_store_key) ;
9fe6733a 2069
2070SV *
2071filter_fetch_value(db, code)
2072 DB_File db
2073 SV * code
2074 SV * RETVAL = &PL_sv_undef ;
2075 CODE:
2076 setFilter(filter_fetch_value) ;
9fe6733a 2077
2078SV *
2079filter_store_value(db, code)
2080 DB_File db
2081 SV * code
2082 SV * RETVAL = &PL_sv_undef ;
2083 CODE:
2084 setFilter(filter_store_value) ;
9fe6733a 2085
2086#endif /* DBM_FILTERING */
Unnamed repository; edit this file to name it for gitweb.