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
27 typedef struct matchDef_t {
28 Tcl_RegExp regExp;
29 Tcl_Obj *regExpObj;
30 Tcl_Obj *command;
31 struct matchDef_t *nextMatchDefPtr;
32 } matchDef_t;
33
34 typedef 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 */
46 typedef 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 */
64 static void
65 CleanUpContext _ANSI_ARGS_((void_pt scanTablePtr,
66 scanContext_t *contextPtr));
67
68 static int
69 ScanContextCreate _ANSI_ARGS_((Tcl_Interp *interp,
70 void_pt scanTablePtr));
71
72 static int
73 ScanContextDelete _ANSI_ARGS_((Tcl_Interp *interp,
74 void_pt scanTablePtr,
75 Tcl_Obj *contextHandleObj));
76
77 static int
78 ScanContextCopyFile _ANSI_ARGS_((Tcl_Interp *interp,
79 void_pt scanTablePtr,
80 Tcl_Obj *contextHandleObj,
81 Tcl_Obj *fileHandleObj));
82
83 static int
84 TclX_ScancontextObjCmd _ANSI_ARGS_((ClientData clientData,
85 Tcl_Interp *interp,
86 int objc,
87 Tcl_Obj *CONST objv[]));
88
89 static int
90 TclX_ScanmatchObjCmd _ANSI_ARGS_((ClientData clientData,
91 Tcl_Interp *interp,
92 int objc,
93 Tcl_Obj *CONST objv[]));
94
95 static void
96 CopyFileCloseHandler _ANSI_ARGS_((ClientData clientData));
97
98 static int
99 SetCopyFileObj _ANSI_ARGS_((Tcl_Interp *interp,
100 scanContext_t *contextPtr,
101 Tcl_Obj *fileHandleObj));
102
103 static void
104 ClearCopyFile _ANSI_ARGS_((scanContext_t *contextPtr));
105
106 static int
107 SetMatchInfoVar _ANSI_ARGS_((Tcl_Interp *interp,
108 scanData_t *scanData));
109
110 static int
111 ScanFile _ANSI_ARGS_((Tcl_Interp *interp,
112 scanContext_t *contextPtr,
113 Tcl_Channel channel));
114
115 static void
116 ScanFileCloseHandler _ANSI_ARGS_((ClientData clientData));
117
118 static int
119 TclX_ScanfileObjCmd _ANSI_ARGS_((ClientData clientData,
120 Tcl_Interp *interp,
121 int objc,
122 Tcl_Obj *CONST objv[]));
123
124 static void
125 FileScanCleanUp _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 */
136 static void
CleanUpContext(scanTablePtr,contextPtr)137 CleanUpContext (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 */
165 static int
ScanContextCreate(interp,scanTablePtr)166 ScanContextCreate (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 */
195 static int
ScanContextDelete(interp,scanTablePtr,contextHandleObj)196 ScanContextDelete (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 */
225 static void
CopyFileCloseHandler(clientData)226 CopyFileCloseHandler (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 */
243 static int
SetCopyFileObj(interp,contextPtr,fileHandleObj)244 SetCopyFileObj (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 */
278 static void
ClearCopyFile(contextPtr)279 ClearCopyFile (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 */
298 static int
ScanContextCopyFile(interp,scanTablePtr,contextHandleObj,fileHandleObj)299 ScanContextCopyFile (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 */
339 static int
TclX_ScancontextObjCmd(clientData,interp,objc,objv)340 TclX_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 */
405 static int
TclX_ScanmatchObjCmd(clientData,interp,objc,objv)406 TclX_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
487 argError:
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 */
506 static int
SetMatchInfoVar(interp,scanData)507 SetMatchInfoVar (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 */
630 static int
ScanFile(interp,contextPtr,channel)631 ScanFile (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 */
781 static void
ScanFileCloseHandler(clientData)782 ScanFileCloseHandler (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 */
795 static int
TclX_ScanfileObjCmd(clientData,interp,objc,objv)796 TclX_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 */
874 static void
FileScanCleanUp(clientData,interp)875 FileScanCleanUp (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 */
900 void
TclX_FilescanInit(interp)901 TclX_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