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