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