1/* 2 * tclXbsearch.c 3 * 4 * Extended Tcl binary file search command. 5 *----------------------------------------------------------------------------- 6 * Copyright 1991-1999 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 1.3 2005/04/26 20:01:33 hobbs Exp $ 16 *----------------------------------------------------------------------------- 17 */ 18 19#include "tclExtdInt.h" 20 21/* 22 * Control block used to pass data used by the binary search routines. 23 */ 24typedef struct binSearchCB_t { 25 Tcl_Interp *interp; /* Pointer to the interpreter. */ 26 char *key; /* The key to search for. */ 27 28 Tcl_Channel channel; /* I/O channel. */ 29 Tcl_DString lineBuf; /* Dynamic buffer to hold a line of file. */ 30 off_t lastRecOffset; /* Offset of last record read. */ 31 int cmpResult; /* -1, 0 or 1 result of string compare. */ 32 char *tclProc; /* Name of Tcl comparsion proc, or NULL. */ 33 } binSearchCB_t; 34 35/* 36 * Prototypes of internal functions. 37 */ 38static int 39StandardKeyCompare _ANSI_ARGS_((char *key, 40 char *line)); 41 42static int 43TclProcKeyCompare _ANSI_ARGS_((binSearchCB_t *searchCBPtr)); 44 45static int 46ReadAndCompare _ANSI_ARGS_((off_t fileOffset, 47 binSearchCB_t *searchCBPtr)); 48 49static int 50BinSearch _ANSI_ARGS_((binSearchCB_t *searchCBPtr)); 51 52static int 53TclX_BsearchObjCmd _ANSI_ARGS_((ClientData clientData, 54 Tcl_Interp *interp, 55 int objc, 56 Tcl_Obj *CONST objv[])); 57 58/*----------------------------------------------------------------------------- 59 * 60 * StandardKeyCompare -- 61 * Standard comparison routine for BinSearch, compares the key to the 62 * first white-space seperated field in the line. 63 * 64 * Parameters: 65 * o key (I) - The key to search for. 66 * o line (I) - The line to compare the key to. 67 * 68 * Results: 69 * o < 0 if key < line-key 70 * o = 0 if key == line-key 71 * o > 0 if key > line-key. 72 *----------------------------------------------------------------------------- 73 */ 74static int 75StandardKeyCompare (key, line) 76 char *key; 77 char *line; 78{ 79 int cmpResult, fieldLen; 80 char saveChar; 81 82 fieldLen = strcspn (line, " \t\r\n\v\f"); 83 84 saveChar = line [fieldLen]; 85 line [fieldLen] = 0; 86 cmpResult = strcmp (key, line); 87 line [fieldLen] = saveChar; 88 89 return cmpResult; 90} 91 92/*----------------------------------------------------------------------------- 93 * TclProcKeyCompare -- 94 * Comparison routine for BinSearch that runs a Tcl procedure to, 95 * compare the key to a line from the file. 96 * 97 * Parameters: 98 * o searchCBPtr (I/O) - The search control block, the line should be in 99 * lineBuf, the comparsion result is returned in cmpResult. 100 * 101 * Results: 102 * TCL_OK or TCL_ERROR. 103 *----------------------------------------------------------------------------- 104 */ 105static int 106TclProcKeyCompare (searchCBPtr) 107 binSearchCB_t *searchCBPtr; 108{ 109 CONST84 char *cmdArgv [3]; 110 char *command, *oldResult; 111 int result; 112 113 cmdArgv [0] = searchCBPtr->tclProc; 114 cmdArgv [1] = searchCBPtr->key; 115 cmdArgv [2] = searchCBPtr->lineBuf.string; 116 command = Tcl_Merge (3, cmdArgv); 117 118 result = Tcl_Eval (searchCBPtr->interp, command); 119 120 ckfree (command); 121 if (result == TCL_ERROR) 122 return TCL_ERROR; 123 124 if (Tcl_GetIntFromObj (searchCBPtr->interp, 125 Tcl_GetObjResult (searchCBPtr->interp), 126 &searchCBPtr->cmpResult) != TCL_OK) { 127 oldResult = Tcl_GetStringFromObj ( 128 Tcl_GetObjResult (searchCBPtr->interp), NULL); 129 oldResult = ckstrdup (oldResult); 130 131 Tcl_ResetResult (searchCBPtr->interp); 132 TclX_AppendObjResult (searchCBPtr->interp, "invalid integer \"", 133 oldResult, "\" returned from compare proc \"", 134 searchCBPtr->tclProc, "\"", (char *) NULL); 135 ckfree (oldResult); 136 return TCL_ERROR; 137 } 138 Tcl_ResetResult (searchCBPtr->interp); 139 return TCL_OK; 140} 141 142/*----------------------------------------------------------------------------- 143 * ReadAndCompare -- 144 * Search for the next line in the file starting at the specified 145 * offset. Read the line into the dynamic buffer and compare it to 146 * the key using the specified comparison method. The start of the 147 * last line read is saved in the control block, and if the start of 148 * the same line is found in the search, then it will not be recompared. 149 * This is needed since the search algorithm has to hit the same line 150 * a couple of times before failing, due to the fact that the records are 151 * not fixed length. 152 * 153 * Parameters: 154 * o fileOffset (I) - The offset of the next byte of the search, not 155 * necessarly the start of a record. 156 * o searchCBPtr (I/O) - The search control block, the comparsion result 157 * is returned in cmpResult. If the EOF is hit, a less-than result is 158 * returned. 159 * 160 * Results: 161 * TCL_OK or TCL_ERROR. 162 *----------------------------------------------------------------------------- 163 */ 164static int 165ReadAndCompare (fileOffset, searchCBPtr) 166 off_t fileOffset; 167 binSearchCB_t *searchCBPtr; 168{ 169 if (Tcl_Seek (searchCBPtr->channel, fileOffset, SEEK_SET) < 0) 170 goto posixError; 171 172 /* 173 * Go to beginning of next line by reading the remainder of the current 174 * one. 175 */ 176 if (fileOffset != 0) { 177 if (Tcl_Gets (searchCBPtr->channel, &searchCBPtr->lineBuf) < 0) { 178 if (Tcl_Eof (searchCBPtr->channel) || 179 Tcl_InputBlocked (searchCBPtr->channel)) { 180 TclX_AppendObjResult (searchCBPtr->interp, 181 "bsearch got unexpected EOF on \"", 182 Tcl_GetChannelName (searchCBPtr->channel), 183 "\"", (char *) NULL); 184 return TCL_ERROR; 185 } 186 goto posixError; 187 } 188 } 189 fileOffset = (off_t) Tcl_Tell (searchCBPtr->channel); /* Offset of next line */ 190 191 /* 192 * If this is the same line as before, then just leave the comparison 193 * result unchanged. 194 */ 195 if (fileOffset == searchCBPtr->lastRecOffset) 196 return TCL_OK; 197 198 searchCBPtr->lastRecOffset = fileOffset; 199 200 Tcl_DStringSetLength (&searchCBPtr->lineBuf, 0); 201 202 /* 203 * Read the line. Only compare if EOF was not hit, otherwise, treat as if 204 * we went above the key we are looking for. 205 */ 206 if (Tcl_Gets (searchCBPtr->channel, &searchCBPtr->lineBuf) < 0) { 207 if (Tcl_Eof (searchCBPtr->channel) || 208 Tcl_InputBlocked (searchCBPtr->channel)) { 209 searchCBPtr->cmpResult = -1; 210 return TCL_OK; 211 } 212 goto posixError; 213 } 214 215 /* 216 * Compare the line. 217 */ 218 if (searchCBPtr->tclProc == NULL) { 219 searchCBPtr->cmpResult = 220 StandardKeyCompare (searchCBPtr->key, 221 searchCBPtr->lineBuf.string); 222 } else { 223 if (TclProcKeyCompare (searchCBPtr) != TCL_OK) 224 return TCL_ERROR; 225 } 226 227 return TCL_OK; 228 229 posixError: 230 TclX_AppendObjResult (searchCBPtr->interp, 231 Tcl_GetChannelName (searchCBPtr->channel), ": ", 232 Tcl_PosixError (searchCBPtr->interp), (char *) NULL); 233 return TCL_ERROR; 234} 235 236/*----------------------------------------------------------------------------- 237 * BinSearch -- 238 * Binary search a sorted ASCII file. 239 * 240 * Parameters: 241 * o searchCBPtr (I/O) - The search control block, if the line is found, 242 * it is returned in lineBuf. 243 * Results: 244 * TCL_OK - If the key was found. 245 * TCL_BREAK - If it was not found. 246 * TCL_ERROR - If there was an error. 247 * 248 * based on getpath.c from smail 2.5 (9/15/87) 249 * 250 *----------------------------------------------------------------------------- 251 */ 252static int 253BinSearch (searchCBPtr) 254 binSearchCB_t *searchCBPtr; 255{ 256 off_t middle, high, low; 257 258 low = 0; 259 if (TclXOSGetFileSize (searchCBPtr->channel, &high) != TCL_OK) 260 goto posixError; 261 262 /* 263 * "Binary search routines are never written right the first time around." 264 * - Robert G. Sheldon. 265 */ 266 267 while (TRUE) { 268 middle = (high + low + 1) / 2; 269 270 if (ReadAndCompare (middle, searchCBPtr) != TCL_OK) 271 return TCL_ERROR; 272 273 if (searchCBPtr->cmpResult == 0) 274 return TCL_OK; /* Found */ 275 276 if (low >= middle) 277 return TCL_BREAK; /* Failure */ 278 279 /* 280 * Close window. 281 */ 282 if (searchCBPtr->cmpResult > 0) { 283 low = middle; 284 } else { 285 high = middle - 1; 286 } 287 } 288 289 posixError: 290 TclX_AppendObjResult (searchCBPtr->interp, 291 Tcl_GetChannelName (searchCBPtr->channel), ": ", 292 Tcl_PosixError (searchCBPtr->interp), (char *) NULL); 293 return TCL_ERROR; 294} 295 296/*----------------------------------------------------------------------------- 297 * TclX_BsearchObjCmd -- 298 * Implements the TCL bsearch command: 299 * bsearch filehandle key ?retvar? 300 *----------------------------------------------------------------------------- 301 */ 302static int 303TclX_BsearchObjCmd (clientData, interp, objc, objv) 304 ClientData clientData; 305 Tcl_Interp *interp; 306 int objc; 307 Tcl_Obj *CONST objv[]; 308{ 309 int status; 310 binSearchCB_t searchCB; 311 312 if ((objc < 3) || (objc > 5)) { 313 TclX_WrongArgs (interp, objv [0], 314 "handle key ?retvar? ?compare_proc?"); 315 return TCL_ERROR; 316 } 317 318 searchCB.channel = TclX_GetOpenChannelObj (interp, 319 objv [1], 320 TCL_READABLE); 321 if (searchCB.channel == NULL) 322 return TCL_ERROR; 323 324 searchCB.interp = interp; 325 searchCB.key = Tcl_GetStringFromObj (objv [2], NULL); 326 searchCB.lastRecOffset = -1; 327 searchCB.tclProc = (objc == 5) ? Tcl_GetStringFromObj (objv [4], NULL) : 328 NULL; 329 330 Tcl_DStringInit (&searchCB.lineBuf); 331 332 status = BinSearch (&searchCB); 333 if (status == TCL_ERROR) { 334 Tcl_DStringFree (&searchCB.lineBuf); 335 return TCL_ERROR; 336 } 337 338 if (status == TCL_BREAK) { 339 if ((objc >= 4) && !TclX_IsNullObj (objv [3])) 340 Tcl_SetBooleanObj (Tcl_GetObjResult (interp), FALSE); 341 goto okExit; 342 } 343 344 if ((objc == 3) || TclX_IsNullObj (objv [3])) { 345 Tcl_SetStringObj (Tcl_GetObjResult (interp), 346 Tcl_DStringValue (&searchCB.lineBuf), 347 -1); 348 } else { 349 Tcl_Obj *valPtr; 350 351 valPtr = Tcl_NewStringObj (Tcl_DStringValue (&searchCB.lineBuf), 352 -1); 353 if (Tcl_ObjSetVar2(interp, objv[3], NULL, valPtr, 354 TCL_PARSE_PART1|TCL_LEAVE_ERR_MSG) == NULL) { 355 Tcl_DecrRefCount (valPtr); 356 goto errorExit; 357 } 358 Tcl_SetBooleanObj (Tcl_GetObjResult (interp), TRUE); 359 } 360 361 okExit: 362 Tcl_DStringFree (&searchCB.lineBuf); 363 return TCL_OK; 364 365 errorExit: 366 Tcl_DStringFree (&searchCB.lineBuf); 367 return TCL_OK; 368} 369 370/*----------------------------------------------------------------------------- 371 * TclX_BsearchInit -- 372 * Initialize the bsearch command. 373 *----------------------------------------------------------------------------- 374 */ 375void 376TclX_BsearchInit (interp) 377 Tcl_Interp *interp; 378{ 379 Tcl_CreateObjCommand (interp, 380 "bsearch", 381 TclX_BsearchObjCmd, 382 (ClientData) NULL, 383 (Tcl_CmdDeleteProc*) NULL); 384} 385