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