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