1{
2    This file is part of the Free Component Library (FCL)
3    Copyright (c) 2018  Mattias Gaertner  mattias@freepascal.org
4
5    Pascal to Javascript converter class.
6
7    See the file COPYING.FPC, included in this distribution,
8    for details about the copyright.
9
10    This program is distributed in the hope that it will be useful,
11    but WITHOUT ANY WARRANTY; without even the implied warranty of
12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13
14 **********************************************************************
15
16  Abstract:
17    TPas2jsFileResolver extends TFileResolver and searches source files.
18}
19unit Pas2jsFileCache;
20
21{$mode objfpc}{$H+}
22
23{$i pas2js_defines.inc}
24
25interface
26
27uses
28  {$IFDEF Pas2js}
29    {$IFDEF NodeJS}
30    JS, node.fs,
31    {$ENDIF}
32  {$ENDIF}
33  Classes, SysUtils,
34  fpjson,
35  PScanner, PasResolver, PasUseAnalyzer,
36  Pas2jsLogger, Pas2jsFileUtils, Pas2JSFS;
37
38
39type
40  EPas2jsFileCache = class(EPas2JSFS);
41
42type
43  TPas2jsFileAgeTime = longint;
44  TPas2jsFileAttr = longint;
45  TPas2jsFileSize = TMaxPrecInt;
46  TPas2jsSearchFileCase = (
47    sfcDefault,
48    sfcCaseSensitive,
49    sfcCaseInsensitive
50  );
51
52  TPas2jsCachedDirectories = class;
53
54  TPas2jsCachedDirectoryEntry = class
55  public
56    Name: string;
57    Time: TPas2jsFileAgeTime; // modification time
58    Attr: TPas2jsFileAttr;
59    Size: TPas2jsFileSize;
60  end;
61
62  { TPas2jsCachedDirectory }
63
64  TPas2jsCachedDirectory = class
65  private
66    FChangeStamp: TChangeStamp;
67    FPath: string;
68    FEntries: TFPList; // list of TPas2jsCachedDirectoryEntry
69    FPool: TPas2jsCachedDirectories;
70    FRefCount: integer;
71    FSorted: boolean;
72    function GetEntries(Index: integer): TPas2jsCachedDirectoryEntry; inline;
73    procedure SetSorted(const AValue: boolean);
74  protected
75    procedure DoReadDir; virtual;
76  public
77    constructor Create(aPath: string; aPool: TPas2jsCachedDirectories);
78    destructor Destroy; override;
79    function Count: integer;
80    procedure Clear;
81    property ChangeStamp: TChangeStamp read FChangeStamp write FChangeStamp;// set on Update to Pool.ChangeStamp
82    function NeedsUpdate: boolean;
83    procedure Update;
84    procedure Reference;
85    procedure Release;
86    property RefCount: integer read FRefCount;
87    function Add(const Name: string; Time: TPas2jsFileAgeTime;
88      Attr: TPas2jsFileAttr; Size: TPas2jsFileSize): TPas2jsCachedDirectoryEntry;
89    function FindFile(const ShortFilename: string;
90                      const FileCase: TPas2jsSearchFileCase): string;
91    function FileAge(const ShortFilename: string): TPas2jsFileAgeTime;
92    function FileAttr(const ShortFilename: string): TPas2jsFileAttr;
93    function FileSize(const ShortFilename: string): TPas2jsFileSize;
94    function IndexOfFileCaseInsensitive(const ShortFilename: String): integer;
95    function IndexOfFileCaseSensitive(const ShortFilename: String): integer;
96    function IndexOfFile(const ShortFilename: String): integer; inline;
97    function CountSameNamesCaseInsensitive(Index: integer): integer;
98    procedure GetSameNamesCaseInsensitive(Index: integer; List: TStrings);
99    property Entries[Index: integer]: TPas2jsCachedDirectoryEntry read GetEntries; default;
100    procedure GetFiles(var Files: TStrings;
101      IncludeDirs: boolean = true // add faDirectory as well
102      ); // returns relative file names
103    procedure CheckConsistency;
104    procedure WriteDebugReport;
105    property Path: string read FPath; // with trailing path delimiter
106    property Pool: TPas2jsCachedDirectories read FPool;
107    property Sorted: boolean read FSorted write SetSorted; // descending, sort first case insensitive, then sensitive
108  end;
109
110  TReadDirectoryEvent = function(Dir: TPas2jsCachedDirectory): boolean of object;// true = skip default function
111
112  { TPas2jsCachedDirectories }
113
114  TPas2jsCachedDirectories = class
115  private
116    FChangeStamp: TChangeStamp;
117    FDirectories: TPasAnalyzerKeySet;// set of TPas2jsCachedDirectory, key is Directory
118    FWorkingDirectory: string;
119  private
120    FOnReadDirectory: TReadDirectoryEvent;
121    type
122      TFileInfo = record
123        Filename: string;
124        DirPath: string;
125        ShortFilename: string;
126        Dir: TPas2jsCachedDirectory;
127      end;
128    function GetFileInfo(var Info: TFileInfo): boolean;
129    procedure SetWorkingDirectory(const AValue: string);
130  public
131    constructor Create;
132    destructor Destroy; override;
133    property ChangeStamp: TChangeStamp read FChangeStamp;
134    procedure Invalidate; inline;
135    procedure Clear;
136    function DirectoryExists(Filename: string): boolean;
137    function FileExists(Filename: string): boolean;
138    function FileExistsI(var Filename: string): integer; // returns number of found files
139    function FileAge(Filename: string): TPas2jsFileAgeTime;
140    function FileAttr(Filename: string): TPas2jsFileAttr;
141    function FileSize(Filename: string): TPas2jsFileSize;
142    function FindDiskFilename(const Filename: string;
143                              {%H-}SearchCaseInsensitive: boolean = false): string; // using Pascal case insensitivity, not UTF-8
144    procedure GetListing(const aDirectory: string; var Files: TStrings;
145        IncludeDirs: boolean = true // add faDirectory as well
146        ); // returns relative file names
147    function GetDirectory(const Directory: string;
148                      CreateIfNotExists: boolean = true;
149                      DoReference: boolean = true): TPas2jsCachedDirectory;
150    property WorkingDirectory: string read FWorkingDirectory write SetWorkingDirectory; // used for relative filenames, contains trailing path delimiter
151    property OnReadDirectory: TReadDirectoryEvent read FOnReadDirectory write FOnReadDirectory;
152  end;
153
154type
155  TPas2jsFilesCache = class;
156  TPas2jsCachedFile = class;
157
158  { TPas2jsFileResolver }
159
160  TPas2jsFileResolver = class(TPas2JSFSResolver)
161  private
162    function GetCache: TPas2jsFilesCache;
163  public
164    constructor Create(aCache: TPas2jsFilesCache); reintroduce;
165    // Redirect all calls to cache.
166    property Cache: TPas2jsFilesCache read GetCache;
167  end;
168
169  { TPas2jsFileLineReader }
170
171  TPas2jsFileLineReader = class(TSourceLineReader)
172  private
173    FCachedFile: TPas2jsCachedFile;
174  Protected
175    Procedure IncLineNumber; override;
176    property CachedFile: TPas2jsCachedFile read FCachedFile;
177  public
178    constructor Create(const AFilename: string); override;
179    constructor Create(aFile: TPas2jsCachedFile); reintroduce;
180  end;
181
182  { TPas2jsCachedFile }
183
184  TPas2jsCachedFile = class(TPas2JSFile)
185  private
186    FChangeStamp: TChangeStamp;
187    FFileEncoding: string;
188    FLastErrorMsg: string;
189    FLoaded: boolean;
190    FLoadedFileAge: longint;
191    FCacheStamp: TChangeStamp; // Cache.ResetStamp when file was loaded
192    function GetCache: TPas2jsFilesCache;
193    function GetIsBinary: boolean; inline;
194  Protected
195    property IsBinary: boolean read GetIsBinary;
196    property FileEncoding: string read FFileEncoding;
197    property Cache: TPas2jsFilesCache read GetCache;
198    property ChangeStamp: TChangeStamp read FChangeStamp;// changed when Source changed
199    property Loaded: boolean read FLoaded; // Source valid, but may contain an old version
200    property LastErrorMsg: string read FLastErrorMsg;
201    property LoadedFileAge: longint read FLoadedFileAge;// only valid if Loaded=true
202  public
203    constructor Create(aCache: TPas2jsFilesCache; const aFilename: string); reintroduce;
204    function Load(RaiseOnError: boolean; Binary: boolean = false): boolean; override;
205    function CreateLineReader(RaiseOnError: boolean): TSourceLineReader; override;
206  end;
207
208  TPas2jsReadFileEvent = function(aFilename: string; var aSource: string): boolean of object;
209  TPas2jsWriteFileEvent = procedure(aFilename: string; Source: string) of object;
210
211  TPas2jsSearchPathKind = (
212    spkPath,      // e.g. unitpaths, includepaths
213    spkIdentifier // e.g. namespaces, trailing - means remove
214    );
215
216  { TPas2jsFilesCache }
217
218  TPas2jsFilesCache = class (TPas2JSFS)
219  private
220    FBaseDirectory: string;
221    FDirectoryCache: TPas2jsCachedDirectories;
222    FFiles: TPasAnalyzerKeySet; // set of TPas2jsCachedFile, key is Filename
223    FForeignUnitPaths: TStringList;
224    FForeignUnitPathsFromCmdLine: integer;
225    FIncludePaths: TStringList;
226    FIncludePathsFromCmdLine: integer;
227    FLog: TPas2jsLogger;
228    FOnReadFile: TPas2jsReadFileEvent;
229    FOnWriteFile: TPas2jsWriteFileEvent;
230    FResetStamp: TChangeStamp;
231    FResourcePaths: TStringList;
232    FUnitPaths: TStringList;
233    FUnitPathsFromCmdLine: integer;
234    FPCUPaths: TStringList;
235    function FileExistsILogged(var Filename: string): integer;
236    function FileExistsLogged(const Filename: string): boolean;
237    function GetOnReadDirectory: TReadDirectoryEvent;
238    procedure RegisterMessages;
239    procedure SetBaseDirectory(AValue: string);
240    function AddSearchPaths(const Paths: string; Kind: TPas2jsSearchPathKind;
241      FromCmdLine: boolean; var List: TStringList; var CmdLineCount: integer): string;
242    procedure SetOnReadDirectory(AValue: TReadDirectoryEvent);
243  protected
244    function FindSourceFileName(const aFilename: string): String; override;
245    function GetHasPCUSupport: Boolean; virtual;
246    function ReadFile(Filename: string; var Source: string): boolean; virtual;
247    procedure FindMatchingFiles(Mask: string; MaxCount: integer; Files: TStrings);// find files, matching * and ?
248  public
249    constructor Create(aLog: TPas2jsLogger); overload;
250    destructor Destroy; override;
251    procedure Reset; override;
252    procedure WriteFoldersAndSearchPaths; override;
253    procedure GetPCUDirs(aList: TStrings; const aBaseDir: String); override;
254    function PCUExists(var aFileName: string): Boolean; override;
255    Function SameFileName(Const File1,File2 : String) : Boolean;  override;
256    Function File1IsNewer(const File1, File2: String): Boolean; override;
257    function SearchLowUpCase(var Filename: string): boolean;
258    function FindCustomJSFileName(const aFilename: string): String; override;
259    function FindUnitJSFileName(const aUnitFilename: string): String; override;
260    function FindUnitFileName(const aUnitname, InFilename, ModuleDir: string; out IsForeign: boolean): String; override;
261    function FindResourceFileName(const aFilename, ModuleDir: string): String; override;
262    function FindIncludeFileName(const aFilename, ModuleDir: string): String; override;
263    function AddIncludePaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
264    function AddUnitPaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
265    function AddSrcUnitPaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
266    function CreateResolver: TPas2jsFSResolver; override;
267    function FormatPath(const aPath: string): string; override;
268    Function DirectoryExists(Const Filename: string): boolean; override;
269    function FileExists(const Filename: string): boolean; override;
270    function FileExistsI(var Filename: string): integer; // returns number of found files
271    function FileAge(const Filename: string): TPas2jsFileAgeTime; virtual;
272    function FindFile(Filename: string): TPas2jsCachedFile;
273    function LoadFile(Filename: string; Binary: boolean = false): TPas2jsFile; override;
274    function NormalizeFilename(const Filename: string; RaiseOnError: boolean): string;
275    procedure GetListing(const aDirectory: string; var Files: TStrings;
276                         FullPaths: boolean = true);
277    procedure RaiseDuplicateFile(aFilename: string);
278    procedure SaveToFile(ms: TFPJSStream; Filename: string); override;
279    function ExpandDirectory(const Filename: string): string; override;
280    function ExpandFileName(const Filename: string): string; override;
281    function ExpandExecutable(const Filename: string): string; override;
282    function HandleOptionPaths(C: Char; aValue: String; FromCmdLine: Boolean): String; override;
283    Function AddForeignUnitPath(const aValue: String; FromCmdLine: Boolean): String; override;
284    function TryCreateRelativePath(const Filename, BaseDirectory: String;
285      UsePointDirectory, AlwaysRequireSharedBaseFolder: boolean; out RelPath: String): Boolean; override;
286  Protected
287    property DirectoryCache: TPas2jsCachedDirectories read FDirectoryCache;
288  public
289    property BaseDirectory: string read FBaseDirectory write SetBaseDirectory; // includes trailing pathdelim
290    property ForeignUnitPaths: TStringList read FForeignUnitPaths;
291    property ResourcePaths : TStringList read FResourcePaths;
292    property ForeignUnitPathsFromCmdLine: integer read FForeignUnitPathsFromCmdLine;
293    property IncludePaths: TStringList read FIncludePaths;
294    property IncludePathsFromCmdLine: integer read FIncludePathsFromCmdLine;
295    property Log: TPas2jsLogger read FLog;
296    property ResetStamp: TChangeStamp read FResetStamp;
297    property UnitPaths: TStringList read FUnitPaths;
298    property UnitPathsFromCmdLine: integer read FUnitPathsFromCmdLine;
299    property OnReadDirectory: TReadDirectoryEvent read GetOnReadDirectory write SetOnReadDirectory;
300    property OnReadFile: TPas2jsReadFileEvent read FOnReadFile write FOnReadFile;
301    property OnWriteFile: TPas2jsWriteFileEvent read FOnWriteFile write FOnWriteFile;
302  end;
303
304{$IFDEF Pas2js}
305function PtrStrToStr(StrAsPtr: Pointer): string;
306function PtrFilenameToKeyName(FilenameAsPtr: Pointer): string;
307function Pas2jsCachedFileToKeyName(Item: Pointer): string;
308function Pas2jsCacheDirToKeyName(Item: Pointer): string;
309{$ELSE}
310function CompareFilenameWithCachedFile(Filename, CachedFile: Pointer): integer;
311function CompareCachedFiles(File1, File2: Pointer): integer;
312function ComparePas2jsCacheDirectories(Dir1, Dir2: Pointer): integer;
313function CompareAnsiStringWithDirectoryCache(Path, DirCache: Pointer): integer;
314{$ENDIF}
315function ComparePas2jsDirectoryEntries(Entry1, Entry2: {$IFDEF Pas2js}jsvalue{$ELSE}Pointer{$ENDIF}): integer;
316function CompareFirstCaseInsThenSensitive(const s, h: string): integer;
317
318{$IFDEF FPC_HAS_CPSTRING}
319// UTF-8 helper functions
320function ConvertTextToUTF8(const Src: string; var SrcEncoding: string): string;
321function GuessEncoding(const Src: string): string;
322function HasUTF8BOM(const s: string): boolean;
323function RemoveUTFBOM(const s: string): string;
324{$ENDIF}
325
326implementation
327
328{$IFDEF pas2js}
329function PtrStrToStr(StrAsPtr: Pointer): string;
330var
331  S: String absolute StrAsPtr;
332begin
333  Result:=S;
334end;
335
336function PtrFilenameToKeyName(FilenameAsPtr: Pointer): string;
337var
338  Filename: String absolute FilenameAsPtr;
339begin
340  Result:=FilenameToKey(Filename);
341end;
342
343function Pas2jsCachedFileToKeyName(Item: Pointer): string;
344var
345  aFile: TPas2jsCachedFile absolute Item;
346begin
347  Result:=FilenameToKey(aFile.Filename);
348end;
349
350function Pas2jsCacheDirToKeyName(Item: Pointer): string;
351var
352  Dir: TPas2jsCachedDirectory absolute Item;
353begin
354  Result:=FilenameToKey(Dir.Path);
355end;
356
357{$ELSE}
358function CompareFilenameWithCachedFile(Filename, CachedFile: Pointer): integer;
359var
360  Cache: TPas2jsCachedFile absolute CachedFile;
361begin
362  Result:=CompareFilenames(AnsiString(Filename),Cache.Filename);
363end;
364
365function CompareCachedFiles(File1, File2: Pointer): integer;
366var
367  Cache1: TPas2jsCachedFile absolute File1;
368  Cache2: TPas2jsCachedFile absolute File2;
369begin
370  Result:=CompareFilenames(Cache1.Filename,Cache2.Filename);
371end;
372
373function ComparePas2jsCacheDirectories(Dir1, Dir2: Pointer): integer;
374var
375  Directory1: TPas2jsCachedDirectory absolute Dir1;
376  Directory2: TPas2jsCachedDirectory absolute Dir2;
377begin
378  Result:=CompareFilenames(Directory1.Path,Directory2.Path);
379end;
380
381function CompareAnsiStringWithDirectoryCache(Path, DirCache: Pointer): integer;
382var
383  Directory: TPas2jsCachedDirectory absolute DirCache;
384begin
385  Result:=CompareFilenames(AnsiString(Path),Directory.Path);
386end;
387
388{$ENDIF}
389
390function ComparePas2jsDirectoryEntries(Entry1, Entry2: {$IFDEF Pas2js}jsvalue{$ELSE}Pointer{$ENDIF}): integer;
391var
392  E1: TPas2jsCachedDirectoryEntry absolute Entry1;
393  E2: TPas2jsCachedDirectoryEntry absolute Entry2;
394begin
395  Result:=CompareFirstCaseInsThenSensitive(E1.Name,E2.Name);
396end;
397
398function CompareFirstCaseInsThenSensitive(const s, h: string): integer;
399begin
400  Result:=CompareText(s,h);
401  if Result<>0 then exit;
402  Result:=CompareStr(s,h);
403end;
404
405{$IFDEF FPC_HAS_CPSTRING}
406function ConvertTextToUTF8(const Src: string; var SrcEncoding: string): string;
407var
408  p: PChar;
409  NormSrcEncoding: String;
410begin
411  Result:=Src;
412  if SrcEncoding='' then
413    SrcEncoding:=GuessEncoding(Src);
414  if Result='' then exit;
415  NormSrcEncoding:=NormalizeEncoding(SrcEncoding);
416  if NormSrcEncoding=NormalizeEncoding(EncodingUTF8) then
417  begin
418    p:=PChar(Result);
419    if (p^=#$EF) and (p[1]=#$BB) and (p[2]=#$BF) then
420    begin
421      // cut out UTF-8 BOM
422      Delete(Result,1,3);
423    end;
424  end else if (NormSrcEncoding=EncodingSystem)
425      or (NormSrcEncoding=GetDefaultTextEncoding) then
426  begin
427    Result:=SystemCPToUTF8(Result);
428  end else
429    EPas2jsFileCache.Create('invalid encoding "'+SrcEncoding+'"');
430end;
431
432function GuessEncoding(const Src: string): string;
433var
434  p: PChar;
435  l: SizeInt;
436  i: Integer;
437begin
438  if Src='' then exit(EncodingUTF8);
439
440  if HasUTF8BOM(Src) then
441    // UTF-8 BOM
442    exit(EncodingUTF8);
443
444  // try UTF-8 (this includes ASCII)
445  l:=length(Src);
446  p:=PChar(Src);
447  repeat
448    if ord(p^)<128 then
449    begin
450      // ASCII
451      if (p^=#0) and (p-PChar(Src)>=l) then
452        exit(EncodingUTF8);
453      inc(p);
454    end else begin
455      i:=UTF8CharacterStrictLength(p);
456      if i=0 then
457        break;
458      inc(p,i);
459    end;
460  until false;
461
462  // check binary
463  p:=PChar(Src);
464  repeat
465    case p^ of
466    #0:
467      if (p-PChar(Src)>=l) then
468        break
469      else
470        exit(EncodingBinary);
471    #1..#8,#11,#14..#31:
472      exit(EncodingBinary);
473    end;
474    inc(p);
475  until false;
476
477  // use system encoding
478  Result:=GetDefaultTextEncoding;
479end;
480
481function HasUTF8BOM(const s: string): boolean;
482var
483  p: PChar;
484begin
485  if s='' then exit(false);
486  p:=PChar(s);
487  Result:=(p^=#$EF) and (p[1]=#$BB) and (p[2]=#$BF);
488end;
489
490function RemoveUTFBOM(const s: string): string;
491begin
492  Result:=s;
493  if not HasUTF8BOM(Result) then exit;
494  Delete(Result,1,3);
495end;
496{$ENDIF}
497
498
499{ TPas2jsCachedDirectory }
500
501// inline
502function TPas2jsCachedDirectory.IndexOfFile(const ShortFilename: String
503  ): integer;
504begin
505  {$IFDEF CaseInsensitiveFilenames}
506  Result:=IndexOfFileCaseInsensitive(ShortFilename);
507  {$ELSE}
508  Result:=IndexOfFileCaseSensitive(ShortFilename);
509  {$ENDIF}
510end;
511
512// inline
513function TPas2jsCachedDirectory.GetEntries(Index: integer
514  ): TPas2jsCachedDirectoryEntry;
515begin
516  Result:=TPas2jsCachedDirectoryEntry(FEntries[Index]);
517end;
518
519// inline
520function TPas2jsCachedDirectory.NeedsUpdate: boolean;
521begin
522  Result:=(Pool.ChangeStamp<>FChangeStamp) or (FChangeStamp=InvalidChangeStamp);
523end;
524
525procedure TPas2jsCachedDirectory.SetSorted(const AValue: boolean);
526begin
527  if FSorted=AValue then Exit;
528  FSorted:=AValue;
529  if not FSorted then exit;
530  FEntries.Sort(@ComparePas2jsDirectoryEntries); // sort descending
531end;
532
533procedure TPas2jsCachedDirectory.DoReadDir;
534var
535  Info: TUnicodeSearchRec;
536begin
537  if Assigned(Pool.OnReadDirectory) then
538    if Pool.OnReadDirectory(Self) then exit;
539
540  // Note: do not add a 'if not DirectoryExists then exit'.
541  // This will not work on automounted directories. You must use FindFirst.
542  if FindFirst(UnicodeString(Path+AllFilesMask),faAnyFile,Info)=0 then
543  begin
544    repeat
545      // check if special file
546      if (Info.Name='.') or (Info.Name='..') or (Info.Name='')
547      then
548        continue;
549      // add file
550      Add(String(Info.Name),Info.Time,Info.Attr,Info.Size);
551    until FindNext(Info)<>0;
552  end;
553  FindClose(Info);
554end;
555
556constructor TPas2jsCachedDirectory.Create(aPath: string;
557  aPool: TPas2jsCachedDirectories);
558begin
559  FRefCount:=1;
560  FPath:=IncludeTrailingPathDelimiter(aPath);
561  FEntries:=TFPList.Create;
562  FPool:=aPool;
563  FChangeStamp:=InvalidChangeStamp;
564end;
565
566destructor TPas2jsCachedDirectory.Destroy;
567begin
568  Clear;
569  FreeAndNil(FEntries);
570  inherited Destroy;
571end;
572
573function TPas2jsCachedDirectory.Count: integer;
574begin
575  Result:=FEntries.Count;
576end;
577
578procedure TPas2jsCachedDirectory.Clear;
579var
580  i: Integer;
581begin
582  for i:=0 to FEntries.Count-1 do
583    TObject(FEntries[i]).{$IFDEF Pas2js}Destroy{$ELSE}Free{$ENDIF};
584  FEntries.Clear;
585  FSorted:=true;
586end;
587
588procedure TPas2jsCachedDirectory.Update;
589begin
590  if not NeedsUpdate then exit;
591  Clear;
592  DoReadDir;
593  FChangeStamp:=Pool.ChangeStamp;
594  Sorted:=true;
595  {$IFDEF VerbosePas2JSDirCache}
596  writeln('TPas2jsCachedDirectories.Update "',Path,'" Count=',Count);
597  CheckConsistency;
598  {$ENDIF}
599end;
600
601procedure TPas2jsCachedDirectory.Reference;
602begin
603  inc(FRefCount);
604end;
605
606procedure TPas2jsCachedDirectory.Release;
607begin
608  if FRefCount<1 then
609    raise Exception.Create('TPas2jsCachedDirectory.Release [20180126090800] "'+Path+'"');
610  dec(FRefCount);
611  if FRefCount=0 then Free;
612end;
613
614function TPas2jsCachedDirectory.Add(const Name: string;
615Time: TPas2jsFileAgeTime; Attr: TPas2jsFileAttr; Size: TPas2jsFileSize
616  ): TPas2jsCachedDirectoryEntry;
617begin
618  Result:=TPas2jsCachedDirectoryEntry.Create;
619  Result.Name:=Name;
620  Result.Time:=Time;
621  Result.Attr:=Attr;
622  Result.Size:=Size;
623  FEntries.Add(Result);
624  FSorted:=false;
625end;
626
627function TPas2jsCachedDirectory.FindFile(const ShortFilename: string;
628  const FileCase: TPas2jsSearchFileCase): string;
629var
630  i: Integer;
631begin
632  case FileCase of
633    sfcCaseSensitive: i:=IndexOfFileCaseSensitive(ShortFilename);
634    sfcCaseInsensitive: i:=IndexOfFileCaseInsensitive(ShortFilename);
635  else
636    i:=IndexOfFile(ShortFilename);
637  end;
638  if i>=0 then
639    Result:=Entries[i].Name
640  else
641    Result:='';
642end;
643
644function TPas2jsCachedDirectory.FileAge(const ShortFilename: string
645  ): TPas2jsFileAgeTime;
646var
647  i: Integer;
648begin
649  i:=IndexOfFile(ShortFilename);
650  if i>=0 then
651    Result:=Entries[i].Time
652  else
653    Result:=-1;
654end;
655
656function TPas2jsCachedDirectory.FileAttr(const ShortFilename: string
657  ): TPas2jsFileAttr;
658var
659  i: Integer;
660begin
661  i:=IndexOfFile(ShortFilename);
662  if i>=0 then
663    Result:=Entries[i].Attr
664  else
665    Result:=0;
666end;
667
668function TPas2jsCachedDirectory.FileSize(const ShortFilename: string
669  ): TPas2jsFileSize;
670var
671  i: Integer;
672begin
673  i:=IndexOfFile(ShortFilename);
674  if i>=0 then
675    Result:=Entries[i].Size
676  else
677    Result:=-1;
678end;
679
680function TPas2jsCachedDirectory.IndexOfFileCaseInsensitive(
681  const ShortFilename: String): integer;
682var
683  l, r, cmp, m: Integer;
684  Entry: TPas2jsCachedDirectoryEntry;
685begin
686  Sorted:=true;
687  l:=0;
688  r:=Count-1;
689  while l<=r do begin
690    m:=(l+r) shr 1;
691    Entry:=Entries[m];
692    cmp:=CompareText(Entry.Name,ShortFilename);
693    if cmp>0 then
694      r:=m-1
695    else if cmp<0 then
696      l:=m+1
697    else
698      exit(m);
699  end;
700  Result:=-1;
701end;
702
703function TPas2jsCachedDirectory.IndexOfFileCaseSensitive(
704  const ShortFilename: String): integer;
705var
706  l, r, cmp, m: Integer;
707  Entry: TPas2jsCachedDirectoryEntry;
708begin
709  Sorted:=true;
710  l:=0;
711  r:=Count-1;
712  while l<=r do begin
713    m:=(l+r) shr 1;
714    Entry:=Entries[m];
715    cmp:=CompareFirstCaseInsThenSensitive(Entry.Name,ShortFilename);
716    if cmp>0 then
717      r:=m-1
718    else if cmp<0 then
719      l:=m+1
720    else
721      exit(m);
722  end;
723  Result:=-1;
724end;
725
726function TPas2jsCachedDirectory.CountSameNamesCaseInsensitive(Index: integer
727  ): integer;
728var
729  i: Integer;
730  Filename: String;
731begin
732  Filename:=Entries[Index].Name;
733  Result:=1;
734  for i:=Index-1 downto 0 do
735  begin
736    if CompareText(Entries[i].Name,Filename)<>0 then break;
737    inc(Result);
738  end;
739  for i:=Index+1 to Count-1 do
740  begin
741    if CompareText(Entries[i].Name,Filename)<>0 then break;
742    inc(Result);
743  end;
744end;
745
746procedure TPas2jsCachedDirectory.GetSameNamesCaseInsensitive(Index: integer;
747  List: TStrings);
748var
749  i: Integer;
750  Filename: String;
751begin
752  Filename:=Entries[Index].Name;
753  List.Add(Filename);
754  for i:=Index-1 downto 0 do
755  begin
756    if CompareText(Entries[i].Name,Filename)<>0 then break;
757    List.Add(Entries[i].Name);
758  end;
759  for i:=Index+1 to Count-1 do
760  begin
761    if CompareText(Entries[i].Name,Filename)<>0 then break;
762    List.Add(Entries[i].Name);
763  end;
764end;
765
766procedure TPas2jsCachedDirectory.GetFiles(var Files: TStrings;
767  IncludeDirs: boolean);
768var
769  i: Integer;
770  Entry: TPas2jsCachedDirectoryEntry;
771begin
772  if Files=nil then
773    Files:=TStringList.Create;
774  if (Self=nil) or (Path='') then exit;
775  Update;
776  for i:=0 to Count-1 do begin
777    Entry:=Entries[i];
778    if IncludeDirs or ((Entry.Attr and faDirectory)=0) then
779      Files.Add(Entry.Name);
780  end;
781end;
782
783procedure TPas2jsCachedDirectory.CheckConsistency;
784{AllowWriteln}
785
786  procedure E(Msg: string);
787  begin
788    WriteDebugReport;
789    writeln('TPas2jsCachedDirectory.CheckConsistency Failed for "',Path,'": '+Msg);
790  end;
791
792var
793  i, cmp, j: Integer;
794  Entry, LastEntry: TPas2jsCachedDirectoryEntry;
795begin
796  if Path<>IncludeTrailingPathDelimiter(Path) then
797    E('Path<>IncludeTrailingPathDelimiter(Path)');
798  LastEntry:=nil;
799  for i:=0 to Count-1 do begin
800    Entry:=Entries[i];
801    if (Entry.Name='') or (Entry.Name='.') or (Entry.Name='..') then
802      E('invalid entry "'+Entry.Name+'"');
803    if (Entry.Size<0) then
804      E('invalid size "'+Entry.Name+'" '+IntToStr(Entry.Size));
805    if Sorted then
806    begin
807      if (LastEntry<>nil) then
808      begin
809        if LastEntry.Name=Entry.Name then
810          E('duplicate "'+Entry.Name+'"');
811        cmp:=CompareText(LastEntry.Name,Entry.Name);
812        if cmp>0 then
813          E('sorted wrong case insensitive "'+LastEntry.Name+'" "'+Entry.Name+'"');
814        if (cmp=0) and (CompareStr(LastEntry.Name,Entry.Name)>0) then
815          E('sorted wrong case sensitive "'+LastEntry.Name+'" "'+Entry.Name+'"');
816      end;
817      j:=IndexOfFileCaseSensitive(Entry.Name);
818      if i<>j then
819        E('IndexOfFileCaseSensitive failed "'+Entry.Name+'" expected '+IntToStr(i)+', but was '+IntToStr(j));
820    end;
821    LastEntry:=Entry;
822  end;
823  {AllowWriteln-}
824end;
825
826procedure TPas2jsCachedDirectory.WriteDebugReport;
827var
828  i: Integer;
829  Entry: TPas2jsCachedDirectoryEntry;
830begin
831  {AllowWriteln}
832  writeln('TPas2jsCachedDirectory.WriteDebugReport Count=',Count,' Path="',Path,'"');
833  for i:=0 to Count-1 do begin
834    Entry:=Entries[i];
835    writeln(i,' "',Entry.Name,'" Size=',Entry.Size,' Time=',DateTimeToStr(FileDateToDateTime(Entry.Time)),' Dir=',faDirectory and Entry.Attr>0);
836  end;
837  {AllowWriteln-}
838end;
839
840{ TPas2jsCachedDirectories }
841
842function TPas2jsCachedDirectories.GetFileInfo(var Info: TFileInfo): boolean;
843begin
844  Info.Filename:=ChompPathDelim(ResolveDots(Info.Filename));
845  if Info.Filename='' then exit(false);
846  if not FilenameIsAbsolute(Info.Filename) then
847    Info.Filename:=WorkingDirectory+Info.Filename;
848  Info.ShortFilename:=ExtractFilename(Info.Filename);
849  Info.DirPath:=ExtractFilePath(Info.Filename);
850  if (Info.ShortFilename<>'') and (Info.ShortFilename<>'.') and (Info.ShortFilename<>'..')
851  then
852  begin
853    Info.Dir:=GetDirectory(Info.DirPath,true,false);
854  end else begin
855    Info.Dir:=nil;
856  end;
857  Result:=true;
858end;
859
860procedure TPas2jsCachedDirectories.SetWorkingDirectory(const AValue: string);
861begin
862  FWorkingDirectory:=IncludeTrailingPathDelimiter(ResolveDots(AValue));
863end;
864
865constructor TPas2jsCachedDirectories.Create;
866begin
867  IncreaseChangeStamp(FChangeStamp);
868  FDirectories:=TPasAnalyzerKeySet.Create(
869    {$IFDEF pas2js}
870    @Pas2jsCacheDirToKeyName,@PtrFilenameToKeyName
871    {$ELSE}
872    @ComparePas2jsCacheDirectories,@CompareAnsiStringWithDirectoryCache
873    {$ENDIF});
874end;
875
876destructor TPas2jsCachedDirectories.Destroy;
877begin
878  Clear;
879  FreeAndNil(FDirectories);
880  inherited Destroy;
881end;
882
883procedure TPas2jsCachedDirectories.Invalidate;
884begin
885  IncreaseChangeStamp(FChangeStamp);
886end;
887
888procedure TPas2jsCachedDirectories.Clear;
889var
890  Dir: TPas2jsCachedDirectory;
891  List: TFPList;
892  i: Integer;
893begin
894  List:=FDirectories.GetList;
895  try
896    for i:=0 to List.Count-1 do
897    begin
898      Dir:=TPas2jsCachedDirectory(List[i]);
899      if Dir.FRefCount<>1 then
900        raise Exception.Create('TPas2jsCachedDirectories.Clear [20180126090807] "'+Dir.Path+'" '+IntToStr(Dir.FRefCount));
901      Dir.Release;
902    end;
903  finally
904    List.Free;
905  end;
906  FDirectories.Clear;
907end;
908
909function TPas2jsCachedDirectories.DirectoryExists(Filename: string): boolean;
910var
911  Info: TFileInfo;
912  Dir: TPas2jsCachedDirectory;
913begin
914  Info.Filename:=Filename;
915  if not GetFileInfo(Info) then exit(false);
916  if Info.Dir<>nil then
917    Result:=(Info.Dir.FileAttr(Info.ShortFilename) and faDirectory)>0
918  else
919    begin
920    Dir:=GetDirectory(Filename,true,false);
921    if Dir<>nil then
922      Result:=Dir.Count>0
923    else
924      begin
925      Filename:=ChompPathDelim(ResolveDots(Filename));
926      if not FilenameIsAbsolute(Filename) then
927        Filename:=WorkingDirectory+Filename;
928      Result:={$IFDEF pas2js}Node.FS{$ELSE}SysUtils{$ENDIF}.DirectoryExists(Filename);
929      end;
930    end;
931end;
932
933function TPas2jsCachedDirectories.FileExists(Filename: string): boolean;
934var
935  Info: TFileInfo;
936begin
937  Info.Filename:=Filename;
938  if not GetFileInfo(Info) then exit(false);
939  if Info.Dir<>nil then
940    Result:=Info.Dir.IndexOfFile(Info.ShortFilename)>=0
941  else
942    Result:={$IFDEF pas2js}Node.FS{$ELSE}SysUtils{$ENDIF}.FileExists(Info.Filename);
943end;
944
945function TPas2jsCachedDirectories.FileExistsI(var Filename: string): integer;
946var
947  Info: TFileInfo;
948  i: Integer;
949begin
950  Result:=0;
951  Info.Filename:=Filename;
952  if not GetFileInfo(Info) then exit;
953  if Info.Dir=nil then
954  begin
955    if {$IFDEF pas2js}Node.FS{$ELSE}SysUtils{$ENDIF}.FileExists(Info.Filename) then
956      Result:=1;
957  end
958  else
959  begin
960    i:=Info.Dir.IndexOfFileCaseInsensitive(Info.ShortFilename);
961    if i<0 then
962      exit;
963    Filename:=Info.Dir.Path+Info.Dir[i].Name;
964    Result:=Info.Dir.CountSameNamesCaseInsensitive(i);
965  end;
966end;
967
968function TPas2jsCachedDirectories.FileAge(Filename: string): TPas2jsFileAgeTime;
969var
970  Info: TFileInfo;
971begin
972  Info.Filename:=Filename;
973  if GetFileInfo(Info) and (Info.Dir<>nil) then
974    Result:=Info.Dir.FileAge(Info.ShortFilename)
975  else
976    Result:=-1;
977end;
978
979function TPas2jsCachedDirectories.FileAttr(Filename: string): TPas2jsFileAttr;
980var
981  Info: TFileInfo;
982begin
983  Info.Filename:=Filename;
984  if GetFileInfo(Info) and (Info.Dir<>nil) then
985    Result:=Info.Dir.FileAttr(Info.ShortFilename)
986  else
987    Result:=0;
988end;
989
990function TPas2jsCachedDirectories.FileSize(Filename: string): TPas2jsFileSize;
991var
992  Info: TFileInfo;
993begin
994  Info.Filename:=Filename;
995  if GetFileInfo(Info) and (Info.Dir<>nil) then
996    Result:=Info.Dir.FileSize(Info.ShortFilename)
997  else
998    Result:=-1;
999end;
1000
1001function TPas2jsCachedDirectories.FindDiskFilename(const Filename: string;
1002  SearchCaseInsensitive: boolean): string;
1003var
1004  ADirectory: String;
1005  Cache: TPas2jsCachedDirectory;
1006  DiskShortFilename: String;
1007begin
1008  Result:=ChompPathDelim(ResolveDots(Filename));
1009  if Result='' then exit;
1010  //debugln(['TPas2jsCachedDirectories.FindDiskFilename Filename=',Result]);
1011  {$IF defined(NotLiteralFilenames) or defined(CaseInsensitiveFilenames)}
1012  {$ELSE}
1013  if (not SearchCaseInsensitive) then exit;
1014  {$ENDIF}
1015  ADirectory:=ExtractFilePath(Result);
1016  if ADirectory=Result then
1017    exit; // root directory, e.g. / under Linux or C: under Windows
1018  if SearchCaseInsensitive then
1019    // search recursively all directory parts
1020    ADirectory:=IncludeTrailingPathDelimiter(FindDiskFilename(ADirectory,true));
1021  Cache:=GetDirectory(ADirectory,true,false);
1022  //debugln(['TPas2jsCachedDirectories.FindDiskFilename Dir=',Cache.Directory]);
1023  Result:=ExtractFileName(Result);
1024  DiskShortFilename:=Cache.FindFile(Result,sfcCaseInsensitive);
1025  //debugln(['TPas2jsCachedDirectories.FindDiskFilename DiskShortFilename=',DiskShortFilename]);
1026  if DiskShortFilename<>'' then Result:=DiskShortFilename;
1027  Result:=Cache.Path+Result;
1028end;
1029
1030procedure TPas2jsCachedDirectories.GetListing(const aDirectory: string;
1031  var Files: TStrings; IncludeDirs: boolean);
1032begin
1033  GetDirectory(aDirectory,true,false).GetFiles(Files,IncludeDirs);
1034end;
1035
1036function TPas2jsCachedDirectories.GetDirectory(const Directory: string;
1037  CreateIfNotExists: boolean; DoReference: boolean): TPas2jsCachedDirectory;
1038var
1039  Dir: String;
1040begin
1041  Dir:=ResolveDots(Directory);
1042  if not FilenameIsAbsolute(Dir) then
1043    Dir:=WorkingDirectory+Dir;
1044  Dir:=IncludeTrailingPathDelimiter(Dir);
1045  Result:=TPas2jsCachedDirectory(FDirectories.FindKey(Pointer(Dir)));
1046  if Result<>nil then
1047  begin
1048    if DoReference then
1049      Result.Reference;
1050    Result.Update;
1051  end else if DoReference or CreateIfNotExists then
1052  begin
1053    {$IFDEF VerbosePas2JSDirCache}
1054    writeln('TPas2jsCachedDirectories.GetDirectory "',Dir,'"');
1055    {$ENDIF}
1056    Result:=TPas2jsCachedDirectory.Create(Dir,Self);
1057    FDirectories.Add(Result);
1058    if DoReference then
1059      Result.Reference;
1060    Result.Update;
1061  end else
1062    Result:=nil;
1063end;
1064
1065{ TPas2jsFileLineReader }
1066
1067procedure TPas2jsFileLineReader.IncLineNumber;
1068begin
1069  if (CachedFile<>nil) and (CachedFile.Cache<>nil) then
1070    CachedFile.Cache.IncReadLineCounter;
1071  inherited IncLineNumber;
1072end;
1073
1074constructor TPas2jsFileLineReader.Create(const AFilename: string);
1075begin
1076  raise Exception.Create('TPas2jsFileLineReader.Create [20180126090825] no cache "'+AFilename+'"');
1077end;
1078
1079constructor TPas2jsFileLineReader.Create(aFile: TPas2jsCachedFile);
1080begin
1081  inherited Create(aFile.Filename,aFile.Source);
1082  FCachedFile:=aFile;
1083end;
1084
1085
1086{ TPas2jsCachedFile }
1087
1088// inline
1089function TPas2jsCachedFile.GetIsBinary: boolean;
1090begin
1091  Result:=FFileEncoding=EncodingBinary;
1092end;
1093
1094function TPas2jsCachedFile.GetCache: TPas2jsFilesCache;
1095begin
1096  Result:=TPas2jsFilesCache(FS);
1097end;
1098
1099constructor TPas2jsCachedFile.Create(aCache: TPas2jsFilesCache;
1100  const aFilename: string);
1101begin
1102  inHerited Create(aCache,aFileName);
1103  FChangeStamp:=InvalidChangeStamp;
1104  FCacheStamp:=Cache.ResetStamp;
1105end;
1106
1107function TPas2jsCachedFile.Load(RaiseOnError: boolean; Binary: boolean
1108  ): boolean;
1109
1110  procedure Err(const ErrorMsg: string);
1111  begin
1112    {$IFDEF VerboseFileCache}
1113    writeln('TPas2jsCachedFile.Load.Err ErrorMsg="',ErrorMsg,'"');
1114    {$ENDIF}
1115    FLastErrorMsg:=ErrorMsg;
1116    if RaiseOnError then
1117      raise EPas2jsFileCache.Create(FLastErrorMsg);
1118  end;
1119
1120var
1121  NewSource: string;
1122  b: Boolean;
1123begin
1124  {$IFDEF VerboseFileCache}
1125  writeln('TPas2jsCachedFile.Load START "',Filename,'" Loaded=',Loaded);
1126  {$ENDIF}
1127  if Loaded then
1128  begin
1129    // already loaded, check if it still valid
1130    if (Cache.ResetStamp=FCacheStamp) then
1131    begin
1132      // nothing changed
1133      Result:=FLastErrorMsg='';
1134      if (not Result) and RaiseOnError then
1135        raise EPas2jsFileCache.Create(FLastErrorMsg);
1136      exit;
1137    end;
1138    {$IFDEF VerboseFileCache}
1139    writeln('TPas2jsCachedFile.Load CHECK FILEAGE "',Filename,'"');
1140    {$ENDIF}
1141    if LoadedFileAge=Cache.DirectoryCache.FileAge(Filename) then
1142      exit(true);
1143  end;
1144  {$IFDEF VerboseFileCache}
1145  writeln('TPas2jsCachedFile.Load FIRST or RELOAD ',Filename,' Loaded=',Loaded);
1146  {$ENDIF}
1147  // needs (re)load
1148  Result:=false;
1149  if not Cache.FileExists(Filename) then
1150  begin
1151    Err('File not found "'+Filename+'"');
1152    exit;
1153  end;
1154  if Cache.DirectoryExists(Filename) then
1155  begin
1156    Err('File is a directory "'+Filename+'"');
1157    exit;
1158  end;
1159  NewSource:='';
1160  if RaiseOnError then
1161    b:=Cache.ReadFile(Filename,NewSource)
1162  else
1163    try
1164      b:=Cache.ReadFile(Filename,NewSource);
1165    except
1166    end;
1167  if not b then begin
1168    Err('Read error "'+Filename+'"');
1169    exit;
1170  end;
1171
1172  {$IFDEF VerboseFileCache}
1173  writeln('TPas2jsCachedFile.Load ENCODE ',Filename,' FFileEncoding=',FFileEncoding);
1174  {$ENDIF}
1175  if Binary then
1176  begin
1177    SetSource(NewSource);
1178    FFileEncoding:=EncodingBinary;
1179  end else
1180  begin
1181    {$IFDEF FPC_HAS_CPSTRING}
1182    SetSource(ConvertTextToUTF8(NewSource,FFileEncoding));
1183    {$ELSE}
1184    SetSource(NewSource);
1185    {$ENDIF}
1186  end;
1187  FLoaded:=true;
1188  FCacheStamp:=Cache.ResetStamp;
1189  FLoadedFileAge:=Cache.DirectoryCache.FileAge(Filename);
1190  {$IFDEF VerboseFileCache}
1191  writeln('TPas2jsCachedFile.Load END ',Filename,' FFileEncoding=',FFileEncoding);
1192  {$ENDIF}
1193end;
1194
1195function TPas2jsCachedFile.CreateLineReader(RaiseOnError: boolean
1196  ): TSourceLineReader;
1197begin
1198  if not Load(RaiseOnError) then
1199    exit(nil);
1200  Result:=TPas2jsFileLineReader.Create(Self);
1201end;
1202
1203{ TPas2jsFileResolver }
1204
1205function TPas2jsFileResolver.GetCache: TPas2jsFilesCache;
1206begin
1207  Result:=TPas2jsFilesCache(FS);
1208end;
1209
1210constructor TPas2jsFileResolver.Create(aCache: TPas2jsFilesCache);
1211begin
1212  inherited Create(aCache);
1213end;
1214
1215{ TPas2jsFilesCache }
1216
1217procedure TPas2jsFilesCache.RegisterMessages;
1218begin
1219  Log.RegisterMsg(mtInfo,nIncludeSearch,sIncludeSearch);
1220  Log.RegisterMsg(mtInfo,nUnitSearch,sUnitSearch);
1221  Log.RegisterMsg(mtInfo,nSearchingFileFound,sSearchingFileFound);
1222  Log.RegisterMsg(mtInfo,nSearchingFileNotFound,sSearchingFileNotFound);
1223  Log.RegisterMsg(mtFatal,nDuplicateFileFound,sDuplicateFileFound);
1224  Log.RegisterMsg(mtFatal,nCustomJSFileNotFound,sCustomJSFileNotFound);
1225end;
1226
1227function TPas2jsFilesCache.GetHasPCUSupport: Boolean;
1228begin
1229  Result:=False;
1230end;
1231
1232procedure TPas2jsFilesCache.SetBaseDirectory(AValue: string);
1233begin
1234  AValue:=Pas2jsFileUtils.ExpandDirectory(AValue);
1235  if FBaseDirectory=AValue then Exit;
1236  FBaseDirectory:=AValue;
1237  DirectoryCache.WorkingDirectory:=BaseDirectory;
1238end;
1239
1240function TPas2jsFilesCache.AddSearchPaths(const Paths: string;
1241  Kind: TPas2jsSearchPathKind; FromCmdLine: boolean; var List: TStringList;
1242  var CmdLineCount: integer): string;
1243// cmd line paths are added in front of the cfg paths
1244// cmd line paths are added in order, cfg paths are added in reverse order
1245// multi paths separated by semicolon are added in order
1246// duplicates are removed
1247var
1248  Added: Integer;
1249
1250  function Add(aPath: string): boolean;
1251  var
1252    Remove: Boolean;
1253    i: Integer;
1254  begin
1255    Remove:=false;
1256    // search duplicate
1257    case Kind of
1258    spkPath:
1259      begin
1260        i:=List.Count-1;
1261        while (i>=0) and (CompareFilenames(aPath,List[i])<>0) do dec(i);
1262      end;
1263    spkIdentifier:
1264      begin
1265        if aPath[length(aPath)]='-' then
1266        begin
1267          Delete(aPath,length(aPath),1);
1268          Remove:=true;
1269        end;
1270        if not IsValidIdent(aPath,true,true) then
1271        begin
1272          AddSearchPaths:=aPath;
1273          exit(false);
1274        end;
1275        i:=List.Count-1;
1276        while (i>=0) and (CompareText(aPath,List[i])<>0) do dec(i);
1277      end;
1278    end;
1279
1280    if Remove then
1281    begin
1282      // remove
1283      if i>=0 then
1284      begin
1285        List.Delete(i);
1286        if CmdLineCount>i then dec(CmdLineCount);
1287      end;
1288      exit(true);
1289    end;
1290
1291    if FromCmdLine then
1292    begin
1293      // from cmdline: append in order to the cmdline params, in front of cfg params
1294      if i>=0 then
1295      begin
1296        if i<=CmdLineCount then exit(true);
1297        List.Delete(i);
1298      end;
1299      List.Insert(CmdLineCount,aPath);
1300      inc(CmdLineCount);
1301    end else begin
1302      // from cfg: append in reverse order to the cfg params, behind cmdline params
1303      if i>=0 then
1304      begin
1305        if i<=CmdLineCount+Added then exit(true);
1306        List.Delete(i);
1307      end;
1308      List.Insert(CmdLineCount+Added,aPath);
1309      inc(Added);
1310    end;
1311    Result:=true;
1312  end;
1313
1314var
1315  aPath: String;
1316  p, i: integer;
1317  aPaths: TStringList;
1318begin
1319  Result:='';
1320  p:=1;
1321  Added:=0;
1322  aPaths:=TStringList.Create;
1323  try
1324    while p<=length(Paths) do begin
1325      aPath:=GetNextDelimitedItem(Paths,';',p);
1326      if aPath='' then continue;
1327      if Kind=spkPath then
1328      begin
1329        aPath:=ExpandDirectory(aPath);
1330        if aPath='' then continue;
1331      end;
1332      aPaths.Clear;
1333      FindMatchingFiles(aPath,1000,aPaths);
1334      if aPaths.Count=0 then
1335      begin
1336        if not Add(aPath) then exit;
1337      end else begin
1338        for i:=0 to aPaths.Count-1 do
1339          if not Add(aPaths[i]) then exit;
1340      end;
1341    end;
1342  finally
1343    aPaths.Free;
1344  end;
1345end;
1346
1347procedure TPas2jsFilesCache.SetOnReadDirectory(AValue: TReadDirectoryEvent);
1348begin
1349  DirectoryCache.OnReadDirectory:=AValue;
1350end;
1351
1352function TPas2jsFilesCache.ReadFile(Filename: string; var Source: string
1353  ): boolean;
1354{$IFDEF Pas2js}
1355{$ELSE}
1356var
1357  ms: TMemoryStream;
1358{$ENDIF}
1359begin
1360  Result:=false;
1361  try
1362    if Assigned(OnReadFile) then
1363      Result:=OnReadFile(Filename,Source);
1364    if Result then
1365      Exit;
1366    {$IFDEF Pas2js}
1367    try
1368      Source:=NJS_FS.readFileSync(Filename,new(['encoding','utf8']));
1369    except
1370      raise EReadError.Create(String(JSExceptValue));
1371    end;
1372    Result:=true;
1373    {$ELSE}
1374    ms:=TMemoryStream.Create;
1375    try
1376      ms.LoadFromFile(Filename);
1377      SetLength(Source,ms.Size);
1378      ms.Position:=0;
1379      if Source<>'' then
1380        ms.Read(Source[1],length(Source));
1381      Result:=true;
1382    finally
1383      ms.Free;
1384    end;
1385    {$ENDIF}
1386  except
1387    on E: Exception do begin
1388      EPas2jsFileCache.Create('Error reading file "'+Filename+'": '+E.Message);
1389    end;
1390  end;
1391end;
1392
1393procedure TPas2jsFilesCache.FindMatchingFiles(Mask: string; MaxCount: integer;
1394  Files: TStrings);
1395
1396  procedure TooMany(id: TMaxPrecInt);
1397  begin
1398    raise EListError.Create('found too many files "'+Mask+'". Max='+IntToStr(MaxCount)+' ['+IntToStr(id)+']');
1399  end;
1400
1401  procedure Find(aMask: string; p: integer);
1402  var
1403    Dir: TPas2jsCachedDirectory;
1404    StartP, i: Integer;
1405    CurMask, Filename: String;
1406    Entry: TPas2jsCachedDirectoryEntry;
1407  begin
1408    while p<=length(aMask) do begin
1409      if aMask[p] in ['*','?'] then
1410      begin
1411        while (p>1) and not (aMask[p-1] in AllowDirectorySeparators) do dec(p);
1412        Dir:=DirectoryCache.GetDirectory(LeftStr(aMask,p-1),true,false);
1413        StartP:=p;
1414        while (p<=length(aMask)) and not (aMask[p] in AllowDirectorySeparators) do
1415          inc(p);
1416        CurMask:=copy(aMask,StartP,p-StartP);
1417        for i:=0 to Dir.Count-1 do begin
1418          Entry:=Dir.Entries[i];
1419          if (Entry.Name='') or (Entry.Name='.') or (Entry.Name='..') then continue;
1420          if not MatchGlobbing(CurMask,Entry.Name) then continue;
1421          Filename:=Dir.Path+Entry.Name;
1422          if p>length(aMask) then
1423          begin
1424            // e.g. /path/unit*.pas
1425            if Files.Count>=MaxCount then
1426              TooMany(20180126091916);
1427            Files.Add(Filename);
1428          end else begin
1429            // e.g. /path/sub*path/...
1430            Find(Filename+copy(aMask,p,length(aMask)),length(Filename)+1);
1431          end;
1432        end;
1433        exit;
1434      end;
1435      inc(p);
1436    end;
1437    // mask has no placeholder -> search directly
1438    if FileExists(aMask) then
1439    begin
1440      if Files.Count>=MaxCount then
1441        TooMany(20180126091913);
1442      Files.Add(aMask);
1443    end;
1444  end;
1445
1446begin
1447  Mask:=ResolveDots(Mask);
1448  Find(Mask,1);
1449end;
1450
1451constructor TPas2jsFilesCache.Create(aLog: TPas2jsLogger);
1452begin
1453  inherited Create;
1454  FResetStamp:=InvalidChangeStamp;
1455  FLog:=aLog;
1456  FIncludePaths:=TStringList.Create;
1457  FForeignUnitPaths:=TStringList.Create;
1458  FUnitPaths:=TStringList.Create;
1459  FResourcePaths:=TStringList.Create;
1460  FFiles:=TPasAnalyzerKeySet.Create(
1461    {$IFDEF Pas2js}
1462    @Pas2jsCachedFileToKeyName,@PtrFilenameToKeyName
1463    {$ELSE}
1464    @CompareCachedFiles,@CompareFilenameWithCachedFile
1465    {$ENDIF});
1466  FDirectoryCache:=TPas2jsCachedDirectories.Create;
1467  RegisterMessages;
1468end;
1469
1470destructor TPas2jsFilesCache.Destroy;
1471begin
1472  FLog:=nil;
1473  FFiles.FreeItems;
1474  FreeAndNil(FDirectoryCache);
1475  FreeAndNil(FFiles);
1476  FreeAndNil(FIncludePaths);
1477  FreeAndNil(FForeignUnitPaths);
1478  FreeAndNil(FUnitPaths);
1479  FreeAndNil(FPCUPaths);
1480  inherited Destroy;
1481end;
1482
1483procedure TPas2jsFilesCache.Reset;
1484begin
1485  Inherited;
1486  IncreaseChangeStamp(FResetStamp);
1487  FDirectoryCache.Invalidate;
1488  // FFiles: keep data, files are checked against LoadedFileAge
1489  FBaseDirectory:='';
1490  FForeignUnitPaths.Clear;
1491  FForeignUnitPathsFromCmdLine:=0;
1492  FUnitPaths.Clear;
1493  FUnitPathsFromCmdLine:=0;
1494  FIncludePaths.Clear;
1495  FIncludePathsFromCmdLine:=0;
1496  FreeAndNil(FPCUPaths);
1497  // FOnReadFile: TPas2jsReadFileEvent; keep
1498  // FOnWriteFile: TPas2jsWriteFileEvent; keep
1499end;
1500
1501procedure TPas2jsFilesCache.WriteFoldersAndSearchPaths;
1502
1503  procedure WriteFolder(aName, Folder: string);
1504  begin
1505    if Folder='' then exit;
1506    Folder:=ChompPathDelim(Folder);
1507    Log.LogMsgIgnoreFilter(nUsingPath,[aName,Folder]);
1508    if not DirectoryExists(Folder) then
1509      Log.LogMsgIgnoreFilter(nFolderNotFound,[aName,QuoteStr(Folder)]);
1510  end;
1511
1512var
1513  i: Integer;
1514begin
1515  WriteFolder('working directory',BaseDirectory);
1516  for i:=0 to ForeignUnitPaths.Count-1 do
1517    WriteFolder('foreign unit path',ForeignUnitPaths[i]);
1518  for i:=0 to UnitPaths.Count-1 do
1519    WriteFolder('unit path',UnitPaths[i]);
1520  for i:=0 to IncludePaths.Count-1 do
1521    WriteFolder('include path',IncludePaths[i]);
1522  WriteFolder('unit output path',UnitOutputPath);
1523  WriteFolder('main output path',MainOutputPath);
1524end;
1525
1526procedure TPas2jsFilesCache.GetPCUDirs(aList: TStrings; const aBaseDir: String);
1527var
1528  i: Integer;
1529begin
1530  if FPCUPaths=nil then
1531    begin
1532    FPCUPaths:=TStringList.Create;
1533    inherited GetPCUDirs(FPCUPaths, aBaseDir);
1534    FPCUPaths.AddStrings(UnitPaths);
1535    for i:=0 to FPCUPaths.Count-1 do
1536      FPCUPaths[i]:=IncludeTrailingPathDelimiter(FPCUPaths[i]);
1537    DeleteDuplicateFiles(FPCUPaths);
1538    end;
1539  aList.Assign(FPCUPaths);
1540end;
1541
1542function TPas2jsFilesCache.PCUExists(var aFileName: string): Boolean;
1543begin
1544  Result:=SearchLowUpCase(aFileName);
1545end;
1546
1547function TPas2jsFilesCache.SameFileName(const File1, File2: String): Boolean;
1548begin
1549  Result:=Pas2jsFileUtils.CompareFilenames(File1,File2)=0;
1550end;
1551
1552function TPas2jsFilesCache.File1IsNewer(const File1, File2: String): Boolean;
1553begin
1554  Result:=FileAge(File1)>FileAge(File2);
1555end;
1556
1557function TPas2jsFilesCache.AddIncludePaths(const Paths: string;
1558  FromCmdLine: boolean; out ErrorMsg: string): boolean;
1559begin
1560  ErrorMsg:=AddSearchPaths(Paths,spkPath,FromCmdLine,FIncludePaths,FIncludePathsFromCmdLine);
1561  Result:=ErrorMsg='';
1562end;
1563
1564function TPas2jsFilesCache.AddUnitPaths(const Paths: string;
1565  FromCmdLine: boolean; out ErrorMsg: string): boolean;
1566begin
1567  ErrorMsg:=AddSearchPaths(Paths,spkPath,FromCmdLine,FUnitPaths,FUnitPathsFromCmdLine);
1568  Result:=ErrorMsg='';
1569end;
1570
1571function TPas2jsFilesCache.AddSrcUnitPaths(const Paths: string;
1572  FromCmdLine: boolean; out ErrorMsg: string): boolean;
1573begin
1574  ErrorMsg:=AddSearchPaths(Paths,spkPath,FromCmdLine,FForeignUnitPaths,FForeignUnitPathsFromCmdLine);
1575  Result:=ErrorMsg='';
1576end;
1577
1578function TPas2jsFilesCache.CreateResolver: TPas2jsFSResolver;
1579
1580begin
1581  Result := TPas2jsFileResolver.Create(Self);
1582  {$IFDEF HasStreams}
1583  Result.UseStreams:=false;
1584  {$ENDIF}
1585  Result.BaseDirectory:=BaseDirectory; // beware: will be changed by Scanner.OpenFile
1586end;
1587
1588function TPas2jsFilesCache.FormatPath(const aPath: string): string;
1589begin
1590  Result:=aPath;
1591  if (Result='') or (BaseDirectory='') then exit;
1592  if FilenameIsAbsolute(aPath) then
1593  begin
1594    if not ShowFullPaths then
1595    begin
1596      if BaseDirectory=LeftStr(Result,length(BaseDirectory)) then
1597        Delete(Result,1,length(BaseDirectory));
1598    end;
1599  end else begin
1600    if ShowFullPaths then
1601      Result:=BaseDirectory+Result;
1602  end;
1603end;
1604
1605
1606
1607function TPas2jsFilesCache.DirectoryExists(const Filename: string): boolean;
1608begin
1609  Result:=DirectoryCache.DirectoryExists(FileName);
1610end;
1611
1612function TPas2jsFilesCache.FileExists(const Filename: string): boolean;
1613begin
1614  Result:=DirectoryCache.FileExists(FileName);
1615end;
1616
1617function TPas2jsFilesCache.FileExistsI(var Filename: string): integer;
1618begin
1619  Result:=DirectoryCache.FileExistsI(FileName);
1620end;
1621
1622function TPas2jsFilesCache.FileAge(const Filename: string): TPas2jsFileAgeTime;
1623begin
1624  Result:=DirectoryCache.FileAge(FileName);
1625end;
1626
1627function TPas2jsFilesCache.FindFile(Filename: string): TPas2jsCachedFile;
1628begin
1629  Filename:=NormalizeFilename(Filename,true);
1630  Result:=TPas2jsCachedFile(FFiles.FindKey(Pointer(Filename)));
1631end;
1632
1633function TPas2jsFilesCache.LoadFile(Filename: string; Binary: boolean
1634  ): TPas2jsFile;
1635begin
1636  Result:=FindFile(FileName);
1637  if Result=nil then
1638  begin
1639    // new file
1640    Result:=TPas2jsCachedFile.Create(Self,Filename);
1641    FFiles.Add(Result);
1642  end;
1643  Result.Load(true,Binary);
1644end;
1645
1646function TPas2jsFilesCache.NormalizeFilename(const Filename: string;
1647  RaiseOnError: boolean): string;
1648begin
1649  Result:=Filename;
1650  if ExtractFilename(Result)='' then
1651    if RaiseOnError then
1652      raise EFileNotFoundError.Create('invalid file name "'+Filename+'"');
1653  Result:=ExpandFileNamePJ(Result,BaseDirectory);
1654  if (ExtractFilename(Result)='') or not FilenameIsAbsolute(Result) then
1655    if RaiseOnError then
1656      raise EFileNotFoundError.Create('invalid file name "'+Filename+'"');
1657end;
1658
1659procedure TPas2jsFilesCache.GetListing(const aDirectory: string;
1660  var Files: TStrings; FullPaths: boolean);
1661begin
1662  DirectoryCache.GetDirectory(aDirectory,true,false).GetFiles(Files,FullPaths);
1663end;
1664
1665procedure TPas2jsFilesCache.RaiseDuplicateFile(aFilename: string);
1666
1667  procedure E(const File1, File2: string);
1668  begin
1669    raise EPas2jsFileCache.Create(SafeFormat(sDuplicateFileFound,[File1,File2]));
1670  end;
1671
1672var
1673  Dir: TPas2jsCachedDirectory;
1674  i: Integer;
1675  List: TStringList;
1676  ShortFilename: String;
1677begin
1678  Dir:=DirectoryCache.GetDirectory(ExtractFilePath(aFilename),true,false);
1679  ShortFilename:=ExtractFilename(aFilename);
1680  i:=Dir.IndexOfFileCaseSensitive(ShortFilename);
1681  if i<0 then
1682    E(aFilename,'?');
1683  List:=TStringList.Create;
1684  try
1685    Dir.GetSameNamesCaseInsensitive(i,List);
1686    if List.Count<2 then
1687      E(aFilename,'?');
1688    E(Dir.Path+List[0],List[1]);
1689  finally
1690    List.Free;
1691  end;
1692end;
1693
1694procedure TPas2jsFilesCache.SaveToFile(ms: TFPJSStream; Filename: string);
1695var
1696  s: string;
1697  {$IFDEF FPC}
1698  i: Integer;
1699  l: TMaxPrecInt;
1700  {$ENDIF}
1701begin
1702  if Assigned(OnWriteFile) then
1703  begin
1704    {$IFDEF Pas2js}
1705    s:=ms.join('');
1706    {$ELSE}
1707    l:=ms.Size-ms.Position;
1708    if l>0 then
1709    begin
1710      s:='';
1711      SetLength(s,l);
1712      ms.Read(s[1],l);
1713    end
1714    else
1715      s:='';
1716    {$ENDIF}
1717    OnWriteFile(Filename,s);
1718  end else
1719  begin
1720    {$IFDEF Pas2js}
1721    try
1722      s:=ms.join('');
1723      NJS_FS.writeFileSync(Filename,s,new(['encoding','utf8']));
1724    except
1725      raise EWriteError.Create(String(JSExceptValue));
1726    end;
1727    {$ELSE}
1728    try
1729      ms.SaveToFile(Filename);
1730    except
1731      on E: Exception do begin
1732        i:=GetLastOSError;
1733        if i<>0 then
1734          Log.LogPlain('Note: '+SysErrorMessage(i));
1735        if not DirectoryExists(ChompPathDelim(ExtractFilePath(Filename))) then
1736          Log.LogPlain('Note: file cache inconsistency: folder does not exist "'+ChompPathDelim(ExtractFilePath(Filename))+'"');
1737        if FileExists(Filename) and not FileIsWritable(Filename) then
1738          Log.LogPlain('Note: file is not writable "'+Filename+'"');
1739        raise;
1740      end;
1741    end;
1742    {$ENDIF}
1743  end;
1744end;
1745
1746function TPas2jsFilesCache.ExpandDirectory(const Filename: string): string;
1747begin
1748  if Filename='' then exit('');
1749  Result:=ExpandFileNamePJ(Filename,BaseDirectory);
1750  if Result='' then exit;
1751  Result:=IncludeTrailingPathDelimiter(Result);
1752end;
1753
1754function TPas2jsFilesCache.ExpandFileName(const Filename: string): string;
1755begin
1756  Result:=ExpandFileNamePJ(Filename,BaseDirectory);
1757end;
1758
1759function TPas2jsFilesCache.ExpandExecutable(const Filename: string): string;
1760
1761  function TryFile(CurFilename: string): boolean;
1762  begin
1763    Result:=false;
1764    CurFilename:=ResolveDots(CurFilename);
1765    if not FileExists(CurFilename) then exit;
1766    ExpandExecutable:=CurFilename;
1767    Result:=true;
1768  end;
1769
1770var
1771  PathVar, CurPath: String;
1772  p, StartPos: Integer;
1773begin
1774  if Filename='' then exit('');
1775  if ExtractFilePath(Filename)='' then
1776  begin
1777    // no file path -> search
1778    {$IFDEF Windows}
1779    // search in BaseDir
1780    if BaseDirectory<>'' then
1781    begin
1782      if TryFile(IncludeTrailingPathDelimiter(BaseDirectory)+Filename) then exit;
1783    end;
1784    {$ENDIF}
1785    // search in PATH
1786    PathVar:=GetEnvironmentVariablePJ('PATH');
1787    p:=1;
1788    while p<=length(PathVar) do
1789    begin
1790      while (p<=length(PathVar)) and (PathVar[p]=PathSeparator) do inc(p);
1791      StartPos:=p;
1792      while (p<=length(PathVar)) and (PathVar[p]<>PathSeparator) do inc(p);
1793      CurPath:=copy(PathVar,StartPos,p-StartPos);
1794      if CurPath='' then continue;
1795      CurPath:=ExpandFileNamePJ(CurPath);
1796      if CurPath='' then continue;
1797      if TryFile(IncludeTrailingPathDelimiter(CurPath)+Filename) then exit;
1798    end;
1799  end else
1800    Result:=ExpandFileName(Filename);
1801end;
1802
1803function TPas2jsFilesCache.HandleOptionPaths(C: Char; aValue: String; FromCmdLine: Boolean): String;
1804
1805Var
1806  ErrorMsg : String;
1807
1808begin
1809  Result:='';
1810  case C of
1811    'E': MainOutputPath:=aValue;
1812    'i': if not AddIncludePaths(aValue,FromCmdLine,ErrorMsg) then
1813           Result:='invalid include path (-Fi) "'+ErrorMsg+'"';
1814    'u': if not AddUnitPaths(aValue,FromCmdLine,ErrorMsg) then
1815           Result:='invalid unit path (-Fu) "'+ErrorMsg+'"';
1816    'U': UnitOutputPath:=aValue;
1817  else
1818    Result:=inherited HandleOptionPaths(C, aValue, FromCmdLine);
1819  end;
1820end;
1821
1822function TPas2jsFilesCache.AddForeignUnitPath(const aValue: String; FromCmdLine: Boolean): String;
1823begin
1824  AddSrcUnitPaths(aValue,FromCmdLine,Result);
1825end;
1826
1827function TPas2jsFilesCache.TryCreateRelativePath(const Filename,
1828  BaseDirectory: String; UsePointDirectory,
1829  AlwaysRequireSharedBaseFolder: boolean; out RelPath: String): Boolean;
1830begin
1831  Result:=Pas2jsFileUtils.TryCreateRelativePath(Filename, BaseDirectory,
1832    UsePointDirectory, AlwaysRequireSharedBaseFolder, RelPath);
1833end;
1834
1835function TPas2jsFilesCache.FindIncludeFileName(const aFilename,
1836  ModuleDir: string): String;
1837
1838  function SearchCasedInIncPath(const Filename: string): string;
1839  var
1840    i: Integer;
1841  begin
1842    // file name is relative
1843    // first search in the same directory as the unit
1844    if ModuleDir<>'' then
1845      begin
1846      Result:=IncludeTrailingPathDelimiter(ModuleDir)+Filename;
1847      if SearchLowUpCase(Result) then exit;
1848      end;
1849    // then search in include path
1850    for i:=0 to IncludePaths.Count-1 do begin
1851      Result:=IncludeTrailingPathDelimiter(IncludePaths[i])+Filename;
1852      if SearchLowUpCase(Result) then exit;
1853    end;
1854    Result:='';
1855  end;
1856
1857var
1858  Filename : string;
1859begin
1860  Result := '';
1861
1862  // convert pathdelims to system
1863  Filename:=SetDirSeparators(aFilename);
1864  if ShowTriedUsedFiles then
1865    Log.LogMsgIgnoreFilter(nIncludeSearch,[Filename]);
1866
1867  if FilenameIsAbsolute(Filename) then
1868  begin
1869    Result:=Filename;
1870    if not SearchLowUpCase(Result) then
1871      Result:='';
1872    exit;
1873  end;
1874
1875  // search with the given file extension (even if no ext)
1876  Result:=SearchCasedInIncPath(Filename);
1877  if Result<>'' then exit;
1878
1879  if ExtractFileExt(Filename)='' then
1880  begin
1881    // search with the default file extensions
1882    Result:=SearchCasedInIncPath(Filename+'.inc');
1883    if Result<>'' then exit;
1884    Result:=SearchCasedInIncPath(Filename+'.pp');
1885    if Result<>'' then exit;
1886    Result:=SearchCasedInIncPath(Filename+'.pas');
1887    if Result<>'' then exit;
1888  end;
1889end;
1890
1891function TPas2jsFilesCache.FindSourceFileName(const aFilename: string): String;
1892
1893Var
1894  Found: Boolean;
1895  i: Integer;
1896
1897begin
1898  Result:=aFilename;
1899  if StrictFileCase or SearchLikeFPC then
1900    Found:=FileExists(Result)
1901  else
1902    begin
1903    i:=FileExistsI(Result);
1904    Found:=i=1;
1905    if i>1 then
1906      RaiseDuplicateFile(Result);
1907    end;
1908  if not Found then
1909    raise EFileNotFoundError.Create(aFilename)
1910end;
1911
1912
1913function TPas2jsFilesCache.FindUnitFileName(const aUnitname, InFilename,
1914  ModuleDir: string; out IsForeign: boolean): String;
1915var
1916  SearchedDirs: TStringList;
1917
1918  function SearchInDir(Dir: string; var Filename: string): boolean;
1919  // search in Dir for pp, pas, p times given case, lower case, upper case
1920  begin
1921    Dir:=IncludeTrailingPathDelimiter(Dir);
1922    if IndexOfFile(SearchedDirs,Dir)>=0 then exit(false);
1923    SearchedDirs.Add(Dir);
1924    Filename:=Dir+aUnitname+'.pp';
1925    if SearchLowUpCase(Filename) then exit(true);
1926    Filename:=Dir+aUnitname+'.pas';
1927    if SearchLowUpCase(Filename) then exit(true);
1928    Filename:=Dir+aUnitname+'.p';
1929    if SearchLowUpCase(Filename) then exit(true);
1930    Result:=false;
1931  end;
1932
1933var
1934  i: Integer;
1935  aFilename: String;
1936begin
1937  //writeln('TPas2jsFilesCache.FindUnitFileName "',aUnitname,'" ModuleDir="',ModuleDir,'"');
1938  Result:='';
1939  IsForeign:=false;
1940  SearchedDirs:=TStringList.Create;
1941  try
1942    if InFilename<>'' then
1943    begin
1944      aFilename:=SetDirSeparators(InFilename);
1945      Result:=ResolveDots(aFilename);
1946      if FilenameIsAbsolute(Result) then
1947      begin
1948        if SearchLowUpCase(Result) then exit;
1949      end else
1950      begin
1951        Result:=ResolveDots(ModuleDir+Result);
1952        if SearchLowUpCase(Result) then exit;
1953      end;
1954      exit('');
1955    end;
1956
1957    // first search in foreign unit paths
1958    IsForeign:=true;
1959    for i:=0 to ForeignUnitPaths.Count-1 do
1960      if SearchInDir(ForeignUnitPaths[i],Result) then
1961      begin
1962        IsForeign:=true;
1963        exit;
1964      end;
1965
1966    // then in ModuleDir
1967    IsForeign:=false;
1968    if SearchInDir(ModuleDir,Result) then exit;
1969
1970    // then in BaseDirectory
1971    IsForeign:=false;
1972    if SearchInDir(BaseDirectory,Result) then exit;
1973
1974    // finally search in unit paths
1975    for i:=0 to UnitPaths.Count-1 do
1976      if SearchInDir(UnitPaths[i],Result) then exit;
1977  finally
1978    SearchedDirs.Free;
1979  end;
1980
1981  Result:='';
1982end;
1983
1984function TPas2jsFilesCache.FindResourceFileName(const aFilename, ModuleDir: string): String;
1985
1986var
1987  SearchedDirs: TStringList;
1988
1989  function SearchInDir(Dir: string; var Filename: string): boolean;
1990  // search in Dir for pp, pas, p times given case, lower case, upper case
1991  var
1992    CurFile : String;
1993  begin
1994    Dir:=IncludeTrailingPathDelimiter(Dir);
1995    if IndexOfFile(SearchedDirs,Dir)>=0 then exit(false);
1996    SearchedDirs.Add(Dir);
1997    CurFile:=Dir+Filename;
1998    if SearchLowUpCase(CurFile) then
1999      begin
2000      FileName:=CurFile;
2001      exit(true);
2002      end;
2003    Result:=false;
2004  end;
2005
2006var
2007  i: Integer;
2008
2009begin
2010  //writeln('TPas2jsFilesCache.FindUnitFileName "',aUnitname,'" ModuleDir="',ModuleDir,'"');
2011  Result:='';
2012  SearchedDirs:=TStringList.Create;
2013  try
2014    Result:=SetDirSeparators(aFilename);
2015
2016    // First search in ModuleDir
2017    if SearchInDir(ModuleDir,Result) then
2018      exit;
2019
2020    // Then in resource paths
2021    for i:=0 to ResourcePaths.Count-1 do
2022      if SearchInDir(ResourcePaths[i],Result) then
2023        exit;
2024    // Not sure
2025    // finally search in unit paths
2026    // for i:=0 to UnitPaths.Count-1 do
2027    //  if SearchInDir(UnitPaths[i],Result) then exit;
2028  finally
2029    SearchedDirs.Free;
2030  end;
2031
2032  Result:='';
2033end;
2034
2035function TPas2jsFilesCache.FindUnitJSFileName(const aUnitFilename: string): String;
2036
2037begin
2038  Result:='';
2039  if aUnitFilename='' then exit;
2040    begin
2041    if UnitOutputPath<>'' then
2042      Result:=UnitOutputPath+ChangeFileExt(ExtractFileName(aUnitFilename),'.js')
2043    else if MainOutputPath<>'' then
2044      Result:=MainOutputPath+ChangeFileExt(ExtractFileName(aUnitFilename),'.js')
2045    else
2046      Result:=ChangeFileExt(aUnitFilename,'.js');
2047    end;
2048end;
2049
2050function TPas2jsFilesCache.FindCustomJSFileName(const aFilename: string): String;
2051
2052Var
2053  FN : String;
2054
2055  function SearchInDir(Dir: string): boolean;
2056  var
2057    CurFilename: String;
2058  begin
2059    Dir:=IncludeTrailingPathDelimiter(Dir);
2060    CurFilename:=Dir+FN;
2061    Result:=FileExistsLogged(CurFilename);
2062    if Result then
2063      FindCustomJSFileName:=CurFilename;
2064  end;
2065
2066var
2067  i: Integer;
2068begin
2069  Result:='';
2070  FN:=ResolveDots(aFileName);
2071  if FilenameIsAbsolute(FN) then
2072    begin
2073    Result:=FN;
2074    if not FileExistsLogged(Result) then
2075      Result:='';
2076    exit;
2077    end;
2078
2079  if ExtractFilePath(FN)<>'' then
2080    begin
2081    Result:=ExpandFileNamePJ(FN,BaseDirectory);
2082    if not FileExistsLogged(Result) then
2083      Result:='';
2084    exit;
2085    end;
2086
2087  // first search in foreign unit paths
2088  for i:=0 to ForeignUnitPaths.Count-1 do
2089    if SearchInDir(ForeignUnitPaths[i]) then
2090      exit;
2091
2092  // then in BaseDirectory
2093  if SearchInDir(BaseDirectory) then exit;
2094
2095  // finally search in unit paths
2096  for i:=0 to UnitPaths.Count-1 do
2097    if SearchInDir(UnitPaths[i]) then exit;
2098
2099  Result:='';
2100end;
2101
2102function TPas2jsFilesCache.FileExistsLogged(const Filename: string): boolean;
2103begin
2104  Result:=FileExists(Filename);
2105  if ShowTriedUsedFiles then
2106    if Result then
2107      Log.LogMsgIgnoreFilter(nSearchingFileFound,[FormatPath(Filename)])
2108    else
2109      Log.LogMsgIgnoreFilter(nSearchingFileNotFound,[FormatPath(Filename)]);
2110end;
2111
2112function TPas2jsFilesCache.GetOnReadDirectory: TReadDirectoryEvent;
2113begin
2114  Result:=DirectoryCache.OnReadDirectory;
2115end;
2116
2117function TPas2jsFilesCache.FileExistsILogged(var Filename: string): integer;
2118begin
2119  Result:=DirectoryCache.FileExistsI(Filename);
2120  if ShowTriedUsedFiles then
2121    if Result>0 then
2122      Log.LogMsgIgnoreFilter(nSearchingFileFound,[FormatPath(Filename)])
2123    else
2124      Log.LogMsgIgnoreFilter(nSearchingFileNotFound,[FormatPath(Filename)]);
2125end;
2126
2127function TPas2jsFilesCache.SearchLowUpCase(var Filename: string): boolean;
2128var
2129  i: Integer;
2130{$IFNDEF CaseInsensitiveFilenames}
2131  CasedFilename: String;
2132{$ENDIF}
2133begin
2134  if StrictFileCase or SearchLikeFPC then
2135  begin
2136    if FileExistsLogged(Filename) then
2137      exit(true);
2138    if StrictFileCase then
2139      exit(false);
2140    {$IFNDEF CaseInsensitiveFilenames}
2141    // FPC like search:
2142    // first as written, then lowercase, then uppercase
2143    CasedFilename:=ExtractFilePath(Filename)+LowerCase(ExtractFileName(Filename));
2144    if (Filename<>CasedFilename) and FileExistsLogged(CasedFilename) then
2145    begin
2146      Filename:=CasedFilename;
2147      exit(true);
2148    end;
2149    CasedFilename:=ExtractFilePath(Filename)+UpperCase(ExtractFileName(Filename));
2150    if (Filename<>CasedFilename) and FileExistsLogged(CasedFilename) then
2151    begin
2152      Filename:=CasedFilename;
2153      exit(true);
2154    end;
2155    {$ENDIF}
2156  end else
2157  begin
2158    // search case insensitive
2159    i:=FileExistsILogged(Filename);
2160    if i=1 then exit(true);
2161    if i>1 then
2162      RaiseDuplicateFile(Filename);
2163  end;
2164  Result:=false;
2165end;
2166
2167end.
2168
2169