git.zerfleddert.de Git - micropolis/blob - src/tclx/src/tclxbsrc.c

   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 "tclxint.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 static int
  40 StandardKeyCompare _ANSI_ARGS_((char *key,
  41                                 char *line));
  42
  43 static int
  44 TclProcKeyCompare _ANSI_ARGS_((binSearchCB_t *searchCBPtr));
  45
  46 static int
  47 ReadAndCompare _ANSI_ARGS_((long           fileOffset,
  48                             binSearchCB_t *searchCBPtr));
  49
  50 static 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 \f
  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 \f
 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 \f
 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 \f
 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 }