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