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