]>
Commit | Line | Data |
---|---|---|
6a5fa4e0 MG |
1 | /* |
2 | * tclXfilescan.c -- | |
3 | * | |
4 | * Tcl file scanning: regular expression matching on lines of a file. | |
5 | * Implements awk. | |
6 | *----------------------------------------------------------------------------- | |
7 | * Copyright 1992 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 2.0 1992/10/16 04:50:43 markd Rel $ | |
17 | *----------------------------------------------------------------------------- | |
18 | */ | |
19 | ||
20 | #include "tclxint.h" | |
21 | #include "regexp.h" | |
22 | ||
23 | /* | |
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. | |
26 | */ | |
27 | ||
28 | #define CONTEXT_A_CASE_INSENSITIVE_FLAG 2 | |
29 | #define MATCH_CASE_INSENSITIVE_FLAG 4 | |
30 | ||
31 | typedef struct matchDef_t { | |
32 | regexp_t regExpInfo; | |
33 | char *command; | |
34 | struct matchDef_t *nextMatchDefPtr; | |
35 | short matchflags; | |
36 | } matchDef_t; | |
37 | typedef struct matchDef_t *matchDef_pt; | |
38 | ||
39 | typedef struct scanContext_t { | |
40 | matchDef_pt matchListHead; | |
41 | matchDef_pt matchListTail; | |
42 | char *defaultAction; | |
43 | short flags; | |
44 | } scanContext_t; | |
45 | typedef struct scanContext_t *scanContext_pt; | |
46 | ||
47 | /* | |
48 | * Global data structure, pointer to by clientData. | |
49 | */ | |
50 | ||
51 | typedef struct { | |
52 | int useCount; /* Commands that current share globals */ | |
53 | void_pt tblHdrPtr; /* Scan context handle table */ | |
54 | char curName [16]; /* Current context name. */ | |
55 | } scanGlob_t; | |
56 | typedef scanGlob_t *scanGlob_pt; | |
57 | ||
58 | /* | |
59 | * Prototypes of internal functions. | |
60 | */ | |
61 | static int | |
62 | CleanUpContext _ANSI_ARGS_((scanGlob_pt scanGlobPtr, | |
63 | scanContext_pt contextPtr)); | |
64 | ||
65 | static int | |
66 | CreateScanContext _ANSI_ARGS_((Tcl_Interp *interp, | |
67 | scanGlob_pt scanGlobPtr)); | |
68 | ||
69 | static int | |
70 | SelectScanContext _ANSI_ARGS_((Tcl_Interp *interp, | |
71 | scanGlob_pt scanGlobPtr, | |
72 | char *contextHandle)); | |
73 | ||
74 | static int | |
75 | Tcl_Delete_scancontextCmd _ANSI_ARGS_((Tcl_Interp *interp, | |
76 | scanGlob_pt scanGlobPtr, | |
77 | char *contextHandle)); | |
78 | ||
79 | static int | |
80 | SetMatchVar _ANSI_ARGS_((Tcl_Interp *interp, | |
81 | char *fileLine, | |
82 | long fileOffset, | |
83 | long scanLineNum, | |
84 | char *fileHandle)); | |
85 | ||
86 | static void | |
87 | FileScanCleanUp _ANSI_ARGS_((ClientData clientData)); | |
88 | ||
89 | \f | |
90 | /* | |
91 | *----------------------------------------------------------------------------- | |
92 | * | |
93 | * CleanUpContext | |
94 | * Release all resources allocated to the specified scan context | |
95 | * entry. The entry itself is not released. | |
96 | *----------------------------------------------------------------------------- | |
97 | */ | |
98 | static int | |
99 | CleanUpContext (scanGlobPtr, contextPtr) | |
100 | scanGlob_pt scanGlobPtr; | |
101 | scanContext_pt contextPtr; | |
102 | { | |
103 | matchDef_pt matchPtr, oldMatchPtr; | |
104 | ||
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); | |
112 | } | |
113 | contextPtr->matchListHead = NULL; | |
114 | contextPtr->matchListTail = NULL; | |
115 | ||
116 | if (contextPtr->defaultAction != NULL) { | |
117 | ckfree(contextPtr->defaultAction); | |
118 | contextPtr->defaultAction = NULL; | |
119 | } | |
120 | } | |
121 | \f | |
122 | /* | |
123 | *----------------------------------------------------------------------------- | |
124 | * | |
125 | * CreateScanContext -- | |
126 | * Create a new scan context, implements the subcommand: | |
127 | * scancontext create | |
128 | * | |
129 | *----------------------------------------------------------------------------- | |
130 | */ | |
131 | static int | |
132 | CreateScanContext (interp, scanGlobPtr) | |
133 | Tcl_Interp *interp; | |
134 | scanGlob_pt scanGlobPtr; | |
135 | { | |
136 | scanContext_pt contextPtr; | |
137 | ||
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; | |
144 | ||
145 | Tcl_SetResult (interp, scanGlobPtr->curName, TCL_STATIC); | |
146 | return TCL_OK; | |
147 | } | |
148 | \f | |
149 | /* | |
150 | *----------------------------------------------------------------------------- | |
151 | * | |
152 | * DeleteScanContext -- | |
153 | * Deletes the specified scan context, implements the subcommand: | |
154 | * scancontext delete contexthandle | |
155 | * | |
156 | *----------------------------------------------------------------------------- | |
157 | */ | |
158 | static int | |
159 | DeleteScanContext (interp, scanGlobPtr, contextHandle) | |
160 | Tcl_Interp *interp; | |
161 | scanGlob_pt scanGlobPtr; | |
162 | char *contextHandle; | |
163 | { | |
164 | scanContext_pt contextPtr; | |
165 | ||
166 | if ((contextPtr = Tcl_HandleXlate (interp, scanGlobPtr->tblHdrPtr, | |
167 | contextHandle)) == NULL) | |
168 | return TCL_ERROR; | |
169 | ||
170 | CleanUpContext (scanGlobPtr, contextPtr); | |
171 | Tcl_HandleFree (scanGlobPtr->tblHdrPtr, contextPtr); | |
172 | ||
173 | return TCL_OK; | |
174 | } | |
175 | \f | |
176 | /* | |
177 | *----------------------------------------------------------------------------- | |
178 | * | |
179 | * Tcl_ScancontextCmd -- | |
180 | * Implements the TCL scancontext Tcl command, which has the | |
181 | * following forms. | |
182 | * scancontext create | |
183 | * scancontext delete | |
184 | * | |
185 | * Results: | |
186 | * Standard TCL results. | |
187 | * | |
188 | *----------------------------------------------------------------------------- | |
189 | */ | |
190 | static int | |
191 | Tcl_ScancontextCmd (clientData, interp, argc, argv) | |
192 | char *clientData; | |
193 | Tcl_Interp *interp; | |
194 | int argc; | |
195 | char **argv; | |
196 | { | |
197 | scanGlob_pt scanGlobPtr = (scanGlob_pt) clientData; | |
198 | ||
199 | if (argc < 2) { | |
200 | Tcl_AppendResult (interp, tclXWrongArgs, argv [0], " option", | |
201 | (char *) NULL); | |
202 | return TCL_ERROR; | |
203 | } | |
204 | /* | |
205 | * Create a new scan context. | |
206 | */ | |
207 | if (STREQU (argv [1], "create")) { | |
208 | if (argc != 2) { | |
209 | Tcl_AppendResult (interp, tclXWrongArgs, argv [0], " create", | |
210 | (char *) NULL); | |
211 | return TCL_ERROR; | |
212 | } | |
213 | return CreateScanContext (interp, scanGlobPtr); | |
214 | } | |
215 | ||
216 | /* | |
217 | * Delete a scan context. | |
218 | */ | |
219 | if (STREQU (argv [1], "delete")) { | |
220 | if (argc != 3) { | |
221 | Tcl_AppendResult (interp, tclXWrongArgs, argv [0], | |
222 | "delete contexthandle", (char *) NULL); | |
223 | return TCL_ERROR; | |
224 | } | |
225 | return DeleteScanContext (interp, scanGlobPtr, argv [2]); | |
226 | } | |
227 | ||
228 | Tcl_AppendResult (interp, "invalid argument, expected one of: ", | |
229 | "create or delete", (char *) NULL); | |
230 | return TCL_ERROR; | |
231 | } | |
232 | \f | |
233 | /* | |
234 | *----------------------------------------------------------------------------- | |
235 | * | |
236 | * Tcl_ScanmatchCmd -- | |
237 | * Implements the TCL command: | |
238 | * scanmatch [-nocase] contexthandle [regexp] commands | |
239 | * This uses both Boyer_Moore and regular expressions matching. | |
240 | * | |
241 | * Results: | |
242 | * Standard TCL results. | |
243 | * | |
244 | *----------------------------------------------------------------------------- | |
245 | */ | |
246 | static int | |
247 | Tcl_ScanmatchCmd (clientData, interp, argc, argv) | |
248 | char *clientData; | |
249 | Tcl_Interp *interp; | |
250 | int argc; | |
251 | char **argv; | |
252 | { | |
253 | scanGlob_pt scanGlobPtr = (scanGlob_pt) clientData; | |
254 | scanContext_pt contextPtr; | |
255 | char *result; | |
256 | matchDef_pt newmatch; | |
257 | int compFlags = REXP_BOTH_ALGORITHMS; | |
258 | int firstArg = 1; | |
259 | ||
260 | if (argc < 3) | |
261 | goto argError; | |
262 | if (STREQU (argv[1], "-nocase")) { | |
263 | compFlags |= REXP_NO_CASE; | |
264 | firstArg = 2; | |
265 | } | |
266 | ||
267 | /* | |
268 | * If firstArg == 2 (-nocase), the both a regular expression and a command | |
269 | * string must be specified, otherwise the regular expression is optional. | |
270 | */ | |
271 | if (((firstArg == 2) && (argc != 5)) || ((firstArg == 1) && (argc > 4))) | |
272 | goto argError; | |
273 | ||
274 | if ((contextPtr = Tcl_HandleXlate (interp, scanGlobPtr->tblHdrPtr, | |
275 | argv [firstArg])) == NULL) | |
276 | return TCL_ERROR; | |
277 | ||
278 | /* | |
279 | * Handle the default case (no regular expression). | |
280 | */ | |
281 | if (argc == 3) { | |
282 | if (contextPtr->defaultAction) { | |
283 | Tcl_AppendResult (interp, argv [0], ": default match already ", | |
284 | "specified in this scan context", (char *) NULL); | |
285 | return TCL_ERROR; | |
286 | } | |
287 | contextPtr->defaultAction = ckalloc (strlen (argv [2]) + 1); | |
288 | strcpy (contextPtr->defaultAction, argv [2]); | |
289 | ||
290 | return TCL_OK; | |
291 | } | |
292 | ||
293 | /* | |
294 | * Add a regular expression to the context. | |
295 | */ | |
296 | ||
297 | newmatch = (matchDef_pt) ckalloc(sizeof (matchDef_t)); | |
298 | newmatch->matchflags = 0; | |
299 | ||
300 | if (compFlags & REXP_NO_CASE) { | |
301 | newmatch->matchflags |= MATCH_CASE_INSENSITIVE_FLAG; | |
302 | contextPtr->flags |= CONTEXT_A_CASE_INSENSITIVE_FLAG; | |
303 | } | |
304 | ||
305 | if (Tcl_RegExpCompile (interp, &newmatch->regExpInfo, argv [firstArg + 1], | |
306 | compFlags) != TCL_OK) { | |
307 | ckfree ((char *) newmatch); | |
308 | return (TCL_ERROR); | |
309 | } | |
310 | ||
311 | newmatch->command = ckalloc (strlen (argv[firstArg + 2]) + 1); | |
312 | strcpy(newmatch->command, argv [firstArg + 2]); | |
313 | ||
314 | /* | |
315 | * Link in the new match. | |
316 | */ | |
317 | newmatch->nextMatchDefPtr = NULL; | |
318 | if (contextPtr->matchListHead == NULL) | |
319 | contextPtr->matchListHead = newmatch; | |
320 | else | |
321 | contextPtr->matchListTail->nextMatchDefPtr = newmatch; | |
322 | contextPtr->matchListTail = newmatch; | |
323 | ||
324 | return TCL_OK; | |
325 | ||
326 | argError: | |
327 | Tcl_AppendResult (interp, tclXWrongArgs, argv [0], | |
328 | " [-nocase] contexthandle [regexp] command", | |
329 | (char *) NULL); | |
330 | return TCL_ERROR; | |
331 | } | |
332 | \f | |
333 | /* | |
334 | *----------------------------------------------------------------------------- | |
335 | * | |
336 | * SetMatchVar -- | |
337 | * Sets the TCL array variable matchInfo to contain information | |
338 | * about the line that is matched. | |
339 | * Results: | |
340 | * TCL_OK if all is ok, TCL_ERROR if an error occures setting the | |
341 | * variables. | |
342 | * Side effects: | |
343 | * A TCL array variable is created or altered. | |
344 | * | |
345 | *----------------------------------------------------------------------------- | |
346 | */ | |
347 | static int | |
348 | SetMatchVar (interp, fileLine, fileOffset, scanLineNum, fileHandle) | |
349 | Tcl_Interp *interp; | |
350 | char *fileLine; | |
351 | long fileOffset; | |
352 | long scanLineNum; | |
353 | char *fileHandle; | |
354 | { | |
355 | char numBuf [20]; | |
356 | ||
357 | if (Tcl_SetVar2 (interp, "matchInfo", "line", fileLine, | |
358 | TCL_LEAVE_ERR_MSG) == NULL) | |
359 | return TCL_ERROR; | |
360 | ||
361 | sprintf (numBuf, "%ld", fileOffset); | |
362 | if (Tcl_SetVar2 (interp, "matchInfo", "offset", numBuf, | |
363 | TCL_LEAVE_ERR_MSG) == NULL) | |
364 | return TCL_ERROR; | |
365 | ||
366 | sprintf (numBuf, "%ld", scanLineNum); | |
367 | if (Tcl_SetVar2 (interp, "matchInfo", "linenum", numBuf, | |
368 | TCL_LEAVE_ERR_MSG) == NULL) | |
369 | return TCL_ERROR; | |
370 | ||
371 | if (Tcl_SetVar2 (interp, "matchInfo", "handle", fileHandle, | |
372 | TCL_LEAVE_ERR_MSG) == NULL) | |
373 | return TCL_ERROR; | |
374 | return TCL_OK; | |
375 | } | |
376 | \f | |
377 | /* | |
378 | *----------------------------------------------------------------------------- | |
379 | * | |
380 | * Tcl_ScanfileCmd -- | |
381 | * Implements the TCL command: | |
382 | * scanfile contexthandle filehandle | |
383 | * | |
384 | * Results: | |
385 | * Standard TCL results. | |
386 | * | |
387 | *----------------------------------------------------------------------------- | |
388 | */ | |
389 | static int | |
390 | Tcl_ScanfileCmd (clientData, interp, argc, argv) | |
391 | char *clientData; | |
392 | Tcl_Interp *interp; | |
393 | int argc; | |
394 | char **argv; | |
395 | { | |
396 | scanGlob_pt scanGlobPtr = (scanGlob_pt) clientData; | |
397 | scanContext_pt contextPtr; | |
398 | dynamicBuf_t dynBuf, lowerDynBuf; | |
399 | OpenFile *filePtr; | |
400 | matchDef_pt matchPtr; | |
401 | int result; | |
402 | int matchedAtLeastOne; | |
403 | long fileOffset; | |
404 | long matchOffset; | |
405 | long scanLineNum = 0; | |
406 | char *fileHandle; | |
407 | ||
408 | if ((argc < 2) || (argc > 3)) { | |
409 | Tcl_AppendResult (interp, tclXWrongArgs, argv [0], | |
410 | " contexthandle filehandle", (char *) NULL); | |
411 | return TCL_ERROR; | |
412 | } | |
413 | if ((contextPtr = Tcl_HandleXlate (interp, scanGlobPtr->tblHdrPtr, | |
414 | argv [1])) == NULL) | |
415 | return TCL_ERROR; | |
416 | ||
417 | if (TclGetOpenFile (interp, argv [2], &filePtr) != TCL_OK) | |
418 | return TCL_ERROR; | |
419 | ||
420 | if (contextPtr->matchListHead == NULL) { | |
421 | Tcl_AppendResult (interp, "no patterns in current scan context", | |
422 | (char *) NULL); | |
423 | return TCL_ERROR; | |
424 | } | |
425 | ||
426 | Tcl_DynBufInit (&dynBuf); | |
427 | Tcl_DynBufInit (&lowerDynBuf); | |
428 | ||
429 | result = TCL_OK; /* Assume the best */ | |
430 | ||
431 | fileOffset = ftell (filePtr->f); /* Get starting offset */ | |
432 | ||
433 | while ((result == TCL_OK)) { | |
434 | int storedThisLine = FALSE; | |
435 | ||
436 | switch (Tcl_DynamicFgets (&dynBuf, filePtr->f, FALSE)) { | |
437 | case -1: /* Error */ | |
438 | interp->result = Tcl_UnixError (interp); | |
439 | goto scanExit; | |
440 | ||
441 | case 0: /* EOF */ | |
442 | goto scanExit; | |
443 | } | |
444 | scanLineNum++; | |
445 | matchOffset = fileOffset; | |
446 | fileOffset += strlen(dynBuf.ptr) + 1; | |
447 | storedThisLine = 0; | |
448 | matchedAtLeastOne = 0; | |
449 | if (contextPtr->flags & CONTEXT_A_CASE_INSENSITIVE_FLAG) { | |
450 | lowerDynBuf.len = 0; | |
451 | Tcl_DynBufAppend (&lowerDynBuf, dynBuf.ptr); | |
452 | Tcl_DownShift (lowerDynBuf.ptr, lowerDynBuf.ptr); | |
453 | } | |
454 | for (matchPtr = contextPtr->matchListHead; matchPtr != NULL; | |
455 | matchPtr = matchPtr->nextMatchDefPtr) { | |
456 | ||
457 | if (!Tcl_RegExpExecute (interp, &matchPtr->regExpInfo, dynBuf.ptr, | |
458 | lowerDynBuf.ptr)) | |
459 | continue; /* Try next match pattern */ | |
460 | ||
461 | matchedAtLeastOne = TRUE; | |
462 | if (!storedThisLine) { | |
463 | result = SetMatchVar (interp, dynBuf.ptr, matchOffset, | |
464 | scanLineNum, argv[2]); | |
465 | if (result != TCL_OK) | |
466 | goto scanExit; | |
467 | storedThisLine = TRUE; | |
468 | } | |
469 | ||
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"); | |
474 | goto scanExit; | |
475 | } | |
476 | if (result == TCL_CONTINUE) { | |
477 | /* | |
478 | * Don't process any more matches for this line. | |
479 | */ | |
480 | result = TCL_OK; | |
481 | goto matchLineExit; | |
482 | } | |
483 | if (result == TCL_BREAK) { | |
484 | /* | |
485 | * Terminate scan. | |
486 | */ | |
487 | result = TCL_OK; | |
488 | goto scanExit; | |
489 | } | |
490 | } | |
491 | ||
492 | matchLineExit: | |
493 | /* | |
494 | * Process default action if required. | |
495 | */ | |
496 | if ((contextPtr->defaultAction != NULL) && (!matchedAtLeastOne)) { | |
497 | ||
498 | result = SetMatchVar (interp, dynBuf.ptr, matchOffset, | |
499 | scanLineNum, argv[2]); | |
500 | if (result != TCL_OK) | |
501 | goto scanExit; | |
502 | ||
503 | result = Tcl_Eval (interp, contextPtr->defaultAction, 0, | |
504 | (char **)NULL); | |
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"); | |
511 | } | |
512 | } | |
513 | scanExit: | |
514 | Tcl_DynBufFree (&dynBuf); | |
515 | Tcl_DynBufFree (&lowerDynBuf); | |
516 | if (result == TCL_RETURN) | |
517 | result = TCL_OK; | |
518 | return result; | |
519 | } | |
520 | \f | |
521 | /* | |
522 | *----------------------------------------------------------------------------- | |
523 | * | |
524 | * FileScanCleanUp -- | |
525 | * Decrements the use count on the globals when a command is deleted. | |
526 | * If it goes to zero, all resources are released. | |
527 | * | |
528 | *----------------------------------------------------------------------------- | |
529 | */ | |
530 | static void | |
531 | FileScanCleanUp (clientData) | |
532 | ClientData clientData; | |
533 | { | |
534 | scanGlob_pt scanGlobPtr = (scanGlob_pt) clientData; | |
535 | scanContext_pt contextPtr; | |
536 | int walkKey; | |
537 | ||
538 | scanGlobPtr->useCount--; | |
539 | if (scanGlobPtr->useCount > 0) | |
540 | return; | |
541 | ||
542 | walkKey = -1; | |
543 | while ((contextPtr = Tcl_HandleWalk (scanGlobPtr->tblHdrPtr, | |
544 | &walkKey)) != NULL) | |
545 | CleanUpContext (scanGlobPtr, contextPtr); | |
546 | ||
547 | Tcl_HandleTblRelease (scanGlobPtr->tblHdrPtr); | |
548 | ckfree ((char *) scanGlobPtr); | |
549 | } | |
550 | \f | |
551 | /* | |
552 | *----------------------------------------------------------------------------- | |
553 | * | |
554 | * Tcl_InitFilescan -- | |
555 | * Initialize the TCL file scanning facility.. | |
556 | * | |
557 | *----------------------------------------------------------------------------- | |
558 | */ | |
559 | void | |
560 | Tcl_InitFilescan (interp) | |
561 | Tcl_Interp *interp; | |
562 | { | |
563 | scanGlob_pt scanGlobPtr; | |
564 | void_pt fileCbTblPtr; | |
565 | ||
566 | scanGlobPtr = (scanGlob_pt) ckalloc (sizeof (scanGlob_t)); | |
567 | scanGlobPtr->tblHdrPtr = | |
568 | Tcl_HandleTblInit ("context", sizeof (scanContext_t), 5); | |
569 | ||
570 | /* | |
571 | * Initialize the commands. | |
572 | */ | |
573 | scanGlobPtr->useCount = 3; /* Number of commands */ | |
574 | ||
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); | |
581 | } | |
582 |