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/tcl_db.h" 16 17/* 18 * Prototypes for procedures defined later in this file: 19 */ 20static int tcl_DbcDup __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *)); 21static int tcl_DbcCompare __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *)); 22static int tcl_DbcGet __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *, int)); 23static int tcl_DbcPut __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *)); 24 25/* 26 * PUBLIC: int dbc_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*)); 27 * 28 * dbc_cmd -- 29 * Implements the cursor command. 30 */ 31int 32dbc_Cmd(clientData, interp, objc, objv) 33 ClientData clientData; /* Cursor handle */ 34 Tcl_Interp *interp; /* Interpreter */ 35 int objc; /* How many arguments? */ 36 Tcl_Obj *CONST objv[]; /* The argument objects */ 37{ 38 static const char *dbccmds[] = { 39#ifdef CONFIG_TEST 40 "pget", 41#endif 42 "close", 43 "cmp", 44 "del", 45 "dup", 46 "get", 47 "put", 48 NULL 49 }; 50 enum dbccmds { 51#ifdef CONFIG_TEST 52 DBCPGET, 53#endif 54 DBCCLOSE, 55 DBCCOMPARE, 56 DBCDELETE, 57 DBCDUP, 58 DBCGET, 59 DBCPUT 60 }; 61 DBC *dbc; 62 DBTCL_INFO *dbip; 63 int cmdindex, result, ret; 64 65 Tcl_ResetResult(interp); 66 dbc = (DBC *)clientData; 67 dbip = _PtrToInfo((void *)dbc); 68 result = TCL_OK; 69 70 if (objc <= 1) { 71 Tcl_WrongNumArgs(interp, 1, objv, "command cmdargs"); 72 return (TCL_ERROR); 73 } 74 if (dbc == NULL) { 75 Tcl_SetResult(interp, "NULL dbc pointer", TCL_STATIC); 76 return (TCL_ERROR); 77 } 78 if (dbip == NULL) { 79 Tcl_SetResult(interp, "NULL dbc info pointer", TCL_STATIC); 80 return (TCL_ERROR); 81 } 82 83 /* 84 * Get the command name index from the object based on the berkdbcmds 85 * defined above. 86 */ 87 if (Tcl_GetIndexFromObj(interp, objv[1], dbccmds, "command", 88 TCL_EXACT, &cmdindex) != TCL_OK) 89 return (IS_HELP(objv[1])); 90 switch ((enum dbccmds)cmdindex) { 91#ifdef CONFIG_TEST 92 case DBCPGET: 93 result = tcl_DbcGet(interp, objc, objv, dbc, 1); 94 break; 95#endif 96 case DBCCLOSE: 97 /* 98 * No args for this. Error if there are some. 99 */ 100 if (objc > 2) { 101 Tcl_WrongNumArgs(interp, 2, objv, NULL); 102 return (TCL_ERROR); 103 } 104 _debug_check(); 105 ret = dbc->close(dbc); 106 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 107 "dbc close"); 108 if (result == TCL_OK) { 109 (void)Tcl_DeleteCommand(interp, dbip->i_name); 110 _DeleteInfo(dbip); 111 } 112 break; 113 case DBCCOMPARE: 114 if (objc > 3) { 115 Tcl_WrongNumArgs(interp, 3, objv, NULL); 116 return (TCL_ERROR); 117 } 118 _debug_check(); 119 result = tcl_DbcCompare(interp, objc, objv, dbc); 120 break; 121 case DBCDELETE: 122 /* 123 * No args for this. Error if there are some. 124 */ 125 if (objc > 2) { 126 Tcl_WrongNumArgs(interp, 2, objv, NULL); 127 return (TCL_ERROR); 128 } 129 _debug_check(); 130 ret = dbc->del(dbc, 0); 131 result = _ReturnSetup(interp, ret, DB_RETOK_DBCDEL(ret), 132 "dbc delete"); 133 break; 134 case DBCDUP: 135 result = tcl_DbcDup(interp, objc, objv, dbc); 136 break; 137 case DBCGET: 138 result = tcl_DbcGet(interp, objc, objv, dbc, 0); 139 break; 140 case DBCPUT: 141 result = tcl_DbcPut(interp, objc, objv, dbc); 142 break; 143 } 144 return (result); 145} 146 147/* 148 * tcl_DbcPut -- 149 */ 150static int 151tcl_DbcPut(interp, objc, objv, dbc) 152 Tcl_Interp *interp; /* Interpreter */ 153 int objc; /* How many arguments? */ 154 Tcl_Obj *CONST objv[]; /* The argument objects */ 155 DBC *dbc; /* Cursor pointer */ 156{ 157 static const char *dbcutopts[] = { 158#ifdef CONFIG_TEST 159 "-nodupdata", 160#endif 161 "-after", 162 "-before", 163 "-current", 164 "-keyfirst", 165 "-keylast", 166 "-overwritedup", 167 "-partial", 168 NULL 169 }; 170 enum dbcutopts { 171#ifdef CONFIG_TEST 172 DBCPUT_NODUPDATA, 173#endif 174 DBCPUT_AFTER, 175 DBCPUT_BEFORE, 176 DBCPUT_CURRENT, 177 DBCPUT_KEYFIRST, 178 DBCPUT_KEYLAST, 179 DBCPUT_OVERWRITE_DUP, 180 DBCPUT_PART 181 }; 182 DB *thisdbp; 183 DBT key, data; 184 DBTCL_INFO *dbcip, *dbip; 185 DBTYPE type; 186 Tcl_Obj **elemv, *res; 187 void *dtmp, *ktmp; 188 db_recno_t recno; 189 u_int32_t flag; 190 int elemc, freekey, freedata, i, optindex, result, ret; 191 192 COMPQUIET(dtmp, NULL); 193 COMPQUIET(ktmp, NULL); 194 195 result = TCL_OK; 196 flag = 0; 197 freekey = freedata = 0; 198 199 if (objc < 2) { 200 Tcl_WrongNumArgs(interp, 2, objv, "?-args? ?key?"); 201 return (TCL_ERROR); 202 } 203 204 memset(&key, 0, sizeof(key)); 205 memset(&data, 0, sizeof(data)); 206 207 /* 208 * Get the command name index from the object based on the options 209 * defined above. 210 */ 211 i = 2; 212 while (i < (objc - 1)) { 213 if (Tcl_GetIndexFromObj(interp, objv[i], dbcutopts, "option", 214 TCL_EXACT, &optindex) != TCL_OK) { 215 /* 216 * Reset the result so we don't get 217 * an errant error message if there is another error. 218 */ 219 if (IS_HELP(objv[i]) == TCL_OK) { 220 result = TCL_OK; 221 goto out; 222 } 223 Tcl_ResetResult(interp); 224 break; 225 } 226 i++; 227 switch ((enum dbcutopts)optindex) { 228#ifdef CONFIG_TEST 229 case DBCPUT_NODUPDATA: 230 FLAG_CHECK(flag); 231 flag = DB_NODUPDATA; 232 break; 233#endif 234 case DBCPUT_AFTER: 235 FLAG_CHECK(flag); 236 flag = DB_AFTER; 237 break; 238 case DBCPUT_BEFORE: 239 FLAG_CHECK(flag); 240 flag = DB_BEFORE; 241 break; 242 case DBCPUT_CURRENT: 243 FLAG_CHECK(flag); 244 flag = DB_CURRENT; 245 break; 246 case DBCPUT_KEYFIRST: 247 FLAG_CHECK(flag); 248 flag = DB_KEYFIRST; 249 break; 250 case DBCPUT_KEYLAST: 251 FLAG_CHECK(flag); 252 flag = DB_KEYLAST; 253 break; 254 case DBCPUT_OVERWRITE_DUP: 255 FLAG_CHECK(flag); 256 flag = DB_OVERWRITE_DUP; 257 break; 258 case DBCPUT_PART: 259 if (i > (objc - 2)) { 260 Tcl_WrongNumArgs(interp, 2, objv, 261 "?-partial {offset length}?"); 262 result = TCL_ERROR; 263 break; 264 } 265 /* 266 * Get sublist as {offset length} 267 */ 268 result = Tcl_ListObjGetElements(interp, objv[i++], 269 &elemc, &elemv); 270 if (elemc != 2) { 271 Tcl_SetResult(interp, 272 "List must be {offset length}", TCL_STATIC); 273 result = TCL_ERROR; 274 break; 275 } 276 data.flags |= DB_DBT_PARTIAL; 277 result = _GetUInt32(interp, elemv[0], &data.doff); 278 if (result != TCL_OK) 279 break; 280 result = _GetUInt32(interp, elemv[1], &data.dlen); 281 /* 282 * NOTE: We don't check result here because all we'd 283 * do is break anyway, and we are doing that. If you 284 * add code here, you WILL need to add the check 285 * for result. (See the check for save.doff, a few 286 * lines above and copy that.) 287 */ 288 } 289 if (result != TCL_OK) 290 break; 291 } 292 if (result != TCL_OK) 293 goto out; 294 295 /* 296 * We need to determine if we are a recno database or not. If we are, 297 * then key.data is a recno, not a string. 298 */ 299 dbcip = _PtrToInfo(dbc); 300 if (dbcip == NULL) 301 type = DB_UNKNOWN; 302 else { 303 dbip = dbcip->i_parent; 304 if (dbip == NULL) { 305 Tcl_SetResult(interp, "Cursor without parent database", 306 TCL_STATIC); 307 result = TCL_ERROR; 308 return (result); 309 } 310 thisdbp = dbip->i_dbp; 311 (void)thisdbp->get_type(thisdbp, &type); 312 } 313 /* 314 * When we get here, we better have: 315 * 1 arg if -after, -before or -current 316 * 2 args in all other cases 317 */ 318 if (flag == DB_AFTER || flag == DB_BEFORE || flag == DB_CURRENT) { 319 if (i != (objc - 1)) { 320 Tcl_WrongNumArgs(interp, 2, objv, 321 "?-args? data"); 322 result = TCL_ERROR; 323 goto out; 324 } 325 /* 326 * We want to get the key back, so we need to set 327 * up the location to get it back in. 328 */ 329 if (type == DB_RECNO || type == DB_QUEUE) { 330 recno = 0; 331 key.data = &recno; 332 key.size = sizeof(db_recno_t); 333 } 334 } else { 335 if (i != (objc - 2)) { 336 Tcl_WrongNumArgs(interp, 2, objv, 337 "?-args? key data"); 338 result = TCL_ERROR; 339 goto out; 340 } 341 if (type == DB_RECNO || type == DB_QUEUE) { 342 result = _GetUInt32(interp, objv[objc-2], &recno); 343 if (result == TCL_OK) { 344 key.data = &recno; 345 key.size = sizeof(db_recno_t); 346 } else 347 return (result); 348 } else { 349 ret = _CopyObjBytes(interp, objv[objc-2], &ktmp, 350 &key.size, &freekey); 351 if (ret != 0) { 352 result = _ReturnSetup(interp, ret, 353 DB_RETOK_DBCPUT(ret), "dbc put"); 354 return (result); 355 } 356 key.data = ktmp; 357 } 358 } 359 ret = _CopyObjBytes(interp, objv[objc-1], &dtmp, 360 &data.size, &freedata); 361 data.data = dtmp; 362 if (ret != 0) { 363 result = _ReturnSetup(interp, ret, 364 DB_RETOK_DBCPUT(ret), "dbc put"); 365 goto out; 366 } 367 _debug_check(); 368 ret = dbc->put(dbc, &key, &data, flag); 369 result = _ReturnSetup(interp, ret, DB_RETOK_DBCPUT(ret), 370 "dbc put"); 371 if (ret == 0 && 372 (flag == DB_AFTER || flag == DB_BEFORE) && type == DB_RECNO) { 373 res = Tcl_NewWideIntObj((Tcl_WideInt)*(db_recno_t *)key.data); 374 Tcl_SetObjResult(interp, res); 375 } 376out: 377 if (freedata) 378 __os_free(NULL, dtmp); 379 if (freekey) 380 __os_free(NULL, ktmp); 381 return (result); 382} 383 384/* 385 * tcl_dbc_get -- 386 */ 387static int 388tcl_DbcGet(interp, objc, objv, dbc, ispget) 389 Tcl_Interp *interp; /* Interpreter */ 390 int objc; /* How many arguments? */ 391 Tcl_Obj *CONST objv[]; /* The argument objects */ 392 DBC *dbc; /* Cursor pointer */ 393 int ispget; /* 1 for pget, 0 for get */ 394{ 395 static const char *dbcgetopts[] = { 396#ifdef CONFIG_TEST 397 "-data_buf_size", 398 "-get_both_range", 399 "-key_buf_size", 400 "-multi", 401 "-multi_key", 402 "-nolease", 403 "-read_committed", 404 "-read_uncommitted", 405#endif 406 "-current", 407 "-first", 408 "-get_both", 409 "-get_recno", 410 "-join_item", 411 "-last", 412 "-next", 413 "-nextdup", 414 "-nextnodup", 415 "-partial", 416 "-prev", 417 "-prevdup", 418 "-prevnodup", 419 "-rmw", 420 "-set", 421 "-set_range", 422 "-set_recno", 423 NULL 424 }; 425 enum dbcgetopts { 426#ifdef CONFIG_TEST 427 DBCGET_DATA_BUF_SIZE, 428 DBCGET_BOTH_RANGE, 429 DBCGET_KEY_BUF_SIZE, 430 DBCGET_MULTI, 431 DBCGET_MULTI_KEY, 432 DBCGET_NOLEASE, 433 DBCGET_READ_COMMITTED, 434 DBCGET_READ_UNCOMMITTED, 435#endif 436 DBCGET_CURRENT, 437 DBCGET_FIRST, 438 DBCGET_BOTH, 439 DBCGET_RECNO, 440 DBCGET_JOIN, 441 DBCGET_LAST, 442 DBCGET_NEXT, 443 DBCGET_NEXTDUP, 444 DBCGET_NEXTNODUP, 445 DBCGET_PART, 446 DBCGET_PREV, 447 DBCGET_PREVDUP, 448 DBCGET_PREVNODUP, 449 DBCGET_RMW, 450 DBCGET_SET, 451 DBCGET_SETRANGE, 452 DBCGET_SETRECNO 453 }; 454 DB *thisdbp; 455 DBT key, data, pdata; 456 DBTCL_INFO *dbcip, *dbip; 457 DBTYPE ptype, type; 458 Tcl_Obj **elemv, *myobj, *retlist; 459 void *dtmp, *ktmp; 460 db_recno_t precno, recno; 461 u_int32_t flag, op; 462 int elemc, freekey, freedata, i, optindex, result, ret; 463#ifdef CONFIG_TEST 464 int data_buf_size, key_buf_size; 465 466 data_buf_size = key_buf_size = 0; 467#endif 468 COMPQUIET(dtmp, NULL); 469 COMPQUIET(ktmp, NULL); 470 471 result = TCL_OK; 472 flag = 0; 473 freekey = freedata = 0; 474 memset(&key, 0, sizeof(key)); 475 memset(&data, 0, sizeof(data)); 476 memset(&pdata, 0, sizeof(DBT)); 477 478 if (objc < 2) { 479 Tcl_WrongNumArgs(interp, 2, objv, "?-args? ?key?"); 480 return (TCL_ERROR); 481 } 482 483 /* 484 * Get the command name index from the object based on the options 485 * defined above. 486 */ 487 i = 2; 488 while (i < objc) { 489 if (Tcl_GetIndexFromObj(interp, objv[i], dbcgetopts, 490 "option", TCL_EXACT, &optindex) != TCL_OK) { 491 /* 492 * Reset the result so we don't get 493 * an errant error message if there is another error. 494 */ 495 if (IS_HELP(objv[i]) == TCL_OK) { 496 result = TCL_OK; 497 goto out; 498 } 499 Tcl_ResetResult(interp); 500 break; 501 } 502 i++; 503 504#define FLAG_CHECK2_STDARG \ 505 (DB_RMW | DB_MULTIPLE | DB_MULTIPLE_KEY | DB_IGNORE_LEASE | \ 506 DB_READ_UNCOMMITTED | DB_READ_COMMITTED) 507 508 switch ((enum dbcgetopts)optindex) { 509#ifdef CONFIG_TEST 510 case DBCGET_DATA_BUF_SIZE: 511 result = 512 Tcl_GetIntFromObj(interp, objv[i], &data_buf_size); 513 if (result != TCL_OK) 514 goto out; 515 i++; 516 break; 517 case DBCGET_BOTH_RANGE: 518 FLAG_CHECK2(flag, FLAG_CHECK2_STDARG); 519 flag |= DB_GET_BOTH_RANGE; 520 break; 521 case DBCGET_KEY_BUF_SIZE: 522 result = 523 Tcl_GetIntFromObj(interp, objv[i], &key_buf_size); 524 if (result != TCL_OK) 525 goto out; 526 i++; 527 break; 528 case DBCGET_MULTI: 529 flag |= DB_MULTIPLE; 530 result = 531 Tcl_GetIntFromObj(interp, objv[i], &data_buf_size); 532 if (result != TCL_OK) 533 goto out; 534 i++; 535 break; 536 case DBCGET_MULTI_KEY: 537 flag |= DB_MULTIPLE_KEY; 538 result = 539 Tcl_GetIntFromObj(interp, objv[i], &data_buf_size); 540 if (result != TCL_OK) 541 goto out; 542 i++; 543 break; 544 case DBCGET_NOLEASE: 545 flag |= DB_IGNORE_LEASE; 546 break; 547 case DBCGET_READ_COMMITTED: 548 flag |= DB_READ_COMMITTED; 549 break; 550 case DBCGET_READ_UNCOMMITTED: 551 flag |= DB_READ_UNCOMMITTED; 552 break; 553#endif 554 case DBCGET_RMW: 555 flag |= DB_RMW; 556 break; 557 case DBCGET_CURRENT: 558 FLAG_CHECK2(flag, FLAG_CHECK2_STDARG); 559 flag |= DB_CURRENT; 560 break; 561 case DBCGET_FIRST: 562 FLAG_CHECK2(flag, FLAG_CHECK2_STDARG); 563 flag |= DB_FIRST; 564 break; 565 case DBCGET_LAST: 566 FLAG_CHECK2(flag, FLAG_CHECK2_STDARG); 567 flag |= DB_LAST; 568 break; 569 case DBCGET_NEXT: 570 FLAG_CHECK2(flag, FLAG_CHECK2_STDARG); 571 flag |= DB_NEXT; 572 break; 573 case DBCGET_PREV: 574 FLAG_CHECK2(flag, FLAG_CHECK2_STDARG); 575 flag |= DB_PREV; 576 break; 577 case DBCGET_PREVDUP: 578 FLAG_CHECK2(flag, FLAG_CHECK2_STDARG); 579 flag |= DB_PREV_DUP; 580 break; 581 case DBCGET_PREVNODUP: 582 FLAG_CHECK2(flag, FLAG_CHECK2_STDARG); 583 flag |= DB_PREV_NODUP; 584 break; 585 case DBCGET_NEXTNODUP: 586 FLAG_CHECK2(flag, FLAG_CHECK2_STDARG); 587 flag |= DB_NEXT_NODUP; 588 break; 589 case DBCGET_NEXTDUP: 590 FLAG_CHECK2(flag, FLAG_CHECK2_STDARG); 591 flag |= DB_NEXT_DUP; 592 break; 593 case DBCGET_BOTH: 594 FLAG_CHECK2(flag, FLAG_CHECK2_STDARG); 595 flag |= DB_GET_BOTH; 596 break; 597 case DBCGET_RECNO: 598 FLAG_CHECK2(flag, FLAG_CHECK2_STDARG); 599 flag |= DB_GET_RECNO; 600 break; 601 case DBCGET_JOIN: 602 FLAG_CHECK2(flag, FLAG_CHECK2_STDARG); 603 flag |= DB_JOIN_ITEM; 604 break; 605 case DBCGET_SET: 606 FLAG_CHECK2(flag, FLAG_CHECK2_STDARG); 607 flag |= DB_SET; 608 break; 609 case DBCGET_SETRANGE: 610 FLAG_CHECK2(flag, FLAG_CHECK2_STDARG); 611 flag |= DB_SET_RANGE; 612 break; 613 case DBCGET_SETRECNO: 614 FLAG_CHECK2(flag, FLAG_CHECK2_STDARG); 615 flag |= DB_SET_RECNO; 616 break; 617 case DBCGET_PART: 618 if (i == objc) { 619 Tcl_WrongNumArgs(interp, 2, objv, 620 "?-partial {offset length}?"); 621 result = TCL_ERROR; 622 break; 623 } 624 /* 625 * Get sublist as {offset length} 626 */ 627 result = Tcl_ListObjGetElements(interp, objv[i++], 628 &elemc, &elemv); 629 if (elemc != 2) { 630 Tcl_SetResult(interp, 631 "List must be {offset length}", TCL_STATIC); 632 result = TCL_ERROR; 633 break; 634 } 635 data.flags |= DB_DBT_PARTIAL; 636 result = _GetUInt32(interp, elemv[0], &data.doff); 637 if (result != TCL_OK) 638 break; 639 result = _GetUInt32(interp, elemv[1], &data.dlen); 640 /* 641 * NOTE: We don't check result here because all we'd 642 * do is break anyway, and we are doing that. If you 643 * add code here, you WILL need to add the check 644 * for result. (See the check for save.doff, a few 645 * lines above and copy that.) 646 */ 647 break; 648 } 649 if (result != TCL_OK) 650 break; 651 } 652 if (result != TCL_OK) 653 goto out; 654 655 /* 656 * We need to determine if we are a recno database 657 * or not. If we are, then key.data is a recno, not 658 * a string. 659 */ 660 dbcip = _PtrToInfo(dbc); 661 if (dbcip == NULL) { 662 type = DB_UNKNOWN; 663 ptype = DB_UNKNOWN; 664 } else { 665 dbip = dbcip->i_parent; 666 if (dbip == NULL) { 667 Tcl_SetResult(interp, "Cursor without parent database", 668 TCL_STATIC); 669 result = TCL_ERROR; 670 goto out; 671 } 672 thisdbp = dbip->i_dbp; 673 (void)thisdbp->get_type(thisdbp, &type); 674 if (ispget && thisdbp->s_primary != NULL) 675 (void)thisdbp-> 676 s_primary->get_type(thisdbp->s_primary, &ptype); 677 else 678 ptype = DB_UNKNOWN; 679 } 680 /* 681 * When we get here, we better have: 682 * 2 args, key and data if GET_BOTH/GET_BOTH_RANGE was specified. 683 * 1 arg if -set, -set_range or -set_recno 684 * 0 in all other cases. 685 */ 686 op = flag & DB_OPFLAGS_MASK; 687 switch (op) { 688 case DB_GET_BOTH: 689#ifdef CONFIG_TEST 690 case DB_GET_BOTH_RANGE: 691#endif 692 if (i != (objc - 2)) { 693 Tcl_WrongNumArgs(interp, 2, objv, 694 "?-args? -get_both key data"); 695 result = TCL_ERROR; 696 goto out; 697 } else { 698 if (type == DB_RECNO || type == DB_QUEUE) { 699 result = _GetUInt32( 700 interp, objv[objc-2], &recno); 701 if (result == TCL_OK) { 702 key.data = &recno; 703 key.size = sizeof(db_recno_t); 704 } else 705 goto out; 706 } else { 707 /* 708 * Some get calls (SET_*) can change the 709 * key pointers. So, we need to store 710 * the allocated key space in a tmp. 711 */ 712 ret = _CopyObjBytes(interp, objv[objc-2], 713 &ktmp, &key.size, &freekey); 714 if (ret != 0) { 715 result = _ReturnSetup(interp, ret, 716 DB_RETOK_DBCGET(ret), "dbc get"); 717 return (result); 718 } 719 key.data = ktmp; 720 } 721 if (ptype == DB_RECNO || ptype == DB_QUEUE) { 722 result = _GetUInt32( 723 interp, objv[objc-1], &precno); 724 if (result == TCL_OK) { 725 data.data = &precno; 726 data.size = sizeof(db_recno_t); 727 } else 728 goto out; 729 } else { 730 ret = _CopyObjBytes(interp, objv[objc-1], 731 &dtmp, &data.size, &freedata); 732 if (ret != 0) { 733 result = _ReturnSetup(interp, ret, 734 DB_RETOK_DBCGET(ret), "dbc get"); 735 goto out; 736 } 737 data.data = dtmp; 738 } 739 } 740 break; 741 case DB_SET: 742 case DB_SET_RANGE: 743 case DB_SET_RECNO: 744 if (i != (objc - 1)) { 745 Tcl_WrongNumArgs(interp, 2, objv, "?-args? key"); 746 result = TCL_ERROR; 747 goto out; 748 } 749#ifdef CONFIG_TEST 750 if (data_buf_size != 0) { 751 (void)__os_malloc( 752 NULL, (size_t)data_buf_size, &data.data); 753 data.ulen = (u_int32_t)data_buf_size; 754 data.flags |= DB_DBT_USERMEM; 755 } else 756#endif 757 data.flags |= DB_DBT_MALLOC; 758 if (op == DB_SET_RECNO || 759 type == DB_RECNO || type == DB_QUEUE) { 760 result = _GetUInt32(interp, objv[objc - 1], &recno); 761 key.data = &recno; 762 key.size = sizeof(db_recno_t); 763 } else { 764 /* 765 * Some get calls (SET_*) can change the 766 * key pointers. So, we need to store 767 * the allocated key space in a tmp. 768 */ 769 ret = _CopyObjBytes(interp, objv[objc-1], 770 &ktmp, &key.size, &freekey); 771 if (ret != 0) { 772 result = _ReturnSetup(interp, ret, 773 DB_RETOK_DBCGET(ret), "dbc get"); 774 return (result); 775 } 776 key.data = ktmp; 777 } 778 break; 779 default: 780 if (i != objc) { 781 Tcl_WrongNumArgs(interp, 2, objv, "?-args?"); 782 result = TCL_ERROR; 783 goto out; 784 } 785#ifdef CONFIG_TEST 786 if (key_buf_size != 0) { 787 (void)__os_malloc( 788 NULL, (size_t)key_buf_size, &key.data); 789 key.ulen = (u_int32_t)key_buf_size; 790 key.flags |= DB_DBT_USERMEM; 791 } else 792#endif 793 key.flags |= DB_DBT_MALLOC; 794#ifdef CONFIG_TEST 795 if (data_buf_size != 0) { 796 (void)__os_malloc( 797 NULL, (size_t)data_buf_size, &data.data); 798 data.ulen = (u_int32_t)data_buf_size; 799 data.flags |= DB_DBT_USERMEM; 800 } else 801#endif 802 data.flags |= DB_DBT_MALLOC; 803 } 804 805 _debug_check(); 806 if (ispget) { 807 F_SET(&pdata, DB_DBT_MALLOC); 808 ret = dbc->pget(dbc, &key, &data, &pdata, flag); 809 } else 810 ret = dbc->get(dbc, &key, &data, flag); 811 result = _ReturnSetup(interp, ret, DB_RETOK_DBCGET(ret), "dbc get"); 812 if (result == TCL_ERROR) 813 goto out; 814 815 retlist = Tcl_NewListObj(0, NULL); 816 if (ret != 0) 817 goto out1; 818 if (op == DB_GET_RECNO) { 819 recno = *((db_recno_t *)data.data); 820 myobj = Tcl_NewWideIntObj((Tcl_WideInt)recno); 821 result = Tcl_ListObjAppendElement(interp, retlist, myobj); 822 } else { 823 if (flag & (DB_MULTIPLE|DB_MULTIPLE_KEY)) 824 result = _SetMultiList(interp, 825 retlist, &key, &data, type, flag); 826 else if ((type == DB_RECNO || type == DB_QUEUE) && 827 key.data != NULL) { 828 if (ispget) 829 result = _Set3DBTList(interp, retlist, &key, 1, 830 &data, 831 (ptype == DB_RECNO || ptype == DB_QUEUE), 832 &pdata); 833 else 834 result = _SetListRecnoElem(interp, retlist, 835 *(db_recno_t *)key.data, 836 data.data, data.size); 837 } else { 838 if (ispget) 839 result = _Set3DBTList(interp, retlist, &key, 0, 840 &data, 841 (ptype == DB_RECNO || ptype == DB_QUEUE), 842 &pdata); 843 else 844 result = _SetListElem(interp, retlist, 845 key.data, key.size, data.data, data.size); 846 } 847 } 848out1: 849 if (result == TCL_OK) 850 Tcl_SetObjResult(interp, retlist); 851 /* 852 * If DB_DBT_MALLOC is set we need to free if DB allocated anything. 853 * If DB_DBT_USERMEM is set we need to free it because 854 * we allocated it (for data_buf_size/key_buf_size). That 855 * allocation does not apply to the pdata DBT. 856 */ 857out: 858 if (key.data != NULL && F_ISSET(&key, DB_DBT_MALLOC)) 859 __os_ufree(dbc->env, key.data); 860 if (key.data != NULL && F_ISSET(&key, DB_DBT_USERMEM)) 861 __os_free(dbc->env, key.data); 862 if (data.data != NULL && F_ISSET(&data, DB_DBT_MALLOC)) 863 __os_ufree(dbc->env, data.data); 864 if (data.data != NULL && F_ISSET(&data, DB_DBT_USERMEM)) 865 __os_free(dbc->env, data.data); 866 if (pdata.data != NULL && F_ISSET(&pdata, DB_DBT_MALLOC)) 867 __os_ufree(dbc->env, pdata.data); 868 if (freedata) 869 __os_free(NULL, dtmp); 870 if (freekey) 871 __os_free(NULL, ktmp); 872 return (result); 873 874} 875 876/* 877 * tcl_DbcCompare -- 878 */ 879static int 880tcl_DbcCompare(interp, objc, objv, dbc) 881 Tcl_Interp *interp; /* Interpreter */ 882 int objc; /* How many arguments? */ 883 Tcl_Obj *CONST objv[]; /* The argument objects */ 884 DBC *dbc; /* Cursor pointer */ 885{ 886 DBC *odbc; 887 DBTCL_INFO *dbcip, *dbip; 888 Tcl_Obj *res; 889 int cmp_res, result, ret; 890 char *arg, msg[MSG_SIZE]; 891 892 result = TCL_OK; 893 res = NULL; 894 895 if (objc != 3) { 896 Tcl_WrongNumArgs(interp, 3, objv, "?-args?"); 897 return (TCL_ERROR); 898 } 899 900 dbcip = _PtrToInfo(dbc); 901 if (dbcip == NULL) { 902 Tcl_SetResult(interp, "Cursor without info structure", 903 TCL_STATIC); 904 result = TCL_ERROR; 905 goto out; 906 } else { 907 dbip = dbcip->i_parent; 908 if (dbip == NULL) { 909 Tcl_SetResult(interp, "Cursor without parent database", 910 TCL_STATIC); 911 result = TCL_ERROR; 912 goto out; 913 } 914 } 915 /* 916 * When we get here, we better have: 917 * 2 args one DBC and an int address for the result 918 */ 919 arg = Tcl_GetStringFromObj(objv[2], NULL); 920 odbc = NAME_TO_DBC(arg); 921 if (odbc == NULL) { 922 snprintf(msg, MSG_SIZE, 923 "Cmp: Invalid cursor: %s\n", arg); 924 Tcl_SetResult(interp, msg, TCL_VOLATILE); 925 result = TCL_ERROR; 926 goto out; 927 } 928 929 ret = dbc->cmp(dbc, odbc, &cmp_res, 0); 930 if (ret != 0) { 931 result = _ReturnSetup(interp, ret, 932 DB_RETOK_STD(ret), "dbc cmp"); 933 return (result); 934 } 935 res = Tcl_NewIntObj(cmp_res); 936 Tcl_SetObjResult(interp, res); 937out: 938 return (result); 939 940} 941 942/* 943 * tcl_DbcDup -- 944 */ 945static int 946tcl_DbcDup(interp, objc, objv, dbc) 947 Tcl_Interp *interp; /* Interpreter */ 948 int objc; /* How many arguments? */ 949 Tcl_Obj *CONST objv[]; /* The argument objects */ 950 DBC *dbc; /* Cursor pointer */ 951{ 952 static const char *dbcdupopts[] = { 953 "-position", 954 NULL 955 }; 956 enum dbcdupopts { 957 DBCDUP_POS 958 }; 959 DBC *newdbc; 960 DBTCL_INFO *dbcip, *newdbcip, *dbip; 961 Tcl_Obj *res; 962 u_int32_t flag; 963 int i, optindex, result, ret; 964 char newname[MSG_SIZE]; 965 966 result = TCL_OK; 967 flag = 0; 968 res = NULL; 969 970 if (objc < 2) { 971 Tcl_WrongNumArgs(interp, 2, objv, "?-args?"); 972 return (TCL_ERROR); 973 } 974 975 /* 976 * Get the command name index from the object based on the options 977 * defined above. 978 */ 979 i = 2; 980 while (i < objc) { 981 if (Tcl_GetIndexFromObj(interp, objv[i], dbcdupopts, 982 "option", TCL_EXACT, &optindex) != TCL_OK) { 983 /* 984 * Reset the result so we don't get 985 * an errant error message if there is another error. 986 */ 987 if (IS_HELP(objv[i]) == TCL_OK) { 988 result = TCL_OK; 989 goto out; 990 } 991 Tcl_ResetResult(interp); 992 break; 993 } 994 i++; 995 switch ((enum dbcdupopts)optindex) { 996 case DBCDUP_POS: 997 flag = DB_POSITION; 998 break; 999 } 1000 if (result != TCL_OK) 1001 break; 1002 } 1003 if (result != TCL_OK) 1004 goto out; 1005 1006 /* 1007 * We need to determine if we are a recno database 1008 * or not. If we are, then key.data is a recno, not 1009 * a string. 1010 */ 1011 dbcip = _PtrToInfo(dbc); 1012 if (dbcip == NULL) { 1013 Tcl_SetResult(interp, "Cursor without info structure", 1014 TCL_STATIC); 1015 result = TCL_ERROR; 1016 goto out; 1017 } else { 1018 dbip = dbcip->i_parent; 1019 if (dbip == NULL) { 1020 Tcl_SetResult(interp, "Cursor without parent database", 1021 TCL_STATIC); 1022 result = TCL_ERROR; 1023 goto out; 1024 } 1025 } 1026 /* 1027 * Now duplicate the cursor. If successful, we need to create 1028 * a new cursor command. 1029 */ 1030 snprintf(newname, sizeof(newname), 1031 "%s.c%d", dbip->i_name, dbip->i_dbdbcid); 1032 newdbcip = _NewInfo(interp, NULL, newname, I_DBC); 1033 if (newdbcip != NULL) { 1034 ret = dbc->dup(dbc, &newdbc, flag); 1035 if (ret == 0) { 1036 dbip->i_dbdbcid++; 1037 newdbcip->i_parent = dbip; 1038 (void)Tcl_CreateObjCommand(interp, newname, 1039 (Tcl_ObjCmdProc *)dbc_Cmd, 1040 (ClientData)newdbc, NULL); 1041 res = NewStringObj(newname, strlen(newname)); 1042 _SetInfoData(newdbcip, newdbc); 1043 Tcl_SetObjResult(interp, res); 1044 } else { 1045 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 1046 "db dup"); 1047 _DeleteInfo(newdbcip); 1048 } 1049 } else { 1050 Tcl_SetResult(interp, "Could not set up info", TCL_STATIC); 1051 result = TCL_ERROR; 1052 } 1053out: 1054 return (result); 1055 1056} 1057