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