|
|
@@ -0,0 +1,275 @@
|
|
|
+{
|
|
|
+ This file is part of the Pas2JS run time library.
|
|
|
+ Copyright (c) 2019 by Michael Van Canneyt
|
|
|
+
|
|
|
+ This unit implements a HTML template loader.
|
|
|
+
|
|
|
+ See the file COPYING.FPC, included in this distribution,
|
|
|
+ for details about the copyright.
|
|
|
+
|
|
|
+ This program is distributed in the hope that it will be useful,
|
|
|
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
+
|
|
|
+ **********************************************************************}
|
|
|
+unit Rtl.TemplateLoader;
|
|
|
+
|
|
|
+{$mode objfpc}
|
|
|
+
|
|
|
+interface
|
|
|
+
|
|
|
+uses
|
|
|
+ Classes, SysUtils, JS, web;
|
|
|
+
|
|
|
+Type
|
|
|
+ TFailData = Record
|
|
|
+ message : string;
|
|
|
+ code : Integer;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TTemplateNotifyEvent = Reference to Procedure(Sender : TObject; Const aTemplate : String);
|
|
|
+ TTemplateErrorNotifyEvent = Reference to Procedure(Sender : TObject; Const aTemplate,aError : String; aErrorcode : Integer);
|
|
|
+
|
|
|
+ { TCustomTemplateLoader }
|
|
|
+
|
|
|
+ TCustomTemplateLoader = Class(TComponent)
|
|
|
+ Private
|
|
|
+ FBaseURL: String;
|
|
|
+ FOnLoad: TTemplateNotifyEvent;
|
|
|
+ FOnLoadFail: TTemplateErrorNotifyEvent;
|
|
|
+ FTemplates : TJSObject;
|
|
|
+ function GetTemplate(aName : String): String;
|
|
|
+ procedure SetTemplate(aName : String; AValue: String);
|
|
|
+ Protected
|
|
|
+ // Process an url before it is used to fetch data
|
|
|
+ Function ProcessURL(const aURL : String) : String;
|
|
|
+ Public
|
|
|
+ Constructor Create (aOwner : TComponent); override;
|
|
|
+ Destructor Destroy; override;
|
|
|
+ // Remove a template
|
|
|
+ Procedure RemoveRemplate(aName : String);
|
|
|
+ // fetch a template using promise. Promise resolves to template name. On fail a TFailData record is passed on.
|
|
|
+ // Note that the global OnLoad/OnLoadFail a
|
|
|
+ Function FetchTemplate(Const aName,aURL : String) : TJSPromise;
|
|
|
+ // procedural API.
|
|
|
+ // If the aOnSuccess aOnFail event handlers are specified, they're called as well in addition to global handlers.
|
|
|
+ Procedure LoadTemplate(Const aName,aURL : String; aOnSuccess : TTemplateNotifyEvent = Nil; AOnFail : TTemplateErrorNotifyEvent= Nil);
|
|
|
+ // procedural API for multiple templates at once.
|
|
|
+ // Form = name, URL, name URL.
|
|
|
+ // If the aOnSuccess aOnFail event handlers are specified, they're called as well in addition to global handlers.
|
|
|
+ Procedure LoadTemplates(Const Templates : Array of String; aOnSuccess : TTemplateNotifyEvent = Nil; AOnFail : TTemplateErrorNotifyEvent= nil);
|
|
|
+ // URLs will be relative to this. Take care that you add a / at the end if needed !
|
|
|
+ Property BaseURL : String Read FBaseURL Write FBaseURl;
|
|
|
+ Property Templates[aName : String] : String Read GetTemplate Write SetTemplate; default;
|
|
|
+ // Called when a template was loaded.
|
|
|
+ Property OnLoad : TTemplateNotifyEvent Read FOnLoad Write FOnLoad;
|
|
|
+ // Called when a template failed to load.
|
|
|
+ Property OnLoadFail : TTemplateErrorNotifyEvent Read FOnLoadFail Write FOnLoadFail;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TTemplateLoader = Class(TCustomTemplateLoader)
|
|
|
+ Published
|
|
|
+ Property BaseURL;
|
|
|
+ Property OnLoad;
|
|
|
+ Property OnLoadFail;
|
|
|
+ end;
|
|
|
+
|
|
|
+// Global instance, for ease of use.
|
|
|
+Function GlobalTemplates : TCustomTemplateLoader;
|
|
|
+
|
|
|
+implementation
|
|
|
+
|
|
|
+{ TCustomTemplateLoader }
|
|
|
+
|
|
|
+Var
|
|
|
+ _loader : TCustomTemplateLoader;
|
|
|
+
|
|
|
+Function GlobalTemplates : TCustomTemplateLoader;
|
|
|
+
|
|
|
+begin
|
|
|
+ if _loader=Nil then
|
|
|
+ _loader:=TCustomTemplateLoader.Create(Nil);
|
|
|
+ Result:=_Loader;
|
|
|
+end;
|
|
|
+
|
|
|
+Type
|
|
|
+ { TURLLoader }
|
|
|
+
|
|
|
+ TURLLoader = Class(TObject)
|
|
|
+ private
|
|
|
+ FLoader: TCustomTemplateLoader;
|
|
|
+ FName: String;
|
|
|
+ FURL: String;
|
|
|
+ procedure dofetch(resolve, reject: TJSPromiseResolver);
|
|
|
+ Public
|
|
|
+ Constructor Create(aLoader : TCustomTemplateLoader; aName,aURL : String);
|
|
|
+ Function fetch : TJSPromise;
|
|
|
+ Property Name : String Read FName;
|
|
|
+ Property URL : String Read FURL;
|
|
|
+ Property Loader : TCustomTemplateLoader Read FLoader;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+{ TURLLoader }
|
|
|
+
|
|
|
+constructor TURLLoader.Create(aLoader: TCustomTemplateLoader; aName, aURL: String);
|
|
|
+begin
|
|
|
+ FLoader:=aLoader;
|
|
|
+ FURL:=aURL;
|
|
|
+ FName:=aName;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TURLLoader.dofetch(resolve,reject : TJSPromiseResolver);
|
|
|
+
|
|
|
+ function doOK(response : JSValue) : JSValue;
|
|
|
+
|
|
|
+ var
|
|
|
+ Res : TJSResponse absolute response;
|
|
|
+ F : TFailData;
|
|
|
+
|
|
|
+ begin
|
|
|
+ If (Res.status<>200) then
|
|
|
+ begin
|
|
|
+ F.Message:=res.StatusText;
|
|
|
+ F.Code:=Res.Status;
|
|
|
+ Result:=Reject(F);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ Res.text._then(
|
|
|
+ function (value : JSValue) : JSValue
|
|
|
+ begin
|
|
|
+ Loader.Templates[FName]:=String(Value);
|
|
|
+ if Assigned(Loader.FonLoad) then
|
|
|
+ Loader.FOnLoad(FLoader,Name);
|
|
|
+ Result:=Resolve(Name);
|
|
|
+ end
|
|
|
+ );
|
|
|
+ end;
|
|
|
+
|
|
|
+ function doFail(response : JSValue) : JSValue;
|
|
|
+
|
|
|
+ Var
|
|
|
+ F : TFailData;
|
|
|
+
|
|
|
+ begin
|
|
|
+ F.message:='unknown error';
|
|
|
+ F.code:=999;
|
|
|
+ Result:=Reject(F);
|
|
|
+ end;
|
|
|
+
|
|
|
+begin
|
|
|
+ Window.Fetch(URl)._then(@DoOK).catch(@DoFail);
|
|
|
+end;
|
|
|
+
|
|
|
+function TURLLoader.fetch : TJSPromise;
|
|
|
+
|
|
|
+begin
|
|
|
+ Result:=TJSPromise.New(@Dofetch)
|
|
|
+end;
|
|
|
+
|
|
|
+function TCustomTemplateLoader.GetTemplate(aName : String): String;
|
|
|
+
|
|
|
+Var
|
|
|
+ V : jsValue;
|
|
|
+
|
|
|
+begin
|
|
|
+ V:=FTemplates[LowerCase(aName)];
|
|
|
+ if isString(V) then
|
|
|
+ Result:=String(V)
|
|
|
+ else
|
|
|
+ Result:='';
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TCustomTemplateLoader.SetTemplate(aName : String; AValue: String);
|
|
|
+begin
|
|
|
+ FTemplates[LowerCase(aName)]:=AValue;
|
|
|
+end;
|
|
|
+
|
|
|
+function TCustomTemplateLoader.ProcessURL(const aURL: String): String;
|
|
|
+
|
|
|
+Var
|
|
|
+ R : TJSRegexp;
|
|
|
+
|
|
|
+begin
|
|
|
+ R:=TJSRegexp.New('^https?://|^/','i');
|
|
|
+ if R.Test(aURL) then
|
|
|
+ Result:=aURL
|
|
|
+ else
|
|
|
+ Result:=BaseURL+aURL;
|
|
|
+end;
|
|
|
+
|
|
|
+constructor TCustomTemplateLoader.Create(aOwner: TComponent);
|
|
|
+begin
|
|
|
+ inherited Create(aOwner);
|
|
|
+ FTemplates:=TJSObject.New;
|
|
|
+end;
|
|
|
+
|
|
|
+destructor TCustomTemplateLoader.Destroy;
|
|
|
+begin
|
|
|
+ FTemplates:=nil;
|
|
|
+ inherited Destroy;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TCustomTemplateLoader.RemoveRemplate(aName: String);
|
|
|
+begin
|
|
|
+ jsDelete(FTemplates,Lowercase(aName));
|
|
|
+end;
|
|
|
+
|
|
|
+function TCustomTemplateLoader.FetchTemplate(const aName, aURL: String): TJSPromise;
|
|
|
+
|
|
|
+begin
|
|
|
+ Result:=TURLLoader.Create(Self,aName,ProcessURL(aURL)).fetch;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TCustomTemplateLoader.LoadTemplate(const aName, aURL: String; aOnSuccess: TTemplateNotifyEvent;
|
|
|
+ AOnFail: TTemplateErrorNotifyEvent);
|
|
|
+
|
|
|
+ function doOK(aValue : JSValue) : JSValue;
|
|
|
+
|
|
|
+ begin
|
|
|
+ if Assigned(aOnSuccess) then
|
|
|
+ aOnSuccess(Self,aName);
|
|
|
+ Result:=nil;
|
|
|
+ end;
|
|
|
+
|
|
|
+ function doFail(aValue : JSValue) : JSValue;
|
|
|
+
|
|
|
+ Var
|
|
|
+ F : TFailData absolute aValue;
|
|
|
+ S : String;
|
|
|
+ C : Integer;
|
|
|
+
|
|
|
+ begin
|
|
|
+ S:=F.message;
|
|
|
+ C:=F.Code;
|
|
|
+ if Assigned(FonLoadFail) then
|
|
|
+ FOnLoadFail(Self,aName,S,C);
|
|
|
+ if Assigned(aOnFail) then
|
|
|
+ aOnFail(Self,aName,S,C);
|
|
|
+ Result:=nil;
|
|
|
+ end;
|
|
|
+
|
|
|
+begin
|
|
|
+ FetchTemplate(aName,aURL)._then(@DoOK).catch(@doFail);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TCustomTemplateLoader.LoadTemplates(const Templates: array of String; aOnSuccess: TTemplateNotifyEvent;
|
|
|
+ AOnFail: TTemplateErrorNotifyEvent);
|
|
|
+
|
|
|
+Var
|
|
|
+ I,L : Integer;
|
|
|
+
|
|
|
+begin
|
|
|
+ L:=Length(Templates);
|
|
|
+ if (L mod 2)<>0 then
|
|
|
+ Raise Exception.CreateFmt('Number of arguments (%d) must be even',[L]);
|
|
|
+ I:=0;
|
|
|
+ While I<L do
|
|
|
+ begin
|
|
|
+ LoadTemplate(Templates[I],Templates[I+1],aOnsuccess,aOnFail);
|
|
|
+ Inc(I,2);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+end.
|
|
|
+
|
michael