1/* 2 * tclXfilescan.c -- 3 * 4 * Tcl file scanning: regular expression matching on lines of a file. 5 * Implements awk. 6 *----------------------------------------------------------------------------- 7 * Copyright 1991-1999 Karl Lehenbauer and Mark Diekhans. 8 * 9 * Permission to use, copy, modify, and distribute this software and its 10 * documentation for any purpose and without fee is hereby granted, provided 11 * that the above copyright notice appear in all copies. Karl Lehenbauer and 12 * Mark Diekhans make no representations about the suitability of this 13 * software for any purpose. It is provided "as is" without express or 14 * implied warranty. 15 *----------------------------------------------------------------------------- 16 * $Id: tclXfilescan.c,v 1.4 2005/04/26 20:01:33 hobbs Exp $ 17 *----------------------------------------------------------------------------- 18 */ 19 20#include "tclExtdInt.h" 21 22/* 23 * A scan context describes a collection of match patterns and commands, 24 * along with a match default command to apply to a file on a scan. 25 */ 26 27typedef struct matchDef_t { 28 Tcl_RegExp regExp; 29 Tcl_Obj *regExpObj; 30 Tcl_Obj *command; 31 struct matchDef_t *nextMatchDefPtr; 32} matchDef_t; 33 34typedef struct scanContext_t { 35 matchDef_t *matchListHead; 36 matchDef_t *matchListTail; 37 Tcl_Obj *defaultAction; 38 char contextHandle [16]; 39 Tcl_Channel copyFileChannel; 40 int fileOpen; 41} scanContext_t; 42 43/* 44 * Data kept on a specific scan. 45 */ 46typedef struct { 47 int storedLine; /* Has the current line been stored in 48 matchInfo? */ 49 scanContext_t *contextPtr; /* Current scan context. */ 50 Tcl_Channel channel; /* The channel being scanned. */ 51 char *line; /* The line from the file. */ 52 Tcl_UniChar *uniLine; /* UniCode (wide) char line. */ 53 int uniLineLen; 54 off_t offset; /* The offset into the file. */ 55 long bytesRead; /* Number of translated bytes read.*/ 56 long lineNum; /* Current scanned line in the file. */ 57 matchDef_t *matchPtr; /* The current match, or NULL for the 58 default. */ 59} scanData_t; 60 61/* 62 * Prototypes of internal functions. 63 */ 64static void 65CleanUpContext _ANSI_ARGS_((void_pt scanTablePtr, 66 scanContext_t *contextPtr)); 67 68static int 69ScanContextCreate _ANSI_ARGS_((Tcl_Interp *interp, 70 void_pt scanTablePtr)); 71 72static int 73ScanContextDelete _ANSI_ARGS_((Tcl_Interp *interp, 74 void_pt scanTablePtr, 75 Tcl_Obj *contextHandleObj)); 76 77static int 78ScanContextCopyFile _ANSI_ARGS_((Tcl_Interp *interp, 79 void_pt scanTablePtr, 80 Tcl_Obj *contextHandleObj, 81 Tcl_Obj *fileHandleObj)); 82 83static int 84TclX_ScancontextObjCmd _ANSI_ARGS_((ClientData clientData, 85 Tcl_Interp *interp, 86 int objc, 87 Tcl_Obj *CONST objv[])); 88 89static int 90TclX_ScanmatchObjCmd _ANSI_ARGS_((ClientData clientData, 91 Tcl_Interp *interp, 92 int objc, 93 Tcl_Obj *CONST objv[])); 94 95static void 96CopyFileCloseHandler _ANSI_ARGS_((ClientData clientData)); 97 98static int 99SetCopyFileObj _ANSI_ARGS_((Tcl_Interp *interp, 100 scanContext_t *contextPtr, 101 Tcl_Obj *fileHandleObj)); 102 103static void 104ClearCopyFile _ANSI_ARGS_((scanContext_t *contextPtr)); 105 106static int 107SetMatchInfoVar _ANSI_ARGS_((Tcl_Interp *interp, 108 scanData_t *scanData)); 109 110static int 111ScanFile _ANSI_ARGS_((Tcl_Interp *interp, 112 scanContext_t *contextPtr, 113 Tcl_Channel channel)); 114 115static void 116ScanFileCloseHandler _ANSI_ARGS_((ClientData clientData)); 117 118static int 119TclX_ScanfileObjCmd _ANSI_ARGS_((ClientData clientData, 120 Tcl_Interp *interp, 121 int objc, 122 Tcl_Obj *CONST objv[])); 123 124static void 125FileScanCleanUp _ANSI_ARGS_((ClientData clientData, 126 Tcl_Interp *interp)); 127 128 129/*----------------------------------------------------------------------------- 130 * CleanUpContext -- 131 * 132 * Release all resources allocated to the specified scan context. Doesn't 133 * free the table entry. 134 *----------------------------------------------------------------------------- 135 */ 136static void 137CleanUpContext (scanTablePtr, contextPtr) 138 void_pt scanTablePtr; 139 scanContext_t *contextPtr; 140{ 141 matchDef_t *matchPtr, *oldMatchPtr; 142 143 for (matchPtr = contextPtr->matchListHead; matchPtr != NULL;) { 144 Tcl_DecrRefCount(matchPtr->regExpObj); 145 if (matchPtr->command != NULL) 146 Tcl_DecrRefCount (matchPtr->command); 147 oldMatchPtr = matchPtr; 148 matchPtr = matchPtr->nextMatchDefPtr; 149 ckfree ((char *) oldMatchPtr); 150 } 151 if (contextPtr->defaultAction != NULL) { 152 Tcl_DecrRefCount (contextPtr->defaultAction); 153 } 154 ClearCopyFile (contextPtr); 155 ckfree ((char *) contextPtr); 156} 157 158/*----------------------------------------------------------------------------- 159 * ScanContextCreate -- 160 * 161 * Create a new scan context, implements the subcommand: 162 * scancontext create 163 *----------------------------------------------------------------------------- 164 */ 165static int 166ScanContextCreate (interp, scanTablePtr) 167 Tcl_Interp *interp; 168 void_pt scanTablePtr; 169{ 170 scanContext_t *contextPtr, **tableEntryPtr; 171 172 contextPtr = (scanContext_t *) ckalloc (sizeof (scanContext_t)); 173 contextPtr->matchListHead = NULL; 174 contextPtr->matchListTail = NULL; 175 contextPtr->defaultAction = NULL; 176 contextPtr->copyFileChannel = NULL; 177 178 tableEntryPtr = (scanContext_t **) 179 TclX_HandleAlloc (scanTablePtr, 180 contextPtr->contextHandle); 181 *tableEntryPtr = contextPtr; 182 183 Tcl_SetStringObj (Tcl_GetObjResult (interp), 184 contextPtr->contextHandle, -1); 185 return TCL_OK; 186} 187 188/*----------------------------------------------------------------------------- 189 * ScanContextDelete -- 190 * 191 * Deletes the specified scan context, implements the subcommand: 192 * scancontext delete contexthandle 193 *----------------------------------------------------------------------------- 194 */ 195static int 196ScanContextDelete (interp, scanTablePtr, contextHandleObj) 197 Tcl_Interp *interp; 198 void_pt scanTablePtr; 199 Tcl_Obj *contextHandleObj; 200{ 201 scanContext_t **tableEntryPtr; 202 char *contextHandle; 203 204 contextHandle = Tcl_GetStringFromObj (contextHandleObj, NULL); 205 206 tableEntryPtr = (scanContext_t **) TclX_HandleXlate (interp, 207 scanTablePtr, 208 contextHandle); 209 if (tableEntryPtr == NULL) 210 return TCL_ERROR; 211 212 CleanUpContext (scanTablePtr, *tableEntryPtr); 213 TclX_HandleFree (scanTablePtr, tableEntryPtr); 214 215 return TCL_OK; 216} 217 218/*----------------------------------------------------------------------------- 219 * CopyFileCloseHandler -- 220 * Close handler for the copyfile. Turns off copying to the file. 221 * Parameters: 222 * o clientData (I) - Pointer to the scan context. 223 *----------------------------------------------------------------------------- 224 */ 225static void 226CopyFileCloseHandler (clientData) 227 ClientData clientData; 228{ 229 ((scanContext_t *) clientData)->copyFileChannel = NULL; 230} 231 232/*----------------------------------------------------------------------------- 233 * SetCopyFileObj -- 234 * Set the copy file handle for a context. 235 * Parameters: 236 * o interp - The Tcl interpreter, errors are returned in result. 237 * o contextPtr - Pointer to the scan context. 238 * o fileHandleObj - Object containing file handle of the copy file. 239 * Returns: 240 * TCL_OK or TCL_ERROR. 241 *----------------------------------------------------------------------------- 242 */ 243static int 244SetCopyFileObj (interp, contextPtr, fileHandleObj) 245 Tcl_Interp *interp; 246 scanContext_t *contextPtr; 247 Tcl_Obj *fileHandleObj; 248{ 249 Tcl_Channel copyFileChannel; 250 251 copyFileChannel = TclX_GetOpenChannelObj (interp, fileHandleObj, 252 TCL_WRITABLE); 253 if (copyFileChannel == NULL) 254 return TCL_ERROR; 255 256 /* 257 * Delete the old copyfile and set the new one. 258 */ 259 if (contextPtr->copyFileChannel != NULL) { 260 Tcl_DeleteCloseHandler (contextPtr->copyFileChannel, 261 CopyFileCloseHandler, 262 (ClientData) contextPtr); 263 } 264 Tcl_CreateCloseHandler (copyFileChannel, 265 CopyFileCloseHandler, 266 (ClientData) contextPtr); 267 contextPtr->copyFileChannel = copyFileChannel; 268 return TCL_OK; 269} 270 271/*----------------------------------------------------------------------------- 272 * ClearCopyFile -- 273 * Clear the copy file handle for a context. 274 * Parameters: 275 * o contextPtr (I) - Pointer to the scan context. 276 *----------------------------------------------------------------------------- 277 */ 278static void 279ClearCopyFile (contextPtr) 280 scanContext_t *contextPtr; 281{ 282 if (contextPtr->copyFileChannel != NULL) { 283 Tcl_DeleteCloseHandler (contextPtr->copyFileChannel, 284 CopyFileCloseHandler, 285 (ClientData) contextPtr); 286 contextPtr->copyFileChannel = NULL; 287 } 288} 289 290/*----------------------------------------------------------------------------- 291 * ScanContextCopyFile -- 292 * 293 * Access or set the copy file handle for the specified scan context, 294 * implements the subcommand: 295 * scancontext copyfile contexthandle ?filehandle? 296 *----------------------------------------------------------------------------- 297 */ 298static int 299ScanContextCopyFile (interp, scanTablePtr, contextHandleObj, fileHandleObj) 300 Tcl_Interp *interp; 301 void_pt scanTablePtr; 302 Tcl_Obj *contextHandleObj; 303 Tcl_Obj *fileHandleObj; 304{ 305 scanContext_t *contextPtr, **tableEntryPtr; 306 char *contextHandle; 307 308 contextHandle = Tcl_GetStringFromObj (contextHandleObj, NULL); 309 310 tableEntryPtr = (scanContext_t **) TclX_HandleXlate (interp, 311 scanTablePtr, 312 contextHandle); 313 if (tableEntryPtr == NULL) 314 return TCL_ERROR; 315 contextPtr = *tableEntryPtr; 316 317 /* 318 * Return the copy file handle if not specified. 319 */ 320 if (fileHandleObj == NULL) { 321 Tcl_SetStringObj (Tcl_GetObjResult (interp), 322 Tcl_GetChannelName (contextPtr->copyFileChannel), 323 -1); 324 return TCL_OK; 325 } 326 327 return SetCopyFileObj (interp, contextPtr, fileHandleObj); 328} 329 330 331/*----------------------------------------------------------------------------- 332 * TclX_ScancontextObjCmd -- 333 * 334 * Implements the TCL scancontext Tcl command, which has the following forms: 335 * scancontext create 336 * scancontext delete 337 *----------------------------------------------------------------------------- 338 */ 339static int 340TclX_ScancontextObjCmd (clientData, interp, objc, objv) 341 ClientData clientData; 342 Tcl_Interp *interp; 343 int objc; 344 Tcl_Obj *CONST objv[]; 345{ 346 char *command; 347 char *subCommand; 348 349 if (objc < 2) 350 return TclX_WrongArgs (interp, objv [0], "option ..."); 351 352 command = Tcl_GetStringFromObj (objv [0], NULL); 353 subCommand = Tcl_GetStringFromObj (objv [1], NULL); 354 355 /* 356 * Create a new scan context. 357 */ 358 if (STREQU (subCommand, "create")) { 359 if (objc != 2) 360 return TclX_WrongArgs (interp, objv [0], "create"); 361 362 return ScanContextCreate (interp, 363 (void_pt) clientData); 364 } 365 366 /* 367 * Delete a scan context. 368 */ 369 if (STREQU (subCommand, "delete")) { 370 if (objc != 3) 371 return TclX_WrongArgs (interp, objv [0], "delete contexthandle"); 372 373 return ScanContextDelete (interp, 374 (void_pt) clientData, 375 objv [2]); 376 } 377 378 /* 379 * Access or set the copyfile. 380 */ 381 if (STREQU (subCommand, "copyfile")) { 382 if ((objc < 3) || (objc > 4)) 383 return TclX_WrongArgs (interp, objv [0], 384 "copyfile contexthandle ?filehandle?"); 385 386 return ScanContextCopyFile (interp, 387 (void_pt) clientData, 388 objv [2], 389 (objc == 4) ? objv [3] : NULL); 390 } 391 392 TclX_AppendObjResult (interp, "invalid argument, expected one of: ", 393 "\"create\", \"delete\", or \"copyfile\"", 394 (char *) NULL); 395 return TCL_ERROR; 396} 397 398/*----------------------------------------------------------------------------- 399 * TclX_ScanmatchObjCmd -- 400 * 401 * Implements the TCL command: 402 * scanmatch ?-nocase? contexthandle ?regexp? command 403 *----------------------------------------------------------------------------- 404 */ 405static int 406TclX_ScanmatchObjCmd (clientData, interp, objc, objv) 407 ClientData clientData; 408 Tcl_Interp *interp; 409 int objc; 410 Tcl_Obj *CONST objv[]; 411{ 412 scanContext_t *contextPtr, **tableEntryPtr; 413 matchDef_t *newmatch; 414 int regExpFlags = TCL_REG_ADVANCED; 415 int firstArg = 1; 416 417 if (objc < 3) 418 goto argError; 419 420 if (STREQU (Tcl_GetStringFromObj (objv[1], NULL), "-nocase")) { 421 regExpFlags |= TCL_REG_NOCASE; 422 firstArg = 2; 423 } 424 425 /* 426 * If firstArg == 2 (-nocase), the both a regular expression and a command 427 * string must be specified, otherwise the regular expression is optional. 428 */ 429 if (((firstArg == 2) && (objc != 5)) || ((firstArg == 1) && (objc > 4))) 430 goto argError; 431 432 tableEntryPtr = (scanContext_t **) 433 TclX_HandleXlateObj (interp, 434 (void_pt) clientData, 435 objv [firstArg]); 436 if (tableEntryPtr == NULL) 437 return TCL_ERROR; 438 contextPtr = *tableEntryPtr; 439 440 /* 441 * Handle the default case (no regular expression). 442 */ 443 if (objc == 3) { 444 if (contextPtr->defaultAction) { 445 Tcl_AppendStringsToObj (Tcl_GetObjResult (interp), 446 Tcl_GetStringFromObj (objv[0], NULL), 447 ": default match already specified in this scan context", 448 (char *) NULL); 449 return TCL_ERROR; 450 } 451 Tcl_IncrRefCount (objv [2]); 452 contextPtr->defaultAction = objv [2]; 453 454 return TCL_OK; 455 } 456 457 /* 458 * Add a regular expression to the context. 459 */ 460 461 newmatch = (matchDef_t *) ckalloc(sizeof (matchDef_t)); 462 463 newmatch->regExp = (Tcl_RegExp) 464 Tcl_GetRegExpFromObj(interp, objv[firstArg + 1], regExpFlags); 465 if (newmatch->regExp == NULL) { 466 ckfree ((char *) newmatch); 467 return TCL_ERROR; 468 } 469 470 newmatch->regExpObj = objv[firstArg + 1], 471 Tcl_IncrRefCount (newmatch->regExpObj); 472 newmatch->command = objv [firstArg + 2]; 473 Tcl_IncrRefCount (newmatch->command); 474 475 /* 476 * Link in the new match. 477 */ 478 newmatch->nextMatchDefPtr = NULL; 479 if (contextPtr->matchListHead == NULL) 480 contextPtr->matchListHead = newmatch; 481 else 482 contextPtr->matchListTail->nextMatchDefPtr = newmatch; 483 contextPtr->matchListTail = newmatch; 484 485 return TCL_OK; 486 487argError: 488 return TclX_WrongArgs (interp, objv [0], 489 "?-nocase? contexthandle ?regexp? command"); 490} 491 492/*----------------------------------------------------------------------------- 493 * SetMatchInfoVar -- 494 * 495 * Sets the Tcl array variable "matchInfo" to contain information about the 496 * current match. This function is optimize to store per line information 497 * only once. 498 * 499 * Parameters: 500 * o interp - The Tcl interpreter to set the matchInfo variable in. 501 * Errors are returned in result. 502 * o scanData - Data about the current line being scanned. 503 * been stored. 504 *----------------------------------------------------------------------------- 505 */ 506static int 507SetMatchInfoVar (interp, scanData) 508 Tcl_Interp *interp; 509 scanData_t *scanData; 510{ 511 static char *MATCHINFO = "matchInfo"; 512 int idx, start, end; 513 char *value; 514 Tcl_DString valueBuf; 515 char key [32]; 516 Tcl_Obj *valueObjPtr, *indexObjv [2]; 517 Tcl_RegExpInfo regExpInfo; 518 519 Tcl_DStringInit(&valueBuf); 520 521 /* 522 * Save information about the current line, if it hasn't been saved. 523 */ 524 if (!scanData->storedLine) { 525 scanData->storedLine = TRUE; 526 527 Tcl_UnsetVar (interp, MATCHINFO, 0); 528 529 if (Tcl_SetVar2 (interp, MATCHINFO, "line", scanData->line, 530 TCL_LEAVE_ERR_MSG) == NULL) 531 goto errorExit; 532 533 valueObjPtr = Tcl_NewLongObj ((long) scanData->offset); 534 if (Tcl_SetVar2Ex(interp, MATCHINFO, "offset", valueObjPtr, 535 TCL_LEAVE_ERR_MSG) == NULL) { 536 Tcl_DecrRefCount (valueObjPtr); 537 goto errorExit; 538 } 539 540#if 0 541 /* 542 * FIX: Don't expose till we decide on semantics: Should it include the 543 * current line? All the pieces are here, include doc and tests, just 544 * disabled. 545 */ 546 valueObjPtr = Tcl_NewLongObj ((long) scanData->bytesRead); 547 if (Tcl_SetObjVar2 (interp, MATCHINFO, "bytesread", valueObjPtr, 548 TCL_LEAVE_ERR_MSG) == NULL) { 549 Tcl_DecrRefCount (valueObjPtr); 550 goto errorExit; 551 } 552#endif 553 valueObjPtr = Tcl_NewIntObj ((long) scanData->lineNum); 554 if (Tcl_SetVar2Ex(interp, MATCHINFO, "linenum", valueObjPtr, 555 TCL_LEAVE_ERR_MSG) == NULL) { 556 Tcl_DecrRefCount (valueObjPtr); 557 goto errorExit; 558 } 559 560 if (Tcl_SetVar2 (interp, MATCHINFO, "context", 561 scanData->contextPtr->contextHandle, 562 TCL_LEAVE_ERR_MSG) == NULL) 563 goto errorExit; 564 565 if (Tcl_SetVar2 (interp, MATCHINFO, "handle", 566 Tcl_GetChannelName (scanData->channel), 567 TCL_LEAVE_ERR_MSG) == NULL) 568 goto errorExit; 569 570 } 571 572 if (scanData->contextPtr->copyFileChannel != NULL) { 573 if (Tcl_SetVar2 (interp, MATCHINFO, "copyHandle", 574 Tcl_GetChannelName (scanData->contextPtr->copyFileChannel), 575 TCL_LEAVE_ERR_MSG) == NULL) 576 goto errorExit; 577 } 578 579 if (scanData->matchPtr == NULL) { 580 goto exitPoint; 581 } 582 583 Tcl_RegExpGetInfo(scanData->matchPtr->regExp, ®ExpInfo); 584 for (idx = 0; idx < regExpInfo.nsubs; idx++) { 585 start = regExpInfo.matches[idx+1].start; 586 end = regExpInfo.matches[idx+1].end; 587 588 sprintf (key, "subindex%d", idx); 589 indexObjv [0] = Tcl_NewIntObj (start); 590 if (start < 0) { 591 indexObjv [1] = Tcl_NewIntObj (-1); 592 } else { 593 indexObjv [1] = Tcl_NewIntObj (end-1); 594 } 595 valueObjPtr = Tcl_NewListObj (2, indexObjv); 596 if (Tcl_SetVar2Ex(interp, MATCHINFO, key, valueObjPtr, 597 TCL_LEAVE_ERR_MSG) == NULL) { 598 Tcl_DecrRefCount (valueObjPtr); 599 goto errorExit; 600 } 601 602 sprintf (key, "submatch%d", idx); 603 Tcl_DStringSetLength(&valueBuf, 0); 604 value = Tcl_UniCharToUtfDString(scanData->uniLine + start, end - start, 605 &valueBuf); 606 valueObjPtr = Tcl_NewStringObj(value, (end - start)); 607 608 if (Tcl_SetVar2Ex(interp, MATCHINFO, key, valueObjPtr, 609 TCL_LEAVE_ERR_MSG) == NULL) { 610 Tcl_DecrRefCount (valueObjPtr); 611 goto errorExit; 612 } 613 } 614 615 exitPoint: 616 Tcl_DStringFree(&valueBuf); 617 return TCL_OK; 618 619 errorExit: 620 Tcl_DStringFree(&valueBuf); 621 return TCL_ERROR; 622} 623 624/*----------------------------------------------------------------------------- 625 * ScanFile -- 626 * 627 * Scan a file given a scancontext. 628 *----------------------------------------------------------------------------- 629 */ 630static int 631ScanFile (interp, contextPtr, channel) 632 Tcl_Interp *interp; 633 scanContext_t *contextPtr; 634 Tcl_Channel channel; 635{ 636 Tcl_DString lineBuf, uniLineBuf; 637 int result, matchedAtLeastOne; 638 scanData_t data; 639 int matchStat; 640 641 if (contextPtr->matchListHead == NULL) { 642 TclX_AppendObjResult (interp, "no patterns in current scan context", 643 (char *) NULL); 644 return TCL_ERROR; 645 } 646 647 data.storedLine = FALSE; 648 data.contextPtr = contextPtr; 649 data.channel = channel; 650 data.bytesRead = 0; 651 data.lineNum = 0; 652 653 Tcl_DStringInit (&lineBuf); 654 Tcl_DStringInit (&uniLineBuf); 655 656 result = TCL_OK; 657 while (TRUE) { 658 if (!contextPtr->fileOpen) 659 goto scanExit; /* Closed by a callback */ 660 661 data.offset = (off_t) Tcl_Tell (channel); 662 Tcl_DStringSetLength (&lineBuf, 0); 663 if (Tcl_Gets (channel, &lineBuf) < 0) { 664 if (Tcl_Eof (channel) || Tcl_InputBlocked (channel)) 665 goto scanExit; 666 Tcl_SetStringObj (Tcl_GetObjResult (interp), 667 Tcl_PosixError (interp), -1); 668 result = TCL_ERROR; 669 goto scanExit; 670 } 671 672 673 data.line = Tcl_DStringValue(&lineBuf); 674 data.bytesRead += (lineBuf.length + 1); /* Include EOLN */ 675 data.lineNum++; 676 data.storedLine = FALSE; 677 678 /* Convert to UTF to UniCode */ 679 Tcl_DStringSetLength (&uniLineBuf, 0); 680 data.uniLine = Tcl_UtfToUniCharDString(Tcl_DStringValue(&lineBuf), 681 Tcl_DStringLength(&lineBuf), 682 &uniLineBuf); 683 data.uniLineLen = Tcl_DStringLength(&uniLineBuf) / sizeof(Tcl_UniChar); 684 685 matchedAtLeastOne = FALSE; 686 687 for (data.matchPtr = contextPtr->matchListHead; 688 data.matchPtr != NULL; 689 data.matchPtr = data.matchPtr->nextMatchDefPtr) { 690 691 matchStat = Tcl_RegExpExec(interp, 692 data.matchPtr->regExp, 693 Tcl_DStringValue(&lineBuf), 694 Tcl_DStringValue(&lineBuf)); 695 if (matchStat < 0) { 696 result = TCL_ERROR; 697 goto scanExit; 698 } 699 if (matchStat == 0) { 700 continue; /* Try next match pattern */ 701 } 702 matchedAtLeastOne = TRUE; 703 704 result = SetMatchInfoVar (interp, &data); 705 if (result != TCL_OK) 706 goto scanExit; 707 708 result = Tcl_EvalObj (interp, data.matchPtr->command); 709 if (result == TCL_ERROR) { 710 Tcl_AddObjErrorInfo (interp, 711 "\n while executing a match command", -1); 712 goto scanExit; 713 } 714 if (result == TCL_CONTINUE) { 715 /* 716 * Don't process any more matches for this line. 717 */ 718 goto matchLineExit; 719 } 720 if ((result == TCL_BREAK) || (result == TCL_RETURN)) { 721 /* 722 * Terminate scan. 723 */ 724 result = TCL_OK; 725 goto scanExit; 726 } 727 } 728 729 matchLineExit: 730 /* 731 * Process default action if required. 732 */ 733 if ((contextPtr->defaultAction != NULL) && (!matchedAtLeastOne)) { 734 data.matchPtr = NULL; 735 result = SetMatchInfoVar(interp, 736 &data); 737 if (result != TCL_OK) 738 goto scanExit; 739 740 result = Tcl_EvalObj (interp, contextPtr->defaultAction); 741 if (result == TCL_ERROR) { 742 Tcl_AddObjErrorInfo (interp, 743 "\n while executing a match default command", -1); 744 goto scanExit; 745 } 746 if ((result == TCL_BREAK) || (result == TCL_RETURN)) { 747 /* 748 * Terminate scan. 749 */ 750 result = TCL_OK; 751 goto scanExit; 752 } 753 } 754 755 if ((contextPtr->copyFileChannel != NULL) && (!matchedAtLeastOne)) { 756 if ((Tcl_Write (contextPtr->copyFileChannel, Tcl_DStringValue(&lineBuf), 757 Tcl_DStringLength(&lineBuf)) < 0) || 758 (TclX_WriteNL (contextPtr->copyFileChannel) < 0)) { 759 Tcl_SetStringObj (Tcl_GetObjResult (interp), 760 Tcl_PosixError (interp), -1); 761 return TCL_ERROR; 762 } 763 } 764 } 765 766 scanExit: 767 Tcl_DStringFree (&lineBuf); 768 Tcl_DStringFree (&uniLineBuf); 769 if (result == TCL_ERROR) 770 return TCL_ERROR; 771 return TCL_OK; 772} 773 774/*----------------------------------------------------------------------------- 775 * ScanFileCloseHandler -- 776 * Close handler for the file being scanned. Marks it as not open. 777 * Parameters: 778 * o clientData (I) - Pointer to the scan context. 779 *----------------------------------------------------------------------------- 780 */ 781static void 782ScanFileCloseHandler (clientData) 783 ClientData clientData; 784{ 785 ((scanContext_t *) clientData)->fileOpen = FALSE; 786} 787 788/*----------------------------------------------------------------------------- 789 * TclX_ScanfileObjCmd -- 790 * 791 * Implements the TCL command: 792 * scanfile ?-copyfile copyhandle? contexthandle filehandle 793 *----------------------------------------------------------------------------- 794 */ 795static int 796TclX_ScanfileObjCmd (clientData, interp, objc, objv) 797 ClientData clientData; 798 Tcl_Interp *interp; 799 int objc; 800 Tcl_Obj *CONST objv[]; 801{ 802 scanContext_t *contextPtr, **tableEntryPtr; 803 Tcl_Obj *contextHandleObj, *fileHandleObj, *copyFileHandleObj; 804 Tcl_Channel channel; 805 int status; 806 807 if ((objc != 3) && (objc != 5)) 808 goto argError; 809 810 if (objc == 3) { 811 contextHandleObj = objv [1]; 812 fileHandleObj = objv [2]; 813 copyFileHandleObj = NULL; 814 } else { 815 if (!STREQU (Tcl_GetStringFromObj (objv[1], NULL), "-copyfile")) 816 goto argError; 817 copyFileHandleObj = objv [2]; 818 contextHandleObj = objv [3]; 819 fileHandleObj = objv [4]; 820 } 821 822 tableEntryPtr = (scanContext_t **) 823 TclX_HandleXlateObj (interp, 824 (void_pt) clientData, 825 contextHandleObj); 826 if (tableEntryPtr == NULL) 827 return TCL_ERROR; 828 contextPtr = *tableEntryPtr; 829 830 channel = TclX_GetOpenChannelObj (interp, fileHandleObj, TCL_READABLE); 831 if (channel == NULL) 832 return TCL_ERROR; 833 834 if (copyFileHandleObj != NULL) { 835 if (SetCopyFileObj (interp, contextPtr, copyFileHandleObj) == TCL_ERROR) 836 return TCL_ERROR; 837 } 838 839 /* 840 * Scan the file, protecting it with a close handler. 841 * Watch for case where ScanFile may close the file during scan. 842 * [Bug 1045190] 843 */ 844 contextPtr->fileOpen = TRUE; 845 Tcl_CreateCloseHandler (channel, 846 ScanFileCloseHandler, 847 (ClientData) contextPtr); 848 status = ScanFile(interp, contextPtr, channel); 849 if (contextPtr->fileOpen == TRUE) { 850 Tcl_DeleteCloseHandler(channel, ScanFileCloseHandler, 851 (ClientData) contextPtr); 852 } 853 854 /* 855 * If we set the copyfile, disassociate it from the context. 856 */ 857 if (copyFileHandleObj != NULL) { 858 ClearCopyFile (contextPtr); 859 } 860 return status; 861 862 argError: 863 return TclX_WrongArgs (interp, objv [0], 864 "?-copyfile filehandle? contexthandle filehandle"); 865} 866 867/*----------------------------------------------------------------------------- 868 * FileScanCleanUp -- 869 * 870 * Called when the interpreter is deleted to cleanup all filescan 871 * resources 872 *----------------------------------------------------------------------------- 873 */ 874static void 875FileScanCleanUp (clientData, interp) 876 ClientData clientData; 877 Tcl_Interp *interp; 878{ 879 scanContext_t **tableEntryPtr; 880 int walkKey; 881 882 walkKey = -1; 883 while (TRUE) { 884 tableEntryPtr = 885 (scanContext_t **) TclX_HandleWalk ((void_pt) clientData, 886 &walkKey); 887 if (tableEntryPtr == NULL) 888 break; 889 CleanUpContext ((void_pt) clientData, *tableEntryPtr); 890 } 891 TclX_HandleTblRelease ((void_pt) clientData); 892} 893 894/*----------------------------------------------------------------------------- 895 * TclX_FilescanInit -- 896 * 897 * Initialize the TCL file scanning facility.. 898 *----------------------------------------------------------------------------- 899 */ 900void 901TclX_FilescanInit (interp) 902 Tcl_Interp *interp; 903{ 904 void_pt scanTablePtr; 905 906 scanTablePtr = TclX_HandleTblInit ("context", 907 sizeof (scanContext_t *), 908 10); 909 910 Tcl_CallWhenDeleted (interp, FileScanCleanUp, (ClientData) scanTablePtr); 911 912 /* 913 * Initialize the commands. 914 */ 915 Tcl_CreateObjCommand (interp, 916 "scanfile", 917 TclX_ScanfileObjCmd, 918 (ClientData) scanTablePtr, 919 (Tcl_CmdDeleteProc*) NULL); 920 921 Tcl_CreateObjCommand (interp, 922 "scanmatch", 923 TclX_ScanmatchObjCmd, 924 (ClientData) scanTablePtr, 925 (Tcl_CmdDeleteProc*) NULL); 926 927 Tcl_CreateObjCommand (interp, 928 "scancontext", 929 TclX_ScancontextObjCmd, 930 (ClientData) scanTablePtr, 931 (Tcl_CmdDeleteProc*) NULL); 932} 933 934 935 936