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