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