mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-31 18:32:11 +01:00
531 lines
13 KiB
ObjectPascal
531 lines
13 KiB
ObjectPascal
unit webfilecache;
|
|
|
|
{$mode objfpc}
|
|
|
|
// Enable this to write lots of debugging info to the browser console.
|
|
{ $DEFINE VERBOSEWEBCACHE}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, JS, Web, fpjson, pas2jsfs, pscanner, contnrs;
|
|
|
|
type
|
|
TPas2jsWebFS = Class;
|
|
|
|
{ TWebFileContent }
|
|
|
|
TWebFileContent = Class(TObject)
|
|
private
|
|
FContents: string;
|
|
FFileName: String;
|
|
FModified: Boolean;
|
|
procedure SetContents(AValue: string);
|
|
Public
|
|
Constructor Create(const aFileName,aContents : String);
|
|
Property FileName : String Read FFileName Write FFileName;
|
|
Property Contents : string Read FContents Write SetContents;
|
|
Property Modified : Boolean Read FModified;
|
|
end;
|
|
{ TWebFilesCache }
|
|
|
|
TWebFilesCache = Class(TObject)
|
|
Private
|
|
FFiles : TFPObjectHashTable;
|
|
Function FindFile(aFileName : String) : TWebFileContent;
|
|
Public
|
|
Constructor Create;
|
|
Destructor Destroy; override;
|
|
Function HasFile(aFileName : String) : Boolean;
|
|
Function GetFileContent(Const aFileName : String) : String;
|
|
function SetFileContent(const aFileName, aContent: String): Boolean;
|
|
end;
|
|
|
|
{ TPas2jsWebFile }
|
|
|
|
TPas2jsWebFile = Class(TPas2jsFile)
|
|
public
|
|
function CreateLineReader(RaiseOnError: boolean): TSourceLineReader; override;
|
|
function Load(RaiseOnError: boolean; Binary: boolean): boolean; override;
|
|
end;
|
|
|
|
{ TWebSourceLineReader }
|
|
|
|
TWebSourceLineReader = Class(TSourceLineReader)
|
|
private
|
|
FFS: TPas2jsFS;
|
|
Protected
|
|
Property FS : TPas2jsFS Read FFS;
|
|
Procedure IncLineNumber; override;
|
|
end;
|
|
|
|
// aFileName is the original filename, not normalized one
|
|
TLoadFileEvent = Reference to Procedure(Sender : TObject; aFileName : String; aError : string);
|
|
|
|
{ TLoadFileRequest }
|
|
|
|
TLoadFileRequest = Class(TObject)
|
|
FFS : TPas2jsWebFS;
|
|
FFileName : string;
|
|
FXML : TJSXMLHttpRequest;
|
|
FOnLoaded : TLoadFileEvent;
|
|
private
|
|
procedure DoChange;
|
|
Public
|
|
constructor Create(aFS: TPas2jsWebFS; const aFileName : string; aOnLoaded: TLoadFileEvent);
|
|
Procedure DoLoad(const aURL : String);
|
|
end;
|
|
|
|
|
|
{ TPas2jsWebFS }
|
|
|
|
TPas2jsWebFS = Class(TPas2jsFS)
|
|
Private
|
|
FCache : TWebFilesCache;
|
|
FLoadBaseURL: String;
|
|
FOnLoadedFile: TLoadFileEvent;
|
|
protected
|
|
// Only for names, no paths
|
|
Class Function NormalizeFileName(Const aFileName : String) : String;
|
|
function FindSourceFileName(const aFilename: string): String; override;
|
|
public
|
|
Constructor Create; override;
|
|
// Overrides
|
|
function CreateResolver: TPas2jsFSResolver; override;
|
|
function FileExists(const aFileName: String): Boolean; override;
|
|
function FindCustomJSFileName(const aFilename: string): String; override;
|
|
function FindIncludeFileName(const aFilename: string): String; override;
|
|
function FindUnitFileName(const aUnitname, InFilename: string; out IsForeign: boolean): String; override;
|
|
function FindUnitJSFileName(const aUnitFilename: string): String; override;
|
|
function LoadFile(Filename: string; Binary: boolean=false): TPas2jsFile; override;
|
|
procedure SaveToFile(ms: TFPJSStream; Filename: string); override;
|
|
Function SetFileContent(Const aFileName,aContents : String) : Boolean;
|
|
Function GetFileContent(Const aFileName : String) : String;
|
|
// Returns false if the file was already loaded. OnLoaded is called in either case.
|
|
Function LoadFile(aFileName : String; OnLoaded : TLoadFileEvent = Nil) : Boolean;
|
|
// Returns number of load requests. OnLoaded is called for each file in the list
|
|
Function LoadFiles(aList : TStrings;OnLoaded : TLoadFileEvent = Nil) : Integer;
|
|
Function LoadFiles(aList : array of String;OnLoaded : TLoadFileEvent = Nil) : integer;
|
|
Property OnLoadedFile : TLoadFileEvent Read FOnLoadedFile Write FOnLoadedFile;
|
|
Property LoadBaseURL : String Read FLoadBaseURL Write FLoadBaseURL;
|
|
end;
|
|
|
|
{ TPas2jsFileResolver }
|
|
|
|
{ TPas2jsWebResolver }
|
|
|
|
TPas2jsWebResolver = class(TPas2jsFSResolver)
|
|
private
|
|
function GetWebFS: TPas2jsWebFS;
|
|
public
|
|
Property WebFS : TPas2jsWebFS Read GetWebFS;
|
|
end;
|
|
|
|
implementation
|
|
|
|
{ TWebSourceLineReader }
|
|
|
|
procedure TWebSourceLineReader.IncLineNumber;
|
|
begin
|
|
if (FFS<>nil) then
|
|
FFS.IncReadLineCounter;
|
|
inherited IncLineNumber;
|
|
end;
|
|
|
|
{ TLoadFileRequest }
|
|
|
|
procedure TLoadFileRequest.DoChange;
|
|
|
|
Var
|
|
Err : String;
|
|
begin
|
|
Case FXML.readyState of
|
|
TJSXMLHttpRequest.UNSENT : ;
|
|
TJSXMLHttpRequest.OPENED : ;
|
|
TJSXMLHttpRequest.HEADERS_RECEIVED : ;
|
|
TJSXMLHttpRequest.LOADING : ;
|
|
TJSXMLHttpRequest.DONE :
|
|
begin
|
|
if (FXML.Status div 100)=2 then
|
|
begin
|
|
Err:='';
|
|
// FS will normalize filename
|
|
FFS.SetFileContent(FFileName,FXML.responsetext)
|
|
end
|
|
else
|
|
Err:='Error loading file: '+FXML.StatusText;
|
|
If Assigned(FOnLoaded) then
|
|
FOnLoaded(FFS,FFileName,Err);
|
|
if Assigned(FFS.OnLoadedFile) then
|
|
FFS.OnLoadedFile(FFS,FFileName,Err);
|
|
Free;
|
|
end;
|
|
end
|
|
end;
|
|
|
|
constructor TLoadFileRequest.Create(aFS: TPas2jsWebFS; const aFileName : string; aOnLoaded: TLoadFileEvent);
|
|
begin
|
|
FFS:=aFS;
|
|
FOnLoaded:=aOnLoaded;
|
|
FFileName:=aFileName;
|
|
end;
|
|
|
|
Procedure TLoadFileRequest.DoLoad(const aURL: String);
|
|
begin
|
|
FXML:=TJSXMLHttpRequest.new;
|
|
FXML.onreadystatechange:=@DoChange;
|
|
// Maybe one day allow do this sync, so the compiler can load files on demand.
|
|
FXML.Open('GET',aURL);
|
|
FXML.Send;
|
|
end;
|
|
|
|
{ TPas2jsWebFile }
|
|
|
|
function TPas2jsWebFile.CreateLineReader(RaiseOnError: boolean): TSourceLineReader;
|
|
begin
|
|
{$IFDEF VERBOSEWEBCACHE}
|
|
Writeln(ClassName,': Creating line reader for ',FileName);
|
|
{$ENDIF}
|
|
if Load(RaiseOnError,False) then
|
|
begin
|
|
Result:=TWebSourceLineReader.Create(FileName,Source);
|
|
TWebSourceLineReader(Result).FFS:=Self.FS;
|
|
end
|
|
else
|
|
Result:=Nil;
|
|
end;
|
|
|
|
function TPas2jsWebFile.Load(RaiseOnError: boolean; Binary: boolean): boolean;
|
|
begin
|
|
Result:=False;
|
|
{$IFDEF VERBOSEWEBCACHE}
|
|
Writeln(ClassName,': Loading for ',FileName);
|
|
{$ENDIF}
|
|
With (FS as TPas2jsWebFS).FCache do
|
|
if HasFile(FileName) then
|
|
begin
|
|
SetSource(GetFileContent(FileName));
|
|
Result:=True;
|
|
end;
|
|
if Not Result then
|
|
if RaiseOnError then
|
|
Raise EFileNotFoundError.Create('File not loaded '+FileName)
|
|
{$IFDEF VERBOSEWEBCACHE}
|
|
else Writeln('File not loaded '+FileName);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{ TWebFilesCache }
|
|
|
|
function TWebFilesCache.FindFile(aFileName: String): TWebFileContent;
|
|
|
|
Var
|
|
N : THTCustomNode;
|
|
|
|
begin
|
|
{$IFDEF VERBOSEWEBCACHE}
|
|
Writeln(ClassName,': Looking for file : ',aFileName);
|
|
{$ENDIF}
|
|
N:=FFiles.Find(aFileName);
|
|
if N=Nil then
|
|
result:=Nil
|
|
else
|
|
Result:=TWebFileContent(THTObjectNode(N).Data);
|
|
{$IFDEF VERBOSEWEBCACHE}
|
|
Writeln(ClassName,': Looking for file : ',aFileName, ': ',Assigned(Result));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
constructor TWebFilesCache.Create;
|
|
begin
|
|
FFiles:=TFPObjectHashTable.Create(True);
|
|
end;
|
|
|
|
destructor TWebFilesCache.Destroy;
|
|
begin
|
|
FreeAndNil(FFiles);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TWebFilesCache.HasFile(aFileName: String): Boolean;
|
|
begin
|
|
Result:=FindFile(aFileName)<>Nil;
|
|
{$IFDEF VERBOSEWEBCACHE}
|
|
Writeln(ClassName,': HasFile(',aFileName,') : ',Result);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TWebFilesCache.GetFileContent(const aFileName: String): String;
|
|
|
|
Var
|
|
W : TWebFileContent;
|
|
|
|
begin
|
|
{$IFDEF VERBOSEWEBCACHE}
|
|
Writeln(ClassName,': GetFileContent(',aFileName,')');
|
|
{$ENDIF}
|
|
W:=FindFile(aFileName);
|
|
if Assigned(W) then
|
|
Result:=W.Contents
|
|
else
|
|
Raise EFileNotFoundError.Create('No such file '+AFileName);
|
|
end;
|
|
|
|
function TWebFilesCache.SetFileContent(const aFileName, aContent: String) : Boolean;
|
|
|
|
Var
|
|
W : TWebFileContent;
|
|
|
|
begin
|
|
{$IFDEF VERBOSEWEBCACHE}
|
|
Writeln(ClassName,': SetFileContent(',aFileName,')');
|
|
{$ENDIF}
|
|
W:=FindFile(aFileName);
|
|
Result:=Assigned(W);
|
|
if Result then
|
|
W.Contents:=aContent
|
|
else
|
|
FFiles.Add(aFileName,TWebFileContent.Create(aFileName,aContent));
|
|
end;
|
|
|
|
{ TWebFileContent }
|
|
|
|
procedure TWebFileContent.SetContents(AValue: string);
|
|
begin
|
|
if FContents=AValue then Exit;
|
|
FContents:=AValue;
|
|
FModified:=True;
|
|
end;
|
|
|
|
constructor TWebFileContent.Create(const aFileName, aContents: String);
|
|
begin
|
|
FContents:=aContents;
|
|
FFileName:=aFileName;
|
|
end;
|
|
|
|
|
|
{ TPas2jsWebFS }
|
|
|
|
function TPas2jsWebFS.FileExists(const aFileName: String): Boolean;
|
|
begin
|
|
{$IFDEF VERBOSEWEBCACHE}
|
|
Writeln(ClassName,': FileExists(',aFileName,')');
|
|
{$ENDIF}
|
|
Result:=FCache.HasFile(NormalizeFileName(aFileName));
|
|
{$IFDEF VERBOSEWEBCACHE}
|
|
Writeln(ClassName,': FileExists(',aFileName,') : ',Result);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TPas2jsWebFS.FindCustomJSFileName(const aFilename: string): String;
|
|
begin
|
|
{$IFDEF VERBOSEWEBCACHE}
|
|
Writeln(ClassName,': FindCustomJSFileName(',aFileName,')');
|
|
{$ENDIF}
|
|
Result:=NormalizeFileName(aFileName);
|
|
If not FCache.HasFile(Result) then
|
|
Result:='';
|
|
{$IFDEF VERBOSEWEBCACHE}
|
|
Writeln(ClassName,': FindCustomJSFileName(',aFileName,'): ',Result);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TPas2jsWebFS.FindIncludeFileName(const aFilename: string): String;
|
|
begin
|
|
{$IFDEF VERBOSEWEBCACHE}
|
|
Writeln(ClassName,': FindIncludeFileName(',aFileName,')');
|
|
{$ENDIF}
|
|
Result:=NormalizeFileName(aFileName);
|
|
If not FCache.HasFile(Result) then
|
|
Result:='';
|
|
{$IFDEF VERBOSEWEBCACHE}
|
|
Writeln(ClassName,': FindIncludeFileName(',aFileName,') : ',Result);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
class function TPas2jsWebFS.NormalizeFileName(const aFileName: String): String;
|
|
begin
|
|
Result:=LowerCase(ExtractFileName(aFileName));
|
|
end;
|
|
|
|
function TPas2jsWebFS.FindSourceFileName(const aFilename: string): String;
|
|
begin
|
|
{$IFDEF VERBOSEWEBCACHE}
|
|
Writeln(ClassName,': FindSourceFileName(',aFileName,')');
|
|
{$ENDIF}
|
|
Result:=NormalizeFileName(aFileName);
|
|
If not FCache.HasFile(Result) then
|
|
Result:='';
|
|
{$IFDEF VERBOSEWEBCACHE}
|
|
Writeln(ClassName,': FindSourceFileName(',aFileName,') : ',Result);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
constructor TPas2jsWebFS.Create;
|
|
begin
|
|
inherited Create;
|
|
FCache:=TWebFilesCache.Create;
|
|
end;
|
|
|
|
function TPas2jsWebFS.CreateResolver: TPas2jsFSResolver;
|
|
begin
|
|
Result:=TPas2jsWebResolver.Create(Self);
|
|
end;
|
|
|
|
function TPas2jsWebFS.FindUnitFileName(const aUnitname, InFilename: string; out IsForeign: boolean): String;
|
|
begin
|
|
{$IFDEF VERBOSEWEBCACHE}
|
|
Writeln(ClassName,': FindUnitFileName(',aUnitName,')');
|
|
{$ENDIF}
|
|
Result:=NormalizeFileName(aUnitName+'.pas');
|
|
isForeign:=False;
|
|
{$IFDEF VERBOSEWEBCACHE}
|
|
Writeln(ClassName,': FindUnitFileName(',aUnitName,') : ',Result);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TPas2jsWebFS.FindUnitJSFileName(const aUnitFilename: string): String;
|
|
begin
|
|
{$IFDEF VERBOSEWEBCACHE}
|
|
Writeln(ClassName,': FindUnitJSFileName(',aUnitFileName,')');
|
|
{$ENDIF}
|
|
Result:=NormalizeFileName(aUnitFileName);
|
|
{$IFDEF VERBOSEWEBCACHE}
|
|
Writeln(ClassName,': FindUnitJSFileName(',aUnitFileName,') : ',Result);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TPas2jsWebFS.LoadFile(Filename: string; Binary: boolean): TPas2jsFile;
|
|
|
|
begin
|
|
Result:=TPas2jsWebFile.Create(Self,FileName);
|
|
Result.Load(True,False);
|
|
end;
|
|
|
|
(*
|
|
// Check if we should not be using this instead, as the compiler outputs UTF8 ?
|
|
// Found on
|
|
// https://weblog.rogueamoeba.com/2017/02/27/javascript-correctly-converting-a-byte-array-to-a-utf-8-string/
|
|
function stringFromUTF8Array(data)
|
|
{
|
|
const extraByteMap = [ 1, 1, 1, 1, 2, 2, 3, 0 ];
|
|
var count = data.length;
|
|
var str = "";
|
|
|
|
for (var index = 0;index < count;)
|
|
{
|
|
var ch = data[index++];
|
|
if (ch & 0x80)
|
|
{
|
|
var extra = extraByteMap[(ch >> 3) & 0x07];
|
|
if (!(ch & 0x40) || !extra || ((index + extra) > count))
|
|
return null;
|
|
|
|
ch = ch & (0x3F >> extra);
|
|
for (;extra > 0;extra -= 1)
|
|
{
|
|
var chx = data[index++];
|
|
if ((chx & 0xC0) != 0x80)
|
|
return null;
|
|
|
|
ch = (ch << 6) | (chx & 0x3F);
|
|
}
|
|
}
|
|
|
|
str += String.fromCharCode(ch);
|
|
}
|
|
|
|
return str;
|
|
}
|
|
*)
|
|
procedure TPas2jsWebFS.SaveToFile(ms: TFPJSStream; Filename: string);
|
|
|
|
Var
|
|
aContent : String;
|
|
i : Integer;
|
|
v : JSValue;
|
|
|
|
begin
|
|
aContent:='';
|
|
for I:=0 to MS.Length-1 do
|
|
begin
|
|
v:=MS[i];
|
|
{AllowWriteln}
|
|
Writeln('Char ',i,'(',v,') : ',TJSString.fromCharCode(v));
|
|
{AllowWriteln-}
|
|
aContent:=aContent+TJSString.fromCharCode(MS[i]);
|
|
end;
|
|
SetFileContent(FileName,aContent);
|
|
end;
|
|
|
|
function TPas2jsWebFS.SetFileContent(const aFileName, aContents: String): Boolean;
|
|
begin
|
|
Result:=FCache.SetFileContent(NormalizeFileName(aFileName),aContents);
|
|
end;
|
|
|
|
function TPas2jsWebFS.GetFileContent(const aFileName: String): String;
|
|
begin
|
|
Result:=FCache.GetFileContent(NormalizeFileName(aFileName));
|
|
end;
|
|
|
|
function TPas2jsWebFS.LoadFile(aFileName: String; OnLoaded: TLoadFileEvent): Boolean;
|
|
|
|
Var
|
|
FN : String;
|
|
aURL : String;
|
|
LF : TLoadFileRequest;
|
|
|
|
begin
|
|
FN:=NormalizeFileName(aFileName);
|
|
Result:=Not FCache.HasFile(FN);
|
|
if Not result then
|
|
begin
|
|
// It is already loaded
|
|
if Assigned(OnLoaded) then
|
|
OnLoaded(Self,aFileName,'')
|
|
end
|
|
else
|
|
begin
|
|
// Not yet already loaded
|
|
aURL:=IncludeTrailingPathDelimiter(LoadBaseURL)+FN;
|
|
LF:=TLoadFileRequest.Create(Self,aFileName,OnLoaded);
|
|
LF.DoLoad(aURL);
|
|
end;
|
|
end;
|
|
|
|
Function TPas2jsWebFS.LoadFiles(aList: TStrings; OnLoaded: TLoadFileEvent): Integer;
|
|
|
|
Var
|
|
i: Integer;
|
|
|
|
begin
|
|
Result:=0;
|
|
For I:=0 to aList.Count-1 do
|
|
if LoadFile(aList[i],OnLoaded) then
|
|
Inc(Result);
|
|
end;
|
|
|
|
function TPas2jsWebFS.LoadFiles(aList: array of String; OnLoaded: TLoadFileEvent): Integer;
|
|
|
|
Var
|
|
i: Integer;
|
|
|
|
begin
|
|
Result:=0;
|
|
For I:=0 to Length(aList)-1 do
|
|
if LoadFile(aList[i],OnLoaded) then
|
|
Inc(Result);
|
|
end;
|
|
|
|
{ TPas2jsWebResolver }
|
|
|
|
function TPas2jsWebResolver.GetWebFS: TPas2jsWebFS;
|
|
begin
|
|
Result:=TPas2jsWebFS(FS)
|
|
end;
|
|
|
|
|
|
|
|
end.
|
|
|