projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Changes had accidentally gone too silent on non-main branches.
[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
a56128cb 587#ifdef BERKELEY_DB_1_OR_2
588# define HASH_CB_SIZE_TYPE size_t
589#else
590# define HASH_CB_SIZE_TYPE u_int32_t
591#endif
592
ecfc5424 593static DB_Hash_t
2c2d71f5 594#ifdef CAN_PROTOTYPE
a56128cb 595hash_cb(const void *data, HASH_CB_SIZE_TYPE size)
2c2d71f5 596#else
597hash_cb(data, size)
598const void * data ;
a56128cb 599HASH_CB_SIZE_TYPE size ;
2c2d71f5 600#endif
a0d0e21e 601{
2c2d71f5 602#ifdef dTHX
b76802f5 603 dTHX;
2c2d71f5 604#endif
a0d0e21e 605 dSP ;
606 int retval ;
607 int count ;
cad2e5aa 608
2c2d71f5 609#ifndef newSVpvn
a0d0e21e 610 if (size == 0)
611 data = "" ;
2c2d71f5 612#endif
cad2e5aa 613
610ab055 614 /* DGH - Next two lines added to fix corrupted stack problem */
615 ENTER ;
616 SAVETMPS;
617
924508f0 618 PUSHMARK(SP) ;
610ab055 619
2c2d71f5 620 XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
a0d0e21e 621 PUTBACK ;
622
8e07c86e 623 count = perl_call_sv(CurrentDB->hash, G_SCALAR);
a0d0e21e 624
625 SPAGAIN ;
626
627 if (count != 1)
ff0cee69 628 croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
a0d0e21e 629
630 retval = POPi ;
631
632 PUTBACK ;
633 FREETMPS ;
634 LEAVE ;
635
636 return (retval) ;
637}
638
639
ccb44e3b 640#if defined(TRACE) && defined(BERKELEY_DB_1_OR_2)
a0d0e21e 641
642static void
2c2d71f5 643#ifdef CAN_PROTOTYPE
b76802f5 644PrintHash(INFO *hash)
2c2d71f5 645#else
646PrintHash(hash)
647INFO * hash ;
648#endif
a0d0e21e 649{
650 printf ("HASH Info\n") ;
1f70e1ea 651 printf (" hash = %s\n",
652 (hash->db_HA_hash != NULL ? "redefined" : "default")) ;
653 printf (" bsize = %d\n", hash->db_HA_bsize) ;
654 printf (" ffactor = %d\n", hash->db_HA_ffactor) ;
655 printf (" nelem = %d\n", hash->db_HA_nelem) ;
656 printf (" cachesize = %d\n", hash->db_HA_cachesize) ;
657 printf (" lorder = %d\n", hash->db_HA_lorder) ;
a0d0e21e 658
659}
660
661static void
2c2d71f5 662#ifdef CAN_PROTOTYPE
b76802f5 663PrintRecno(INFO *recno)
2c2d71f5 664#else
665PrintRecno(recno)
666INFO * recno ;
667#endif
a0d0e21e 668{
669 printf ("RECNO Info\n") ;
1f70e1ea 670 printf (" flags = %d\n", recno->db_RE_flags) ;
671 printf (" cachesize = %d\n", recno->db_RE_cachesize) ;
672 printf (" psize = %d\n", recno->db_RE_psize) ;
673 printf (" lorder = %d\n", recno->db_RE_lorder) ;
674 printf (" reclen = %ul\n", (unsigned long)recno->db_RE_reclen) ;
675 printf (" bval = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
676 printf (" bfname = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
a0d0e21e 677}
678
ff68c719 679static void
2c2d71f5 680#ifdef CAN_PROTOTYPE
b76802f5 681PrintBtree(INFO *btree)
2c2d71f5 682#else
683PrintBtree(btree)
684INFO * btree ;
685#endif
a0d0e21e 686{
687 printf ("BTREE Info\n") ;
1f70e1ea 688 printf (" compare = %s\n",
689 (btree->db_BT_compare ? "redefined" : "default")) ;
690 printf (" prefix = %s\n",
691 (btree->db_BT_prefix ? "redefined" : "default")) ;
692 printf (" flags = %d\n", btree->db_BT_flags) ;
693 printf (" cachesize = %d\n", btree->db_BT_cachesize) ;
694 printf (" psize = %d\n", btree->db_BT_psize) ;
695#ifndef DB_VERSION_MAJOR
696 printf (" maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
697 printf (" minkeypage = %d\n", btree->db_BT_minkeypage) ;
698#endif
699 printf (" lorder = %d\n", btree->db_BT_lorder) ;
a0d0e21e 700}
701
702#else
703
704#define PrintRecno(recno)
705#define PrintHash(hash)
706#define PrintBtree(btree)
707
708#endif /* TRACE */
709
710
711static I32
2c2d71f5 712#ifdef CAN_PROTOTYPE
b76802f5 713GetArrayLength(pTHX_ DB_File db)
2c2d71f5 714#else
715GetArrayLength(db)
716DB_File db ;
717#endif
a0d0e21e 718{
719 DBT key ;
720 DBT value ;
721 int RETVAL ;
722
ccb44e3b 723 DBT_clear(key) ;
724 DBT_clear(value) ;
1f70e1ea 725 RETVAL = do_SEQ(db, key, value, R_LAST) ;
a0d0e21e 726 if (RETVAL == 0)
727 RETVAL = *(I32 *)key.data ;
1f70e1ea 728 else /* No key means empty file */
a0d0e21e 729 RETVAL = 0 ;
730
a0b8c8c1 731 return ((I32)RETVAL) ;
a0d0e21e 732}
733
88108326 734static recno_t
2c2d71f5 735#ifdef CAN_PROTOTYPE
b76802f5 736GetRecnoKey(pTHX_ DB_File db, I32 value)
2c2d71f5 737#else
738GetRecnoKey(db, value)
739DB_File db ;
740I32 value ;
741#endif
88108326 742{
743 if (value < 0) {
744 /* Get the length of the array */
b76802f5 745 I32 length = GetArrayLength(aTHX_ db) ;
88108326 746
747 /* check for attempt to write before start of array */
748 if (length + value + 1 <= 0)
ff0cee69 749 croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
88108326 750
751 value = length + value + 1 ;
752 }
753 else
754 ++ value ;
755
756 return value ;
a0d0e21e 757}
758
ccb44e3b 759
a0d0e21e 760static DB_File
2c2d71f5 761#ifdef CAN_PROTOTYPE
b76802f5 762ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv)
2c2d71f5 763#else
764ParseOpenInfo(isHASH, name, flags, mode, sv)
765int isHASH ;
766char * name ;
767int flags ;
768int mode ;
769SV * sv ;
770#endif
a0d0e21e 771{
ccb44e3b 772
773#ifdef BERKELEY_DB_1_OR_2 /* Berkeley DB Version 1 or 2 */
774
a0d0e21e 775 SV ** svp;
776 HV * action ;
045291aa 777 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
a0d0e21e 778 void * openinfo = NULL ;
045291aa 779 INFO * info = &RETVAL->info ;
2d8e6c8d 780 STRLEN n_a;
1f70e1ea 781
782/* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
045291aa 783 Zero(RETVAL, 1, DB_File_type) ;
a0d0e21e 784
88108326 785 /* Default to HASH */
9fe6733a 786#ifdef DBM_FILTERING
787 RETVAL->filtering = 0 ;
788 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
789 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
790#endif /* DBM_FILTERING */
8e07c86e 791 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
792 RETVAL->type = DB_HASH ;
a0d0e21e 793
610ab055 794 /* DGH - Next line added to avoid SEGV on existing hash DB */
795 CurrentDB = RETVAL;
796
a0b8c8c1 797 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
798 RETVAL->in_memory = (name == NULL) ;
799
a0d0e21e 800 if (sv)
801 {
802 if (! SvROK(sv) )
803 croak ("type parameter is not a reference") ;
804
36477c24 805 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
806 if (svp && SvOK(*svp))
807 action = (HV*) SvRV(*svp) ;
808 else
809 croak("internal error") ;
610ab055 810
a0d0e21e 811 if (sv_isa(sv, "DB_File::HASHINFO"))
812 {
05475680 813
814 if (!isHASH)
815 croak("DB_File can only tie an associative array to a DB_HASH database") ;
816
8e07c86e 817 RETVAL->type = DB_HASH ;
610ab055 818 openinfo = (void*)info ;
a0d0e21e 819
820 svp = hv_fetch(action, "hash", 4, FALSE);
821
822 if (svp && SvOK(*svp))
823 {
1f70e1ea 824 info->db_HA_hash = hash_cb ;
8e07c86e 825 RETVAL->hash = newSVsv(*svp) ;
a0d0e21e 826 }
827 else
1f70e1ea 828 info->db_HA_hash = NULL ;
a0d0e21e 829
a0d0e21e 830 svp = hv_fetch(action, "ffactor", 7, FALSE);
1f70e1ea 831 info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
a0d0e21e 832
833 svp = hv_fetch(action, "nelem", 5, FALSE);
1f70e1ea 834 info->db_HA_nelem = svp ? SvIV(*svp) : 0;
a0d0e21e 835
1f70e1ea 836 svp = hv_fetch(action, "bsize", 5, FALSE);
837 info->db_HA_bsize = svp ? SvIV(*svp) : 0;
838
a0d0e21e 839 svp = hv_fetch(action, "cachesize", 9, FALSE);
1f70e1ea 840 info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
a0d0e21e 841
842 svp = hv_fetch(action, "lorder", 6, FALSE);
1f70e1ea 843 info->db_HA_lorder = svp ? SvIV(*svp) : 0;
a0d0e21e 844
845 PrintHash(info) ;
846 }
847 else if (sv_isa(sv, "DB_File::BTREEINFO"))
848 {
05475680 849 if (!isHASH)
850 croak("DB_File can only tie an associative array to a DB_BTREE database");
851
8e07c86e 852 RETVAL->type = DB_BTREE ;
610ab055 853 openinfo = (void*)info ;
a0d0e21e 854
855 svp = hv_fetch(action, "compare", 7, FALSE);
856 if (svp && SvOK(*svp))
857 {
1f70e1ea 858 info->db_BT_compare = btree_compare ;
8e07c86e 859 RETVAL->compare = newSVsv(*svp) ;
a0d0e21e 860 }
861 else
1f70e1ea 862 info->db_BT_compare = NULL ;
a0d0e21e 863
864 svp = hv_fetch(action, "prefix", 6, FALSE);
865 if (svp && SvOK(*svp))
866 {
1f70e1ea 867 info->db_BT_prefix = btree_prefix ;
8e07c86e 868 RETVAL->prefix = newSVsv(*svp) ;
a0d0e21e 869 }
870 else
1f70e1ea 871 info->db_BT_prefix = NULL ;
a0d0e21e 872
873 svp = hv_fetch(action, "flags", 5, FALSE);
1f70e1ea 874 info->db_BT_flags = svp ? SvIV(*svp) : 0;
a0d0e21e 875
876 svp = hv_fetch(action, "cachesize", 9, FALSE);
1f70e1ea 877 info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
a0d0e21e 878
1f70e1ea 879#ifndef DB_VERSION_MAJOR
a0d0e21e 880 svp = hv_fetch(action, "minkeypage", 10, FALSE);
610ab055 881 info->btree.minkeypage = svp ? SvIV(*svp) : 0;
a0d0e21e 882
883 svp = hv_fetch(action, "maxkeypage", 10, FALSE);
610ab055 884 info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
1f70e1ea 885#endif
a0d0e21e 886
887 svp = hv_fetch(action, "psize", 5, FALSE);
1f70e1ea 888 info->db_BT_psize = svp ? SvIV(*svp) : 0;
a0d0e21e 889
890 svp = hv_fetch(action, "lorder", 6, FALSE);
1f70e1ea 891 info->db_BT_lorder = svp ? SvIV(*svp) : 0;
a0d0e21e 892
893 PrintBtree(info) ;
894
895 }
896 else if (sv_isa(sv, "DB_File::RECNOINFO"))
897 {
05475680 898 if (isHASH)
899 croak("DB_File can only tie an array to a DB_RECNO database");
900
8e07c86e 901 RETVAL->type = DB_RECNO ;
610ab055 902 openinfo = (void *)info ;
a0d0e21e 903
1f70e1ea 904 info->db_RE_flags = 0 ;
905
a0d0e21e 906 svp = hv_fetch(action, "flags", 5, FALSE);
1f70e1ea 907 info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
908
909 svp = hv_fetch(action, "reclen", 6, FALSE);
910 info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
a0d0e21e 911
912 svp = hv_fetch(action, "cachesize", 9, FALSE);
1f70e1ea 913 info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
a0d0e21e 914
915 svp = hv_fetch(action, "psize", 5, FALSE);
1f70e1ea 916 info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
a0d0e21e 917
918 svp = hv_fetch(action, "lorder", 6, FALSE);
1f70e1ea 919 info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
920
921#ifdef DB_VERSION_MAJOR
922 info->re_source = name ;
923 name = NULL ;
924#endif
925 svp = hv_fetch(action, "bfname", 6, FALSE);
926 if (svp && SvOK(*svp)) {
2d8e6c8d 927 char * ptr = SvPV(*svp,n_a) ;
1f70e1ea 928#ifdef DB_VERSION_MAJOR
2d8e6c8d 929 name = (char*) n_a ? ptr : NULL ;
1f70e1ea 930#else
2d8e6c8d 931 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
1f70e1ea 932#endif
933 }
934 else
935#ifdef DB_VERSION_MAJOR
936 name = NULL ;
937#else
938 info->db_RE_bfname = NULL ;
939#endif
a0d0e21e 940
941 svp = hv_fetch(action, "bval", 4, FALSE);
1f70e1ea 942#ifdef DB_VERSION_MAJOR
a0d0e21e 943 if (svp && SvOK(*svp))
944 {
1f70e1ea 945 int value ;
a0d0e21e 946 if (SvPOK(*svp))
2d8e6c8d 947 value = (int)*SvPV(*svp, n_a) ;
a0d0e21e 948 else
1f70e1ea 949 value = SvIV(*svp) ;
950
951 if (info->flags & DB_FIXEDLEN) {
952 info->re_pad = value ;
953 info->flags |= DB_PAD ;
954 }
955 else {
956 info->re_delim = value ;
957 info->flags |= DB_DELIMITER ;
958 }
959
960 }
961#else
962 if (svp && SvOK(*svp))
963 {
964 if (SvPOK(*svp))
2d8e6c8d 965 info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
1f70e1ea 966 else
967 info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
968 DB_flags(info->flags, DB_DELIMITER) ;
969
a0d0e21e 970 }
971 else
972 {
1f70e1ea 973 if (info->db_RE_flags & R_FIXEDLEN)
974 info->db_RE_bval = (u_char) ' ' ;
a0d0e21e 975 else
1f70e1ea 976 info->db_RE_bval = (u_char) '\n' ;
977 DB_flags(info->flags, DB_DELIMITER) ;
a0d0e21e 978 }
1f70e1ea 979#endif
a0d0e21e 980
1f70e1ea 981#ifdef DB_RENUMBER
982 info->flags |= DB_RENUMBER ;
983#endif
984
a0d0e21e 985 PrintRecno(info) ;
986 }
987 else
988 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
989 }
990
991
88108326 992 /* OS2 Specific Code */
993#ifdef OS2
994#ifdef __EMX__
995 flags |= O_BINARY;
996#endif /* __EMX__ */
997#endif /* OS2 */
a0d0e21e 998
1f70e1ea 999#ifdef DB_VERSION_MAJOR
1000
1001 {
1002 int Flags = 0 ;
1003 int status ;
1004
1005 /* Map 1.x flags to 2.x flags */
1006 if ((flags & O_CREAT) == O_CREAT)
1007 Flags |= DB_CREATE ;
1008
1f70e1ea 1009#if O_RDONLY == 0
1010 if (flags == O_RDONLY)
1011#else
20896112 1012 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1f70e1ea 1013#endif
1014 Flags |= DB_RDONLY ;
1015
20896112 1016#ifdef O_TRUNC
1f70e1ea 1017 if ((flags & O_TRUNC) == O_TRUNC)
1018 Flags |= DB_TRUNCATE ;
1019#endif
1020
1021 status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
1022 if (status == 0)
6ca2e664 1023#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
1f70e1ea 1024 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
6ca2e664 1025#else
1026 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1027 0) ;
1028#endif
1f70e1ea 1029
1030 if (status)
1031 RETVAL->dbp = NULL ;
1032
1033 }
1034#else
ccb44e3b 1035
1036#if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2
1037 RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ;
1038#else
88108326 1039 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
ccb44e3b 1040#endif /* DB_LIBRARY_COMPATIBILITY_API */
1041
1f70e1ea 1042#endif
a0d0e21e 1043
1044 return (RETVAL) ;
ccb44e3b 1045
1046#else /* Berkeley DB Version > 2 */
1047
1048 SV ** svp;
1049 HV * action ;
1050 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
1051 DB * dbp ;
1052 STRLEN n_a;
1053 int status ;
1054
1055/* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
1056 Zero(RETVAL, 1, DB_File_type) ;
1057
1058 /* Default to HASH */
1059#ifdef DBM_FILTERING
1060 RETVAL->filtering = 0 ;
1061 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
1062 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
1063#endif /* DBM_FILTERING */
1064 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
1065 RETVAL->type = DB_HASH ;
1066
1067 /* DGH - Next line added to avoid SEGV on existing hash DB */
1068 CurrentDB = RETVAL;
1069
1070 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
1071 RETVAL->in_memory = (name == NULL) ;
1072
1073 status = db_create(&RETVAL->dbp, NULL,0) ;
1074 /* printf("db_create returned %d %s\n", status, db_strerror(status)) ; */
1075 if (status) {
1076 RETVAL->dbp = NULL ;
1077 return (RETVAL) ;
1078 }
1079 dbp = RETVAL->dbp ;
1080
1081 if (sv)
1082 {
1083 if (! SvROK(sv) )
1084 croak ("type parameter is not a reference") ;
1085
1086 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
1087 if (svp && SvOK(*svp))
1088 action = (HV*) SvRV(*svp) ;
1089 else
1090 croak("internal error") ;
1091
1092 if (sv_isa(sv, "DB_File::HASHINFO"))
1093 {
1094
1095 if (!isHASH)
1096 croak("DB_File can only tie an associative array to a DB_HASH database") ;
1097
1098 RETVAL->type = DB_HASH ;
1099
1100 svp = hv_fetch(action, "hash", 4, FALSE);
1101
1102 if (svp && SvOK(*svp))
1103 {
1104 (void)dbp->set_h_hash(dbp, hash_cb) ;
1105 RETVAL->hash = newSVsv(*svp) ;
1106 }
1107
1108 svp = hv_fetch(action, "ffactor", 7, FALSE);
1109 if (svp)
1110 (void)dbp->set_h_ffactor(dbp, SvIV(*svp)) ;
1111
1112 svp = hv_fetch(action, "nelem", 5, FALSE);
1113 if (svp)
1114 (void)dbp->set_h_nelem(dbp, SvIV(*svp)) ;
1115
1116 svp = hv_fetch(action, "bsize", 5, FALSE);
1117 if (svp)
1118 (void)dbp->set_pagesize(dbp, SvIV(*svp));
1119
1120 svp = hv_fetch(action, "cachesize", 9, FALSE);
1121 if (svp)
1122 (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1123
1124 svp = hv_fetch(action, "lorder", 6, FALSE);
1125 if (svp)
1126 (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
1127
1128 PrintHash(info) ;
1129 }
1130 else if (sv_isa(sv, "DB_File::BTREEINFO"))
1131 {
1132 if (!isHASH)
1133 croak("DB_File can only tie an associative array to a DB_BTREE database");
1134
1135 RETVAL->type = DB_BTREE ;
1136
1137 svp = hv_fetch(action, "compare", 7, FALSE);
1138 if (svp && SvOK(*svp))
1139 {
1140 (void)dbp->set_bt_compare(dbp, btree_compare) ;
1141 RETVAL->compare = newSVsv(*svp) ;
1142 }
1143
1144 svp = hv_fetch(action, "prefix", 6, FALSE);
1145 if (svp && SvOK(*svp))
1146 {
1147 (void)dbp->set_bt_prefix(dbp, btree_prefix) ;
1148 RETVAL->prefix = newSVsv(*svp) ;
1149 }
1150
1151 svp = hv_fetch(action, "flags", 5, FALSE);
1152 if (svp)
1153 (void)dbp->set_flags(dbp, SvIV(*svp)) ;
1154
1155 svp = hv_fetch(action, "cachesize", 9, FALSE);
1156 if (svp)
1157 (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1158
1159 svp = hv_fetch(action, "psize", 5, FALSE);
1160 if (svp)
1161 (void)dbp->set_pagesize(dbp, SvIV(*svp)) ;
1162
1163 svp = hv_fetch(action, "lorder", 6, FALSE);
1164 if (svp)
1165 (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
1166
1167 PrintBtree(info) ;
1168
1169 }
1170 else if (sv_isa(sv, "DB_File::RECNOINFO"))
1171 {
1172 int fixed = FALSE ;
1173
1174 if (isHASH)
1175 croak("DB_File can only tie an array to a DB_RECNO database");
1176
1177 RETVAL->type = DB_RECNO ;
1178
1179 svp = hv_fetch(action, "flags", 5, FALSE);
1180 if (svp) {
1181 int flags = SvIV(*svp) ;
1182 /* remove FIXDLEN, if present */
1183 if (flags & DB_FIXEDLEN) {
1184 fixed = TRUE ;
1185 flags &= ~DB_FIXEDLEN ;
1186 }
1187 }
1188
1189 svp = hv_fetch(action, "cachesize", 9, FALSE);
1190 if (svp) {
1191 status = dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1192 }
1193
1194 svp = hv_fetch(action, "psize", 5, FALSE);
1195 if (svp) {
1196 status = dbp->set_pagesize(dbp, SvIV(*svp)) ;
1197 }
1198
1199 svp = hv_fetch(action, "lorder", 6, FALSE);
1200 if (svp) {
1201 status = dbp->set_lorder(dbp, SvIV(*svp)) ;
1202 }
1203
1204 svp = hv_fetch(action, "bval", 4, FALSE);
1205 if (svp && SvOK(*svp))
1206 {
1207 int value ;
1208 if (SvPOK(*svp))
1209 value = (int)*SvPV(*svp, n_a) ;
1210 else
1211 value = SvIV(*svp) ;
1212
1213 if (fixed) {
1214 status = dbp->set_re_pad(dbp, value) ;
1215 }
1216 else {
1217 status = dbp->set_re_delim(dbp, value) ;
1218 }
1219
1220 }
1221
1222 if (fixed) {
1223 svp = hv_fetch(action, "reclen", 6, FALSE);
1224 if (svp) {
1225 u_int32_t len = (u_int32_t)SvIV(*svp) ;
1226 status = dbp->set_re_len(dbp, len) ;
1227 }
1228 }
1229
1230 if (name != NULL) {
1231 status = dbp->set_re_source(dbp, name) ;
1232 name = NULL ;
1233 }
1234
1235 svp = hv_fetch(action, "bfname", 6, FALSE);
1236 if (svp && SvOK(*svp)) {
1237 char * ptr = SvPV(*svp,n_a) ;
1238 name = (char*) n_a ? ptr : NULL ;
1239 }
1240 else
1241 name = NULL ;
1242
1243
1244 status = dbp->set_flags(dbp, DB_RENUMBER) ;
1245
1246 if (flags){
1247 (void)dbp->set_flags(dbp, flags) ;
1248 }
1249 PrintRecno(info) ;
1250 }
1251 else
1252 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1253 }
1254
1255 {
1256 int Flags = 0 ;
1257 int status ;
1258
1259 /* Map 1.x flags to 3.x flags */
1260 if ((flags & O_CREAT) == O_CREAT)
1261 Flags |= DB_CREATE ;
1262
1263#if O_RDONLY == 0
1264 if (flags == O_RDONLY)
1265#else
1266 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1267#endif
1268 Flags |= DB_RDONLY ;
1269
1270#ifdef O_TRUNC
1271 if ((flags & O_TRUNC) == O_TRUNC)
1272 Flags |= DB_TRUNCATE ;
1273#endif
1274
1275 status = RETVAL->dbp->open(RETVAL->dbp, name, NULL, RETVAL->type,
1276 Flags, mode) ;
1277 /* printf("open returned %d %s\n", status, db_strerror(status)) ; */
1278
1279 if (status == 0)
1280 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1281 0) ;
1282 /* printf("cursor returned %d %s\n", status, db_strerror(status)) ; */
1283
1284 if (status)
1285 RETVAL->dbp = NULL ;
1286
1287 }
1288
1289 return (RETVAL) ;
1290
1291#endif /* Berkeley DB Version > 2 */
1292
1293} /* ParseOpenInfo */
a0d0e21e 1294
1295
a0d0e21e 1296static double
2c2d71f5 1297#ifdef CAN_PROTOTYPE
b76802f5 1298constant(char *name, int arg)
2c2d71f5 1299#else
1300constant(name, arg)
1301char *name;
1302int arg;
1303#endif
a0d0e21e 1304{
1305 errno = 0;
1306 switch (*name) {
1307 case 'A':
1308 break;
1309 case 'B':
1310 if (strEQ(name, "BTREEMAGIC"))
1311#ifdef BTREEMAGIC
1312 return BTREEMAGIC;
1313#else
1314 goto not_there;
1315#endif
1316 if (strEQ(name, "BTREEVERSION"))
1317#ifdef BTREEVERSION
1318 return BTREEVERSION;
1319#else
1320 goto not_there;
1321#endif
1322 break;
1323 case 'C':
1324 break;
1325 case 'D':
1326 if (strEQ(name, "DB_LOCK"))
1327#ifdef DB_LOCK
1328 return DB_LOCK;
1329#else
1330 goto not_there;
1331#endif
1332 if (strEQ(name, "DB_SHMEM"))
1333#ifdef DB_SHMEM
1334 return DB_SHMEM;
1335#else
1336 goto not_there;
1337#endif
1338 if (strEQ(name, "DB_TXN"))
1339#ifdef DB_TXN
1340 return (U32)DB_TXN;
1341#else
1342 goto not_there;
1343#endif
1344 break;
1345 case 'E':
1346 break;
1347 case 'F':
1348 break;
1349 case 'G':
1350 break;
1351 case 'H':
1352 if (strEQ(name, "HASHMAGIC"))
1353#ifdef HASHMAGIC
1354 return HASHMAGIC;
1355#else
1356 goto not_there;
1357#endif
1358 if (strEQ(name, "HASHVERSION"))
1359#ifdef HASHVERSION
1360 return HASHVERSION;
1361#else
1362 goto not_there;
1363#endif
1364 break;
1365 case 'I':
1366 break;
1367 case 'J':
1368 break;
1369 case 'K':
1370 break;
1371 case 'L':
1372 break;
1373 case 'M':
1374 if (strEQ(name, "MAX_PAGE_NUMBER"))
1375#ifdef MAX_PAGE_NUMBER
1376 return (U32)MAX_PAGE_NUMBER;
1377#else
1378 goto not_there;
1379#endif
1380 if (strEQ(name, "MAX_PAGE_OFFSET"))
1381#ifdef MAX_PAGE_OFFSET
1382 return MAX_PAGE_OFFSET;
1383#else
1384 goto not_there;
1385#endif
1386 if (strEQ(name, "MAX_REC_NUMBER"))
1387#ifdef MAX_REC_NUMBER
1388 return (U32)MAX_REC_NUMBER;
1389#else
1390 goto not_there;
1391#endif
1392 break;
1393 case 'N':
1394 break;
1395 case 'O':
1396 break;
1397 case 'P':
1398 break;
1399 case 'Q':
1400 break;
1401 case 'R':
1402 if (strEQ(name, "RET_ERROR"))
1403#ifdef RET_ERROR
1404 return RET_ERROR;
1405#else
1406 goto not_there;
1407#endif
1408 if (strEQ(name, "RET_SPECIAL"))
1409#ifdef RET_SPECIAL
1410 return RET_SPECIAL;
1411#else
1412 goto not_there;
1413#endif
1414 if (strEQ(name, "RET_SUCCESS"))
1415#ifdef RET_SUCCESS
1416 return RET_SUCCESS;
1417#else
1418 goto not_there;
1419#endif
1420 if (strEQ(name, "R_CURSOR"))
1421#ifdef R_CURSOR
1422 return R_CURSOR;
1423#else
1424 goto not_there;
1425#endif
1426 if (strEQ(name, "R_DUP"))
1427#ifdef R_DUP
1428 return R_DUP;
1429#else
1430 goto not_there;
1431#endif
1432 if (strEQ(name, "R_FIRST"))
1433#ifdef R_FIRST
1434 return R_FIRST;
1435#else
1436 goto not_there;
1437#endif
1438 if (strEQ(name, "R_FIXEDLEN"))
1439#ifdef R_FIXEDLEN
1440 return R_FIXEDLEN;
1441#else
1442 goto not_there;
1443#endif
1444 if (strEQ(name, "R_IAFTER"))
1445#ifdef R_IAFTER
1446 return R_IAFTER;
1447#else
1448 goto not_there;
1449#endif
1450 if (strEQ(name, "R_IBEFORE"))
1451#ifdef R_IBEFORE
1452 return R_IBEFORE;
1453#else
1454 goto not_there;
1455#endif
1456 if (strEQ(name, "R_LAST"))
1457#ifdef R_LAST
1458 return R_LAST;
1459#else
1460 goto not_there;
1461#endif
1462 if (strEQ(name, "R_NEXT"))
1463#ifdef R_NEXT
1464 return R_NEXT;
1465#else
1466 goto not_there;
1467#endif
1468 if (strEQ(name, "R_NOKEY"))
1469#ifdef R_NOKEY
1470 return R_NOKEY;
1471#else
1472 goto not_there;
1473#endif
1474 if (strEQ(name, "R_NOOVERWRITE"))
1475#ifdef R_NOOVERWRITE
1476 return R_NOOVERWRITE;
1477#else
1478 goto not_there;
1479#endif
1480 if (strEQ(name, "R_PREV"))
1481#ifdef R_PREV
1482 return R_PREV;
1483#else
1484 goto not_there;
1485#endif
1486 if (strEQ(name, "R_RECNOSYNC"))
1487#ifdef R_RECNOSYNC
1488 return R_RECNOSYNC;
1489#else
1490 goto not_there;
1491#endif
1492 if (strEQ(name, "R_SETCURSOR"))
1493#ifdef R_SETCURSOR
1494 return R_SETCURSOR;
1495#else
1496 goto not_there;
1497#endif
1498 if (strEQ(name, "R_SNAPSHOT"))
1499#ifdef R_SNAPSHOT
1500 return R_SNAPSHOT;
1501#else
1502 goto not_there;
1503#endif
1504 break;
1505 case 'S':
1506 break;
1507 case 'T':
1508 break;
1509 case 'U':
1510 break;
1511 case 'V':
1512 break;
1513 case 'W':
1514 break;
1515 case 'X':
1516 break;
1517 case 'Y':
1518 break;
1519 case 'Z':
1520 break;
1521 case '_':
a0d0e21e 1522 break;
1523 }
1524 errno = EINVAL;
1525 return 0;
1526
1527not_there:
1528 errno = ENOENT;
1529 return 0;
1530}
1531
1532MODULE = DB_File PACKAGE = DB_File PREFIX = db_
1533
1f70e1ea 1534BOOT:
1535 {
ccb44e3b 1536 __getBerkeleyDBInfo() ;
1f70e1ea 1537
ccb44e3b 1538 DBT_clear(empty) ;
1f70e1ea 1539 empty.data = &zero ;
1540 empty.size = sizeof(recno_t) ;
1f70e1ea 1541 }
1542
a0d0e21e 1543double
1544constant(name,arg)
1545 char * name
1546 int arg
1547
1548
1549DB_File
05475680 1550db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
1551 int isHASH
a0d0e21e 1552 char * dbtype
1553 int flags
1554 int mode
1555 CODE:
1556 {
1557 char * name = (char *) NULL ;
1558 SV * sv = (SV *) NULL ;
2d8e6c8d 1559 STRLEN n_a;
a0d0e21e 1560
05475680 1561 if (items >= 3 && SvOK(ST(2)))
2d8e6c8d 1562 name = (char*) SvPV(ST(2), n_a) ;
a0d0e21e 1563
05475680 1564 if (items == 6)
1565 sv = ST(5) ;
a0d0e21e 1566
b76802f5 1567 RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
4633a7c4 1568 if (RETVAL->dbp == NULL)
1569 RETVAL = NULL ;
a0d0e21e 1570 }
1571 OUTPUT:
1572 RETVAL
1573
a0d0e21e 1574int
1575db_DESTROY(db)
1576 DB_File db
8e07c86e 1577 INIT:
1578 CurrentDB = db ;
1579 CLEANUP:
1580 if (db->hash)
1581 SvREFCNT_dec(db->hash) ;
1582 if (db->compare)
1583 SvREFCNT_dec(db->compare) ;
1584 if (db->prefix)
1585 SvREFCNT_dec(db->prefix) ;
9fe6733a 1586#ifdef DBM_FILTERING
1587 if (db->filter_fetch_key)
1588 SvREFCNT_dec(db->filter_fetch_key) ;
1589 if (db->filter_store_key)
1590 SvREFCNT_dec(db->filter_store_key) ;
1591 if (db->filter_fetch_value)
1592 SvREFCNT_dec(db->filter_fetch_value) ;
1593 if (db->filter_store_value)
1594 SvREFCNT_dec(db->filter_store_value) ;
1595#endif /* DBM_FILTERING */
eb99164f 1596 safefree(db) ;
1f70e1ea 1597#ifdef DB_VERSION_MAJOR
1598 if (RETVAL > 0)
1599 RETVAL = -1 ;
1600#endif
a0d0e21e 1601
1602
1603int
1604db_DELETE(db, key, flags=0)
1605 DB_File db
1606 DBTKEY key
1607 u_int flags
8e07c86e 1608 INIT:
1609 CurrentDB = db ;
a0d0e21e 1610
f6b705ef 1611
1612int
1613db_EXISTS(db, key)
1614 DB_File db
1615 DBTKEY key
1616 CODE:
1617 {
1618 DBT value ;
1619
ccb44e3b 1620 DBT_clear(value) ;
f6b705ef 1621 CurrentDB = db ;
1f70e1ea 1622 RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
f6b705ef 1623 }
1624 OUTPUT:
1625 RETVAL
1626
a0d0e21e 1627int
1628db_FETCH(db, key, flags=0)
1629 DB_File db
1630 DBTKEY key
1631 u_int flags
1632 CODE:
1633 {
1f70e1ea 1634 DBT value ;
a0d0e21e 1635
ccb44e3b 1636 DBT_clear(value) ;
8e07c86e 1637 CurrentDB = db ;
1f70e1ea 1638 /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */
1639 RETVAL = db_get(db, key, value, flags) ;
a0d0e21e 1640 ST(0) = sv_newmortal();
a9fd575d 1641 OutputValue(ST(0), value)
a0d0e21e 1642 }
1643
1644int
1645db_STORE(db, key, value, flags=0)
1646 DB_File db
1647 DBTKEY key
1648 DBT value
1649 u_int flags
8e07c86e 1650 INIT:
1651 CurrentDB = db ;
a0d0e21e 1652
1653
1654int
1655db_FIRSTKEY(db)
1656 DB_File db
1657 CODE:
1658 {
1f70e1ea 1659 DBTKEY key ;
a0d0e21e 1660 DBT value ;
1661
ccb44e3b 1662 DBT_clear(key) ;
1663 DBT_clear(value) ;
8e07c86e 1664 CurrentDB = db ;
1f70e1ea 1665 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
a0d0e21e 1666 ST(0) = sv_newmortal();
a9fd575d 1667 OutputKey(ST(0), key) ;
a0d0e21e 1668 }
1669
1670int
1671db_NEXTKEY(db, key)
1672 DB_File db
1673 DBTKEY key
1674 CODE:
1675 {
1676 DBT value ;
1677
ccb44e3b 1678 DBT_clear(value) ;
8e07c86e 1679 CurrentDB = db ;
1f70e1ea 1680 RETVAL = do_SEQ(db, key, value, R_NEXT) ;
a0d0e21e 1681 ST(0) = sv_newmortal();
a9fd575d 1682 OutputKey(ST(0), key) ;
a0d0e21e 1683 }
1684
1685#
1686# These would be nice for RECNO
1687#
1688
1689int
1690unshift(db, ...)
1691 DB_File db
045291aa 1692 ALIAS: UNSHIFT = 1
a0d0e21e 1693 CODE:
1694 {
1695 DBTKEY key ;
1696 DBT value ;
1697 int i ;
1698 int One ;
4633a7c4 1699 DB * Db = db->dbp ;
2d8e6c8d 1700 STRLEN n_a;
a0d0e21e 1701
ccb44e3b 1702 DBT_clear(key) ;
1703 DBT_clear(value) ;
8e07c86e 1704 CurrentDB = db ;
1f70e1ea 1705#ifdef DB_VERSION_MAJOR
1706 /* get the first value */
1707 RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1708 RETVAL = 0 ;
1709#else
a0d0e21e 1710 RETVAL = -1 ;
1f70e1ea 1711#endif
a0d0e21e 1712 for (i = items-1 ; i > 0 ; --i)
1713 {
2d8e6c8d 1714 value.data = SvPV(ST(i), n_a) ;
1715 value.size = n_a ;
a0d0e21e 1716 One = 1 ;
1717 key.data = &One ;
1718 key.size = sizeof(int) ;
1f70e1ea 1719#ifdef DB_VERSION_MAJOR
1720 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1721#else
4633a7c4 1722 RETVAL = (Db->put)(Db, &key, &value, R_IBEFORE) ;
1f70e1ea 1723#endif
a0d0e21e 1724 if (RETVAL != 0)
1725 break;
1726 }
1727 }
1728 OUTPUT:
1729 RETVAL
1730
1731I32
1732pop(db)
1733 DB_File db
045291aa 1734 ALIAS: POP = 1
a0d0e21e 1735 CODE:
1736 {
1737 DBTKEY key ;
1738 DBT value ;
1739
ccb44e3b 1740 DBT_clear(key) ;
1741 DBT_clear(value) ;
8e07c86e 1742 CurrentDB = db ;
1f70e1ea 1743
a0d0e21e 1744 /* First get the final value */
1f70e1ea 1745 RETVAL = do_SEQ(db, key, value, R_LAST) ;
a0d0e21e 1746 ST(0) = sv_newmortal();
1747 /* Now delete it */
1748 if (RETVAL == 0)
1749 {
f6b705ef 1750 /* the call to del will trash value, so take a copy now */
a9fd575d 1751 OutputValue(ST(0), value) ;
1f70e1ea 1752 RETVAL = db_del(db, key, R_CURSOR) ;
f6b705ef 1753 if (RETVAL != 0)
6b88bc9c 1754 sv_setsv(ST(0), &PL_sv_undef);
a0d0e21e 1755 }
1756 }
1757
1758I32
1759shift(db)
1760 DB_File db
045291aa 1761 ALIAS: SHIFT = 1
a0d0e21e 1762 CODE:
1763 {
a0d0e21e 1764 DBT value ;
f6b705ef 1765 DBTKEY key ;
a0d0e21e 1766
ccb44e3b 1767 DBT_clear(key) ;
1768 DBT_clear(value) ;
8e07c86e 1769 CurrentDB = db ;
a0d0e21e 1770 /* get the first value */
1f70e1ea 1771 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
a0d0e21e 1772 ST(0) = sv_newmortal();
1773 /* Now delete it */
1774 if (RETVAL == 0)
1775 {
f6b705ef 1776 /* the call to del will trash value, so take a copy now */
a9fd575d 1777 OutputValue(ST(0), value) ;
1f70e1ea 1778 RETVAL = db_del(db, key, R_CURSOR) ;
f6b705ef 1779 if (RETVAL != 0)
6b88bc9c 1780 sv_setsv (ST(0), &PL_sv_undef) ;
a0d0e21e 1781 }
1782 }
1783
1784
1785I32
1786push(db, ...)
1787 DB_File db
045291aa 1788 ALIAS: PUSH = 1
a0d0e21e 1789 CODE:
1790 {
1791 DBTKEY key ;
1792 DBT value ;
4633a7c4 1793 DB * Db = db->dbp ;
a0d0e21e 1794 int i ;
2d8e6c8d 1795 STRLEN n_a;
ccb44e3b 1796 int keyval ;
a0d0e21e 1797
1f70e1ea 1798 DBT_flags(key) ;
1799 DBT_flags(value) ;
8e07c86e 1800 CurrentDB = db ;
ca63f0d2 1801 /* Set the Cursor to the Last element */
1802 RETVAL = do_SEQ(db, key, value, R_LAST) ;
ccb44e3b 1803#ifndef DB_VERSION_MAJOR
ca63f0d2 1804 if (RETVAL >= 0)
ccb44e3b 1805#endif
ca63f0d2 1806 {
ccb44e3b 1807 if (RETVAL == 0)
1808 keyval = *(int*)key.data ;
1809 else
1810 keyval = 0 ;
1811 for (i = 1 ; i < items ; ++i)
8e07c86e 1812 {
2d8e6c8d 1813 value.data = SvPV(ST(i), n_a) ;
1814 value.size = n_a ;
ccb44e3b 1815 ++ keyval ;
1816 key.data = &keyval ;
1817 key.size = sizeof(int) ;
1818 RETVAL = (Db->put)(Db, TXN &key, &value, 0) ;
8e07c86e 1819 if (RETVAL != 0)
1820 break;
1821 }
a0d0e21e 1822 }
1823 }
1824 OUTPUT:
1825 RETVAL
1826
a0d0e21e 1827I32
1828length(db)
1829 DB_File db
045291aa 1830 ALIAS: FETCHSIZE = 1
a0d0e21e 1831 CODE:
8e07c86e 1832 CurrentDB = db ;
b76802f5 1833 RETVAL = GetArrayLength(aTHX_ db) ;
a0d0e21e 1834 OUTPUT:
1835 RETVAL
1836
1837
1838#
1839# Now provide an interface to the rest of the DB functionality
1840#
1841
1842int
1843db_del(db, key, flags=0)
1844 DB_File db
1845 DBTKEY key
1846 u_int flags
1f70e1ea 1847 CODE:
8e07c86e 1848 CurrentDB = db ;
1f70e1ea 1849 RETVAL = db_del(db, key, flags) ;
1850#ifdef DB_VERSION_MAJOR
1851 if (RETVAL > 0)
1852 RETVAL = -1 ;
1853 else if (RETVAL == DB_NOTFOUND)
1854 RETVAL = 1 ;
1855#endif
1856 OUTPUT:
1857 RETVAL
a0d0e21e 1858
1859
1860int
1861db_get(db, key, value, flags=0)
1862 DB_File db
1863 DBTKEY key
a6ed719b 1864 DBT value = NO_INIT
a0d0e21e 1865 u_int flags
1f70e1ea 1866 CODE:
8e07c86e 1867 CurrentDB = db ;
ccb44e3b 1868 DBT_clear(value) ;
1f70e1ea 1869 RETVAL = db_get(db, key, value, flags) ;
1870#ifdef DB_VERSION_MAJOR
1871 if (RETVAL > 0)
1872 RETVAL = -1 ;
1873 else if (RETVAL == DB_NOTFOUND)
1874 RETVAL = 1 ;
1875#endif
a0d0e21e 1876 OUTPUT:
1f70e1ea 1877 RETVAL
a0d0e21e 1878 value
1879
1880int
1881db_put(db, key, value, flags=0)
1882 DB_File db
1883 DBTKEY key
1884 DBT value
1885 u_int flags
1f70e1ea 1886 CODE:
8e07c86e 1887 CurrentDB = db ;
1f70e1ea 1888 RETVAL = db_put(db, key, value, flags) ;
1889#ifdef DB_VERSION_MAJOR
1890 if (RETVAL > 0)
1891 RETVAL = -1 ;
1892 else if (RETVAL == DB_KEYEXIST)
1893 RETVAL = 1 ;
1894#endif
a0d0e21e 1895 OUTPUT:
1f70e1ea 1896 RETVAL
9d9477b1 1897 key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
a0d0e21e 1898
1899int
1900db_fd(db)
1901 DB_File db
1f70e1ea 1902 int status = 0 ;
1903 CODE:
8e07c86e 1904 CurrentDB = db ;
1f70e1ea 1905#ifdef DB_VERSION_MAJOR
1906 RETVAL = -1 ;
1907 status = (db->in_memory
1908 ? -1
1909 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
1910 if (status != 0)
1911 RETVAL = -1 ;
1912#else
1913 RETVAL = (db->in_memory
1914 ? -1
1915 : ((db->dbp)->fd)(db->dbp) ) ;
1916#endif
1917 OUTPUT:
1918 RETVAL
a0d0e21e 1919
1920int
1921db_sync(db, flags=0)
1922 DB_File db
1923 u_int flags
1f70e1ea 1924 CODE:
8e07c86e 1925 CurrentDB = db ;
1f70e1ea 1926 RETVAL = db_sync(db, flags) ;
1927#ifdef DB_VERSION_MAJOR
1928 if (RETVAL > 0)
1929 RETVAL = -1 ;
1930#endif
1931 OUTPUT:
1932 RETVAL
a0d0e21e 1933
1934
1935int
1936db_seq(db, key, value, flags)
1937 DB_File db
1938 DBTKEY key
a6ed719b 1939 DBT value = NO_INIT
a0d0e21e 1940 u_int flags
1f70e1ea 1941 CODE:
8e07c86e 1942 CurrentDB = db ;
ccb44e3b 1943 DBT_clear(value) ;
1f70e1ea 1944 RETVAL = db_seq(db, key, value, flags);
1945#ifdef DB_VERSION_MAJOR
1946 if (RETVAL > 0)
1947 RETVAL = -1 ;
1948 else if (RETVAL == DB_NOTFOUND)
1949 RETVAL = 1 ;
1950#endif
a0d0e21e 1951 OUTPUT:
1f70e1ea 1952 RETVAL
a0d0e21e 1953 key
1954 value
610ab055 1955
9fe6733a 1956#ifdef DBM_FILTERING
1957
1958#define setFilter(type) \
1959 { \
1960 if (db->type) \
cad2e5aa 1961 RETVAL = sv_mortalcopy(db->type) ; \
1962 ST(0) = RETVAL ; \
9fe6733a 1963 if (db->type && (code == &PL_sv_undef)) { \
1964 SvREFCNT_dec(db->type) ; \
1965 db->type = NULL ; \
1966 } \
1967 else if (code) { \
1968 if (db->type) \
1969 sv_setsv(db->type, code) ; \
1970 else \
1971 db->type = newSVsv(code) ; \
1972 } \
1973 }
1974
1975
1976SV *
1977filter_fetch_key(db, code)
1978 DB_File db
1979 SV * code
1980 SV * RETVAL = &PL_sv_undef ;
1981 CODE:
1982 setFilter(filter_fetch_key) ;
9fe6733a 1983
1984SV *
1985filter_store_key(db, code)
1986 DB_File db
1987 SV * code
1988 SV * RETVAL = &PL_sv_undef ;
1989 CODE:
1990 setFilter(filter_store_key) ;
9fe6733a 1991
1992SV *
1993filter_fetch_value(db, code)
1994 DB_File db
1995 SV * code
1996 SV * RETVAL = &PL_sv_undef ;
1997 CODE:
1998 setFilter(filter_fetch_value) ;
9fe6733a 1999
2000SV *
2001filter_store_value(db, code)
2002 DB_File db
2003 SV * code
2004 SV * RETVAL = &PL_sv_undef ;
2005 CODE:
2006 setFilter(filter_store_value) ;
9fe6733a 2007
2008#endif /* DBM_FILTERING */
Unnamed repository; edit this file to name it for gitweb.