paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-05 08:38:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Mustache templates implementation

Browse Source 
git-svn-id: trunk@49240 -
This commit is contained in:
michael 2021-04-20 11:39:30 +00:00
parent b149718566
commit 5e2bf25790
29 changed files with 4251 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
.gitattributes vendored
View File

@ -3837,6 +3837,32 @@ packages/fcl-json/tests/testjsondata.pp svneol=native#text/plain
packages/fcl-json/tests/testjsonparser.pp svneol=native#text/plain
packages/fcl-json/tests/testjsonreader.pp svneol=native#text/plain
packages/fcl-json/tests/testjsonrtti.pp svneol=native#text/plain
packages/fcl-mustache/examples/README.txt svneol=native#text/plain
packages/fcl-mustache/examples/demo1.lpi svneol=native#text/plain
packages/fcl-mustache/examples/demo1.lpr svneol=native#text/plain
packages/fcl-mustache/examples/demo2.lpi svneol=native#text/plain
packages/fcl-mustache/examples/demo2.lpr svneol=native#text/plain
packages/fcl-mustache/examples/family.csv svneol=native#text/plain
packages/fcl-mustache/examples/family.json svneol=native#text/plain
packages/fcl-mustache/examples/family.tmpl svneol=native#text/plain
packages/fcl-mustache/examples/mustache.lpi svneol=native#text/plain
packages/fcl-mustache/examples/mustache.lpr svneol=native#text/plain
packages/fcl-mustache/src/fpdbmustache.pp svneol=native#text/plain
packages/fcl-mustache/src/fpexmustache.pp svneol=native#text/plain
packages/fcl-mustache/src/fpmustache.pp svneol=native#text/plain
packages/fcl-mustache/tests/spec/comments.json svneol=native#text/plain
packages/fcl-mustache/tests/spec/delimiters.json svneol=native#text/plain
packages/fcl-mustache/tests/spec/interpolation.json svneol=native#text/plain
packages/fcl-mustache/tests/spec/inverted.json svneol=native#text/plain
packages/fcl-mustache/tests/spec/partials.json svneol=native#text/plain
packages/fcl-mustache/tests/spec/sections.json svneol=native#text/plain
packages/fcl-mustache/tests/tcbasemustache.pas svneol=native#text/plain
packages/fcl-mustache/tests/tcdbmustache.pas svneol=native#text/plain
packages/fcl-mustache/tests/tcexmustache.pas svneol=native#text/plain
packages/fcl-mustache/tests/tcmustache.pas svneol=native#text/plain
packages/fcl-mustache/tests/tcspecs.pas svneol=native#text/plain
packages/fcl-mustache/tests/testmustache.lpi svneol=native#text/plain
packages/fcl-mustache/tests/testmustache.lpr svneol=native#text/plain
packages/fcl-net/Makefile svneol=native#text/plain
packages/fcl-net/Makefile.fpc svneol=native#text/plain
packages/fcl-net/Makefile.fpc.fpcmake svneol=native#text/plain

27
packages/fcl-mustache/examples/README.txt Normal file
View File

@ -0,0 +1,27 @@
demo1 sample program:
Demonstrates the most basic use of the mustache parser
demo2 sample program:
Demonstrates the use of the mustache parser with a CSV dataset
mustache example program:
Can be used to load a template and data, and process the result.
Output to standard output or file.
The template and JSON value can be loaded from file (using @filename),
or their value can be specified directly on the command-line.
Example usage:
Load template from family.tmpl file, data from family.json file:
./mustache -d title="my family" -t @family.tmpl -j @family.json
Load template from family.tmpl file, data from family.csv file:
./mustache -d title="my family" -t @family.tmpl -c family.csv
Use of expressions can be enabled with the -e switch.

57
packages/fcl-mustache/examples/demo1.lpi Normal file
View File

@ -0,0 +1,57 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="demo1"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<Units>
<Unit>
<Filename Value="demo1.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="demo1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="../src"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

42
packages/fcl-mustache/examples/demo1.lpr Normal file
View File

@ -0,0 +1,42 @@
{ Demo for mustache engine with JSON context
Copyright (C) 2021 michael Van Canneyt michael@freepascal.org
This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as
published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version.
This code 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. See the GNU General Public License for more details.
A copy of the GNU General Public License is available on the World Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can
also obtain it by writing to the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.
}
program demo1;
// jsonparser includes the json parser.
uses jsonparser, fpmustache;
Const
JSON = '{ "products" : [ {"name" : "BMW" }, {"name" : "Mercedes"}, { "name" : "Audi" }] }';
// Mock markdown table
Template =
'| name |'+sLineBreak+
'|------|'+sLineBreak+
'{{#products}}| {{name}} |'+sLineBreak+
'{{/products}}';
Var
M : TMustache;
begin
M:=TMustache.Create(Nil);
try
// Json support enabled by default
Writeln(M.Render(Template,JSON));
finally
M.Free;
end;
end.

57
packages/fcl-mustache/examples/demo2.lpi Normal file
View File

@ -0,0 +1,57 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="demo2"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<Units>
<Unit>
<Filename Value="demo2.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="demo2"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="../src"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

48
packages/fcl-mustache/examples/demo2.lpr Normal file
View File

@ -0,0 +1,48 @@
{ Demo for mustache engine with database context
Copyright (C) 2021 michael Van Canneyt michael@freepascal.org
This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as
published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version.
This code 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. See the GNU General Public License for more details.
A copy of the GNU General Public License is available on the World Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can
also obtain it by writing to the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.
}
program demo2;
uses csvdataset, fpmustache, fpdbmustache;
Const
// Mock markdown table
Template =
'| name | age | '+sLineBreak+
'|------|------|'+sLineBreak+
'{{#family}}| {{name}} | {{age}} |'+sLineBreak+
'{{/family}}';
Var
M : TMustache;
C : TMustacheDBContext;
D : TCSVDataset;
begin
M:=TMustache.Create(Nil);
try
D:=TCSVDataset.Create(Nil);
D.CSVOptions.FirstLineAsFieldNames:=True;
D.LoadFromFile('family.csv');
C:=TMustacheDBContext.Create(Nil);
C.AddDataset(D,'family');
M.Template:=Template;
Writeln(M.Render(C));
finally
M.Free;
D.Free;
C.Free;
end;
end.

7
packages/fcl-mustache/examples/family.csv Normal file
View File

@ -0,0 +1,7 @@
name,age
Father,30
Mother,29
Grandfather,62
GrandMother,61
Child 1,2
Child 2,4
1 name age
2 Father 30
3 Mother 29
4 Grandfather 62
5 GrandMother 61
6 Child 1 2
7 Child 2 4

10
packages/fcl-mustache/examples/family.json Normal file
View File

@ -0,0 +1,10 @@
{
"data" : [
{ "name" : "Father", "age": 30 },
{ "name" : "Mother", "age": 29 },
{ "name" : "Grandfather", "age": 62 },
{ "name" : "GrandMother", "age": 61 },
{ "name" : "Child 1", "age": 2 },
{ "name" : "Child 2", "age": 4 }
]
}

22
packages/fcl-mustache/examples/family.tmpl Normal file
View File

