1 {
2 **********************************************************************
3 This file is part of LazUtils.
4
5 See the file COPYING.modifiedLGPL.txt, included in this distribution,
6 for details about the license.
7 **********************************************************************
8 }
9 unit LazFileCache;
10
11 {$mode objfpc}{$H+}
12
13 interface
14
15 uses
16 Classes, SysUtils, Laz_AVL_Tree,
17 LazDbgLog, LazFileUtils;
18
19 type
20 TFileStateCacheItemFlag = (
21 fsciExists, // file or directory exists
22 fsciDirectory, // file exists and is directory
23 fsciReadable, // file is readable
24 fsciWritable, // file is writable
25 fsciDirectoryReadable, // file is directory and can be searched
26 fsciDirectoryWritable, // file is directory and new files can be created
27 fsciText, // file is text file (not binary)
28 fsciExecutable,// file is executable
29 fsciAge, // file age is valid
30 fsciPhysical // physical filename is valid
31 );
32 TFileStateCacheItemFlags = set of TFileStateCacheItemFlag;
33
34 { TFileStateCacheItem }
35
36 TFileStateCacheItem = class
37 private
38 FAge: longint;
39 FFilename: string;
40 FFlags: TFileStateCacheItemFlags;
41 FPhysicalFilename: string;
42 FTestedFlags: TFileStateCacheItemFlags;
43 FTimeStamp: int64;
44 public
45 constructor Create(const TheFilename: string; NewTimeStamp: int64);
CalcMemSizenull46 function CalcMemSize: PtrUint;
47 public
48 property Filename: string read FFilename;
49 property PhysicalFilename: string read FPhysicalFilename;
50 property Flags: TFileStateCacheItemFlags read FFlags;
51 property TestedFlags: TFileStateCacheItemFlags read FTestedFlags;
52 property TimeStamp: int64 read FTimeStamp;
53 property Age: longint read FAge;
54 end;
55
56 TOnChangeFileStateTimeStamp = procedure(Sender: TObject;
57 const AFilename: string) of object;
58
59 { TFileStateCache }
60
61 TFileStateCache = class
62 private
63 FFiles: TAVLTree; // tree of TFileStateCacheItem
64 FTimeStamp: int64;
65 FLockCount: integer;
66 FChangeTimeStampHandler: array of TOnChangeFileStateTimeStamp;
67 procedure SetFlag(AFile: TFileStateCacheItem;
68 AFlag: TFileStateCacheItemFlag; NewValue: boolean);
69 public
70 constructor Create;
71 destructor Destroy; override;
72 procedure Lock;
73 procedure Unlock;
Lockednull74 function Locked: boolean;
75 procedure IncreaseTimeStamp(const AFilename: string);
FileExistsCachednull76 function FileExistsCached(const AFilename: string): boolean;
DirPathExistsCachednull77 function DirPathExistsCached(const AFilename: string): boolean;
DirectoryIsWritableCachednull78 function DirectoryIsWritableCached(const DirectoryName: string): boolean;
FileIsExecutableCachednull79 function FileIsExecutableCached(const AFilename: string): boolean;
FileIsReadableCachednull80 function FileIsReadableCached(const AFilename: string): boolean;
FileIsWritableCachednull81 function FileIsWritableCached(const AFilename: string): boolean;
FileIsTextCachednull82 function FileIsTextCached(const AFilename: string): boolean;
FileAgeCachednull83 function FileAgeCached(const AFileName: string): Longint;
GetPhysicalFilenameCachednull84 function GetPhysicalFilenameCached(const AFileName: string; {%H-}EmptyOnError: boolean): string;
FindFilenull85 function FindFile(const Filename: string;
86 CreateIfNotExists: boolean): TFileStateCacheItem;
Checknull87 function Check(const Filename: string; AFlag: TFileStateCacheItemFlag;
88 out AFile: TFileStateCacheItem; var FlagIsSet: boolean): boolean;
89 procedure AddChangeTimeStampHandler(const Handler: TOnChangeFileStateTimeStamp);
90 procedure RemoveChangeTimeStampHandler(const Handler: TOnChangeFileStateTimeStamp);
CalcMemSizenull91 function CalcMemSize: PtrUint;
92 public
93 property TimeStamp: int64 read FTimeStamp;
94 end;
95
96 var
97 FileStateCache: TFileStateCache = nil;
98
FileExistsCachednull99 function FileExistsCached(const AFilename: string): boolean;
DirPathExistsCachednull100 function DirPathExistsCached(const AFilename: string): boolean;
DirectoryIsWritableCachednull101 function DirectoryIsWritableCached(const ADirectoryName: string): boolean;
FileIsExecutableCachednull102 function FileIsExecutableCached(const AFilename: string): boolean;
FileIsReadableCachednull103 function FileIsReadableCached(const AFilename: string): boolean;
FileIsWritableCachednull104 function FileIsWritableCached(const AFilename: string): boolean;
FileIsTextCachednull105 function FileIsTextCached(const AFilename: string): boolean;
FileAgeCachednull106 function FileAgeCached(const AFileName: string): Longint;
GetPhysicalFilenameCachednull107 function GetPhysicalFilenameCached(const AFilename: string; EmptyOnError: boolean): string;
108
109 procedure InvalidateFileStateCache(const Filename: string = ''); inline;
CompareFileStateItemsnull110 function CompareFileStateItems(Data1, Data2: Pointer): integer;
CompareFilenameWithFileStateCacheItemnull111 function CompareFilenameWithFileStateCacheItem(Key, Data: Pointer): integer;
112
113 const
114 LUInvalidChangeStamp = Low(integer);
115 LUInvalidChangeStamp64 = Low(int64); // using a value outside integer to spot wrong types early
116 procedure LUIncreaseChangeStamp(var ChangeStamp: integer); inline;
117 procedure LUIncreaseChangeStamp64(var ChangeStamp: int64); inline;
118
119 type
ilenamenull120 TOnFileExistsCached = function(Filename: string): boolean of object;
ilenamenull121 TOnFileAgeCached = function(Filename: string): longint of object;
122 var
123 OnFileExistsCached: TOnFileExistsCached = nil;
124 OnFileAgeCached: TOnFileAgeCached = nil;
125
126 implementation
127
128
FileExistsCachednull129 function FileExistsCached(const AFilename: string): boolean;
130 begin
131 if OnFileExistsCached<>nil then
132 Result:=OnFileExistsCached(AFilename)
133 else if FileStateCache<>nil then
134 Result:=FileStateCache.FileExistsCached(AFilename)
135 else
136 Result:=FileExistsUTF8(AFilename);
137 end;
138
DirPathExistsCachednull139 function DirPathExistsCached(const AFilename: string): boolean;
140 begin
141 if FileStateCache<>nil then
142 Result:=FileStateCache.DirPathExistsCached(AFilename)
143 else
144 Result:=DirPathExists(AFilename);
145 end;
146
DirectoryIsWritableCachednull147 function DirectoryIsWritableCached(const ADirectoryName: string): boolean;
148 begin
149 if FileStateCache<>nil then
150 Result:=FileStateCache.DirectoryIsWritableCached(ADirectoryName)
151 else
152 Result:=DirectoryIsWritable(ADirectoryName);
153 end;
154
FileIsExecutableCachednull155 function FileIsExecutableCached(const AFilename: string): boolean;
156 begin
157 if FileStateCache<>nil then
158 Result:=FileStateCache.FileIsExecutableCached(AFilename)
159 else
160 Result:=FileIsExecutable(AFilename);
161 end;
162
FileIsReadableCachednull163 function FileIsReadableCached(const AFilename: string): boolean;
164 begin
165 if FileStateCache<>nil then
166 Result:=FileStateCache.FileIsReadableCached(AFilename)
167 else
168 Result:=FileIsReadable(AFilename);
169 end;
170
FileIsWritableCachednull171 function FileIsWritableCached(const AFilename: string): boolean;
172 begin
173 if FileStateCache<>nil then
174 Result:=FileStateCache.FileIsWritableCached(AFilename)
175 else
176 Result:=FileIsWritable(AFilename);
177 end;
178
FileIsTextCachednull179 function FileIsTextCached(const AFilename: string): boolean;
180 begin
181 if FileStateCache<>nil then
182 Result:=FileStateCache.FileIsTextCached(AFilename)
183 else
184 Result:=FileIsText(AFilename);
185 end;
186
FileAgeCachednull187 function FileAgeCached(const AFileName: string): Longint;
188 begin
189 if OnFileAgeCached<>nil then
190 Result:=OnFileAgeCached(AFilename)
191 else if FileStateCache<>nil then
192 Result:=FileStateCache.FileAgeCached(AFilename)
193 else
194 Result:=FileAgeUTF8(AFileName);
195 end;
196
GetPhysicalFilenameCachednull197 function GetPhysicalFilenameCached(const AFilename: string;
198 EmptyOnError: boolean): string;
199 var
200 OnError: TPhysicalFilenameOnError;
201 begin
202 if FileStateCache<>nil then
203 Result:=FileStateCache.GetPhysicalFilenameCached(AFilename,EmptyOnError)
204 else begin
205 if EmptyOnError then
206 OnError:=pfeEmpty
207 else
208 OnError:=pfeOriginal;
209 writeln('GetPhysicalFilenameCached GGG1');
210 Result:=GetPhysicalFilename(AFilename,OnError);
211 end;
212 end;
213
214 procedure InvalidateFileStateCache(const Filename: string);
215 begin
216 FileStateCache.IncreaseTimeStamp(Filename);
217 end;
218
CompareFileStateItemsnull219 function CompareFileStateItems(Data1, Data2: Pointer): integer;
220 begin
221 Result:=CompareFilenames(TFileStateCacheItem(Data1).FFilename,
222 TFileStateCacheItem(Data2).FFilename);
223 end;
224
CompareFilenameWithFileStateCacheItemnull225 function CompareFilenameWithFileStateCacheItem(Key, Data: Pointer): integer;
226 begin
227 Result:=CompareFilenames(AnsiString(Key),TFileStateCacheItem(Data).FFilename);
228 //debugln('CompareFilenameWithFileStateCacheItem Key=',AnsiString(Key),' Data=',TFileStateCacheItem(Data).FFilename,' Result=',dbgs(Result));
229 end;
230
231 procedure LUIncreaseChangeStamp(var ChangeStamp: integer);
232 begin
233 if ChangeStamp<High(ChangeStamp) then
234 inc(ChangeStamp)
235 else
236 ChangeStamp:=LUInvalidChangeStamp+1;
237 end;
238
239 procedure LUIncreaseChangeStamp64(var ChangeStamp: int64);
240 begin
241 if ChangeStamp<High(ChangeStamp) then
242 inc(ChangeStamp)
243 else
244 ChangeStamp:=LUInvalidChangeStamp64+1;
245 end;
246
247 { TFileStateCacheItem }
248
249 constructor TFileStateCacheItem.Create(const TheFilename: string;
250 NewTimeStamp: int64);
251 begin
252 FFilename:=TheFilename;
253 FTimeStamp:=NewTimeStamp;
254 end;
255
TFileStateCacheItem.CalcMemSizenull256 function TFileStateCacheItem.CalcMemSize: PtrUint;
257 begin
258 Result:=PtrUInt(InstanceSize)
259 +MemSizeString(FFilename)
260 +MemSizeString(FPhysicalFilename);
261 end;
262
263 { TFileStateCache }
264
265 procedure TFileStateCache.SetFlag(AFile: TFileStateCacheItem;
266 AFlag: TFileStateCacheItemFlag; NewValue: boolean);
267 begin
268 if AFile.FTimeStamp<>FTimeStamp then begin
269 AFile.FTestedFlags:=[];
270 AFile.FTimeStamp:=FTimeStamp;
271 end;
272 Include(AFile.FTestedFlags,AFlag);
273 if NewValue then
274 Include(AFile.FFlags,AFlag)
275 else
276 Exclude(AFile.FFlags,AFlag);
277 //WriteStr(s, AFlag);
278 //debugln('TFileStateCache.SetFlag AFile.Filename=',AFile.Filename,' ',s,'=',dbgs(AFlag in AFile.FFlags),' Valid=',dbgs(AFlag in AFile.FTestedFlags));
279 end;
280
281 constructor TFileStateCache.Create;
282 begin
283 FFiles:=TAVLTree.Create(@CompareFileStateItems);
284 LUIncreaseChangeStamp64(FTimeStamp); // one higher than default for new files
285 end;
286
287 destructor TFileStateCache.Destroy;
288 begin
289 FFiles.FreeAndClear;
290 FFiles.Free;
291 SetLength(FChangeTimeStampHandler,0);
292 inherited Destroy;
293 end;
294
295 procedure TFileStateCache.Lock;
296 begin
297 inc(FLockCount);
298 end;
299
300 procedure TFileStateCache.Unlock;
301
302 procedure RaiseTooManyUnlocks;
303 begin
304 raise Exception.Create('TFileStateCache.Unlock');
305 end;
306
307 begin
308 if FLockCount<=0 then RaiseTooManyUnlocks;
309 dec(FLockCount);
310 end;
311
Lockednull312 function TFileStateCache.Locked: boolean;
313 begin
314 Result:=FLockCount>0;
315 end;
316
317 procedure TFileStateCache.IncreaseTimeStamp(const AFilename: string);
318 var
319 i: Integer;
320 AFile: TFileStateCacheItem;
321 begin
322 if Self=nil then exit;
323 if AFilename='' then begin
324 // invalidate all
325 LUIncreaseChangeStamp64(FTimeStamp);
326 end else begin
327 // invalidate single file
328 AFile:=FindFile(AFilename,false);
329 if AFile<>nil then
330 AFile.FTestedFlags:=[];
331 end;
332 for i:=0 to length(FChangeTimeStampHandler)-1 do
333 FChangeTimeStampHandler[i](Self,AFilename);
334 //debugln('TFileStateCache.IncreaseTimeStamp FTimeStamp=',dbgs(FTimeStamp));
335 end;
336
TFileStateCache.FileExistsCachednull337 function TFileStateCache.FileExistsCached(const AFilename: string): boolean;
338 var
339 AFile: TFileStateCacheItem;
340 begin
341 Result := False;
342 if Check(AFilename,fsciExists,AFile,Result) then exit;
343 Result:=FileExistsUTF8(AFile.Filename);
344 SetFlag(AFile,fsciExists,Result);
345 {if not Check(Filename,fsciExists,AFile,Result) then begin
346 WriteDebugReport;
347 raise Exception.Create('');
348 end;}
349 end;
350
DirPathExistsCachednull351 function TFileStateCache.DirPathExistsCached(const AFilename: string): boolean;
352 var
353 AFile: TFileStateCacheItem;
354 begin
355 Result := False;
356 if Check(AFilename,fsciDirectory,AFile,Result) then exit;
357 Result:=DirPathExists(AFile.Filename);
358 SetFlag(AFile,fsciDirectory,Result);
359 end;
360
DirectoryIsWritableCachednull361 function TFileStateCache.DirectoryIsWritableCached(const DirectoryName: string
362 ): boolean;
363 var
364 AFile: TFileStateCacheItem;
365 begin
366 Result := False;
367 if Check(DirectoryName,fsciDirectoryWritable,AFile,Result) then exit;
368 Result:=DirectoryIsWritable(AFile.Filename);
369 SetFlag(AFile,fsciDirectoryWritable,Result);
370 end;
371
FileIsExecutableCachednull372 function TFileStateCache.FileIsExecutableCached(
373 const AFilename: string): boolean;
374 var
375 AFile: TFileStateCacheItem;
376 begin
377 Result := False;
378 if Check(AFilename,fsciExecutable,AFile,Result) then exit;
379 Result:=FileIsExecutable(AFile.Filename);
380 SetFlag(AFile,fsciExecutable,Result);
381 end;
382
TFileStateCache.FileIsReadableCachednull383 function TFileStateCache.FileIsReadableCached(const AFilename: string): boolean;
384 var
385 AFile: TFileStateCacheItem;
386 begin
387 Result := False;
388 if Check(AFilename,fsciReadable,AFile,Result) then exit;
389 Result:=FileIsReadable(AFile.Filename);
390 SetFlag(AFile,fsciReadable,Result);
391 end;
392
FileIsWritableCachednull393 function TFileStateCache.FileIsWritableCached(const AFilename: string): boolean;
394 var
395 AFile: TFileStateCacheItem;
396 begin
397 Result := False;
398 if Check(AFilename,fsciWritable,AFile,Result) then exit;
399 Result:=FileIsWritable(AFile.Filename);
400 SetFlag(AFile,fsciWritable,Result);
401 end;
402
TFileStateCache.FileIsTextCachednull403 function TFileStateCache.FileIsTextCached(const AFilename: string): boolean;
404 var
405 AFile: TFileStateCacheItem;
406 begin
407 Result := False;
408 if Check(AFilename,fsciText,AFile,Result) then exit;
409 Result:=FileIsText(AFile.Filename);
410 SetFlag(AFile,fsciText,Result);
411 end;
412
FileAgeCachednull413 function TFileStateCache.FileAgeCached(const AFileName: string): Longint;
414 var
415 AFile: TFileStateCacheItem;
416 Dummy: Boolean;
417 begin
418 Dummy := False;
419 if Check(AFilename,fsciAge,AFile,Dummy) then begin
420 Result:=AFile.Age;
421 exit;
422 end;
423 Result:=FileAge(AFile.Filename);
424 AFile.FAge:=Result;
425 Include(AFile.FTestedFlags,fsciAge);
426 end;
427
TFileStateCache.GetPhysicalFilenameCachednull428 function TFileStateCache.GetPhysicalFilenameCached(const AFileName: string;
429 EmptyOnError: boolean): string;
430 {$IFDEF Unix}
431 var
432 AFile: TFileStateCacheItem;
433 Dummy: Boolean;
434 {$ENDIF}
435 begin
436 {$IFDEF Unix}
437 Dummy := False;
438 if Check(AFilename,fsciPhysical,AFile,Dummy) then begin
439 Result:=AFile.PhysicalFilename;
440 exit;
441 end;
442 Result:=ExtractFilePath(AFile.Filename);
443 if Result<>'' then begin
444 // use cache recursively for directory
445 if (Result='.') or (Result='..') or (Result='/') then begin
446 // no query required
447 end else begin
448 Result:=GetPhysicalFilenameCached(Result,true);
449 end;
450 if Result<>'' then begin
451 Result:=AppendPathDelim(Result)+ExtractFilename(AFile.Filename);
452 Result:=ReadAllLinks(Result,false);
453 end;
454 end else begin
455 // no path
456 Result:=ReadAllLinks(AFile.Filename,false);
457 end;
458 AFile.FPhysicalFilename:=Result;
459 Include(AFile.FTestedFlags,fsciPhysical);
460 if (Result='') and (not EmptyOnError) then
461 Result:=AFileName;
462 {$ELSE}
463 Result:=AFileName;
464 {$ENDIF}
465 end;
466
TFileStateCache.FindFilenull467 function TFileStateCache.FindFile(const Filename: string;
468 CreateIfNotExists: boolean): TFileStateCacheItem;
469 var
470 NormedFilename: String;
471 ANode: TAVLTreeNode;
472 begin
473 // make filename unique
474 NormedFilename:=ChompPathDelim(ResolveDots(Filename));
475 ANode:=FFiles.FindKey(Pointer(NormedFilename),
476 @CompareFilenameWithFileStateCacheItem);
477 if ANode<>nil then
478 Result:=TFileStateCacheItem(ANode.Data)
479 else if CreateIfNotExists then begin
480 Result:=TFileStateCacheItem.Create(NormedFilename,FTimeStamp);
481 FFiles.Add(Result);
482 if FFiles.FindKey(Pointer(NormedFilename),
483 @CompareFilenameWithFileStateCacheItem)=nil
484 then begin
485 //DebugLn(format('FileStateCache.FindFile: "%s"',[FileName]));
486 raise Exception.Create('');
487 end;
488 end else
489 Result:=nil;
490 end;
491
TFileStateCache.Checknull492 function TFileStateCache.Check(const Filename: string;
493 AFlag: TFileStateCacheItemFlag; out AFile: TFileStateCacheItem;
494 var FlagIsSet: boolean): boolean;
495 begin
496 AFile:=FindFile(Filename,true);
497 if FTimeStamp=AFile.FTimeStamp then begin
498 Result:=AFlag in AFile.FTestedFlags;
499 FlagIsSet:=AFlag in AFile.FFlags;
500 end else begin
501 AFile.FTestedFlags:=[];
502 AFile.FTimeStamp:=FTimeStamp;
503 Result:=false;
504 FlagIsSet:=false;
505 end;
506 //WriteStr(s, AFlag);
507 //debugln('TFileStateCache.Check Filename=',Filename,' AFile.Filename=',AFile.Filename,' ',s,'=',dbgs(FlagIsSet),' Valid=',dbgs(Result));
508 end;
509
510 procedure TFileStateCache.AddChangeTimeStampHandler(
511 const Handler: TOnChangeFileStateTimeStamp);
512 begin
513 SetLength(FChangeTimeStampHandler,length(FChangeTimeStampHandler)+1);
514 FChangeTimeStampHandler[length(FChangeTimeStampHandler)-1]:=Handler;
515 end;
516
517 procedure TFileStateCache.RemoveChangeTimeStampHandler(
518 const Handler: TOnChangeFileStateTimeStamp);
519 var
520 i: Integer;
521 begin
522 for i:=length(FChangeTimeStampHandler)-1 downto 0 do begin
523 if Handler=FChangeTimeStampHandler[i] then begin
524 if i<length(FChangeTimeStampHandler)-1 then
525 System.Move(FChangeTimeStampHandler[i+1],FChangeTimeStampHandler[i],
526 SizeOf(TNotifyEvent)*(length(FChangeTimeStampHandler)-i-1));
527 SetLength(FChangeTimeStampHandler,length(FChangeTimeStampHandler)-1);
528 end;
529 end;
530 end;
531
CalcMemSizenull532 function TFileStateCache.CalcMemSize: PtrUint;
533 var
534 Node: TAVLTreeNode;
535 begin
536 Result:=PtrUInt(InstanceSize)
537 +PtrUInt(length(FChangeTimeStampHandler))*SizeOf(TNotifyEvent);
538 if FFiles<>nil then begin
539 inc(Result,PtrUInt(FFiles.InstanceSize)
540 +PtrUInt(FFiles.Count)*PtrUInt(TAVLTreeNode.InstanceSize));
541 Node:=FFiles.FindLowest;
542 while Node<>nil do begin
543 inc(Result,TFileStateCacheItem(Node.Data).CalcMemSize);
544 Node:=FFiles.FindSuccessor(Node);
545 end;
546 end;
547 end;
548
549 initialization
550 OnInvalidateFileStateCache:=@InvalidateFileStateCache;
551
552 end.
553
554