1/*- 2 * See the file LICENSE for redistribution information. 3 * 4 * Copyright (c) 1999-2009 Oracle. All rights reserved. 5 * 6 * $Id$ 7 */ 8 9#include "db_config.h" 10 11#include "db_int.h" 12#ifdef HAVE_SYSTEM_INCLUDE_FILES 13#include <tcl.h> 14#endif 15#include "dbinc/db_page.h" 16#include "dbinc/db_am.h" 17#include "dbinc/tcl_db.h" 18 19/* 20 * Prototypes for procedures defined later in this file: 21 */ 22static int tcl_DbAssociate __P((Tcl_Interp *, 23 int, Tcl_Obj * CONST*, DB *)); 24static int tcl_DbClose __P((Tcl_Interp *, 25 int, Tcl_Obj * CONST*, DB *, DBTCL_INFO *)); 26static int tcl_DbDelete __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); 27static int tcl_DbGet __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *, int)); 28#ifdef CONFIG_TEST 29static int tcl_DbKeyRange __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); 30#endif 31static int tcl_DbPut __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); 32static int tcl_DbStat __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); 33static int tcl_DbTruncate __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); 34#ifdef CONFIG_TEST 35static int tcl_DbCompact __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); 36static int tcl_DbCompactStat __P((Tcl_Interp *, 37 int, Tcl_Obj * CONST*, DB *)); 38#endif 39static int tcl_DbCursor __P((Tcl_Interp *, 40 int, Tcl_Obj * CONST*, DB *, DBC **)); 41static int tcl_DbJoin __P((Tcl_Interp *, 42 int, Tcl_Obj * CONST*, DB *, DBC **)); 43static int tcl_DbGetFlags __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); 44static int tcl_DbGetOpenFlags __P((Tcl_Interp *, 45 int, Tcl_Obj * CONST*, DB *)); 46static int tcl_DbGetjoin __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); 47static int tcl_DbCount __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); 48static int tcl_second_call __P((DB *, const DBT *, const DBT *, DBT *)); 49 50/* 51 * _DbInfoDelete -- 52 * 53 * PUBLIC: void _DbInfoDelete __P((Tcl_Interp *, DBTCL_INFO *)); 54 */ 55void 56_DbInfoDelete(interp, dbip) 57 Tcl_Interp *interp; 58 DBTCL_INFO *dbip; 59{ 60 DBTCL_INFO *nextp, *p; 61 /* 62 * First we have to close any open cursors. Then we close 63 * our db. 64 */ 65 for (p = LIST_FIRST(&__db_infohead); p != NULL; p = nextp) { 66 nextp = LIST_NEXT(p, entries); 67 /* 68 * Check if this is a cursor info structure and if 69 * it is, if it belongs to this DB. If so, remove 70 * its commands and info structure. 71 */ 72 if (p->i_parent == dbip && p->i_type == I_DBC) { 73 (void)Tcl_DeleteCommand(interp, p->i_name); 74 _DeleteInfo(p); 75 } 76 } 77 (void)Tcl_DeleteCommand(interp, dbip->i_name); 78 _DeleteInfo(dbip); 79} 80 81/* 82 * 83 * PUBLIC: int db_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*)); 84 * 85 * db_Cmd -- 86 * Implements the "db" widget. 87 */ 88int 89db_Cmd(clientData, interp, objc, objv) 90 ClientData clientData; /* DB handle */ 91 Tcl_Interp *interp; /* Interpreter */ 92 int objc; /* How many arguments? */ 93 Tcl_Obj *CONST objv[]; /* The argument objects */ 94{ 95 static const char *dbcmds[] = { 96#ifdef CONFIG_TEST 97 "keyrange", 98 "pget", 99 "rpcid", 100 "test", 101 "compact", 102 "compact_stat", 103#endif 104 "associate", 105 "close", 106 "count", 107 "cursor", 108 "del", 109 "get", 110 "get_bt_minkey", 111 "get_cachesize", 112 "get_dbname", 113 "get_encrypt_flags", 114 "get_env", 115 "get_errpfx", 116 "get_flags", 117 "get_h_ffactor", 118 "get_h_nelem", 119 "get_join", 120 "get_lorder", 121 "get_open_flags", 122 "get_pagesize", 123 "get_q_extentsize", 124 "get_re_delim", 125 "get_re_len", 126 "get_re_pad", 127 "get_re_source", 128 "get_type", 129 "is_byteswapped", 130 "join", 131 "put", 132 "stat", 133 "sync", 134 "truncate", 135 NULL 136 }; 137 enum dbcmds { 138#ifdef CONFIG_TEST 139 DBKEYRANGE, 140 DBPGET, 141 DBRPCID, 142 DBTEST, 143 DBCOMPACT, 144 DBCOMPACT_STAT, 145#endif 146 DBASSOCIATE, 147 DBCLOSE, 148 DBCOUNT, 149 DBCURSOR, 150 DBDELETE, 151 DBGET, 152 DBGETBTMINKEY, 153 DBGETCACHESIZE, 154 DBGETDBNAME, 155 DBGETENCRYPTFLAGS, 156 DBGETENV, 157 DBGETERRPFX, 158 DBGETFLAGS, 159 DBGETHFFACTOR, 160 DBGETHNELEM, 161 DBGETJOIN, 162 DBGETLORDER, 163 DBGETOPENFLAGS, 164 DBGETPAGESIZE, 165 DBGETQEXTENTSIZE, 166 DBGETREDELIM, 167 DBGETRELEN, 168 DBGETREPAD, 169 DBGETRESOURCE, 170 DBGETTYPE, 171 DBSWAPPED, 172 DBJOIN, 173 DBPUT, 174 DBSTAT, 175 DBSYNC, 176 DBTRUNCATE 177 }; 178 DB *dbp; 179 DB_ENV *dbenv; 180 DBC *dbc; 181 DBTCL_INFO *dbip, *ip; 182 DBTYPE type; 183 Tcl_Obj *res, *myobjv[3]; 184 int cmdindex, intval, ncache, result, ret; 185 char newname[MSG_SIZE]; 186 u_int32_t bytes, gbytes, value; 187 const char *strval, *filename, *dbname, *envid; 188 189 Tcl_ResetResult(interp); 190 dbp = (DB *)clientData; 191 dbip = _PtrToInfo((void *)dbp); 192 memset(newname, 0, MSG_SIZE); 193 result = TCL_OK; 194 if (objc <= 1) { 195 Tcl_WrongNumArgs(interp, 1, objv, "command cmdargs"); 196 return (TCL_ERROR); 197 } 198 if (dbp == NULL) { 199 Tcl_SetResult(interp, "NULL db pointer", TCL_STATIC); 200 return (TCL_ERROR); 201 } 202 if (dbip == NULL) { 203 Tcl_SetResult(interp, "NULL db info pointer", TCL_STATIC); 204 return (TCL_ERROR); 205 } 206 207 /* 208 * Get the command name index from the object based on the dbcmds 209 * defined above. 210 */ 211 if (Tcl_GetIndexFromObj(interp, 212 objv[1], dbcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK) 213 return (IS_HELP(objv[1])); 214 215 res = NULL; 216 switch ((enum dbcmds)cmdindex) { 217#ifdef CONFIG_TEST 218 case DBKEYRANGE: 219 result = tcl_DbKeyRange(interp, objc, objv, dbp); 220 break; 221 case DBPGET: 222 result = tcl_DbGet(interp, objc, objv, dbp, 1); 223 break; 224 case DBRPCID: 225 /* 226 * No args for this. Error if there are some. 227 */ 228 if (objc > 2) { 229 Tcl_WrongNumArgs(interp, 2, objv, NULL); 230 return (TCL_ERROR); 231 } 232 /* 233 * !!! Retrieve the client ID from the dbp handle directly. 234 * This is for testing purposes only. It is dbp-private data. 235 */ 236 res = Tcl_NewLongObj((long)dbp->cl_id); 237 break; 238 case DBTEST: 239 result = tcl_EnvTest(interp, objc, objv, dbp->dbenv); 240 break; 241 242 case DBCOMPACT: 243 result = tcl_DbCompact(interp, objc, objv, dbp); 244 break; 245 246 case DBCOMPACT_STAT: 247 result = tcl_DbCompactStat(interp, objc, objv, dbp); 248 break; 249 250#endif 251 case DBASSOCIATE: 252 result = tcl_DbAssociate(interp, objc, objv, dbp); 253 break; 254 case DBCLOSE: 255 result = tcl_DbClose(interp, objc, objv, dbp, dbip); 256 break; 257 case DBDELETE: 258 result = tcl_DbDelete(interp, objc, objv, dbp); 259 break; 260 case DBGET: 261 result = tcl_DbGet(interp, objc, objv, dbp, 0); 262 break; 263 case DBPUT: 264 result = tcl_DbPut(interp, objc, objv, dbp); 265 break; 266 case DBCOUNT: 267 result = tcl_DbCount(interp, objc, objv, dbp); 268 break; 269 case DBSWAPPED: 270 /* 271 * No args for this. Error if there are some. 272 */ 273 if (objc > 2) { 274 Tcl_WrongNumArgs(interp, 2, objv, NULL); 275 return (TCL_ERROR); 276 } 277 _debug_check(); 278 ret = dbp->get_byteswapped(dbp, &intval); 279 res = Tcl_NewIntObj(intval); 280 break; 281 case DBGETTYPE: 282 /* 283 * No args for this. Error if there are some. 284 */ 285 if (objc > 2) { 286 Tcl_WrongNumArgs(interp, 2, objv, NULL); 287 return (TCL_ERROR); 288 } 289 _debug_check(); 290 ret = dbp->get_type(dbp, &type); 291 if (type == DB_BTREE) 292 res = NewStringObj("btree", strlen("btree")); 293 else if (type == DB_HASH) 294 res = NewStringObj("hash", strlen("hash")); 295 else if (type == DB_RECNO) 296 res = NewStringObj("recno", strlen("recno")); 297 else if (type == DB_QUEUE) 298 res = NewStringObj("queue", strlen("queue")); 299 else { 300 Tcl_SetResult(interp, 301 "db gettype: Returned unknown type\n", TCL_STATIC); 302 result = TCL_ERROR; 303 } 304 break; 305 case DBSTAT: 306 result = tcl_DbStat(interp, objc, objv, dbp); 307 break; 308 case DBSYNC: 309 /* 310 * No args for this. Error if there are some. 311 */ 312 if (objc > 2) { 313 Tcl_WrongNumArgs(interp, 2, objv, NULL); 314 return (TCL_ERROR); 315 } 316 _debug_check(); 317 ret = dbp->sync(dbp, 0); 318 res = Tcl_NewIntObj(ret); 319 if (ret != 0) { 320 Tcl_SetObjResult(interp, res); 321 result = TCL_ERROR; 322 } 323 break; 324 case DBCURSOR: 325 snprintf(newname, sizeof(newname), 326 "%s.c%d", dbip->i_name, dbip->i_dbdbcid); 327 ip = _NewInfo(interp, NULL, newname, I_DBC); 328 if (ip != NULL) { 329 result = tcl_DbCursor(interp, objc, objv, dbp, &dbc); 330 if (result == TCL_OK) { 331 dbip->i_dbdbcid++; 332 ip->i_parent = dbip; 333 (void)Tcl_CreateObjCommand(interp, newname, 334 (Tcl_ObjCmdProc *)dbc_Cmd, 335 (ClientData)dbc, NULL); 336 res = NewStringObj(newname, strlen(newname)); 337 _SetInfoData(ip, dbc); 338 } else 339 _DeleteInfo(ip); 340 } else { 341 Tcl_SetResult(interp, 342 "Could not set up info", TCL_STATIC); 343 result = TCL_ERROR; 344 } 345 break; 346 case DBJOIN: 347 snprintf(newname, sizeof(newname), 348 "%s.c%d", dbip->i_name, dbip->i_dbdbcid); 349 ip = _NewInfo(interp, NULL, newname, I_DBC); 350 if (ip != NULL) { 351 result = tcl_DbJoin(interp, objc, objv, dbp, &dbc); 352 if (result == TCL_OK) { 353 dbip->i_dbdbcid++; 354 ip->i_parent = dbip; 355 (void)Tcl_CreateObjCommand(interp, newname, 356 (Tcl_ObjCmdProc *)dbc_Cmd, 357 (ClientData)dbc, NULL); 358 res = NewStringObj(newname, strlen(newname)); 359 _SetInfoData(ip, dbc); 360 } else 361 _DeleteInfo(ip); 362 } else { 363 Tcl_SetResult(interp, 364 "Could not set up info", TCL_STATIC); 365 result = TCL_ERROR; 366 } 367 break; 368 case DBGETBTMINKEY: 369 if (objc != 2) { 370 Tcl_WrongNumArgs(interp, 1, objv, NULL); 371 return (TCL_ERROR); 372 } 373 ret = dbp->get_bt_minkey(dbp, &value); 374 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 375 "db get_bt_minkey")) == TCL_OK) 376 res = Tcl_NewIntObj((int)value); 377 break; 378 case DBGETCACHESIZE: 379 if (objc != 2) { 380 Tcl_WrongNumArgs(interp, 1, objv, NULL); 381 return (TCL_ERROR); 382 } 383 ret = dbp->get_cachesize(dbp, &gbytes, &bytes, &ncache); 384 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 385 "db get_cachesize")) == TCL_OK) { 386 myobjv[0] = Tcl_NewIntObj((int)gbytes); 387 myobjv[1] = Tcl_NewIntObj((int)bytes); 388 myobjv[2] = Tcl_NewIntObj((int)ncache); 389 res = Tcl_NewListObj(3, myobjv); 390 } 391 break; 392 case DBGETDBNAME: 393 if (objc != 2) { 394 Tcl_WrongNumArgs(interp, 1, objv, NULL); 395 return (TCL_ERROR); 396 } 397 ret = dbp->get_dbname(dbp, &filename, &dbname); 398 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 399 "db get_dbname")) == TCL_OK) { 400 myobjv[0] = NewStringObj(filename, strlen(filename)); 401 myobjv[1] = NewStringObj(dbname, strlen(dbname)); 402 res = Tcl_NewListObj(2, myobjv); 403 } 404 break; 405 case DBGETENCRYPTFLAGS: 406 result = tcl_EnvGetEncryptFlags(interp, objc, objv, dbp->dbenv); 407 break; 408 case DBGETENV: 409 if (objc != 2) { 410 Tcl_WrongNumArgs(interp, 1, objv, NULL); 411 return (TCL_ERROR); 412 } 413 dbenv = dbp->get_env(dbp); 414 if (dbenv != NULL && (ip = _PtrToInfo(dbenv)) != NULL) { 415 envid = ip->i_name; 416 res = NewStringObj(envid, strlen(envid)); 417 } else 418 Tcl_ResetResult(interp); 419 break; 420 case DBGETERRPFX: 421 if (objc != 2) { 422 Tcl_WrongNumArgs(interp, 1, objv, NULL); 423 return (TCL_ERROR); 424 } 425 dbp->get_errpfx(dbp, &strval); 426 res = NewStringObj(strval, strlen(strval)); 427 break; 428 case DBGETFLAGS: 429 result = tcl_DbGetFlags(interp, objc, objv, dbp); 430 break; 431 case DBGETHFFACTOR: 432 if (objc != 2) { 433 Tcl_WrongNumArgs(interp, 1, objv, NULL); 434 return (TCL_ERROR); 435 } 436 ret = dbp->get_h_ffactor(dbp, &value); 437 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 438 "db get_h_ffactor")) == TCL_OK) 439 res = Tcl_NewIntObj((int)value); 440 break; 441 case DBGETHNELEM: 442 if (objc != 2) { 443 Tcl_WrongNumArgs(interp, 1, objv, NULL); 444 return (TCL_ERROR); 445 } 446 ret = dbp->get_h_nelem(dbp, &value); 447 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 448 "db get_h_nelem")) == TCL_OK) 449 res = Tcl_NewIntObj((int)value); 450 break; 451 case DBGETJOIN: 452 result = tcl_DbGetjoin(interp, objc, objv, dbp); 453 break; 454 case DBGETLORDER: 455 /* 456 * No args for this. Error if there are some. 457 */ 458 if (objc > 2) { 459 Tcl_WrongNumArgs(interp, 2, objv, NULL); 460 return (TCL_ERROR); 461 } 462 _debug_check(); 463 ret = dbp->get_lorder(dbp, &intval); 464 res = Tcl_NewIntObj(intval); 465 break; 466 case DBGETOPENFLAGS: 467 result = tcl_DbGetOpenFlags(interp, objc, objv, dbp); 468 break; 469 case DBGETPAGESIZE: 470 if (objc != 2) { 471 Tcl_WrongNumArgs(interp, 1, objv, NULL); 472 return (TCL_ERROR); 473 } 474 ret = dbp->get_pagesize(dbp, &value); 475 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 476 "db get_pagesize")) == TCL_OK) 477 res = Tcl_NewIntObj((int)value); 478 break; 479 case DBGETQEXTENTSIZE: 480 if (objc != 2) { 481 Tcl_WrongNumArgs(interp, 1, objv, NULL); 482 return (TCL_ERROR); 483 } 484 ret = dbp->get_q_extentsize(dbp, &value); 485 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 486 "db get_q_extentsize")) == TCL_OK) 487 res = Tcl_NewIntObj((int)value); 488 break; 489 case DBGETREDELIM: 490 if (objc != 2) { 491 Tcl_WrongNumArgs(interp, 1, objv, NULL); 492 return (TCL_ERROR); 493 } 494 ret = dbp->get_re_delim(dbp, &intval); 495 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 496 "db get_re_delim")) == TCL_OK) 497 res = Tcl_NewIntObj(intval); 498 break; 499 case DBGETRELEN: 500 if (objc != 2) { 501 Tcl_WrongNumArgs(interp, 1, objv, NULL); 502 return (TCL_ERROR); 503 } 504 ret = dbp->get_re_len(dbp, &value); 505 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 506 "db get_re_len")) == TCL_OK) 507 res = Tcl_NewIntObj((int)value); 508 break; 509 case DBGETREPAD: 510 if (objc != 2) { 511 Tcl_WrongNumArgs(interp, 1, objv, NULL); 512 return (TCL_ERROR); 513 } 514 ret = dbp->get_re_pad(dbp, &intval); 515 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 516 "db get_re_pad")) == TCL_OK) 517 res = Tcl_NewIntObj((int)intval); 518 break; 519 case DBGETRESOURCE: 520 if (objc != 2) { 521 Tcl_WrongNumArgs(interp, 1, objv, NULL); 522 return (TCL_ERROR); 523 } 524 ret = dbp->get_re_source(dbp, &strval); 525 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 526 "db get_re_source")) == TCL_OK) 527 res = NewStringObj(strval, strlen(strval)); 528 break; 529 case DBTRUNCATE: 530 result = tcl_DbTruncate(interp, objc, objv, dbp); 531 break; 532 } 533 /* 534 * Only set result if we have a res. Otherwise, lower 535 * functions have already done so. 536 */ 537 if (result == TCL_OK && res) 538 Tcl_SetObjResult(interp, res); 539 return (result); 540} 541 542/* 543 * tcl_db_stat -- 544 */ 545static int 546tcl_DbStat(interp, objc, objv, dbp) 547 Tcl_Interp *interp; /* Interpreter */ 548 int objc; /* How many arguments? */ 549 Tcl_Obj *CONST objv[]; /* The argument objects */ 550 DB *dbp; /* Database pointer */ 551{ 552 static const char *dbstatopts[] = { 553#ifdef CONFIG_TEST 554 "-read_committed", 555 "-read_uncommitted", 556#endif 557 "-faststat", 558 "-txn", 559 NULL 560 }; 561 enum dbstatopts { 562#ifdef CONFIG_TEST 563 DBCUR_READ_COMMITTED, 564 DBCUR_READ_UNCOMMITTED, 565#endif 566 DBCUR_FASTSTAT, 567 DBCUR_TXN 568 }; 569 DBTYPE type; 570 DB_BTREE_STAT *bsp; 571 DB_HASH_STAT *hsp; 572 DB_QUEUE_STAT *qsp; 573 DB_TXN *txn; 574 Tcl_Obj *res, *flaglist, *myobjv[2]; 575 u_int32_t flag; 576 int i, optindex, result, ret; 577 char *arg, msg[MSG_SIZE]; 578 void *sp; 579 580 result = TCL_OK; 581 flag = 0; 582 txn = NULL; 583 sp = NULL; 584 i = 2; 585 while (i < objc) { 586 if (Tcl_GetIndexFromObj(interp, objv[i], dbstatopts, "option", 587 TCL_EXACT, &optindex) != TCL_OK) { 588 result = IS_HELP(objv[i]); 589 goto error; 590 } 591 i++; 592 switch ((enum dbstatopts)optindex) { 593#ifdef CONFIG_TEST 594 case DBCUR_READ_COMMITTED: 595 flag |= DB_READ_COMMITTED; 596 break; 597 case DBCUR_READ_UNCOMMITTED: 598 flag |= DB_READ_UNCOMMITTED; 599 break; 600#endif 601 case DBCUR_FASTSTAT: 602 flag |= DB_FAST_STAT; 603 break; 604 case DBCUR_TXN: 605 if (i == objc) { 606 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); 607 result = TCL_ERROR; 608 break; 609 } 610 arg = Tcl_GetStringFromObj(objv[i++], NULL); 611 txn = NAME_TO_TXN(arg); 612 if (txn == NULL) { 613 snprintf(msg, MSG_SIZE, 614 "Stat: Invalid txn: %s\n", arg); 615 Tcl_SetResult(interp, msg, TCL_VOLATILE); 616 result = TCL_ERROR; 617 } 618 break; 619 } 620 if (result != TCL_OK) 621 break; 622 } 623 if (result != TCL_OK) 624 goto error; 625 626 _debug_check(); 627 ret = dbp->stat(dbp, txn, &sp, flag); 628 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db stat"); 629 if (result == TCL_ERROR) 630 return (result); 631 632 (void)dbp->get_type(dbp, &type); 633 /* 634 * Have our stats, now construct the name value 635 * list pairs and free up the memory. 636 */ 637 res = Tcl_NewObj(); 638 639 /* 640 * MAKE_STAT_LIST assumes 'res' and 'error' label. 641 */ 642 if (type == DB_HASH) { 643 hsp = (DB_HASH_STAT *)sp; 644 MAKE_STAT_LIST("Magic", hsp->hash_magic); 645 MAKE_STAT_LIST("Version", hsp->hash_version); 646 MAKE_STAT_LIST("Page size", hsp->hash_pagesize); 647 MAKE_STAT_LIST("Page count", hsp->hash_pagecnt); 648 MAKE_STAT_LIST("Number of keys", hsp->hash_nkeys); 649 MAKE_STAT_LIST("Number of records", hsp->hash_ndata); 650 MAKE_STAT_LIST("Fill factor", hsp->hash_ffactor); 651 MAKE_STAT_LIST("Buckets", hsp->hash_buckets); 652 if (flag != DB_FAST_STAT) { 653 MAKE_STAT_LIST("Free pages", hsp->hash_free); 654 MAKE_WSTAT_LIST("Bytes free", hsp->hash_bfree); 655 MAKE_STAT_LIST("Number of big pages", 656 hsp->hash_bigpages); 657 MAKE_STAT_LIST("Big pages bytes free", 658 hsp->hash_big_bfree); 659 MAKE_STAT_LIST("Overflow pages", hsp->hash_overflows); 660 MAKE_STAT_LIST("Overflow bytes free", 661 hsp->hash_ovfl_free); 662 MAKE_STAT_LIST("Duplicate pages", hsp->hash_dup); 663 MAKE_STAT_LIST("Duplicate pages bytes free", 664 hsp->hash_dup_free); 665 } 666 } else if (type == DB_QUEUE) { 667 qsp = (DB_QUEUE_STAT *)sp; 668 MAKE_STAT_LIST("Magic", qsp->qs_magic); 669 MAKE_STAT_LIST("Version", qsp->qs_version); 670 MAKE_STAT_LIST("Page size", qsp->qs_pagesize); 671 MAKE_STAT_LIST("Extent size", qsp->qs_extentsize); 672 MAKE_STAT_LIST("Number of keys", qsp->qs_nkeys); 673 MAKE_STAT_LIST("Number of records", qsp->qs_ndata); 674 MAKE_STAT_LIST("Record length", qsp->qs_re_len); 675 MAKE_STAT_LIST("Record pad", qsp->qs_re_pad); 676 MAKE_STAT_LIST("First record number", qsp->qs_first_recno); 677 MAKE_STAT_LIST("Last record number", qsp->qs_cur_recno); 678 if (flag != DB_FAST_STAT) { 679 MAKE_STAT_LIST("Number of pages", qsp->qs_pages); 680 MAKE_WSTAT_LIST("Bytes free", qsp->qs_pgfree); 681 } 682 } else { /* BTREE and RECNO are same stats */ 683 bsp = (DB_BTREE_STAT *)sp; 684 MAKE_STAT_LIST("Magic", bsp->bt_magic); 685 MAKE_STAT_LIST("Version", bsp->bt_version); 686 MAKE_STAT_LIST("Number of keys", bsp->bt_nkeys); 687 MAKE_STAT_LIST("Number of records", bsp->bt_ndata); 688 MAKE_STAT_LIST("Minimum keys per page", bsp->bt_minkey); 689 MAKE_STAT_LIST("Fixed record length", bsp->bt_re_len); 690 MAKE_STAT_LIST("Record pad", bsp->bt_re_pad); 691 MAKE_STAT_LIST("Page size", bsp->bt_pagesize); 692 MAKE_STAT_LIST("Page count", bsp->bt_pagecnt); 693 if (flag != DB_FAST_STAT) { 694 MAKE_STAT_LIST("Levels", bsp->bt_levels); 695 MAKE_STAT_LIST("Internal pages", bsp->bt_int_pg); 696 MAKE_STAT_LIST("Leaf pages", bsp->bt_leaf_pg); 697 MAKE_STAT_LIST("Duplicate pages", bsp->bt_dup_pg); 698 MAKE_STAT_LIST("Overflow pages", bsp->bt_over_pg); 699 MAKE_STAT_LIST("Empty pages", bsp->bt_empty_pg); 700 MAKE_STAT_LIST("Pages on freelist", bsp->bt_free); 701 MAKE_STAT_LIST("Internal pages bytes free", 702 bsp->bt_int_pgfree); 703 MAKE_STAT_LIST("Leaf pages bytes free", 704 bsp->bt_leaf_pgfree); 705 MAKE_STAT_LIST("Duplicate pages bytes free", 706 bsp->bt_dup_pgfree); 707 MAKE_STAT_LIST("Bytes free in overflow pages", 708 bsp->bt_over_pgfree); 709 } 710 } 711 712 /* 713 * Construct a {name {flag1 flag2 ... flagN}} list for the 714 * dbp flags. These aren't access-method dependent, but they 715 * include all the interesting flags, and the integer value 716 * isn't useful from Tcl--return the strings instead. 717 */ 718 myobjv[0] = NewStringObj("Flags", strlen("Flags")); 719 myobjv[1] = _GetFlagsList(interp, dbp->flags, __db_get_flags_fn()); 720 flaglist = Tcl_NewListObj(2, myobjv); 721 if (flaglist == NULL) { 722 result = TCL_ERROR; 723 goto error; 724 } 725 if ((result = 726 Tcl_ListObjAppendElement(interp, res, flaglist)) != TCL_OK) 727 goto error; 728 729 Tcl_SetObjResult(interp, res); 730error: 731 if (sp != NULL) 732 __os_ufree(dbp->env, sp); 733 return (result); 734} 735 736/* 737 * tcl_db_close -- 738 */ 739static int 740tcl_DbClose(interp, objc, objv, dbp, dbip) 741 Tcl_Interp *interp; /* Interpreter */ 742 int objc; /* How many arguments? */ 743 Tcl_Obj *CONST objv[]; /* The argument objects */ 744 DB *dbp; /* Database pointer */ 745 DBTCL_INFO *dbip; /* Info pointer */ 746{ 747 static const char *dbclose[] = { 748 "-nosync", "--", NULL 749 }; 750 enum dbclose { 751 TCL_DBCLOSE_NOSYNC, 752 TCL_DBCLOSE_ENDARG 753 }; 754 u_int32_t flag; 755 int endarg, i, optindex, result, ret; 756 char *arg; 757 758 result = TCL_OK; 759 endarg = 0; 760 flag = 0; 761 if (objc > 4) { 762 Tcl_WrongNumArgs(interp, 2, objv, "?-nosync?"); 763 return (TCL_ERROR); 764 } 765 766 for (i = 2; i < objc; ++i) { 767 if (Tcl_GetIndexFromObj(interp, objv[i], dbclose, 768 "option", TCL_EXACT, &optindex) != TCL_OK) { 769 arg = Tcl_GetStringFromObj(objv[i], NULL); 770 if (arg[0] == '-') 771 return (IS_HELP(objv[i])); 772 else 773 Tcl_ResetResult(interp); 774 break; 775 } 776 switch ((enum dbclose)optindex) { 777 case TCL_DBCLOSE_NOSYNC: 778 flag = DB_NOSYNC; 779 break; 780 case TCL_DBCLOSE_ENDARG: 781 endarg = 1; 782 break; 783 } 784 /* 785 * If, at any time, parsing the args we get an error, 786 * bail out and return. 787 */ 788 if (result != TCL_OK) 789 return (result); 790 if (endarg) 791 break; 792 } 793 if (dbip->i_cdata != NULL) 794 __os_free(dbp->env, dbip->i_cdata); 795 _DbInfoDelete(interp, dbip); 796 _debug_check(); 797 798 /* Paranoia. */ 799 dbp->api_internal = NULL; 800 801 ret = (dbp)->close(dbp, flag); 802 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db close"); 803 return (result); 804} 805 806/* 807 * tcl_db_put -- 808 */ 809static int 810tcl_DbPut(interp, objc, objv, dbp) 811 Tcl_Interp *interp; /* Interpreter */ 812 int objc; /* How many arguments? */ 813 Tcl_Obj *CONST objv[]; /* The argument objects */ 814 DB *dbp; /* Database pointer */ 815{ 816 static const char *dbputopts[] = { 817#ifdef CONFIG_TEST 818 "-nodupdata", 819#endif 820 "-append", 821 "-multiple", 822 "-multiple_key", 823 "-nooverwrite", 824 "-overwritedup", 825 "-partial", 826 "-txn", 827 NULL 828 }; 829 enum dbputopts { 830#ifdef CONFIG_TEST 831 DBGET_NODUPDATA, 832#endif 833 DBPUT_APPEND, 834 DBPUT_MULTIPLE, 835 DBPUT_MULTIPLE_KEY, 836 DBPUT_NOOVER, 837 DBPUT_OVER, 838 DBPUT_PART, 839 DBPUT_TXN 840 }; 841 static const char *dbputapp[] = { 842 "-append", 843 "-multiple_key", 844 NULL 845 }; 846 enum dbputapp { DBPUT_APPEND0, DBPUT_MULTIPLE_KEY0 }; 847 DBT key, data; 848 DBTYPE type; 849 DB_TXN *txn; 850 Tcl_Obj **delemv, **elemv, *res; 851 void *dtmp, *ktmp, *ptr; 852 db_recno_t recno; 853 u_int32_t flag, multiflag; 854 int delemc, elemc, end, freekey, freedata; 855 int dlen, klen, i, optindex, result, ret; 856 char *arg, msg[MSG_SIZE]; 857 858 txn = NULL; 859 result = TCL_OK; 860 flag = multiflag = 0; 861 if (objc <= 3) { 862 Tcl_WrongNumArgs(interp, 2, objv, "?-args? key data"); 863 return (TCL_ERROR); 864 } 865 866 dtmp = ktmp = NULL; 867 freekey = freedata = 0; 868 memset(&key, 0, sizeof(key)); 869 memset(&data, 0, sizeof(data)); 870 COMPQUIET(recno, 0); 871 872 /* 873 * If it is a QUEUE or RECNO database, the key is a record number 874 * and must be setup up to contain a db_recno_t. Otherwise the 875 * key is a "string". 876 */ 877 (void)dbp->get_type(dbp, &type); 878 879 /* 880 * We need to determine where the end of required args are. If we are 881 * using a QUEUE/RECNO db and -append, or -multiple_key is specified, 882 * then there is just one req arg (data). Otherwise there are two 883 * (key data). 884 * 885 * We preparse the list to determine this since we need to know 886 * to properly check # of args for other options below. 887 */ 888 end = objc - 2; 889 i = 2; 890 while (i < objc - 1) { 891 if (Tcl_GetIndexFromObj(interp, objv[i++], dbputapp, 892 "option", TCL_EXACT, &optindex) != TCL_OK) 893 continue; 894 switch ((enum dbputapp)optindex) { 895 case DBPUT_APPEND0: 896 case DBPUT_MULTIPLE_KEY0: 897 end = objc - 1; 898 break; 899 } 900 } 901 Tcl_ResetResult(interp); 902 903 /* 904 * Get the command name index from the object based on the options 905 * defined above. 906 */ 907 i = 2; 908 while (i < end) { 909 if (Tcl_GetIndexFromObj(interp, objv[i], 910 dbputopts, "option", TCL_EXACT, &optindex) != TCL_OK) 911 return (IS_HELP(objv[i])); 912 i++; 913 switch ((enum dbputopts)optindex) { 914#ifdef CONFIG_TEST 915 case DBGET_NODUPDATA: 916 FLAG_CHECK(flag); 917 flag = DB_NODUPDATA; 918 break; 919#endif 920 case DBPUT_TXN: 921 if (i > (end - 1)) { 922 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); 923 result = TCL_ERROR; 924 break; 925 } 926 arg = Tcl_GetStringFromObj(objv[i++], NULL); 927 txn = NAME_TO_TXN(arg); 928 if (txn == NULL) { 929 snprintf(msg, MSG_SIZE, 930 "Put: Invalid txn: %s\n", arg); 931 Tcl_SetResult(interp, msg, TCL_VOLATILE); 932 result = TCL_ERROR; 933 } 934 break; 935 case DBPUT_APPEND: 936 FLAG_CHECK(flag); 937 flag = DB_APPEND; 938 break; 939 case DBPUT_MULTIPLE: 940 FLAG_CHECK(multiflag); 941 multiflag = DB_MULTIPLE; 942 break; 943 case DBPUT_MULTIPLE_KEY: 944 FLAG_CHECK(multiflag); 945 multiflag = DB_MULTIPLE_KEY; 946 break; 947 case DBPUT_NOOVER: 948 FLAG_CHECK(flag); 949 flag = DB_NOOVERWRITE; 950 break; 951 case DBPUT_OVER: 952 FLAG_CHECK(flag); 953 flag = DB_OVERWRITE_DUP; 954 break; 955 case DBPUT_PART: 956 if (i > (end - 1)) { 957 Tcl_WrongNumArgs(interp, 2, objv, 958 "?-partial {offset length}?"); 959 result = TCL_ERROR; 960 break; 961 } 962 /* 963 * Get sublist as {offset length} 964 */ 965 result = Tcl_ListObjGetElements(interp, objv[i++], 966 &elemc, &elemv); 967 if (elemc != 2) { 968 Tcl_SetResult(interp, 969 "List must be {offset length}", TCL_STATIC); 970 result = TCL_ERROR; 971 break; 972 } 973 data.flags = DB_DBT_PARTIAL; 974 result = _GetUInt32(interp, elemv[0], &data.doff); 975 if (result != TCL_OK) 976 break; 977 result = _GetUInt32(interp, elemv[1], &data.dlen); 978 /* 979 * NOTE: We don't check result here because all we'd 980 * do is break anyway, and we are doing that. If you 981 * add code here, you WILL need to add the check 982 * for result. (See the check for save.doff, a few 983 * lines above and copy that.) 984 */ 985 break; 986 } 987 if (result != TCL_OK) 988 break; 989 } 990 991 if (result == TCL_ERROR) 992 return (result); 993 994 if (multiflag == DB_MULTIPLE) { 995 /* 996 * To work out how big a buffer is needed, we first need to 997 * find out the total length of the data and the number of data 998 * items (elemc). 999 */ 1000 ktmp = Tcl_GetByteArrayFromObj(objv[objc - 2], &klen); 1001 result = Tcl_ListObjGetElements(interp, objv[objc - 2], 1002 &elemc, &elemv); 1003 if (result != TCL_OK) 1004 return (result); 1005 1006 dtmp = Tcl_GetByteArrayFromObj(objv[objc - 1], &dlen); 1007 result = Tcl_ListObjGetElements(interp, objv[objc - 1], 1008 &delemc, &delemv); 1009 if (result != TCL_OK) 1010 return (result); 1011 1012 if (elemc < delemc) 1013 delemc = elemc; 1014 else 1015 elemc = delemc; 1016 1017 memset(&key, 0, sizeof(key)); 1018 key.ulen = DB_ALIGN((u_int32_t)klen + 1019 (u_int32_t)elemc * sizeof(u_int32_t) * 2, 1024UL); 1020 key.flags = DB_DBT_USERMEM | DB_DBT_BULK; 1021 if ((ret = __os_malloc(dbp->env, key.ulen, &key.data)) != 0) 1022 return (ret); 1023 freekey = 1; 1024 1025 memset(&data, 0, sizeof(data)); 1026 data.ulen = DB_ALIGN((u_int32_t)dlen + 1027 (u_int32_t)delemc * sizeof(u_int32_t) * 2, 1024UL); 1028 data.flags = DB_DBT_USERMEM | DB_DBT_BULK; 1029 if ((ret = __os_malloc(dbp->env, data.ulen, &data.data)) != 0) 1030 return (ret); 1031 freedata = 1; 1032 1033 if (type == DB_QUEUE || type == DB_RECNO) { 1034 DB_MULTIPLE_RECNO_WRITE_INIT(ptr, &key); 1035 for (i = 0; i < elemc; i++) { 1036 result = _GetUInt32(interp, elemv[i], &recno); 1037 DB_MULTIPLE_RECNO_WRITE_NEXT(ptr, &key, recno, 1038 dtmp, 0); 1039 DB_ASSERT(dbp->env, ptr != NULL); 1040 } 1041 } else { 1042 DB_MULTIPLE_WRITE_INIT(ptr, &key); 1043 for (i = 0; i < elemc; i++) { 1044 ktmp = Tcl_GetByteArrayFromObj(elemv[i], &klen); 1045 DB_MULTIPLE_WRITE_NEXT(ptr, 1046 &key, ktmp, (u_int32_t)klen); 1047 DB_ASSERT(dbp->env, ptr != NULL); 1048 } 1049 } 1050 DB_MULTIPLE_WRITE_INIT(ptr, &data); 1051 for (i = 0; i < elemc; i++) { 1052 dtmp = Tcl_GetByteArrayFromObj(delemv[i], &dlen); 1053 DB_MULTIPLE_WRITE_NEXT(ptr, 1054 &data, dtmp, (u_int32_t)dlen); 1055 DB_ASSERT(dbp->env, ptr != NULL); 1056 } 1057 } else if (multiflag == DB_MULTIPLE_KEY) { 1058 /* 1059 * To work out how big a buffer is needed, we first need to 1060 * find out the total length of the data (len) and the number 1061 * of data items (elemc). 1062 */ 1063 ktmp = Tcl_GetByteArrayFromObj(objv[objc - 1], &klen); 1064 result = Tcl_ListObjGetElements(interp, objv[objc - 1], 1065 &elemc, &elemv); 1066 if (result != TCL_OK) 1067 return (result); 1068 1069 memset(&key, 0, sizeof(key)); 1070 key.ulen = DB_ALIGN((u_int32_t)klen + 1071 (u_int32_t)elemc * sizeof(u_int32_t) * 2, 1024UL); 1072 key.flags = DB_DBT_USERMEM | DB_DBT_BULK; 1073 if ((ret = __os_malloc(dbp->env, key.ulen, &key.data)) != 0) 1074 return (ret); 1075 freekey = 1; 1076 1077 if (type == DB_QUEUE || type == DB_RECNO) { 1078 DB_MULTIPLE_RECNO_WRITE_INIT(ptr, &key); 1079 for (i = 0; i + 1 < elemc; i += 2) { 1080 result = _GetUInt32(interp, elemv[i], &recno); 1081 dtmp = Tcl_GetByteArrayFromObj(elemv[i + 1], 1082 &dlen); 1083 DB_MULTIPLE_RECNO_WRITE_NEXT(ptr, &key, 1084 recno, dtmp, (u_int32_t)dlen); 1085 DB_ASSERT(dbp->env, ptr != NULL); 1086 } 1087 } else { 1088 DB_MULTIPLE_WRITE_INIT(ptr, &key); 1089 for (i = 0; i + 1 < elemc; i += 2) { 1090 ktmp = Tcl_GetByteArrayFromObj(elemv[i], &klen); 1091 dtmp = Tcl_GetByteArrayFromObj(elemv[i + 1], 1092 &dlen); 1093 DB_MULTIPLE_KEY_WRITE_NEXT(ptr, 1094 &key, ktmp, (u_int32_t)klen, 1095 dtmp, (u_int32_t)dlen); 1096 DB_ASSERT(dbp->env, ptr != NULL); 1097 } 1098 } 1099 } else if (type == DB_QUEUE || type == DB_RECNO) { 1100 /* 1101 * If we are a recno db and we are NOT using append, then the 1102 * 2nd last arg is the key. 1103 */ 1104 key.data = &recno; 1105 key.ulen = key.size = sizeof(db_recno_t); 1106 key.flags = DB_DBT_USERMEM; 1107 if (flag == DB_APPEND) 1108 recno = 0; 1109 else { 1110 result = _GetUInt32(interp, objv[objc-2], &recno); 1111 if (result != TCL_OK) 1112 return (result); 1113 } 1114 } else { 1115 ret = _CopyObjBytes(interp, objv[objc-2], &ktmp, 1116 &key.size, &freekey); 1117 if (ret != 0) { 1118 result = _ReturnSetup(interp, ret, 1119 DB_RETOK_DBPUT(ret), "db put"); 1120 return (result); 1121 } 1122 key.data = ktmp; 1123 } 1124 1125 if (multiflag == 0) { 1126 ret = _CopyObjBytes(interp, 1127 objv[objc-1], &dtmp, &data.size, &freedata); 1128 if (ret != 0) { 1129 result = _ReturnSetup(interp, ret, 1130 DB_RETOK_DBPUT(ret), "db put"); 1131 goto out; 1132 } 1133 data.data = dtmp; 1134 } 1135 _debug_check(); 1136 ret = dbp->put(dbp, txn, &key, &data, flag | multiflag); 1137 result = _ReturnSetup(interp, ret, DB_RETOK_DBPUT(ret), "db put"); 1138 1139 /* We may have a returned record number. */ 1140 if (ret == 0 && 1141 (type == DB_QUEUE || type == DB_RECNO) && flag == DB_APPEND) { 1142 res = Tcl_NewWideIntObj((Tcl_WideInt)recno); 1143 Tcl_SetObjResult(interp, res); 1144 } 1145 1146out: if (freedata && data.data != NULL) 1147 __os_free(dbp->env, data.data); 1148 if (freekey && key.data != NULL) 1149 __os_free(dbp->env, key.data); 1150 return (result); 1151} 1152 1153/* 1154 * tcl_db_get -- 1155 */ 1156static int 1157tcl_DbGet(interp, objc, objv, dbp, ispget) 1158 Tcl_Interp *interp; /* Interpreter */ 1159 int objc; /* How many arguments? */ 1160 Tcl_Obj *CONST objv[]; /* The argument objects */ 1161 DB *dbp; /* Database pointer */ 1162 int ispget; /* 1 for pget, 0 for get */ 1163{ 1164 static const char *dbgetopts[] = { 1165#ifdef CONFIG_TEST 1166 "-data_buf_size", 1167 "-multi", 1168 "-nolease", 1169 "-read_committed", 1170 "-read_uncommitted", 1171#endif 1172 "-consume", 1173 "-consume_wait", 1174 "-get_both", 1175 "-glob", 1176 "-partial", 1177 "-recno", 1178 "-rmw", 1179 "-txn", 1180 "--", 1181 NULL 1182 }; 1183 enum dbgetopts { 1184#ifdef CONFIG_TEST 1185 DBGET_DATA_BUF_SIZE, 1186 DBGET_MULTI, 1187 DBGET_NOLEASE, 1188 DBGET_READ_COMMITTED, 1189 DBGET_READ_UNCOMMITTED, 1190#endif 1191 DBGET_CONSUME, 1192 DBGET_CONSUME_WAIT, 1193 DBGET_BOTH, 1194 DBGET_GLOB, 1195 DBGET_PART, 1196 DBGET_RECNO, 1197 DBGET_RMW, 1198 DBGET_TXN, 1199 DBGET_ENDARG 1200 }; 1201 DBC *dbc; 1202 DBT key, pkey, data, save; 1203 DBTYPE ptype, type; 1204 DB_TXN *txn; 1205 Tcl_Obj **elemv, *retlist; 1206 db_recno_t precno, recno; 1207 u_int32_t flag, cflag, isdup, mflag, rmw; 1208 int elemc, end, endarg, freekey, freedata, i; 1209 int optindex, result, ret, useglob, useprecno, userecno; 1210 char *arg, *pattern, *prefix, msg[MSG_SIZE]; 1211 void *dtmp, *ktmp; 1212#ifdef CONFIG_TEST 1213 int bufsize, data_buf_size; 1214#endif 1215 1216 result = TCL_OK; 1217 freekey = freedata = 0; 1218 cflag = endarg = flag = mflag = rmw = 0; 1219 useglob = userecno = 0; 1220 txn = NULL; 1221 pattern = prefix = NULL; 1222 dtmp = ktmp = NULL; 1223#ifdef CONFIG_TEST 1224 COMPQUIET(bufsize, 0); 1225 data_buf_size = 0; 1226#endif 1227 1228 if (objc < 3) { 1229 Tcl_WrongNumArgs(interp, 2, objv, "?-args? key"); 1230 return (TCL_ERROR); 1231 } 1232 1233 memset(&key, 0, sizeof(key)); 1234 memset(&data, 0, sizeof(data)); 1235 memset(&save, 0, sizeof(save)); 1236 1237 /* For the primary key in a pget call. */ 1238 memset(&pkey, 0, sizeof(pkey)); 1239 1240 /* 1241 * Get the command name index from the object based on the options 1242 * defined above. 1243 */ 1244 i = 2; 1245 (void)dbp->get_type(dbp, &type); 1246 end = objc; 1247 while (i < end) { 1248 if (Tcl_GetIndexFromObj(interp, objv[i], dbgetopts, "option", 1249 TCL_EXACT, &optindex) != TCL_OK) { 1250 arg = Tcl_GetStringFromObj(objv[i], NULL); 1251 if (arg[0] == '-') { 1252 result = IS_HELP(objv[i]); 1253 goto out; 1254 } else 1255 Tcl_ResetResult(interp); 1256 break; 1257 } 1258 i++; 1259 switch ((enum dbgetopts)optindex) { 1260#ifdef CONFIG_TEST 1261 case DBGET_DATA_BUF_SIZE: 1262 result = 1263 Tcl_GetIntFromObj(interp, objv[i], &data_buf_size); 1264 if (result != TCL_OK) 1265 goto out; 1266 i++; 1267 break; 1268 case DBGET_MULTI: 1269 mflag |= DB_MULTIPLE; 1270 result = 1271 Tcl_GetIntFromObj(interp, objv[i], &bufsize); 1272 if (result != TCL_OK) 1273 goto out; 1274 i++; 1275 break; 1276 case DBGET_NOLEASE: 1277 rmw |= DB_IGNORE_LEASE; 1278 break; 1279 case DBGET_READ_COMMITTED: 1280 rmw |= DB_READ_COMMITTED; 1281 break; 1282 case DBGET_READ_UNCOMMITTED: 1283 rmw |= DB_READ_UNCOMMITTED; 1284 break; 1285#endif 1286 case DBGET_BOTH: 1287 /* 1288 * Change 'end' and make sure we aren't already past 1289 * the new end. 1290 */ 1291 if (i > objc - 2) { 1292 Tcl_WrongNumArgs(interp, 2, objv, 1293 "?-get_both key data?"); 1294 result = TCL_ERROR; 1295 break; 1296 } 1297 end = objc - 2; 1298 FLAG_CHECK(flag); 1299 flag = DB_GET_BOTH; 1300 break; 1301 case DBGET_TXN: 1302 if (i >= end) { 1303 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); 1304 result = TCL_ERROR; 1305 break; 1306 } 1307 arg = Tcl_GetStringFromObj(objv[i++], NULL); 1308 txn = NAME_TO_TXN(arg); 1309 if (txn == NULL) { 1310 snprintf(msg, MSG_SIZE, 1311 "Get: Invalid txn: %s\n", arg); 1312 Tcl_SetResult(interp, msg, TCL_VOLATILE); 1313 result = TCL_ERROR; 1314 } 1315 break; 1316 case DBGET_GLOB: 1317 useglob = 1; 1318 end = objc - 1; 1319 break; 1320 case DBGET_CONSUME: 1321 FLAG_CHECK(flag); 1322 flag = DB_CONSUME; 1323 break; 1324 case DBGET_CONSUME_WAIT: 1325 FLAG_CHECK(flag); 1326 flag = DB_CONSUME_WAIT; 1327 break; 1328 case DBGET_RECNO: 1329 end = objc - 1; 1330 userecno = 1; 1331 if (type != DB_RECNO && type != DB_QUEUE) { 1332 FLAG_CHECK(flag); 1333 flag = DB_SET_RECNO; 1334 key.flags |= DB_DBT_MALLOC; 1335 } 1336 break; 1337 case DBGET_RMW: 1338 rmw |= DB_RMW; 1339 break; 1340 case DBGET_PART: 1341 end = objc - 1; 1342 if (i == end) { 1343 Tcl_WrongNumArgs(interp, 2, objv, 1344 "?-partial {offset length}?"); 1345 result = TCL_ERROR; 1346 break; 1347 } 1348 /* 1349 * Get sublist as {offset length} 1350 */ 1351 result = Tcl_ListObjGetElements(interp, objv[i++], 1352 &elemc, &elemv); 1353 if (elemc != 2) { 1354 Tcl_SetResult(interp, 1355 "List must be {offset length}", TCL_STATIC); 1356 result = TCL_ERROR; 1357 break; 1358 } 1359 save.flags = DB_DBT_PARTIAL; 1360 result = _GetUInt32(interp, elemv[0], &save.doff); 1361 if (result != TCL_OK) 1362 break; 1363 result = _GetUInt32(interp, elemv[1], &save.dlen); 1364 /* 1365 * NOTE: We don't check result here because all we'd 1366 * do is break anyway, and we are doing that. If you 1367 * add code here, you WILL need to add the check 1368 * for result. (See the check for save.doff, a few 1369 * lines above and copy that.) 1370 */ 1371 break; 1372 case DBGET_ENDARG: 1373 endarg = 1; 1374 break; 1375 } 1376 if (result != TCL_OK) 1377 break; 1378 if (endarg) 1379 break; 1380 } 1381 if (result != TCL_OK) 1382 goto out; 1383 1384 if (type == DB_RECNO || type == DB_QUEUE) 1385 userecno = 1; 1386 1387 /* 1388 * Check args we have left versus the flags we were given. 1389 * We might have 0, 1 or 2 left. If we have 0, it must 1390 * be DB_CONSUME*, if 2, then DB_GET_BOTH, all others should 1391 * be 1. 1392 */ 1393 if (((flag == DB_CONSUME || flag == DB_CONSUME_WAIT) && i != objc) || 1394 (flag == DB_GET_BOTH && i != objc - 2)) { 1395 Tcl_SetResult(interp, 1396 "Wrong number of key/data given based on flags specified\n", 1397 TCL_STATIC); 1398 result = TCL_ERROR; 1399 goto out; 1400 } else if (flag == 0 && i != objc - 1) { 1401 Tcl_SetResult(interp, 1402 "Wrong number of key/data given\n", TCL_STATIC); 1403 result = TCL_ERROR; 1404 goto out; 1405 } 1406 1407 /* 1408 * Find out whether the primary key should also be a recno. 1409 */ 1410 if (ispget && dbp->s_primary != NULL) { 1411 (void)dbp->s_primary->get_type(dbp->s_primary, &ptype); 1412 useprecno = ptype == DB_RECNO || ptype == DB_QUEUE; 1413 } else 1414 useprecno = 0; 1415 1416 /* 1417 * Check for illegal combos of options. 1418 */ 1419 if (useglob && (userecno || flag == DB_SET_RECNO || 1420 type == DB_RECNO || type == DB_QUEUE)) { 1421 Tcl_SetResult(interp, 1422 "Cannot use -glob and record numbers.\n", 1423 TCL_STATIC); 1424 result = TCL_ERROR; 1425 goto out; 1426 } 1427#ifdef CONFIG_TEST 1428 if (data_buf_size != 0 && flag == DB_GET_BOTH) { 1429 Tcl_SetResult(interp, 1430 "Only one of -data_buf_size or -get_both can be specified.\n", 1431 TCL_STATIC); 1432 result = TCL_ERROR; 1433 goto out; 1434 } 1435 if (data_buf_size != 0 && mflag != 0) { 1436 Tcl_SetResult(interp, 1437 "Only one of -data_buf_size or -multi can be specified.\n", 1438 TCL_STATIC); 1439 result = TCL_ERROR; 1440 goto out; 1441 } 1442#endif 1443 if (useglob && flag == DB_GET_BOTH) { 1444 Tcl_SetResult(interp, 1445 "Only one of -glob or -get_both can be specified.\n", 1446 TCL_STATIC); 1447 result = TCL_ERROR; 1448 goto out; 1449 } 1450 1451 if (useglob) 1452 pattern = Tcl_GetStringFromObj(objv[objc - 1], NULL); 1453 1454 /* 1455 * This is the list we return 1456 */ 1457 retlist = Tcl_NewListObj(0, NULL); 1458 save.flags |= DB_DBT_MALLOC; 1459 1460 /* 1461 * isdup is used to know if we support duplicates. If not, we 1462 * can just do a db->get call and avoid using cursors. 1463 */ 1464 if ((ret = dbp->get_flags(dbp, &isdup)) != 0) { 1465 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db get"); 1466 goto out; 1467 } 1468 isdup &= DB_DUP; 1469 1470 /* 1471 * If the database doesn't support duplicates or we're performing 1472 * ops that don't require returning multiple items, use DB->get 1473 * instead of a cursor operation. 1474 */ 1475 if (pattern == NULL && (isdup == 0 || mflag != 0 || 1476#ifdef CONFIG_TEST 1477 data_buf_size != 0 || 1478#endif 1479 flag == DB_SET_RECNO || flag == DB_GET_BOTH || 1480 flag == DB_CONSUME || flag == DB_CONSUME_WAIT)) { 1481#ifdef CONFIG_TEST 1482 if (data_buf_size == 0) { 1483 F_CLR(&save, DB_DBT_USERMEM); 1484 F_SET(&save, DB_DBT_MALLOC); 1485 } else { 1486 (void)__os_malloc( 1487 NULL, (size_t)data_buf_size, &save.data); 1488 save.ulen = (u_int32_t)data_buf_size; 1489 F_CLR(&save, DB_DBT_MALLOC); 1490 F_SET(&save, DB_DBT_USERMEM); 1491 } 1492#endif 1493 if (flag == DB_GET_BOTH) { 1494 if (userecno) { 1495 result = _GetUInt32(interp, 1496 objv[(objc - 2)], &recno); 1497 if (result == TCL_OK) { 1498 key.data = &recno; 1499 key.size = sizeof(db_recno_t); 1500 } else 1501 goto out; 1502 } else { 1503 /* 1504 * Some get calls (SET_*) can change the 1505 * key pointers. So, we need to store 1506 * the allocated key space in a tmp. 1507 */ 1508 ret = _CopyObjBytes(interp, objv[objc-2], 1509 &key.data, &key.size, &freekey); 1510 if (ret != 0) { 1511 result = _ReturnSetup(interp, ret, 1512 DB_RETOK_DBGET(ret), "db get"); 1513 goto out; 1514 } 1515 } 1516 ktmp = key.data; 1517 /* 1518 * Already checked args above. Fill in key and save. 1519 * Save is used in the dbp->get call below to fill in 1520 * data. 1521 * 1522 * If the "data" here is really a primary key--that 1523 * is, if we're in a pget--and that primary key 1524 * is a recno, treat it appropriately as an int. 1525 */ 1526 if (useprecno) { 1527 result = _GetUInt32(interp, 1528 objv[objc - 1], &precno); 1529 if (result == TCL_OK) { 1530 save.data = &precno; 1531 save.size = sizeof(db_recno_t); 1532 } else 1533 goto out; 1534 } else { 1535 ret = _CopyObjBytes(interp, objv[objc-1], 1536 &dtmp, &save.size, &freedata); 1537 if (ret != 0) { 1538 result = _ReturnSetup(interp, ret, 1539 DB_RETOK_DBGET(ret), "db get"); 1540 goto out; 1541 } 1542 save.data = dtmp; 1543 } 1544 } else if (flag != DB_CONSUME && flag != DB_CONSUME_WAIT) { 1545 if (userecno) { 1546 result = _GetUInt32( 1547 interp, objv[(objc - 1)], &recno); 1548 if (result == TCL_OK) { 1549 key.data = &recno; 1550 key.size = sizeof(db_recno_t); 1551 } else 1552 goto out; 1553 } else { 1554 /* 1555 * Some get calls (SET_*) can change the 1556 * key pointers. So, we need to store 1557 * the allocated key space in a tmp. 1558 */ 1559 ret = _CopyObjBytes(interp, objv[objc-1], 1560 &key.data, &key.size, &freekey); 1561 if (ret != 0) { 1562 result = _ReturnSetup(interp, ret, 1563 DB_RETOK_DBGET(ret), "db get"); 1564 goto out; 1565 } 1566 } 1567 ktmp = key.data; 1568#ifdef CONFIG_TEST 1569 if (mflag & DB_MULTIPLE) { 1570 if ((ret = __os_malloc(dbp->env, 1571 (size_t)bufsize, &save.data)) != 0) { 1572 Tcl_SetResult(interp, 1573 db_strerror(ret), TCL_STATIC); 1574 goto out; 1575 } 1576 save.ulen = (u_int32_t)bufsize; 1577 F_CLR(&save, DB_DBT_MALLOC); 1578 F_SET(&save, DB_DBT_USERMEM); 1579 } 1580#endif 1581 } 1582 1583 data = save; 1584 1585 if (ispget) { 1586 if (flag == DB_GET_BOTH) { 1587 pkey.data = save.data; 1588 pkey.size = save.size; 1589 data.data = NULL; 1590 data.size = 0; 1591 } 1592 F_SET(&pkey, DB_DBT_MALLOC); 1593 _debug_check(); 1594 ret = dbp->pget(dbp, 1595 txn, &key, &pkey, &data, flag | rmw); 1596 } else { 1597 _debug_check(); 1598 ret = dbp->get(dbp, 1599 txn, &key, &data, flag | rmw | mflag); 1600 } 1601 result = _ReturnSetup(interp, ret, DB_RETOK_DBGET(ret), 1602 "db get"); 1603 if (ret == 0) { 1604 /* 1605 * Success. Return a list of the form {name value} 1606 * If it was a recno in key.data, we need to convert 1607 * into a string/object representation of that recno. 1608 */ 1609 if (mflag & DB_MULTIPLE) 1610 result = _SetMultiList(interp, 1611 retlist, &key, &data, type, flag); 1612 else if (type == DB_RECNO || type == DB_QUEUE) 1613 if (ispget) 1614 result = _Set3DBTList(interp, 1615 retlist, &key, 1, &pkey, 1616 useprecno, &data); 1617 else 1618 result = _SetListRecnoElem(interp, 1619 retlist, *(db_recno_t *)key.data, 1620 data.data, data.size); 1621 else { 1622 if (ispget) 1623 result = _Set3DBTList(interp, 1624 retlist, &key, 0, &pkey, 1625 useprecno, &data); 1626 else 1627 result = _SetListElem(interp, retlist, 1628 key.data, key.size, 1629 data.data, data.size); 1630 } 1631 } 1632 /* 1633 * Free space from DBT. 1634 * 1635 * If we set DB_DBT_MALLOC, we need to free the space if and 1636 * only if we succeeded and if DB allocated anything (the 1637 * pointer has changed from what we passed in). If 1638 * DB_DBT_MALLOC is not set, this is a bulk get buffer, and 1639 * needs to be freed no matter what. 1640 */ 1641 if (F_ISSET(&key, DB_DBT_MALLOC) && ret == 0 && 1642 key.data != ktmp) 1643 __os_ufree(dbp->env, key.data); 1644 if (F_ISSET(&data, DB_DBT_MALLOC) && ret == 0 && 1645 data.data != dtmp) 1646 __os_ufree(dbp->env, data.data); 1647 else if (!F_ISSET(&data, DB_DBT_MALLOC)) 1648 __os_free(dbp->env, data.data); 1649 if (ispget && ret == 0 && pkey.data != save.data) 1650 __os_ufree(dbp->env, pkey.data); 1651 if (result == TCL_OK) 1652 Tcl_SetObjResult(interp, retlist); 1653 goto out; 1654 } 1655 1656 if (userecno) { 1657 result = _GetUInt32(interp, objv[(objc - 1)], &recno); 1658 if (result == TCL_OK) { 1659 key.data = &recno; 1660 key.size = sizeof(db_recno_t); 1661 } else 1662 goto out; 1663 } else { 1664 /* 1665 * Some get calls (SET_*) can change the 1666 * key pointers. So, we need to store 1667 * the allocated key space in a tmp. 1668 */ 1669 ret = _CopyObjBytes(interp, objv[objc-1], &key.data, 1670 &key.size, &freekey); 1671 if (ret != 0) { 1672 result = _ReturnSetup(interp, ret, 1673 DB_RETOK_DBGET(ret), "db get"); 1674 return (result); 1675 } 1676 } 1677 ktmp = key.data; 1678 ret = dbp->cursor(dbp, txn, &dbc, 0); 1679 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db cursor"); 1680 if (result == TCL_ERROR) 1681 goto out; 1682 1683 /* 1684 * At this point, we have a cursor, if we have a pattern, 1685 * we go to the nearest one and step forward until we don't 1686 * have any more that match the pattern prefix. If we have 1687 * an exact key, we go to that key position, and step through 1688 * all the duplicates. In either case we build up a list of 1689 * the form {{key data} {key data}...} along the way. 1690 */ 1691 memset(&data, 0, sizeof(data)); 1692 /* 1693 * Restore any "partial" info we have saved. 1694 */ 1695 data = save; 1696 if (pattern) { 1697 /* 1698 * Note, prefix is returned in new space. Must free it. 1699 */ 1700 ret = _GetGlobPrefix(pattern, &prefix); 1701 if (ret) { 1702 result = TCL_ERROR; 1703 Tcl_SetResult(interp, 1704 "Unable to allocate pattern space", TCL_STATIC); 1705 goto out1; 1706 } 1707 key.data = prefix; 1708 key.size = (u_int32_t)strlen(prefix); 1709 /* 1710 * If they give us an empty pattern string 1711 * (i.e. -glob *), go through entire DB. 1712 */ 1713 if (strlen(prefix) == 0) 1714 cflag = DB_FIRST; 1715 else 1716 cflag = DB_SET_RANGE; 1717 } else 1718 cflag = DB_SET; 1719 if (ispget) { 1720 _debug_check(); 1721 F_SET(&pkey, DB_DBT_MALLOC); 1722 ret = dbc->pget(dbc, &key, &pkey, &data, cflag | rmw); 1723 } else { 1724 _debug_check(); 1725 ret = dbc->get(dbc, &key, &data, cflag | rmw); 1726 } 1727 result = _ReturnSetup(interp, ret, DB_RETOK_DBCGET(ret), 1728 "db get (cursor)"); 1729 if (result == TCL_ERROR) 1730 goto out1; 1731 if (pattern) { 1732 if (ret == 0 && prefix != NULL && 1733 memcmp(key.data, prefix, strlen(prefix)) != 0) { 1734 /* 1735 * Free space from DB_DBT_MALLOC 1736 */ 1737 __os_ufree(dbp->env, data.data); 1738 goto out1; 1739 } 1740 cflag = DB_NEXT; 1741 } else 1742 cflag = DB_NEXT_DUP; 1743 1744 while (ret == 0 && result == TCL_OK) { 1745 /* 1746 * Build up our {name value} sublist 1747 */ 1748 if (ispget) 1749 result = _Set3DBTList(interp, retlist, &key, 0, 1750 &pkey, useprecno, &data); 1751 else 1752 result = _SetListElem(interp, retlist, 1753 key.data, key.size, data.data, data.size); 1754 /* 1755 * Free space from DB_DBT_MALLOC 1756 */ 1757 if (ispget) 1758 __os_ufree(dbp->env, pkey.data); 1759 __os_ufree(dbp->env, data.data); 1760 if (result != TCL_OK) 1761 break; 1762 /* 1763 * Append {name value} to return list 1764 */ 1765 memset(&key, 0, sizeof(key)); 1766 memset(&pkey, 0, sizeof(pkey)); 1767 memset(&data, 0, sizeof(data)); 1768 /* 1769 * Restore any "partial" info we have saved. 1770 */ 1771 data = save; 1772 if (ispget) { 1773 F_SET(&pkey, DB_DBT_MALLOC); 1774 ret = dbc->pget(dbc, &key, &pkey, &data, cflag | rmw); 1775 } else 1776 ret = dbc->get(dbc, &key, &data, cflag | rmw); 1777 if (ret == 0 && prefix != NULL && 1778 memcmp(key.data, prefix, strlen(prefix)) != 0) { 1779 /* 1780 * Free space from DB_DBT_MALLOC 1781 */ 1782 __os_ufree(dbp->env, data.data); 1783 break; 1784 } 1785 } 1786out1: 1787 (void)dbc->close(dbc); 1788 if (result == TCL_OK) 1789 Tcl_SetObjResult(interp, retlist); 1790out: 1791 /* 1792 * _GetGlobPrefix(), the function which allocates prefix, works 1793 * by copying and condensing another string. Thus prefix may 1794 * have multiple nuls at the end, so we free using __os_free(). 1795 */ 1796 if (prefix != NULL) 1797 __os_free(dbp->env, prefix); 1798 if (dtmp != NULL && freedata) 1799 __os_free(dbp->env, dtmp); 1800 if (ktmp != NULL && freekey) 1801 __os_free(dbp->env, ktmp); 1802 return (result); 1803} 1804 1805/* 1806 * tcl_db_delete -- 1807 */ 1808static int 1809tcl_DbDelete(interp, objc, objv, dbp) 1810 Tcl_Interp *interp; /* Interpreter */ 1811 int objc; /* How many arguments? */ 1812 Tcl_Obj *CONST objv[]; /* The argument objects */ 1813 DB *dbp; /* Database pointer */ 1814{ 1815 static const char *dbdelopts[] = { 1816 "-consume", 1817 "-glob", 1818 "-multiple", 1819 "-multiple_key", 1820 "-txn", 1821 NULL 1822 }; 1823 enum dbdelopts { 1824 DBDEL_CONSUME, 1825 DBDEL_GLOB, 1826 DBDEL_MULTIPLE, 1827 DBDEL_MULTIPLE_KEY, 1828 DBDEL_TXN 1829 }; 1830 DBC *dbc; 1831 DBT key, data; 1832 DBTYPE type; 1833 DB_TXN *txn; 1834 Tcl_Obj **elemv; 1835 void *dtmp, *ktmp, *ptr; 1836 db_recno_t recno; 1837 int dlen, elemc, freekey, i, j, klen, optindex, result, ret; 1838 u_int32_t dflag, flag, multiflag; 1839 char *arg, *pattern, *prefix, msg[MSG_SIZE]; 1840 1841 result = TCL_OK; 1842 freekey = 0; 1843 dflag = 0; 1844 multiflag = 0; 1845 pattern = prefix = NULL; 1846 txn = NULL; 1847 if (objc < 3) { 1848 Tcl_WrongNumArgs(interp, 2, objv, "?-args? key"); 1849 return (TCL_ERROR); 1850 } 1851 1852 dtmp = ktmp = NULL; 1853 memset(&key, 0, sizeof(key)); 1854 /* 1855 * The first arg must be -glob, -txn or a list of keys. 1856 */ 1857 i = 2; 1858 while (i < objc) { 1859 if (Tcl_GetIndexFromObj(interp, objv[i], dbdelopts, "option", 1860 TCL_EXACT, &optindex) != TCL_OK) { 1861 /* 1862 * If we don't have a -glob or -txn, then the remaining 1863 * args must be exact keys. Reset the result so we 1864 * don't get an errant error message if there is another 1865 * error. 1866 */ 1867 if (IS_HELP(objv[i]) == TCL_OK) 1868 return (TCL_OK); 1869 Tcl_ResetResult(interp); 1870 break; 1871 } 1872 i++; 1873 switch ((enum dbdelopts)optindex) { 1874 case DBDEL_TXN: 1875 if (i == objc) { 1876 /* 1877 * Someone could conceivably have a key of 1878 * the same name. So just break and use it. 1879 */ 1880 i--; 1881 break; 1882 } 1883 arg = Tcl_GetStringFromObj(objv[i++], NULL); 1884 txn = NAME_TO_TXN(arg); 1885 if (txn == NULL) { 1886 snprintf(msg, MSG_SIZE, 1887 "Delete: Invalid txn: %s\n", arg); 1888 Tcl_SetResult(interp, msg, TCL_VOLATILE); 1889 result = TCL_ERROR; 1890 } 1891 break; 1892 case DBDEL_GLOB: 1893 /* 1894 * Get the pattern. Get the prefix and use cursors to 1895 * get all the data items. 1896 */ 1897 if (i == objc) { 1898 /* 1899 * Someone could conceivably have a key of 1900 * the same name. So just break and use it. 1901 */ 1902 i--; 1903 break; 1904 } 1905 pattern = Tcl_GetStringFromObj(objv[i++], NULL); 1906 break; 1907 case DBDEL_CONSUME: 1908 FLAG_CHECK(dflag); 1909 dflag = DB_CONSUME; 1910 break; 1911 case DBDEL_MULTIPLE: 1912 FLAG_CHECK(multiflag); 1913 multiflag |= DB_MULTIPLE; 1914 break; 1915 case DBDEL_MULTIPLE_KEY: 1916 FLAG_CHECK(multiflag); 1917 multiflag |= DB_MULTIPLE_KEY; 1918 break; 1919 } 1920 if (result != TCL_OK) 1921 break; 1922 } 1923 1924 if (result != TCL_OK) 1925 goto out; 1926 /* 1927 * XXX 1928 * For consistency with get, we have decided for the moment, to 1929 * allow -glob, or one key, not many. The code was originally 1930 * written to take many keys and we'll leave it that way, because 1931 * tcl_DbGet may one day accept many disjoint keys to get, rather 1932 * than one, and at that time we'd make delete be consistent. In 1933 * any case, the code is already here and there is no need to remove, 1934 * just check that we only have one arg left. 1935 * 1936 * If we have a pattern AND more keys to process, there is an error. 1937 * Either we have some number of exact keys, or we have a pattern. 1938 */ 1939 if (pattern == NULL) { 1940 if (i != (objc - 1)) { 1941 Tcl_WrongNumArgs( 1942 interp, 2, objv, "?args? -glob pattern | key"); 1943 result = TCL_ERROR; 1944 goto out; 1945 } 1946 } else { 1947 if (i != objc) { 1948 Tcl_WrongNumArgs( 1949 interp, 2, objv, "?args? -glob pattern | key"); 1950 result = TCL_ERROR; 1951 goto out; 1952 } 1953 } 1954 1955 /* 1956 * If we have remaining args, they are all exact keys. Call 1957 * DB->del on each of those keys. 1958 * 1959 * If it is a RECNO database, the key is a record number and must be 1960 * setup up to contain a db_recno_t. Otherwise the key is a "string". 1961 */ 1962 (void)dbp->get_type(dbp, &type); 1963 ret = 0; 1964 while (i < objc && ret == 0) { 1965 memset(&key, 0, sizeof(key)); 1966 if (multiflag == DB_MULTIPLE) { 1967 /* 1968 * To work out how big a buffer is needed, we first 1969 * need to find out the total length of the data and 1970 * the number of data items (elemc). 1971 */ 1972 ktmp = Tcl_GetByteArrayFromObj(objv[i], &klen); 1973 result = Tcl_ListObjGetElements(interp, objv[i++], 1974 &elemc, &elemv); 1975 if (result != TCL_OK) 1976 return (result); 1977 1978 memset(&key, 0, sizeof(key)); 1979 key.ulen = DB_ALIGN((u_int32_t)klen + (u_int32_t)elemc 1980 * sizeof(u_int32_t) * 2, 1024UL); 1981 key.flags = DB_DBT_USERMEM | DB_DBT_BULK; 1982 if ((ret = 1983 __os_malloc(dbp->env, key.ulen, &key.data)) != 0) 1984 return (ret); 1985 freekey = 1; 1986 1987 if (type == DB_RECNO || type == DB_QUEUE) { 1988 DB_MULTIPLE_RECNO_WRITE_INIT(ptr, &key); 1989 for (j = 0; j < elemc; j++) { 1990 result = 1991 _GetUInt32(interp, 1992 elemv[j], &recno); 1993 if (result != TCL_OK) 1994 return (result); 1995 DB_MULTIPLE_RECNO_WRITE_NEXT(ptr, 1996 &key, recno, dtmp, 0); 1997 DB_ASSERT(dbp->env, ptr != NULL); 1998 } 1999 } else { 2000 DB_MULTIPLE_WRITE_INIT(ptr, &key); 2001 for (j = 0; j < elemc; j++) { 2002 ktmp = Tcl_GetByteArrayFromObj(elemv[j], 2003 &klen); 2004 DB_MULTIPLE_WRITE_NEXT(ptr, 2005 &key, ktmp, (u_int32_t)klen); 2006 DB_ASSERT(dbp->env, ptr != NULL); 2007 } 2008 } 2009 } else if (multiflag == DB_MULTIPLE_KEY) { 2010 /* 2011 * To work out how big a buffer is needed, we first 2012 * need to find out the total length of the data (len) 2013 * and the number of data items (elemc). 2014 */ 2015 ktmp = Tcl_GetByteArrayFromObj(objv[i], &klen); 2016 result = Tcl_ListObjGetElements(interp, objv[i++], 2017 &elemc, &elemv); 2018 if (result != TCL_OK) 2019 return (result); 2020 2021 memset(&key, 0, sizeof(key)); 2022 key.ulen = DB_ALIGN((u_int32_t)klen + 2023 (u_int32_t)elemc * sizeof(u_int32_t) * 2, 1024UL); 2024 key.flags = DB_DBT_USERMEM | DB_DBT_BULK; 2025 if ((ret = 2026 __os_malloc(dbp->env, key.ulen, &key.data)) != 0) 2027 return (ret); 2028 freekey = 1; 2029 2030 if (type == DB_RECNO || type == DB_QUEUE) { 2031 DB_MULTIPLE_RECNO_WRITE_INIT(ptr, &key); 2032 for (j = 0; j + 1 < elemc; j += 2) { 2033 result = 2034 _GetUInt32(interp, 2035 elemv[j], &recno); 2036 if (result != TCL_OK) 2037 return (result); 2038 dtmp = Tcl_GetByteArrayFromObj( 2039 elemv[j + 1], &dlen); 2040 DB_MULTIPLE_RECNO_WRITE_NEXT(ptr, 2041 &key, recno, dtmp, (u_int32_t)dlen); 2042 DB_ASSERT(dbp->env, ptr != NULL); 2043 } 2044 } else { 2045 DB_MULTIPLE_WRITE_INIT(ptr, &key); 2046 for (j = 0; j + 1 < elemc; j += 2) { 2047 ktmp = Tcl_GetByteArrayFromObj( 2048 elemv[j], &klen); 2049 dtmp = Tcl_GetByteArrayFromObj( 2050 elemv[j + 1], &dlen); 2051 DB_MULTIPLE_KEY_WRITE_NEXT(ptr, 2052 &key, ktmp, (u_int32_t)klen, 2053 dtmp, (u_int32_t)dlen); 2054 DB_ASSERT(dbp->env, ptr != NULL); 2055 } 2056 } 2057 } else if (type == DB_RECNO || type == DB_QUEUE) { 2058 result = _GetUInt32(interp, objv[i++], &recno); 2059 if (result == TCL_OK) { 2060 key.data = &recno; 2061 key.size = sizeof(db_recno_t); 2062 } else 2063 return (result); 2064 } else { 2065 ret = _CopyObjBytes(interp, objv[i++], &ktmp, 2066 &key.size, &freekey); 2067 if (ret != 0) { 2068 result = _ReturnSetup(interp, ret, 2069 DB_RETOK_DBDEL(ret), "db del"); 2070 return (result); 2071 } 2072 key.data = ktmp; 2073 } 2074 _debug_check(); 2075 ret = dbp->del(dbp, txn, &key, dflag | multiflag); 2076 /* 2077 * If we have any error, set up return result and stop 2078 * processing keys. 2079 */ 2080 if (freekey && key.data != NULL) 2081 __os_free(dbp->env, key.data); 2082 if (ret != 0) 2083 break; 2084 } 2085 result = _ReturnSetup(interp, ret, DB_RETOK_DBDEL(ret), "db del"); 2086 2087 /* 2088 * At this point we've either finished or, if we have a pattern, 2089 * we go to the nearest one and step forward until we don't 2090 * have any more that match the pattern prefix. 2091 */ 2092 if (pattern) { 2093 ret = dbp->cursor(dbp, txn, &dbc, 0); 2094 if (ret != 0) { 2095 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 2096 "db cursor"); 2097 goto out; 2098 } 2099 /* 2100 * Note, prefix is returned in new space. Must free it. 2101 */ 2102 memset(&key, 0, sizeof(key)); 2103 memset(&data, 0, sizeof(data)); 2104 ret = _GetGlobPrefix(pattern, &prefix); 2105 if (ret) { 2106 result = TCL_ERROR; 2107 Tcl_SetResult(interp, 2108 "Unable to allocate pattern space", TCL_STATIC); 2109 goto out; 2110 } 2111 key.data = prefix; 2112 key.size = (u_int32_t)strlen(prefix); 2113 if (strlen(prefix) == 0) 2114 flag = DB_FIRST; 2115 else 2116 flag = DB_SET_RANGE; 2117 ret = dbc->get(dbc, &key, &data, flag); 2118 while (ret == 0 && 2119 memcmp(key.data, prefix, strlen(prefix)) == 0) { 2120 /* 2121 * Each time through here the cursor is pointing 2122 * at the current valid item. Delete it and 2123 * move ahead. 2124 */ 2125 _debug_check(); 2126 ret = dbc->del(dbc, dflag); 2127 if (ret != 0) { 2128 result = _ReturnSetup(interp, ret, 2129 DB_RETOK_DBCDEL(ret), "db c_del"); 2130 break; 2131 } 2132 /* 2133 * Deleted the current, now move to the next item 2134 * in the list, check if it matches the prefix pattern. 2135 */ 2136 memset(&key, 0, sizeof(key)); 2137 memset(&data, 0, sizeof(data)); 2138 ret = dbc->get(dbc, &key, &data, DB_NEXT); 2139 } 2140 if (ret == DB_NOTFOUND) 2141 ret = 0; 2142 /* 2143 * _GetGlobPrefix(), the function which allocates prefix, works 2144 * by copying and condensing another string. Thus prefix may 2145 * have multiple nuls at the end, so we free using __os_free(). 2146 */ 2147 __os_free(dbp->env, prefix); 2148 (void)dbc->close(dbc); 2149 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db del"); 2150 } 2151out: 2152 return (result); 2153} 2154 2155/* 2156 * tcl_db_cursor -- 2157 */ 2158static int 2159tcl_DbCursor(interp, objc, objv, dbp, dbcp) 2160 Tcl_Interp *interp; /* Interpreter */ 2161 int objc; /* How many arguments? */ 2162 Tcl_Obj *CONST objv[]; /* The argument objects */ 2163 DB *dbp; /* Database pointer */ 2164 DBC **dbcp; /* Return cursor pointer */ 2165{ 2166 static const char *dbcuropts[] = { 2167#ifdef CONFIG_TEST 2168 "-read_committed", 2169 "-read_uncommitted", 2170 "-update", 2171#endif 2172 "-bulk", 2173 "-txn", 2174 NULL 2175 }; 2176 enum dbcuropts { 2177#ifdef CONFIG_TEST 2178 DBCUR_READ_COMMITTED, 2179 DBCUR_READ_UNCOMMITTED, 2180 DBCUR_UPDATE, 2181#endif 2182 DBCUR_BULK, 2183 DBCUR_TXN 2184 }; 2185 DB_TXN *txn; 2186 u_int32_t flag; 2187 int i, optindex, result, ret; 2188 char *arg, msg[MSG_SIZE]; 2189 2190 result = TCL_OK; 2191 flag = 0; 2192 txn = NULL; 2193 i = 2; 2194 while (i < objc) { 2195 if (Tcl_GetIndexFromObj(interp, objv[i], dbcuropts, "option", 2196 TCL_EXACT, &optindex) != TCL_OK) { 2197 result = IS_HELP(objv[i]); 2198 goto out; 2199 } 2200 i++; 2201 switch ((enum dbcuropts)optindex) { 2202#ifdef CONFIG_TEST 2203 case DBCUR_READ_COMMITTED: 2204 flag |= DB_READ_COMMITTED; 2205 break; 2206 case DBCUR_READ_UNCOMMITTED: 2207 flag |= DB_READ_UNCOMMITTED; 2208 break; 2209 case DBCUR_UPDATE: 2210 flag |= DB_WRITECURSOR; 2211 break; 2212#endif 2213 case DBCUR_BULK: 2214 flag |= DB_CURSOR_BULK; 2215 break; 2216 case DBCUR_TXN: 2217 if (i == objc) { 2218 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); 2219 result = TCL_ERROR; 2220 break; 2221 } 2222 arg = Tcl_GetStringFromObj(objv[i++], NULL); 2223 txn = NAME_TO_TXN(arg); 2224 if (txn == NULL) { 2225 snprintf(msg, MSG_SIZE, 2226 "Cursor: Invalid txn: %s\n", arg); 2227 Tcl_SetResult(interp, msg, TCL_VOLATILE); 2228 result = TCL_ERROR; 2229 } 2230 break; 2231 } 2232 if (result != TCL_OK) 2233 break; 2234 } 2235 if (result != TCL_OK) 2236 goto out; 2237 2238 _debug_check(); 2239 ret = dbp->cursor(dbp, txn, dbcp, flag); 2240 if (ret != 0) 2241 result = _ErrorSetup(interp, ret, "db cursor"); 2242out: 2243 return (result); 2244} 2245 2246/* 2247 * tcl_DbAssociate -- 2248 * Call DB->associate(). 2249 */ 2250static int 2251tcl_DbAssociate(interp, objc, objv, dbp) 2252 Tcl_Interp *interp; 2253 int objc; 2254 Tcl_Obj *CONST objv[]; 2255 DB *dbp; 2256{ 2257 static const char *dbaopts[] = { 2258 "-create", 2259 "-immutable_key", 2260 "-txn", 2261 NULL 2262 }; 2263 enum dbaopts { 2264 DBA_CREATE, 2265 DBA_IMMUTABLE_KEY, 2266 DBA_TXN 2267 }; 2268 DB *sdbp; 2269 DB_TXN *txn; 2270 DBTCL_INFO *sdbip; 2271 int i, optindex, result, ret; 2272 char *arg, msg[MSG_SIZE]; 2273 u_int32_t flag; 2274#ifdef CONFIG_TEST 2275 /* 2276 * When calling DB->associate over RPC, the Tcl API uses 2277 * special flags that the RPC server interprets to set the 2278 * callback correctly. 2279 */ 2280 const char *cbname; 2281 struct { 2282 const char *name; 2283 u_int32_t flag; 2284 } *cb, callbacks[] = { 2285 { "", 0 }, /* A NULL callback in Tcl. */ 2286 { "_s_reversedata", DB_RPC2ND_REVERSEDATA }, 2287 { "_s_noop", DB_RPC2ND_NOOP }, 2288 { "_s_concatkeydata", DB_RPC2ND_CONCATKEYDATA }, 2289 { "_s_concatdatakey", DB_RPC2ND_CONCATDATAKEY }, 2290 { "_s_reverseconcat", DB_RPC2ND_REVERSECONCAT }, 2291 { "_s_truncdata", DB_RPC2ND_TRUNCDATA }, 2292 { "_s_reversedata", DB_RPC2ND_REVERSEDATA }, 2293 { "_s_constant", DB_RPC2ND_CONSTANT }, 2294 { "sj_getzip", DB_RPC2ND_GETZIP }, 2295 { "sj_getname", DB_RPC2ND_GETNAME }, 2296 { NULL, 0 } 2297 }; 2298#endif 2299 2300 txn = NULL; 2301 result = TCL_OK; 2302 flag = 0; 2303 if (objc < 2) { 2304 Tcl_WrongNumArgs(interp, 2, objv, "[callback] secondary"); 2305 return (TCL_ERROR); 2306 } 2307 2308 i = 2; 2309 while (i < objc) { 2310 if (Tcl_GetIndexFromObj(interp, objv[i], dbaopts, "option", 2311 TCL_EXACT, &optindex) != TCL_OK) { 2312 result = IS_HELP(objv[i]); 2313 if (result == TCL_OK) 2314 return (result); 2315 result = TCL_OK; 2316 Tcl_ResetResult(interp); 2317 break; 2318 } 2319 i++; 2320 switch ((enum dbaopts)optindex) { 2321 case DBA_CREATE: 2322 flag |= DB_CREATE; 2323 break; 2324 case DBA_IMMUTABLE_KEY: 2325 flag |= DB_IMMUTABLE_KEY; 2326 break; 2327 case DBA_TXN: 2328 if (i > (objc - 1)) { 2329 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); 2330 result = TCL_ERROR; 2331 break; 2332 } 2333 arg = Tcl_GetStringFromObj(objv[i++], NULL); 2334 txn = NAME_TO_TXN(arg); 2335 if (txn == NULL) { 2336 snprintf(msg, MSG_SIZE, 2337 "Associate: Invalid txn: %s\n", arg); 2338 Tcl_SetResult(interp, msg, TCL_VOLATILE); 2339 result = TCL_ERROR; 2340 } 2341 break; 2342 } 2343 } 2344 if (result != TCL_OK) 2345 return (result); 2346 2347 /* 2348 * Better be 1 or 2 args left. The last arg must be the sdb 2349 * handle. If 2 args then objc-2 is the callback proc, else 2350 * we have a NULL callback. 2351 */ 2352 /* Get the secondary DB handle. */ 2353 arg = Tcl_GetStringFromObj(objv[objc - 1], NULL); 2354 sdbp = NAME_TO_DB(arg); 2355 if (sdbp == NULL) { 2356 snprintf(msg, MSG_SIZE, 2357 "Associate: Invalid database handle: %s\n", arg); 2358 Tcl_SetResult(interp, msg, TCL_VOLATILE); 2359 return (TCL_ERROR); 2360 } 2361 2362 /* 2363 * The callback is simply a Tcl object containing the name 2364 * of the callback proc, which is the second-to-last argument. 2365 * 2366 * Note that the callback needs to go in the *secondary* DB handle's 2367 * info struct; we may have multiple secondaries with different 2368 * callbacks. 2369 */ 2370 sdbip = (DBTCL_INFO *)sdbp->api_internal; 2371 2372#ifdef CONFIG_TEST 2373 if (i != objc - 1 && RPC_ON(dbp->dbenv)) { 2374 /* 2375 * The flag values allowed to DB->associate may have changed to 2376 * overlap with the range we've chosen. If this happens, we 2377 * need to reset all of the RPC_2ND_* flags to a new range. 2378 */ 2379 if ((flag & DB_RPC2ND_MASK) != 0) { 2380 snprintf(msg, MSG_SIZE, 2381 "RPC secondary flags overlap -- recalculate!\n"); 2382 Tcl_SetResult(interp, msg, TCL_VOLATILE); 2383 return (TCL_ERROR); 2384 } 2385 2386 cbname = Tcl_GetStringFromObj(objv[objc - 2], NULL); 2387 for (cb = callbacks; cb->name != NULL; cb++) 2388 if (strcmp(cb->name, cbname) == 0) { 2389 flag |= cb->flag; 2390 break; 2391 } 2392 2393 if (cb->name == NULL) { 2394 snprintf(msg, MSG_SIZE, 2395 "Associate: unknown callback: %s\n", cbname); 2396 Tcl_SetResult(interp, msg, TCL_VOLATILE); 2397 return (TCL_ERROR); 2398 } 2399 2400 ret = dbp->associate(dbp, txn, sdbp, NULL, flag); 2401 2402 /* 2403 * The primary reference isn't set when calling through 2404 * the RPC server, but the Tcl API peeks at it in other 2405 * places (see tcl_DbGet). 2406 */ 2407 if (ret == 0) 2408 sdbp->s_primary = dbp; 2409 } else if (i != objc - 1) { 2410#else 2411 if (i != objc - 1) { 2412#endif 2413 /* 2414 * We have 2 args, get the callback. 2415 */ 2416 sdbip->i_second_call = objv[objc - 2]; 2417 Tcl_IncrRefCount(sdbip->i_second_call); 2418 2419 /* Now call associate. */ 2420 _debug_check(); 2421 ret = dbp->associate(dbp, txn, sdbp, tcl_second_call, flag); 2422 } else { 2423 /* 2424 * We have a NULL callback. 2425 */ 2426 sdbip->i_second_call = NULL; 2427 ret = dbp->associate(dbp, txn, sdbp, NULL, flag); 2428 } 2429 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "associate"); 2430 2431 return (result); 2432} 2433 2434/* 2435 * tcl_second_call -- 2436 * Callback function for secondary indices. Get the callback 2437 * out of ip->i_second_call and call it. 2438 */ 2439static int 2440tcl_second_call(dbp, pkey, data, skey) 2441 DB *dbp; 2442 const DBT *pkey, *data; 2443 DBT *skey; 2444{ 2445 DBT *tskey; 2446 DBTCL_INFO *ip; 2447 Tcl_Interp *interp; 2448 Tcl_Obj *pobj, *dobj, *objv[3], *robj, **skeylist; 2449 size_t len; 2450 int ilen, result, ret; 2451 u_int32_t i, nskeys; 2452 void *retbuf, *databuf; 2453 2454 ip = (DBTCL_INFO *)dbp->api_internal; 2455 interp = ip->i_interp; 2456 objv[0] = ip->i_second_call; 2457 2458 /* 2459 * Create two ByteArray objects, with the contents of the pkey 2460 * and data DBTs that are our inputs. 2461 */ 2462 pobj = Tcl_NewByteArrayObj(pkey->data, (int)pkey->size); 2463 Tcl_IncrRefCount(pobj); 2464 dobj = Tcl_NewByteArrayObj(data->data, (int)data->size); 2465 Tcl_IncrRefCount(dobj); 2466 2467 objv[1] = pobj; 2468 objv[2] = dobj; 2469 2470 result = Tcl_EvalObjv(interp, 3, objv, 0); 2471 2472 Tcl_DecrRefCount(pobj); 2473 Tcl_DecrRefCount(dobj); 2474 2475 if (result != TCL_OK) { 2476 __db_errx(dbp->env, 2477 "Tcl callback function failed with code %d", result); 2478 return (EINVAL); 2479 } 2480 2481 robj = Tcl_GetObjResult(interp); 2482 if (robj->typePtr == NULL || strcmp(robj->typePtr->name, "list") != 0) { 2483 nskeys = 1; 2484 skeylist = &robj; 2485 tskey = skey; 2486 } else { 2487 if ((result = Tcl_ListObjGetElements(interp, 2488 robj, &ilen, &skeylist)) != TCL_OK) { 2489 __db_errx(dbp->env, 2490 "Could not get list elements from Tcl callback"); 2491 return (EINVAL); 2492 } 2493 nskeys = (u_int32_t)ilen; 2494 2495 /* 2496 * It would be nice to check for nskeys == 0 and return 2497 * DB_DONOTINDEX, but Tcl does not distinguish between an empty 2498 * string and an empty list, so that would disallow empty 2499 * secondary keys. 2500 */ 2501 if (nskeys == 0) { 2502 nskeys = 1; 2503 skeylist = &robj; 2504 } 2505 if (nskeys == 1) 2506 tskey = skey; 2507 else { 2508 memset(skey, 0, sizeof(DBT)); 2509 if ((ret = __os_umalloc(dbp->env, 2510 nskeys * sizeof(DBT), &skey->data)) != 0) 2511 return (ret); 2512 skey->size = nskeys; 2513 F_SET(skey, DB_DBT_MULTIPLE | DB_DBT_APPMALLOC); 2514 tskey = (DBT *)skey->data; 2515 } 2516 } 2517 2518 for (i = 0; i < nskeys; i++, tskey++) { 2519 retbuf = Tcl_GetByteArrayFromObj(skeylist[i], &ilen); 2520 len = (size_t)ilen; 2521 2522 /* 2523 * retbuf is owned by Tcl; copy it into malloc'ed memory. 2524 * We need to use __os_umalloc rather than ufree because this 2525 * will be freed by DB using __os_ufree--the DB_DBT_APPMALLOC 2526 * flag tells DB to free application-allocated memory. 2527 */ 2528 if ((ret = __os_umalloc(dbp->env, len, &databuf)) != 0) 2529 return (ret); 2530 memcpy(databuf, retbuf, len); 2531 2532 memset(tskey, 0, sizeof(DBT)); 2533 tskey->data = databuf; 2534 tskey->size = (u_int32_t)len; 2535 F_SET(tskey, DB_DBT_APPMALLOC); 2536 } 2537 2538 return (0); 2539} 2540 2541/* 2542 * tcl_db_join -- 2543 */ 2544static int 2545tcl_DbJoin(interp, objc, objv, dbp, dbcp) 2546 Tcl_Interp *interp; /* Interpreter */ 2547 int objc; /* How many arguments? */ 2548 Tcl_Obj *CONST objv[]; /* The argument objects */ 2549 DB *dbp; /* Database pointer */ 2550 DBC **dbcp; /* Cursor pointer */ 2551{ 2552 static const char *dbjopts[] = { 2553 "-nosort", 2554 NULL 2555 }; 2556 enum dbjopts { 2557 DBJ_NOSORT 2558 }; 2559 DBC **listp; 2560 size_t size; 2561 u_int32_t flag; 2562 int adj, i, j, optindex, result, ret; 2563 char *arg, msg[MSG_SIZE]; 2564 2565 result = TCL_OK; 2566 flag = 0; 2567 if (objc < 3) { 2568 Tcl_WrongNumArgs(interp, 2, objv, "curs1 curs2 ..."); 2569 return (TCL_ERROR); 2570 } 2571 2572 for (adj = i = 2; i < objc; i++) { 2573 if (Tcl_GetIndexFromObj(interp, objv[i], dbjopts, "option", 2574 TCL_EXACT, &optindex) != TCL_OK) { 2575 result = IS_HELP(objv[i]); 2576 if (result == TCL_OK) 2577 return (result); 2578 result = TCL_OK; 2579 Tcl_ResetResult(interp); 2580 break; 2581 } 2582 switch ((enum dbjopts)optindex) { 2583 case DBJ_NOSORT: 2584 flag |= DB_JOIN_NOSORT; 2585 adj++; 2586 break; 2587 } 2588 } 2589 if (result != TCL_OK) 2590 return (result); 2591 /* 2592 * Allocate one more for NULL ptr at end of list. 2593 */ 2594 size = sizeof(DBC *) * (size_t)((objc - adj) + 1); 2595 ret = __os_malloc(dbp->env, size, &listp); 2596 if (ret != 0) { 2597 Tcl_SetResult(interp, db_strerror(ret), TCL_STATIC); 2598 return (TCL_ERROR); 2599 } 2600 2601 memset(listp, 0, size); 2602 for (j = 0, i = adj; i < objc; i++, j++) { 2603 arg = Tcl_GetStringFromObj(objv[i], NULL); 2604 listp[j] = NAME_TO_DBC(arg); 2605 if (listp[j] == NULL) { 2606 snprintf(msg, MSG_SIZE, 2607 "Join: Invalid cursor: %s\n", arg); 2608 Tcl_SetResult(interp, msg, TCL_VOLATILE); 2609 result = TCL_ERROR; 2610 goto out; 2611 } 2612 } 2613 listp[j] = NULL; 2614 _debug_check(); 2615 ret = dbp->join(dbp, listp, dbcp, flag); 2616 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db join"); 2617 2618out: 2619 __os_free(dbp->env, listp); 2620 return (result); 2621} 2622 2623/* 2624 * tcl_db_getjoin -- 2625 */ 2626static int 2627tcl_DbGetjoin(interp, objc, objv, dbp) 2628 Tcl_Interp *interp; /* Interpreter */ 2629 int objc; /* How many arguments? */ 2630 Tcl_Obj *CONST objv[]; /* The argument objects */ 2631 DB *dbp; /* Database pointer */ 2632{ 2633 static const char *dbgetjopts[] = { 2634#ifdef CONFIG_TEST 2635 "-nosort", 2636#endif 2637 "-txn", 2638 NULL 2639 }; 2640 enum dbgetjopts { 2641#ifdef CONFIG_TEST 2642 DBGETJ_NOSORT, 2643#endif 2644 DBGETJ_TXN 2645 }; 2646 DB_TXN *txn; 2647 DB *elemdbp; 2648 DBC **listp; 2649 DBC *dbc; 2650 DBT key, data; 2651 Tcl_Obj **elemv, *retlist; 2652 void *ktmp; 2653 size_t size; 2654 u_int32_t flag; 2655 int adj, elemc, freekey, i, j, optindex, result, ret; 2656 char *arg, msg[MSG_SIZE]; 2657 2658 result = TCL_OK; 2659 flag = 0; 2660 ktmp = NULL; 2661 freekey = 0; 2662 if (objc < 3) { 2663 Tcl_WrongNumArgs(interp, 2, objv, "{db1 key1} {db2 key2} ..."); 2664 return (TCL_ERROR); 2665 } 2666 2667 txn = NULL; 2668 i = 2; 2669 adj = i; 2670 while (i < objc) { 2671 if (Tcl_GetIndexFromObj(interp, objv[i], dbgetjopts, "option", 2672 TCL_EXACT, &optindex) != TCL_OK) { 2673 result = IS_HELP(objv[i]); 2674 if (result == TCL_OK) 2675 return (result); 2676 result = TCL_OK; 2677 Tcl_ResetResult(interp); 2678 break; 2679 } 2680 i++; 2681 switch ((enum dbgetjopts)optindex) { 2682#ifdef CONFIG_TEST 2683 case DBGETJ_NOSORT: 2684 flag |= DB_JOIN_NOSORT; 2685 adj++; 2686 break; 2687#endif 2688 case DBGETJ_TXN: 2689 if (i == objc) { 2690 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); 2691 result = TCL_ERROR; 2692 break; 2693 } 2694 arg = Tcl_GetStringFromObj(objv[i++], NULL); 2695 txn = NAME_TO_TXN(arg); 2696 adj += 2; 2697 if (txn == NULL) { 2698 snprintf(msg, MSG_SIZE, 2699 "GetJoin: Invalid txn: %s\n", arg); 2700 Tcl_SetResult(interp, msg, TCL_VOLATILE); 2701 result = TCL_ERROR; 2702 } 2703 break; 2704 } 2705 } 2706 if (result != TCL_OK) 2707 return (result); 2708 size = sizeof(DBC *) * (size_t)((objc - adj) + 1); 2709 ret = __os_malloc(NULL, size, &listp); 2710 if (ret != 0) { 2711 Tcl_SetResult(interp, db_strerror(ret), TCL_STATIC); 2712 return (TCL_ERROR); 2713 } 2714 2715 memset(listp, 0, size); 2716 for (j = 0, i = adj; i < objc; i++, j++) { 2717 /* 2718 * Get each sublist as {db key} 2719 */ 2720 result = Tcl_ListObjGetElements(interp, objv[i], 2721 &elemc, &elemv); 2722 if (elemc != 2) { 2723 Tcl_SetResult(interp, "Lists must be {db key}", 2724 TCL_STATIC); 2725 result = TCL_ERROR; 2726 goto out; 2727 } 2728 /* 2729 * Get a pointer to that open db. Then, open a cursor in 2730 * that db, and go to the "key" place. 2731 */ 2732 elemdbp = NAME_TO_DB(Tcl_GetStringFromObj(elemv[0], NULL)); 2733 if (elemdbp == NULL) { 2734 snprintf(msg, MSG_SIZE, "Get_join: Invalid db: %s\n", 2735 Tcl_GetStringFromObj(elemv[0], NULL)); 2736 Tcl_SetResult(interp, msg, TCL_VOLATILE); 2737 result = TCL_ERROR; 2738 goto out; 2739 } 2740 ret = elemdbp->cursor(elemdbp, txn, &listp[j], 0); 2741 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 2742 "db cursor")) == TCL_ERROR) 2743 goto out; 2744 memset(&key, 0, sizeof(key)); 2745 memset(&data, 0, sizeof(data)); 2746 ret = _CopyObjBytes(interp, elemv[elemc-1], &ktmp, 2747 &key.size, &freekey); 2748 if (ret != 0) { 2749 result = _ReturnSetup(interp, ret, 2750 DB_RETOK_STD(ret), "db join"); 2751 goto out; 2752 } 2753 key.data = ktmp; 2754 ret = (listp[j])->get(listp[j], &key, &data, DB_SET); 2755 if ((result = _ReturnSetup(interp, ret, DB_RETOK_DBCGET(ret), 2756 "db cget")) == TCL_ERROR) 2757 goto out; 2758 } 2759 listp[j] = NULL; 2760 _debug_check(); 2761 ret = dbp->join(dbp, listp, &dbc, flag); 2762 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db join"); 2763 if (result == TCL_ERROR) 2764 goto out; 2765 2766 retlist = Tcl_NewListObj(0, NULL); 2767 while (ret == 0 && result == TCL_OK) { 2768 memset(&key, 0, sizeof(key)); 2769 memset(&data, 0, sizeof(data)); 2770 key.flags |= DB_DBT_MALLOC; 2771 data.flags |= DB_DBT_MALLOC; 2772 ret = dbc->get(dbc, &key, &data, 0); 2773 /* 2774 * Build up our {name value} sublist 2775 */ 2776 if (ret == 0) { 2777 result = _SetListElem(interp, retlist, 2778 key.data, key.size, 2779 data.data, data.size); 2780 __os_ufree(dbp->env, key.data); 2781 __os_ufree(dbp->env, data.data); 2782 } 2783 } 2784 (void)dbc->close(dbc); 2785 if (result == TCL_OK) 2786 Tcl_SetObjResult(interp, retlist); 2787out: 2788 if (ktmp != NULL && freekey) 2789 __os_free(dbp->env, ktmp); 2790 while (j) { 2791 if (listp[j]) 2792 (void)(listp[j])->close(listp[j]); 2793 j--; 2794 } 2795 __os_free(dbp->env, listp); 2796 return (result); 2797} 2798 2799/* 2800 * tcl_DbGetFlags -- 2801 */ 2802static int 2803tcl_DbGetFlags(interp, objc, objv, dbp) 2804 Tcl_Interp *interp; /* Interpreter */ 2805 int objc; /* How many arguments? */ 2806 Tcl_Obj *CONST objv[]; /* The argument objects */ 2807 DB *dbp; /* Database pointer */ 2808{ 2809 int i, ret, result; 2810 u_int32_t flags; 2811 char buf[512]; 2812 Tcl_Obj *res; 2813 2814 static const struct { 2815 u_int32_t flag; 2816 char *arg; 2817 } db_flags[] = { 2818 { DB_CHKSUM, "-chksum" }, 2819 { DB_DUP, "-dup" }, 2820 { DB_DUPSORT, "-dupsort" }, 2821 { DB_ENCRYPT, "-encrypt" }, 2822 { DB_INORDER, "-inorder" }, 2823 { DB_TXN_NOT_DURABLE, "-notdurable" }, 2824 { DB_RECNUM, "-recnum" }, 2825 { DB_RENUMBER, "-renumber" }, 2826 { DB_REVSPLITOFF, "-revsplitoff" }, 2827 { DB_SNAPSHOT, "-snapshot" }, 2828 { 0, NULL } 2829 }; 2830 2831 if (objc != 2) { 2832 Tcl_WrongNumArgs(interp, 1, objv, NULL); 2833 return (TCL_ERROR); 2834 } 2835 2836 ret = dbp->get_flags(dbp, &flags); 2837 if ((result = _ReturnSetup( 2838 interp, ret, DB_RETOK_STD(ret), "db get_flags")) == TCL_OK) { 2839 buf[0] = '\0'; 2840 2841 for (i = 0; db_flags[i].flag != 0; i++) 2842 if (LF_ISSET(db_flags[i].flag)) { 2843 if (strlen(buf) > 0) 2844 (void)strncat(buf, " ", sizeof(buf)); 2845 (void)strncat( 2846 buf, db_flags[i].arg, sizeof(buf)); 2847 } 2848 2849 res = NewStringObj(buf, strlen(buf)); 2850 Tcl_SetObjResult(interp, res); 2851 } 2852 2853 return (result); 2854} 2855 2856/* 2857 * tcl_DbGetOpenFlags -- 2858 */ 2859static int 2860tcl_DbGetOpenFlags(interp, objc, objv, dbp) 2861 Tcl_Interp *interp; /* Interpreter */ 2862 int objc; /* How many arguments? */ 2863 Tcl_Obj *CONST objv[]; /* The argument objects */ 2864 DB *dbp; /* Database pointer */ 2865{ 2866 int i, ret, result; 2867 u_int32_t flags; 2868 char buf[512]; 2869 Tcl_Obj *res; 2870 2871 static const struct { 2872 u_int32_t flag; 2873 char *arg; 2874 } open_flags[] = { 2875 { DB_AUTO_COMMIT, "-auto_commit" }, 2876 { DB_CREATE, "-create" }, 2877 { DB_EXCL, "-excl" }, 2878 { DB_MULTIVERSION, "-multiversion" }, 2879 { DB_NOMMAP, "-nommap" }, 2880 { DB_RDONLY, "-rdonly" }, 2881 { DB_READ_UNCOMMITTED, "-read_uncommitted" }, 2882 { DB_THREAD, "-thread" }, 2883 { DB_TRUNCATE, "-truncate" }, 2884 { 0, NULL } 2885 }; 2886 2887 if (objc != 2) { 2888 Tcl_WrongNumArgs(interp, 1, objv, NULL); 2889 return (TCL_ERROR); 2890 } 2891 2892 ret = dbp->get_open_flags(dbp, &flags); 2893 if ((result = _ReturnSetup( 2894 interp, ret, DB_RETOK_STD(ret), "db get_open_flags")) == TCL_OK) { 2895 buf[0] = '\0'; 2896 2897 for (i = 0; open_flags[i].flag != 0; i++) 2898 if (LF_ISSET(open_flags[i].flag)) { 2899 if (strlen(buf) > 0) 2900 (void)strncat(buf, " ", sizeof(buf)); 2901 (void)strncat( 2902 buf, open_flags[i].arg, sizeof(buf)); 2903 } 2904 2905 res = NewStringObj(buf, strlen(buf)); 2906 Tcl_SetObjResult(interp, res); 2907 } 2908 2909 return (result); 2910} 2911 2912/* 2913 * tcl_DbCount -- 2914 */ 2915static int 2916tcl_DbCount(interp, objc, objv, dbp) 2917 Tcl_Interp *interp; /* Interpreter */ 2918 int objc; /* How many arguments? */ 2919 Tcl_Obj *CONST objv[]; /* The argument objects */ 2920 DB *dbp; /* Database pointer */ 2921{ 2922 DBC *dbc; 2923 DBT key, data; 2924 Tcl_Obj *res; 2925 void *ktmp; 2926 db_recno_t count, recno; 2927 int freekey, result, ret; 2928 2929 res = NULL; 2930 count = 0; 2931 freekey = ret = 0; 2932 ktmp = NULL; 2933 result = TCL_OK; 2934 2935 if (objc != 3) { 2936 Tcl_WrongNumArgs(interp, 2, objv, "key"); 2937 return (TCL_ERROR); 2938 } 2939 2940 /* 2941 * Get the count for our key. 2942 * We do this by getting a cursor for this DB. Moving the cursor 2943 * to the set location, and getting a count on that cursor. 2944 */ 2945 memset(&key, 0, sizeof(key)); 2946 memset(&data, 0, sizeof(data)); 2947 2948 /* 2949 * If it's a queue or recno database, we must make sure to 2950 * treat the key as a recno rather than as a byte string. 2951 */ 2952 if (dbp->type == DB_RECNO || dbp->type == DB_QUEUE) { 2953 result = _GetUInt32(interp, objv[2], &recno); 2954 if (result == TCL_OK) { 2955 key.data = &recno; 2956 key.size = sizeof(db_recno_t); 2957 } else 2958 return (result); 2959 } else { 2960 ret = _CopyObjBytes(interp, objv[2], &ktmp, 2961 &key.size, &freekey); 2962 if (ret != 0) { 2963 result = _ReturnSetup(interp, ret, 2964 DB_RETOK_STD(ret), "db count"); 2965 return (result); 2966 } 2967 key.data = ktmp; 2968 } 2969 _debug_check(); 2970 ret = dbp->cursor(dbp, NULL, &dbc, 0); 2971 if (ret != 0) { 2972 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 2973 "db cursor"); 2974 goto out; 2975 } 2976 /* 2977 * Move our cursor to the key. 2978 */ 2979 ret = dbc->get(dbc, &key, &data, DB_SET); 2980 if (ret == DB_KEYEMPTY || ret == DB_NOTFOUND) 2981 count = 0; 2982 else { 2983 ret = dbc->count(dbc, &count, 0); 2984 if (ret != 0) { 2985 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 2986 "db c count"); 2987 goto out; 2988 } 2989 } 2990 res = Tcl_NewWideIntObj((Tcl_WideInt)count); 2991 Tcl_SetObjResult(interp, res); 2992 2993out: if (ktmp != NULL && freekey) 2994 __os_free(dbp->env, ktmp); 2995 (void)dbc->close(dbc); 2996 return (result); 2997} 2998 2999#ifdef CONFIG_TEST 3000/* 3001 * tcl_DbKeyRange -- 3002 */ 3003static int 3004tcl_DbKeyRange(interp, objc, objv, dbp) 3005 Tcl_Interp *interp; /* Interpreter */ 3006 int objc; /* How many arguments? */ 3007 Tcl_Obj *CONST objv[]; /* The argument objects */ 3008 DB *dbp; /* Database pointer */ 3009{ 3010 static const char *dbkeyropts[] = { 3011 "-txn", 3012 NULL 3013 }; 3014 enum dbkeyropts { 3015 DBKEYR_TXN 3016 }; 3017 DB_TXN *txn; 3018 DB_KEY_RANGE range; 3019 DBT key; 3020 DBTYPE type; 3021 Tcl_Obj *myobjv[3], *retlist; 3022 void *ktmp; 3023 db_recno_t recno; 3024 u_int32_t flag; 3025 int freekey, i, myobjc, optindex, result, ret; 3026 char *arg, msg[MSG_SIZE]; 3027 3028 ktmp = NULL; 3029 flag = 0; 3030 freekey = 0; 3031 result = TCL_OK; 3032 if (objc < 3) { 3033 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id? key"); 3034 return (TCL_ERROR); 3035 } 3036 3037 txn = NULL; 3038 for (i = 2; i < objc;) { 3039 if (Tcl_GetIndexFromObj(interp, objv[i], dbkeyropts, "option", 3040 TCL_EXACT, &optindex) != TCL_OK) { 3041 result = IS_HELP(objv[i]); 3042 if (result == TCL_OK) 3043 return (result); 3044 result = TCL_OK; 3045 Tcl_ResetResult(interp); 3046 break; 3047 } 3048 i++; 3049 switch ((enum dbkeyropts)optindex) { 3050 case DBKEYR_TXN: 3051 if (i == objc) { 3052 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); 3053 result = TCL_ERROR; 3054 break; 3055 } 3056 arg = Tcl_GetStringFromObj(objv[i++], NULL); 3057 txn = NAME_TO_TXN(arg); 3058 if (txn == NULL) { 3059 snprintf(msg, MSG_SIZE, 3060 "KeyRange: Invalid txn: %s\n", arg); 3061 Tcl_SetResult(interp, msg, TCL_VOLATILE); 3062 result = TCL_ERROR; 3063 } 3064 break; 3065 } 3066 } 3067 if (result != TCL_OK) 3068 return (result); 3069 (void)dbp->get_type(dbp, &type); 3070 ret = 0; 3071 /* 3072 * Make sure we have a key. 3073 */ 3074 if (i != (objc - 1)) { 3075 Tcl_WrongNumArgs(interp, 2, objv, "?args? key"); 3076 result = TCL_ERROR; 3077 goto out; 3078 } 3079 memset(&key, 0, sizeof(key)); 3080 if (type == DB_RECNO || type == DB_QUEUE) { 3081 result = _GetUInt32(interp, objv[i], &recno); 3082 if (result == TCL_OK) { 3083 key.data = &recno; 3084 key.size = sizeof(db_recno_t); 3085 } else 3086 return (result); 3087 } else { 3088 ret = _CopyObjBytes(interp, objv[i++], &ktmp, 3089 &key.size, &freekey); 3090 if (ret != 0) { 3091 result = _ReturnSetup(interp, ret, 3092 DB_RETOK_STD(ret), "db keyrange"); 3093 return (result); 3094 } 3095 key.data = ktmp; 3096 } 3097 _debug_check(); 3098 ret = dbp->key_range(dbp, txn, &key, &range, flag); 3099 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db keyrange"); 3100 if (result == TCL_ERROR) 3101 goto out; 3102 3103 /* 3104 * If we succeeded, set up return list. 3105 */ 3106 myobjc = 3; 3107 myobjv[0] = Tcl_NewDoubleObj(range.less); 3108 myobjv[1] = Tcl_NewDoubleObj(range.equal); 3109 myobjv[2] = Tcl_NewDoubleObj(range.greater); 3110 retlist = Tcl_NewListObj(myobjc, myobjv); 3111 if (result == TCL_OK) 3112 Tcl_SetObjResult(interp, retlist); 3113 3114out: if (ktmp != NULL && freekey) 3115 __os_free(dbp->env, ktmp); 3116 return (result); 3117} 3118#endif 3119 3120/* 3121 * tcl_DbTruncate -- 3122 */ 3123static int 3124tcl_DbTruncate(interp, objc, objv, dbp) 3125 Tcl_Interp *interp; /* Interpreter */ 3126 int objc; /* How many arguments? */ 3127 Tcl_Obj *CONST objv[]; /* The argument objects */ 3128 DB *dbp; /* Database pointer */ 3129{ 3130 static const char *dbcuropts[] = { 3131 "-txn", 3132 NULL 3133 }; 3134 enum dbcuropts { 3135 DBTRUNC_TXN 3136 }; 3137 DB_TXN *txn; 3138 Tcl_Obj *res; 3139 u_int32_t count; 3140 int i, optindex, result, ret; 3141 char *arg, msg[MSG_SIZE]; 3142 3143 txn = NULL; 3144 result = TCL_OK; 3145 3146 i = 2; 3147 while (i < objc) { 3148 if (Tcl_GetIndexFromObj(interp, objv[i], dbcuropts, "option", 3149 TCL_EXACT, &optindex) != TCL_OK) { 3150 result = IS_HELP(objv[i]); 3151 goto out; 3152 } 3153 i++; 3154 switch ((enum dbcuropts)optindex) { 3155 case DBTRUNC_TXN: 3156 if (i == objc) { 3157 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); 3158 result = TCL_ERROR; 3159 break; 3160 } 3161 arg = Tcl_GetStringFromObj(objv[i++], NULL); 3162 txn = NAME_TO_TXN(arg); 3163 if (txn == NULL) { 3164 snprintf(msg, MSG_SIZE, 3165 "Truncate: Invalid txn: %s\n", arg); 3166 Tcl_SetResult(interp, msg, TCL_VOLATILE); 3167 result = TCL_ERROR; 3168 } 3169 break; 3170 } 3171 if (result != TCL_OK) 3172 break; 3173 } 3174 if (result != TCL_OK) 3175 goto out; 3176 3177 _debug_check(); 3178 ret = dbp->truncate(dbp, txn, &count, 0); 3179 if (ret != 0) 3180 result = _ErrorSetup(interp, ret, "db truncate"); 3181 3182 else { 3183 res = Tcl_NewWideIntObj((Tcl_WideInt)count); 3184 Tcl_SetObjResult(interp, res); 3185 } 3186out: 3187 return (result); 3188} 3189 3190#ifdef CONFIG_TEST 3191/* 3192 * tcl_DbCompact -- 3193 */ 3194static int 3195tcl_DbCompact(interp, objc, objv, dbp) 3196 Tcl_Interp *interp; /* Interpreter */ 3197 int objc; /* How many arguments? */ 3198 Tcl_Obj *CONST objv[]; /* The argument objects */ 3199 DB *dbp; /* Database pointer */ 3200{ 3201 static const char *dbcuropts[] = { 3202 "-fillpercent", 3203 "-freespace", 3204 "-freeonly", 3205 "-pages", 3206 "-start", 3207 "-stop", 3208 "-timeout", 3209 "-txn", 3210 NULL 3211 }; 3212 enum dbcuropts { 3213 DBREORG_FILLFACTOR, 3214 DBREORG_FREESPACE, 3215 DBREORG_FREEONLY, 3216 DBREORG_PAGES, 3217 DBREORG_START, 3218 DBREORG_STOP, 3219 DBREORG_TIMEOUT, 3220 DBREORG_TXN 3221 }; 3222 DBTCL_INFO *ip; 3223 DBT *key, end, start, stop; 3224 DBTYPE type; 3225 DB_TXN *txn; 3226 Tcl_Obj *myobj, *retlist; 3227 db_recno_t recno, srecno; 3228 u_int32_t arg, fillfactor, flags, pages, timeout; 3229 char *carg, msg[MSG_SIZE]; 3230 int freekey, i, optindex, result, ret; 3231 void *kp; 3232 3233 flags = 0; 3234 result = TCL_OK; 3235 txn = NULL; 3236 (void)dbp->get_type(dbp, &type); 3237 memset(&start, 0, sizeof(start)); 3238 memset(&stop, 0, sizeof(stop)); 3239 memset(&end, 0, sizeof(end)); 3240 ip = (DBTCL_INFO *)dbp->api_internal; 3241 fillfactor = pages = timeout = 0; 3242 3243 i = 2; 3244 while (i < objc) { 3245 if (Tcl_GetIndexFromObj(interp, objv[i], dbcuropts, "option", 3246 TCL_EXACT, &optindex) != TCL_OK) { 3247 result = IS_HELP(objv[i]); 3248 goto out; 3249 } 3250 i++; 3251 switch ((enum dbcuropts)optindex) { 3252 case DBREORG_FILLFACTOR: 3253 if (i == objc) { 3254 Tcl_WrongNumArgs(interp, 3255 2, objv, "?-fillfactor number?"); 3256 result = TCL_ERROR; 3257 break; 3258 } 3259 result = _GetUInt32(interp, objv[i++], &arg); 3260 if (result != TCL_OK) 3261 goto out; 3262 i++; 3263 fillfactor = arg; 3264 break; 3265 case DBREORG_FREESPACE: 3266 LF_SET(DB_FREE_SPACE); 3267 break; 3268 3269 case DBREORG_FREEONLY: 3270 LF_SET(DB_FREELIST_ONLY); 3271 break; 3272 3273 case DBREORG_PAGES: 3274 if (i == objc) { 3275 Tcl_WrongNumArgs(interp, 3276 2, objv, "?-pages number?"); 3277 result = TCL_ERROR; 3278 break; 3279 } 3280 result = _GetUInt32(interp, objv[i++], &arg); 3281 if (result != TCL_OK) 3282 goto out; 3283 i++; 3284 pages = arg; 3285 break; 3286 case DBREORG_TIMEOUT: 3287 if (i == objc) { 3288 Tcl_WrongNumArgs(interp, 3289 2, objv, "?-timeout number?"); 3290 result = TCL_ERROR; 3291 break; 3292 } 3293 result = _GetUInt32(interp, objv[i++], &arg); 3294 if (result != TCL_OK) 3295 goto out; 3296 i++; 3297 timeout = arg; 3298 break; 3299 3300 case DBREORG_START: 3301 case DBREORG_STOP: 3302 if (i == objc) { 3303 Tcl_WrongNumArgs(interp, 1, objv, 3304 "?-args? -start/stop key"); 3305 result = TCL_ERROR; 3306 goto out; 3307 } 3308 if ((enum dbcuropts)optindex == DBREORG_START) { 3309 key = &start; 3310 key->data = &recno; 3311 } else { 3312 key = &stop; 3313 key->data = &srecno; 3314 } 3315 if (type == DB_RECNO || type == DB_QUEUE) { 3316 result = _GetUInt32( 3317 interp, objv[i], key->data); 3318 if (result == TCL_OK) { 3319 key->size = sizeof(db_recno_t); 3320 } else 3321 goto out; 3322 } else { 3323 ret = _CopyObjBytes(interp, objv[i], 3324 &key->data, &key->size, &freekey); 3325 if (ret != 0) 3326 goto err; 3327 if (freekey == 0) { 3328 if ((ret = __os_malloc(NULL, 3329 key->size, &kp)) != 0) 3330 goto err; 3331 3332 memcpy(kp, key->data, key->size); 3333 key->data = kp; 3334 key->ulen = key->size; 3335 } 3336 } 3337 i++; 3338 break; 3339 case DBREORG_TXN: 3340 if (i == objc) { 3341 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); 3342 result = TCL_ERROR; 3343 break; 3344 } 3345 carg = Tcl_GetStringFromObj(objv[i++], NULL); 3346 txn = NAME_TO_TXN(carg); 3347 if (txn == NULL) { 3348 snprintf(msg, MSG_SIZE, 3349 "Compact: Invalid txn: %s\n", carg); 3350 Tcl_SetResult(interp, msg, TCL_VOLATILE); 3351 result = TCL_ERROR; 3352 } 3353 } 3354 if (result != TCL_OK) 3355 break; 3356 } 3357 if (result != TCL_OK) 3358 goto out; 3359 3360 if (ip->i_cdata == NULL) 3361 if ((ret = __os_calloc(dbp->env, 3362 1, sizeof(DB_COMPACT), &ip->i_cdata)) != 0) { 3363 Tcl_SetResult(interp, 3364 db_strerror(ret), TCL_STATIC); 3365 goto out; 3366 } 3367 3368 ip->i_cdata->compact_fillpercent = fillfactor; 3369 ip->i_cdata->compact_timeout = timeout; 3370 ip->i_cdata->compact_pages = pages; 3371 3372 _debug_check(); 3373 ret = dbp->compact(dbp, txn, &start, &stop, ip->i_cdata, flags, &end); 3374 result = _ReturnSetup(interp, ret, DB_RETOK_DBCGET(ret), "dbp compact"); 3375 if (result == TCL_ERROR) 3376 goto out; 3377 3378 retlist = Tcl_NewListObj(0, NULL); 3379 if (ret != 0) 3380 goto out; 3381 if (type == DB_RECNO || type == DB_QUEUE) { 3382 if (end.size == 0) 3383 recno = 0; 3384 else 3385 recno = *((db_recno_t *)end.data); 3386 myobj = Tcl_NewWideIntObj((Tcl_WideInt)recno); 3387 } else 3388 myobj = Tcl_NewByteArrayObj(end.data, (int)end.size); 3389 result = Tcl_ListObjAppendElement(interp, retlist, myobj); 3390 if (result == TCL_OK) 3391 Tcl_SetObjResult(interp, retlist); 3392 3393 if (0) { 3394err: result = _ReturnSetup(interp, 3395 ret, DB_RETOK_DBCGET(ret), "dbc compact"); 3396 } 3397out: 3398 if (start.data != NULL && start.data != &recno) 3399 __os_free(NULL, start.data); 3400 if (stop.data != NULL && stop.data != &srecno) 3401 __os_free(NULL, stop.data); 3402 if (end.data != NULL) 3403 __os_free(NULL, end.data); 3404 3405 return (result); 3406} 3407 3408/* 3409 * tcl_DbCompactStat 3410 */ 3411static int 3412tcl_DbCompactStat(interp, objc, objv, dbp) 3413 Tcl_Interp *interp; /* Interpreter */ 3414 int objc; /* How many arguments? */ 3415 Tcl_Obj *CONST objv[]; /* The argument objects */ 3416 DB *dbp; /* Database pointer */ 3417{ 3418 DBTCL_INFO *ip; 3419 3420 COMPQUIET(objc, 0); 3421 COMPQUIET(objv, NULL); 3422 3423 ip = (DBTCL_INFO *)dbp->api_internal; 3424 3425 return (tcl_CompactStat(interp, ip)); 3426} 3427 3428/* 3429 * PUBLIC: int tcl_CompactStat __P((Tcl_Interp *, DBTCL_INFO *)); 3430 */ 3431int 3432tcl_CompactStat(interp, ip) 3433 Tcl_Interp *interp; /* Interpreter */ 3434 DBTCL_INFO *ip; 3435{ 3436 DB_COMPACT *rp; 3437 Tcl_Obj *res; 3438 int result; 3439 char msg[MSG_SIZE]; 3440 3441 result = TCL_OK; 3442 rp = NULL; 3443 3444 _debug_check(); 3445 if ((rp = ip->i_cdata) == NULL) { 3446 snprintf(msg, MSG_SIZE, 3447 "Compact stat: No stats available\n"); 3448 Tcl_SetResult(interp, msg, TCL_VOLATILE); 3449 result = TCL_ERROR; 3450 goto error; 3451 } 3452 3453 res = Tcl_NewObj(); 3454 3455 MAKE_STAT_LIST("Pages freed", rp->compact_pages_free); 3456 MAKE_STAT_LIST("Pages truncated", rp->compact_pages_truncated); 3457 MAKE_STAT_LIST("Pages examined", rp->compact_pages_examine); 3458 MAKE_STAT_LIST("Levels removed", rp->compact_levels); 3459 MAKE_STAT_LIST("Deadlocks encountered", rp->compact_deadlock); 3460 3461 Tcl_SetObjResult(interp, res); 3462error: 3463 return (result); 3464} 3465#endif 3466