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