home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / tcl / tclX6.5c / src / tclXbsearch.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-12-19  |  10.5 KB  |  356 lines
  1. /*
  2.  * tclXbsearch.c
  3.  *
  4.  * Extended Tcl binary file search command.
  5.  *-----------------------------------------------------------------------------
  6.  * Copyright 1992 Karl Lehenbauer and Mark Diekhans.
  7.  *
  8.  * Permission to use, copy, modify, and distribute this software and its
  9.  * documentation for any purpose and without fee is hereby granted, provided
  10.  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11.  * Mark Diekhans make no representations about the suitability of this
  12.  * software for any purpose.  It is provided "as is" without express or
  13.  * implied warranty.
  14.  *-----------------------------------------------------------------------------
  15.  * $Id: tclXbsearch.c,v 2.0 1992/10/16 04:50:24 markd Rel $
  16.  *-----------------------------------------------------------------------------
  17.  */
  18.  
  19. #include "tclExtdInt.h"
  20.  
  21. /*
  22.  * Control block used to pass data used by the binary search routines.
  23.  */
  24. typedef struct binSearchCB_t {
  25.     Tcl_Interp   *interp;         /* Pointer to the interpreter.             */
  26.     char         *fileHandle;     /* Handle of file.                         */
  27.     char         *key;            /* The key to search for.                  */
  28.  
  29.     FILE         *fileCBPtr;      /* Open file structure.                    */
  30.     dynamicBuf_t  dynBuf;         /* Dynamic buffer to hold a line of file.  */
  31.     long          lastRecOffset;  /* Offset of last record read.             */
  32.     int           cmpResult;      /* -1, 0 or 1 result of string compare.    */
  33.     char         *tclProc;        /* Name of Tcl comparsion proc, or NULL.   */
  34.     } binSearchCB_t;
  35.  
  36. /*
  37.  * Prototypes of internal functions.
  38.  */
  39. int
  40. StandardKeyCompare _ANSI_ARGS_((char *key,
  41.                                 char *line));
  42.  
  43. int
  44. TclProcKeyCompare _ANSI_ARGS_((binSearchCB_t *searchCBPtr));
  45.  
  46. int
  47. ReadAndCompare _ANSI_ARGS_((long           fileOffset,
  48.                             binSearchCB_t *searchCBPtr));
  49.  
  50. int
  51. BinSearch _ANSI_ARGS_((binSearchCB_t *searchCBPtr));
  52.  
  53. /*
  54.  *-----------------------------------------------------------------------------
  55.  *
  56.  * StandardKeyCompare --
  57.  *    Standard comparison routine for BinSearch, compares the key to the
  58.  *    first white-space seperated field in the line.
  59.  *
  60.  * Parameters:
  61.  *   o key (I) - The key to search for.
  62.  *   o line (I) - The line to compare the key to.
  63.  *
  64.  * Results:
  65.  *   o < 0 if key < line-key
  66.  *   o = 0 if key == line-key
  67.  *   o > 0 if key > line-key.
  68.  *-----------------------------------------------------------------------------
  69.  */
  70. static int
  71. StandardKeyCompare (key, line)
  72.     char *key;
  73.     char *line;
  74. {
  75.     int  cmpResult, fieldLen;
  76.     char saveChar;
  77.  
  78.     fieldLen = strcspn (line, " \t\r\n\v\f");
  79.  
  80.     saveChar = line [fieldLen];
  81.     line [fieldLen] = 0;
  82.     cmpResult = strcmp (key, line);
  83.     line [fieldLen] = saveChar;
  84.  
  85.     return cmpResult;
  86. }
  87.  
  88. /*
  89.  *-----------------------------------------------------------------------------
  90.  *
  91.  * TclProcKeyCompare --
  92.  *    Comparison routine for BinSearch that runs a Tcl procedure to, 
  93.  *    compare the key to a line from the file.
  94.  *
  95.  * Parameters:
  96.  *   o searchCBPtr (I/O) - The search control block, the line should be in
  97.  *     dynBuf, the comparsion result is returned in cmpResult.
  98.  *
  99.  * Results:
  100.  *   TCL_OK or TCL_ERROR.
  101.  *-----------------------------------------------------------------------------
  102.  */
  103. static int
  104. TclProcKeyCompare (searchCBPtr)
  105.     binSearchCB_t *searchCBPtr;
  106. {
  107.     char *cmdArgv [3];
  108.     char *command;
  109.     int   result;
  110.  
  111.     cmdArgv [0] = searchCBPtr->tclProc;
  112.     cmdArgv [1] = searchCBPtr->key;
  113.     cmdArgv [2] = searchCBPtr->dynBuf.ptr;
  114.     command = Tcl_Merge (3, cmdArgv);
  115.  
  116.     result = Tcl_Eval (searchCBPtr->interp, command, 0, (char **) NULL);
  117.  
  118.     ckfree (command);
  119.     if (result == TCL_ERROR)
  120.         return TCL_ERROR;
  121.  
  122.     if (!Tcl_StrToInt (searchCBPtr->interp->result, 0, 
  123.                        &searchCBPtr->cmpResult)) {
  124.         char *oldResult = ckalloc (strlen (searchCBPtr->interp->result + 1));
  125.         
  126.         strcpy (oldResult, searchCBPtr->interp->result);
  127.         Tcl_ResetResult (searchCBPtr->interp);
  128.         Tcl_AppendResult (searchCBPtr->interp, "invalid integer \"", oldResult,
  129.                           "\" returned from compare proc \"",
  130.                           searchCBPtr->tclProc, "\"", (char *) NULL);
  131.         ckfree (oldResult);
  132.         return TCL_ERROR;
  133.     }
  134.     Tcl_ResetResult (searchCBPtr->interp);
  135.     return TCL_OK;
  136. }
  137.  
  138. /*
  139.  *-----------------------------------------------------------------------------
  140.  *
  141.  * ReadAndCompare --
  142.  *    Search for the next line in the file starting at the specified
  143.  *    offset.  Read the line into the dynamic buffer and compare it to
  144.  *    the key using the specified comparison method.  The start of the
  145.  *    last line read is saved in the control block, and if the start of
  146.  *    the same line is found in the search, then it will not be recompared.
  147.  *    This is needed since the search algorithm has to hit the same line
  148.  *    a couple of times before failing, due to the fact that the records are
  149.  *    not fixed length.
  150.  *
  151.  * Parameters:
  152.  *   o fileOffset (I) - The offset of the next byte of the search, not
  153.  *     necessarly the start of a record.
  154.  *   o searchCBPtr (I/O) - The search control block, the comparsion result
  155.  *     is returned in cmpResult.  If the EOF is hit, a less-than result is
  156.  *     returned.
  157.  *
  158.  * Results:
  159.  *   TCL_OK or TCL_ERROR.
  160.  *-----------------------------------------------------------------------------
  161.  */
  162. static int
  163. ReadAndCompare (fileOffset, searchCBPtr)
  164.     long           fileOffset;
  165.     binSearchCB_t *searchCBPtr;
  166. {
  167.     int  recChar, status;
  168.  
  169.     if (fseek (searchCBPtr->fileCBPtr, fileOffset, SEEK_SET) != 0)
  170.         goto unixError;
  171.  
  172.     /*
  173.      * Go to beginning of next line.
  174.      */
  175.     
  176.     if (fileOffset != 0) {
  177.         while (((recChar = getc (searchCBPtr->fileCBPtr)) != EOF) &&
  178.                 (recChar != '\n'))
  179.             fileOffset++;
  180.         if ((recChar == EOF) && ferror (searchCBPtr->fileCBPtr))
  181.             goto unixError;
  182.     }
  183.     /*
  184.      * If this is the same line as before, then just leave the comparison
  185.      * result unchanged.
  186.      */
  187.     if (fileOffset == searchCBPtr->lastRecOffset)
  188.         return TCL_OK;
  189.  
  190.     searchCBPtr->lastRecOffset = fileOffset;
  191.  
  192.     status = Tcl_DynamicFgets (&searchCBPtr->dynBuf, searchCBPtr->fileCBPtr, 
  193.                                FALSE);
  194.     if (status < 0)
  195.         goto unixError;
  196.  
  197.     /* 
  198.      * Only compare if EOF was not hit, otherwise, treat as if we went
  199.      * above the key we are looking for.
  200.      */
  201.     if (status == 0) {
  202.         searchCBPtr->cmpResult = -1;
  203.         return TCL_OK;
  204.     }
  205.  
  206.     if (searchCBPtr->tclProc == NULL) {
  207.         searchCBPtr->cmpResult = StandardKeyCompare (searchCBPtr->key, 
  208.                                                      searchCBPtr->dynBuf.ptr);
  209.     } else {
  210.         if (TclProcKeyCompare (searchCBPtr) != TCL_OK)
  211.             return TCL_ERROR;
  212.     }
  213.  
  214.     return TCL_OK;
  215.  
  216. unixError:
  217.    Tcl_AppendResult (searchCBPtr->interp, searchCBPtr->fileHandle, ": ",
  218.                      Tcl_UnixError (searchCBPtr->interp), (char *) NULL);
  219.    return TCL_ERROR;
  220. }
  221.  
  222. /*
  223.  *-----------------------------------------------------------------------------
  224.  *
  225.  * BinSearch --
  226.  *      Binary search a sorted ASCII file.
  227.  *
  228.  * Parameters:
  229.  *   o searchCBPtr (I/O) - The search control block, if the line is found,
  230.  *     it is returned in dynBuf.
  231.  * Results:
  232.  *     TCL_OK - If the key was found.
  233.  *     TCL_BREAK - If it was not found.
  234.  *     TCL_ERROR - If there was an error.
  235.  *
  236.  * based on getpath.c from smail 2.5 (9/15/87)
  237.  *
  238.  *-----------------------------------------------------------------------------
  239.  */
  240. static int
  241. BinSearch (searchCBPtr)
  242.     binSearchCB_t *searchCBPtr;
  243. {
  244.     OpenFile   *filePtr;
  245.     long        middle, high, low;
  246.     struct stat statBuf;
  247.  
  248.     if (TclGetOpenFile (searchCBPtr->interp, searchCBPtr->fileHandle, 
  249.                         &filePtr) != TCL_OK)
  250.         return TCL_ERROR;
  251.  
  252.     searchCBPtr->fileCBPtr = filePtr->f;
  253.     searchCBPtr->lastRecOffset = -1;
  254.  
  255.     if (fstat (fileno (searchCBPtr->fileCBPtr), &statBuf) < 0)
  256.         goto unixError;
  257.  
  258.     low = 0;
  259.     high = statBuf.st_size;
  260.  
  261.     /*
  262.      * "Binary search routines are never written right the first time around."
  263.      * - Robert G. Sheldon.
  264.      */
  265.  
  266.     while (TRUE) {
  267.         middle = (high + low + 1) / 2;
  268.  
  269.         if (ReadAndCompare (middle, searchCBPtr) != TCL_OK)
  270.             return TCL_ERROR;
  271.  
  272.         if (searchCBPtr->cmpResult == 0)
  273.             return TCL_OK;     /* Found   */
  274.         
  275.         if (low >= middle)  
  276.             return TCL_BREAK;  /* Failure */
  277.  
  278.         /*
  279.          * Close window.
  280.          */
  281.         if (searchCBPtr->cmpResult > 0) {
  282.             low = middle;
  283.         } else {
  284.             high = middle - 1;
  285.         }
  286.     }
  287.  
  288. unixError:
  289.    Tcl_AppendResult (searchCBPtr->interp, searchCBPtr->fileHandle, ": ",
  290.                      Tcl_UnixError (searchCBPtr->interp), (char *) NULL);
  291.    return TCL_ERROR;
  292. }
  293.  
  294. /*
  295.  *-----------------------------------------------------------------------------
  296.  *
  297.  * Tcl_BsearchCmd --
  298.  *     Implements the TCL bsearch command:
  299.  *        bsearch filehandle key [retvar]
  300.  *
  301.  * Results:
  302.  *      Standard TCL results.
  303.  *
  304.  *-----------------------------------------------------------------------------
  305.  */
  306. int
  307. Tcl_BsearchCmd (clientData, interp, argc, argv)
  308.     ClientData  clientData;
  309.     Tcl_Interp *interp;
  310.     int         argc;
  311.     char      **argv;
  312. {
  313.     int           status;
  314.     binSearchCB_t searchCB;
  315.  
  316.     if ((argc < 3) || (argc > 5)) {
  317.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], 
  318.                           " handle key [retvar] [compare_proc]"
  319.                           , (char *) NULL);
  320.         return TCL_ERROR;
  321.     }
  322.  
  323.     searchCB.interp = interp;
  324.     searchCB.fileHandle = argv [1];
  325.     searchCB.key = argv [2];
  326.     searchCB.tclProc = (argc == 5) ? argv [4] : NULL;
  327.     Tcl_DynBufInit (&searchCB.dynBuf);
  328.  
  329.     status = BinSearch (&searchCB);
  330.     if (status == TCL_ERROR) {
  331.         Tcl_DynBufFree (&searchCB.dynBuf);
  332.         return TCL_ERROR;
  333.     }
  334.  
  335.     if (status == TCL_BREAK) {
  336.         Tcl_DynBufFree (&searchCB.dynBuf);
  337.         if ((argc >= 4) && (argv [3][0] != '\0'))
  338.             interp->result = "0";
  339.         return TCL_OK;
  340.     }
  341.  
  342.     if ((argc == 3) || (argv [3][0] == '\0')) {
  343.         Tcl_DynBufReturn (interp, &searchCB.dynBuf);
  344.     } else {
  345.         char *varPtr;
  346.  
  347.         varPtr = Tcl_SetVar (interp, argv[3], searchCB.dynBuf.ptr,
  348.                              TCL_LEAVE_ERR_MSG);
  349.         Tcl_DynBufFree (&searchCB.dynBuf);
  350.         if (varPtr == NULL)
  351.             return TCL_ERROR;
  352.         interp->result = "1";
  353.     }
  354.     return TCL_OK;
  355. }
  356.