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