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