Merge pull request #140 from sempare/dev

Release v1.7.1

Sempare.Template.RCGenerator.dpr

@@ -70,7 +70,7 @@ begin
   LData.Files := AFiles;
   LStream := TUseStream.Create(AFilename, fmCreate);
   try
-    TTemplateRegistry.Instance.Eval(LStream, 'sempare_template_rcgenerator_tpl', LData)
+    TTemplateRegistry.Instance.Eval('sempare_template_rcgenerator_tpl', LData, LStream);
   finally
     LStream.Free;
   end;

boss.json

@@ -1,7 +1,7 @@
 {
 	"name": "Sempare Template Engine",
 	"description": "Sempare Template Engine for Delphi allows for flexible text manipulation. It can be used for generating email, html, source code, xml, configuration, etc.",
-	"version": "1.7.0",
+	"version": "1.7.1",
 	"homepage": "https://github.com/sempare/sempare-delphi-template-engine",
 	"mainsrc": "./src/",
 	"projects": [],

demo/WebBrokerStandalone/ServerConst1.pas

@@ -22,6 +22,9 @@ interface
     '   - "status" for Server status'+ slineBreak +
     '   - "help" to show commands'+ slineBreak +
     '   - "exit" to close the application';
+  sConnect = 'Connect your browser to http://localhost:%d';
+  sWelcome = 'This is the Sempare Template Engine WebBroker Demo';
+  sVersion = 'This is using the Sempare Template Engine v%s';
 
 const
   cArrow = '->';

demo/WebBrokerStandalone/WebBrokerStandalone8080.dpr

@@ -9,7 +9,8 @@ uses
   IdHTTPWebBrokerBridge,
   Web.WebReq,
   Web.WebBroker,
-  WebModuleUnit1 in 'WebModuleUnit1.pas' {WebModule1: TWebModule},
+  Sempare.Template,
+  WebModuleUnit1 in 'WebModuleUnit1.pas' {WebModule1: TWebModule} ,
   ServerConst1 in 'ServerConst1.pas',
   DynForm in 'DynForm.pas';
 
@@ -66,6 +67,7 @@ begin
     end
     else
       Writeln(Format(sPortInUse, [AServer.DefaultPort.ToString]));
+    Writeln(Format(SConnect, [AServer.DefaultPort]));
   end
   else
     Writeln(sServerRunning);
@@ -143,13 +145,18 @@ begin
 end;
 
 begin
+  Writeln(sWelcome);
+  Writeln('');
+  Writeln(Format(sVersion, [Template.Version]));
+  Writeln('');
   try
     if WebRequestHandler <> nil then
       WebRequestHandler.WebModuleClass := WebModuleClass;
     RunServer(8080);
   except
     on E: Exception do
       Writeln(E.ClassName, ': ', E.Message);
-  end
+  end;
+  TTemplateRegistry.Finalize;
 
 end.

demo/WebBrokerStandalone/WebBrokerStandalone8080.rc

@@ -1,6 +1,6 @@
-index_tpl RCDATA "templates\\index.tpl"
-dynform_tpl RCDATA "templates\\dynform.tpl"
-helper_tpl RCDATA "templates\\helper.tpl"
-template_tpl RCDATA "templates\\template.tpl"
-submitted_tpl RCDATA "templates\\submitted.tpl"
-error404_tpl RCDATA "templates\\error404.tpl"
+INDEX_TPL RCDATA "templates\\index.tpl"
+DYNFORM_TPL RCDATA "templates\\dynform.tpl"
+HELPER_TPL RCDATA "templates\\helper.tpl"
+TEMPLATE_TPL RCDATA "templates\\template.tpl"
+SUBMITTED_TPL RCDATA "templates\\submitted.tpl"
+ERROR404_TPL RCDATA "templates\\error404.tpl"

demo/WebBrokerStandalone/WebModuleUnit1.dfm

@@ -1,4 +1,5 @@
 object WebModule1: TWebModule1
+  OnCreate = WebModuleCreate
   Actions = <
     item
       Default = True

demo/WebBrokerStandalone/WebModuleUnit1.pas

@@ -11,6 +11,7 @@   TWebModule1 = class(TWebModule)
     procedure WebModule1FormInputAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
     procedure WebModule1FormInputHandlerAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
     procedure WebModule1ErrorHandlerAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+    procedure WebModuleCreate(Sender: TObject);
   private
     { Private declarations }
   public
@@ -23,6 +24,9 @@   TWebModule1 = class(TWebModule)
 implementation
 
 uses
+  System.Rtti,
+  IdHTTPWebBrokerBridge,
+  IdCustomHTTPServer,
   DynForm,
   Sempare.Template;
 
@@ -38,20 +42,50 @@   TDemo = record
     constructor Create(const AName: String; const AFrameworkUrl, AUrl: string; const ACurrent: Boolean = false);
   end;
 
+  // This is a workaround to get AcceptLanguage as the TIdHTTPAppRequest does not expose headerss
+function GetAcceptLanguage(const Req: TWebRequest): string;
+var
+  LContext: TRttiContext;
+  LRttiType: TRttiType;
+  LField: TRttiField;
+  LRequestInfo: TIdHTTPRequestInfo;
+begin
+  LRttiType := LContext.GetType(TIdHTTPAppRequest);
+  LField := LRttiType.GetField('FRequestInfo');
+  LRequestInfo := LField.GetValue(Req).AsType<TIdHTTPRequestInfo>;
+  exit(LRequestInfo.AcceptLanguage);
+end;
+
 procedure TWebModule1.WebModule1IndexHandlerAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
   LDemos: TArray<TDemo>;
 begin
   setlength(LDemos, 2);
   LDemos[0] := TDemo.Create('Web Broker', 'https://docwiki.embarcadero.com/RADStudio/Alexandria/en/Creating_WebBroker_Applications', 'https://github.com/sempare/sempare-delphi-template-engine/tree/main/demo/WebBrokerStandalone', true);
   LDemos[1] := TDemo.Create('Horse', 'https://github.com/HashLoad/horse', 'https://github.com/sempare/sempare-delphi-template-engine-horse-demo');
-  Response.Content := TTemplateRegistry.Instance.Eval('index', LDemos);
+  Response.Content := Template.ResolveWithContext('index', Request, LDemos);
   Handled := true;
 end;
 
+procedure TWebModule1.WebModuleCreate(Sender: TObject);
+begin
+  Template.Resolver.ContextNameResolver := function(const AName: string; const AContext: TTemplateValue): string
+    var
+      LLang: string;
+      LReq: TWebRequest;
+    begin
+      LReq := AContext.AsType<TWebRequest>;
+      LLang := GetAcceptLanguage(LReq).Substring(0, 2);
+      if LLang.IsEmpty then
+        exit(AName)
+      else
+        exit(AName + '_' + LLang);
+    end;
+end;
+
 procedure TWebModule1.WebModule1ErrorHandlerAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 begin
-  Response.Content := TTemplateRegistry.Instance.Eval('error404');
+  Response.Content := Template.ResolveWithContext('error404', Request);
   Response.StatusCode := 404;
   Handled := true;
 end;
@@ -69,7 +103,7 @@ procedure TWebModule1.WebModule1FormInputAction(Sender: TObject; Request: TWebRe
   LTemplateData.Fields[2] := TField.Create('Email', 'email', 'TEmail');
   setlength(LTemplateData.Buttons, 1);
   LTemplateData.Buttons[0] := TButton.Create('Submit', 'submit');
-  Response.Content := TTemplateRegistry.Instance.Eval('dynform', LTemplateData);
+  Response.Content := Template.ResolveWithContext('dynform', Request, LTemplateData);
   Handled := true;
 end;
 
@@ -86,7 +120,7 @@ procedure TWebModule1.WebModule1FormInputHandlerAction(Sender: TObject; Request:
     LFormData.firstname := Params.Values['firstname'];
     LFormData.lastname := Params.Values['lastname'];
     LFormData.email := Params.Values['email'];
-    Response.Content := TTemplateRegistry.Instance.Eval('submitted', LFormData);
+    Response.Content := Template.ResolveWithContext('submitted', Request, LFormData);
   finally
     Params.Free;
   end;

docs/configuration.md

@@ -104,16 +104,28 @@ ctx.RegisterTemplate('footer', Template.Parse('Copyright (c) <% year %> <% compa
 
 <a name="Dynamic_Template_Resolution"><h3>Dynamic Template Resolution</h3></a>
 
-Templates don't need to be located in a single template. They can also be resolved dynamically using the TemplateResolver method on the context.
+Templates don't need to be located in a single template. They can also be resolved dynamically using the TemplateResolver or TemplateResolverWithContext method on the context.
 Templates could be loaded from file, resources or urls are per your requirements.
 
 ```
 ctx.TemplateResolver = function(const AContext : ITemplate; const AName : string) : ITemplate
 begin
    result := Template.parse('some template loaded from file...');
 end;
+
+// or
+
+ctx.TemplateResolverWithContext = function(const AContext : ITemplate; const AName : string; const AResolveContext: TTemplateValue) : ITemplate
+begin
+   // ...
+end;
+
 ```
 
+Only one of the resolvers needs to be set as TemplateResolver is wrapped into TemplateResolverWithContext passing an empty string as a context.
+
+Using a resolve context can be useful in scenarios such as web, where a language specific template can be resolved based on request headers (the http request object can be the resolve context).
+
 <a name="Embed_exceptions_in_output"><h3>Embed exceptions in output</h3></a>
 
 Exceptions are normally raised. However, they can be logged in the output with the following configuration.

docs/tricks.md

@@ -69,8 +69,10 @@ abcd
 
 <a name="dynamic-loading-templates"><h2>Loading templates dynamically</h2></a>
 
-If you reference templates using the 'include' statement, you can rely on a TemplateResolver to load them if they are not
-defined within the template itself.
+If you reference templates using the 'include' statement, you can rely on a TemplateResolver or TemplateResolverWithContext to load them if they are not
+defined within the template itself. Only TemplateResolver or TemplateResolverWithContext should be set. TemplateResolver is essentially ignoring the context.
+
+Using a resolve context can be useful in scenarios such as web, where a language specific template can be resolved based on request headers (the http request object can be the resolve context).
 
 e.g. This is illustrative:
 
@@ -83,6 +85,11 @@ e.g. This is illustrative:
       LStream := TFileStream.Create(ATemplate + '.tpl', fmOpenRead);
       exit(Template.Parse(AContext, LStream));
     end;
+    
+  ctx.TemplateResolverWithContext := function(AContext: ITemplateContext; const ATemplate: string; const AResolveContext: TTemplateValue): ITemplate
+    begin
+      // ... note TTemplateValue is an RTTI TValue. 
+    end;
 ```
 
 Also see the section on the [Template Registry](./template-registry.md).

src/Sempare.Template.BlockResolver.pas

@@ -43,6 +43,7 @@ interface
 type
   IBlockResolverVisitor = interface(ITemplateVisitor)
     ['{623A7C4A-3592-46BD-A3C5-FE354E0E67C0}']
+    procedure Discover;
     function GetBlockNames: TArray<string>;
     function GetBlock(const AName: string): IBlockStmt;
   end;
@@ -51,9 +52,11 @@   TBlockResolverVisitor = class(TNoExprTemplateVisitor, IBlockResolverVisitor)
   private
     FBlocks: TDictionary<string, IBlockStmt>;
     FEvalVisitor: IEvaluationTemplateVisitor;
+    FTemplate: ITemplate;
   public
     constructor Create(const AEvalVisitor: IEvaluationTemplateVisitor; const ATemplate: ITemplate);
     destructor Destroy; override;
+    procedure Discover;
 
     function GetBlockNames: TArray<string>;
     function GetBlock(const AName: string): IBlockStmt;
@@ -100,16 +103,20 @@ constructor TBlockResolverVisitor.Create(const AEvalVisitor: IEvaluationTemplate
 begin
   FEvalVisitor := AEvalVisitor;
   FBlocks := TDictionary<string, IBlockStmt>.Create();
-  AcceptVisitor(ATemplate, self);
+  FTemplate := ATemplate;
 end;
 
 destructor TBlockResolverVisitor.Destroy;
 begin
-  FBlocks.Clear;
   FBlocks.Free;
   inherited;
 end;
 
+procedure TBlockResolverVisitor.Discover;
+begin
+  AcceptVisitor(FTemplate, self);
+end;
+
 function TBlockResolverVisitor.GetBlockNames: TArray<string>;
 begin
   exit(FBlocks.Keys.ToArray);

src/Sempare.Template.Common.pas

@@ -62,7 +62,7 @@   ETemplateEvaluationError = class(ETemplate, IPosition)
   private
     FPosition: IPosition;
   public
-    constructor Create(APosition: IPosition; const AMessage: string);
+    constructor Create(const APosition: IPosition; const AMessage: string);
     property Position: IPosition read FPosition write FPosition implements IPosition;
   end;
 
@@ -181,7 +181,7 @@ procedure RaiseErrorRes(const APositional: IPosition; const ResStringRec: PResSt
 
 { ETemplateEvaluationError }
 
-constructor ETemplateEvaluationError.Create(APosition: IPosition; const AMessage: string);
+constructor ETemplateEvaluationError.Create(const APosition: IPosition; const AMessage: string);
 begin
   inherited Create(AMessage);
   FPosition := APosition;