projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Refresh DB_File to 1.12
[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
5 written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
b3deed91 6 last modified 12th Mar 1997
7 version 1.12
a0d0e21e 8
9 All comments/suggestions/problems are welcome
10
a0b8c8c1 11 Copyright (c) 1995, 1996, 1997 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
b3deed91 41 1.12 - No change to DB_File.xs
f6b705ef 42
a0d0e21e 43*/
44
45#include "EXTERN.h"
46#include "perl.h"
47#include "XSUB.h"
48
49#include <db.h>
50
51#include <fcntl.h>
52
610ab055 53#ifdef mDB_Prefix_t
54#ifdef DB_Prefix_t
55#undef DB_Prefix_t
56#endif
57#define DB_Prefix_t mDB_Prefix_t
58#endif
59
60#ifdef mDB_Hash_t
61#ifdef DB_Hash_t
62#undef DB_Hash_t
63#endif
64#define DB_Hash_t mDB_Hash_t
65#endif
66
67union INFO {
68 HASHINFO hash ;
69 RECNOINFO recno ;
70 BTREEINFO btree ;
71 } ;
72
8e07c86e 73typedef struct {
74 DBTYPE type ;
75 DB * dbp ;
76 SV * compare ;
77 SV * prefix ;
78 SV * hash ;
a0b8c8c1 79 int in_memory ;
610ab055 80 union INFO info ;
8e07c86e 81 } DB_File_type;
82
83typedef DB_File_type * DB_File ;
a0d0e21e 84typedef DBT DBTKEY ;
85
a0d0e21e 86
610ab055 87/* #define TRACE */
a0d0e21e 88
4633a7c4 89#define db_DESTROY(db) ((db->dbp)->close)(db->dbp)
90#define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
91#define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
92#define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, &key, &value, flags)
a0d0e21e 93
4633a7c4 94#define db_close(db) ((db->dbp)->close)(db->dbp)
95#define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
a0b8c8c1 96#define db_fd(db) (db->in_memory \
97 ? -1 \
98 : ((db->dbp)->fd)(db->dbp) )
4633a7c4 99#define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
100#define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, &key, &value, flags)
101#define db_seq(db, key, value, flags) ((db->dbp)->seq)(db->dbp, &key, &value, flags)
102#define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
a0d0e21e 103
104
88108326 105#define OutputValue(arg, name) \
106 { if (RETVAL == 0) { \
107 sv_setpvn(arg, name.data, name.size) ; \
108 } \
109 }
a0d0e21e 110
111#define OutputKey(arg, name) \
112 { if (RETVAL == 0) \
113 { \
88108326 114 if (db->type != DB_RECNO) { \
a0d0e21e 115 sv_setpvn(arg, name.data, name.size); \
88108326 116 } \
a0d0e21e 117 else \
118 sv_setiv(arg, (I32)*(I32*)name.data - 1); \
119 } \
120 }
121
122/* Internal Global Data */
8e07c86e 123static recno_t Value ;
124static DB_File CurrentDB ;
125static recno_t zero = 0 ;
126static DBTKEY empty = { &zero, sizeof(recno_t) } ;
a0d0e21e 127
128
129static int
130btree_compare(key1, key2)
131const DBT * key1 ;
132const DBT * key2 ;
133{
134 dSP ;
135 void * data1, * data2 ;
136 int retval ;
137 int count ;
138
139 data1 = key1->data ;
140 data2 = key2->data ;
141
142 /* As newSVpv will assume that the data pointer is a null terminated C
143 string if the size parameter is 0, make sure that data points to an
144 empty string if the length is 0
145 */
146 if (key1->size == 0)
147 data1 = "" ;
148 if (key2->size == 0)
149 data2 = "" ;
150
151 ENTER ;
152 SAVETMPS;
153
154 PUSHMARK(sp) ;
155 EXTEND(sp,2) ;
156 PUSHs(sv_2mortal(newSVpv(data1,key1->size)));
157 PUSHs(sv_2mortal(newSVpv(data2,key2->size)));
158 PUTBACK ;
159
8e07c86e 160 count = perl_call_sv(CurrentDB->compare, G_SCALAR);
a0d0e21e 161
162 SPAGAIN ;
163
164 if (count != 1)
ff0cee69 165 croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
a0d0e21e 166
167 retval = POPi ;
168
169 PUTBACK ;
170 FREETMPS ;
171 LEAVE ;
172 return (retval) ;
173
174}
175
ecfc5424 176static DB_Prefix_t
a0d0e21e 177btree_prefix(key1, key2)
178const DBT * key1 ;
179const DBT * key2 ;
180{
181 dSP ;
182 void * data1, * data2 ;
183 int retval ;
184 int count ;
185
186 data1 = key1->data ;
187 data2 = key2->data ;
188
189 /* As newSVpv will assume that the data pointer is a null terminated C
190 string if the size parameter is 0, make sure that data points to an
191 empty string if the length is 0
192 */
193 if (key1->size == 0)
194 data1 = "" ;
195 if (key2->size == 0)
196 data2 = "" ;
197
198 ENTER ;
199 SAVETMPS;
200
201 PUSHMARK(sp) ;
202 EXTEND(sp,2) ;
203 PUSHs(sv_2mortal(newSVpv(data1,key1->size)));
204 PUSHs(sv_2mortal(newSVpv(data2,key2->size)));
205 PUTBACK ;
206
8e07c86e 207 count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
a0d0e21e 208
209 SPAGAIN ;
210
211 if (count != 1)
ff0cee69 212 croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
a0d0e21e 213
214 retval = POPi ;
215
216 PUTBACK ;
217 FREETMPS ;
218 LEAVE ;
219
220 return (retval) ;
221}
222
ecfc5424 223static DB_Hash_t
a0d0e21e 224hash_cb(data, size)
225const void * data ;
226size_t size ;
227{
228 dSP ;
229 int retval ;
230 int count ;
231
232 if (size == 0)
233 data = "" ;
234
610ab055 235 /* DGH - Next two lines added to fix corrupted stack problem */
236 ENTER ;
237 SAVETMPS;
238
a0d0e21e 239 PUSHMARK(sp) ;
610ab055 240
a0d0e21e 241 XPUSHs(sv_2mortal(newSVpv((char*)data,size)));
242 PUTBACK ;
243
8e07c86e 244 count = perl_call_sv(CurrentDB->hash, G_SCALAR);
a0d0e21e 245
246 SPAGAIN ;
247
248 if (count != 1)
ff0cee69 249 croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
a0d0e21e 250
251 retval = POPi ;
252
253 PUTBACK ;
254 FREETMPS ;
255 LEAVE ;
256
257 return (retval) ;
258}
259
260
261#ifdef TRACE
262
263static void
264PrintHash(hash)
610ab055 265HASHINFO * hash ;
a0d0e21e 266{
267 printf ("HASH Info\n") ;
610ab055 268 printf (" hash = %s\n", (hash->hash != NULL ? "redefined" : "default")) ;
269 printf (" bsize = %d\n", hash->bsize) ;
270 printf (" ffactor = %d\n", hash->ffactor) ;
271 printf (" nelem = %d\n", hash->nelem) ;
272 printf (" cachesize = %d\n", hash->cachesize) ;
273 printf (" lorder = %d\n", hash->lorder) ;
a0d0e21e 274
275}
276
277static void
278PrintRecno(recno)
610ab055 279RECNOINFO * recno ;
a0d0e21e 280{
281 printf ("RECNO Info\n") ;
610ab055 282 printf (" flags = %d\n", recno->flags) ;
283 printf (" cachesize = %d\n", recno->cachesize) ;
284 printf (" psize = %d\n", recno->psize) ;
285 printf (" lorder = %d\n", recno->lorder) ;
286 printf (" reclen = %d\n", recno->reclen) ;
36477c24 287 printf (" bval = %d 0x%x\n", recno->bval, recno->bval) ;
610ab055 288 printf (" bfname = %d [%s]\n", recno->bfname, recno->bfname) ;
a0d0e21e 289}
290
ff68c719 291static void
a0d0e21e 292PrintBtree(btree)
610ab055 293BTREEINFO * btree ;
a0d0e21e 294{
295 printf ("BTREE Info\n") ;
610ab055 296 printf (" compare = %s\n", (btree->compare ? "redefined" : "default")) ;
297 printf (" prefix = %s\n", (btree->prefix ? "redefined" : "default")) ;
298 printf (" flags = %d\n", btree->flags) ;
299 printf (" cachesize = %d\n", btree->cachesize) ;
300 printf (" psize = %d\n", btree->psize) ;
301 printf (" maxkeypage = %d\n", btree->maxkeypage) ;
302 printf (" minkeypage = %d\n", btree->minkeypage) ;
303 printf (" lorder = %d\n", btree->lorder) ;
a0d0e21e 304}
305
306#else
307
308#define PrintRecno(recno)
309#define PrintHash(hash)
310#define PrintBtree(btree)
311
312#endif /* TRACE */
313
314
315static I32
316GetArrayLength(db)
8e07c86e 317DB * db ;
a0d0e21e 318{
319 DBT key ;
320 DBT value ;
321 int RETVAL ;
322
323 RETVAL = (db->seq)(db, &key, &value, R_LAST) ;
324 if (RETVAL == 0)
325 RETVAL = *(I32 *)key.data ;
326 else if (RETVAL == 1) /* No key means empty file */
327 RETVAL = 0 ;
328
a0b8c8c1 329 return ((I32)RETVAL) ;
a0d0e21e 330}
331
88108326 332static recno_t
333GetRecnoKey(db, value)
334DB_File db ;
335I32 value ;
336{
337 if (value < 0) {
338 /* Get the length of the array */
339 I32 length = GetArrayLength(db->dbp) ;
340
341 /* check for attempt to write before start of array */
342 if (length + value + 1 <= 0)
ff0cee69 343 croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
88108326 344
345 value = length + value + 1 ;
346 }
347 else
348 ++ value ;
349
350 return value ;
351}
352
a0d0e21e 353static DB_File
610ab055 354ParseOpenInfo(name, flags, mode, sv)
a0d0e21e 355char * name ;
356int flags ;
357int mode ;
358SV * sv ;
a0d0e21e 359{
360 SV ** svp;
361 HV * action ;
8e07c86e 362 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
a0d0e21e 363 void * openinfo = NULL ;
610ab055 364 union INFO * info = &RETVAL->info ;
a0d0e21e 365
88108326 366 /* Default to HASH */
8e07c86e 367 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
368 RETVAL->type = DB_HASH ;
a0d0e21e 369
610ab055 370 /* DGH - Next line added to avoid SEGV on existing hash DB */
371 CurrentDB = RETVAL;
372
a0b8c8c1 373 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
374 RETVAL->in_memory = (name == NULL) ;
375
a0d0e21e 376 if (sv)
377 {
378 if (! SvROK(sv) )
379 croak ("type parameter is not a reference") ;
380
36477c24 381 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
382 if (svp && SvOK(*svp))
383 action = (HV*) SvRV(*svp) ;
384 else
385 croak("internal error") ;
610ab055 386
a0d0e21e 387 if (sv_isa(sv, "DB_File::HASHINFO"))
388 {
8e07c86e 389 RETVAL->type = DB_HASH ;
610ab055 390 openinfo = (void*)info ;
a0d0e21e 391
392 svp = hv_fetch(action, "hash", 4, FALSE);
393
394 if (svp && SvOK(*svp))
395 {
610ab055 396 info->hash.hash = hash_cb ;
8e07c86e 397 RETVAL->hash = newSVsv(*svp) ;
a0d0e21e 398 }
399 else
610ab055 400 info->hash.hash = NULL ;
a0d0e21e 401
402 svp = hv_fetch(action, "bsize", 5, FALSE);
610ab055 403 info->hash.bsize = svp ? SvIV(*svp) : 0;
a0d0e21e 404
405 svp = hv_fetch(action, "ffactor", 7, FALSE);
610ab055 406 info->hash.ffactor = svp ? SvIV(*svp) : 0;
a0d0e21e 407
408 svp = hv_fetch(action, "nelem", 5, FALSE);
610ab055 409 info->hash.nelem = svp ? SvIV(*svp) : 0;
a0d0e21e 410
411 svp = hv_fetch(action, "cachesize", 9, FALSE);
610ab055 412 info->hash.cachesize = svp ? SvIV(*svp) : 0;
a0d0e21e 413
414 svp = hv_fetch(action, "lorder", 6, FALSE);
610ab055 415 info->hash.lorder = svp ? SvIV(*svp) : 0;
a0d0e21e 416
417 PrintHash(info) ;
418 }
419 else if (sv_isa(sv, "DB_File::BTREEINFO"))
420 {
8e07c86e 421 RETVAL->type = DB_BTREE ;
610ab055 422 openinfo = (void*)info ;
a0d0e21e 423
424 svp = hv_fetch(action, "compare", 7, FALSE);
425 if (svp && SvOK(*svp))
426 {
610ab055 427 info->btree.compare = btree_compare ;
8e07c86e 428 RETVAL->compare = newSVsv(*svp) ;
a0d0e21e 429 }
430 else
610ab055 431 info->btree.compare = NULL ;
a0d0e21e 432
433 svp = hv_fetch(action, "prefix", 6, FALSE);
434 if (svp && SvOK(*svp))
435 {
610ab055 436 info->btree.prefix = btree_prefix ;
8e07c86e 437 RETVAL->prefix = newSVsv(*svp) ;
a0d0e21e 438 }
439 else
610ab055 440 info->btree.prefix = NULL ;
a0d0e21e 441
442 svp = hv_fetch(action, "flags", 5, FALSE);
610ab055 443 info->btree.flags = svp ? SvIV(*svp) : 0;
a0d0e21e 444
445 svp = hv_fetch(action, "cachesize", 9, FALSE);
610ab055 446 info->btree.cachesize = svp ? SvIV(*svp) : 0;
a0d0e21e 447
448 svp = hv_fetch(action, "minkeypage", 10, FALSE);
610ab055 449 info->btree.minkeypage = svp ? SvIV(*svp) : 0;
a0d0e21e 450
451 svp = hv_fetch(action, "maxkeypage", 10, FALSE);
610ab055 452 info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
a0d0e21e 453
454 svp = hv_fetch(action, "psize", 5, FALSE);
610ab055 455 info->btree.psize = svp ? SvIV(*svp) : 0;
a0d0e21e 456
457 svp = hv_fetch(action, "lorder", 6, FALSE);
610ab055 458 info->btree.lorder = svp ? SvIV(*svp) : 0;
a0d0e21e 459
460 PrintBtree(info) ;
461
462 }
463 else if (sv_isa(sv, "DB_File::RECNOINFO"))
464 {
8e07c86e 465 RETVAL->type = DB_RECNO ;
610ab055 466 openinfo = (void *)info ;
a0d0e21e 467
468 svp = hv_fetch(action, "flags", 5, FALSE);
610ab055 469 info->recno.flags = (u_long) svp ? SvIV(*svp) : 0;
a0d0e21e 470
471 svp = hv_fetch(action, "cachesize", 9, FALSE);
610ab055 472 info->recno.cachesize = (u_int) svp ? SvIV(*svp) : 0;
a0d0e21e 473
474 svp = hv_fetch(action, "psize", 5, FALSE);
610ab055 475 info->recno.psize = (int) svp ? SvIV(*svp) : 0;
a0d0e21e 476
477 svp = hv_fetch(action, "lorder", 6, FALSE);
610ab055 478 info->recno.lorder = (int) svp ? SvIV(*svp) : 0;
a0d0e21e 479
480 svp = hv_fetch(action, "reclen", 6, FALSE);
610ab055 481 info->recno.reclen = (size_t) svp ? SvIV(*svp) : 0;
a0d0e21e 482
483 svp = hv_fetch(action, "bval", 4, FALSE);
484 if (svp && SvOK(*svp))
485 {
486 if (SvPOK(*svp))
610ab055 487 info->recno.bval = (u_char)*SvPV(*svp, na) ;
a0d0e21e 488 else
610ab055 489 info->recno.bval = (u_char)(unsigned long) SvIV(*svp) ;
a0d0e21e 490 }
491 else
492 {
610ab055 493 if (info->recno.flags & R_FIXEDLEN)
494 info->recno.bval = (u_char) ' ' ;
a0d0e21e 495 else
610ab055 496 info->recno.bval = (u_char) '\n' ;
a0d0e21e 497 }
498
499 svp = hv_fetch(action, "bfname", 6, FALSE);
36477c24 500 if (svp && SvOK(*svp)) {
88108326 501 char * ptr = SvPV(*svp,na) ;
36477c24 502 info->recno.bfname = (char*) na ? ptr : NULL ;
88108326 503 }
36477c24 504 else
505 info->recno.bfname = NULL ;
a0d0e21e 506
507 PrintRecno(info) ;
508 }
509 else
510 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
511 }
512
513
88108326 514 /* OS2 Specific Code */
515#ifdef OS2
516#ifdef __EMX__
517 flags |= O_BINARY;
518#endif /* __EMX__ */
519#endif /* OS2 */
a0d0e21e 520
88108326 521 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
a0d0e21e 522
523 return (RETVAL) ;
524}
525
526
527static int
528not_here(s)
529char *s;
530{
531 croak("DB_File::%s not implemented on this architecture", s);
532 return -1;
533}
534
535static double
536constant(name, arg)
537char *name;
538int arg;
539{
540 errno = 0;
541 switch (*name) {
542 case 'A':
543 break;
544 case 'B':
545 if (strEQ(name, "BTREEMAGIC"))
546#ifdef BTREEMAGIC
547 return BTREEMAGIC;
548#else
549 goto not_there;
550#endif
551 if (strEQ(name, "BTREEVERSION"))
552#ifdef BTREEVERSION
553 return BTREEVERSION;
554#else
555 goto not_there;
556#endif
557 break;
558 case 'C':
559 break;
560 case 'D':
561 if (strEQ(name, "DB_LOCK"))
562#ifdef DB_LOCK
563 return DB_LOCK;
564#else
565 goto not_there;
566#endif
567 if (strEQ(name, "DB_SHMEM"))
568#ifdef DB_SHMEM
569 return DB_SHMEM;
570#else
571 goto not_there;
572#endif
573 if (strEQ(name, "DB_TXN"))
574#ifdef DB_TXN
575 return (U32)DB_TXN;
576#else
577 goto not_there;
578#endif
579 break;
580 case 'E':
581 break;
582 case 'F':
583 break;
584 case 'G':
585 break;
586 case 'H':
587 if (strEQ(name, "HASHMAGIC"))
588#ifdef HASHMAGIC
589 return HASHMAGIC;
590#else
591 goto not_there;
592#endif
593 if (strEQ(name, "HASHVERSION"))
594#ifdef HASHVERSION
595 return HASHVERSION;
596#else
597 goto not_there;
598#endif
599 break;
600 case 'I':
601 break;
602 case 'J':
603 break;
604 case 'K':
605 break;
606 case 'L':
607 break;
608 case 'M':
609 if (strEQ(name, "MAX_PAGE_NUMBER"))
610#ifdef MAX_PAGE_NUMBER
611 return (U32)MAX_PAGE_NUMBER;
612#else
613 goto not_there;
614#endif
615 if (strEQ(name, "MAX_PAGE_OFFSET"))
616#ifdef MAX_PAGE_OFFSET
617 return MAX_PAGE_OFFSET;
618#else
619 goto not_there;
620#endif
621 if (strEQ(name, "MAX_REC_NUMBER"))
622#ifdef MAX_REC_NUMBER
623 return (U32)MAX_REC_NUMBER;
624#else
625 goto not_there;
626#endif
627 break;
628 case 'N':
629 break;
630 case 'O':
631 break;
632 case 'P':
633 break;
634 case 'Q':
635 break;
636 case 'R':
637 if (strEQ(name, "RET_ERROR"))
638#ifdef RET_ERROR
639 return RET_ERROR;
640#else
641 goto not_there;
642#endif
643 if (strEQ(name, "RET_SPECIAL"))
644#ifdef RET_SPECIAL
645 return RET_SPECIAL;
646#else
647 goto not_there;
648#endif
649 if (strEQ(name, "RET_SUCCESS"))
650#ifdef RET_SUCCESS
651 return RET_SUCCESS;
652#else
653 goto not_there;
654#endif
655 if (strEQ(name, "R_CURSOR"))
656#ifdef R_CURSOR
657 return R_CURSOR;
658#else
659 goto not_there;
660#endif
661 if (strEQ(name, "R_DUP"))
662#ifdef R_DUP
663 return R_DUP;
664#else
665 goto not_there;
666#endif
667 if (strEQ(name, "R_FIRST"))
668#ifdef R_FIRST
669 return R_FIRST;
670#else
671 goto not_there;
672#endif
673 if (strEQ(name, "R_FIXEDLEN"))
674#ifdef R_FIXEDLEN
675 return R_FIXEDLEN;
676#else
677 goto not_there;
678#endif
679 if (strEQ(name, "R_IAFTER"))
680#ifdef R_IAFTER
681 return R_IAFTER;
682#else
683 goto not_there;
684#endif
685 if (strEQ(name, "R_IBEFORE"))
686#ifdef R_IBEFORE
687 return R_IBEFORE;
688#else
689 goto not_there;
690#endif
691 if (strEQ(name, "R_LAST"))
692#ifdef R_LAST
693 return R_LAST;
694#else
695 goto not_there;
696#endif
697 if (strEQ(name, "R_NEXT"))
698#ifdef R_NEXT
699 return R_NEXT;
700#else
701 goto not_there;
702#endif
703 if (strEQ(name, "R_NOKEY"))
704#ifdef R_NOKEY
705 return R_NOKEY;
706#else
707 goto not_there;
708#endif
709 if (strEQ(name, "R_NOOVERWRITE"))
710#ifdef R_NOOVERWRITE
711 return R_NOOVERWRITE;
712#else
713 goto not_there;
714#endif
715 if (strEQ(name, "R_PREV"))
716#ifdef R_PREV
717 return R_PREV;
718#else
719 goto not_there;
720#endif
721 if (strEQ(name, "R_RECNOSYNC"))
722#ifdef R_RECNOSYNC
723 return R_RECNOSYNC;
724#else
725 goto not_there;
726#endif
727 if (strEQ(name, "R_SETCURSOR"))
728#ifdef R_SETCURSOR
729 return R_SETCURSOR;
730#else
731 goto not_there;
732#endif
733 if (strEQ(name, "R_SNAPSHOT"))
734#ifdef R_SNAPSHOT
735 return R_SNAPSHOT;
736#else
737 goto not_there;
738#endif
739 break;
740 case 'S':
741 break;
742 case 'T':
743 break;
744 case 'U':
745 break;
746 case 'V':
747 break;
748 case 'W':
749 break;
750 case 'X':
751 break;
752 case 'Y':
753 break;
754 case 'Z':
755 break;
756 case '_':
757 if (strEQ(name, "__R_UNUSED"))
758#ifdef __R_UNUSED
759 return __R_UNUSED;
760#else
761 goto not_there;
762#endif
763 break;
764 }
765 errno = EINVAL;
766 return 0;
767
768not_there:
769 errno = ENOENT;
770 return 0;
771}
772
773MODULE = DB_File PACKAGE = DB_File PREFIX = db_
774
775double
776constant(name,arg)
777 char * name
778 int arg
779
780
781DB_File
18d2dc8c 782db_DoTie_(dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
a0d0e21e 783 char * dbtype
784 int flags
785 int mode
786 CODE:
787 {
788 char * name = (char *) NULL ;
789 SV * sv = (SV *) NULL ;
790
791 if (items >= 2 && SvOK(ST(1)))
792 name = (char*) SvPV(ST(1), na) ;
793
794 if (items == 5)
795 sv = ST(4) ;
796
610ab055 797 RETVAL = ParseOpenInfo(name, flags, mode, sv) ;
4633a7c4 798 if (RETVAL->dbp == NULL)
799 RETVAL = NULL ;
a0d0e21e 800 }
801 OUTPUT:
802 RETVAL
803
a0d0e21e 804int
805db_DESTROY(db)
806 DB_File db
8e07c86e 807 INIT:
808 CurrentDB = db ;
809 CLEANUP:
810 if (db->hash)
811 SvREFCNT_dec(db->hash) ;
812 if (db->compare)
813 SvREFCNT_dec(db->compare) ;
814 if (db->prefix)
815 SvREFCNT_dec(db->prefix) ;
816 Safefree(db) ;
a0d0e21e 817
818
819int
820db_DELETE(db, key, flags=0)
821 DB_File db
822 DBTKEY key
823 u_int flags
8e07c86e 824 INIT:
825 CurrentDB = db ;
a0d0e21e 826
f6b705ef 827
828int
829db_EXISTS(db, key)
830 DB_File db
831 DBTKEY key
832 CODE:
833 {
834 DBT value ;
835
836 CurrentDB = db ;
837 RETVAL = (((db->dbp)->get)(db->dbp, &key, &value, 0) == 0) ;
838 }
839 OUTPUT:
840 RETVAL
841
a0d0e21e 842int
843db_FETCH(db, key, flags=0)
844 DB_File db
845 DBTKEY key
846 u_int flags
847 CODE:
848 {
849 DBT value ;
850
8e07c86e 851 CurrentDB = db ;
4633a7c4 852 RETVAL = ((db->dbp)->get)(db->dbp, &key, &value, flags) ;
a0d0e21e 853 ST(0) = sv_newmortal();
854 if (RETVAL == 0)
855 sv_setpvn(ST(0), value.data, value.size);
856 }
857
858int
859db_STORE(db, key, value, flags=0)
860 DB_File db
861 DBTKEY key
862 DBT value
863 u_int flags
8e07c86e 864 INIT:
865 CurrentDB = db ;
a0d0e21e 866
867
868int
869db_FIRSTKEY(db)
870 DB_File db
871 CODE:
872 {
873 DBTKEY key ;
874 DBT value ;
4633a7c4 875 DB * Db = db->dbp ;
a0d0e21e 876
8e07c86e 877 CurrentDB = db ;
4633a7c4 878 RETVAL = (Db->seq)(Db, &key, &value, R_FIRST) ;
a0d0e21e 879 ST(0) = sv_newmortal();
880 if (RETVAL == 0)
881 {
4633a7c4 882 if (Db->type != DB_RECNO)
a0d0e21e 883 sv_setpvn(ST(0), key.data, key.size);
884 else
885 sv_setiv(ST(0), (I32)*(I32*)key.data - 1);
886 }
887 }
888
889int
890db_NEXTKEY(db, key)
891 DB_File db
892 DBTKEY key
893 CODE:
894 {
895 DBT value ;
4633a7c4 896 DB * Db = db->dbp ;
a0d0e21e 897
8e07c86e 898 CurrentDB = db ;
4633a7c4 899 RETVAL = (Db->seq)(Db, &key, &value, R_NEXT) ;
a0d0e21e 900 ST(0) = sv_newmortal();
901 if (RETVAL == 0)
902 {
4633a7c4 903 if (Db->type != DB_RECNO)
a0d0e21e 904 sv_setpvn(ST(0), key.data, key.size);
905 else
906 sv_setiv(ST(0), (I32)*(I32*)key.data - 1);
907 }
908 }
909
910#
911# These would be nice for RECNO
912#
913
914int
915unshift(db, ...)
916 DB_File db
917 CODE:
918 {
919 DBTKEY key ;
920 DBT value ;
921 int i ;
922 int One ;
4633a7c4 923 DB * Db = db->dbp ;
a0d0e21e 924
8e07c86e 925 CurrentDB = db ;
a0d0e21e 926 RETVAL = -1 ;
927 for (i = items-1 ; i > 0 ; --i)
928 {
929 value.data = SvPV(ST(i), na) ;
930 value.size = na ;
931 One = 1 ;
932 key.data = &One ;
933 key.size = sizeof(int) ;
4633a7c4 934 RETVAL = (Db->put)(Db, &key, &value, R_IBEFORE) ;
a0d0e21e 935 if (RETVAL != 0)
936 break;
937 }
938 }
939 OUTPUT:
940 RETVAL
941
942I32
943pop(db)
944 DB_File db
945 CODE:
946 {
947 DBTKEY key ;
948 DBT value ;
4633a7c4 949 DB * Db = db->dbp ;
a0d0e21e 950
8e07c86e 951 CurrentDB = db ;
a0d0e21e 952 /* First get the final value */
4633a7c4 953 RETVAL = (Db->seq)(Db, &key, &value, R_LAST) ;
a0d0e21e 954 ST(0) = sv_newmortal();
955 /* Now delete it */
956 if (RETVAL == 0)
957 {
f6b705ef 958 /* the call to del will trash value, so take a copy now */
959 sv_setpvn(ST(0), value.data, value.size);
4633a7c4 960 RETVAL = (Db->del)(Db, &key, R_CURSOR) ;
f6b705ef 961 if (RETVAL != 0)
962 sv_setsv(ST(0), &sv_undef);
a0d0e21e 963 }
964 }
965
966I32
967shift(db)
968 DB_File db
969 CODE:
970 {
a0d0e21e 971 DBT value ;
f6b705ef 972 DBTKEY key ;
4633a7c4 973 DB * Db = db->dbp ;
a0d0e21e 974
8e07c86e 975 CurrentDB = db ;
a0d0e21e 976 /* get the first value */
f6b705ef 977 RETVAL = (Db->seq)(Db, &key, &value, R_FIRST) ;
a0d0e21e 978 ST(0) = sv_newmortal();
979 /* Now delete it */
980 if (RETVAL == 0)
981 {
f6b705ef 982 /* the call to del will trash value, so take a copy now */
983 sv_setpvn(ST(0), value.data, value.size);
984 RETVAL = (Db->del)(Db, &key, R_CURSOR) ;
985 if (RETVAL != 0)
986 sv_setsv (ST(0), &sv_undef) ;
a0d0e21e 987 }
988 }
989
990
991I32
992push(db, ...)
993 DB_File db
994 CODE:
995 {
996 DBTKEY key ;
8e07c86e 997 DBTKEY * keyptr = &key ;
a0d0e21e 998 DBT value ;
4633a7c4 999 DB * Db = db->dbp ;
a0d0e21e 1000 int i ;
1001
8e07c86e 1002 CurrentDB = db ;
a0d0e21e 1003 /* Set the Cursor to the Last element */
4633a7c4 1004 RETVAL = (Db->seq)(Db, &key, &value, R_LAST) ;
8e07c86e 1005 if (RETVAL >= 0)
a0d0e21e 1006 {
8e07c86e 1007 if (RETVAL == 1)
1008 keyptr = &empty ;
1009 for (i = items - 1 ; i > 0 ; --i)
1010 {
1011 value.data = SvPV(ST(i), na) ;
1012 value.size = na ;
4633a7c4 1013 RETVAL = (Db->put)(Db, keyptr, &value, R_IAFTER) ;
8e07c86e 1014 if (RETVAL != 0)
1015 break;
1016 }
a0d0e21e 1017 }
1018 }
1019 OUTPUT:
1020 RETVAL
1021
1022
1023I32
1024length(db)
1025 DB_File db
1026 CODE:
8e07c86e 1027 CurrentDB = db ;
1028 RETVAL = GetArrayLength(db->dbp) ;
a0d0e21e 1029 OUTPUT:
1030 RETVAL
1031
1032
1033#
1034# Now provide an interface to the rest of the DB functionality
1035#
1036
1037int
1038db_del(db, key, flags=0)
1039 DB_File db
1040 DBTKEY key
1041 u_int flags
8e07c86e 1042 INIT:
1043 CurrentDB = db ;
a0d0e21e 1044
1045
1046int
1047db_get(db, key, value, flags=0)
1048 DB_File db
1049 DBTKEY key
1050 DBT value
1051 u_int flags
8e07c86e 1052 INIT:
1053 CurrentDB = db ;
a0d0e21e 1054 OUTPUT:
1055 value
1056
1057int
1058db_put(db, key, value, flags=0)
1059 DB_File db
1060 DBTKEY key
1061 DBT value
1062 u_int flags
8e07c86e 1063 INIT:
1064 CurrentDB = db ;
a0d0e21e 1065 OUTPUT:
1066 key if (flags & (R_IAFTER|R_IBEFORE)) OutputKey(ST(1), key);
1067
1068int
1069db_fd(db)
1070 DB_File db
8e07c86e 1071 INIT:
1072 CurrentDB = db ;
a0d0e21e 1073
1074int
1075db_sync(db, flags=0)
1076 DB_File db
1077 u_int flags
8e07c86e 1078 INIT:
1079 CurrentDB = db ;
a0d0e21e 1080
1081
1082int
1083db_seq(db, key, value, flags)
1084 DB_File db
1085 DBTKEY key
1086 DBT value
1087 u_int flags
8e07c86e 1088 INIT:
1089 CurrentDB = db ;
a0d0e21e 1090 OUTPUT:
1091 key
1092 value
610ab055 1093
Unnamed repository; edit this file to name it for gitweb.