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