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