home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / tcl / tclX6.5c / src / tclXfilescan.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-12-19  |  17.7 KB  |  583 lines
  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 "tclExtdInt.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. int
  62. CleanUpContext _ANSI_ARGS_((scanGlob_pt    scanGlobPtr,
  63.                             scanContext_pt contextPtr));
  64.  
  65. int
  66. CreateScanContext _ANSI_ARGS_((Tcl_Interp  *interp,
  67.                                scanGlob_pt  scanGlobPtr));
  68.  
  69. int
  70. SelectScanContext _ANSI_ARGS_((Tcl_Interp  *interp,
  71.                                scanGlob_pt  scanGlobPtr,
  72.                                char        *contextHandle));
  73.  
  74. int
  75. Tcl_Delete_scancontextCmd _ANSI_ARGS_((Tcl_Interp  *interp,
  76.                                        scanGlob_pt  scanGlobPtr,
  77.                                        char        *contextHandle));
  78.  
  79. int
  80. SetMatchVar _ANSI_ARGS_((Tcl_Interp *interp,
  81.                          char       *fileLine,
  82.                          long        fileOffset,
  83.                          long        scanLineNum,
  84.                          char       *fileHandle));
  85.  
  86. void
  87. FileScanCleanUp _ANSI_ARGS_((ClientData clientData));
  88.  
  89.  
  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.  
  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.  
  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.  
  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.  
  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.  
  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.  
  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.  
  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.  
  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.  
  583.