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