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