@ -0,0 +1,22 @@
<html>
<head>
<title>{{title}}</title>
</head>
<body>
<h1>Family members</h1>
<table>
<thead>
<tr>
<th>Name</th><th>Age</th>
</tr>
</thead>
<tbody>
{{#data}}
<tr>
<td>{{name}}</td><td>{{age}}</td>
</tr>
{{/data}}
</tbody>
</table>
</body>
</html>

57
packages/fcl-mustache/examples/mustache.lpi Normal file
View File

@ -0,0 +1,57 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="Mustache Templater"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<Units>
<Unit>
<Filename Value="mustache.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="mustache"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="../src"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

207
packages/fcl-mustache/examples/mustache.lpr Normal file
View File

@ -0,0 +1,207 @@
program mustache;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
Classes, SysUtils, CustApp, strutils, fpjson, jsonparser, csvdataset, fpMustache, fpexmustache, fpdbmustache, iostream;
type
{ TMustacheApplication }
TMustacheApplication = class(TCustomApplication)
private
FTemplate : TMustacheString;
FJSON : TJSONStringType;
FCSV: TCSVDataset;
FPartials,
FDefines : TStrings;
FAllowExpressions : Boolean;
Foutput,
FSection,
FRootPath : String;
procedure DoGetDefine(const aName: TMustacheString; var aHandled: Boolean;
var aValue: TMustacheString);
procedure ProcessOptions;
Procedure Createoutput;
procedure Usage(ErrorMsg: String);
protected
procedure DoRun; override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
end;
{ TMustacheApplication }
procedure TMustacheApplication.Usage(ErrorMsg : String);
begin
If ErrorMsg<>'' then
Writeln('Error : ',ErrorMsg);
Writeln('Usage : mustache [options]');
Writeln('Where options is one or more of:');
writeln('-c --csv=FILE Use a CSV file as data source. First line must contain column names.');
writeln('-d --define=name=value Define fixed value.');
writeln('-e --expressions Allow expressions.');
writeln('-h --help This message.');
writeln('-j --json=JSON Use JSON as data source. @FILENAME will read JSON from file (UTF8).');
writeln('-o --output=FILE output file to write output to. If empty, stdout is assumed.');
writeln('-p --partial=name=PARTIAL Register partial. @FILENAME reads partial from file.');
writeln('-r --root=PATH Register variables at root path PATH for expression engine');
writeln('-s --section=SECTIOn Section name for CSV data');
writeln('-t --template=TEMPLATE Use TEMPLATE as data source. @FILENAME will read template from file (UTF8). Required.');
Halt(Ord(ErrorMsg<>''));
end;
procedure TMustacheApplication.ProcessOptions;
Function StringOrFile(S : String) : UTF8String;
begin
if Copy(S,1,1)<>'@' then
Result:=S
else
With TFileStream.Create(Copy(S,2,Length(S)-1),fmOpenRead or fmShareDenyNone) do
try
SetLength(Result,Size);
ReadBuffer(Result[1],Size);
finally
Free;
end;
end;
Var
S : String;
begin
if Not HasOption('t','template') then
Raise Exception.Create('Need a template');
if HasOption('c','csv') and HasOption('j','json') then
Raise Exception.Create('Cannot specify both JSON or CSV');
FTemplate:=StringOrFile(GetOptionValue('t','template'));
if HasOption('j','json') then
FJSON:=StringOrFile(GetOptionValue('j','json'))
else if HasOption('c','csv') then
begin
FCSV:=TCSVDataset.Create(Self);
FCSV.FileName:=GetOptionValue('c','csv');
FCSV.CSVOptions.FirstLineAsFieldNames:=True;
FCSV.Open;
end;
for S in GetOptionValues('d','define') do
FDefines.Add(S);
for S in GetOptionValues('p','partial') do
FPartials.Add(ExtractWord(1,S,['='])+'='+StringOrFile(ExtractWord(2,S,['='])));
FAllowExpressions:=HasOption('e','expressions');
FRootPath:=GetOptionValue('r','root');
FSection:=GetOptionValue('s','section');
if FSection='' then
FSection:='data';
Foutput:=GetOptionValue('o','output');
end;
procedure TMustacheApplication.DoGetDefine(const aName: TMustacheString;
var aHandled: Boolean; var aValue: TMustacheString);
Var
Idx : Integer;
begin
Writeln('Getting define ',aName);
Idx:=FDefines.IndexOfName(aName);
aHandled:=Idx<>-1;
if aHandled then
aValue:=FDefines.ValueFromIndex[Idx]
else
aValue:='';
end;
procedure TMustacheApplication.DoRun;
var
ErrorMsg: String;
begin
Terminate;
// quick check parameters
ErrorMsg:=CheckOptions('het:j:c:d:o:r:', ['help','template','json','csv','define','output','expressions','root']);
if (ErrorMsg<>'') or HasOption('h','help') then
Usage(ErrorMsg);
ProcessOptions;
CreateOutput;
end;
procedure TMustacheApplication.CreateOutput;
Var
M : TMustache;
C : TMustacheContext;
O : TStream;
S : TMustacheString;
begin
O:=Nil;
M:=Nil;
C:=Nil;
try
if FAllowExpressions then
M:=TMustache.Create(Self)
else
begin
M:=TMustacheExpr.Create(Self);
if (FRootPath<>'') and (FJSON<>'') then
TMustacheExpr(M).RegisterVariables(FJSON,FRootPath,True);
end;
M.Partials:=FPartials;
if Assigned(FCSV) then
begin
C:=TMustacheDBContext.Create(@DoGetDefine);
TMustacheDBContext(C).AddDataset(FCSV,FSection);
end
else if (FJSON<>'') then
C:=TMustacheJSONContext.Create(GetJSON(FJSON),@DoGetDefine)
else
C:=TMustacheContext.Create(@DoGetDefine);
if Foutput<>'' then
O:=TFileStream.Create(Foutput,fmCreate)
else
O:=TIOStream.Create(iosOutput);
M.Template:=FTemplate;
S:=M.Render(C);
O.WriteBuffer(S[1],Length(S));
finally
O.Free;
C.Free;
M.Free;
end;
end;
constructor TMustacheApplication.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
FPartials:=TStringList.Create;
FDefines:=TStringList.Create;
StopOnException:=True;
end;
destructor TMustacheApplication.Destroy;
begin
FreeAndNil(FPartials);
FreeAndNil(FDefines);
FreeAndNil(FCSV);
inherited Destroy;
end;
var
Application: TMustacheApplication;
begin
Application:=TMustacheApplication.Create(nil);
Application.Title:='Mustache Templater';
Application.Run;
Application.Free;
end.

268
packages/fcl-mustache/src/fpdbmustache.pp Normal file
View File

@ -0,0 +1,268 @@
{
This file is part of the Free Pascal Run time library.
Copyright (c) 2021 by Michael Van Canneyt (michael@freepascal.org)
This file contains a Mustache DB context, getting data from a dataset
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 fpdbmustache;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, db, fpMustache;
Type
{ TDatasetCollectionItem }
TDatasetCollectionItem = Class(TCollectionItem)
private
FDataset: TDataSet;
FSection: String;
Public
Property Dataset : TDataSet Read FDataset Write FDataset;
Property SectionName : String Read FSection Write FSection;
end;
TDatasetCollection = Class(TCollection)
private
function GetDS(aIndex : Integer): TDatasetCollectionItem;
Public
Function IndexOfDataset(aDataset : TDataset) : Integer;
Function IndexOfSection(aSection : String) : Integer;
Property Datasets[aIndex : Integer] : TDatasetCollectionItem Read GetDS; default;
end;
{ TMustacheDBContext }
TMustacheDBContext = Class(TMustacheContext)
Private
Type
TPair = Record
atStart : Boolean;
Value : TDataset;
end;
Private
FStack : Array of TPair;
FCount : Integer;
FStaticValues: TStrings;
FDatasets : TDatasetCollection;
Function FindField(Const aName : TMustacheString) : TField;
function GetDataset(aIndex : Integer): TDatasetCollectionItem;
function GetDatasetCount: INteger;
procedure SetStaticValues(AValue: TStrings);
Public
Constructor Create(aCallback : TGetTextValueEvent); override;
Destructor destroy; override;
Procedure Clear;
Function MoveNextSectionItem(Const aName : TMustacheString) : Boolean; override;
Function PushSection(Const aName : TMustacheString) : TMustacheSectionType; override;
Procedure PopSection(Const aName : TMustacheString); override;
Function GetTextValue(Const aName : TMustacheString) : TMustacheString; override;
Procedure AddDataset(aDataset : TDataset; aSectionName : String = '');
Procedure RemoveDataset(aDataset : TDataset);
Property StaticValues : TStrings Read FStaticValues Write SetStaticValues;
Property Datasets[aIndex : Integer] : TDatasetCollectionItem Read GetDataset;
Property DatasetCount : INteger Read GetDatasetCount;
end;
implementation
uses StrUtils;
Resourcestring
SErrPopSectionNoPush = 'PopSection %s without push';
SErrDatasetNameEmpty = 'Dataset name and section cannot both be empty';
SErrDatasetEmpty = 'Dataset is Nil';
SErrDuplicateDataSetName = 'Duplicate dataset name: %s';
{ TMustacheDBContext }
function TMustacheDBContext.FindField(const aName: TMustacheString): TField;
Var
aCount : Integer;
begin
Result:=Nil;
aCount:=FCount-1;
While (Result=Nil) and (aCount>=0) do
begin
Result:=FStack[aCount].Value.FieldByName(aName);
Dec(aCount);
end;
end;
function TMustacheDBContext.GetDataset(aIndex : Integer
): TDatasetCollectionItem;
begin
Result:=FDatasets[aIndex];
end;
function TMustacheDBContext.GetDatasetCount: INteger;
begin
Result:=FDatasets.Count;
end;
procedure TMustacheDBContext.SetStaticValues(AValue: TStrings);
begin
if FStaticValues=AValue then Exit;
FStaticValues.Assign(AValue);
end;
constructor TMustacheDBContext.Create(aCallback: TGetTextValueEvent);
begin
inherited Create(aCallback);
FDatasets:=TDatasetCollection.Create(TDatasetCollectionItem);
FStaticValues:=TStringList.Create;
SetLength(FStack,JSONListGrowCount);
FCount:=0;
end;
destructor TMustacheDBContext.destroy;
begin
FreeAndNil(FStaticValues);
FreeAndNil(FDatasets);
inherited destroy;
end;
procedure TMustacheDBContext.Clear;
begin
FStaticValues.Clear;
FDatasets.Clear;
end;
function TMustacheDBContext.MoveNextSectionItem(const aName: TMustacheString
): Boolean;
begin
if FStack[FCount-1].atStart then
FStack[FCount-1].atStart:=False
else
FStack[FCount-1].Value.Next;
Result:=Not FStack[FCount-1].Value.EOF;
end;
function TMustacheDBContext.PushSection(const aName: TMustacheString
): TMustacheSectionType;
Var
aDS : TDataset;
Idx : Integer;
begin
Result:=mstNone;
Idx:=FDatasets.IndexOfSection(aName);
if Idx=-1 then
Exit;
aDS:=FDatasets[Idx].Dataset;
if aDS.IsEmpty then
exit;
if FCount=Length(FStack) then
SetLength(FStack,FCount+JSONListGrowCount);
FStack[FCount].Value:=aDS;
FStack[FCount].atStart:=True;
Inc(FCount,1);
Result:=mstList;
end;
procedure TMustacheDBContext.PopSection(const aName: TMustacheString);
begin
if FCount<1 then
Raise EMustache.CreateFmt(SErrPopSectionNoPush,[aName]);
Dec(FCount,1);
end;
function TMustacheDBContext.GetTextValue(const aName: TMustacheString
): TMustacheString;
Var
F : TField;
idx : Integer;
begin
F:=Nil;
if Pos('.',aName)=0 then
F:=FindField(aName)
else if WordCount(aName,['.'])=2 then
begin
Idx:=FDatasets.IndexOfSection(ExtractWord(1,aName,['.']));
if (Idx<>-1) then
F:=FDatasets[Idx].Dataset.FindField(ExtractWord(2,aName,['.']));
end;
If Assigned(F) then
Result:=F.AsString
else
begin
Idx:=FStaticValues.IndexOfName(aName);
if Idx<>-1 then
Result:=FStaticValues.ValueFromIndex[Idx]
else
Result:=Inherited GetTextValue(aName);
end;
end;
procedure TMustacheDBContext.AddDataset(aDataset: TDataset; aSectionName: String);
Var
DCI : TDatasetCollectionItem;
aName : String;
begin
aName:=aSectionName;
if aName='' then
aName:=aDataset.Name;
if aName='' then
raise EMustache.Create(SErrDatasetNameEmpty);
if aDataset=Nil then
raise EMustache.Create(SErrDatasetEmpty);
if FDatasets.IndexOfSection(aName)<>-1 then
raise EMustache.CreateFmt(SErrDuplicateDataSetName, [aName]);
DCI:=FDatasets.Add as TDatasetCollectionItem;
DCI.Dataset:=aDataset;
DCI.SectionName:=aName;
end;
procedure TMustacheDBContext.RemoveDataset(aDataset: TDataset);
Var
Idx : Integer;
begin
Idx:=FDatasets.IndexOfDataset(aDataset);
if Idx<>-1 then
FDatasets.Delete(Idx);
end;
{ TDatasetCollection }
function TDatasetCollection.GetDS(aIndex : Integer): TDatasetCollectionItem;
begin
Result:=Items[aIndex] as TDatasetCollectionItem;
end;
function TDatasetCollection.IndexOfDataset(aDataset: TDataset): Integer;
begin
Result:=Count-1;
While (Result>=0) and (GetDS(Result).Dataset<>ADataset) do
Dec(Result);
end;
function TDatasetCollection.IndexOfSection(aSection: String): Integer;
begin
Result:=Count-1;
While (Result>=0) and not SameText(GetDS(Result).SectionName,ASection) do
Dec(Result);
end;
end.

399
packages/fcl-mustache/src/fpexmustache.pp Normal file
View File

@ -0,0 +1,399 @@
{
This file is part of the Free Pascal Run time library.
Copyright (c) 2021 by Michael Van Canneyt (michael@freepascal.org)
This file contains a Mustache descendent with FPExpr parser expression support
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 fpexmustache;
{$mode ObjFPC}{$H+}
interface
uses
Classes, fpexprpars, fpmustache, fpjson;
Type
{ TMustacheExprElement }
TMustacheExprElement = Class(TMustacheElement)
private
FNode: TFPExprNode;
FExpr : TMustacheString;
Protected
Procedure SetNode(aNode : TFPExprNode); virtual;
Function GetData : TMustacheString;override;
Procedure SetData(const aValue : TMustacheString) ; override;
Public
Destructor Destroy; override;
Procedure Render(aContext : TMustacheContext; aOutput : TMustacheOutput; const aPrefix : String = ''; aLast : Boolean = False); override;
Property Node : TFPExprNode Read FNode;
end;
{ TMustacheExprParser }
TMustacheExprParser = class(TMustacheParser)
private
FExprEnd: Char;
FExprParser: TFPExpressionParser;
FExprStart: Char;
Protected
function CreateDefault(aParent: TMustacheElement; aPosition: Integer; const aName: String): TMustacheElement; override;
Public
Constructor Create(aTemplate : TMustacheString = '';aStart: TMustacheString='';aStop: TMustacheString = ''); override;
// Default [
Property ExprStart : Char Read FExprStart Write FExprStart;
// Default ]
Property ExprEnd : Char Read FExprEnd Write FExprEnd;
// Our instance
Property ExprParser : TFPExpressionParser Read FExprParser Write FExprParser;
end;
{ TMustacheExpr }
TMustacheExpr = Class(TMustache)
private
FExprEndChar: String;
FExpressionParser: TFPExpressionParser;
FExprStartChar: String;
FCurrentContext : TMustacheContext;
function GetResultType(aValue: TJSONData): TResultType;
procedure SetExprEndChar(AValue: String);
procedure SetExpressionParser(AValue: TFPExpressionParser);
procedure SetExprStartChar(AValue: String);
function DoGetExpressionParser : TFPExpressionParser;
Protected
procedure DoGetVariable(var Result: TFPExpressionResult; ConstRef AName: ShortString); virtual;
Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
Function CreateParser(aTemplate: TMustacheString): TMustacheParser; override;
function GetExpressionParser(aOwner : TComponent): TFPExpressionParser; virtual;
Public
Constructor Create(aOwner : TComponent); override;
Procedure Render(aContext : TMustacheContext; aOutput : TMustacheOutput); override; overload;
// Register variables from JSON in the expression engine.
// If UseEvent is true, the variables will be retrieved while parsing with an event.
// If UseEvent is false, the variables will be registered as static values.
Procedure RegisterVariables (aContext : TMustacheJSONContext; aPath : TJSONStringType = ''; UseEvent : Boolean = True);
Procedure RegisterVariables (aJSON : String; aPath : TJSONStringType = ''; UseEvent : Boolean = True);
Procedure RegisterVariables (aJSON : TJSONObject; aPath : TJSONStringType = ''; UseEvent : Boolean = True);
Published
// Default [
Property ExprStartChar : String Read FExprStartChar Write SetExprStartChar;
// Default ]
Property ExprEndChar : String Read FExprEndChar Write SetExprEndChar;
// An expression parser instance. If none is specified, then a default is created.
Property ExpressionParser : TFPExpressionParser Read DoGetExpressionParser Write SetExpressionParser;
end;
{ TMustacheExpressionParser }
TMustacheExpressionParser = class(TFPExpressionParser)
end;
implementation
uses sysutils;
Resourcestring
SErrLengthStartMustBe1 = 'Length expression start delimiter must be 1';
SErrLengthEndMustBe1 = 'Length expression end delimiter must be 1';
{ TMustacheExprElement }
procedure TMustacheExprElement.SetNode(aNode: TFPExprNode);
begin
FNode:=aNode;
end;
function TMustacheExprElement.GetData: TMustacheString;
begin
Result:=FExpr;
end;
procedure TMustacheExprElement.SetData(const aValue: TMustacheString);
begin
FExpr:=aValue;
end;
procedure TMustacheExprElement.Render(aContext: TMustacheContext;
aOutput: TMustacheOutput; const aPrefix: String; aLast: Boolean);
Var
Res : TFPExpressionResult;
S : TMustacheString;
begin
Res:=Node.NodeValue;
case Res.ResultType of
rtString : S:=Res.ResString;
rtBoolean : S:=BoolToStr(Res.ResBoolean,True);
rtInteger : S:=IntToStr(Res.ResInteger);
rtFloat : S:=FormatFloat('0.0#######',Res.ResFloat);
rtCurrency : S:=CurrToStr(Res.ResCurrency);
rtDateTime : S:=DateTimeToStr(Res.ResDateTime);
end;
aOutput.Output(aPrefix+S);
end;
destructor TMustacheExprElement.Destroy;
begin
FreeAndNil(FNode);
inherited Destroy;
end;
{ TMustacheExprParser }
function TMustacheExprParser.CreateDefault(aParent: TMustacheElement;
aPosition: Integer; const aName: String): TMustacheElement;
Var
L : Integer;
N : TFPExprNode;
begin
N:=Nil;
L:=Length(aName);
If (aName[1]=FExprStart) and (aName[L]=FExprEnd) then
begin
Result:=TMustacheExprElement.Create(metVariable,aParent,aPosition);
Result.Data:=Copy(aName,2,L-2);
ExprParser.Expression:=Result.Data;
ExprParser.ExtractNode(N);
TMustacheExprElement(Result).SetNode(N);
aParent.AddChild(Result);
end
else
Result:=Inherited CreateDefault(aParent,aPosition,aName);
end;
constructor TMustacheExprParser.Create(aTemplate: TMustacheString;
aStart: TMustacheString; aStop: TMustacheString);
begin
inherited Create(aTemplate, aStart, aStop);
FExprStart:='[';
FExprEnd:=']';
end;
{ TMustacheExpr }
procedure TMustacheExpr.SetExprEndChar(AValue: String);
begin
if FExprEndChar=AValue then Exit;
if Length(aValue)<>1 then
EMustache.Create(SErrLengthStartMustBe1);
FExprEndChar:=AValue;
end;
function TMustacheExpr.GetExpressionParser(aOwner : TComponent): TFPExpressionParser;
begin
Result:=TMustacheExpressionParser.Create(AOwner);
end;
procedure TMustacheExpr.SetExpressionParser(AValue: TFPExpressionParser);
begin
if FExpressionParser=AValue then Exit;
If assigned(FExpressionParser) then
FExpressionParser.RemoveFreeNotification(Self);
FExpressionParser:=AValue;
If assigned(FExpressionParser) then
FExpressionParser.FreeNotification(Self);
end;
procedure TMustacheExpr.SetExprStartChar(AValue: String);
begin
if FExprStartChar=AValue then Exit;
if Length(aValue)<>1 then
EMustache.Create(SErrLengthEndMustBe1);
FExprStartChar:=AValue;
end;
function TMustacheExpr.DoGetExpressionParser: TFPExpressionParser;
begin
if FExpressionParser=Nil then
begin
FExpressionParser:=GetExpressionParser(Self);
FExpressionParser.SetSubComponent(True);
FExpressionParser.FreeNotification(Self);
end;
Result:=FExpressionParser;
end;
procedure TMustacheExpr.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation=opRemove) and (aComponent=FExpressionParser) then
FExpressionParser:=Nil;
end;
function TMustacheExpr.CreateParser(aTemplate: TMustacheString ): TMustacheParser;
Var
Exp : TMustacheExprParser;
begin
Exp:=TMustacheExprParser.Create(aTemplate);
Exp.ExprParser:=Self.ExpressionParser;
Result:=Exp;
end;
constructor TMustacheExpr.Create(aOwner: TComponent);
begin
inherited Create(aOwner);
DoGetExpressionParser;
end;
procedure TMustacheExpr.Render(aContext: TMustacheContext; aOutput: TMustacheOutput);
begin
FCurrentContext:=aContext;
try
inherited Render(aContext, aOutput);
finally
FCurrentContext:=nil;
end;
end;
procedure TMustacheExpr.DoGetVariable(var Result: TFPExpressionResult; ConstRef
AName: ShortString);
Var
S : TMustacheString;
V : Double;
C : Integer;
begin
If not Assigned(FCurrentContext) then
case result.ResultType of
rtInteger : Result.ResInteger:=0;
rtDateTime : Result.ResDateTime:=0.0;
rtString : Result.ResString:='';
rtFloat: Result.ResFloat:=0.0;
rtCurrency: Result.ResCurrency:=0.0;
rtBoolean: Result.ResBoolean:=False;
end
else
begin
S:=FCurrentContext.GetTextValue(aName);
case result.ResultType of
rtInteger : Result.ResInteger:=StrToInt64Def(S,0);
rtDateTime : if Not TryStrToDateTime(S,Result.ResDateTime) then
Result.ResDateTime:=0.0;
rtString : Result.ResString:=S;
rtFloat: begin
Val(S,V,C);
if C<>0 then
Result.ResFloat:=0.0
else
Result.ResFloat:=V;
end;
rtCurrency:
begin
Val(S,V,C);
if (C<>0) then
Result.ResCurrency:=0.0
else
Result.ResCurrency:=V;
end;
rtBoolean: Result.ResBoolean:=StrToBoolDef(S,False);
end;
end;
end;
function TMustacheExpr.GetResultType(aValue: TJSONData): TResultType;
begin
Case aValue.JSONType of
jtBoolean : Result:=rtBoolean;
jtString,
jtArray,
jtObject,
jtNull : Result:=rtString;
jtNumber :
begin
Case TJSONNumber(aValue).NumberType of
ntFloat : Result:=rtFloat;
ntInteger,
ntInt64 : Result:=rtInteger;
ntQWord : Raise EMustache.Create('Unsupported JSON type');
end;
end;
end;
end;
procedure TMustacheExpr.RegisterVariables(aContext: TMustacheJSONContext;
aPath: TJSONStringType; UseEvent: Boolean);
begin
RegisterVariables(aContext.RootData as TJSONObject,aPath,UseEvent);
end;
procedure TMustacheExpr.RegisterVariables(aJSON: String;
aPath: TJSONStringType; UseEvent: Boolean);
Var
aData : TJSONData;
aObj : TJSONObject absolute aData;
begin
aData:=getJSON(aJSON,True);
try
if aData is TJSONObject then
RegisterVariables(aObj,aPath,useEvent)
else
Raise EMustache.Create('Invalid JSON data to register variables');
finally
aData.Free;
end;
end;
procedure TMustacheExpr.RegisterVariables(aJSON: TJSONObject; aPath: TJSONStringType; UseEvent: Boolean);
Var
aData,aValue : TJSONData;
aEnum : TJSONEnum;
aKey : TJSONStringType;
rt : TResultType;
aParser : TFPExpressionParser;
begin
aParser:=ExpressionParser;
aData:=aJSON.FindPath(aPath);
if aData is TJSONObject then
for aEnum in aData do
begin
aKey:=aEnum.Key;
aValue:=aEnum.Value;
rt:=GetResultType(aValue);
if UseEvent then
aParser.Identifiers.AddVariable(aKey,rt,@DoGetVariable)
else
case rt of
rtBoolean: aParser.Identifiers.AddBooleanVariable(aKey,aValue.AsBoolean);
rtFloat: aParser.Identifiers.AddFloatVariable(aKey,aValue.AsFloat);
rtInteger: aParser.Identifiers.AddIntegerVariable(aKey,aValue.AsInteger);
rtString: Case aValue.JSONType of
jtNull: aParser.Identifiers.AddStringVariable(aKey,'');
jtArray,
jtObject: aParser.Identifiers.AddStringVariable(aKey, aValue.AsJSON);
else
aParser.Identifiers.AddStringVariable(aKey,aValue.AsString);
end;
end;
end;
end;
end.

1340
packages/fcl-mustache/src/fpmustache.pp Normal file
View File

File diff suppressed because it is too large Load Diff

1
packages/fcl-mustache/tests/spec/comments.json Normal file
View File

@ -0,0 +1 @@
{"__ATTN__":"Do not edit this file; changes belong in the appropriate YAML file.","overview":"Comment tags represent content that should never appear in the resulting\noutput.\n\nThe tag's content may contain any substring (including newlines) EXCEPT the\nclosing delimiter.\n\nComment tags SHOULD be treated as standalone when appropriate.\n","tests":[{"name":"Inline","data":{},"expected":"1234567890","template":"12345{{! Comment Block! }}67890","desc":"Comment blocks should be removed from the template."},{"name":"Multiline","data":{},"expected":"1234567890\n","template":"12345{{!\n This is a\n multi-line comment...\n}}67890\n","desc":"Multiline comments should be permitted."},{"name":"Standalone","data":{},"expected":"Begin.\nEnd.\n","template":"Begin.\n{{! Comment Block! }}\nEnd.\n","desc":"All standalone comment lines should be removed."},{"name":"Indented Standalone","data":{},"expected":"Begin.\nEnd.\n","template":"Begin.\n {{! Indented Comment Block! }}\nEnd.\n","desc":"All standalone comment lines should be removed."},{"name":"Standalone Line Endings","data":{},"expected":"|\r\n|","template":"|\r\n{{! Standalone Comment }}\r\n|","desc":"\"\\r\\n\" should be considered a newline for standalone tags."},{"name":"Standalone Without Previous Line","data":{},"expected":"!","template":" {{! I'm Still Standalone }}\n!","desc":"Standalone tags should not require a newline to precede them."},{"name":"Standalone Without Newline","data":{},"expected":"!\n","template":"!\n {{! I'm Still Standalone }}","desc":"Standalone tags should not require a newline to follow them."},{"name":"Multiline Standalone","data":{},"expected":"Begin.\nEnd.\n","template":"Begin.\n{{!\nSomething's going on here...\n}}\nEnd.\n","desc":"All standalone comment lines should be removed."},{"name":"Indented Multiline Standalone","data":{},"expected":"Begin.\nEnd.\n","template":"Begin.\n {{!\n Something's going on here...\n }}\nEnd.\n","desc":"All standalone comment lines should be removed."},{"name":"Indented Inline","data":{},"expected":" 12 \n","template":" 12 {{! 34 }}\n","desc":"Inline comments should not strip whitespace"},{"name":"Surrounding Whitespace","data":{},"expected":"12345 67890","template":"12345 {{! Comment Block! }} 67890","desc":"Comment removal should preserve surrounding whitespace."}]}

1
packages/fcl-mustache/tests/spec/delimiters.json Normal file
View File

@ -0,0 +1 @@
{"__ATTN__":"Do not edit this file; changes belong in the appropriate YAML file.","overview":"Set Delimiter tags are used to change the tag delimiters for all content\nfollowing the tag in the current compilation unit.\n\nThe tag's content MUST be any two non-whitespace sequences (separated by\nwhitespace) EXCEPT an equals sign ('=') followed by the current closing\ndelimiter.\n\nSet Delimiter tags SHOULD be treated as standalone when appropriate.\n","tests":[{"name":"Pair Behavior","data":{"text":"Hey!"},"expected":"(Hey!)","template":"{{=<% %>=}}(<%text%>)","desc":"The equals sign (used on both sides) should permit delimiter changes."},{"name":"Special Characters","data":{"text":"It worked!"},"expected":"(It worked!)","template":"({{=[ ]=}}[text])","desc":"Characters with special meaning regexen should be valid delimiters."},{"name":"Sections","data":{"section":true,"data":"I got interpolated."},"expected":"[\n I got interpolated.\n |data|\n\n {{data}}\n I got interpolated.\n]\n","template":"[\n{{#section}}\n {{data}}\n |data|\n{{/section}}\n\n{{= | | =}}\n|#section|\n {{data}}\n |data|\n|/section|\n]\n","desc":"Delimiters set outside sections should persist."},{"name":"Inverted Sections","data":{"section":false,"data":"I got interpolated."},"expected":"[\n I got interpolated.\n |data|\n\n {{data}}\n I got interpolated.\n]\n","template":"[\n{{^section}}\n {{data}}\n |data|\n{{/section}}\n\n{{= | | =}}\n|^section|\n {{data}}\n |data|\n|/section|\n]\n","desc":"Delimiters set outside inverted sections should persist."},{"name":"Partial Inheritence","data":{"value":"yes"},"expected":"[ .yes. ]\n[ .yes. ]\n","template":"[ {{>include}} ]\n{{= | | =}}\n[ |>include| ]\n","desc":"Delimiters set in a parent template should not affect a partial.","partials":{"include":".{{value}}."}},{"name":"Post-Partial Behavior","data":{"value":"yes"},"expected":"[ .yes. .yes. ]\n[ .yes. .|value|. ]\n","template":"[ {{>include}} ]\n[ .{{value}}. .|value|. ]\n","desc":"Delimiters set in a partial should not affect the parent template.","partials":{"include":".{{value}}. {{= | | =}} .|value|."}},{"name":"Surrounding Whitespace","data":{},"expected":"| |","template":"| {{=@ @=}} |","desc":"Surrounding whitespace should be left untouched."},{"name":"Outlying Whitespace (Inline)","data":{},"expected":" | \n","template":" | {{=@ @=}}\n","desc":"Whitespace should be left untouched."},{"name":"Standalone Tag","data":{},"expected":"Begin.\nEnd.\n","template":"Begin.\n{{=@ @=}}\nEnd.\n","desc":"Standalone lines should be removed from the template."},{"name":"Indented Standalone Tag","data":{},"expected":"Begin.\nEnd.\n","template":"Begin.\n {{=@ @=}}\nEnd.\n","desc":"Indented standalone lines should be removed from the template."},{"name":"Standalone Line Endings","data":{},"expected":"|\r\n|","template":"|\r\n{{= @ @ =}}\r\n|","desc":"\"\\r\\n\" should be considered a newline for standalone tags."},{"name":"Standalone Without Previous Line","data":{},"expected":"=","template":" {{=@ @=}}\n=","desc":"Standalone tags should not require a newline to precede them."},{"name":"Standalone Without Newline","data":{},"expected":"=\n","template":"=\n {{=@ @=}}","desc":"Standalone tags should not require a newline to follow them."},{"name":"Pair with Padding","data":{},"expected":"||","template":"|{{= @ @ =}}|","desc":"Superfluous in-tag whitespace should be ignored."}]}

1
packages/fcl-mustache/tests/spec/interpolation.json Normal file
View File

File diff suppressed because one or more lines are too long

1
packages/fcl-mustache/tests/spec/inverted.json Normal file
View File

File diff suppressed because one or more lines are too long

1
packages/fcl-mustache/tests/spec/partials.json Normal file
View File

@ -0,0 +1 @@
{"__ATTN__":"Do not edit this file; changes belong in the appropriate YAML file.","overview":"Partial tags are used to expand an external template into the current\ntemplate.\n\nThe tag's content MUST be a non-whitespace character sequence NOT containing\nthe current closing delimiter.\n\nThis tag's content names the partial to inject. Set Delimiter tags MUST NOT\naffect the parsing of a partial. The partial MUST be rendered against the\ncontext stack local to the tag. If the named partial cannot be found, the\nempty string SHOULD be used instead, as in interpolations.\n\nPartial tags SHOULD be treated as standalone when appropriate. If this tag\nis used standalone, any whitespace preceding the tag should treated as\nindentation, and prepended to each line of the partial before rendering.\n","tests":[{"name":"Basic Behavior","data":{},"expected":"\"from partial\"","template":"\"{{>text}}\"","desc":"The greater-than operator should expand to the named partial.","partials":{"text":"from partial"}},{"name":"Failed Lookup","data":{},"expected":"\"\"","template":"\"{{>text}}\"","desc":"The empty string should be used when the named partial is not found.","partials":{}},{"name":"Context","data":{"text":"content"},"expected":"\"*content*\"","template":"\"{{>partial}}\"","desc":"The greater-than operator should operate within the current context.","partials":{"partial":"*{{text}}*"}},{"name":"Recursion","data":{"content":"X","nodes":[{"content":"Y","nodes":[]}]},"expected":"X<Y<>>","template":"{{>node}}","desc":"The greater-than operator should properly recurse.","partials":{"node":"{{content}}<{{#nodes}}{{>node}}{{/nodes}}>"}},{"name":"Surrounding Whitespace","data":{},"expected":"| \t|\t |","template":"| {{>partial}} |","desc":"The greater-than operator should not alter surrounding whitespace.","partials":{"partial":"\t|\t"}},{"name":"Inline Indentation","data":{"data":"|"},"expected":" | >\n>\n","template":" {{data}} {{> partial}}\n","desc":"Whitespace should be left untouched.","partials":{"partial":">\n>"}},{"name":"Standalone Line Endings","data":{},"expected":"|\r\n>|","template":"|\r\n{{>partial}}\r\n|","desc":"\"\\r\\n\" should be considered a newline for standalone tags.","partials":{"partial":">"}},{"name":"Standalone Without Previous Line","data":{},"expected":" >\n >>","template":" {{>partial}}\n>","desc":"Standalone tags should not require a newline to precede them.","partials":{"partial":">\n>"}},{"name":"Standalone Without Newline","data":{},"expected":">\n >\n >","template":">\n {{>partial}}","desc":"Standalone tags should not require a newline to follow them.","partials":{"partial":">\n>"}},{"name":"Standalone Indentation","data":{"content":"<\n->"},"expected":"\\\n |\n <\n->\n |\n/\n","template":"\\\n {{>partial}}\n/\n","desc":"Each line of the partial should be indented before rendering.","partials":{"partial":"|\n{{{content}}}\n|\n"}},{"name":"Padding Whitespace","data":{"boolean":true},"expected":"|[]|","template":"|{{> partial }}|","desc":"Superfluous in-tag whitespace should be ignored.","partials":{"partial":"[]"}}]}

1
packages/fcl-mustache/tests/spec/sections.json Normal file
View File

File diff suppressed because one or more lines are too long

290
packages/fcl-mustache/tests/tcbasemustache.pas Normal file
View File

@ -0,0 +1,290 @@
{
This file is part of the Free Pascal Run time library.
Copyright (c) 2021 by Michael Van Canneyt (michael@freepascal.org)
Helper classes for Mustache test cases
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 tcbasemustache;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, fpcunit, fpmustache;
type
{ TTestContext }
(* StringList with following encoding
// Null value
aName=<null>
// false value
aName=<null>
// plain value
aName=AValue
// Object value & member. Object value must be present
SubObj={}
SubObj.aName=aValue
// Array and members. Array value must be present
SubObj.SubArr=[]
SubObj.SubArr[0]={}
SubObj.SubArr[0].aName=aValue
SubObj.SubArr[1]={}
Subobj.SubArr[1].aName=aValue
*)
TTestContext = class (TMustacheContext)
Private
FValues : TStringList;
FPath : String;
public
Constructor Create(aCallback: TGetTextValueEvent); override;
Destructor destroy; override;
Function GetTextValue(Const aName : TMustacheString) : TMustacheString; override;
Function MoveNextSectionItem(Const aName : TMustacheString) : Boolean; override;
Function PushSection(Const aName : TMustacheString) : TMustacheSectionType; override;
Procedure PopSection(Const aName : TMustacheString); override;
Procedure SetValue(const aPath,aValue : string);
Property Values : TStringList read FValues;
end;
TBaseMustacheTest = class(TTestCase)
Private
FPartials: TStrings;
FTemplate: String;
FResult: TMustacheElement;
FParser: TMustacheParser;
Protected
Function CreateParser : TMustacheParser; virtual; abstract;
Procedure DoGetPartial(const aName: TMustacheString; var aHandled: Boolean; var aValue: TMustacheString);
Public
Class Procedure AssertEquals(Msg : String; aExpected,aActual : TMustacheElementType); overload;
Class Function AssertElement(aParent : TMustacheElement; aIndex: Integer; aType: TMustacheElementType; aData: String; aClass : TMustacheElementClass = Nil) : TMustacheElement; overload;
Function AssertElement(aIndex: Integer; aType: TMustacheElementType; aData: String; aClass : TMustacheElementClass = Nil) : TMustacheElement; overload;
Procedure AssertResultCount(aCount : Integer);
procedure SetUp; override;
procedure TearDown; override;
Procedure CallParser;
Procedure AddPartial(Const aName,aText: TMustacheString);
Property Partials : TStrings Read FPartials;
Property Template : String Read FTemplate Write FTemplate;
property ParseResult : TMustacheElement Read FResult;
property Parser : TMustacheParser Read FParser;
end;
implementation
uses strutils, typinfo;
{ TTestContext }
constructor TTestContext.Create(aCallback: TGetTextValueEvent);
begin
inherited Create(aCallback);
FValues:=TStringList.Create;
FValues.OwnsObjects:=True;
end;
destructor TTestContext.destroy;
begin
FreeAndNil(FValues);
inherited destroy;
end;
function TTestContext.GetTextValue(const aName: TMustacheString
): TMustacheString;
Var
aPath,N : String;
Done : Boolean;
begin
Result:='';
aPath:=FPath;
Done:=False;
Repeat
if aPath<>'' then
N:=aPath+'.'+aName
else
begin
N:=aName;
Done:=True;
end;
Result:=FValues.Values[N];
if not Done then
aPath:=Copy(aPath,1,RPos('.',aPath)-1);
until (Result<>'') or Done;
end;
function TTestContext.MoveNextSectionItem(const aName: TMustacheString
): Boolean;
Var
L,P,Idx : Integer;
N : String;
begin
L:=Length(FPath);
if (L>0) and (FPath[L]=']') then
begin
P:=RPos('[',FPath)+1;
Idx:=StrToIntDef(Copy(FPath,P,L-P),-1);
N:=Copy(FPath,1,P-1)+IntToStr(Idx+1)+']';
Result:=FValues.Values[N]<>''; // We could check for {}
if Result then
FPath:=N;
end;
end;
function TTestContext.PushSection(const aName: TMustacheString): TMustacheSectionType;
Var
aPath,S : String;
begin
if FPath<>'' then
FPath:=FPath+'.';
aPath:=FPath+aName;
S:=Values.Values[aPath];
if S='{}' then
begin
FPath:=aPath;
result:=mstSingle;
end;
if S='[]' then
begin
if Values.Values[aPath+'[0]']='' then
Result:=mstNone
else
begin
FPath:=aPath+'[-1]';
result:=mstList;
end;
end
else if (s='<null>') or (s='<false>') or (s='') then
begin
Result:=mstNone;
end
else
begin
FPath:=aPath;
result:=mstSingle;
end;
end;
procedure TTestContext.PopSection(const aName: TMustacheString);
begin
FPath:=Copy(FPath,1,RPos('.',FPath)-1);
end;
procedure TTestContext.SetValue(const aPath, aValue: string);
begin
Values.Values[aPath]:=aValue;
end;
{ TBaseMustacheTest }
procedure TBaseMustacheTest.SetUp;
begin
Inherited;
FParser:=CreateParser;
FParser.Partials:=TMustachePartialList.Create(metRoot,Nil,0);
FParser.OnGetPartial:=@DoGetPartial;
FPartials:=TStringList.Create;
TStringList(FPartials).OwnsObjects:=True;
end;
procedure TBaseMustacheTest.TearDown;
begin
FreeAndNil(FPartials);
FreeAndNil(FResult);
FParser.Partials.Free;
FreeAndNil(FParser);
Inherited;
end;
procedure TBaseMustacheTest.DoGetPartial(const aName: TMustacheString;
var aHandled: Boolean; var aValue: TMustacheString);
begin
aValue:=FPartials.Values[aName];
aHandled:=FPartials.IndexOfName(aName)<>-1;
end;
class function TBaseMustacheTest.AssertElement(aParent: TMustacheElement;
aIndex: Integer; aType: TMustacheElementType; aData: String;
aClass: TMustacheElementClass): TMustacheElement;
Var
El : TMustacheElement;
aChild : String;
begin
AssertNotNull('Have parent',aParent);
AssertTrue(Format('Index %d in range 0..%d',[aIndex,aParent.ChildCount-1]),(aIndex>=0) and (aIndex<aParent.ChildCount));
EL:=aParent.Children[aIndex];
aChild:=Format('Child %d',[aIndex]);
AssertNotNull('Have result '+aChild,El);
AssertEquals(aChild+' has correct type',aType,El.ElementType);
AssertEquals(aChild+' has correct data',aData,El.Data);
if (aClass<>Nil) then
AssertEquals(aChild+' has correct class',aClass,el.Classtype);
Result:=El;
end;
function TBaseMustacheTest.AssertElement(aIndex: Integer;
aType: TMustacheElementType; aData: String; aClass : TMustacheElementClass = Nil): TMustacheElement;
begin
AssertNotNull('Have result',FResult);
Result:=AssertElement(FResult,aIndex,aType,aData,aClass);
end;
procedure TBaseMustacheTest.AssertResultCount(aCount: Integer);
begin
AssertNotNull('Have result',FResult);
AssertEquals('Result count',aCount,FResult.ChildCount);
end;
procedure TBaseMustacheTest.CallParser;
begin
Parser.Template:=Template;
FResult:=Parser.Parse;
end;
procedure TBaseMustacheTest.AddPartial(const aName, aText: TMustacheString);
//Var
// T : TMustacheTextElement;
begin
// T:=TMustacheTextElement.Create(metText,Nil,0);
// T.Data:=aText;
FPartials.Add(aName+'='+atext);
end;
class procedure TBaseMustacheTest.AssertEquals(Msg: String; aExpected,
aActual: TMustacheElementType);
begin
AssertEquals(Msg,GetEnumName(typeInfo(TMustacheElementType),Ord(aExpected)),
GetEnumName(typeInfo(TMustacheElementType),Ord(aActual)));
end;
end.

149
packages/fcl-mustache/tests/tcdbmustache.pas Normal file
View File

@ -0,0 +1,149 @@
{
This file is part of the Free Pascal Run time library.
Copyright (c) 2021 by Michael Van Canneyt (michael@freepascal.org)
Test cases for DB Context for Mustache
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 tcdbmustache;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testregistry, fpmustache, db, bufdataset, fpdbmustache;
Type
{ TTestMustacheDBContext }
TTestMustacheDBContext = Class(TTestCase)
private
FContext: TMustacheDBContext;
FDataset1: TBufDataset;
FDataset2: TBufDataset;
FMustache: TMustache;
Public
Procedure Setup; override;
Procedure TearDown; override;
Procedure CreateDataset1;
Procedure CreateDataset2;
Property Dataset1 : TBufDataset Read FDataset1;
Property Dataset2 : TBufDataset Read FDataset2;
Property Context : TMustacheDBContext Read FContext;
Property Mustache : TMustache Read FMustache;
Published
Procedure TestEmpty;
Procedure TestSingleSection;
Procedure TestTwoSections;
end;
implementation
Const
Template1 = '{{title}}! {{#Parents}}{{name}} {{age}} - {{/Parents}}';
Template2 = '{{title}}! {{#Parents}}{{name}}({{age}}) : {{#Children}}{{name}} {{age}},{{/Children}} - {{/Parents}}';
{ TTestMustacheDBContext }
procedure TTestMustacheDBContext.Setup;
begin
Inherited;
FDataset1:=TBufDataset.Create(Nil);
FDataset1.Name:='Parents';
FDataset2:=TBufDataset.Create(Nil);
FDataset2.Name:='Children';
FContext:=TMustacheDBContext.Create(Nil);
FContext.StaticValues.Values['title']:='Family';
FMustache:=TMustache.Create(Nil);
end;
procedure TTestMustacheDBContext.TearDown;
begin
FreeAndNil(FDataset1);
FreeAndNil(FDataset2);
FreeAndNil(FContext);
FreeAndNil(FMustache);
end;
procedure TTestMustacheDBContext.CreateDataset1;
begin
FDataset1.FieldDefs.Add('name',ftString,20);
FDataset1.FieldDefs.Add('age',ftInteger);
FDataset1.CreateDataset;
FDataset1.Append;
FDataset1.FieldByName('name').AsString:='Father';
FDataset1.FieldByName('age').AsInteger:=40;
FDataset1.Post;
FDataset1.Append;
FDataset1.FieldByName('name').AsString:='Mother';
FDataset1.FieldByName('age').AsInteger:=39;
FDataset1.Post;
FDataset1.First;
end;
procedure TTestMustacheDBContext.CreateDataset2;
begin
FDataset2.FieldDefs.Add('name',ftString,20);
FDataset2.FieldDefs.Add('age',ftInteger);
FDataset2.CreateDataset;
FDataset2.Append;
FDataset2.FieldByName('name').AsString:='Child1';
FDataset2.FieldByName('age').AsInteger:=4;
FDataset2.Post;
FDataset2.Append;
FDataset2.FieldByName('name').AsString:='Child2';
FDataset2.FieldByName('age').AsInteger:=2;
FDataset2.Post;
FDataset2.First;
end;
procedure TTestMustacheDBContext.TestEmpty;
begin
AssertNotNull('Mustache',Mustache);
AssertNotNull('Dataset1',Dataset1);
AssertNotNull('Dataset2',Dataset2);
AssertNotNull('Context',Context);
AssertEquals('Context static','Family',Context.StaticValues.Values['title']);
end;
procedure TTestMustacheDBContext.TestSingleSection;
Var
S : String;
begin
Mustache.Template:=Template1;
CreateDataset1;
Context.AddDataset(FDataset1);
S:=Mustache.Render(Context);
AssertEquals('Correct result','Family! Father 40 - Mother 39 - ',S);
end;
procedure TTestMustacheDBContext.TestTwoSections;
Var
S : String;
begin
Mustache.Template:=Template2;
CreateDataset1;
CreateDataset2;
Context.AddDataset(FDataset1);
Context.AddDataset(FDataset2);
S:=Mustache.Render(Context);
AssertEquals('Correct result','Family! Father(40) : Child1 4,Child2 2, - Mother(39) : - ',S);
end;
initialization
RegisterTest(TTestMustacheDBContext);
end.

199
packages/fcl-mustache/tests/tcexmustache.pas Normal file
View File

@ -0,0 +1,199 @@
{
This file is part of the Free Pascal Run time library.
Copyright (c) 2021 by Michael Van Canneyt (michael@freepascal.org)
Test cases for expression parser support
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 tcexmustache;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, fpcunit, fpjson, testregistry, fpmustache, tcbasemustache, fpexmustache, fpexprpars;
Type
{ TTestExMustacheParser }
TTestExMustacheParser = Class(TBaseMustacheTest)
private
FExpr: TFPExpressionParser;
FOutput: TMustacheStringOutput;
FContext : TMustacheJSONContext;
FData : TJSONData;
procedure GetVar(var Result: TFPExpressionResult; ConstRef
AName: ShortString);
Public
Procedure SetUp; override;
Procedure TearDown; override;
Function CreateParser: TMustacheParser; override;
Property Expr : TFPExpressionParser Read FExpr;
Property Output : TMustacheStringOutput Read FOutput;
Published
Procedure TestSimple;
Procedure TestRenderSimple;
Procedure TestRenderSection;
end;
{ TTestMustacheExpr }
TTestMustacheExpr = Class(TTestCase)
private
FJSON: TJSONObject;
FMustache: TMustacheExpr;
public
Procedure SetUp; override;
Procedure TearDown; override;
Property Mustache : TMustacheExpr Read FMustache;
Property JSON : TJSONObject Read FJSON;
Published
Procedure TestEmpty;
Procedure TestRegisterVariables;
Procedure TestRenderSection;
procedure TestRenderSectionStaticVariables;
end;
implementation
Const
STestJSON = '{ "data" : [ { "name": "me", "age" : 10}, { "name": "you", "age" : 12 }, { "name": "he", "age" : 13 } ] }';
{ TTestMustacheExpr }
procedure TTestMustacheExpr.SetUp;
begin
inherited SetUp;
FMustache:=TMustacheExpr.Create(Nil);
FJSON:=GetJSON(STestJSON) as TJSONObject;
end;
procedure TTestMustacheExpr.TearDown;
begin
FreeAndNil(FJSON);
FreeAndNil(FMustache);
inherited TearDown;
end;
procedure TTestMustacheExpr.TestEmpty;
begin
AssertNotNull('Have mustache instance',Mustache);
AssertNotNull('Have mustache expression engine instance',Mustache.ExpressionParser);
end;
procedure TTestMustacheExpr.TestRegisterVariables;
begin
Mustache.RegisterVariables(JSON,'data[0]',True);
AssertEquals('Variable count',2,Mustache.ExpressionParser.Identifiers.Count);
AssertEquals('Variable 0','name',Mustache.ExpressionParser.Identifiers[0].Name);
AssertEquals('Variable 1','age',Mustache.ExpressionParser.Identifiers[1].Name);
AssertTrue('Variable 0 type',rtString=Mustache.ExpressionParser.Identifiers[0].ResultType);
AssertTrue('Variable 1 type',rtInteger=Mustache.ExpressionParser.Identifiers[1].ResultType);
end;
procedure TTestMustacheExpr.TestRenderSection;
Var
S : String;
Const
Template = '{{#data}}{{[name]}}:{{[age>11]}} {{/data}}';
begin
Mustache.Template:=Template;
Mustache.RegisterVariables(JSON,'data[0]',True);
S:=Mustache.Render(JSON);
AssertEquals('Correct result','me:False you:True he:True ',S);
end;
procedure TTestMustacheExpr.TestRenderSectionStaticVariables;
Var
S : String;
Const
Template = '{{#data}}{{[name]}}:{{[age>11]}} {{/data}}';
begin
Mustache.Template:=Template;
Mustache.RegisterVariables(JSON,'data[0]',False);
S:=Mustache.Render(JSON);
AssertEquals('Correct result','me:False me:False me:False ',S);
end;
{ TTestExMustacheParser }
procedure TTestExMustacheParser.SetUp;
begin
FExpr:=TFPExpressionParser.Create(Nil);
Foutput:=TMustacheStringOutput.Create;
inherited SetUp;
end;
procedure TTestExMustacheParser.TearDown;
begin
inherited TearDown;
FreeAndNil(FExpr);
FreeAndNil(Foutput);
FreeAndNil(FContext);
FreeAndNil(FData);
end;
function TTestExMustacheParser.CreateParser: TMustacheParser;
Var
P : TMustacheExprParser;
begin
P:=TMustacheExprParser.Create;
P.ExprParser:=FExpr;
Result:=P;
end;
procedure TTestExMustacheParser.TestSimple;
begin
Template:='{{[1+2]}}';
CallParser;
AssertElement(0,metVariable,'1+2',TMustacheExprElement);
end;
procedure TTestExMustacheParser.TestRenderSimple;
begin
TestSimple;
ParseResult.Children[0].Render(Nil,Output,'',False);
AssertEquals('Correct result','3',Output.Data);
end;
procedure TTestExMustacheParser.GetVar(Var Result : TFPExpressionResult; ConstRef AName : ShortString);
begin
Result.ResultType:=rtInteger;
Result.ResInteger:=StrToINt(FContext.GetTextValue('age'));
end;
procedure TTestExMustacheParser.TestRenderSection;
begin
FData:=GetJSON(STestJSON);
FContext:=TMustacheJSONContext.Create(FData,Nil);
FExpr.Identifiers.AddVariable('age',rtInteger,@GetVar);
Template:='{{#data}}{{{name}}}:{{[age>11]}} {{/data}}';
CallParser;
ParseResult.Render(FContext,Output,'',False);
AssertEquals('Correct result','me:False you:True he:True ',Output.Data);
end;
initialization
RegisterTests([TTestExMustacheParser,TTestMustacheExpr]);
end.

728
packages/fcl-mustache/tests/tcmustache.pas Normal file
View File

@ -0,0 +1,728 @@
{
This file is part of the Free Pascal Run time library.
Copyright (c) 2021 by Michael Van Canneyt (michael@freepascal.org)
Test cases for basic mustache parser support
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 tcmustache;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testregistry, fpmustache, tcbasemustache;
type
{ TTestMustacheParser }
TTestMustacheParser= class(TBaseMustacheTest)
private
protected
Function CreateParser : TMustacheParser; override;
Public
procedure SetUp; override;
procedure TearDown; override;
published
procedure TestEmpty;
procedure TestText;
procedure TestVariable;
procedure TestVariableErrNonClosed;
procedure TestVariableAlternateStartStop;
procedure TestDottedVariable;
procedure TestVariableNoUnescape;
procedure TestVariableNoUnescapeErrNonClosed;
procedure TestVariableNoUnescapeAlternateStartStop;
procedure TestComment;
procedure TestCommentSurround;
procedure TestCommentStandalone;
procedure TestCommentStandaloneSpaced;
procedure TestSetDelimiter;
procedure TestSetDelimiterErrInvalid;
procedure TestSection;
procedure TestSectionNested;
procedure TestSectionErrNotClosed;
procedure TestSectionErrWrongClosed;
procedure TestSectionErrNotStarted;
procedure TestTextSection;
procedure TestPartial;
end;
{ TTestMustacheOutput }
TTestMustacheOutput = class(TTestCase)
Published
Procedure TestStringOutput;
end;
{ TTestMustacheElement }
TTestMustacheElement = class(TTestCase)
private
FContext: TTestContext;
FEl: TMustacheElement;
Foutput: TMustacheStringOutput;
procedure DoCallBack(const aName: TMustacheString; var aHandled: Boolean;
var aValue: TMustacheString);
Public
Procedure SetUp; override;
Procedure TearDown; override;
Property Context : TTestContext Read FContext;
Property Output : TMustacheStringOutput Read Foutput;
Property El : TMustacheElement Read FEl;
Published
Procedure TestEmpty;
Procedure TestTextElement;
Procedure TestTextElementNoEscape;
Procedure TestTextElementComment;
Procedure TestTextElementPrefix;
procedure TestTextElementPrefixNotLast;
procedure TestTextElementPrefixLast;
Procedure TestVariableElement;
Procedure TestVariableElementNoEscape;
Procedure TestVariableElementEscape;
Procedure TestSectionEmpty;
Procedure TestSectionValue;
Procedure TestSectionValueFalse;
Procedure TestSectionValueNull;
Procedure TestSectionValueEmptyArray;
Procedure TestSectionValueArray1El;
Procedure TestSectionValueArray2El;
Procedure TestSectionValueArray2ElValue;
Procedure TestSectionValueArray1ElValueSuper;
Procedure TestSectionValueArray2ElValueSuper;
Procedure TestParentElement;
Procedure TestParentElementRender;
Procedure TestParentElementRenderPrefix;
end;
implementation
uses Typinfo;
Const
SNeedsQuoting = '< > & "';
SQuotedResult = '&lt; &gt; &amp; &quot;';
{ TTestMustacheElement }
procedure TTestMustacheElement.DoCallBack(const aName: TMustacheString;
var aHandled: Boolean; var aValue: TMustacheString);
begin
aValue:='';
end;
procedure TTestMustacheElement.SetUp;
begin
inherited SetUp;
FOutput:=TMustacheStringOutput.Create;
FContext:=TTestContext.Create(@DoCallBack);
end;
procedure TTestMustacheElement.TearDown;
begin
FreeAndNil(FContext);
FreeAndNil(FOutput);
FreeAndNil(FEl);
inherited TearDown;
end;
procedure TTestMustacheElement.TestEmpty;
begin
AssertNotNull('Have output',Output);
end;
procedure TTestMustacheElement.TestTextElement;
begin
Fel:=TMustacheTextElement.Create(metText,Nil,0);
El.Render(Nil,Output);
AssertEquals('No output','',Output.Data);
El.Data:='me';
El.Render(Nil,Output);
AssertEquals('Correct output','me',Output.Data);
end;
procedure TTestMustacheElement.TestTextElementNoEscape;
begin
Fel:=TMustacheTextElement.Create(metText,Nil,0);
El.Data:=SNeedsQuoting;
El.Render(Nil,Output);
AssertEquals('Correct output',SNeedsQuoting,Output.Data);
end;
procedure TTestMustacheElement.TestTextElementComment;
begin
Fel:=TMustacheTextElement.Create(metComment,Nil,0);
El.Data:='Something';
El.Render(Nil,Output);
AssertEquals('Correct output','',Output.Data);
end;
procedure TTestMustacheElement.TestTextElementPrefix;
begin
Fel:=TMustacheTextElement.Create(metText,Nil,0);
El.Data:='me'#10'you';
El.Render(Nil,Output,' ');
AssertEquals('Correct output 1','me'#10' you',Output.Data);
end;
procedure TTestMustacheElement.TestTextElementPrefixNotLast;
begin
Fel:=TMustacheTextElement.Create(metText,Nil,0);
El.Data:='me'#10'you'#10;
El.Render(Nil,Output,' ');
AssertEquals('Correct output 2','me'#10' you'#10' ',Output.Data);
end;
procedure TTestMustacheElement.TestTextElementPrefixLast;
begin
Fel:=TMustacheTextElement.Create(metText,Nil,0);
El.Data:='me'#10'you'#10;
El.Render(Nil,Output,' ',True);
AssertEquals('Correct output 2','me'#10' you'#10,Output.Data);
end;
procedure TTestMustacheElement.TestVariableElement;
begin
Fel:=TMustacheVariableElement.Create(metText,Nil,0);
Context.Values.Values['name']:='abc';
El.Data:='name';
El.Render(Context,Output);
AssertEquals('Correct output','abc',Output.Data);
end;
procedure TTestMustacheElement.TestVariableElementNoEscape;
begin
Fel:=TMustacheVariableElement.Create(metText,Nil,0);
Context.Values.Values['name']:=SNeedsQuoting;
El.Data:='{name}';
El.Render(Context,Output);
AssertEquals('Correct output',SNeedsQuoting,Output.Data);
end;
procedure TTestMustacheElement.TestVariableElementEscape;
begin
Fel:=TMustacheVariableElement.Create(metText,Nil,0);
Context.Values.Values['name']:=SNeedsQuoting;
El.Data:='name';
El.Render(Context,Output);
AssertEquals('Correct output',SQuotedResult,Output.Data);
end;
procedure TTestMustacheElement.TestSectionEmpty;
Var
T : TMustacheTextElement;
begin
Fel:=TMustacheSectionElement.Create(metSection,Nil,0);
Fel.Data:='s';
T:=TMustacheTextElement.Create(metText,Nil,0);
Fel.AddChild(T);
T.Data:='a';
Fel.Render(Context,Output);
AssertEquals('No output','',Output.Data);
end;
procedure TTestMustacheElement.TestSectionValue;
Var
T : TMustacheTextElement;
begin
Context.SetValue('s','b');
Fel:=TMustacheSectionElement.Create(metSection,Nil,0);
Fel.Data:='s';
T:=TMustacheTextElement.Create(metText,Nil,0);
Fel.AddChild(T);
T.Data:='a';
Fel.Render(Context,Output);
AssertEquals('Single pass','a',Output.Data);
end;
procedure TTestMustacheElement.TestSectionValueFalse;
Var
T : TMustacheTextElement;
begin
Context.SetValue('s','<false>');
Fel:=TMustacheSectionElement.Create(metSection,Nil,0);
Fel.Data:='s';
T:=TMustacheTextElement.Create(metText,Nil,0);
Fel.AddChild(T);
T.Data:='a';
Fel.Render(Context,Output);
AssertEquals('no pass','',Output.Data);
end;
procedure TTestMustacheElement.TestSectionValueNull;
Var
T : TMustacheTextElement;
begin
Context.SetValue('s','<null>');
Fel:=TMustacheSectionElement.Create(metSection,Nil,0);
Fel.Data:='s';
T:=TMustacheTextElement.Create(metText,Nil,0);
Fel.AddChild(T);
T.Data:='a';
Fel.Render(Context,Output);
AssertEquals('no pass','',Output.Data);
end;
procedure TTestMustacheElement.TestSectionValueEmptyArray;
Var
T : TMustacheTextElement;
begin
Context.SetValue('s','[]');
Fel:=TMustacheSectionElement.Create(metSection,Nil,0);
Fel.Data:='s';
T:=TMustacheTextElement.Create(metText,Nil,0);
Fel.AddChild(T);
T.Data:='a';
Fel.Render(Context,Output);
AssertEquals('no pass','',Output.Data);
end;
procedure TTestMustacheElement.TestSectionValueArray1El;
Var
T : TMustacheTextElement;
begin
Context.SetValue('s','[]');
Context.SetValue('s[0]','toto');
Fel:=TMustacheSectionElement.Create(metSection,Nil,0);
Fel.Data:='s';
T:=TMustacheTextElement.Create(metText,Nil,0);
Fel.AddChild(T);
T.Data:='a';
Fel.Render(Context,Output);
AssertEquals('Single pass','a',Output.Data);
end;
procedure TTestMustacheElement.TestSectionValueArray2El;
Var
T : TMustacheTextElement;
begin
Context.SetValue('s','[]');
Context.SetValue('s[0]','toto');
Context.SetValue('s[1]','tata');
Fel:=TMustacheSectionElement.Create(metSection,Nil,0);
Fel.Data:='s';
T:=TMustacheTextElement.Create(metText,Nil,0);
Fel.AddChild(T);
T.Data:='a';
Fel.Render(Context,Output);
AssertEquals('Double pass','aa',Output.Data);
end;
procedure TTestMustacheElement.TestSectionValueArray2ElValue;
Var
T : TMustacheElement;
begin
Context.SetValue('s','[]');
Context.SetValue('s[0]','{}');
Context.SetValue('s[0].a','1');
Context.SetValue('s[1]','{}');
Context.SetValue('s[1].a','2');
Fel:=TMustacheSectionElement.Create(metSection,Nil,0);
Fel.Data:='s';
T:=TMustacheVariableElement.Create(metVariable,Nil,0);
Fel.AddChild(T);
T.Data:='a';
Fel.Render(Context,Output);
AssertEquals('Double pass','12',Output.Data);
end;
procedure TTestMustacheElement.TestSectionValueArray1ElValueSuper;
Var
T : TMustacheElement;
begin
Context.SetValue('s','[]');
Context.SetValue('s[0]','{}');
Context.SetValue('s[0].b','1');
Context.SetValue('a','2');
Fel:=TMustacheSectionElement.Create(metSection,Nil,0);
Fel.Data:='s';
T:=TMustacheVariableElement.Create(metVariable,Nil,0);
Fel.AddChild(T);
T.Data:='a';
Fel.Render(Context,Output);
AssertEquals('Single pass','2',Output.Data);
end;
procedure TTestMustacheElement.TestSectionValueArray2ElValueSuper;
Var
T : TMustacheElement;
begin
Context.SetValue('s','[]');
Context.SetValue('s[0]','{}');
Context.SetValue('s[0].b','1');
Context.SetValue('s[1]','{}');
Context.SetValue('s[1].b','2');
Context.SetValue('a','.a.');
Fel:=TMustacheSectionElement.Create(metSection,Nil,0);
Fel.Data:='s';
T:=TMustacheVariableElement.Create(metVariable,Nil,0);
Fel.AddChild(T);
T.Data:='a';
T:=TMustacheVariableElement.Create(metVariable,Nil,0);
Fel.AddChild(T);
T.Data:='b';
Fel.Render(Context,Output);
AssertEquals('Single pass','.a.1.a.2',Output.Data);
end;
procedure TTestMustacheElement.TestParentElement;
Var
SEl : TMustacheElement;
begin
Fel:=TMustacheParentElement.Create(metSection,Nil,0);
Sel:=TMustacheTextElement.Create(metText,Fel,0);
AssertSame('Parent stored',Fel,Sel.Parent);
AssertEquals('Not added to parent',0,FEl.ChildCount);
Fel.AddChild(Sel);
AssertEquals('added to parent - count',1,FEl.ChildCount);
AssertSame('added to parent - stored',Sel,FEl.Children[0]);
end;
procedure TTestMustacheElement.TestParentElementRender;
Var
SEl : TMustacheElement;
begin
Fel:=TMustacheParentElement.Create(metSection,Nil,0);
Sel:=TMustacheTextElement.Create(metText,Fel,0);
Sel.Data:='a';
Fel.AddChild(Sel);
Sel:=TMustacheTextElement.Create(metText,Fel,0);
Sel.Data:='b';
Fel.AddChild(Sel);
Sel:=TMustacheTextElement.Create(metText,Fel,0);
Sel.Data:='c';
Fel.AddChild(Sel);
Fel.Render(Context,Output);
AssertEquals('Correct output','abc',Output.Data);
end;
procedure TTestMustacheElement.TestParentElementRenderPrefix;
Var
SEl : TMustacheElement;
begin
Fel:=TMustacheParentElement.Create(metSection,Nil,0);
Sel:=TMustacheTextElement.Create(metText,Fel,0);
Sel.Data:='a'#10'b';
Fel.AddChild(Sel);
Sel:=TMustacheTextElement.Create(metText,Fel,0);
Sel.Data:='d'#10'e';
Fel.AddChild(Sel);
Sel:=TMustacheTextElement.Create(metText,Fel,0);
Sel.Data:='f'#10;
Fel.AddChild(Sel);
Fel.Render(Context,Output,' ');
AssertEquals('Correct output','a'#10' bd'#10' ef'#10,Output.Data);
end;
{ TTestMustacheOutput }
procedure TTestMustacheOutput.TestStringOutput;
Var
SO : TMustacheStringOutput;
begin
SO:=TMustacheStringOutput.Create;
try
AssertEquals('Empty start','',SO.Data);
SO.Output('abc');
AssertEquals('Output 1','abc',SO.Data);
SO.Output('def');
AssertEquals('Output 2','abcdef',SO.Data);
finally
SO.Free;
end;
end;
function TTestMustacheParser.CreateParser: TMustacheParser;
begin
Result:=TMustacheParser.Create;
end;
procedure TTestMustacheParser.SetUp;
begin
inherited SetUp;
end;
procedure TTestMustacheParser.TearDown;
begin
inherited TearDown;
end;
procedure TTestMustacheParser.TestEmpty;
begin
AssertNotNull('Have parser',Parser);
AssertNull('Have no result',ParseResult);
AssertEquals('Have no template','',Template);
end;
procedure TTestMustacheParser.TestText;
begin
Template:='a simple text';
CallParser;
AssertResultCount(1);
AssertElement(0,metText,'a simple text');
end;
procedure TTestMustacheParser.TestVariable;
Var
el : TMustacheVariableElement;
begin
Template:='{{a}}';
CallParser;
AssertResultCount(1);
el:=AssertElement(0,metVariable,'a',TMustacheVariableElement) as TMustacheVariableElement;
AssertFalse('unescape',El.NoUnescape);
end;
procedure TTestMustacheParser.TestVariableErrNonClosed;
begin
Template:='{{a';
AssertException('Have error',EMustache,@CallParser,'Tag {{ opened on position 1 but not closed.');
Template:='{{a}';
AssertException('Have error',EMustache,@CallParser,'Tag {{ opened on position 1 but not closed.');
end;
procedure TTestMustacheParser.TestVariableAlternateStartStop;
Var
el : TMustacheVariableElement;
begin
Parser.StartTag:='<<';
Parser.StopTag:='>>';
Template:='<<a>>';
CallParser;
AssertResultCount(1);
el:=AssertElement(0,metVariable,'a',TMustacheVariableElement) as TMustacheVariableElement;
AssertFalse('unescape',El.NoUnescape);
end;
procedure TTestMustacheParser.TestDottedVariable;
begin
Template:='{{a.b}}';
CallParser;
AssertResultCount(1);
AssertElement(0,metVariable,'a.b');
end;
procedure TTestMustacheParser.TestVariableNoUnescape;
Var
el : TMustacheVariableElement;
begin
Template:='{{{a}}}';
CallParser;
AssertResultCount(1);
el:=AssertElement(0,metVariable,'a',TMustacheVariableElement) as TMustacheVariableElement;
AssertTrue('unescape',El.NoUnescape);
end;
procedure TTestMustacheParser.TestVariableNoUnescapeErrNonClosed;
begin
Template:='{{{a';
AssertException('Have error',EMustache,@CallParser,'Tag {{ opened on position 1 but not closed.');
Template:='{{{a}';
AssertException('Have error',EMustache,@CallParser,'Tag {{ opened on position 1 but not closed.');
Template:='{{{a}}';
AssertException('Have error',EMustache,@CallParser,'Tag {{ opened on position 1 but not closed.');
end;
procedure TTestMustacheParser.TestVariableNoUnescapeAlternateStartStop;
Var
el : TMustacheVariableElement;
begin
Parser.StartTag:='<<';
Parser.StopTag:='>>';
Template:='<<{a}>>';
CallParser;
AssertResultCount(1);
el:=AssertElement(0,metVariable,'a',TMustacheVariableElement) as TMustacheVariableElement;
AssertTrue('unescape',El.NoUnescape);
end;
procedure TTestMustacheParser.TestComment;
begin
Parser.StartTag:='<<';
Parser.StopTag:='>>';
Template:='<<! a comment>>';
CallParser;
AssertResultCount(1);
AssertElement(0,metComment,' a comment',TMustacheTextElement);
end;
procedure TTestMustacheParser.TestCommentSurround;
begin
Template:='ab{{! a comment}}cd';
CallParser;
AssertResultCount(3);
AssertElement(0,metText,'ab',TMustacheTextElement);
AssertElement(1,metComment,' a comment',TMustacheTextElement);
AssertElement(2,metText,'cd',TMustacheTextElement);
end;
procedure TTestMustacheParser.TestCommentStandalone;
begin
Template:='a'+sLineBreak+'{{! a comment}}'+sLineBreak+'b';
CallParser;
AssertResultCount(3);
AssertElement(0,metText,'a'+sLineBreak,TMustacheTextElement);
AssertElement(1,metComment,' a comment',TMustacheTextElement);
AssertElement(2,metText,'b',TMustacheTextElement);
end;
procedure TTestMustacheParser.TestCommentStandaloneSpaced;
begin
Template:='a'+sLineBreak+' {{! a comment}} '+sLineBreak+'b';
CallParser;
AssertResultCount(3);
AssertElement(0,metText,'a'+sLineBreak,TMustacheTextElement);
AssertElement(1,metComment,' a comment',TMustacheTextElement);
AssertElement(2,metText,'b',TMustacheTextElement);
end;
procedure TTestMustacheParser.TestSetDelimiter;
begin
Template:='{{=<< >>=}}<<! a comment>>';
CallParser;
AssertResultCount(1);
AssertElement(0,metComment,' a comment',TMustacheTextElement);
end;
procedure TTestMustacheParser.TestSetDelimiterErrInvalid;
begin
Template:='{{=== ===}}';
AssertException('Have error',EMustache,@CallParser,'Invalid set delimiter Stop value: == in "== =="');
end;
procedure TTestMustacheParser.TestSection;
Var
el : TMustacheSectionElement;
begin
Template:='{{#a}}{{/a}}';
CallParser;
AssertResultCount(1);
el:=AssertElement(0,metSection,'a',TMustacheSectionElement) as TMustacheSectionElement;
AssertEquals('No elements in section',0,el.ChildCount);
end;
procedure TTestMustacheParser.TestSectionNested;
Var
el : TMustacheSectionElement;
begin
Template:='{{#a}}{{#b}}{{/b}}{{/a}}';
CallParser;
AssertResultCount(1);
el:=AssertElement(0,metSection,'a',TMustacheSectionElement) as TMustacheSectionElement;
AssertEquals('elements in section',1,el.ChildCount);
el:=AssertElement(el,0,metSection,'b',TMustacheSectionElement) as TMustacheSectionElement;
AssertEquals('elements in section sub',0,el.ChildCount);
end;
procedure TTestMustacheParser.TestSectionErrNotClosed;
begin
Template:='{{#a}}';
AssertException('Have error',EMustache,@CallParser,'Structural error: Section "a" on position 1 is not closed.');
end;
procedure TTestMustacheParser.TestSectionErrWrongClosed;
begin
Template:='{{#a}}{{#b}}{{/a}}{{/b}}';
AssertException('Have error',EMustache,@CallParser,'Structural error: Section "b" on position 7 is closed by tag "a" on position 13.');
end;
procedure TTestMustacheParser.TestSectionErrNotStarted;
begin
Template:='{{/a}}';
AssertException('Have error',EMustache,@CallParser,'Structural error: Section "a" on position 1 was never opened.');
end;
procedure TTestMustacheParser.TestTextSection;
Var
el : TMustacheSectionElement;
begin
Template:='{{#a}}bbb{{/a}}';
CallParser;
AssertResultCount(1);
el:=AssertElement(0,metSection,'a',TMustacheSectionElement) as TMustacheSectionElement;
AssertEquals('No elements in section',1,el.ChildCount);
AssertElement(el,0,metText,'bbb');
end;
procedure TTestMustacheParser.TestPartial;
Var
el : TMustachePartialElement;
begin
AddPartial('part','bcd');
Template:='a{{>part}}e';
CallParser;
AssertResultCount(3);
AssertElement(0,metText,'a',TMustacheTextElement);
el:=AssertElement(1,metPartial,'part',TMustachePartialElement) as TMustachePartialElement;
AssertElement(2,metText,'e',TMustacheTextElement);
AssertEquals('Correct partial','part',El.Partial.Data);
AssertEquals('Correct partial',1,El.Partial.ChildCount);
AssertElement(el.Partial,0,metText,'bcd',TMustacheTextElement);
end;
initialization
RegisterTests([TTestMustacheParser,TTestMustacheOutput,TTestMustacheElement]);
end.

188
packages/fcl-mustache/tests/tcspecs.pas Normal file
View File

@ -0,0 +1,188 @@
{
This file is part of the Free Pascal Run time library.
Copyright (c) 2021 by Michael Van Canneyt (michael@freepascal.org)
testcase for official Mustache tests
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 tcspecs;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testregistry, fpmustache, fpjson, jsonparser;
Type
{ TTestMustacheSpecs }
TTestMustacheSpecs = class(TTestCase)
private
FTests: TJSONArray;
procedure RunMustacheTest(aIndex: Integer; aTest: TJSONObject);
Public
class var BaseDir : string;
Public
Procedure Setup; override;
Procedure TearDown; override;
Procedure DoTest(aFileName : string);
Property Tests : TJSONArray Read FTests;
Published
Procedure TestComments;
Procedure TestDelimiters;
Procedure TestInterpolation;
Procedure TestInverted;
Procedure TestPartials;
Procedure TestSections;
end;
implementation
{ TTestMustacheSpecs }
procedure TTestMustacheSpecs.RunMustacheTest(aIndex : Integer; aTest : TJSONObject);
Var
M : TMustache;
aTempl,aErr,aRes,aName : TMustacheString;
Parts : TJSONObject;
I : Integer;
Ok : Boolean;
Procedure TreeDump;
begin
if not OK then
begin
Writeln('Tree dump:');
Writeln(M.Dump);
end;
end;
Procedure InputDump;
begin
Writeln('Test : ',aIndex);
writeln(aTempl);
writeln(StringReplace(StringReplace(aTempl,#10,' ',[rfReplaceAll]),#13,' ',[rfReplaceAll]));
aName:='';
While Length(aName)<Length(aTempl) do
aName:=AName+'1234567890';
Writeln(aName);
end;
begin
OK:=False;
aTempl:=aTest.Get('template','');
// InputDump;
M:=TMustache.CreateMustache(Nil,aTempl);
try
// Load partials
Parts:=aTest.Get('partials',TJSONObject(Nil));
if Assigned(Parts) then
for I:=0 to Parts.Count-1 do
M.Partials.Add(Parts.Names[i]+'='+Parts.Items[i].AsString);
// Set test name and run tests
aName:='Test '+IntToStr(aIndex)+': '+aTest.Get('name','');
Try
aErr:='';
aRes:=m.Render(aTest.Get('data',TJSONObject(Nil)));
except
on e : exception do
aErr:=E.ClassName+' '+E.message;
end;
if aErr<>'' then
Fail(aName+': Unexpected error: '+aErr);
AssertEquals(aName,aTest.Get('expected',''),aRes);
OK:=true;
finally
// TreeDump;
M.Free;
end;
end;
procedure TTestMustacheSpecs.Setup;
begin
inherited Setup;
end;
procedure TTestMustacheSpecs.TearDown;
begin
inherited TearDown;
end;
procedure TTestMustacheSpecs.DoTest(aFileName: string);
Var
I : Integer;
F : TFileStream;
D : TJSONData;
FN : String;
begin
D:=Nil;
FN:=IncludeTrailingPathDelimiter(BaseDir)+aFileName+'.json';
F:=TFileStream.Create(FN,fmOpenRead or fmShareDenyWrite);
try
D:=GetJSON(F);
if D is TJSONObject then
begin
Ftests:=(D as TJSONObject).Get('tests',TJSONArray(Nil));
if (FTests=Nil) then
Fail('Invalid mustache tests in '+FN);
end
else
Fail('Invalid JSON object in '+FN);
For I:=0 to Tests.Count-1 do
RunMustacheTest(I,Tests.Items[i] as TJSONObject);
finally
D.Free;
F.Free;
end;
end;
procedure TTestMustacheSpecs.TestComments;
begin
DoTest('comments');
end;
procedure TTestMustacheSpecs.TestDelimiters;
begin
DoTest('delimiters');
end;
procedure TTestMustacheSpecs.TestInterpolation;
begin
DoTest('interpolation');
end;
procedure TTestMustacheSpecs.TestInverted;
begin
DoTest('inverted');
end;
procedure TTestMustacheSpecs.TestPartials;
begin
DoTest('partials');
end;
procedure TTestMustacheSpecs.TestSections;
begin
DoTest('sections');
end;
begin
TTestMustacheSpecs.BaseDir:='spec/';
RegisterTest(TTestMustacheSpecs);
end.

88
packages/fcl-mustache/tests/testmustache.lpi Normal file
View File

@ -0,0 +1,88 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<General>
<Flags>
<SaveOnlyProjectUnits Value="True"/>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="testmustache"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<RequiredPackages>
<Item>
<PackageName Value="FCL"/>
</Item>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="testmustache.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="tcmustache.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="tcspecs.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="tcexmustache.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="tcbasemustache.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="tcdbmustache.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="testmustache"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="../src"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Debugging>
<UseHeaptrc Value="True"/>
</Debugging>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

29
packages/fcl-mustache/tests/testmustache.lpr Normal file
View File

@ -0,0 +1,29 @@
program testmustache;
{$mode objfpc}{$H+}
uses
Classes, consoletestrunner, tcmustache, tcspecs,
tcexmustache, tcbasemustache, tcdbmustache;
type
{ TMyTestRunner }
TMyTestRunner = class(TTestRunner)
protected
// override the protected methods of TTestRunner to customize its behavior
end;
var
Application: TMyTestRunner;
begin
DefaultFormat:=fPlain;
DefaultRunAllTests:=True;
Application := TMyTestRunner.Create(nil);
Application.Initialize;
Application.Title := 'FPCUnit Console test runner';
Application.Run;
Application.Free;
end.

1
packages/fpmake_add.inc
View File

@ -145,4 +145,5 @@
add_ide(ADirectory+IncludeTrailingPathDelimiter('ide'));
add_vclcompat(ADirectory+IncludeTrailingPathDelimiter('vcl-compat'));
add_qlunits(ADirectory+IncludeTrailingPathDelimiter('qlunits'));
add_mustache(ADirectory+IncludeTrailingPathDelimiter('fcl-mustache'));

6
packages/fpmake_proc.inc
View File

@ -821,4 +821,10 @@ begin
{$include qlunits/fpmake.pp}
end;
procedure add_mustache(const ADirectory: string);
begin
with Installer do
{$include fcl-mustache/fpmake.pp}
end;
{$include ide/fpmake.pp}