Trang chủ Khám phá Trợ giúp
Đăng nhập
pascal
/
pas2js
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git
2
0
Fork 0
Các tập tin Các vấn đề 0 Wiki
Browse Source

* Template loader and demo

michael 5 năm trước cách đây
mục cha
2e22184840
commit
466aadfba9
7 tập tin đã thay đổi với 453 bổ sung và 0 xóa
View chưa được định nghĩa Hiển thị tình trạng sai khác
  1. BIN
      demo/templates/favicon.ico
  2. 17 0
      demo/templates/index.html
  3. 96 0
      demo/templates/templates.lpi
  4. 63 0
      demo/templates/templates.lpr
  5. 1 0
      demo/templates/templates/this.txt
  6. 1 0
      demo/templates/templates/thistoo.txt
  7. 275 0
      packages/rtl/Rtl.TemplateLoader.pas

BIN
demo/templates/favicon.ico
Xem Tập Tin


+ 17 - 0
demo/templates/index.html
Xem Tập Tin 

@@ -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 - 0
demo/templates/templates.lpi
Xem Tập Tin 

@@ -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 - 0
demo/templates/templates.lpr
Xem Tập Tin 

@@ -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 - 0
demo/templates/templates/this.txt
Xem Tập Tin 

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

+ 1 - 0
demo/templates/templates/thistoo.txt
Xem Tập Tin 

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

+ 275 - 0
packages/rtl/Rtl.TemplateLoader.pas
Xem Tập Tin 

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