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