1 #define PERL_NO_GET_CONTEXT 2 3 #include "EXTERN.h" 4 #include "perl.h" 5 #include "XSUB.h" 6 7 #include <gdbm.h> 8 #include <fcntl.h> 9 10 #define fetch_key 0 11 #define store_key 1 12 #define fetch_value 2 13 #define store_value 3 14 15 typedef struct { 16 GDBM_FILE dbp ; 17 SV * filter[4]; 18 int filtering ; 19 } GDBM_File_type; 20 21 typedef GDBM_File_type * GDBM_File ; 22 typedef datum datum_key ; 23 typedef datum datum_value ; 24 typedef datum datum_key_copy; 25 26 /* Indexes for gdbm_flags aliases */ 27 enum { 28 opt_flags = 0, 29 opt_cache_size, 30 opt_sync_mode, 31 opt_centfree, 32 opt_coalesce, 33 opt_dbname, 34 opt_block_size, 35 opt_mmap, 36 opt_mmapsize 37 }; 38 39 /* Names of gdbm_flags aliases, for error reporting. 40 Indexed by opt_ constants above. 41 */ 42 char const *opt_names[] = { 43 "GDBM_File::flags", 44 "GDBM_File::cache_size", 45 "GDBM_File::sync_mode", 46 "GDBM_File::centfree", 47 "GDBM_File::coalesce", 48 "GDBM_File::dbname", 49 "GDBM_File::block_size", 50 "GDBM_File::mmap", 51 "GDBM_File::mmapsize" 52 }; 53 54 #ifdef GDBM_VERSION_MAJOR 55 # define GDBM_VERSION_GUESS 0 56 #else 57 /* Try educated guess 58 * The value of GDBM_VERSION_GUESS indicates how rough the guess is: 59 * 1 - Precise; based on the CVS logs and existing archives 60 * 2 - Moderate. The major and minor number are correct. The patchlevel 61 * is set to the upper bound. 62 * 3 - Rough; The version is guaranteed to be not newer than major.minor. 63 */ 64 # if defined(GDBM_SYNCMODE) 65 /* CHANGES from 1.7.3 to 1.8 66 * 1. Added GDBM_CENTFREE functionality and option. 67 */ 68 # define GDBM_VERSION_MAJOR 1 69 # define GDBM_VERSION_MINOR 8 70 # define GDBM_VERSION_PATCH 3 71 # define GDBM_VERSION_GUESS 1 72 # elif defined(GDBM_FASTMODE) 73 /* CHANGES from 1.7.2 to 1.7.3 74 * 1. Fixed a couple of last minute problems. (Namely, no autoconf.h in 75 * version.c, and no GDBM_FASTMODE in gdbm.h!) 76 */ 77 # define GDBM_VERSION_MAJOR 1 78 # define GDBM_VERSION_MINOR 7 79 # define GDBM_VERSION_PATCH 3 80 # define GDBM_VERSION_GUESS 1 81 # elif defined(GDBM_FAST) 82 /* From CVS logs: 83 * Mon May 17 12:32:02 1993 Phil Nelson (phil at cs.wwu.edu) 84 * 85 * * gdbm.proto: Added GDBM_FAST to the read_write flags. 86 */ 87 # define GDBM_VERSION_MAJOR 1 88 # define GDBM_VERSION_MINOR 7 89 # define GDBM_VERSION_PATCH 2 90 # define GDBM_VERSION_GUESS 2 91 # else 92 # define GDBM_VERSION_MAJOR 1 93 # define GDBM_VERSION_MINOR 6 94 # define GDBM_VERSION_GUESS 3 95 # endif 96 #endif 97 98 #ifndef GDBM_VERSION_PATCH 99 # define GDBM_VERSION_PATCH 0 100 #endif 101 102 /* The use of fatal_func argument to gdbm_open is deprecated since 1.13 */ 103 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13 104 # define FATALFUNC NULL 105 #elif GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 9 106 # define FATALFUNC croak_string 107 # define NEED_FATALFUNC 1 108 #else 109 # define FATALFUNC (void (*)()) croak_string 110 # define NEED_FATALFUNC 1 111 #endif 112 113 #ifdef NEED_FATALFUNC 114 static void 115 croak_string(const char *message) { 116 Perl_croak_nocontext("%s", message); 117 } 118 #endif 119 120 #define not_here(s) (croak("GDBM_File::%s not implemented", #s),-1) 121 122 #if ! (GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 11) 123 typedef unsigned gdbm_count_t; 124 #endif 125 126 /* GDBM allocates the datum with system malloc() and expects the user 127 * to free() it. So we either have to free() it immediately, or have 128 * perl free() it when it deallocates the SV, depending on whether 129 * perl uses malloc()/free() or not. */ 130 static void 131 output_datum(pTHX_ SV *arg, char *str, int size) 132 { 133 sv_setpvn(arg, str, size); 134 # undef free 135 free(str); 136 } 137 138 /* Versions of gdbm prior to 1.7x might not have the gdbm_sync, 139 gdbm_exists, and gdbm_setopt functions. Apparently Slackware 140 (Linux) 2.1 contains gdbm-1.5 (which dates back to 1991). 141 */ 142 #ifndef GDBM_FAST 143 #define gdbm_exists(db,key) not_here("gdbm_exists") 144 #define gdbm_sync(db) (void) not_here("gdbm_sync") 145 #define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt") 146 #endif 147 148 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR < 13 149 /* Prior to 1.13, only gdbm_fetch set GDBM_ITEM_NOT_FOUND if the requested 150 key did not exist. Other similar functions would set GDBM_NO_ERROR instead. 151 The GDBM_ITEM_NOT_FOUND existed as early as in 1.7.3 */ 152 # define ITEM_NOT_FOUND() (gdbm_errno == GDBM_NO_ERROR || gdbm_errno == GDBM_ITEM_NOT_FOUND) 153 #else 154 # define ITEM_NOT_FOUND() (gdbm_errno == GDBM_ITEM_NOT_FOUND) 155 #endif 156 157 #define CHECKDB(db) do { \ 158 if (!db->dbp) { \ 159 croak("database was closed"); \ 160 } \ 161 } while (0) 162 163 static void 164 dbcroak(GDBM_File db, char const *func) 165 { 166 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13 167 if (db) 168 croak("%s: %s", func, gdbm_db_strerror(db->dbp)); 169 if (gdbm_check_syserr(gdbm_errno)) 170 croak("%s: %s: %s", func, gdbm_strerror(gdbm_errno), strerror(errno)); 171 #else 172 (void)db; 173 #endif 174 croak("%s: %s", func, gdbm_strerror(gdbm_errno)); 175 } 176 177 #if GDBM_VERSION_MAJOR == 1 && (GDBM_VERSION_MINOR > 16 || GDBM_VERSION_PATCH >= 90) 178 # define gdbm_close(db) gdbm_close(db->dbp) 179 #else 180 # define gdbm_close(db) (gdbm_close(db->dbp),0) 181 #endif 182 static int 183 gdbm_file_close(GDBM_File db) 184 { 185 int rc = 0; 186 if (db->dbp) { 187 rc = gdbm_close(db); 188 db->dbp = NULL; 189 } 190 return rc; 191 } 192 193 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13 194 /* Error-reporting wrapper for gdbm_recover */ 195 static void 196 rcvr_errfun(void *cv, char const *fmt, ...) 197 { 198 dTHX; 199 dSP; 200 va_list ap; 201 202 ENTER; 203 SAVETMPS; 204 205 PUSHMARK(SP); 206 va_start(ap, fmt); 207 XPUSHs(sv_2mortal(vnewSVpvf(fmt, &ap))); 208 va_end(ap); 209 PUTBACK; 210 211 call_sv((SV*)cv, G_DISCARD); 212 213 FREETMPS; 214 LEAVE; 215 } 216 #endif 217 218 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR < 13 219 static int 220 gdbm_check_syserr(int ec) 221 { 222 switch (ec) { 223 case GDBM_FILE_OPEN_ERROR: 224 case GDBM_FILE_WRITE_ERROR: 225 case GDBM_FILE_SEEK_ERROR: 226 case GDBM_FILE_READ_ERROR: 227 return 1; 228 229 default: 230 return 0; 231 } 232 } 233 #endif 234 235 static I32 236 get_gdbm_errno(pTHX_ IV idx, SV *sv) 237 { 238 PERL_UNUSED_ARG(idx); 239 sv_setiv(sv, gdbm_errno); 240 sv_setpv(sv, gdbm_strerror(gdbm_errno)); 241 if (gdbm_check_syserr(gdbm_errno)) { 242 SV *val = get_sv("!", 0); 243 if (val) { 244 sv_catpv(sv, ": "); 245 sv_catsv(sv, val); 246 } 247 } 248 SvIOK_on(sv); 249 return 0; 250 } 251 252 static I32 253 set_gdbm_errno(pTHX_ IV idx, SV *sv) 254 { 255 PERL_UNUSED_ARG(idx); 256 gdbm_errno = SvIV(sv); 257 return 0; 258 } 259 260 261 #include "const-c.inc" 262 263 MODULE = GDBM_File PACKAGE = GDBM_File PREFIX = gdbm_ 264 265 INCLUDE: const-xs.inc 266 267 BOOT: 268 { 269 SV *sv = get_sv("GDBM_File::gdbm_errno", GV_ADD); 270 struct ufuncs uf; 271 272 uf.uf_val = get_gdbm_errno; 273 uf.uf_set = set_gdbm_errno; 274 uf.uf_index = 0; 275 276 sv_magic(sv, NULL, PERL_MAGIC_uvar, (char*)&uf, sizeof(uf)); 277 } 278 279 void 280 gdbm_GDBM_version(package) 281 PPCODE: 282 I32 gimme = GIMME_V; 283 if (gimme == G_VOID) { 284 /* nothing */; 285 } else if (gimme == G_SCALAR) { 286 static char const *guess[] = { 287 "", 288 " (exact guess)", 289 " (approximate)", 290 " (rough guess)" 291 }; 292 if (GDBM_VERSION_PATCH > 0) { 293 XPUSHs(sv_2mortal(newSVpvf("%d.%d.%d%s", 294 GDBM_VERSION_MAJOR, 295 GDBM_VERSION_MINOR, 296 GDBM_VERSION_PATCH, 297 guess[GDBM_VERSION_GUESS]))); 298 } else { 299 XPUSHs(sv_2mortal(newSVpvf("%d.%d%s", 300 GDBM_VERSION_MAJOR, 301 GDBM_VERSION_MINOR, 302 guess[GDBM_VERSION_GUESS]))); 303 } 304 } else { 305 XPUSHs(sv_2mortal(newSVuv(GDBM_VERSION_MAJOR))); 306 XPUSHs(sv_2mortal(newSVuv(GDBM_VERSION_MINOR))); 307 XPUSHs(sv_2mortal(newSVuv(GDBM_VERSION_PATCH))); 308 if (GDBM_VERSION_GUESS > 0) { 309 XPUSHs(sv_2mortal(newSVuv(GDBM_VERSION_GUESS))); 310 } 311 } 312 313 GDBM_File 314 gdbm_TIEHASH(dbtype, name, read_write, mode) 315 char * dbtype 316 char * name 317 int read_write 318 int mode 319 PREINIT: 320 GDBM_FILE dbp; 321 CODE: 322 dbp = gdbm_open(name, 0, read_write, mode, FATALFUNC); 323 if (!dbp && gdbm_errno == GDBM_BLOCK_SIZE_ERROR) { 324 /* 325 * By specifying a block size of 0 above, we asked gdbm to 326 * default to the filesystem's block size. That's usually the 327 * right size to choose. But some versions of gdbm require 328 * a power-of-two block size, and some unusual filesystems 329 * or devices have a non-power-of-two size that cause this 330 * defaulting to fail. In that case, force an acceptable 331 * block size. 332 */ 333 dbp = gdbm_open(name, 4096, read_write, mode, FATALFUNC); 334 } 335 if (dbp) { 336 RETVAL = (GDBM_File)safecalloc(1, sizeof(GDBM_File_type)); 337 RETVAL->dbp = dbp; 338 } else { 339 RETVAL = NULL; 340 } 341 OUTPUT: 342 RETVAL 343 344 void 345 gdbm_DESTROY(db) 346 GDBM_File db 347 PREINIT: 348 int i = store_value; 349 CODE: 350 if (gdbm_file_close(db)) { 351 croak("gdbm_close: %s; %s", gdbm_strerror(gdbm_errno), 352 strerror(errno)); 353 } 354 do { 355 if (db->filter[i]) 356 SvREFCNT_dec(db->filter[i]); 357 } while (i-- > 0); 358 safefree(db); 359 360 void 361 gdbm_UNTIE(db, count) 362 GDBM_File db 363 unsigned count 364 CODE: 365 if (count == 0) { 366 if (gdbm_file_close(db)) 367 croak("gdbm_close: %s; %s", 368 gdbm_strerror(gdbm_errno), 369 strerror(errno)); 370 } 371 372 373 #define gdbm_FETCH(db,key) gdbm_fetch(db->dbp,key) 374 datum_value 375 gdbm_FETCH(db, key) 376 GDBM_File db 377 datum_key_copy key 378 INIT: 379 CHECKDB(db); 380 CLEANUP: 381 if (RETVAL.dptr == NULL && !ITEM_NOT_FOUND()) { 382 dbcroak(db, "gdbm_fetch"); 383 } 384 385 #define gdbm_STORE(db,key,value,flags) gdbm_store(db->dbp,key,value,flags) 386 int 387 gdbm_STORE(db, key, value, flags = GDBM_REPLACE) 388 GDBM_File db 389 datum_key key 390 datum_value value 391 int flags 392 INIT: 393 CHECKDB(db); 394 CLEANUP: 395 if (RETVAL) { 396 dbcroak(db, "gdbm_store"); 397 } 398 399 #define gdbm_DELETE(db,key) gdbm_delete(db->dbp,key) 400 int 401 gdbm_DELETE(db, key) 402 GDBM_File db 403 datum_key key 404 INIT: 405 CHECKDB(db); 406 CLEANUP: 407 if (RETVAL && !ITEM_NOT_FOUND()) { 408 dbcroak(db, "gdbm_delete"); 409 } 410 411 #define gdbm_FIRSTKEY(db) gdbm_firstkey(db->dbp) 412 datum_key 413 gdbm_FIRSTKEY(db) 414 GDBM_File db 415 INIT: 416 CHECKDB(db); 417 CLEANUP: 418 if (RETVAL.dptr == NULL && !ITEM_NOT_FOUND()) { 419 dbcroak(db, "gdbm_firstkey"); 420 } 421 422 #define gdbm_NEXTKEY(db,key) gdbm_nextkey(db->dbp,key) 423 datum_key 424 gdbm_NEXTKEY(db, key) 425 GDBM_File db 426 datum_key key 427 INIT: 428 CHECKDB(db); 429 CLEANUP: 430 if (RETVAL.dptr == NULL && !ITEM_NOT_FOUND()) { 431 dbcroak(db, "gdbm_nextkey"); 432 } 433 434 #define gdbm_EXISTS(db,key) gdbm_exists(db->dbp,key) 435 int 436 gdbm_EXISTS(db, key) 437 GDBM_File db 438 datum_key key 439 INIT: 440 CHECKDB(db); 441 442 ## 443 444 int 445 gdbm_close(db) 446 GDBM_File db 447 INIT: 448 CHECKDB(db); 449 CODE: 450 RETVAL = gdbm_file_close(db); 451 OUTPUT: 452 RETVAL 453 454 #define gdbm_gdbm_check_syserr(ec) gdbm_check_syserr(ec) 455 int 456 gdbm_gdbm_check_syserr(ec) 457 int ec 458 459 SV * 460 gdbm_errno(db) 461 GDBM_File db 462 INIT: 463 CHECKDB(db); 464 CODE: 465 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13 466 { 467 int ec = gdbm_last_errno(db->dbp); 468 RETVAL = newSViv(ec); 469 sv_setpv(RETVAL, gdbm_db_strerror (db->dbp)); 470 SvIOK_on(RETVAL); 471 } 472 #else 473 RETVAL = newSVsv(get_sv("GDBM_File::gdbm_errno", 0)); 474 #endif 475 OUTPUT: 476 RETVAL 477 478 int 479 gdbm_syserrno(db) 480 GDBM_File db 481 INIT: 482 CHECKDB(db); 483 CODE: 484 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13 485 { 486 int ec = gdbm_last_errno(db->dbp); 487 if (gdbm_check_syserr(ec)) { 488 RETVAL = gdbm_last_syserr(db->dbp); 489 } else { 490 RETVAL = 0; 491 } 492 } 493 #else 494 RETVAL = not_here("syserrno"); 495 #endif 496 OUTPUT: 497 RETVAL 498 499 SV * 500 gdbm_strerror(db) 501 GDBM_File db 502 PREINIT: 503 char const *errstr; 504 INIT: 505 CHECKDB(db); 506 CODE: 507 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13 508 errstr = gdbm_db_strerror(db->dbp); 509 #else 510 errstr = gdbm_strerror(gdbm_errno); 511 #endif 512 RETVAL = newSVpv(errstr, 0); 513 OUTPUT: 514 RETVAL 515 516 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13 517 # define gdbm_clear_error(db) gdbm_clear_error(db->dbp) 518 #else 519 # define gdbm_clear_error(db) (gdbm_errno = 0) 520 #endif 521 void 522 gdbm_clear_error(db) 523 GDBM_File db 524 INIT: 525 CHECKDB(db); 526 527 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13 528 # define gdbm_needs_recovery(db) gdbm_needs_recovery(db->dbp) 529 #else 530 # define gdbm_needs_recovery(db) not_here("gdbm_needs_recovery") 531 #endif 532 int 533 gdbm_needs_recovery(db) 534 GDBM_File db 535 INIT: 536 CHECKDB(db); 537 538 #define gdbm_reorganize(db) gdbm_reorganize(db->dbp) 539 int 540 gdbm_reorganize(db) 541 GDBM_File db 542 INIT: 543 CHECKDB(db); 544 545 546 # Arguments: 547 # err => sub { ... } 548 # max_failed_keys => $n 549 # max_failed_buckets => $n 550 # max_failures => $n 551 # backup => \$str 552 # stat => \%hash 553 554 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13 555 556 void 557 gdbm_recover(db, ...) 558 GDBM_File db 559 PREINIT: 560 int flags = GDBM_RCVR_FORCE; 561 SV *backup_ref = &PL_sv_undef; 562 SV *stat_ref = &PL_sv_undef; 563 gdbm_recovery rcvr; 564 INIT: 565 CHECKDB(db); 566 CODE: 567 if (items > 1) { 568 int i; 569 if ((items % 2) == 0) { 570 croak_xs_usage(cv, "db, %opts"); 571 } 572 for (i = 1; i < items; i += 2) { 573 char *kw; 574 SV *sv = ST(i); 575 SV *val = ST(i+1); 576 577 kw = SvPV_nolen(sv); 578 if (strcmp(kw, "err") == 0) { 579 SvGETMAGIC(val); 580 if (SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVCV) { 581 rcvr.data = SvRV(val); 582 } else { 583 croak("%s must be a code ref", kw); 584 } 585 rcvr.errfun = rcvr_errfun; 586 flags |= GDBM_RCVR_ERRFUN; 587 } else if (strcmp(kw, "max_failed_keys") == 0) { 588 rcvr.max_failed_keys = SvUV(val); 589 flags |= GDBM_RCVR_MAX_FAILED_KEYS; 590 } else if (strcmp(kw, "max_failed_buckets") == 0) { 591 rcvr.max_failed_buckets = SvUV(val); 592 flags |= GDBM_RCVR_MAX_FAILED_BUCKETS; 593 } else if (strcmp(kw, "max_failures") == 0) { 594 rcvr.max_failures = SvUV(val); 595 flags |= GDBM_RCVR_MAX_FAILURES; 596 } else if (strcmp(kw, "backup") == 0) { 597 SvGETMAGIC(val); 598 if (SvROK(val) && SvTYPE(SvRV(val)) < SVt_PVAV) { 599 backup_ref = val; 600 } else { 601 croak("%s must be a scalar reference", kw); 602 } 603 flags |= GDBM_RCVR_BACKUP; 604 } else if (strcmp(kw, "stat") == 0) { 605 SvGETMAGIC(val); 606 if (SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVHV) { 607 stat_ref = val; 608 } else { 609 croak("%s must be a scalar reference", kw); 610 } 611 } else { 612 croak("%s: unrecognized argument", kw); 613 } 614 } 615 } 616 if (gdbm_recover(db->dbp, &rcvr, flags)) { 617 dbcroak(db, "gdbm_recover"); 618 } 619 if (stat_ref != &PL_sv_undef) { 620 HV *hv = (HV*)SvRV(stat_ref); 621 #define STAT_RECOVERED_KEYS_STR "recovered_keys" 622 #define STAT_RECOVERED_KEYS_LEN (sizeof(STAT_RECOVERED_KEYS_STR)-1) 623 #define STAT_RECOVERED_BUCKETS_STR "recovered_buckets" 624 #define STAT_RECOVERED_BUCKETS_LEN (sizeof(STAT_RECOVERED_BUCKETS_STR)-1) 625 #define STAT_FAILED_KEYS_STR "failed_keys" 626 #define STAT_FAILED_KEYS_LEN (sizeof(STAT_FAILED_KEYS_STR)-1) 627 #define STAT_FAILED_BUCKETS_STR "failed_buckets" 628 #define STAT_FAILED_BUCKETS_LEN (sizeof(STAT_FAILED_BUCKETS_STR)-1) 629 hv_store(hv, STAT_RECOVERED_KEYS_STR, STAT_RECOVERED_KEYS_LEN, 630 newSVuv(rcvr.recovered_keys), 0); 631 hv_store(hv, 632 STAT_RECOVERED_BUCKETS_STR, 633 STAT_RECOVERED_BUCKETS_LEN, 634 newSVuv(rcvr.recovered_buckets), 0); 635 hv_store(hv, 636 STAT_FAILED_KEYS_STR, 637 STAT_FAILED_KEYS_LEN, 638 newSVuv(rcvr.failed_keys), 0); 639 hv_store(hv, 640 STAT_FAILED_BUCKETS_STR, 641 STAT_FAILED_BUCKETS_LEN, 642 newSVuv(rcvr.failed_buckets), 0); 643 } 644 if (backup_ref != &PL_sv_undef) { 645 SV *sv = SvRV(backup_ref); 646 sv_setpv(sv, rcvr.backup_name); 647 free(rcvr.backup_name); 648 } 649 650 #endif 651 652 #if GDBM_VERSION_MAJOR == 1 && (GDBM_VERSION_MINOR > 16 || GDBM_VERSION_PATCH >= 90) 653 # define gdbm_sync(db) gdbm_sync(db->dbp) 654 #else 655 # define gdbm_sync(db) (gdbm_sync(db->dbp),0) 656 #endif 657 int 658 gdbm_sync(db) 659 GDBM_File db 660 INIT: 661 CHECKDB(db); 662 CLEANUP: 663 if (RETVAL) { 664 dbcroak(db, "gdbm_sync"); 665 } 666 667 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 11 668 669 gdbm_count_t 670 gdbm_count(db) 671 GDBM_File db 672 PREINIT: 673 gdbm_count_t c; 674 INIT: 675 CHECKDB(db); 676 CODE: 677 if (gdbm_count(db->dbp, &c)) { 678 dbcroak(db, "gdbm_count"); 679 } 680 RETVAL = c; 681 OUTPUT: 682 RETVAL 683 684 void 685 gdbm_dump(db, filename, ...) 686 GDBM_File db 687 char * filename 688 PREINIT: 689 int format = GDBM_DUMP_FMT_ASCII; 690 int flags = GDBM_WRCREAT; 691 int mode = 0666; 692 INIT: 693 CHECKDB(db); 694 CODE: 695 if (items % 2) { 696 croak_xs_usage(cv, "db, filename, %opts"); 697 } else { 698 int i; 699 700 for (i = 2; i < items; i += 2) { 701 char *kw; 702 SV *sv = ST(i); 703 SV *val = ST(i+1); 704 705 kw = SvPV_nolen(sv); 706 if (strcmp(kw, "mode") == 0) { 707 mode = SvUV(val) & 0777; 708 } else if (strcmp(kw, "binary") == 0) { 709 if (SvTRUE(val)) { 710 format = GDBM_DUMP_FMT_BINARY; 711 } 712 } else if (strcmp(kw, "overwrite") == 0) { 713 if (SvTRUE(val)) { 714 flags = GDBM_NEWDB; 715 } 716 } else { 717 croak("unrecognized keyword: %s", kw); 718 } 719 } 720 if (gdbm_dump(db->dbp, filename, format, flags, mode)) { 721 dbcroak(NULL, "dump"); 722 } 723 } 724 725 void 726 gdbm_load(db, filename, ...) 727 GDBM_File db 728 char * filename 729 PREINIT: 730 int flag = GDBM_INSERT; 731 int meta_mask = 0; 732 unsigned long errline; 733 int result; 734 int strict_errors = 0; 735 INIT: 736 CHECKDB(db); 737 CODE: 738 if (items % 2) { 739 croak_xs_usage(cv, "db, filename, %opts"); 740 } else { 741 int i; 742 743 for (i = 2; i < items; i += 2) { 744 char *kw; 745 SV *sv = ST(i); 746 SV *val = ST(i+1); 747 748 kw = SvPV_nolen(sv); 749 750 if (strcmp(kw, "restore_mode") == 0) { 751 if (!SvTRUE(val)) 752 meta_mask |= GDBM_META_MASK_MODE; 753 } else if (strcmp(kw, "restore_owner") == 0) { 754 if (!SvTRUE(val)) 755 meta_mask |= GDBM_META_MASK_OWNER; 756 } else if (strcmp(kw, "replace") == 0) { 757 if (SvTRUE(val)) 758 flag = GDBM_REPLACE; 759 } else if (strcmp(kw, "strict_errors") == 0) { 760 strict_errors = SvTRUE(val); 761 } else { 762 croak("unrecognized keyword: %s", kw); 763 } 764 } 765 } 766 767 result = gdbm_load(&db->dbp, filename, flag, meta_mask, &errline); 768 if (result == -1 || (result == 1 && strict_errors)) { 769 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13 770 if (errline) { 771 croak("%s:%lu: database load error: %s", 772 filename, errline, gdbm_db_strerror(db->dbp)); 773 } else { 774 croak("%s: database load error: %s", 775 filename, gdbm_db_strerror(db->dbp)); 776 } 777 #else 778 if (errline) { 779 croak("%s:%lu: database load error: %s", 780 filename, errline, gdbm_strerror(gdbm_errno)); 781 } else { 782 croak("%s: database load error: %s", 783 filename, gdbm_strerror(gdbm_errno)); 784 } 785 #endif 786 } 787 788 #endif 789 790 #define OPTNAME(a,b) a ## b 791 #define INTOPTSETUP(opt) \ 792 do { \ 793 if (items == 1) { \ 794 opcode = OPTNAME(GDBM_GET, opt); \ 795 } else { \ 796 opcode = OPTNAME(GDBM_SET, opt); \ 797 c_iv = SvIV(ST(1)); \ 798 } \ 799 } while (0) 800 801 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 9 802 # define OPTVALPTR void * 803 #else 804 # define OPTVALPTR int * 805 #endif 806 807 # GDBM_GET defines appeared in version 1.9 (2011-08-12). 808 # 809 # Provide definitions for earlier versions. These will cause gdbm_setopt 810 # to fail with GDBM_OPT_ILLEGAL 811 812 #ifndef GDBM_GETFLAGS 813 # define GDBM_GETFLAGS -1 814 #endif 815 #ifndef GDBM_GETMMAP 816 # define GDBM_GETMMAP -1 817 #endif 818 #ifndef GDBM_GETCACHESIZE 819 # define GDBM_GETCACHESIZE -1 820 #endif 821 #ifndef GDBM_GETSYNCMODE 822 # define GDBM_GETSYNCMODE -1 823 #endif 824 #ifndef GDBM_GETCENTFREE 825 # define GDBM_GETCENTFREE -1 826 #endif 827 #ifndef GDBM_GETCOALESCEBLKS 828 # define GDBM_GETCOALESCEBLKS -1 829 #endif 830 #ifndef GDBM_GETMAXMAPSIZE 831 # define GDBM_GETMAXMAPSIZE -1 832 #endif 833 #ifndef GDBM_GETDBNAME 834 # define GDBM_GETDBNAME -1 835 #endif 836 #ifndef GDBM_GETBLOCKSIZE 837 # define GDBM_GETBLOCKSIZE -1 838 #endif 839 840 # These two appeared in version 1.10: 841 842 #ifndef GDBM_SETMAXMAPSIZE 843 # define GDBM_SETMAXMAPSIZE -1 844 #endif 845 #ifndef GDBM_SETMMAP 846 # define GDBM_SETMMAP -1 847 #endif 848 849 # These GDBM_SET defines appeared in 1.10, replacing obsolete opcodes. 850 # Provide definitions for older versions 851 852 #ifndef GDBM_SETCACHESIZE 853 # define GDBM_SETCACHESIZE GDBM_CACHESIZE 854 #endif 855 #ifndef GDBM_SETSYNCMODE 856 # define GDBM_SETSYNCMODE GDBM_SYNCMODE 857 #endif 858 #ifndef GDBM_SETCENTFREE 859 # define GDBM_SETCENTFREE GDBM_CENTFREE 860 #endif 861 #ifndef GDBM_SETCOALESCEBLKS 862 # define GDBM_SETCOALESCEBLKS GDBM_COALESCEBLKS 863 #endif 864 865 SV * 866 gdbm_flags(db, ...) 867 GDBM_File db 868 SV * RETVAL = &PL_sv_undef; 869 ALIAS: 870 GDBM_File::cache_size = opt_cache_size 871 GDBM_File::sync_mode = opt_sync_mode 872 GDBM_File::centfree = opt_centfree 873 GDBM_File::coalesce = opt_coalesce 874 GDBM_File::dbname = opt_dbname 875 GDBM_File::block_size = opt_block_size 876 GDBM_File::mmap = opt_mmap 877 GDBM_File::mmapsize = opt_mmapsize 878 PREINIT: 879 int opcode = -1; 880 int c_iv; 881 unsigned c_uv; 882 char *c_cv; 883 OPTVALPTR vptr = (OPTVALPTR) &c_iv; 884 size_t vsiz = sizeof(c_iv); 885 INIT: 886 CHECKDB(db); 887 CODE: 888 if (items > 2) { 889 croak("%s: too many arguments", opt_names[ix]); 890 } 891 892 switch (ix) { 893 case opt_flags: 894 if (items > 1) { 895 croak("%s: too many arguments", opt_names[ix]); 896 } 897 opcode = GDBM_GETFLAGS; 898 break; 899 case opt_cache_size: 900 INTOPTSETUP(CACHESIZE); 901 break; 902 case opt_sync_mode: 903 INTOPTSETUP(SYNCMODE); 904 break; 905 case opt_centfree: 906 INTOPTSETUP(CENTFREE); 907 break; 908 case opt_coalesce: 909 INTOPTSETUP(COALESCEBLKS); 910 break; 911 case opt_dbname: 912 if (items > 1) { 913 croak("%s: too many arguments", opt_names[ix]); 914 } 915 opcode = GDBM_GETDBNAME; 916 vptr = (OPTVALPTR) &c_cv; 917 vsiz = sizeof(c_cv); 918 break; 919 case opt_block_size: 920 if (items > 1) { 921 croak("%s: too many arguments", opt_names[ix]); 922 } 923 opcode = GDBM_GETBLOCKSIZE; 924 break; 925 case opt_mmap: 926 if (items > 1) { 927 croak("%s: too many arguments", opt_names[ix]); 928 } 929 opcode = GDBM_GETMMAP; 930 break; 931 case opt_mmapsize: 932 vptr = (OPTVALPTR) &c_uv; 933 vsiz = sizeof(c_uv); 934 if (items == 1) { 935 opcode = GDBM_GETMAXMAPSIZE; 936 } else { 937 opcode = GDBM_SETMAXMAPSIZE; 938 c_uv = SvUV(ST(1)); 939 } 940 break; 941 } 942 943 if (gdbm_setopt(db->dbp, opcode, vptr, vsiz)) { 944 if (gdbm_errno == GDBM_OPT_ILLEGAL) 945 croak("%s not implemented", opt_names[ix]); 946 dbcroak(db, "gdbm_setopt"); 947 } 948 949 if (vptr == (OPTVALPTR) &c_iv) { 950 RETVAL = newSViv(c_iv); 951 } else if (vptr == (OPTVALPTR) &c_uv) { 952 RETVAL = newSVuv(c_uv); 953 } else { 954 RETVAL = newSVpv(c_cv, 0); 955 free(c_cv); 956 } 957 OUTPUT: 958 RETVAL 959 960 #define gdbm_setopt(db,optflag, optval, optlen) gdbm_setopt(db->dbp,optflag, optval, optlen) 961 int 962 gdbm_setopt (db, optflag, optval, optlen) 963 GDBM_File db 964 int optflag 965 int &optval 966 int optlen 967 INIT: 968 CHECKDB(db); 969 CLEANUP: 970 if (RETVAL) { 971 dbcroak(db, "gdbm_setopt"); 972 } 973 974 SV * 975 filter_fetch_key(db, code) 976 GDBM_File db 977 SV * code 978 SV * RETVAL = &PL_sv_undef ; 979 ALIAS: 980 GDBM_File::filter_fetch_key = fetch_key 981 GDBM_File::filter_store_key = store_key 982 GDBM_File::filter_fetch_value = fetch_value 983 GDBM_File::filter_store_value = store_value 984 CODE: 985 DBM_setFilter(db->filter[ix], code); 986 987 # 988 # Export/Import API 989 # 990 991 992 # 993 # Crash tolerance API 994 # 995 996 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 21 997 998 #define gdbm_convert(db, flag) gdbm_convert(db->dbp, flag) 999 int 1000 gdbm_convert(db, flag) 1001 GDBM_File db 1002 int flag 1003 INIT: 1004 CHECKDB(db); 1005 CLEANUP: 1006 if (RETVAL) { 1007 dbcroak(db, "gdbm_convert"); 1008 } 1009 1010 #define gdbm_failure_atomic(db, even, odd) gdbm_failure_atomic(db->dbp, even, odd) 1011 1012 int 1013 gdbm_failure_atomic(db, even, odd) 1014 GDBM_File db 1015 char * even 1016 char * odd 1017 INIT: 1018 CHECKDB(db); 1019 CLEANUP: 1020 if (RETVAL) { 1021 dbcroak(db, "gdbm_failure_atomic"); 1022 } 1023 1024 void 1025 gdbm_latest_snapshot(package, even, odd) 1026 char * even 1027 char * odd 1028 INIT: 1029 int result; 1030 int syserr; 1031 const char * filename; 1032 PPCODE: 1033 result = gdbm_latest_snapshot(even, odd, &filename); 1034 syserr = errno; 1035 if (result == GDBM_SNAPSHOT_OK) { 1036 XPUSHs(sv_2mortal(newSVpv(filename, 0))); 1037 } else { 1038 XPUSHs(&PL_sv_undef); 1039 } 1040 if (GIMME_V == G_ARRAY) { 1041 XPUSHs(sv_2mortal(newSVuv(result))); 1042 if (result == GDBM_SNAPSHOT_ERR) 1043 XPUSHs(sv_2mortal(newSVuv(syserr))); 1044 } 1045 1046 #endif 1047 1048 int 1049 gdbm_crash_tolerance_status(package) 1050 CODE: 1051 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 21 1052 /* 1053 * The call below returns GDBM_SNAPSHOT_ERR and sets errno to 1054 * EINVAL, if crash tolerance is implemented, or ENOSYS, if it 1055 * is not. 1056 */ 1057 gdbm_latest_snapshot(NULL, NULL, NULL); 1058 RETVAL = (errno != ENOSYS); 1059 #else 1060 RETVAL = 0; 1061 #endif 1062 OUTPUT: 1063 RETVAL 1064 1065