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