1 /* 2 3 DB_File.xs -- Perl 5 interface to Berkeley DB 4 5 Written by Paul Marquess <pmqs@cpan.org> 6 7 All comments/suggestions/problems are welcome 8 9 Copyright (c) 1995-2013 Paul Marquess. All rights reserved. 10 This program is free software; you can redistribute it and/or 11 modify it under the same terms as Perl itself. 12 13 Changes: 14 0.1 - Initial Release 15 0.2 - No longer bombs out if dbopen returns an error. 16 0.3 - Added some support for multiple btree compares 17 1.0 - Complete support for multiple callbacks added. 18 Fixed a problem with pushing a value onto an empty list. 19 1.01 - Fixed a SunOS core dump problem. 20 The return value from TIEHASH wasn't set to NULL when 21 dbopen returned an error. 22 1.02 - Use ALIAS to define TIEARRAY. 23 Removed some redundant commented code. 24 Merged OS2 code into the main distribution. 25 Allow negative subscripts with RECNO interface. 26 Changed the default flags to O_CREAT|O_RDWR 27 1.03 - Added EXISTS 28 1.04 - fixed a couple of bugs in hash_cb. Patches supplied by 29 Dave Hammen, hammen@gothamcity.jsc.nasa.gov 30 1.05 - Added logic to allow prefix & hash types to be specified via 31 Makefile.PL 32 1.06 - Minor namespace cleanup: Localized PrintBtree. 33 1.07 - Fixed bug with RECNO, where bval wasn't defaulting to "\n". 34 1.08 - No change to DB_File.xs 35 1.09 - Default mode for dbopen changed to 0666 36 1.10 - Fixed fd method so that it still returns -1 for 37 in-memory files when db 1.86 is used. 38 1.11 - No change to DB_File.xs 39 1.12 - No change to DB_File.xs 40 1.13 - Tidied up a few casts. 41 1.14 - Made it illegal to tie an associative array to a RECNO 42 database and an ordinary array to a HASH or BTREE database. 43 1.50 - Make work with both DB 1.x or DB 2.x 44 1.51 - Fixed a bug in mapping 1.x O_RDONLY flag to 2.x DB_RDONLY equivalent 45 1.52 - Patch from Gisle Aas <gisle@aas.no> to suppress "use of 46 undefined value" warning with db_get and db_seq. 47 1.53 - Added DB_RENUMBER to flags for recno. 48 1.54 - Fixed bug in the fd method 49 1.55 - Fix for AIX from Jarkko Hietaniemi 50 1.56 - No change to DB_File.xs 51 1.57 - added the #undef op to allow building with Threads support. 52 1.58 - Fixed a problem with the use of sv_setpvn. When the 53 size is specified as 0, it does a strlen on the data. 54 This was ok for DB 1.x, but isn't for DB 2.x. 55 1.59 - No change to DB_File.xs 56 1.60 - Some code tidy up 57 1.61 - added flagSet macro for DB 2.5.x 58 fixed typo in O_RDONLY test. 59 1.62 - No change to DB_File.xs 60 1.63 - Fix to alllow DB 2.6.x to build. 61 1.64 - Tidied up the 1.x to 2.x flags mapping code. 62 Added a patch from Mark Kettenis <kettenis@wins.uva.nl> 63 to fix a flag mapping problem with O_RDONLY on the Hurd 64 1.65 - Fixed a bug in the PUSH logic. 65 Added BOOT check that using 2.3.4 or greater 66 1.66 - Added DBM filter code 67 1.67 - Backed off the use of newSVpvn. 68 Fixed DBM Filter code for Perl 5.004. 69 Fixed a small memory leak in the filter code. 70 1.68 - fixed backward compatibility bug with R_IAFTER & R_IBEFORE 71 merged in the 5.005_58 changes 72 1.69 - fixed a bug in push -- DB_APPEND wasn't working properly. 73 Fixed the R_SETCURSOR bug introduced in 1.68 74 Added a new Perl variable $DB_File::db_ver 75 1.70 - Initialise $DB_File::db_ver and $DB_File::db_version with 76 GV_ADD|GV_ADDMULT -- bug spotted by Nick Ing-Simmons. 77 Added a BOOT check to test for equivalent versions of db.h & 78 libdb.a/so. 79 1.71 - Support for Berkeley DB version 3. 80 Support for Berkeley DB 2/3's backward compatibility mode. 81 Rewrote push 82 1.72 - No change to DB_File.xs 83 1.73 - No change to DB_File.xs 84 1.74 - A call to open needed parenthesised to stop it clashing 85 with a win32 macro. 86 Added Perl core patches 7703 & 7801. 87 1.75 - Fixed Perl core patch 7703. 88 Added support to allow DB_File to be built with 89 Berkeley DB 3.2 -- btree_compare, btree_prefix and hash_cb 90 needed to be changed. 91 1.76 - No change to DB_File.xs 92 1.77 - Tidied up a few types used in calling newSVpvn. 93 1.78 - Core patch 10335, 10372, 10534, 10549, 11051 included. 94 1.79 - NEXTKEY ignores the input key. 95 Added lots of casts 96 1.800 - Moved backward compatibility code into ppport.h. 97 Use the new constants code. 98 1.801 - No change to DB_File.xs 99 1.802 - No change to DB_File.xs 100 1.803 - FETCH, STORE & DELETE don't map the flags parameter 101 into the equivalent Berkeley DB function anymore. 102 1.804 - no change. 103 1.805 - recursion detection added to the callbacks 104 Support for 4.1.X added. 105 Filter code can now cope with read-only $_ 106 1.806 - recursion detection beefed up. 107 1.807 - no change 108 1.808 - leak fixed in ParseOpenInfo 109 1.809 - no change 110 1.810 - no change 111 1.811 - no change 112 1.812 - no change 113 1.813 - no change 114 1.814 - no change 115 1.814 - C++ casting fixes 116 117 */ 118 119 #define PERL_NO_GET_CONTEXT 120 #include "EXTERN.h" 121 #include "perl.h" 122 #include "XSUB.h" 123 124 #ifdef _NOT_CORE 125 # include "ppport.h" 126 #endif 127 128 /* Mention DB_VERSION_MAJOR_CFG, DB_VERSION_MINOR_CFG, and 129 DB_VERSION_PATCH_CFG here so that Configure pulls them all in. */ 130 131 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be 132 * shortly #included by the <db.h>) __attribute__ to the possibly 133 * already defined __attribute__, for example by GNUC or by Perl. */ 134 135 /* #if DB_VERSION_MAJOR_CFG < 2 */ 136 #ifndef DB_VERSION_MAJOR 137 # undef __attribute__ 138 #endif 139 140 #ifdef COMPAT185 141 # include <db_185.h> 142 #else 143 144 /* Uncomment one of the lines below */ 145 /* See the section "At least one secondary cursor must be specified to DB->join" 146 in the README file for the circumstances where you need to uncomment one 147 of the two lines below. 148 */ 149 150 /* #define time_t __time64_t */ 151 /* #define time_t __time32_t */ 152 153 # include <db.h> 154 #endif 155 156 /* Wall starts with 5.7.x */ 157 158 #if PERL_REVISION > 5 || (PERL_REVISION == 5 && PERL_VERSION >= 7) 159 160 /* Since we dropped the gccish definition of __attribute__ we will want 161 * to redefine dNOOP, however (so that dTHX continues to work). Yes, 162 * all this means that we can't do attribute checking on the DB_File, 163 * boo, hiss. */ 164 # ifndef DB_VERSION_MAJOR 165 166 # undef dNOOP 167 # define dNOOP extern int Perl___notused 168 169 /* Ditto for dXSARGS. */ 170 # undef dXSARGS 171 # define dXSARGS \ 172 dSP; dMARK; \ 173 I32 ax = mark - PL_stack_base + 1; \ 174 I32 items = sp - mark 175 176 # endif 177 178 /* avoid -Wall; DB_File xsubs never make use of `ix' setup for ALIASes */ 179 # undef dXSI32 180 # define dXSI32 dNOOP 181 182 #endif /* Perl >= 5.7 */ 183 184 #include <fcntl.h> 185 186 /* #define TRACE */ 187 188 #ifdef TRACE 189 # define Trace(x) printf x 190 #else 191 # define Trace(x) 192 #endif 193 194 195 #define DBT_clear(x) Zero(&x, 1, DBT) ; 196 197 #ifdef DB_VERSION_MAJOR 198 199 #if DB_VERSION_MAJOR == 2 200 # define BERKELEY_DB_1_OR_2 201 #endif 202 203 #if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 2) 204 # define AT_LEAST_DB_3_2 205 #endif 206 207 #if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 3) 208 # define AT_LEAST_DB_3_3 209 #endif 210 211 #if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 1) 212 # define AT_LEAST_DB_4_1 213 #endif 214 215 #if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 3) 216 # define AT_LEAST_DB_4_3 217 #endif 218 219 #if DB_VERSION_MAJOR >= 6 220 # define AT_LEAST_DB_6_0 221 #endif 222 223 #ifdef AT_LEAST_DB_3_3 224 # define WANT_ERROR 225 #endif 226 227 /* map version 2 features & constants onto their version 1 equivalent */ 228 229 #ifdef DB_Prefix_t 230 # undef DB_Prefix_t 231 #endif 232 #define DB_Prefix_t size_t 233 234 #ifdef DB_Hash_t 235 # undef DB_Hash_t 236 #endif 237 #define DB_Hash_t u_int32_t 238 239 /* DBTYPE stays the same */ 240 /* HASHINFO, RECNOINFO and BTREEINFO map to DB_INFO */ 241 #if DB_VERSION_MAJOR == 2 242 typedef DB_INFO INFO ; 243 #else /* DB_VERSION_MAJOR > 2 */ 244 # define DB_FIXEDLEN (0x8000) 245 #endif /* DB_VERSION_MAJOR == 2 */ 246 247 /* version 2 has db_recno_t in place of recno_t */ 248 typedef db_recno_t recno_t; 249 250 251 #define R_CURSOR DB_SET_RANGE 252 #define R_FIRST DB_FIRST 253 #define R_IAFTER DB_AFTER 254 #define R_IBEFORE DB_BEFORE 255 #define R_LAST DB_LAST 256 #define R_NEXT DB_NEXT 257 #define R_NOOVERWRITE DB_NOOVERWRITE 258 #define R_PREV DB_PREV 259 260 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5 261 # define R_SETCURSOR 0x800000 262 #else 263 # define R_SETCURSOR (-100) 264 #endif 265 266 #define R_RECNOSYNC 0 267 #define R_FIXEDLEN DB_FIXEDLEN 268 #define R_DUP DB_DUP 269 270 271 #define db_HA_hash h_hash 272 #define db_HA_ffactor h_ffactor 273 #define db_HA_nelem h_nelem 274 #define db_HA_bsize db_pagesize 275 #define db_HA_cachesize db_cachesize 276 #define db_HA_lorder db_lorder 277 278 #define db_BT_compare bt_compare 279 #define db_BT_prefix bt_prefix 280 #define db_BT_flags flags 281 #define db_BT_psize db_pagesize 282 #define db_BT_cachesize db_cachesize 283 #define db_BT_lorder db_lorder 284 #define db_BT_maxkeypage 285 #define db_BT_minkeypage 286 287 288 #define db_RE_reclen re_len 289 #define db_RE_flags flags 290 #define db_RE_bval re_pad 291 #define db_RE_bfname re_source 292 #define db_RE_psize db_pagesize 293 #define db_RE_cachesize db_cachesize 294 #define db_RE_lorder db_lorder 295 296 #define TXN NULL, 297 298 #define do_SEQ(db, key, value, flag) (db->cursor->c_get)(db->cursor, &key, &value, flag) 299 300 301 #define DBT_flags(x) x.flags = 0 302 #define DB_flags(x, v) x |= v 303 304 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5 305 # define flagSet(flags, bitmask) ((flags) & (bitmask)) 306 #else 307 # define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask)) 308 #endif 309 310 #else /* db version 1.x */ 311 312 #define BERKELEY_DB_1 313 #define BERKELEY_DB_1_OR_2 314 315 typedef union INFO { 316 HASHINFO hash ; 317 RECNOINFO recno ; 318 BTREEINFO btree ; 319 } INFO ; 320 321 322 #ifdef mDB_Prefix_t 323 # ifdef DB_Prefix_t 324 # undef DB_Prefix_t 325 # endif 326 # define DB_Prefix_t mDB_Prefix_t 327 #endif 328 329 #ifdef mDB_Hash_t 330 # ifdef DB_Hash_t 331 # undef DB_Hash_t 332 # endif 333 # define DB_Hash_t mDB_Hash_t 334 #endif 335 336 #define db_HA_hash hash.hash 337 #define db_HA_ffactor hash.ffactor 338 #define db_HA_nelem hash.nelem 339 #define db_HA_bsize hash.bsize 340 #define db_HA_cachesize hash.cachesize 341 #define db_HA_lorder hash.lorder 342 343 #define db_BT_compare btree.compare 344 #define db_BT_prefix btree.prefix 345 #define db_BT_flags btree.flags 346 #define db_BT_psize btree.psize 347 #define db_BT_cachesize btree.cachesize 348 #define db_BT_lorder btree.lorder 349 #define db_BT_maxkeypage btree.maxkeypage 350 #define db_BT_minkeypage btree.minkeypage 351 352 #define db_RE_reclen recno.reclen 353 #define db_RE_flags recno.flags 354 #define db_RE_bval recno.bval 355 #define db_RE_bfname recno.bfname 356 #define db_RE_psize recno.psize 357 #define db_RE_cachesize recno.cachesize 358 #define db_RE_lorder recno.lorder 359 360 #define TXN 361 362 #define do_SEQ(db, key, value, flag) (db->dbp->seq)(db->dbp, &key, &value, flag) 363 #define DBT_flags(x) 364 #define DB_flags(x, v) 365 #define flagSet(flags, bitmask) ((flags) & (bitmask)) 366 367 #endif /* db version 1 */ 368 369 370 371 #define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, TXN &key, 0) 372 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, 0) 373 #define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, 0) 374 375 #define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags) 376 #define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) 377 378 #ifdef DB_VERSION_MAJOR 379 #define db_DESTROY(db) (!db->aborted && ( db->cursor->c_close(db->cursor),\ 380 (db->dbp->close)(db->dbp, 0) )) 381 #define db_close(db) ((db->dbp)->close)(db->dbp, 0) 382 #define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \ 383 ? ((db->cursor)->c_del)(db->cursor, 0) \ 384 : ((db->dbp)->del)(db->dbp, NULL, &key, flags) ) 385 386 #else /* ! DB_VERSION_MAJOR */ 387 388 #define db_DESTROY(db) (!db->aborted && ((db->dbp)->close)(db->dbp)) 389 #define db_close(db) ((db->dbp)->close)(db->dbp) 390 #define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags) 391 #define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags) 392 393 #endif /* ! DB_VERSION_MAJOR */ 394 395 396 #define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags) 397 398 typedef struct { 399 DBTYPE type ; 400 DB * dbp ; 401 SV * compare ; 402 bool in_compare ; 403 SV * prefix ; 404 bool in_prefix ; 405 SV * hash ; 406 bool in_hash ; 407 bool aborted ; 408 int in_memory ; 409 #ifdef BERKELEY_DB_1_OR_2 410 INFO info ; 411 #endif 412 #ifdef DB_VERSION_MAJOR 413 DBC * cursor ; 414 #endif 415 SV * filter_fetch_key ; 416 SV * filter_store_key ; 417 SV * filter_fetch_value ; 418 SV * filter_store_value ; 419 int filtering ; 420 421 } DB_File_type; 422 423 typedef DB_File_type * DB_File ; 424 typedef DBT DBTKEY ; 425 426 #define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (const char *)""), s) 427 428 #define OutputValue(arg, name) \ 429 { if (RETVAL == 0) { \ 430 SvGETMAGIC(arg) ; \ 431 my_sv_setpvn(arg, (const char *)name.data, name.size) ; \ 432 TAINT; \ 433 SvTAINTED_on(arg); \ 434 SvUTF8_off(arg); \ 435 DBM_ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \ 436 } \ 437 } 438 439 #define OutputKey(arg, name) \ 440 { if (RETVAL == 0) \ 441 { \ 442 SvGETMAGIC(arg) ; \ 443 if (db->type != DB_RECNO) { \ 444 my_sv_setpvn(arg, (const char *)name.data, name.size); \ 445 } \ 446 else \ 447 sv_setiv(arg, (I32)*(I32*)name.data - 1); \ 448 TAINT; \ 449 SvTAINTED_on(arg); \ 450 SvUTF8_off(arg); \ 451 DBM_ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \ 452 } \ 453 } 454 455 #define my_SvUV32(sv) ((u_int32_t)SvUV(sv)) 456 457 #ifdef CAN_PROTOTYPE 458 extern void __getBerkeleyDBInfo(void); 459 #endif 460 461 /* Internal Global Data */ 462 463 #define MY_CXT_KEY "DB_File::_guts" XS_VERSION 464 465 typedef struct { 466 recno_t x_Value; 467 recno_t x_zero; 468 DB_File x_CurrentDB; 469 DBTKEY x_empty; 470 } my_cxt_t; 471 472 START_MY_CXT 473 474 #define Value (MY_CXT.x_Value) 475 #define zero (MY_CXT.x_zero) 476 #define CurrentDB (MY_CXT.x_CurrentDB) 477 #define empty (MY_CXT.x_empty) 478 479 #define ERR_BUFF "DB_File::Error" 480 481 #ifdef DB_VERSION_MAJOR 482 483 static int 484 #ifdef CAN_PROTOTYPE 485 db_put(DB_File db, DBTKEY key, DBT value, u_int flags) 486 #else 487 db_put(db, key, value, flags) 488 DB_File db ; 489 DBTKEY key ; 490 DBT value ; 491 u_int flags ; 492 #endif 493 { 494 int status ; 495 496 if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) { 497 DBC * temp_cursor ; 498 DBT l_key, l_value; 499 500 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6 501 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor) != 0) 502 #else 503 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor, 0) != 0) 504 #endif 505 return (-1) ; 506 507 memset(&l_key, 0, sizeof(l_key)); 508 l_key.data = key.data; 509 l_key.size = key.size; 510 memset(&l_value, 0, sizeof(l_value)); 511 l_value.data = value.data; 512 l_value.size = value.size; 513 514 if ( temp_cursor->c_get(temp_cursor, &l_key, &l_value, DB_SET) != 0) { 515 (void)temp_cursor->c_close(temp_cursor); 516 return (-1); 517 } 518 519 status = temp_cursor->c_put(temp_cursor, &key, &value, flags); 520 (void)temp_cursor->c_close(temp_cursor); 521 522 return (status) ; 523 } 524 525 526 if (flagSet(flags, R_CURSOR)) { 527 return ((db->cursor)->c_put)(db->cursor, &key, &value, DB_CURRENT); 528 } 529 530 if (flagSet(flags, R_SETCURSOR)) { 531 if ((db->dbp)->put(db->dbp, NULL, &key, &value, 0) != 0) 532 return -1 ; 533 return ((db->cursor)->c_get)(db->cursor, &key, &value, DB_SET_RANGE); 534 535 } 536 537 return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ; 538 539 } 540 541 #endif /* DB_VERSION_MAJOR */ 542 543 static void 544 tidyUp(DB_File db) 545 { 546 db->aborted = TRUE ; 547 } 548 549 550 static int 551 552 #ifdef AT_LEAST_DB_6_0 553 #ifdef CAN_PROTOTYPE 554 btree_compare(DB * db, const DBT *key1, const DBT *key2, size_t* locp) 555 #else 556 btree_compare(db, key1, key2, locp) 557 DB * db ; 558 const DBT * key1 ; 559 const DBT * key2 ; 560 size_t* locp; 561 #endif /* CAN_PROTOTYPE */ 562 563 #else /* Berkeley DB < 6.0 */ 564 #ifdef AT_LEAST_DB_3_2 565 566 #ifdef CAN_PROTOTYPE 567 btree_compare(DB * db, const DBT *key1, const DBT *key2) 568 #else 569 btree_compare(db, key1, key2) 570 DB * db ; 571 const DBT * key1 ; 572 const DBT * key2 ; 573 #endif /* CAN_PROTOTYPE */ 574 575 #else /* Berkeley DB < 3.2 */ 576 577 #ifdef CAN_PROTOTYPE 578 btree_compare(const DBT *key1, const DBT *key2) 579 #else 580 btree_compare(key1, key2) 581 const DBT * key1 ; 582 const DBT * key2 ; 583 #endif 584 585 #endif 586 #endif 587 588 { 589 #ifdef dTHX 590 dTHX; 591 #endif 592 dSP ; 593 dMY_CXT ; 594 void * data1, * data2 ; 595 int retval ; 596 int count ; 597 598 599 if (CurrentDB->in_compare) { 600 tidyUp(CurrentDB); 601 croak ("DB_File btree_compare: recursion detected\n") ; 602 } 603 604 data1 = (char *) key1->data ; 605 data2 = (char *) key2->data ; 606 607 #ifndef newSVpvn 608 /* As newSVpv will assume that the data pointer is a null terminated C 609 string if the size parameter is 0, make sure that data points to an 610 empty string if the length is 0 611 */ 612 if (key1->size == 0) 613 data1 = "" ; 614 if (key2->size == 0) 615 data2 = "" ; 616 #endif 617 618 ENTER ; 619 SAVETMPS; 620 SAVESPTR(CurrentDB); 621 CurrentDB->in_compare = FALSE; 622 SAVEINT(CurrentDB->in_compare); 623 CurrentDB->in_compare = TRUE; 624 625 PUSHMARK(SP) ; 626 EXTEND(SP,2) ; 627 PUSHs(sv_2mortal(newSVpvn((const char*)data1,key1->size))); 628 PUSHs(sv_2mortal(newSVpvn((const char*)data2,key2->size))); 629 PUTBACK ; 630 631 count = perl_call_sv(CurrentDB->compare, G_SCALAR); 632 633 SPAGAIN ; 634 635 if (count != 1){ 636 tidyUp(CurrentDB); 637 croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ; 638 } 639 640 retval = POPi ; 641 642 PUTBACK ; 643 FREETMPS ; 644 LEAVE ; 645 646 return (retval) ; 647 648 } 649 650 static DB_Prefix_t 651 #ifdef AT_LEAST_DB_3_2 652 653 #ifdef CAN_PROTOTYPE 654 btree_prefix(DB * db, const DBT *key1, const DBT *key2) 655 #else 656 btree_prefix(db, key1, key2) 657 Db * db ; 658 const DBT * key1 ; 659 const DBT * key2 ; 660 #endif 661 662 #else /* Berkeley DB < 3.2 */ 663 664 #ifdef CAN_PROTOTYPE 665 btree_prefix(const DBT *key1, const DBT *key2) 666 #else 667 btree_prefix(key1, key2) 668 const DBT * key1 ; 669 const DBT * key2 ; 670 #endif 671 672 #endif 673 { 674 #ifdef dTHX 675 dTHX; 676 #endif 677 dSP ; 678 dMY_CXT ; 679 char * data1, * data2 ; 680 int retval ; 681 int count ; 682 683 if (CurrentDB->in_prefix){ 684 tidyUp(CurrentDB); 685 croak ("DB_File btree_prefix: recursion detected\n") ; 686 } 687 688 data1 = (char *) key1->data ; 689 data2 = (char *) key2->data ; 690 691 #ifndef newSVpvn 692 /* As newSVpv will assume that the data pointer is a null terminated C 693 string if the size parameter is 0, make sure that data points to an 694 empty string if the length is 0 695 */ 696 if (key1->size == 0) 697 data1 = "" ; 698 if (key2->size == 0) 699 data2 = "" ; 700 #endif 701 702 ENTER ; 703 SAVETMPS; 704 SAVESPTR(CurrentDB); 705 CurrentDB->in_prefix = FALSE; 706 SAVEINT(CurrentDB->in_prefix); 707 CurrentDB->in_prefix = TRUE; 708 709 PUSHMARK(SP) ; 710 EXTEND(SP,2) ; 711 PUSHs(sv_2mortal(newSVpvn(data1,key1->size))); 712 PUSHs(sv_2mortal(newSVpvn(data2,key2->size))); 713 PUTBACK ; 714 715 count = perl_call_sv(CurrentDB->prefix, G_SCALAR); 716 717 SPAGAIN ; 718 719 if (count != 1){ 720 tidyUp(CurrentDB); 721 croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ; 722 } 723 724 retval = POPi ; 725 726 PUTBACK ; 727 FREETMPS ; 728 LEAVE ; 729 730 return (retval) ; 731 } 732 733 734 #ifdef BERKELEY_DB_1 735 # define HASH_CB_SIZE_TYPE size_t 736 #else 737 # define HASH_CB_SIZE_TYPE u_int32_t 738 #endif 739 740 static DB_Hash_t 741 #ifdef AT_LEAST_DB_3_2 742 743 #ifdef CAN_PROTOTYPE 744 hash_cb(DB * db, const void *data, u_int32_t size) 745 #else 746 hash_cb(db, data, size) 747 DB * db ; 748 const void * data ; 749 HASH_CB_SIZE_TYPE size ; 750 #endif 751 752 #else /* Berkeley DB < 3.2 */ 753 754 #ifdef CAN_PROTOTYPE 755 hash_cb(const void *data, HASH_CB_SIZE_TYPE size) 756 #else 757 hash_cb(data, size) 758 const void * data ; 759 HASH_CB_SIZE_TYPE size ; 760 #endif 761 762 #endif 763 { 764 #ifdef dTHX 765 dTHX; 766 #endif 767 dSP ; 768 dMY_CXT; 769 int retval = 0; 770 int count ; 771 772 if (CurrentDB->in_hash){ 773 tidyUp(CurrentDB); 774 croak ("DB_File hash callback: recursion detected\n") ; 775 } 776 777 #ifndef newSVpvn 778 if (size == 0) 779 data = "" ; 780 #endif 781 782 /* DGH - Next two lines added to fix corrupted stack problem */ 783 ENTER ; 784 SAVETMPS; 785 SAVESPTR(CurrentDB); 786 CurrentDB->in_hash = FALSE; 787 SAVEINT(CurrentDB->in_hash); 788 CurrentDB->in_hash = TRUE; 789 790 PUSHMARK(SP) ; 791 792 793 XPUSHs(sv_2mortal(newSVpvn((char*)data,size))); 794 PUTBACK ; 795 796 count = perl_call_sv(CurrentDB->hash, G_SCALAR); 797 798 SPAGAIN ; 799 800 if (count != 1){ 801 tidyUp(CurrentDB); 802 croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ; 803 } 804 805 retval = POPi ; 806 807 PUTBACK ; 808 FREETMPS ; 809 LEAVE ; 810 811 return (retval) ; 812 } 813 814 #ifdef WANT_ERROR 815 816 static void 817 #ifdef AT_LEAST_DB_4_3 818 db_errcall_cb(const DB_ENV* dbenv, const char * db_errpfx, const char * buffer) 819 #else 820 db_errcall_cb(const char * db_errpfx, char * buffer) 821 #endif 822 { 823 #ifdef dTHX 824 dTHX; 825 #endif 826 SV * sv = perl_get_sv(ERR_BUFF, FALSE) ; 827 if (sv) { 828 if (db_errpfx) 829 sv_setpvf(sv, "%s: %s", db_errpfx, buffer) ; 830 else 831 sv_setpv(sv, buffer) ; 832 } 833 } 834 #endif 835 836 #if defined(TRACE) && defined(BERKELEY_DB_1_OR_2) 837 838 static void 839 #ifdef CAN_PROTOTYPE 840 PrintHash(INFO *hash) 841 #else 842 PrintHash(hash) 843 INFO * hash ; 844 #endif 845 { 846 printf ("HASH Info\n") ; 847 printf (" hash = %s\n", 848 (hash->db_HA_hash != NULL ? "redefined" : "default")) ; 849 printf (" bsize = %d\n", hash->db_HA_bsize) ; 850 printf (" ffactor = %d\n", hash->db_HA_ffactor) ; 851 printf (" nelem = %d\n", hash->db_HA_nelem) ; 852 printf (" cachesize = %d\n", hash->db_HA_cachesize) ; 853 printf (" lorder = %d\n", hash->db_HA_lorder) ; 854 855 } 856 857 static void 858 #ifdef CAN_PROTOTYPE 859 PrintRecno(INFO *recno) 860 #else 861 PrintRecno(recno) 862 INFO * recno ; 863 #endif 864 { 865 printf ("RECNO Info\n") ; 866 printf (" flags = %d\n", recno->db_RE_flags) ; 867 printf (" cachesize = %d\n", recno->db_RE_cachesize) ; 868 printf (" psize = %d\n", recno->db_RE_psize) ; 869 printf (" lorder = %d\n", recno->db_RE_lorder) ; 870 printf (" reclen = %lu\n", (unsigned long)recno->db_RE_reclen) ; 871 printf (" bval = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ; 872 printf (" bfname = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ; 873 } 874 875 static void 876 #ifdef CAN_PROTOTYPE 877 PrintBtree(INFO *btree) 878 #else 879 PrintBtree(btree) 880 INFO * btree ; 881 #endif 882 { 883 printf ("BTREE Info\n") ; 884 printf (" compare = %s\n", 885 (btree->db_BT_compare ? "redefined" : "default")) ; 886 printf (" prefix = %s\n", 887 (btree->db_BT_prefix ? "redefined" : "default")) ; 888 printf (" flags = %d\n", btree->db_BT_flags) ; 889 printf (" cachesize = %d\n", btree->db_BT_cachesize) ; 890 printf (" psize = %d\n", btree->db_BT_psize) ; 891 #ifndef DB_VERSION_MAJOR 892 printf (" maxkeypage = %d\n", btree->db_BT_maxkeypage) ; 893 printf (" minkeypage = %d\n", btree->db_BT_minkeypage) ; 894 #endif 895 printf (" lorder = %d\n", btree->db_BT_lorder) ; 896 } 897 898 #else 899 900 #define PrintRecno(recno) 901 #define PrintHash(hash) 902 #define PrintBtree(btree) 903 904 #endif /* TRACE */ 905 906 907 static I32 908 #ifdef CAN_PROTOTYPE 909 GetArrayLength(pTHX_ DB_File db) 910 #else 911 GetArrayLength(db) 912 DB_File db ; 913 #endif 914 { 915 DBT key ; 916 DBT value ; 917 int RETVAL ; 918 919 DBT_clear(key) ; 920 DBT_clear(value) ; 921 RETVAL = do_SEQ(db, key, value, R_LAST) ; 922 if (RETVAL == 0) 923 RETVAL = *(I32 *)key.data ; 924 else /* No key means empty file */ 925 RETVAL = 0 ; 926 927 return ((I32)RETVAL) ; 928 } 929 930 static recno_t 931 #ifdef CAN_PROTOTYPE 932 GetRecnoKey(pTHX_ DB_File db, I32 value) 933 #else 934 GetRecnoKey(db, value) 935 DB_File db ; 936 I32 value ; 937 #endif 938 { 939 if (value < 0) { 940 /* Get the length of the array */ 941 I32 length = GetArrayLength(aTHX_ db) ; 942 943 /* check for attempt to write before start of array */ 944 if (length + value + 1 <= 0) { 945 tidyUp(db); 946 croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ; 947 } 948 949 value = length + value + 1 ; 950 } 951 else 952 ++ value ; 953 954 return value ; 955 } 956 957 958 static DB_File 959 #ifdef CAN_PROTOTYPE 960 ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv) 961 #else 962 ParseOpenInfo(isHASH, name, flags, mode, sv) 963 int isHASH ; 964 char * name ; 965 int flags ; 966 int mode ; 967 SV * sv ; 968 #endif 969 { 970 971 #ifdef BERKELEY_DB_1_OR_2 /* Berkeley DB Version 1 or 2 */ 972 973 SV ** svp; 974 HV * action ; 975 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ; 976 void * openinfo = NULL ; 977 INFO * info = &RETVAL->info ; 978 STRLEN n_a; 979 dMY_CXT; 980 981 #ifdef TRACE 982 printf("In ParseOpenInfo name=[%s] flags=[%d] mode=[%d] SV NULL=[%d]\n", 983 name, flags, mode, sv == NULL) ; 984 #endif 985 Zero(RETVAL, 1, DB_File_type) ; 986 987 /* Default to HASH */ 988 RETVAL->filtering = 0 ; 989 RETVAL->filter_fetch_key = RETVAL->filter_store_key = 990 RETVAL->filter_fetch_value = RETVAL->filter_store_value = 991 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ; 992 RETVAL->type = DB_HASH ; 993 994 /* DGH - Next line added to avoid SEGV on existing hash DB */ 995 CurrentDB = RETVAL; 996 997 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */ 998 RETVAL->in_memory = (name == NULL) ; 999 1000 if (sv) 1001 { 1002 if (! SvROK(sv) ) 1003 croak ("type parameter is not a reference") ; 1004 1005 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ; 1006 if (svp && SvOK(*svp)) 1007 action = (HV*) SvRV(*svp) ; 1008 else 1009 croak("internal error") ; 1010 1011 if (sv_isa(sv, "DB_File::HASHINFO")) 1012 { 1013 1014 if (!isHASH) 1015 croak("DB_File can only tie an associative array to a DB_HASH database") ; 1016 1017 RETVAL->type = DB_HASH ; 1018 openinfo = (void*)info ; 1019 1020 svp = hv_fetch(action, "hash", 4, FALSE); 1021 1022 if (svp && SvOK(*svp)) 1023 { 1024 info->db_HA_hash = hash_cb ; 1025 RETVAL->hash = newSVsv(*svp) ; 1026 } 1027 else 1028 info->db_HA_hash = NULL ; 1029 1030 svp = hv_fetch(action, "ffactor", 7, FALSE); 1031 info->db_HA_ffactor = svp ? SvIV(*svp) : 0; 1032 1033 svp = hv_fetch(action, "nelem", 5, FALSE); 1034 info->db_HA_nelem = svp ? SvIV(*svp) : 0; 1035 1036 svp = hv_fetch(action, "bsize", 5, FALSE); 1037 info->db_HA_bsize = svp ? SvIV(*svp) : 0; 1038 1039 svp = hv_fetch(action, "cachesize", 9, FALSE); 1040 info->db_HA_cachesize = svp ? SvIV(*svp) : 0; 1041 1042 svp = hv_fetch(action, "lorder", 6, FALSE); 1043 info->db_HA_lorder = svp ? SvIV(*svp) : 0; 1044 1045 PrintHash(info) ; 1046 } 1047 else if (sv_isa(sv, "DB_File::BTREEINFO")) 1048 { 1049 if (!isHASH) 1050 croak("DB_File can only tie an associative array to a DB_BTREE database"); 1051 1052 RETVAL->type = DB_BTREE ; 1053 openinfo = (void*)info ; 1054 1055 svp = hv_fetch(action, "compare", 7, FALSE); 1056 if (svp && SvOK(*svp)) 1057 { 1058 info->db_BT_compare = btree_compare ; 1059 RETVAL->compare = newSVsv(*svp) ; 1060 } 1061 else 1062 info->db_BT_compare = NULL ; 1063 1064 svp = hv_fetch(action, "prefix", 6, FALSE); 1065 if (svp && SvOK(*svp)) 1066 { 1067 info->db_BT_prefix = btree_prefix ; 1068 RETVAL->prefix = newSVsv(*svp) ; 1069 } 1070 else 1071 info->db_BT_prefix = NULL ; 1072 1073 svp = hv_fetch(action, "flags", 5, FALSE); 1074 info->db_BT_flags = svp ? SvIV(*svp) : 0; 1075 1076 svp = hv_fetch(action, "cachesize", 9, FALSE); 1077 info->db_BT_cachesize = svp ? SvIV(*svp) : 0; 1078 1079 #ifndef DB_VERSION_MAJOR 1080 svp = hv_fetch(action, "minkeypage", 10, FALSE); 1081 info->btree.minkeypage = svp ? SvIV(*svp) : 0; 1082 1083 svp = hv_fetch(action, "maxkeypage", 10, FALSE); 1084 info->btree.maxkeypage = svp ? SvIV(*svp) : 0; 1085 #endif 1086 1087 svp = hv_fetch(action, "psize", 5, FALSE); 1088 info->db_BT_psize = svp ? SvIV(*svp) : 0; 1089 1090 svp = hv_fetch(action, "lorder", 6, FALSE); 1091 info->db_BT_lorder = svp ? SvIV(*svp) : 0; 1092 1093 PrintBtree(info) ; 1094 1095 } 1096 else if (sv_isa(sv, "DB_File::RECNOINFO")) 1097 { 1098 if (isHASH) 1099 croak("DB_File can only tie an array to a DB_RECNO database"); 1100 1101 RETVAL->type = DB_RECNO ; 1102 openinfo = (void *)info ; 1103 1104 info->db_RE_flags = 0 ; 1105 1106 svp = hv_fetch(action, "flags", 5, FALSE); 1107 info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0); 1108 1109 svp = hv_fetch(action, "reclen", 6, FALSE); 1110 info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0); 1111 1112 svp = hv_fetch(action, "cachesize", 9, FALSE); 1113 info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0); 1114 1115 svp = hv_fetch(action, "psize", 5, FALSE); 1116 info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0); 1117 1118 svp = hv_fetch(action, "lorder", 6, FALSE); 1119 info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0); 1120 1121 #ifdef DB_VERSION_MAJOR 1122 info->re_source = name ; 1123 name = NULL ; 1124 #endif 1125 svp = hv_fetch(action, "bfname", 6, FALSE); 1126 if (svp && SvOK(*svp)) { 1127 char * ptr = SvPV(*svp,n_a) ; 1128 #ifdef DB_VERSION_MAJOR 1129 name = (char*) n_a ? ptr : NULL ; 1130 #else 1131 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ; 1132 #endif 1133 } 1134 else 1135 #ifdef DB_VERSION_MAJOR 1136 name = NULL ; 1137 #else 1138 info->db_RE_bfname = NULL ; 1139 #endif 1140 1141 svp = hv_fetch(action, "bval", 4, FALSE); 1142 #ifdef DB_VERSION_MAJOR 1143 if (svp && SvOK(*svp)) 1144 { 1145 int value ; 1146 if (SvPOK(*svp)) 1147 value = (int)*SvPV(*svp, n_a) ; 1148 else 1149 value = SvIV(*svp) ; 1150 1151 if (info->flags & DB_FIXEDLEN) { 1152 info->re_pad = value ; 1153 info->flags |= DB_PAD ; 1154 } 1155 else { 1156 info->re_delim = value ; 1157 info->flags |= DB_DELIMITER ; 1158 } 1159 1160 } 1161 #else 1162 if (svp && SvOK(*svp)) 1163 { 1164 if (SvPOK(*svp)) 1165 info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ; 1166 else 1167 info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ; 1168 DB_flags(info->flags, DB_DELIMITER) ; 1169 1170 } 1171 else 1172 { 1173 if (info->db_RE_flags & R_FIXEDLEN) 1174 info->db_RE_bval = (u_char) ' ' ; 1175 else 1176 info->db_RE_bval = (u_char) '\n' ; 1177 DB_flags(info->flags, DB_DELIMITER) ; 1178 } 1179 #endif 1180 1181 #ifdef DB_RENUMBER 1182 info->flags |= DB_RENUMBER ; 1183 #endif 1184 1185 PrintRecno(info) ; 1186 } 1187 else 1188 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO"); 1189 } 1190 1191 1192 /* OS2 Specific Code */ 1193 #ifdef OS2 1194 #ifdef __EMX__ 1195 flags |= O_BINARY; 1196 #endif /* __EMX__ */ 1197 #endif /* OS2 */ 1198 1199 #ifdef DB_VERSION_MAJOR 1200 1201 { 1202 int Flags = 0 ; 1203 int status ; 1204 1205 /* Map 1.x flags to 2.x flags */ 1206 if ((flags & O_CREAT) == O_CREAT) 1207 Flags |= DB_CREATE ; 1208 1209 #if O_RDONLY == 0 1210 if (flags == O_RDONLY) 1211 #else 1212 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR) 1213 #endif 1214 Flags |= DB_RDONLY ; 1215 1216 #ifdef O_TRUNC 1217 if ((flags & O_TRUNC) == O_TRUNC) 1218 Flags |= DB_TRUNCATE ; 1219 #endif 1220 1221 status = db_open(name, RETVAL->type, Flags, mode, NULL, (DB_INFO*)openinfo, &RETVAL->dbp) ; 1222 if (status == 0) 1223 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6 1224 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ; 1225 #else 1226 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor, 1227 0) ; 1228 #endif 1229 1230 if (status) 1231 RETVAL->dbp = NULL ; 1232 1233 } 1234 #else 1235 1236 #if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2 1237 RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ; 1238 #else 1239 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ; 1240 #endif /* DB_LIBRARY_COMPATIBILITY_API */ 1241 1242 #endif 1243 1244 return (RETVAL) ; 1245 1246 #else /* Berkeley DB Version > 2 */ 1247 1248 SV ** svp; 1249 HV * action ; 1250 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ; 1251 DB * dbp ; 1252 STRLEN n_a; 1253 int status ; 1254 dMY_CXT; 1255 1256 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */ 1257 Zero(RETVAL, 1, DB_File_type) ; 1258 1259 /* Default to HASH */ 1260 RETVAL->filtering = 0 ; 1261 RETVAL->filter_fetch_key = RETVAL->filter_store_key = 1262 RETVAL->filter_fetch_value = RETVAL->filter_store_value = 1263 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ; 1264 RETVAL->type = DB_HASH ; 1265 1266 /* DGH - Next line added to avoid SEGV on existing hash DB */ 1267 CurrentDB = RETVAL; 1268 1269 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */ 1270 RETVAL->in_memory = (name == NULL) ; 1271 1272 status = db_create(&RETVAL->dbp, NULL,0) ; 1273 /* printf("db_create returned %d %s\n", status, db_strerror(status)) ; */ 1274 if (status) { 1275 RETVAL->dbp = NULL ; 1276 return (RETVAL) ; 1277 } 1278 dbp = RETVAL->dbp ; 1279 1280 #ifdef WANT_ERROR 1281 RETVAL->dbp->set_errcall(RETVAL->dbp, db_errcall_cb) ; 1282 #endif 1283 if (sv) 1284 { 1285 if (! SvROK(sv) ) 1286 croak ("type parameter is not a reference") ; 1287 1288 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ; 1289 if (svp && SvOK(*svp)) 1290 action = (HV*) SvRV(*svp) ; 1291 else 1292 croak("internal error") ; 1293 1294 if (sv_isa(sv, "DB_File::HASHINFO")) 1295 { 1296 1297 if (!isHASH) 1298 croak("DB_File can only tie an associative array to a DB_HASH database") ; 1299 1300 RETVAL->type = DB_HASH ; 1301 1302 svp = hv_fetch(action, "hash", 4, FALSE); 1303 1304 if (svp && SvOK(*svp)) 1305 { 1306 (void)dbp->set_h_hash(dbp, hash_cb) ; 1307 RETVAL->hash = newSVsv(*svp) ; 1308 } 1309 1310 svp = hv_fetch(action, "ffactor", 7, FALSE); 1311 if (svp) 1312 (void)dbp->set_h_ffactor(dbp, my_SvUV32(*svp)) ; 1313 1314 svp = hv_fetch(action, "nelem", 5, FALSE); 1315 if (svp) 1316 (void)dbp->set_h_nelem(dbp, my_SvUV32(*svp)) ; 1317 1318 svp = hv_fetch(action, "bsize", 5, FALSE); 1319 if (svp) 1320 (void)dbp->set_pagesize(dbp, my_SvUV32(*svp)); 1321 1322 svp = hv_fetch(action, "cachesize", 9, FALSE); 1323 if (svp) 1324 (void)dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ; 1325 1326 svp = hv_fetch(action, "lorder", 6, FALSE); 1327 if (svp) 1328 (void)dbp->set_lorder(dbp, (int)SvIV(*svp)) ; 1329 1330 PrintHash(info) ; 1331 } 1332 else if (sv_isa(sv, "DB_File::BTREEINFO")) 1333 { 1334 if (!isHASH) 1335 croak("DB_File can only tie an associative array to a DB_BTREE database"); 1336 1337 RETVAL->type = DB_BTREE ; 1338 1339 svp = hv_fetch(action, "compare", 7, FALSE); 1340 if (svp && SvOK(*svp)) 1341 { 1342 (void)dbp->set_bt_compare(dbp, btree_compare) ; 1343 RETVAL->compare = newSVsv(*svp) ; 1344 } 1345 1346 svp = hv_fetch(action, "prefix", 6, FALSE); 1347 if (svp && SvOK(*svp)) 1348 { 1349 (void)dbp->set_bt_prefix(dbp, btree_prefix) ; 1350 RETVAL->prefix = newSVsv(*svp) ; 1351 } 1352 1353 svp = hv_fetch(action, "flags", 5, FALSE); 1354 if (svp) 1355 (void)dbp->set_flags(dbp, my_SvUV32(*svp)) ; 1356 1357 svp = hv_fetch(action, "cachesize", 9, FALSE); 1358 if (svp) 1359 (void)dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ; 1360 1361 svp = hv_fetch(action, "psize", 5, FALSE); 1362 if (svp) 1363 (void)dbp->set_pagesize(dbp, my_SvUV32(*svp)) ; 1364 1365 svp = hv_fetch(action, "lorder", 6, FALSE); 1366 if (svp) 1367 (void)dbp->set_lorder(dbp, (int)SvIV(*svp)) ; 1368 1369 PrintBtree(info) ; 1370 1371 } 1372 else if (sv_isa(sv, "DB_File::RECNOINFO")) 1373 { 1374 int fixed = FALSE ; 1375 1376 if (isHASH) 1377 croak("DB_File can only tie an array to a DB_RECNO database"); 1378 1379 RETVAL->type = DB_RECNO ; 1380 1381 svp = hv_fetch(action, "flags", 5, FALSE); 1382 if (svp) { 1383 int flags = SvIV(*svp) ; 1384 /* remove FIXDLEN, if present */ 1385 if (flags & DB_FIXEDLEN) { 1386 fixed = TRUE ; 1387 flags &= ~DB_FIXEDLEN ; 1388 } 1389 } 1390 1391 svp = hv_fetch(action, "cachesize", 9, FALSE); 1392 if (svp) { 1393 status = dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ; 1394 } 1395 1396 svp = hv_fetch(action, "psize", 5, FALSE); 1397 if (svp) { 1398 status = dbp->set_pagesize(dbp, my_SvUV32(*svp)) ; 1399 } 1400 1401 svp = hv_fetch(action, "lorder", 6, FALSE); 1402 if (svp) { 1403 status = dbp->set_lorder(dbp, (int)SvIV(*svp)) ; 1404 } 1405 1406 svp = hv_fetch(action, "bval", 4, FALSE); 1407 if (svp && SvOK(*svp)) 1408 { 1409 int value ; 1410 if (SvPOK(*svp)) 1411 value = (int)*SvPV(*svp, n_a) ; 1412 else 1413 value = (int)SvIV(*svp) ; 1414 1415 if (fixed) { 1416 status = dbp->set_re_pad(dbp, value) ; 1417 } 1418 else { 1419 status = dbp->set_re_delim(dbp, value) ; 1420 } 1421 1422 } 1423 1424 if (fixed) { 1425 svp = hv_fetch(action, "reclen", 6, FALSE); 1426 if (svp) { 1427 u_int32_t len = my_SvUV32(*svp) ; 1428 status = dbp->set_re_len(dbp, len) ; 1429 } 1430 } 1431 1432 if (name != NULL) { 1433 status = dbp->set_re_source(dbp, name) ; 1434 name = NULL ; 1435 } 1436 1437 svp = hv_fetch(action, "bfname", 6, FALSE); 1438 if (svp && SvOK(*svp)) { 1439 char * ptr = SvPV(*svp,n_a) ; 1440 name = (char*) n_a ? ptr : NULL ; 1441 } 1442 else 1443 name = NULL ; 1444 1445 1446 status = dbp->set_flags(dbp, (u_int32_t)DB_RENUMBER) ; 1447 1448 if (flags){ 1449 (void)dbp->set_flags(dbp, (u_int32_t)flags) ; 1450 } 1451 PrintRecno(info) ; 1452 } 1453 else 1454 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO"); 1455 } 1456 1457 { 1458 u_int32_t Flags = 0 ; 1459 int status ; 1460 1461 /* Map 1.x flags to 3.x flags */ 1462 if ((flags & O_CREAT) == O_CREAT) 1463 Flags |= DB_CREATE ; 1464 1465 #if O_RDONLY == 0 1466 if (flags == O_RDONLY) 1467 #else 1468 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR) 1469 #endif 1470 Flags |= DB_RDONLY ; 1471 1472 #ifdef O_TRUNC 1473 if ((flags & O_TRUNC) == O_TRUNC) 1474 Flags |= DB_TRUNCATE ; 1475 #endif 1476 1477 #ifdef AT_LEAST_DB_4_4 1478 /* need this for recno */ 1479 if ((flags & O_TRUNC) == O_TRUNC) 1480 Flags |= DB_CREATE ; 1481 #endif 1482 1483 #ifdef AT_LEAST_DB_4_1 1484 status = (RETVAL->dbp->open)(RETVAL->dbp, NULL, name, NULL, RETVAL->type, 1485 Flags, mode) ; 1486 #else 1487 status = (RETVAL->dbp->open)(RETVAL->dbp, name, NULL, RETVAL->type, 1488 Flags, mode) ; 1489 #endif 1490 /* printf("open returned %d %s\n", status, db_strerror(status)) ; */ 1491 1492 if (status == 0) { 1493 1494 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor, 1495 0) ; 1496 /* printf("cursor returned %d %s\n", status, db_strerror(status)) ; */ 1497 } 1498 1499 if (status) 1500 { 1501 db_close(RETVAL); /* close **dbp handle to prevent mem.leak */ 1502 RETVAL->dbp = NULL ; 1503 } 1504 1505 } 1506 1507 return (RETVAL) ; 1508 1509 #endif /* Berkeley DB Version > 2 */ 1510 1511 } /* ParseOpenInfo */ 1512 1513 1514 #include "constants.h" 1515 1516 MODULE = DB_File PACKAGE = DB_File PREFIX = db_ 1517 1518 INCLUDE: constants.xs 1519 1520 BOOT: 1521 { 1522 #ifdef dTHX 1523 dTHX; 1524 #endif 1525 #ifdef WANT_ERROR 1526 SV * sv_err = perl_get_sv(ERR_BUFF, GV_ADD|GV_ADDMULTI) ; 1527 #endif 1528 MY_CXT_INIT; 1529 __getBerkeleyDBInfo() ; 1530 1531 DBT_clear(empty) ; 1532 empty.data = &zero ; 1533 empty.size = sizeof(recno_t) ; 1534 } 1535 1536 1537 1538 DB_File 1539 db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH) 1540 int isHASH 1541 char * dbtype 1542 int flags 1543 int mode 1544 CODE: 1545 { 1546 char * name = (char *) NULL ; 1547 SV * sv = (SV *) NULL ; 1548 STRLEN n_a; 1549 1550 if (items >= 3 && SvOK(ST(2))) 1551 name = (char*) SvPV(ST(2), n_a) ; 1552 1553 if (items == 6) 1554 sv = ST(5) ; 1555 1556 RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ; 1557 Trace(("db_DoTie_ %p\n", RETVAL)); 1558 if (RETVAL->dbp == NULL) { 1559 Safefree(RETVAL); 1560 RETVAL = NULL ; 1561 } 1562 } 1563 OUTPUT: 1564 RETVAL 1565 1566 int 1567 db_DESTROY(db) 1568 DB_File db 1569 PREINIT: 1570 dMY_CXT; 1571 INIT: 1572 CurrentDB = db ; 1573 Trace(("DESTROY %p\n", db)); 1574 CLEANUP: 1575 Trace(("DESTROY %p done\n", db)); 1576 if (db->hash) 1577 SvREFCNT_dec(db->hash) ; 1578 if (db->compare) 1579 SvREFCNT_dec(db->compare) ; 1580 if (db->prefix) 1581 SvREFCNT_dec(db->prefix) ; 1582 if (db->filter_fetch_key) 1583 SvREFCNT_dec(db->filter_fetch_key) ; 1584 if (db->filter_store_key) 1585 SvREFCNT_dec(db->filter_store_key) ; 1586 if (db->filter_fetch_value) 1587 SvREFCNT_dec(db->filter_fetch_value) ; 1588 if (db->filter_store_value) 1589 SvREFCNT_dec(db->filter_store_value) ; 1590 safefree(db) ; 1591 #ifdef DB_VERSION_MAJOR 1592 if (RETVAL > 0) 1593 RETVAL = -1 ; 1594 #endif 1595 1596 1597 int 1598 db_DELETE(db, key, flags=0) 1599 DB_File db 1600 DBTKEY key 1601 u_int flags 1602 PREINIT: 1603 dMY_CXT; 1604 INIT: 1605 CurrentDB = db ; 1606 1607 1608 int 1609 db_EXISTS(db, key) 1610 DB_File db 1611 DBTKEY key 1612 PREINIT: 1613 dMY_CXT; 1614 CODE: 1615 { 1616 DBT value ; 1617 1618 DBT_clear(value) ; 1619 CurrentDB = db ; 1620 RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ; 1621 } 1622 OUTPUT: 1623 RETVAL 1624 1625 void 1626 db_FETCH(db, key, flags=0) 1627 DB_File db 1628 DBTKEY key 1629 u_int flags 1630 PREINIT: 1631 dMY_CXT ; 1632 int RETVAL ; 1633 CODE: 1634 { 1635 DBT value ; 1636 1637 DBT_clear(value) ; 1638 CurrentDB = db ; 1639 RETVAL = db_get(db, key, value, flags) ; 1640 ST(0) = sv_newmortal(); 1641 OutputValue(ST(0), value) 1642 } 1643 1644 int 1645 db_STORE(db, key, value, flags=0) 1646 DB_File db 1647 DBTKEY key 1648 DBT value 1649 u_int flags 1650 PREINIT: 1651 dMY_CXT; 1652 INIT: 1653 CurrentDB = db ; 1654 1655 1656 void 1657 db_FIRSTKEY(db) 1658 DB_File db 1659 PREINIT: 1660 dMY_CXT ; 1661 int RETVAL ; 1662 CODE: 1663 { 1664 DBTKEY key ; 1665 DBT value ; 1666 1667 DBT_clear(key) ; 1668 DBT_clear(value) ; 1669 CurrentDB = db ; 1670 RETVAL = do_SEQ(db, key, value, R_FIRST) ; 1671 ST(0) = sv_newmortal(); 1672 OutputKey(ST(0), key) ; 1673 } 1674 1675 void 1676 db_NEXTKEY(db, key) 1677 DB_File db 1678 DBTKEY key = NO_INIT 1679 PREINIT: 1680 dMY_CXT ; 1681 int RETVAL ; 1682 CODE: 1683 { 1684 DBT value ; 1685 1686 DBT_clear(key) ; 1687 DBT_clear(value) ; 1688 CurrentDB = db ; 1689 RETVAL = do_SEQ(db, key, value, R_NEXT) ; 1690 ST(0) = sv_newmortal(); 1691 OutputKey(ST(0), key) ; 1692 } 1693 1694 # 1695 # These would be nice for RECNO 1696 # 1697 1698 int 1699 unshift(db, ...) 1700 DB_File db 1701 ALIAS: UNSHIFT = 1 1702 PREINIT: 1703 dMY_CXT; 1704 CODE: 1705 { 1706 DBTKEY key ; 1707 DBT value ; 1708 int i ; 1709 int One ; 1710 STRLEN n_a; 1711 1712 DBT_clear(key) ; 1713 DBT_clear(value) ; 1714 CurrentDB = db ; 1715 #ifdef DB_VERSION_MAJOR 1716 /* get the first value */ 1717 RETVAL = do_SEQ(db, key, value, DB_FIRST) ; 1718 RETVAL = 0 ; 1719 #else 1720 RETVAL = -1 ; 1721 #endif 1722 for (i = items-1 ; i > 0 ; --i) 1723 { 1724 DBM_ckFilter(ST(i), filter_store_value, "filter_store_value"); 1725 value.data = SvPVbyte(ST(i), n_a) ; 1726 value.size = n_a ; 1727 One = 1 ; 1728 key.data = &One ; 1729 key.size = sizeof(int) ; 1730 #ifdef DB_VERSION_MAJOR 1731 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ; 1732 #else 1733 RETVAL = (db->dbp->put)(db->dbp, &key, &value, R_IBEFORE) ; 1734 #endif 1735 if (RETVAL != 0) 1736 break; 1737 } 1738 } 1739 OUTPUT: 1740 RETVAL 1741 1742 void 1743 pop(db) 1744 DB_File db 1745 PREINIT: 1746 dMY_CXT; 1747 ALIAS: POP = 1 1748 PREINIT: 1749 I32 RETVAL; 1750 CODE: 1751 { 1752 DBTKEY key ; 1753 DBT value ; 1754 1755 DBT_clear(key) ; 1756 DBT_clear(value) ; 1757 CurrentDB = db ; 1758 1759 /* First get the final value */ 1760 RETVAL = do_SEQ(db, key, value, R_LAST) ; 1761 ST(0) = sv_newmortal(); 1762 /* Now delete it */ 1763 if (RETVAL == 0) 1764 { 1765 /* the call to del will trash value, so take a copy now */ 1766 OutputValue(ST(0), value) ; 1767 RETVAL = db_del(db, key, R_CURSOR) ; 1768 if (RETVAL != 0) 1769 sv_setsv(ST(0), &PL_sv_undef); 1770 } 1771 } 1772 1773 void 1774 shift(db) 1775 DB_File db 1776 PREINIT: 1777 dMY_CXT; 1778 ALIAS: SHIFT = 1 1779 PREINIT: 1780 I32 RETVAL; 1781 CODE: 1782 { 1783 DBT value ; 1784 DBTKEY key ; 1785 1786 DBT_clear(key) ; 1787 DBT_clear(value) ; 1788 CurrentDB = db ; 1789 /* get the first value */ 1790 RETVAL = do_SEQ(db, key, value, R_FIRST) ; 1791 ST(0) = sv_newmortal(); 1792 /* Now delete it */ 1793 if (RETVAL == 0) 1794 { 1795 /* the call to del will trash value, so take a copy now */ 1796 OutputValue(ST(0), value) ; 1797 RETVAL = db_del(db, key, R_CURSOR) ; 1798 if (RETVAL != 0) 1799 sv_setsv (ST(0), &PL_sv_undef) ; 1800 } 1801 } 1802 1803 1804 I32 1805 push(db, ...) 1806 DB_File db 1807 PREINIT: 1808 dMY_CXT; 1809 ALIAS: PUSH = 1 1810 CODE: 1811 { 1812 DBTKEY key ; 1813 DBT value ; 1814 DB * Db = db->dbp ; 1815 int i ; 1816 STRLEN n_a; 1817 int keyval ; 1818 1819 DBT_flags(key) ; 1820 DBT_flags(value) ; 1821 CurrentDB = db ; 1822 /* Set the Cursor to the Last element */ 1823 RETVAL = do_SEQ(db, key, value, R_LAST) ; 1824 #ifndef DB_VERSION_MAJOR 1825 if (RETVAL >= 0) 1826 #endif 1827 { 1828 if (RETVAL == 0) 1829 keyval = *(int*)key.data ; 1830 else 1831 keyval = 0 ; 1832 for (i = 1 ; i < items ; ++i) 1833 { 1834 DBM_ckFilter(ST(i), filter_store_value, "filter_store_value"); 1835 value.data = SvPVbyte(ST(i), n_a) ; 1836 value.size = n_a ; 1837 ++ keyval ; 1838 key.data = &keyval ; 1839 key.size = sizeof(int) ; 1840 RETVAL = (Db->put)(Db, TXN &key, &value, 0) ; 1841 if (RETVAL != 0) 1842 break; 1843 } 1844 } 1845 } 1846 OUTPUT: 1847 RETVAL 1848 1849 I32 1850 length(db) 1851 DB_File db 1852 PREINIT: 1853 dMY_CXT; 1854 ALIAS: FETCHSIZE = 1 1855 CODE: 1856 CurrentDB = db ; 1857 RETVAL = GetArrayLength(aTHX_ db) ; 1858 OUTPUT: 1859 RETVAL 1860 1861 1862 # 1863 # Now provide an interface to the rest of the DB functionality 1864 # 1865 1866 int 1867 db_del(db, key, flags=0) 1868 DB_File db 1869 DBTKEY key 1870 u_int flags 1871 PREINIT: 1872 dMY_CXT; 1873 CODE: 1874 CurrentDB = db ; 1875 RETVAL = db_del(db, key, flags) ; 1876 #ifdef DB_VERSION_MAJOR 1877 if (RETVAL > 0) 1878 RETVAL = -1 ; 1879 else if (RETVAL == DB_NOTFOUND) 1880 RETVAL = 1 ; 1881 #endif 1882 OUTPUT: 1883 RETVAL 1884 1885 1886 int 1887 db_get(db, key, value, flags=0) 1888 DB_File db 1889 DBTKEY key 1890 DBT value = NO_INIT 1891 u_int flags 1892 PREINIT: 1893 dMY_CXT; 1894 CODE: 1895 CurrentDB = db ; 1896 DBT_clear(value) ; 1897 RETVAL = db_get(db, key, value, flags) ; 1898 #ifdef DB_VERSION_MAJOR 1899 if (RETVAL > 0) 1900 RETVAL = -1 ; 1901 else if (RETVAL == DB_NOTFOUND) 1902 RETVAL = 1 ; 1903 #endif 1904 OUTPUT: 1905 RETVAL 1906 value 1907 1908 int 1909 db_put(db, key, value, flags=0) 1910 DB_File db 1911 DBTKEY key 1912 DBT value 1913 u_int flags 1914 PREINIT: 1915 dMY_CXT; 1916 CODE: 1917 CurrentDB = db ; 1918 RETVAL = db_put(db, key, value, flags) ; 1919 #ifdef DB_VERSION_MAJOR 1920 if (RETVAL > 0) 1921 RETVAL = -1 ; 1922 else if (RETVAL == DB_KEYEXIST) 1923 RETVAL = 1 ; 1924 #endif 1925 OUTPUT: 1926 RETVAL 1927 key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key); 1928 1929 int 1930 db_fd(db) 1931 DB_File db 1932 PREINIT: 1933 dMY_CXT ; 1934 CODE: 1935 CurrentDB = db ; 1936 #ifdef DB_VERSION_MAJOR 1937 RETVAL = -1 ; 1938 { 1939 int status = 0 ; 1940 status = (db->in_memory 1941 ? -1 1942 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ; 1943 if (status != 0) 1944 RETVAL = -1 ; 1945 } 1946 #else 1947 RETVAL = (db->in_memory 1948 ? -1 1949 : ((db->dbp)->fd)(db->dbp) ) ; 1950 #endif 1951 OUTPUT: 1952 RETVAL 1953 1954 int 1955 db_sync(db, flags=0) 1956 DB_File db 1957 u_int flags 1958 PREINIT: 1959 dMY_CXT; 1960 CODE: 1961 CurrentDB = db ; 1962 RETVAL = db_sync(db, flags) ; 1963 #ifdef DB_VERSION_MAJOR 1964 if (RETVAL > 0) 1965 RETVAL = -1 ; 1966 #endif 1967 OUTPUT: 1968 RETVAL 1969 1970 1971 int 1972 db_seq(db, key, value, flags) 1973 DB_File db 1974 DBTKEY key 1975 DBT value = NO_INIT 1976 u_int flags 1977 PREINIT: 1978 dMY_CXT; 1979 CODE: 1980 CurrentDB = db ; 1981 DBT_clear(value) ; 1982 RETVAL = db_seq(db, key, value, flags); 1983 #ifdef DB_VERSION_MAJOR 1984 if (RETVAL > 0) 1985 RETVAL = -1 ; 1986 else if (RETVAL == DB_NOTFOUND) 1987 RETVAL = 1 ; 1988 #endif 1989 OUTPUT: 1990 RETVAL 1991 key 1992 value 1993 1994 SV * 1995 filter_fetch_key(db, code) 1996 DB_File db 1997 SV * code 1998 SV * RETVAL = &PL_sv_undef ; 1999 CODE: 2000 DBM_setFilter(db->filter_fetch_key, code) ; 2001 2002 SV * 2003 filter_store_key(db, code) 2004 DB_File db 2005 SV * code 2006 SV * RETVAL = &PL_sv_undef ; 2007 CODE: 2008 DBM_setFilter(db->filter_store_key, code) ; 2009 2010 SV * 2011 filter_fetch_value(db, code) 2012 DB_File db 2013 SV * code 2014 SV * RETVAL = &PL_sv_undef ; 2015 CODE: 2016 DBM_setFilter(db->filter_fetch_value, code) ; 2017 2018 SV * 2019 filter_store_value(db, code) 2020 DB_File db 2021 SV * code 2022 SV * RETVAL = &PL_sv_undef ; 2023 CODE: 2024 DBM_setFilter(db->filter_store_value, code) ; 2025 2026