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