]> git.zerfleddert.de Git - micropolis/blame - src/tclx/src/tclxfsca.c
projects / micropolis / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Import Micropolis from http://www.donhopkins.com/home/micropolis/
[micropolis] / src / tclx / src / tclxfsca.c
CommitLineData
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
31typedef struct matchDef_t {
32 regexp_t regExpInfo;
33 char *command;
34 struct matchDef_t *nextMatchDefPtr;
35 short matchflags;
36 } matchDef_t;
37typedef struct matchDef_t *matchDef_pt;
38
39typedef struct scanContext_t {
40 matchDef_pt matchListHead;
41 matchDef_pt matchListTail;
42 char *defaultAction;
43 short flags;
44 } scanContext_t;
45typedef struct scanContext_t *scanContext_pt;
46
47/*
48 * Global data structure, pointer to by clientData.
49 */
50
51typedef 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;
56typedef scanGlob_t *scanGlob_pt;
57
58/*
59 * Prototypes of internal functions.
60 */
61static int
62CleanUpContext _ANSI_ARGS_((scanGlob_pt scanGlobPtr,
63 scanContext_pt contextPtr));
64
65static int
66CreateScanContext _ANSI_ARGS_((Tcl_Interp *interp,
67 scanGlob_pt scanGlobPtr));
68
69static int
70SelectScanContext _ANSI_ARGS_((Tcl_Interp *interp,
71 scanGlob_pt scanGlobPtr,
72 char *contextHandle));
73
74static int
75Tcl_Delete_scancontextCmd _ANSI_ARGS_((Tcl_Interp *interp,
76 scanGlob_pt scanGlobPtr,
77 char *contextHandle));
78
79static int
80SetMatchVar _ANSI_ARGS_((Tcl_Interp *interp,
81 char *fileLine,
82 long fileOffset,
83 long scanLineNum,
84 char *fileHandle));
85
86static void
87FileScanCleanUp _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 */
98static int
99CleanUpContext (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 */
131static int
132CreateScanContext (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 */
158static int
159DeleteScanContext (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 */
190static int
191Tcl_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 */
246static int
247Tcl_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
326argError:
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 */
347static int
348SetMatchVar (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 */
389static int
390Tcl_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 }
513scanExit:
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 */
530static void
531FileScanCleanUp (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 */
559void
560Tcl_InitFilescan (interp)
561Tcl_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
Micropolis
Impressum, Datenschutz