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