| 1 | Unit TextSearchQuery;
 | 
|---|
| 2 | 
 | 
|---|
| 3 | // NewView - a new OS/2 Help Viewer
 | 
|---|
| 4 | // Copyright 2003 Aaron Lawrence (aaronl at consultant dot com)
 | 
|---|
| 5 | // This software is released under the Gnu Public License - see readme.txt
 | 
|---|
| 6 | 
 | 
|---|
| 7 | Interface
 | 
|---|
| 8 | 
 | 
|---|
| 9 | // Encapsulates a parsed search query.
 | 
|---|
| 10 | 
 | 
|---|
| 11 | uses
 | 
|---|
| 12 |   Classes,
 | 
|---|
| 13 |   SysUtils;
 | 
|---|
| 14 | 
 | 
|---|
| 15 | Type
 | 
|---|
| 16 |   ESearchSyntaxError = class( Exception )
 | 
|---|
| 17 |   end;
 | 
|---|
| 18 | 
 | 
|---|
| 19 |   TSearchTermCombineMethod =
 | 
|---|
| 20 |   (
 | 
|---|
| 21 |     cmOptional,
 | 
|---|
| 22 |     cmRequired,
 | 
|---|
| 23 |     cmExcluded
 | 
|---|
| 24 |   );
 | 
|---|
| 25 | 
 | 
|---|
| 26 |   TSearchTerm = class
 | 
|---|
| 27 |     Text: string;
 | 
|---|
| 28 |     Parts: TStringList;
 | 
|---|
| 29 |     CombineMethod: TSearchTermCombineMethod;
 | 
|---|
| 30 | 
 | 
|---|
| 31 |     constructor Create( const aText: string;
 | 
|---|
| 32 |                         const aCombineMethod: TSearchTermCombineMethod );
 | 
|---|
| 33 |     destructor Destroy; override;
 | 
|---|
| 34 | 
 | 
|---|
| 35 |     function AsLogText: String;
 | 
|---|
| 36 |   end;
 | 
|---|
| 37 | 
 | 
|---|
| 38 |   TTextSearchQuery = class
 | 
|---|
| 39 |   protected
 | 
|---|
| 40 |     Terms: TList;
 | 
|---|
| 41 |     function GetTerm( Index: longint ): TSearchTerm;
 | 
|---|
| 42 |     function GetTermCount: longint;
 | 
|---|
| 43 |   public
 | 
|---|
| 44 |     constructor Create(const aSearchString: String);
 | 
|---|
| 45 |     destructor Destroy; override;
 | 
|---|
| 46 | 
 | 
|---|
| 47 |     property Term[ Index: longint ]: TSearchTerm read GetTerm;
 | 
|---|
| 48 |     property TermCount: longint read GetTermCount;
 | 
|---|
| 49 | 
 | 
|---|
| 50 |     procedure Log;
 | 
|---|
| 51 |   end;
 | 
|---|
| 52 | 
 | 
|---|
| 53 | Implementation
 | 
|---|
| 54 | 
 | 
|---|
| 55 | uses
 | 
|---|
| 56 |   ACLUtility,
 | 
|---|
| 57 |   ACLLanguageUnit,
 | 
|---|
| 58 |   CharUtilsUnit,
 | 
|---|
| 59 |   StringUtilsUnit,
 | 
|---|
| 60 |   DebugUnit;
 | 
|---|
| 61 | 
 | 
|---|
| 62 | var
 | 
|---|
| 63 |   QueryErrorMissingWord1: string;
 | 
|---|
| 64 |   QueryErrorMissingWord2: string;
 | 
|---|
| 65 | 
 | 
|---|
| 66 | Procedure OnLanguageEvent( Language: TLanguageFile;
 | 
|---|
| 67 |                            const Apply: boolean );
 | 
|---|
| 68 | begin
 | 
|---|
| 69 |   Language.Prefix := 'SearchQuery.';
 | 
|---|
| 70 |   Language.LL( Apply, QueryErrorMissingWord1, 'QueryErrorMissingWord1', 'No search word given after ' );
 | 
|---|
| 71 |   Language.LL( Apply, QueryErrorMissingWord2, 'QueryErrorMissingWord2', ' before ' );
 | 
|---|
| 72 | end;
 | 
|---|
| 73 | 
 | 
|---|
| 74 | 
 | 
|---|
| 75 | constructor TTextSearchQuery.Create(const aSearchString: string);
 | 
|---|
| 76 | var
 | 
|---|
| 77 |   tmpTermText: string;
 | 
|---|
| 78 |   tmpCombineMethod: TSearchTermCombineMethod;
 | 
|---|
| 79 |   Term: TSearchTerm;
 | 
|---|
| 80 |   tmpTerms : TStringList;
 | 
|---|
| 81 |   i : integer;
 | 
|---|
| 82 | begin
 | 
|---|
| 83 |   Terms := TList.Create;
 | 
|---|
| 84 |   try
 | 
|---|
| 85 |     tmpTerms := TStringList.Create;
 | 
