projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Re: [ID 20011025.054] Segmentation fault when using the function read not correctly
[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)
3d7a97b7 1256 (void)dbp->set_flags(dbp, (u_int32_t)SvIV(*svp)) ;
ccb44e3b 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
0bf2e707 1780 DBTKEY key = NO_INIT
c6c619a9 1781 PREINIT:
1782 int RETVAL;
a0d0e21e 1783 CODE:
1784 {
1785 DBT value ;
1786
0bf2e707 1787 DBT_clear(key) ;
ccb44e3b 1788 DBT_clear(value) ;
8e07c86e 1789 CurrentDB = db ;
1f70e1ea 1790 RETVAL = do_SEQ(db, key, value, R_NEXT) ;
a0d0e21e 1791 ST(0) = sv_newmortal();
a9fd575d 1792 OutputKey(ST(0), key) ;
a0d0e21e 1793 }
1794
1795#
1796# These would be nice for RECNO
1797#
1798
1799int
1800unshift(db, ...)
1801 DB_File db
045291aa 1802 ALIAS: UNSHIFT = 1
a0d0e21e 1803 CODE:
1804 {
1805 DBTKEY key ;
1806 DBT value ;
1807 int i ;
1808 int One ;
2d8e6c8d 1809 STRLEN n_a;
a0d0e21e 1810
ccb44e3b 1811 DBT_clear(key) ;
1812 DBT_clear(value) ;
8e07c86e 1813 CurrentDB = db ;
1f70e1ea 1814#ifdef DB_VERSION_MAJOR
1815 /* get the first value */
1816 RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1817 RETVAL = 0 ;
1818#else
a0d0e21e 1819 RETVAL = -1 ;
1f70e1ea 1820#endif
a0d0e21e 1821 for (i = items-1 ; i > 0 ; --i)
1822 {
2d8e6c8d 1823 value.data = SvPV(ST(i), n_a) ;
1824 value.size = n_a ;
a0d0e21e 1825 One = 1 ;
1826 key.data = &One ;
1827 key.size = sizeof(int) ;
1f70e1ea 1828#ifdef DB_VERSION_MAJOR
1829 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1830#else
b7953727 1831 RETVAL = (db->dbp->put)(db->dbp, &key, &value, R_IBEFORE) ;
1f70e1ea 1832#endif
a0d0e21e 1833 if (RETVAL != 0)
1834 break;
1835 }
1836 }
1837 OUTPUT:
1838 RETVAL
1839
c6c619a9 1840void
a0d0e21e 1841pop(db)
1842 DB_File db
045291aa 1843 ALIAS: POP = 1
c6c619a9 1844 PREINIT:
1845 I32 RETVAL;
a0d0e21e 1846 CODE:
1847 {
1848 DBTKEY key ;
1849 DBT value ;
1850
ccb44e3b 1851 DBT_clear(key) ;
1852 DBT_clear(value) ;
8e07c86e 1853 CurrentDB = db ;
1f70e1ea 1854
a0d0e21e 1855 /* First get the final value */
1f70e1ea 1856 RETVAL = do_SEQ(db, key, value, R_LAST) ;
a0d0e21e 1857 ST(0) = sv_newmortal();
1858 /* Now delete it */
1859 if (RETVAL == 0)
1860 {
f6b705ef 1861 /* the call to del will trash value, so take a copy now */
a9fd575d 1862 OutputValue(ST(0), value) ;
1f70e1ea 1863 RETVAL = db_del(db, key, R_CURSOR) ;
f6b705ef 1864 if (RETVAL != 0)
6b88bc9c 1865 sv_setsv(ST(0), &PL_sv_undef);
a0d0e21e 1866 }
1867 }
1868
c6c619a9 1869void
a0d0e21e 1870shift(db)
1871 DB_File db
045291aa 1872 ALIAS: SHIFT = 1
c6c619a9 1873 PREINIT:
1874 I32 RETVAL;
a0d0e21e 1875 CODE:
1876 {
a0d0e21e 1877 DBT value ;
f6b705ef 1878 DBTKEY key ;
a0d0e21e 1879
ccb44e3b 1880 DBT_clear(key) ;
1881 DBT_clear(value) ;
8e07c86e 1882 CurrentDB = db ;
a0d0e21e 1883 /* get the first value */
1f70e1ea 1884 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
a0d0e21e 1885 ST(0) = sv_newmortal();
1886 /* Now delete it */
1887 if (RETVAL == 0)
1888 {
f6b705ef 1889 /* the call to del will trash value, so take a copy now */
a9fd575d 1890 OutputValue(ST(0), value) ;
1f70e1ea 1891 RETVAL = db_del(db, key, R_CURSOR) ;
f6b705ef 1892 if (RETVAL != 0)
6b88bc9c 1893 sv_setsv (ST(0), &PL_sv_undef) ;
a0d0e21e 1894 }
1895 }
1896
1897
1898I32
1899push(db, ...)
1900 DB_File db
045291aa 1901 ALIAS: PUSH = 1
a0d0e21e 1902 CODE:
1903 {
1904 DBTKEY key ;
1905 DBT value ;
4633a7c4 1906 DB * Db = db->dbp ;
a0d0e21e 1907 int i ;
2d8e6c8d 1908 STRLEN n_a;
ccb44e3b 1909 int keyval ;
a0d0e21e 1910
1f70e1ea 1911 DBT_flags(key) ;
1912 DBT_flags(value) ;
8e07c86e 1913 CurrentDB = db ;
ca63f0d2 1914 /* Set the Cursor to the Last element */
1915 RETVAL = do_SEQ(db, key, value, R_LAST) ;
ccb44e3b 1916#ifndef DB_VERSION_MAJOR
ca63f0d2 1917 if (RETVAL >= 0)
ccb44e3b 1918#endif
ca63f0d2 1919 {
ccb44e3b 1920 if (RETVAL == 0)
1921 keyval = *(int*)key.data ;
1922 else
1923 keyval = 0 ;
1924 for (i = 1 ; i < items ; ++i)
8e07c86e 1925 {
2d8e6c8d 1926 value.data = SvPV(ST(i), n_a) ;
1927 value.size = n_a ;
ccb44e3b 1928 ++ keyval ;
1929 key.data = &keyval ;
1930 key.size = sizeof(int) ;
1931 RETVAL = (Db->put)(Db, TXN &key, &value, 0) ;
8e07c86e 1932 if (RETVAL != 0)
1933 break;
1934 }
a0d0e21e 1935 }
1936 }
1937 OUTPUT:
1938 RETVAL
1939
a0d0e21e 1940I32
1941length(db)
1942 DB_File db
045291aa 1943 ALIAS: FETCHSIZE = 1
a0d0e21e 1944 CODE:
8e07c86e 1945 CurrentDB = db ;
b76802f5 1946 RETVAL = GetArrayLength(aTHX_ db) ;
a0d0e21e 1947 OUTPUT:
1948 RETVAL
1949
1950
1951#
1952# Now provide an interface to the rest of the DB functionality
1953#
1954
1955int
1956db_del(db, key, flags=0)
1957 DB_File db
1958 DBTKEY key
1959 u_int flags
1f70e1ea 1960 CODE:
8e07c86e 1961 CurrentDB = db ;
1f70e1ea 1962 RETVAL = db_del(db, key, flags) ;
1963#ifdef DB_VERSION_MAJOR
1964 if (RETVAL > 0)
1965 RETVAL = -1 ;
1966 else if (RETVAL == DB_NOTFOUND)
1967 RETVAL = 1 ;
1968#endif
1969 OUTPUT:
1970 RETVAL
a0d0e21e 1971
1972
1973int
1974db_get(db, key, value, flags=0)
1975 DB_File db
1976 DBTKEY key
a6ed719b 1977 DBT value = NO_INIT
a0d0e21e 1978 u_int flags
1f70e1ea 1979 CODE:
8e07c86e 1980 CurrentDB = db ;
ccb44e3b 1981 DBT_clear(value) ;
1f70e1ea 1982 RETVAL = db_get(db, key, value, flags) ;
1983#ifdef DB_VERSION_MAJOR
1984 if (RETVAL > 0)
1985 RETVAL = -1 ;
1986 else if (RETVAL == DB_NOTFOUND)
1987 RETVAL = 1 ;
1988#endif
a0d0e21e 1989 OUTPUT:
1f70e1ea 1990 RETVAL
a0d0e21e 1991 value
1992
1993int
1994db_put(db, key, value, flags=0)
1995 DB_File db
1996 DBTKEY key
1997 DBT value
1998 u_int flags
1f70e1ea 1999 CODE:
8e07c86e 2000 CurrentDB = db ;
1f70e1ea 2001 RETVAL = db_put(db, key, value, flags) ;
2002#ifdef DB_VERSION_MAJOR
2003 if (RETVAL > 0)
2004 RETVAL = -1 ;
2005 else if (RETVAL == DB_KEYEXIST)
2006 RETVAL = 1 ;
2007#endif
a0d0e21e 2008 OUTPUT:
1f70e1ea 2009 RETVAL
9d9477b1 2010 key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
a0d0e21e 2011
2012int
2013db_fd(db)
2014 DB_File db
1f70e1ea 2015 CODE:
8e07c86e 2016 CurrentDB = db ;
1f70e1ea 2017#ifdef DB_VERSION_MAJOR
2018 RETVAL = -1 ;
497b47a8 2019 {
2020 int status = 0 ;
2021 status = (db->in_memory
2022 ? -1
2023 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
2024 if (status != 0)
2025 RETVAL = -1 ;
2026 }
1f70e1ea 2027#else
2028 RETVAL = (db->in_memory
2029 ? -1
2030 : ((db->dbp)->fd)(db->dbp) ) ;
2031#endif
2032 OUTPUT:
2033 RETVAL
a0d0e21e 2034
2035int
2036db_sync(db, flags=0)
2037 DB_File db
2038 u_int flags
1f70e1ea 2039 CODE:
8e07c86e 2040 CurrentDB = db ;
1f70e1ea 2041 RETVAL = db_sync(db, flags) ;
2042#ifdef DB_VERSION_MAJOR
2043 if (RETVAL > 0)
2044 RETVAL = -1 ;
2045#endif
2046 OUTPUT:
2047 RETVAL
a0d0e21e 2048
2049
2050int
2051db_seq(db, key, value, flags)
2052 DB_File db
2053 DBTKEY key
a6ed719b 2054 DBT value = NO_INIT
a0d0e21e 2055 u_int flags
1f70e1ea 2056 CODE:
8e07c86e 2057 CurrentDB = db ;
ccb44e3b 2058 DBT_clear(value) ;
1f70e1ea 2059 RETVAL = db_seq(db, key, value, flags);
2060#ifdef DB_VERSION_MAJOR
2061 if (RETVAL > 0)
2062 RETVAL = -1 ;
2063 else if (RETVAL == DB_NOTFOUND)
2064 RETVAL = 1 ;
2065#endif
a0d0e21e 2066 OUTPUT:
1f70e1ea 2067 RETVAL
a0d0e21e 2068 key
2069 value
610ab055 2070
9fe6733a 2071#ifdef DBM_FILTERING
2072
2073#define setFilter(type) \
2074 { \
2075 if (db->type) \
cad2e5aa 2076 RETVAL = sv_mortalcopy(db->type) ; \
2077 ST(0) = RETVAL ; \
9fe6733a 2078 if (db->type && (code == &PL_sv_undef)) { \
2079 SvREFCNT_dec(db->type) ; \
2080 db->type = NULL ; \
2081 } \
2082 else if (code) { \
2083 if (db->type) \
2084 sv_setsv(db->type, code) ; \
2085 else \
2086 db->type = newSVsv(code) ; \
2087 } \
2088 }
2089
2090
2091SV *
2092filter_fetch_key(db, code)
2093 DB_File db
2094 SV * code
2095 SV * RETVAL = &PL_sv_undef ;
2096 CODE:
2097 setFilter(filter_fetch_key) ;
9fe6733a 2098
2099SV *
2100filter_store_key(db, code)
2101 DB_File db
2102 SV * code
2103 SV * RETVAL = &PL_sv_undef ;
2104 CODE:
2105 setFilter(filter_store_key) ;
9fe6733a 2106
2107SV *
2108filter_fetch_value(db, code)
2109 DB_File db
2110 SV * code
2111 SV * RETVAL = &PL_sv_undef ;
2112 CODE:
2113 setFilter(filter_fetch_value) ;
9fe6733a 2114
2115SV *
2116filter_store_value(db, code)
2117 DB_File db
2118 SV * code
2119 SV * RETVAL = &PL_sv_undef ;
2120 CODE:
2121 setFilter(filter_store_value) ;
9fe6733a 2122
2123#endif /* DBM_FILTERING */
Unnamed repository; edit this file to name it for gitweb.