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