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