4 * Tcl file scanning: regular expression matching on lines of a file.
6 *-----------------------------------------------------------------------------
7 * Copyright 1992 Karl Lehenbauer and Mark Diekhans.
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
15 *-----------------------------------------------------------------------------
16 * $Id: tclXfilescan.c,v 2.0 1992/10/16 04:50:43 markd Rel $
17 *-----------------------------------------------------------------------------
24 * A scan context describes a collection of match patterns and commands,
25 * along with a match default command to apply to a file on a scan.
28 #define CONTEXT_A_CASE_INSENSITIVE_FLAG 2
29 #define MATCH_CASE_INSENSITIVE_FLAG 4
31 typedef struct matchDef_t
{
34 struct matchDef_t
*nextMatchDefPtr
;
37 typedef struct matchDef_t
*matchDef_pt
;
39 typedef struct scanContext_t
{
40 matchDef_pt matchListHead
;
41 matchDef_pt matchListTail
;
45 typedef struct scanContext_t
*scanContext_pt
;
48 * Global data structure, pointer to by clientData.
52 int useCount
; /* Commands that current share globals */
53 void_pt tblHdrPtr
; /* Scan context handle table */
54 char curName
[16]; /* Current context name. */
56 typedef scanGlob_t
*scanGlob_pt
;
59 * Prototypes of internal functions.
62 CleanUpContext
_ANSI_ARGS_((scanGlob_pt scanGlobPtr
,
63 scanContext_pt contextPtr
));
66 CreateScanContext
_ANSI_ARGS_((Tcl_Interp
*interp
,
67 scanGlob_pt scanGlobPtr
));
70 SelectScanContext
_ANSI_ARGS_((Tcl_Interp
*interp
,
71 scanGlob_pt scanGlobPtr
,
72 char *contextHandle
));
75 Tcl_Delete_scancontextCmd
_ANSI_ARGS_((Tcl_Interp
*interp
,
76 scanGlob_pt scanGlobPtr
,
77 char *contextHandle
));
80 SetMatchVar
_ANSI_ARGS_((Tcl_Interp
*interp
,
87 FileScanCleanUp
_ANSI_ARGS_((ClientData clientData
));
91 *-----------------------------------------------------------------------------
94 * Release all resources allocated to the specified scan context
95 * entry. The entry itself is not released.
96 *-----------------------------------------------------------------------------
99 CleanUpContext (scanGlobPtr
, contextPtr
)
100 scanGlob_pt scanGlobPtr
;
101 scanContext_pt contextPtr
;
103 matchDef_pt matchPtr
, oldMatchPtr
;
105 for (matchPtr
= contextPtr
->matchListHead
; matchPtr
!= NULL
;) {
106 Tcl_RegExpClean (&matchPtr
->regExpInfo
);
107 if (matchPtr
->command
!= NULL
)
108 ckfree(matchPtr
->command
);
109 oldMatchPtr
= matchPtr
;
110 matchPtr
= matchPtr
->nextMatchDefPtr
;
111 ckfree ((char *) oldMatchPtr
);
113 contextPtr
->matchListHead
= NULL
;
114 contextPtr
->matchListTail
= NULL
;
116 if (contextPtr
->defaultAction
!= NULL
) {
117 ckfree(contextPtr
->defaultAction
);
118 contextPtr
->defaultAction
= NULL
;
123 *-----------------------------------------------------------------------------
125 * CreateScanContext --
126 * Create a new scan context, implements the subcommand:
129 *-----------------------------------------------------------------------------
132 CreateScanContext (interp
, scanGlobPtr
)
134 scanGlob_pt scanGlobPtr
;
136 scanContext_pt contextPtr
;
138 contextPtr
= (scanContext_pt
)Tcl_HandleAlloc (scanGlobPtr
->tblHdrPtr
,
139 scanGlobPtr
->curName
);
140 contextPtr
->flags
= 0;
141 contextPtr
->matchListHead
= NULL
;
142 contextPtr
->matchListTail
= NULL
;
143 contextPtr
->defaultAction
= NULL
;
145 Tcl_SetResult (interp
, scanGlobPtr
->curName
, TCL_STATIC
);
150 *-----------------------------------------------------------------------------
152 * DeleteScanContext --
153 * Deletes the specified scan context, implements the subcommand:
154 * scancontext delete contexthandle
156 *-----------------------------------------------------------------------------
159 DeleteScanContext (interp
, scanGlobPtr
, contextHandle
)
161 scanGlob_pt scanGlobPtr
;
164 scanContext_pt contextPtr
;
166 if ((contextPtr
= Tcl_HandleXlate (interp
, scanGlobPtr
->tblHdrPtr
,
167 contextHandle
)) == NULL
)
170 CleanUpContext (scanGlobPtr
, contextPtr
);
171 Tcl_HandleFree (scanGlobPtr
->tblHdrPtr
, contextPtr
);
177 *-----------------------------------------------------------------------------
179 * Tcl_ScancontextCmd --
180 * Implements the TCL scancontext Tcl command, which has the
186 * Standard TCL results.
188 *-----------------------------------------------------------------------------
191 Tcl_ScancontextCmd (clientData
, interp
, argc
, argv
)
197 scanGlob_pt scanGlobPtr
= (scanGlob_pt
) clientData
;
200 Tcl_AppendResult (interp
, tclXWrongArgs
, argv
[0], " option",
205 * Create a new scan context.
207 if (STREQU (argv
[1], "create")) {
209 Tcl_AppendResult (interp
, tclXWrongArgs
, argv
[0], " create",
213 return CreateScanContext (interp
, scanGlobPtr
);
217 * Delete a scan context.
219 if (STREQU (argv
[1], "delete")) {
221 Tcl_AppendResult (interp
, tclXWrongArgs
, argv
[0],
222 "delete contexthandle", (char *) NULL
);
225 return DeleteScanContext (interp
, scanGlobPtr
, argv
[2]);
228 Tcl_AppendResult (interp
, "invalid argument, expected one of: ",
229 "create or delete", (char *) NULL
);
234 *-----------------------------------------------------------------------------
236 * Tcl_ScanmatchCmd --
237 * Implements the TCL command:
238 * scanmatch [-nocase] contexthandle [regexp] commands
239 * This uses both Boyer_Moore and regular expressions matching.
242 * Standard TCL results.
244 *-----------------------------------------------------------------------------
247 Tcl_ScanmatchCmd (clientData
, interp
, argc
, argv
)
253 scanGlob_pt scanGlobPtr
= (scanGlob_pt
) clientData
;
254 scanContext_pt contextPtr
;
256 matchDef_pt newmatch
;
257 int compFlags
= REXP_BOTH_ALGORITHMS
;
262 if (STREQU (argv
[1], "-nocase")) {
263 compFlags
|= REXP_NO_CASE
;
268 * If firstArg == 2 (-nocase), the both a regular expression and a command
269 * string must be specified, otherwise the regular expression is optional.
271 if (((firstArg
== 2) && (argc
!= 5)) || ((firstArg
== 1) && (argc
> 4)))
274 if ((contextPtr
= Tcl_HandleXlate (interp
, scanGlobPtr
->tblHdrPtr
,
275 argv
[firstArg
])) == NULL
)
279 * Handle the default case (no regular expression).
282 if (contextPtr
->defaultAction
) {
283 Tcl_AppendResult (interp
, argv
[0], ": default match already ",
284 "specified in this scan context", (char *) NULL
);
287 contextPtr
->defaultAction
= ckalloc (strlen (argv
[2]) + 1);
288 strcpy (contextPtr
->defaultAction
, argv
[2]);
294 * Add a regular expression to the context.
297 newmatch
= (matchDef_pt
) ckalloc(sizeof (matchDef_t
));
298 newmatch
->matchflags
= 0;
300 if (compFlags
& REXP_NO_CASE
) {
301 newmatch
->matchflags
|= MATCH_CASE_INSENSITIVE_FLAG
;
302 contextPtr
->flags
|= CONTEXT_A_CASE_INSENSITIVE_FLAG
;
305 if (Tcl_RegExpCompile (interp
, &newmatch
->regExpInfo
, argv
[firstArg
+ 1],
306 compFlags
) != TCL_OK
) {
307 ckfree ((char *) newmatch
);
311 newmatch
->command
= ckalloc (strlen (argv
[firstArg
+ 2]) + 1);
312 strcpy(newmatch
->command
, argv
[firstArg
+ 2]);
315 * Link in the new match.
317 newmatch
->nextMatchDefPtr
= NULL
;
318 if (contextPtr
->matchListHead
== NULL
)
319 contextPtr
->matchListHead
= newmatch
;
321 contextPtr
->matchListTail
->nextMatchDefPtr
= newmatch
;
322 contextPtr
->matchListTail
= newmatch
;
327 Tcl_AppendResult (interp
, tclXWrongArgs
, argv
[0],
328 " [-nocase] contexthandle [regexp] command",
334 *-----------------------------------------------------------------------------
337 * Sets the TCL array variable matchInfo to contain information
338 * about the line that is matched.
340 * TCL_OK if all is ok, TCL_ERROR if an error occures setting the
343 * A TCL array variable is created or altered.
345 *-----------------------------------------------------------------------------
348 SetMatchVar (interp
, fileLine
, fileOffset
, scanLineNum
, fileHandle
)
357 if (Tcl_SetVar2 (interp
, "matchInfo", "line", fileLine
,
358 TCL_LEAVE_ERR_MSG
) == NULL
)
361 sprintf (numBuf
, "%ld", fileOffset
);
362 if (Tcl_SetVar2 (interp
, "matchInfo", "offset", numBuf
,
363 TCL_LEAVE_ERR_MSG
) == NULL
)
366 sprintf (numBuf
, "%ld", scanLineNum
);
367 if (Tcl_SetVar2 (interp
, "matchInfo", "linenum", numBuf
,
368 TCL_LEAVE_ERR_MSG
) == NULL
)
371 if (Tcl_SetVar2 (interp
, "matchInfo", "handle", fileHandle
,
372 TCL_LEAVE_ERR_MSG
) == NULL
)
378 *-----------------------------------------------------------------------------
381 * Implements the TCL command:
382 * scanfile contexthandle filehandle
385 * Standard TCL results.
387 *-----------------------------------------------------------------------------
390 Tcl_ScanfileCmd (clientData
, interp
, argc
, argv
)
396 scanGlob_pt scanGlobPtr
= (scanGlob_pt
) clientData
;
397 scanContext_pt contextPtr
;
398 dynamicBuf_t dynBuf
, lowerDynBuf
;
400 matchDef_pt matchPtr
;
402 int matchedAtLeastOne
;
405 long scanLineNum
= 0;
408 if ((argc
< 2) || (argc
> 3)) {
409 Tcl_AppendResult (interp
, tclXWrongArgs
, argv
[0],
410 " contexthandle filehandle", (char *) NULL
);
413 if ((contextPtr
= Tcl_HandleXlate (interp
, scanGlobPtr
->tblHdrPtr
,
417 if (TclGetOpenFile (interp
, argv
[2], &filePtr
) != TCL_OK
)
420 if (contextPtr
->matchListHead
== NULL
) {
421 Tcl_AppendResult (interp
, "no patterns in current scan context",
426 Tcl_DynBufInit (&dynBuf
);
427 Tcl_DynBufInit (&lowerDynBuf
);
429 result
= TCL_OK
; /* Assume the best */
431 fileOffset
= ftell (filePtr
->f
); /* Get starting offset */
433 while ((result
== TCL_OK
)) {
434 int storedThisLine
= FALSE
;
436 switch (Tcl_DynamicFgets (&dynBuf
, filePtr
->f
, FALSE
)) {
438 interp
->result
= Tcl_UnixError (interp
);
445 matchOffset
= fileOffset
;
446 fileOffset
+= strlen(dynBuf
.ptr
) + 1;
448 matchedAtLeastOne
= 0;
449 if (contextPtr
->flags
& CONTEXT_A_CASE_INSENSITIVE_FLAG
) {
451 Tcl_DynBufAppend (&lowerDynBuf
, dynBuf
.ptr
);
452 Tcl_DownShift (lowerDynBuf
.ptr
, lowerDynBuf
.ptr
);
454 for (matchPtr
= contextPtr
->matchListHead
; matchPtr
!= NULL
;
455 matchPtr
= matchPtr
->nextMatchDefPtr
) {
457 if (!Tcl_RegExpExecute (interp
, &matchPtr
->regExpInfo
, dynBuf
.ptr
,
459 continue; /* Try next match pattern */
461 matchedAtLeastOne
= TRUE
;
462 if (!storedThisLine
) {
463 result
= SetMatchVar (interp
, dynBuf
.ptr
, matchOffset
,
464 scanLineNum
, argv
[2]);
465 if (result
!= TCL_OK
)
467 storedThisLine
= TRUE
;
470 result
= Tcl_Eval(interp
, matchPtr
->command
, 0, (char **)NULL
);
471 if (result
== TCL_ERROR
) {
472 Tcl_AddErrorInfo (interp
,
473 "\n while executing a match command");
476 if (result
== TCL_CONTINUE
) {
478 * Don't process any more matches for this line.
483 if (result
== TCL_BREAK
) {
494 * Process default action if required.
496 if ((contextPtr
->defaultAction
!= NULL
) && (!matchedAtLeastOne
)) {
498 result
= SetMatchVar (interp
, dynBuf
.ptr
, matchOffset
,
499 scanLineNum
, argv
[2]);
500 if (result
!= TCL_OK
)
503 result
= Tcl_Eval (interp
, contextPtr
->defaultAction
, 0,
505 if (result
== TCL_CONTINUE
)
506 result
= TCL_OK
; /* This doesn't mean anything, but */
507 /* don't break the user. */
508 if (result
== TCL_ERROR
)
509 Tcl_AddErrorInfo (interp
,
510 "\n while executing a match default command");
514 Tcl_DynBufFree (&dynBuf
);
515 Tcl_DynBufFree (&lowerDynBuf
);
516 if (result
== TCL_RETURN
)
522 *-----------------------------------------------------------------------------
525 * Decrements the use count on the globals when a command is deleted.
526 * If it goes to zero, all resources are released.
528 *-----------------------------------------------------------------------------
531 FileScanCleanUp (clientData
)
532 ClientData clientData
;
534 scanGlob_pt scanGlobPtr
= (scanGlob_pt
) clientData
;
535 scanContext_pt contextPtr
;
538 scanGlobPtr
->useCount
--;
539 if (scanGlobPtr
->useCount
> 0)
543 while ((contextPtr
= Tcl_HandleWalk (scanGlobPtr
->tblHdrPtr
,
545 CleanUpContext (scanGlobPtr
, contextPtr
);
547 Tcl_HandleTblRelease (scanGlobPtr
->tblHdrPtr
);
548 ckfree ((char *) scanGlobPtr
);
552 *-----------------------------------------------------------------------------
554 * Tcl_InitFilescan --
555 * Initialize the TCL file scanning facility..
557 *-----------------------------------------------------------------------------
560 Tcl_InitFilescan (interp
)
563 scanGlob_pt scanGlobPtr
;
564 void_pt fileCbTblPtr
;
566 scanGlobPtr
= (scanGlob_pt
) ckalloc (sizeof (scanGlob_t
));
567 scanGlobPtr
->tblHdrPtr
=
568 Tcl_HandleTblInit ("context", sizeof (scanContext_t
), 5);
571 * Initialize the commands.
573 scanGlobPtr
->useCount
= 3; /* Number of commands */
575 Tcl_CreateCommand (interp
, "scanfile", Tcl_ScanfileCmd
,
576 (ClientData
)scanGlobPtr
, FileScanCleanUp
);
577 Tcl_CreateCommand (interp
, "scanmatch", Tcl_ScanmatchCmd
,
578 (ClientData
)scanGlobPtr
, FileScanCleanUp
);
579 Tcl_CreateCommand (interp
, "scancontext", Tcl_ScancontextCmd
,
580 (ClientData
)scanGlobPtr
, FileScanCleanUp
);