paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-04-20 11:09:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Template loader and demo

Browse Source
This commit is contained in:
michael 2019-09-12 20:38:59 +00:00
parent 2e22184840
commit 466aadfba9
7 changed files with 453 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
demo/templates/favicon.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 318 B

17
demo/templates/index.html Normal file
View File

@ -0,0 +1,17 @@
<!doctype html>
<html lang="en">
<head>
<meta http-equiv="Content-type" content="text/html; charset=utf-8">
<link rel="icon" type="image/png" href="favicon.ico">
<meta name="viewport" content="width=device-width, initial-scale=1">
<title>Template loader demo</title>
<script src="templates.js"></script>
</head>
<body>
<script>
rtl.run();
</script>
</body>
</html>

96
demo/templates/templates.lpi Normal file
View File

@ -0,0 +1,96 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
<Runnable Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="templates"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<CustomData Count="4">
<Item0 Name="MaintainHTML" Value="1"/>
<Item1 Name="PasJSHTMLFile" Value="project1.html"/>
<Item2 Name="PasJSPort" Value="0"/>
<Item3 Name="PasJSWebBrowserProject" Value="1"/>
</CustomData>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0"/>
</RunParams>
<Units>
<Unit>
<Filename Value="templates.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="index.html"/>
<IsPartOfProject Value="True"/>
<CustomData Count="1">
<Item0 Name="PasJSIsProjectHTMLFile" Value="1"/>
</CustomData>
</Unit>
<Unit>
<Filename Value="../units.templateloader.pp"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target FileExt=".js">
<Filename Value="templates"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value=".."/>
<UnitOutputDirectory Value="js"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<AllowLabel Value="False"/>
<CPPInline Value="False"/>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<TargetOS Value="browser"/>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
<UseLineInfoUnit Value="False"/>
</Debugging>
</Linking>
<Other>
<CustomOptions Value="-Jeutf-8 -Jirtl.js -Jc -Jminclude"/>
<CompilerPath Value="$(pas2js)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

63
demo/templates/templates.lpr Normal file
View File

@ -0,0 +1,63 @@
program templates;
{$mode objfpc}
uses
browserconsole, JS, Classes, SysUtils, Web, Rtl.TemplateLoader, browserapp;
TYpe
{ TMyApp }
TMyApp = Class(TBrowserApplication)
FLoader : TTemplateLoader;
procedure DoRUn; override;
private
procedure DoGlobalFail(Sender: TObject; const aTemplate, aError: String; aErrorcode: Integer);
procedure DoGlobalLoaded(Sender: TObject; const aTemplate: String);
procedure DoLocalFail(Sender: TObject; const aTemplate, aError: String; aErrorcode: Integer);
procedure DoLocalLoaded(Sender: TObject; const aTemplate: String);
end;
{ TMyApp }
procedure TMyApp.DoRUn;
begin
FLoader:=TTemplateLoader.Create(Self);
FLoader.OnLoad:=@DoGlobalLoaded;
FLoader.OnLoadFail:=@DoGlobalFail;
Floader.BaseURL:='templates/';
FLoader.LoadTemplate('this','this.txt');
FLoader.LoadTemplate('thistoo','thistoo.txt',@DoLocalLoaded,@DoLocalFail);
FLoader.LoadTemplate('thisnot','thisnot.txt',@DoLocalLoaded,@DoLocalFail);
FLoader.LoadTemplates(['one','this.txt','two','thistoo.txt','threenot','thisalsonot.txt'],@DoLocalLoaded,@DoLocalFail);
end;
procedure TMyApp.DoGlobalFail(Sender: TObject; const aTemplate, aError: String; aErrorcode: Integer);
begin
Writeln('GLobal fail load for : ',aTemplate,' Error: ',aError,' Code : ',aErrorCode);
end;
procedure TMyApp.DoGlobalLoaded(Sender: TObject; const aTemplate: String);
begin
Writeln('GLobal load OK: ',aTemplate,' Template text ',Floader.Templates[aTemplate]);
end;
procedure TMyApp.DoLocalFail(Sender: TObject; const aTemplate, aError: String; aErrorcode: Integer);
begin
Writeln('Local fail load for : ',aTemplate,' Error: ',aError,' Code : ',aErrorCode);
end;
procedure TMyApp.DoLocalLoaded(Sender: TObject; const aTemplate: String);
begin
Writeln('Local load OK: ',aTemplate,' Template text ',Floader.Templates[aTemplate]);
end;
begin
With TMyApp.Create(Nil) do
begin
Initialize;
run;
end;
end.

1
demo/templates/templates/this.txt Normal file
View File

@ -0,0 +1 @@
this text

1
demo/templates/templates/thistoo.txt Normal file
View File

@ -0,0 +1 @@
this text too

275
packages/rtl/Rtl.TemplateLoader.pas Normal file
View File

@ -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.