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