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