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