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