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