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