|---|
| 86 |     StrExtractStringsQuoted(tmpTerms, aSearchString);
 | 
|---|
| 87 | 
 | 
|---|
| 88 |     for i := 0 to tmpTerms.count-1 do
 | 
|---|
| 89 |     begin
 | 
|---|
| 90 |       tmpTermText := tmpTerms[i];
 | 
|---|
| 91 | 
 | 
|---|
| 92 |       // Check for modifiers:
 | 
|---|
| 93 |       //  + word must be matched
 | 
|---|
| 94 |       //  - word must not be matched
 | 
|---|
| 95 |       case tmpTermText[ 1 ] of
 | 
|---|
| 96 |        '+':
 | 
|---|
| 97 |          tmpCombineMethod := cmRequired;
 | 
|---|
| 98 |        '-':
 | 
|---|
| 99 |          tmpCombineMethod := cmExcluded;
 | 
|---|
| 100 |        else
 | 
|---|
| 101 |          tmpCombineMethod := cmOptional;
 | 
|---|
| 102 |       end;
 | 
|---|
| 103 | 
 | 
|---|
| 104 |       if tmpCombineMethod <> cmOptional then
 | 
|---|
| 105 |       begin
 | 
|---|
| 106 |         // delete + or -
 | 
|---|
| 107 |         if Length( tmpTermText ) = 1 then
 | 
|---|
| 108 |           if (i < tmpTerms.count-1) then
 | 
|---|
| 109 |             raise ESearchSyntaxError.Create( QueryErrorMissingWord1
 | 
|---|
| 110 |                                              + StrInDoubleQuotes(tmpTermText)
 | 
|---|
| 111 |                                              + QueryErrorMissingWord2
 | 
|---|
| 112 |                                              + StrInDoubleQuotes(tmpTerms[i+1]) )
 | 
|---|
| 113 |           else
 | 
|---|
| 114 |             raise ESearchSyntaxError.Create( QueryErrorMissingWord1
 | 
|---|
| 115 |                                              + StrInDoubleQuotes(tmpTermText));
 | 
|---|
| 116 |         Delete( tmpTermText, 1, 1 );
 | 
|---|
| 117 |       end;
 | 
|---|
| 118 | 
 | 
|---|
| 119 |       Term := TSearchTerm.Create( tmpTermText, tmpCombineMethod );
 | 
|---|
| 120 |       Terms.Add( Term );
 | 
|---|
| 121 |     end;
 | 
|---|
| 122 |     tmpTerms.Destroy;
 | 
|---|
| 123 |   except
 | 
|---|
| 124 |     tmpTerms.Destroy;
 | 
|---|
| 125 |     Destroy; // clean up
 | 
|---|
| 126 |     raise; // reraise exception
 | 
|---|
| 127 |   end;
 | 
|---|
| 128 | end;
 | 
|---|
| 129 | 
 | 
|---|
| 130 | 
 | 
|---|
| 131 | destructor TTextSearchQuery.Destroy;
 | 
|---|
| 132 | begin
 | 
|---|
| 133 |   DestroyListObjects( Terms );
 | 
|---|
| 134 |   Terms.Destroy;
 | 
|---|
| 135 | end;
 | 
|---|
| 136 | 
 | 
|---|
| 137 | 
 | 
|---|
| 138 | function TSearchTerm.AsLogText: String;
 | 
|---|
| 139 | var
 | 
|---|
| 140 |   i : integer;
 | 
|---|
| 141 | begin
 | 
