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