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