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