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