|---|
| 142 |   result := 'TSearchTerm: ''' + text + '''  (' + IntToStr(Parts.Count) + ' parts; ';
 | 
|---|
| 143 | 
 | 
|---|
| 144 |   case CombineMethod of
 | 
|---|
| 145 |   cmRequired :
 | 
|---|
| 146 |     result := result + 'cmRequired';
 | 
|---|
| 147 |   cmExcluded :
 | 
|---|
| 148 |     result := result + 'cmExcluded';
 | 
|---|
| 149 |   cmOptional :
 | 
|---|
| 150 |     result := result + 'cmOptional';
 | 
|---|
| 151 |   end;
 | 
|---|
| 152 | 
 | 
|---|
| 153 |   result := result + ')';
 | 
|---|
| 154 | end;
 | 
|---|
| 155 | 
 | 
|---|
| 156 | 
 | 
|---|
| 157 | 
 | 
|---|
| 158 | function TTextSearchQuery.GetTerm( index: longint ): TSearchTerm;
 | 
|---|
| 159 | begin
 | 
|---|
| 160 |   Result := Terms[ Index ];
 | 
|---|
| 161 | end;
 | 
|---|
| 162 | 
 | 
|---|
| 163 | 
 | 
|---|
| 164 | function TTextSearchQuery.GetTermCount: longint;
 | 
|---|
| 165 | begin
 | 
|---|
| 166 |   Result := Terms.Count;
 | 
|---|
| 167 | end;
 | 
|---|
| 168 | 
 | 
|---|
| 169 | 
 | 
|---|
| 170 | constructor TSearchTerm.Create( const aText: string;
 | 
|---|
| 171 |                                 const aCombineMethod: TSearchTermCombineMethod );
 | 
|---|
| 172 | var
 | 
|---|
| 173 |   TermParseIndex: longint;
 | 
|---|
| 174 |   TermChar: char;
 | 
|---|
| 175 |   TermPart: string;
 | 
|---|
| 176 | begin
 | 
|---|
| 177 |   Parts := TStringList.Create;
 | 
|---|
| 178 | 
 | 
|---|
| 179 |   Text := aText;
 | 
|---|
| 180 |   CombineMethod := aCombineMethod;
 | 
|---|
| 181 | 
 | 
|---|
| 182 |   // Break out each part of the term as IPF does:
 | 
|---|
| 183 |   // consecutive alphanumeric chars become a "word"
 | 
|---|
| 184 |   // but each symbol is a separate word, and symbols break
 | 
|---|
| 185 |   // up alphanumerics into multiple words. e.g.
 | 
|---|
| 186 |   // CAKE_SAUSAGE becomes three words in IPF,
 | 
|---|
| 187 |   // one each for "CAKE" "_" and "SAUSAGE"
 | 
|---|
| 188 | 
 | 
|---|
| 189 |   TermParseIndex := 1;
 | 
|---|
| 190 |   while TermParseIndex <= Length( Text ) do
 | 
|---|
| 191 |   begin
 | 
|---|
| 192 |     // collect alphanumeric chars
 | 
|---|
| 193 |     TermPart := '';
 | 
|---|
| 194 |     while TermParseIndex <= Length( Text ) do
 | 
|---|
| 195 |     begin
 | 
|---|
| 196 |       TermChar := Text[ TermParseIndex ];
 | 
|---|
| 197 |       if  (    CharIsAlpha( TermChar )
 | 
|---|
| 198 |             or CharIsDigit( TermChar ) ) then
 | 
|---|
| 199 |       begin
 | 
|---|
| 200 |         // alpha numeric, collect it
 | 
|---|
| 201 |         TermPart := TermPart + TermChar;
 | 
|---|
| 202 |         inc( TermParseIndex );
 | 
|---|
| 203 |       end
 | 
|---|
| 204 |       else
 | 
|---|
| 205 |       begin
 | 
|---|
| 206 |         // not alpha numeric, so stop
 | 
|---|
| 207 |         break;
 | 
|---|
| 208 |       end;
 | 
|---|
| 209 |     end;
 | 
|---|
| 210 |     if Length( TermPart ) > 0 then
 | 
|---|
| 211 |     begin
 | 
|---|
| 212 |       Parts.Add( TermPart ); // add collected alphanumeric part
 | 
|---|
| 213 |     end;
 | 
|---|
| 214 | 
 | 
|---|
| 215 |     if TermParseIndex <= Length( Text ) then
 | 
|---|
| 216 |     begin
 | 
|---|
| 217 |       // must be a symbol,
 | 
|---|
| 218 |       // each symbol (excluding space) is an individual item
 | 
|---|
| 219 |       if Text[ TermParseIndex ] <> ' ' then
 | 
|---|
| 220 |         Parts.Add( Text[ TermParseIndex ] );
 | 
|---|
| 221 |       inc( TermParseIndex );
 | 
|---|
| 222 |     end;
 | 
|---|
| 223 | 
 | 
|---|
| 224 |   end;
 | 
|---|
| 225 | 
 | 
|---|
| 226 | end;
 | 
|---|
| 227 | 
 | 
|---|
| 228 | destructor TSearchTerm.Destroy;
 | 
|---|
| 229 | begin
 | 
|---|
| 230 |   Parts.Destroy;
 | 
|---|
| 231 | end;
 | 
|---|
| 232 | 
 | 
|---|
| 233 | 
 | 
|---|
| 234 | procedure TTextSearchQuery.Log;
 | 
|---|
| 235 | var
 | 
|---|
| 236 |   i : longint;
 | 
|---|
| 237 | begin
 | 
|---|
| 238 |   if IsLogAspectsEnabled(LogSearch) then
 | 
|---|
| 239 |   begin
 | 
|---|
| 240 |     LogEvent(LogSearch, ' TTextSearchQuery:');
 | 
|---|
| 241 | 
 | 
|---|
| 242 |     for i := 0 to TermCount - 1 do
 | 
|---|
| 243 |     begin
 | 
|---|
| 244 |       LogEvent(LogSearch, '  Term ' + IntToStr(0) + ' [' + Term[i].AsLogText + ']');
 | 
|---|
| 245 |     end;
 | 
|---|
| 246 |   end;
 | 
|---|
| 247 | end;
 | 
|---|
| 248 | 
 | 
|---|
| 249 | 
 | 
|---|
| 250 | 
 | 
|---|
| 251 | Initialization
 | 
|---|
| 252 |    RegisterProcForLanguages( OnLanguageEvent );
 | 
|---|
| 253 | End.
 | 
|---|