mirror of
https://github.com/danieleteti/delphimvcframework.git
synced 2024-11-15 15:55:54 +01:00
2729 lines
79 KiB
ObjectPascal
2729 lines
79 KiB
ObjectPascal
// ***************************************************************************
|
|
//
|
|
// Copyright (c) 2016-2024 Daniele Teti
|
|
//
|
|
// https://github.com/danieleteti/templatepro
|
|
//
|
|
// ***************************************************************************
|
|
//
|
|
// Licensed under the Apache License, Version 2.0 (the "License");
|
|
// you may not use this file except in compliance with the License.
|
|
// You may obtain a copy of the License at
|
|
//
|
|
// http://www.apache.org/licenses/LICENSE-2.0
|
|
//
|
|
// Unless required by applicable law or agreed to in writing, software
|
|
// distributed under the License is distributed on an "AS IS" BASIS,
|
|
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
// See the License for the specific language governing permissions and
|
|
// limitations under the License.
|
|
//
|
|
// ***************************************************************************
|
|
|
|
unit TemplatePro;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.Generics.Collections,
|
|
System.Classes,
|
|
System.SysUtils,
|
|
System.TypInfo,
|
|
Data.DB,
|
|
System.DateUtils,
|
|
System.RTTI;
|
|
|
|
const
|
|
TEMPLATEPRO_VERSION = '0.5';
|
|
|
|
type
|
|
ETProException = class(Exception)
|
|
|
|
end;
|
|
|
|
ETProCompilerException = class(ETProException)
|
|
|
|
end;
|
|
|
|
ETProRenderException = class(ETProException)
|
|
|
|
end;
|
|
|
|
ETProDuckTypingException = class(ETProException)
|
|
|
|
end;
|
|
|
|
TIfThenElseIndex = record
|
|
IfIndex, ElseIndex: Int64;
|
|
end;
|
|
|
|
TTokenType = (
|
|
ttContent, ttInclude, ttFor, ttEndFor, ttIfThen, ttBoolExpression, ttElse, ttEndIf, ttStartTag, ttComment,
|
|
ttLiteralString, ttEndTag, ttValue, ttFilterName, ttFilterParameter, ttLineBreak, ttSystemVersion, ttEOF);
|
|
const
|
|
TOKEN_TYPE_DESCR: array [Low(TTokenType)..High(TTokenType)] of string =
|
|
('ttContent', 'ttInclude', 'ttFor', 'ttEndFor', 'ttIfThen', 'ttBoolExpression', 'ttElse', 'ttEndIf', 'ttStartTag', 'ttComment',
|
|
'ttLiteralString', 'ttEndTag', 'ttValue', 'ttFilterName', 'ttFilterParameter', 'ttLineBreak', 'ttSystemVersion', 'ttEOF');
|
|
type
|
|
TToken = packed record
|
|
TokenType: TTokenType;
|
|
Value1: String;
|
|
Value2: String;
|
|
Ref1, Ref2: Int64;
|
|
class function Create(TokType: TTokenType; Value1: String; Value2: String; Ref1: Int64 = -1; Ref2: Int64 = -1): TToken; static;
|
|
function TokenTypeAsString: String;
|
|
function ToString: String;
|
|
procedure SaveToBytes(const aBytes: TBinaryWriter);
|
|
class function CreateFromBytes(const aBytes: TBinaryReader): TToken; static;
|
|
end;
|
|
|
|
TTokenWalkProc = reference to procedure(const Index: Integer; const Token: TToken);
|
|
|
|
TTProTemplateFunction = function(const aValue: TValue; const aParameters: TArray<string>): TValue;
|
|
TTProVariablesInfo = (viSimpleType, viObject, viDataSet, viListOfObject, viJSONObject, viIterable);
|
|
TTProVariablesInfos = set of TTProVariablesInfo;
|
|
|
|
TVarDataSource = class
|
|
protected
|
|
VarValue: TValue;
|
|
VarOption: TTProVariablesInfos;
|
|
constructor Create(const VarValue: TValue; const VarOption: TTProVariablesInfos);
|
|
end;
|
|
|
|
TTProVariables = class(TObjectDictionary<string, TVarDataSource>)
|
|
public
|
|
constructor Create;
|
|
end;
|
|
|
|
|
|
TTProCompiledTemplateGetValueEvent = reference to procedure(const DataSource, Members: string; var Value: TValue; var Handled: Boolean);
|
|
|
|
ITProCompiledTemplate = interface
|
|
['{0BE04DE7-6930-456B-86EE-BFD407BA6C46}']
|
|
function Render: String;
|
|
procedure ForEachToken(const TokenProc: TTokenWalkProc);
|
|
procedure ClearData;
|
|
procedure SetData(const Name: String; Value: TValue); overload;
|
|
procedure AddFilter(const FunctionName: string; const FunctionImpl: TTProTemplateFunction);
|
|
procedure DumpToFile(const FileName: String);
|
|
procedure SaveToFile(const FileName: String);
|
|
function GetOnGetValue: TTProCompiledTemplateGetValueEvent;
|
|
procedure SetOnGetValue(const Value: TTProCompiledTemplateGetValueEvent);
|
|
property OnGetValue: TTProCompiledTemplateGetValueEvent read GetOnGetValue write SetOnGetValue;
|
|
end;
|
|
|
|
TTProCompiledTemplateEvent = reference to procedure(const TemplateProCompiledTemplate: ITProCompiledTemplate);
|
|
|
|
TLoopStackItem = class
|
|
protected
|
|
DataSourceName: String;
|
|
LoopExpression: String;
|
|
FullPath: String;
|
|
IteratorName: String;
|
|
IteratorPosition: Integer;
|
|
function IncrementIteratorPosition: Integer;
|
|
constructor Create(DataSourceName: String; LoopExpression: String; FullPath: String; IteratorName: String);
|
|
end;
|
|
|
|
TTProCompiledTemplate = class(TInterfacedObject, ITProCompiledTemplate)
|
|
private
|
|
fTokens: TList<TToken>;
|
|
fVariables: TTProVariables;
|
|
fTemplateFunctions: TDictionary<string, TTProTemplateFunction>;
|
|
fLoopsStack: TObjectList<TLoopStackItem>;
|
|
fOnGetValue: TTProCompiledTemplateGetValueEvent;
|
|
function PeekLoop: TLoopStackItem;
|
|
procedure PopLoop;
|
|
procedure PushLoop(const LoopStackItem: TLoopStackItem);
|
|
function LoopStackIsEmpty: Boolean;
|
|
function WalkThroughLoopStack(const VarName: String; out BaseVarName: String; out FullPath: String): Boolean;
|
|
constructor Create(Tokens: TList<TToken>);
|
|
procedure Error(const aMessage: String);
|
|
function IsTruthy(const Value: TValue): Boolean;
|
|
function GetVarAsString(const Name: string): string;
|
|
function GetTValueVarAsString(const Value: TValue; const VarName: string = ''): String;
|
|
function GetVarAsTValue(const aName: string): TValue;
|
|
// function EvaluateIfExpression(aIdentifier: string): Boolean;
|
|
function EvaluateIfExpressionAt(var Idx: UInt64): Boolean;
|
|
function GetVariables: TTProVariables;
|
|
procedure SplitVariableName(const VariableWithMember: String; out VarName, VarMembers: String);
|
|
function ExecuteFilter(aFunctionName: string; aParameters: TArray<string>; aValue: TValue): TValue;
|
|
procedure CheckParNumber(const aHowManyPars: Integer; const aParameters: TArray<string>); overload;
|
|
procedure CheckParNumber(const aMinParNumber, aMaxParNumber: Integer; const aParameters: TArray<string>); overload;
|
|
function GetPseudoVariable(const VarIterator: Integer; const PseudoVarName: String): TValue; overload;
|
|
function IsAnIterator(const VarName: String; out DataSourceName: String; out CurrentIterator: TLoopStackItem): Boolean;
|
|
function GetOnGetValue: TTProCompiledTemplateGetValueEvent;
|
|
function EvaluateValue(var Idx: UInt64; out MustBeEncoded: Boolean): TValue;
|
|
procedure SetOnGetValue(const Value: TTProCompiledTemplateGetValueEvent);
|
|
procedure DoOnGetValue(const DataSource, Members: string; var Value: TValue; var Handled: Boolean);
|
|
public
|
|
destructor Destroy; override;
|
|
function Render: String;
|
|
procedure ForEachToken(const TokenProc: TTokenWalkProc);
|
|
procedure ClearData;
|
|
procedure SaveToFile(const FileName: String);
|
|
class function CreateFromFile(const FileName: String): ITProCompiledTemplate;
|
|
procedure SetData(const Name: String; Value: TValue); overload;
|
|
procedure AddFilter(const FunctionName: string; const FunctionImpl: TTProTemplateFunction);
|
|
procedure DumpToFile(const FileName: String);
|
|
property OnGetValue: TTProCompiledTemplateGetValueEvent read GetOnGetValue write SetOnGetValue;
|
|
end;
|
|
|
|
TTProCompiler = class
|
|
strict private
|
|
function MatchStartTag: Boolean;
|
|
function MatchEndTag: Boolean;
|
|
function MatchVariable(var aIdentifier: string): Boolean;
|
|
function MatchFilterParamValue(var aParamValue: string): Boolean;
|
|
function MatchSymbol(const aSymbol: string): Boolean;
|
|
function MatchSpace: Boolean;
|
|
function MatchString(out aStringValue: string): Boolean;
|
|
procedure InternalMatchFilter(lIdentifier: String; var lStartVerbatim: UInt64; const CurrToken: TTokenType; aTokens: TList<TToken>; const lRef2: Integer);
|
|
function GetFunctionParameters: TArray<String>;
|
|
private
|
|
fInputString: string;
|
|
fCharIndex: Int64;
|
|
fCurrentLine: Integer;
|
|
fEncoding: TEncoding;
|
|
fCurrentFileName: String;
|
|
procedure Error(const aMessage: string);
|
|
function Step: Char;
|
|
function CurrentChar: Char;
|
|
function GetSubsequentText: String;
|
|
procedure InternalCompileIncludedTemplate(const aTemplate: string; const aTokens: TList<TToken>; const aFileNameRefPath: String);
|
|
procedure Compile(const aTemplate: string; const aTokens: TList<TToken>; const aFileNameRefPath: String); overload;
|
|
public
|
|
function Compile(const aTemplate: string; const aFileNameRefPath: String = ''): ITProCompiledTemplate; overload;
|
|
constructor Create(aEncoding: TEncoding = nil);
|
|
end;
|
|
|
|
ITProWrappedList = interface
|
|
['{C1963FBF-1E42-4E2A-A17A-27F3945F13ED}']
|
|
function GetItem(const AIndex: Integer): TObject;
|
|
procedure Add(const AObject: TObject);
|
|
function Count: Integer;
|
|
procedure Clear;
|
|
function IsWrappedList: Boolean; overload;
|
|
function ItemIsObject(const AIndex: Integer; out AValue: TValue): Boolean;
|
|
end;
|
|
|
|
TTProConfiguration = class sealed
|
|
private
|
|
class var fOnContextConfiguration: TTProCompiledTemplateEvent;
|
|
protected
|
|
class procedure RegisterHandlers(const TemplateProCompiledTemplate: ITProCompiledTemplate);
|
|
public
|
|
class property OnContextConfiguration: TTProCompiledTemplateEvent read fOnContextConfiguration write fOnContextConfiguration;
|
|
end;
|
|
|
|
|
|
|
|
function HTMLEncode(s: string): string;
|
|
function HTMLSpecialCharsEncode(s: string): string;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.StrUtils, System.IOUtils, System.NetEncoding, System.Math,
|
|
JsonDataObjects, MVCFramework.Nullables;
|
|
|
|
const
|
|
IdenfierAllowedFirstChars = ['a' .. 'z', 'A' .. 'Z', '_', '@'];
|
|
IdenfierAllowedChars = ['a' .. 'z', 'A' .. 'Z', '_', '0' .. '9'];
|
|
ValueAllowedChars = IdenfierAllowedChars + [' ', '-', '+', '*', '.', '@', '/', '\']; // maybe a lot others
|
|
START_TAG = '{{';
|
|
END_TAG = '}}';
|
|
|
|
type
|
|
TTProRTTIUtils = class sealed
|
|
public
|
|
class function GetProperty(AObject: TObject; const APropertyName: string): TValue;
|
|
end;
|
|
|
|
TTProDuckTypedList = class(TInterfacedObject, ITProWrappedList)
|
|
private
|
|
FObjectAsDuck: TObject;
|
|
FObjType: TRttiType;
|
|
FAddMethod: TRttiMethod;
|
|
FClearMethod: TRttiMethod;
|
|
FCountProperty: TRttiProperty;
|
|
FGetItemMethod: TRttiMethod;
|
|
FGetCountMethod: TRttiMethod;
|
|
protected
|
|
procedure Add(const AObject: TObject);
|
|
procedure Clear;
|
|
function ItemIsObject(const AIndex: Integer; out AValue: TValue): Boolean;
|
|
public
|
|
constructor Create(const AObjectAsDuck: TObject); overload;
|
|
constructor Create(const AInterfaceAsDuck: IInterface); overload;
|
|
|
|
function IsWrappedList: Boolean; overload;
|
|
function Count: Integer;
|
|
procedure GetItemAsTValue(const AIndex: Integer; out AValue: TValue);
|
|
function GetItem(const AIndex: Integer): TObject;
|
|
class function CanBeWrappedAsList(const AObjectAsDuck: TObject): Boolean; overload; static;
|
|
class function CanBeWrappedAsList(const AObjectAsDuck: TObject; out AMVCList: ITProWrappedList): Boolean; overload; static;
|
|
class function CanBeWrappedAsList(const AInterfaceAsDuck: IInterface): Boolean; overload; static;
|
|
class function Wrap(const AObjectAsDuck: TObject): ITProWrappedList; static;
|
|
end;
|
|
|
|
var
|
|
GlContext: TRttiContext;
|
|
|
|
function WrapAsList(const AObject: TObject): ITProWrappedList;
|
|
begin
|
|
Result := TTProDuckTypedList.Wrap(AObject);
|
|
end;
|
|
|
|
|
|
{ TParser }
|
|
|
|
procedure TTProCompiledTemplate.AddFilter(const FunctionName: string; const FunctionImpl: TTProTemplateFunction);
|
|
begin
|
|
fTemplateFunctions.Add(FunctionName.ToLower, FunctionImpl);
|
|
end;
|
|
|
|
function TTProCompiledTemplate.GetOnGetValue: TTProCompiledTemplateGetValueEvent;
|
|
begin
|
|
Result := fOnGetValue;
|
|
end;
|
|
|
|
//function TTProCompiledTemplate.GetPseudoVariable(const Variable: TVarDataSource; const PseudoVarName: String): TValue;
|
|
//begin
|
|
// Result := GetPseudoVariable(Variable.VarIterator, PseudoVarName);
|
|
//end;
|
|
|
|
function TTProCompiledTemplate.GetPseudoVariable(const VarIterator: Integer; const PseudoVarName: String): TValue;
|
|
begin
|
|
if PseudoVarName = '@@index' then
|
|
begin
|
|
Result := VarIterator + 1;
|
|
end
|
|
else if PseudoVarName = '@@odd' then
|
|
begin
|
|
Result := (VarIterator + 1) mod 2 > 0;
|
|
end
|
|
else if PseudoVarName = '@@even' then
|
|
begin
|
|
Result := (VarIterator + 1) mod 2 = 0;
|
|
end
|
|
else
|
|
begin
|
|
Result := TValue.Empty;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TTProCompiledTemplate.GetTValueVarAsString(const Value: TValue; const VarName: string): String;
|
|
var
|
|
lIsObject: Boolean;
|
|
lAsObject: TObject;
|
|
begin
|
|
if Value.IsEmpty then
|
|
begin
|
|
Exit('');
|
|
end;
|
|
|
|
lIsObject := False;
|
|
lAsObject := nil;
|
|
if Value.IsObject then
|
|
begin
|
|
lIsObject := True;
|
|
lAsObject := Value.AsObject;
|
|
end;
|
|
|
|
if lIsObject then
|
|
begin
|
|
if lAsObject is TField then
|
|
Result := TField(Value.AsObject).AsString
|
|
else if lAsObject is TJsonBaseObject then
|
|
Result := TJsonBaseObject(lAsObject).ToJSON()
|
|
else
|
|
Result := lAsObject.ToString;
|
|
end
|
|
else
|
|
begin
|
|
if Value.TypeInfo.Kind = tkRecord then
|
|
begin
|
|
if Value.TypeInfo = TypeInfo(NullableInt32) then
|
|
begin
|
|
Result := Value.AsType<NullableInt32>.Value.ToString;
|
|
end
|
|
else if Value.TypeInfo = TypeInfo(NullableUInt32) then
|
|
begin
|
|
Result := Value.AsType<NullableInt32>.Value.ToString;
|
|
end
|
|
else if Value.TypeInfo = TypeInfo(NullableInt16) then
|
|
begin
|
|
Result := Value.AsType<NullableInt16>.Value.ToString;
|
|
end
|
|
else if Value.TypeInfo = TypeInfo(NullableUInt16) then
|
|
begin
|
|
Result := Value.AsType<NullableUInt16>.Value.ToString;
|
|
end
|
|
else if Value.TypeInfo = TypeInfo(NullableInt64) then
|
|
begin
|
|
Result := Value.AsType<NullableInt64>.Value.ToString;
|
|
end
|
|
else if Value.TypeInfo = TypeInfo(NullableUInt64) then
|
|
begin
|
|
Result := Value.AsType<NullableUInt64>.Value.ToString;
|
|
end
|
|
else if Value.TypeInfo = TypeInfo(NullableString) then
|
|
begin
|
|
Result := Value.AsType<NullableString>.Value;
|
|
end
|
|
else if Value.TypeInfo = TypeInfo(NullableCurrency) then
|
|
begin
|
|
Result := Value.AsType<NullableCurrency>.Value.ToString;
|
|
end
|
|
else if Value.TypeInfo = TypeInfo(NullableBoolean) then
|
|
begin
|
|
Result := Value.AsType<NullableBoolean>.Value.ToString;
|
|
end
|
|
else if Value.TypeInfo = TypeInfo(NullableTDate) then
|
|
begin
|
|
Result := DateToISO8601(Value.AsType<NullableTDate>.Value);
|
|
end
|
|
else if Value.TypeInfo = TypeInfo(NullableTTime) then
|
|
begin
|
|
Result := DateToISO8601(Value.AsType<NullableTTime>.Value);
|
|
end
|
|
else if Value.TypeInfo = TypeInfo(NullableTDateTime) then
|
|
begin
|
|
Result := DateToISO8601(Value.AsType<NullableTDateTime>.Value);
|
|
end
|
|
else
|
|
begin
|
|
raise ETProException.Create('Unsupported type for variable "' + VarName + '"');
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
Result := Value.ToString;
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TTProCompiledTemplate.CheckParNumber(const aMinParNumber, aMaxParNumber: Integer;
|
|
const aParameters: TArray<string>);
|
|
var
|
|
lParNumber: Integer;
|
|
begin
|
|
lParNumber := Length(aParameters);
|
|
if (lParNumber < aMinParNumber) or (lParNumber > aMaxParNumber) then
|
|
begin
|
|
if aMinParNumber = aMaxParNumber then
|
|
Error(Format('Expected %d parameters, got %d' , [aMinParNumber, lParNumber]))
|
|
else
|
|
Error(Format('Expected from %d to %d parameters, got %d', [aMinParNumber, aMaxParNumber, lParNumber]));
|
|
end;
|
|
end;
|
|
|
|
procedure TTProCompiler.InternalCompileIncludedTemplate(const aTemplate: string;
|
|
const aTokens: TList<TToken>; const aFileNameRefPath: String);
|
|
var
|
|
lCompiler: TTProCompiler;
|
|
begin
|
|
lCompiler := TTProCompiler.Create(fEncoding);
|
|
try
|
|
lCompiler.Compile(aTemplate, aTokens, aFileNameRefPath);
|
|
if aTokens[aTokens.Count - 1].TokenType <> ttEOF then
|
|
begin
|
|
Error('Included file ' + aFileNameRefPath + ' doesn''t terminate with EOF');
|
|
end;
|
|
aTokens.Delete(aTokens.Count - 1); // remove the EOF
|
|
finally
|
|
lCompiler.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TTProCompiler.InternalMatchFilter(lIdentifier: String; var lStartVerbatim: UInt64; const CurrToken: TTokenType; aTokens: TList<TToken>; const lRef2: Integer);
|
|
var
|
|
lFilterName: string;
|
|
lFilterParamsCount: Integer;
|
|
lFilterParams: TArray<String>;
|
|
I: Integer;
|
|
begin
|
|
lFilterName := '';
|
|
lFilterParamsCount := -1; {-1 means "no filter applied to value"}
|
|
if MatchSymbol('|') then
|
|
begin
|
|
if not MatchVariable(lFilterName) then
|
|
Error('Invalid function name applied to variable or literal string "' + lIdentifier + '"');
|
|
lFilterParams := GetFunctionParameters;
|
|
lFilterParamsCount := Length(lFilterParams);
|
|
end;
|
|
|
|
if not MatchEndTag then
|
|
begin
|
|
Error('Expected end tag "' + END_TAG + '" near ' + GetSubsequentText);
|
|
end;
|
|
lStartVerbatim := fCharIndex;
|
|
aTokens.Add(TToken.Create(CurrToken, lIdentifier, '', lFilterParamsCount, lRef2));
|
|
|
|
//add function with params
|
|
if not lFilterName.IsEmpty then
|
|
begin
|
|
aTokens.Add(TToken.Create(ttFilterName, lFilterName, '', lFilterParamsCount));
|
|
if lFilterParamsCount > 0 then
|
|
begin
|
|
for I := 0 to lFilterParamsCount -1 do
|
|
begin
|
|
aTokens.Add(TToken.Create(ttFilterParameter, lFilterParams[I], ''));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
|
|
constructor TTProCompiler.Create(aEncoding: TEncoding = nil);
|
|
begin
|
|
inherited Create;
|
|
if aEncoding = nil then
|
|
fEncoding := TEncoding.UTF8 { default encoding }
|
|
else
|
|
fEncoding := aEncoding;
|
|
end;
|
|
|
|
function TTProCompiler.CurrentChar: Char;
|
|
begin
|
|
Result := fInputString.Chars[fCharIndex];
|
|
end;
|
|
|
|
function TTProCompiler.MatchEndTag: Boolean;
|
|
begin
|
|
Result := MatchSymbol(END_TAG);
|
|
end;
|
|
|
|
function TTProCompiler.MatchVariable(var aIdentifier: string): Boolean;
|
|
var
|
|
lTmp: String;
|
|
begin
|
|
aIdentifier := '';
|
|
lTmp := '';
|
|
Result := False;
|
|
if CharInSet(fInputString.Chars[fCharIndex], IdenfierAllowedFirstChars) then
|
|
begin
|
|
lTmp := fInputString.Chars[fCharIndex];
|
|
Inc(fCharIndex);
|
|
if lTmp = '@' then
|
|
begin
|
|
if fInputString.Chars[fCharIndex] = '@' then
|
|
begin
|
|
lTmp := '@@';
|
|
Inc(fCharIndex);
|
|
end;
|
|
end;
|
|
|
|
while CharInSet(fInputString.Chars[fCharIndex], IdenfierAllowedChars) do
|
|
begin
|
|
lTmp := lTmp + fInputString.Chars[fCharIndex];
|
|
Inc(fCharIndex);
|
|
end;
|
|
Result := True;
|
|
aIdentifier := lTmp;
|
|
end;
|
|
if Result then
|
|
begin
|
|
while MatchSymbol('.') do
|
|
begin
|
|
lTmp := '';
|
|
if not MatchVariable(lTmp) then
|
|
begin
|
|
Error('Expected identifier after "' + aIdentifier + '" - got ' + GetSubsequentText);
|
|
end;
|
|
aIdentifier := aIdentifier + '.' + lTmp;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TTProCompiler.MatchFilterParamValue(var aParamValue: string): Boolean;
|
|
var
|
|
lTmp: String;
|
|
begin
|
|
lTmp := '';
|
|
Result := False;
|
|
if MatchString(aParamValue) then
|
|
begin
|
|
Result := True;
|
|
end;
|
|
if CharInSet(fInputString.Chars[fCharIndex], IdenfierAllowedChars) then
|
|
begin
|
|
while CharInSet(fInputString.Chars[fCharIndex], ValueAllowedChars) do
|
|
begin
|
|
lTmp := lTmp + fInputString.Chars[fCharIndex];
|
|
Inc(fCharIndex);
|
|
end;
|
|
Result := True;
|
|
aParamValue := lTmp.Trim;
|
|
end;
|
|
end;
|
|
|
|
function TTProCompiler.MatchSpace: Boolean;
|
|
begin
|
|
Result := MatchSymbol(' ');
|
|
while MatchSymbol(' ') do;
|
|
end;
|
|
|
|
function TTProCompiler.MatchStartTag: Boolean;
|
|
begin
|
|
Result := MatchSymbol(START_TAG);
|
|
end;
|
|
|
|
function TTProCompiler.MatchString(out aStringValue: String): Boolean;
|
|
begin
|
|
aStringValue := '';
|
|
Result := MatchSymbol('"');
|
|
if Result then
|
|
begin
|
|
while not MatchSymbol('"') do //no escape so far
|
|
begin
|
|
if CurrentChar = #0 then
|
|
begin
|
|
Error('Unclosed string at the end of file');
|
|
end;
|
|
aStringValue := aStringValue + CurrentChar;
|
|
Step;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TTProCompiler.MatchSymbol(const aSymbol: string): Boolean;
|
|
var
|
|
lSymbolIndex: Integer;
|
|
lSavedCharIndex: Int64;
|
|
lSymbolLength: Integer;
|
|
begin
|
|
if aSymbol.IsEmpty then
|
|
Exit(True);
|
|
lSavedCharIndex := fCharIndex;
|
|
lSymbolIndex := 0;
|
|
lSymbolLength := Length(aSymbol);
|
|
while (fInputString.Chars[fCharIndex] = aSymbol.Chars[lSymbolIndex]) and (lSymbolIndex < lSymbolLength) do
|
|
begin
|
|
Inc(fCharIndex);
|
|
Inc(lSymbolIndex);
|
|
end;
|
|
Result := (lSymbolIndex > 0) and (lSymbolIndex = lSymbolLength);
|
|
if not Result then
|
|
fCharIndex := lSavedCharIndex;
|
|
end;
|
|
|
|
function TTProCompiler.Step: Char;
|
|
begin
|
|
Inc(fCharIndex);
|
|
Result := CurrentChar;
|
|
end;
|
|
|
|
function TTProCompiler.Compile(const aTemplate: string; const aFileNameRefPath: String): ITProCompiledTemplate;
|
|
var
|
|
lTokens: TList<TToken>;
|
|
lFileNameRefPath: string;
|
|
begin
|
|
if aFileNameRefPath.IsEmpty then
|
|
begin
|
|
lFileNameRefPath := TPath.Combine(TPath.GetDirectoryName(GetModuleName(HInstance)), 'main.template');
|
|
end
|
|
else
|
|
begin
|
|
lFileNameRefPath := TPath.GetFullPath(aFileNameRefPath);
|
|
end;
|
|
fCurrentFileName := lFileNameRefPath;
|
|
lTokens := TList<TToken>.Create;
|
|
try
|
|
Compile(aTemplate, lTokens, fCurrentFileName);
|
|
Result := TTProCompiledTemplate.Create(lTokens);
|
|
except
|
|
lTokens.Free;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
procedure TTProCompiler.Compile(const aTemplate: string; const aTokens: TList<TToken>; const aFileNameRefPath: String);
|
|
var
|
|
lSectionStack: array [0..49] of Integer; //max 50 nested loops
|
|
lCurrentSectionIndex: Integer;
|
|
|
|
lIfStatementStack: array [0..49] of TIfThenElseIndex; //max 50 nested ifs
|
|
lCurrentIfIndex: Integer;
|
|
lLastToken: TTokenType;
|
|
lChar: Char;
|
|
lVarName: string;
|
|
lFuncName: string;
|
|
lIdentifier: string;
|
|
lIteratorName: string;
|
|
lStartVerbatim: UInt64;
|
|
lEndVerbatim: UInt64;
|
|
lIndexOfLatestIfStatement: UInt64;
|
|
lIndexOfLatestLoopStatement: Integer;
|
|
lIndexOfLatestElseStatement: Int64;
|
|
lNegation: Boolean;
|
|
lFuncParams: TArray<String>;
|
|
lFuncParamsCount: Integer;
|
|
I: Integer;
|
|
lIncludeFileContent: string;
|
|
lCurrentFileName: string;
|
|
lStringValue: string;
|
|
lRef2: Integer;
|
|
lContentOnThisLine: Integer;
|
|
begin
|
|
aTokens.Add(TToken.Create(ttSystemVersion, TEMPLATEPRO_VERSION, ''));
|
|
lLastToken := ttEOF;
|
|
lContentOnThisLine := 0;
|
|
fCurrentFileName := aFileNameRefPath;
|
|
fCharIndex := -1;
|
|
fCurrentLine := 1;
|
|
lCurrentIfIndex := -1;
|
|
lCurrentSectionIndex := -1;
|
|
fInputString := aTemplate;
|
|
lStartVerbatim := 0;
|
|
Step;
|
|
while fCharIndex <= fInputString.Length do
|
|
begin
|
|
lChar := CurrentChar;
|
|
if lChar = #0 then //eof
|
|
begin
|
|
lEndVerbatim := fCharIndex;
|
|
if lEndVerbatim - lStartVerbatim > 0 then
|
|
begin
|
|
lLastToken := ttContent;
|
|
aTokens.Add(TToken.Create(lLastToken, fInputString.Substring(lStartVerbatim, lEndVerbatim - lStartVerbatim), ''));
|
|
end;
|
|
aTokens.Add(TToken.Create(ttEOF, '', ''));
|
|
Break;
|
|
end;
|
|
|
|
if MatchSymbol(sLineBreak) then {linebreak}
|
|
begin
|
|
lEndVerbatim := fCharIndex - Length(sLineBreak);
|
|
if lEndVerbatim - lStartVerbatim > 0 then
|
|
begin
|
|
Inc(lContentOnThisLine);
|
|
aTokens.Add(TToken.Create(ttContent, fInputString.Substring(lStartVerbatim, lEndVerbatim - lStartVerbatim), ''));
|
|
end;
|
|
lStartVerbatim := fCharIndex;
|
|
if lLastToken = ttLineBreak then Inc(lContentOnThisLine);
|
|
lLastToken := ttLineBreak;
|
|
if lContentOnThisLine > 0 then
|
|
begin
|
|
aTokens.Add(TToken.Create(lLastToken, '', ''));
|
|
end;
|
|
Inc(fCurrentLine);
|
|
lContentOnThisLine := 0;
|
|
end else if MatchStartTag then {starttag}
|
|
begin
|
|
lEndVerbatim := fCharIndex - Length(START_TAG);
|
|
|
|
if lEndVerbatim - lStartVerbatim > 0 then
|
|
begin
|
|
lLastToken := ttContent;
|
|
aTokens.Add(TToken.Create(lLastToken, fInputString.Substring(lStartVerbatim, lEndVerbatim - lStartVerbatim), ''));
|
|
end;
|
|
|
|
if CurrentChar = START_TAG[1] then
|
|
begin
|
|
lLastToken := ttContent;
|
|
aTokens.Add(TToken.Create(lLastToken, START_TAG, ''));
|
|
Inc(fCharIndex);
|
|
lStartVerbatim := fCharIndex;
|
|
Continue;
|
|
end;
|
|
|
|
if CurrentChar = ':' then //variable
|
|
begin
|
|
Step;
|
|
if MatchVariable(lVarName) then {variable}
|
|
begin
|
|
if lVarName.IsEmpty then
|
|
Error('Invalid variable name');
|
|
lFuncName := '';
|
|
lFuncParamsCount := -1; {-1 means "no filter applied to value"}
|
|
lRef2 := IfThen(MatchSymbol('$'),1,-1); // {{value$}} means no escaping
|
|
MatchSpace;
|
|
if MatchSymbol('|') then
|
|
begin
|
|
MatchSpace;
|
|
if not MatchVariable(lFuncName) then
|
|
Error('Invalid function name applied to variable ' + lVarName);
|
|
MatchSpace;
|
|
lFuncParams := GetFunctionParameters;
|
|
lFuncParamsCount := Length(lFuncParams);
|
|
MatchSpace;
|
|
end;
|
|
|
|
if not MatchEndTag then
|
|
begin
|
|
Error('Expected end tag "' + END_TAG + '" near ' + GetSubsequentText);
|
|
end;
|
|
lStartVerbatim := fCharIndex;
|
|
lLastToken := ttValue;
|
|
aTokens.Add(TToken.Create(lLastToken, lVarName, '', lFuncParamsCount, lRef2));
|
|
Inc(lContentOnThisLine);
|
|
|
|
//add function with params
|
|
if not lFuncName.IsEmpty then
|
|
begin
|
|
aTokens.Add(TToken.Create(ttFilterName, lFuncName, '', lFuncParamsCount));
|
|
if lFuncParamsCount > 0 then
|
|
begin
|
|
for I := 0 to lFuncParamsCount -1 do
|
|
begin
|
|
aTokens.Add(TToken.Create(ttFilterParameter, lFuncParams[I], ''));
|
|
end;
|
|
end;
|
|
end;
|
|
end; //matchvariable
|
|
end
|
|
else
|
|
begin
|
|
// if MatchSymbol('loop') then {loop}
|
|
// begin
|
|
// if not MatchSymbol('(') then
|
|
// Error('Expected "("');
|
|
// if not MatchVariable(lIdentifier) then
|
|
// Error('Expected identifier after "loop("');
|
|
// if not MatchSymbol(')') then
|
|
// Error('Expected ")" after "' + lIdentifier + '"');
|
|
// if not MatchSpace then
|
|
// Error('Expected "space" after "loop(' + lIdentifier + ')');
|
|
// if not MatchSymbol('as') then
|
|
// Error('Expected "as" after "loop(' + lIdentifier + ')');
|
|
// if not MatchSpace then
|
|
// Error('Expected <space> after "loop(' + lIdentifier + ') - EXAMPLE: loop(' + lIdentifier + ') as myalias');
|
|
// if not MatchVariable(lIteratorName) then
|
|
// Error('Expected iterator name after "loop" - EXAMPLE: loop(' + lIdentifier + ') as myalias');
|
|
// if not MatchEndTag then
|
|
// Error('Expected closing tag for "loop(' + lIdentifier + ')"');
|
|
|
|
if MatchSymbol('for') then {loop}
|
|
begin
|
|
if not MatchSpace then
|
|
Error('Expected "space"');
|
|
if not MatchVariable(lIteratorName) then
|
|
Error('Expected iterator name after "for" - EXAMPLE: for iterator in iterable');
|
|
if not MatchSpace then
|
|
Error('Expected "space"');
|
|
if not MatchSymbol('in') then
|
|
Error('Expected "in" after "for" iterator');
|
|
if not MatchSpace then
|
|
Error('Expected "space"');
|
|
if not MatchVariable(lIdentifier) then
|
|
Error('Expected iterable "for"');
|
|
MatchSpace;
|
|
if not MatchEndTag then
|
|
Error('Expected closing tag for "for"');
|
|
|
|
// create another element in the sections stack
|
|
Inc(lCurrentSectionIndex);
|
|
lSectionStack[lCurrentSectionIndex] := aTokens.Count;
|
|
lLastToken := ttFor;
|
|
if lIdentifier = lIteratorName then
|
|
begin
|
|
Error('loop data source and its iterator cannot have the same name: ' + lIdentifier)
|
|
end;
|
|
aTokens.Add(TToken.Create(lLastToken, lIdentifier, lIteratorName));
|
|
lStartVerbatim := fCharIndex;
|
|
end else if MatchSymbol('endfor') then {endfor}
|
|
begin
|
|
if not MatchEndTag then
|
|
Error('Expected closing tag');
|
|
if lCurrentSectionIndex = -1 then
|
|
begin
|
|
Error('endfor without loop');
|
|
end;
|
|
lLastToken := ttEndFor;
|
|
aTokens.Add(TToken.Create(lLastToken, '', '', lSectionStack[lCurrentSectionIndex]));
|
|
|
|
// let the loop know where the endfor is
|
|
lIndexOfLatestLoopStatement := lSectionStack[lCurrentSectionIndex];
|
|
aTokens[lIndexOfLatestLoopStatement] :=
|
|
TToken.Create(ttFor,
|
|
aTokens[lIndexOfLatestLoopStatement].Value1,
|
|
aTokens[lIndexOfLatestLoopStatement].Value2,
|
|
aTokens.Count - 1);
|
|
|
|
Dec(lCurrentSectionIndex);
|
|
lStartVerbatim := fCharIndex;
|
|
end else if MatchSymbol('endif') then {endif}
|
|
begin
|
|
if lCurrentIfIndex = -1 then
|
|
begin
|
|
Error('"endif" without "if"');
|
|
end;
|
|
if not MatchEndTag then
|
|
begin
|
|
Error('Expected closing tag for "endif"');
|
|
end;
|
|
|
|
lLastToken := ttEndIf;
|
|
aTokens.Add(TToken.Create(lLastToken, '', ''));
|
|
|
|
// jumps handling...
|
|
lIndexOfLatestIfStatement := lIfStatementStack[lCurrentIfIndex].IfIndex;
|
|
|
|
//rewrite current "ifthen" references
|
|
aTokens[lIndexOfLatestIfStatement] :=
|
|
TToken.Create(ttIfThen,
|
|
aTokens[lIndexOfLatestIfStatement].Value1,
|
|
'',
|
|
aTokens[lIndexOfLatestIfStatement].Ref1,
|
|
aTokens.Count - 1); {ttIfThen.Ref2 points always to relative "endif"}
|
|
|
|
if aTokens[lIndexOfLatestIfStatement].Ref1 > -1 then
|
|
begin
|
|
lIndexOfLatestElseStatement := aTokens[lIndexOfLatestIfStatement].Ref1;
|
|
aTokens[lIndexOfLatestElseStatement] :=
|
|
TToken.Create(ttElse,
|
|
aTokens[lIndexOfLatestElseStatement].Value1,
|
|
'',
|
|
-1 {Ref1 is not used by ttElse},
|
|
aTokens.Count - 1); {ttIfThen.Ref2 points always to relative "endif"}
|
|
end;
|
|
|
|
Dec(lCurrentIfIndex);
|
|
lStartVerbatim := fCharIndex;
|
|
end else if MatchSymbol('if') then
|
|
begin
|
|
MatchSpace;
|
|
// if not MatchSymbol('(') then
|
|
// Error('Expected "("');
|
|
// MatchSpace;
|
|
lNegation := MatchSymbol('!');
|
|
MatchSpace;
|
|
if not MatchVariable(lIdentifier) then
|
|
Error('Expected identifier after "if"');
|
|
lFuncParamsCount := -1; {lFuncParamsCount = -1 means "no filter applied"}
|
|
lFuncName := '';
|
|
if MatchSymbol('|') then
|
|
begin
|
|
MatchSpace;
|
|
if not MatchVariable(lFuncName) then
|
|
Error('Invalid function name applied to variable ' + lVarName);
|
|
lFuncParams := GetFunctionParameters;
|
|
lFuncParamsCount := Length(lFuncParams);
|
|
end;
|
|
MatchSpace;
|
|
// if not MatchSymbol(')') then
|
|
// Error('Expected ")" after "' + lIdentifier + '"');
|
|
// MatchSpace;
|
|
if not MatchEndTag then
|
|
Error('Expected closing tag for "if"');
|
|
if lNegation then
|
|
begin
|
|
lIdentifier := '!' + lIdentifier;
|
|
end;
|
|
lLastToken := ttIfThen;
|
|
aTokens.Add(TToken.Create(lLastToken, '' {lIdentifier}, ''));
|
|
Inc(lCurrentIfIndex);
|
|
lIfStatementStack[lCurrentIfIndex].IfIndex := aTokens.Count - 1;
|
|
lIfStatementStack[lCurrentIfIndex].ElseIndex := -1;
|
|
lStartVerbatim := fCharIndex;
|
|
|
|
lLastToken := ttBoolExpression;
|
|
aTokens.Add(TToken.Create(lLastToken, lIdentifier, '', lFuncParamsCount, -1 {no html escape}));
|
|
|
|
//add function with params
|
|
if not lFuncName.IsEmpty then
|
|
begin
|
|
aTokens.Add(TToken.Create(ttFilterName, lFuncName, '', lFuncParamsCount));
|
|
if lFuncParamsCount > 0 then
|
|
begin
|
|
for I := 0 to lFuncParamsCount -1 do
|
|
begin
|
|
aTokens.Add(TToken.Create(ttFilterParameter, lFuncParams[I], ''));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
end else if MatchSymbol('else') then
|
|
begin
|
|
if not MatchEndTag then
|
|
Error('Expected closing tag for "else"');
|
|
|
|
lLastToken := ttElse;
|
|
aTokens.Add(TToken.Create(lLastToken, '', ''));
|
|
|
|
// jumps handling...
|
|
lIndexOfLatestIfStatement := lIfStatementStack[lCurrentIfIndex].IfIndex;
|
|
lIfStatementStack[lCurrentIfIndex].ElseIndex := aTokens.Count - 1;
|
|
aTokens[lIndexOfLatestIfStatement] := TToken.Create(ttIfThen,
|
|
aTokens[lIndexOfLatestIfStatement].Value1,
|
|
'',
|
|
lIfStatementStack[lCurrentIfIndex].ElseIndex, {ttIfThen.Ref1 points always to relative else (if present otherwise -1)}
|
|
-1);
|
|
lStartVerbatim := fCharIndex;
|
|
end
|
|
else if MatchSymbol('include') then {include}
|
|
begin
|
|
if not MatchSpace then
|
|
Error('Expected "space" after "include"');
|
|
|
|
{In a future version we could implement a function call}
|
|
if not MatchString(lStringValue) then
|
|
begin
|
|
Error('Expected string after "include"');
|
|
end;
|
|
|
|
MatchSpace;
|
|
|
|
if not MatchEndTag then
|
|
Error('Expected closing tag for "include"');
|
|
|
|
// create another element in the sections stack
|
|
try
|
|
if TDirectory.Exists(aFileNameRefPath) then
|
|
begin
|
|
lCurrentFileName := TPath.GetFullPath(TPath.Combine(aFileNameRefPath, lStringValue));
|
|
end
|
|
else
|
|
begin
|
|
lCurrentFileName := TPath.GetFullPath(TPath.Combine(TPath.GetDirectoryName(aFileNameRefPath), lStringValue));
|
|
end;
|
|
lIncludeFileContent := TFile.ReadAllText(lCurrentFileName, fEncoding);
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
Error('Cannot read "' + lStringValue + '"');
|
|
end;
|
|
end;
|
|
Inc(lContentOnThisLine);
|
|
InternalCompileIncludedTemplate(lIncludeFileContent, aTokens, lCurrentFileName);
|
|
lStartVerbatim := fCharIndex;
|
|
end
|
|
else if MatchSymbol('exit') then {exit}
|
|
begin
|
|
lLastToken := ttEOF;
|
|
aTokens.Add(TToken.Create(lLastToken, '', ''));
|
|
Break;
|
|
end
|
|
else if MatchString(lStringValue) then {string}
|
|
begin
|
|
lLastToken := ttLiteralString;
|
|
Inc(lContentOnThisLine);
|
|
lRef2 := IfThen(MatchSymbol('$'),1,-1); // {{value$}} means no escaping
|
|
MatchSpace;
|
|
InternalMatchFilter(lStringValue, lStartVerbatim, ttLiteralString, aTokens, lRef2);
|
|
end
|
|
else if MatchSymbol('#') then
|
|
begin
|
|
while not MatchEndTag do
|
|
begin
|
|
Step;
|
|
end;
|
|
lStartVerbatim := fCharIndex;
|
|
lLastToken := ttComment; {will not added into compiled template}
|
|
end
|
|
else
|
|
begin
|
|
lIdentifier := GetSubsequentText;
|
|
Error('Expected command, got "' + lIdentifier + '"');
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
Step;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function CapitalizeString(const s: string; const CapitalizeFirst: Boolean): string;
|
|
const
|
|
ALLOWEDCHARS = ['a' .. 'z', '_'];
|
|
var
|
|
index: Integer;
|
|
bCapitalizeNext: Boolean;
|
|
begin
|
|
bCapitalizeNext := CapitalizeFirst;
|
|
Result := lowercase(s);
|
|
if Result <> EmptyStr then
|
|
begin
|
|
for index := 1 to Length(Result) do
|
|
begin
|
|
if bCapitalizeNext then
|
|
begin
|
|
Result[index] := UpCase(Result[index]);
|
|
bCapitalizeNext := False;
|
|
end
|
|
else if not CharInSet(Result[index], ALLOWEDCHARS) then
|
|
begin
|
|
bCapitalizeNext := True;
|
|
end;
|
|
end; // for
|
|
end; // if
|
|
end;
|
|
|
|
procedure TTProCompiler.Error(const aMessage: string);
|
|
begin
|
|
raise ETProCompilerException.CreateFmt('%s - at line %d in file %s', [aMessage, fCurrentLine, fCurrentFileName]);
|
|
end;
|
|
|
|
function TTProCompiler.GetFunctionParameters: TArray<String>;
|
|
var
|
|
lFuncPar: string;
|
|
begin
|
|
Result := [];
|
|
while MatchSymbol(',') do
|
|
begin
|
|
lFuncPar := '';
|
|
MatchSpace;
|
|
if not MatchFilterParamValue(lFuncPar) then
|
|
Error('Expected function parameter');
|
|
Result := Result + [lFuncPar];
|
|
MatchSpace;
|
|
end;
|
|
end;
|
|
|
|
function TTProCompiler.GetSubsequentText: String;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := CurrentChar;
|
|
Step;
|
|
I := 0;
|
|
while (CurrentChar <> #0) and (CurrentChar <> END_TAG[1]) and (I<20) do
|
|
begin
|
|
Result := Result + CurrentChar;
|
|
Step;
|
|
Inc(I);
|
|
end;
|
|
Result := Result.QuotedString('"');
|
|
end;
|
|
|
|
procedure TTProCompiledTemplate.CheckParNumber(const aHowManyPars: Integer; const aParameters: TArray<string>);
|
|
begin
|
|
CheckParNumber(aHowManyPars, aHowManyPars, aParameters);
|
|
end;
|
|
|
|
function TTProCompiledTemplate.ExecuteFilter(aFunctionName: string; aParameters: TArray<string>;
|
|
aValue: TValue): TValue;
|
|
var
|
|
lDateValue: TDateTime;
|
|
lStrValue: string;
|
|
lFunc: TTProTemplateFunction;
|
|
lFormatSettings: TFormatSettings;
|
|
procedure FunctionError(const ErrMessage: string);
|
|
begin
|
|
Error(Format('%s in function %s', [ErrMessage, aFunctionName]));
|
|
end;
|
|
begin
|
|
aFunctionName := lowercase(aFunctionName);
|
|
if aFunctionName = 'uppercase' then
|
|
begin
|
|
Result := UpperCase(aValue.AsString);
|
|
end else if aFunctionName = 'lowercase' then
|
|
begin
|
|
Result := lowercase(aValue.AsString);
|
|
end else if aFunctionName = 'capitalize' then
|
|
begin
|
|
Result := CapitalizeString(aValue.AsString, True);
|
|
end else if aFunctionName = 'rpad' then
|
|
begin
|
|
if aValue.IsType<Integer> then
|
|
lStrValue := aValue.AsInteger.ToString
|
|
else if aValue.IsType<string> then
|
|
lStrValue := aValue.AsString
|
|
else
|
|
FunctionError('Invalid parameter/s');
|
|
|
|
CheckParNumber(1, 2, aParameters);
|
|
if Length(aParameters) = 1 then
|
|
begin
|
|
Result := lStrValue.PadRight(aParameters[0].ToInteger);
|
|
end
|
|
else
|
|
begin
|
|
Result := lStrValue.PadRight(aParameters[0].ToInteger, aParameters[1].Chars[0]);
|
|
end;
|
|
end else if aFunctionName = 'lpad' then
|
|
begin
|
|
if aValue.IsType<Integer> then
|
|
lStrValue := aValue.AsInteger.ToString
|
|
else if aValue.IsType<string> then
|
|
lStrValue := aValue.AsString
|
|
else
|
|
FunctionError('Invalid parameter/s');
|
|
|
|
CheckParNumber(1, 2, aParameters);
|
|
if Length(aParameters) = 1 then
|
|
begin
|
|
Result := lStrValue.PadLeft(aParameters[0].ToInteger);
|
|
end
|
|
else
|
|
begin
|
|
Result := lStrValue.PadLeft(aParameters[0].ToInteger, aParameters[1].Chars[0]);
|
|
end;
|
|
end else if aFunctionName = 'datetostr' then
|
|
begin
|
|
if aValue.IsEmpty then
|
|
begin
|
|
Result := '';
|
|
end else if aValue.TryAsType<TDateTime>(lDateValue) then
|
|
begin
|
|
if Length(aParameters) = 0 then
|
|
begin
|
|
Result := DateToStr(lDateValue)
|
|
end
|
|
else
|
|
begin
|
|
CheckParNumber(1, aParameters);
|
|
lFormatSettings.ShortDateFormat := aParameters[0];
|
|
Result := DateToStr(lDateValue, lFormatSettings)
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
FunctionError('Invalid date ' + aValue.AsString.QuotedString);
|
|
end;
|
|
end else if (aFunctionName = 'datetimetostr') or (aFunctionName = 'formatdatetime') then
|
|
begin
|
|
if aValue.IsEmpty then
|
|
begin
|
|
Result := '';
|
|
end else if aValue.TryAsType<TDateTime>(lDateValue) then
|
|
begin
|
|
if Length(aParameters) = 0 then
|
|
Result := DateTimeToStr(lDateValue)
|
|
else
|
|
begin
|
|
CheckParNumber(1, aParameters);
|
|
Result := FormatDateTime(aParameters[0], lDateValue);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
FunctionError('Invalid datetime ' + aValue.AsString.QuotedString);
|
|
end;
|
|
end else if aFunctionName = 'empty' then
|
|
begin
|
|
CheckParNumber(0, aParameters);
|
|
Result := TValue.Empty;
|
|
end else if fTemplateFunctions.TryGetValue(aFunctionName, lFunc) then
|
|
begin
|
|
Result := lFunc(aValue, aParameters);
|
|
end
|
|
else
|
|
begin
|
|
Error(Format('Unknown function [%s]', [aFunctionName]));
|
|
end;
|
|
end;
|
|
|
|
function HTMLEncode(s: string): string;
|
|
begin
|
|
Result := HTMLSpecialCharsEncode(s);
|
|
end;
|
|
|
|
function HTMLSpecialCharsEncode(s: string): string;
|
|
var
|
|
I: Integer;
|
|
r: string;
|
|
begin
|
|
I := 1;
|
|
while I <= Length(s) do
|
|
begin
|
|
r := '';
|
|
case ord(s[I]) of
|
|
Ord('>'):
|
|
r := 'gt';
|
|
Ord('<'):
|
|
r := 'lt';
|
|
160:
|
|
r := 'nbsp';
|
|
161:
|
|
r := 'excl';
|
|
162:
|
|
r := 'cent';
|
|
163:
|
|
r := 'ound';
|
|
164:
|
|
r := 'curren';
|
|
165:
|
|
r := 'yen';
|
|
166:
|
|
r := 'brvbar';
|
|
167:
|
|
r := 'sect';
|
|
168:
|
|
r := 'uml';
|
|
169:
|
|
r := 'copy';
|
|
170:
|
|
r := 'ordf';
|
|
171:
|
|
r := 'laquo';
|
|
172:
|
|
r := 'not';
|
|
173:
|
|
r := 'shy';
|
|
174:
|
|
r := 'reg';
|
|
175:
|
|
r := 'macr';
|
|
176:
|
|
r := 'deg';
|
|
177:
|
|
r := 'plusmn';
|
|
178:
|
|
r := 'sup2';
|
|
179:
|
|
r := 'sup3';
|
|
180:
|
|
r := 'acute';
|
|
181:
|
|
r := 'micro';
|
|
182:
|
|
r := 'para';
|
|
183:
|
|
r := 'middot';
|
|
184:
|
|
r := 'cedil';
|
|
185:
|
|
r := 'sup1';
|
|
186:
|
|
r := 'ordm';
|
|
187:
|
|
r := 'raquo';
|
|
188:
|
|
r := 'frac14';
|
|
189:
|
|
r := 'frac12';
|
|
190:
|
|
r := 'frac34';
|
|
191:
|
|
r := 'iquest';
|
|
192:
|
|
r := 'Agrave';
|
|
193:
|
|
r := 'Aacute';
|
|
194:
|
|
r := 'Acirc';
|
|
195:
|
|
r := 'Atilde';
|
|
196:
|
|
r := 'Auml';
|
|
197:
|
|
r := 'Aring';
|
|
198:
|
|
r := 'AElig';
|
|
199:
|
|
r := 'Ccedil';
|
|
200:
|
|
r := 'Egrave';
|
|
201:
|
|
r := 'Eacute';
|
|
202:
|
|
r := 'Ecirc';
|
|
203:
|
|
r := 'Euml';
|
|
204:
|
|
r := 'Igrave';
|
|
205:
|
|
r := 'Iacute';
|
|
206:
|
|
r := 'Icirc';
|
|
207:
|
|
r := 'Iuml';
|
|
208:
|
|
r := 'ETH';
|
|
209:
|
|
r := 'Ntilde';
|
|
210:
|
|
r := 'Ograve';
|
|
211:
|
|
r := 'Oacute';
|
|
212:
|
|
r := 'Ocirc';
|
|
213:
|
|
r := 'Otilde';
|
|
214:
|
|
r := 'Ouml';
|
|
215:
|
|
r := 'times';
|
|
216:
|
|
r := 'Oslash';
|
|
217:
|
|
r := 'Ugrave';
|
|
218:
|
|
r := 'Uacute';
|
|
219:
|
|
r := 'Ucirc';
|
|
220:
|
|
r := 'Uuml';
|
|
221:
|
|
r := 'Yacute';
|
|
222:
|
|
r := 'THORN';
|
|
223:
|
|
r := 'szlig';
|
|
224:
|
|
r := 'agrave';
|
|
225:
|
|
r := 'aacute';
|
|
226:
|
|
r := 'acirc';
|
|
227:
|
|
r := 'atilde';
|
|
228:
|
|
r := 'auml';
|
|
229:
|
|
r := 'aring';
|
|
230:
|
|
r := 'aelig';
|
|
231:
|
|
r := 'ccedil';
|
|
232:
|
|
r := 'egrave';
|
|
233:
|
|
r := 'eacute';
|
|
234:
|
|
r := 'ecirc';
|
|
235:
|
|
r := 'euml';
|
|
236:
|
|
r := 'igrave';
|
|
237:
|
|
r := 'iacute';
|
|
238:
|
|
r := 'icirc';
|
|
239:
|
|
r := 'iuml';
|
|
240:
|
|
r := 'eth';
|
|
241:
|
|
r := 'ntilde';
|
|
242:
|
|
r := 'ograve';
|
|
243:
|
|
r := 'oacute';
|
|
244:
|
|
r := 'ocirc';
|
|
245:
|
|
r := 'otilde';
|
|
246:
|
|
r := 'ouml';
|
|
247:
|
|
r := 'divide';
|
|
248:
|
|
r := 'oslash';
|
|
249:
|
|
r := 'ugrave';
|
|
250:
|
|
r := 'uacute';
|
|
251:
|
|
r := 'ucirc';
|
|
252:
|
|
r := 'uuml';
|
|
253:
|
|
r := 'yacute';
|
|
254:
|
|
r := 'thorn';
|
|
255:
|
|
r := 'yuml';
|
|
end;
|
|
if r <> '' then
|
|
begin
|
|
s := s.Replace(s[I], '&' + r + ';');
|
|
Inc(I, Length(r) + 1);
|
|
end;
|
|
Inc(I)
|
|
end;
|
|
Result := s;
|
|
end;
|
|
|
|
{ TToken }
|
|
|
|
class function TToken.Create(TokType: TTokenType; Value1, Value2: String; Ref1: Int64; Ref2: Int64): TToken;
|
|
begin
|
|
Result.TokenType:= TokType;
|
|
Result.Value1 := Value1;
|
|
Result.Value2 := Value2;
|
|
Result.Ref1 := Ref1;
|
|
Result.Ref2 := Ref2;
|
|
end;
|
|
|
|
class function TToken.CreateFromBytes(const aBytes: TBinaryReader): TToken;
|
|
var
|
|
//lSize: UInt32;
|
|
lValue1Size: UInt32;
|
|
lValue2Size: UInt32;
|
|
lTokenAsByte: Byte;
|
|
begin
|
|
{
|
|
STORAGE FORMAT
|
|
|
|
Bytes
|
|
0: Total record size as UInt32
|
|
1: Token Type as Byte
|
|
2: Value1 Size in bytes as UInt32
|
|
3: Value1 bytes
|
|
4: Value2 Size in bytes as UInt32
|
|
5: Value2 bytes
|
|
6: Ref1 (8 bytes) in bytes - Int64
|
|
7: Ref1 (8 bytes) in bytes - Int64
|
|
}
|
|
|
|
//lSize := aBytes.ReadUInt32;
|
|
lTokenAsByte := aBytes.ReadByte;
|
|
Result.TokenType := TTokenType(lTokenAsByte);
|
|
lValue1Size := aBytes.ReadUInt32;
|
|
Result.Value1 := TEncoding.Unicode.GetString(aBytes.ReadBytes(lValue1Size));
|
|
|
|
lValue2Size := aBytes.ReadUInt32;
|
|
Result.Value2 := TEncoding.Unicode.GetString(aBytes.ReadBytes(lValue2Size));
|
|
|
|
Result.Ref1 := aBytes.ReadInt64;
|
|
Result.Ref2 := aBytes.ReadInt64;
|
|
end;
|
|
|
|
procedure TToken.SaveToBytes(const aBytes: TBinaryWriter);
|
|
var
|
|
// lSize: UInt32;
|
|
lValue1Bytes: TArray<Byte>;
|
|
lValue2Bytes: TArray<Byte>;
|
|
lValue1Length: UInt32;
|
|
lValue2Length: UInt32;
|
|
lTokenAsByte: Byte;
|
|
begin
|
|
|
|
// lSize :=
|
|
// SizeOf(UInt32) + {total record size}
|
|
// 1 + //Token Type as Byte
|
|
// 4 + //Value1 Size in bytes as UInt32
|
|
// Length(Value1) * SizeOf(Char) + //value1 bytes
|
|
// 4 + //Value2 Size in bytes as UInt32
|
|
// Length(Value2) * SizeOf(Char) + //value2 bytes
|
|
// 8 + //ref1
|
|
// 8; //ref2
|
|
//aBytes.Write(lSize);
|
|
|
|
lTokenAsByte := Byte(TokenType);
|
|
aBytes.Write(lTokenAsByte);
|
|
|
|
lValue1Bytes := TEncoding.Unicode.GetBytes(Value1);
|
|
lValue1Length := UInt16(Length(lValue1Bytes));
|
|
aBytes.Write(lValue1Length);
|
|
aBytes.Write(lValue1Bytes);
|
|
|
|
lValue2Bytes := TEncoding.Unicode.GetBytes(Value2);
|
|
lValue2Length := UInt16(Length(lValue2Bytes));
|
|
aBytes.Write(lValue2Length);
|
|
aBytes.Write(lValue2Bytes);
|
|
|
|
aBytes.Write(Ref1);
|
|
|
|
aBytes.Write(Ref2);
|
|
end;
|
|
|
|
function TToken.TokenTypeAsString: String;
|
|
begin
|
|
Result := TOKEN_TYPE_DESCR[self.TokenType];
|
|
end;
|
|
|
|
function TToken.ToString: String;
|
|
begin
|
|
Result := Format('%15s | Ref1: %8d | Ref2: %8d | Val1: %-20s| Val2: %-20s',[TokenTypeAsString, Ref1, Ref2, Value1, Value2]);
|
|
end;
|
|
|
|
{ TTProCompiledTemplate }
|
|
|
|
constructor TTProCompiledTemplate.Create(Tokens: TList<TToken>);
|
|
begin
|
|
inherited Create;
|
|
fLoopsStack := TObjectList<TLoopStackItem>.Create(True);
|
|
fTokens := Tokens;
|
|
fTemplateFunctions := TDictionary<string, TTProTemplateFunction>.Create;
|
|
TTProConfiguration.RegisterHandlers(Self);
|
|
end;
|
|
|
|
class function TTProCompiledTemplate.CreateFromFile(
|
|
const FileName: String): ITProCompiledTemplate;
|
|
var
|
|
lBR: TBinaryReader;
|
|
lTokens: TList<TToken>;
|
|
begin
|
|
lBR := TBinaryReader.Create(TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone), nil, True);
|
|
try
|
|
lTokens := TList<TToken>.Create;
|
|
try
|
|
try
|
|
while True do
|
|
begin
|
|
lTokens.Add(TToken.CreateFromBytes(lBR));
|
|
if lTokens.Last.TokenType = ttEOF then
|
|
begin
|
|
Break;
|
|
end;
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
raise ETProRenderException.CreateFmt('Cannot load compiled template from [FILE: %s][CLASS: %s][MSG: %s] - consider to delete templates cache.',
|
|
[FileName, E.ClassName, E.Message])
|
|
end;
|
|
end;
|
|
Result := TTProCompiledTemplate.Create(lTokens);
|
|
except
|
|
lTokens.Free;
|
|
raise;
|
|
end;
|
|
finally
|
|
lBR.Free;
|
|
end;
|
|
end;
|
|
|
|
destructor TTProCompiledTemplate.Destroy;
|
|
begin
|
|
fLoopsStack.Free;
|
|
fTemplateFunctions.Free;
|
|
fTokens.Free;
|
|
fVariables.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TTProCompiledTemplate.DoOnGetValue(const DataSource, Members: string;
|
|
var Value: TValue; var Handled: Boolean);
|
|
begin
|
|
Handled := False;
|
|
if Assigned(fOnGetValue) then
|
|
begin
|
|
fOnGetValue(DataSource, Members, Value, Handled);
|
|
end;
|
|
end;
|
|
|
|
procedure TTProCompiledTemplate.DumpToFile(const FileName: String);
|
|
var
|
|
lToken: TToken;
|
|
lSW: TStreamWriter;
|
|
lIdx: UInt64;
|
|
begin
|
|
lSW := TStreamWriter.Create(FileName);
|
|
try
|
|
lIdx := 0;
|
|
for lToken in fTokens do
|
|
begin
|
|
lSW.WriteLine('%5d %s', [lIdx, lToken.ToString]);
|
|
Inc(lIdx);
|
|
end;
|
|
finally
|
|
lSW.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TTProCompiledTemplate.Error(const aMessage: String);
|
|
begin
|
|
raise ETProRenderException.Create(aMessage);
|
|
end;
|
|
|
|
procedure TTProCompiledTemplate.ForEachToken(
|
|
const TokenProc: TTokenWalkProc);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to fTokens.Count - 1 do
|
|
begin
|
|
TokenProc(I, fTokens[I]);
|
|
end;
|
|
end;
|
|
|
|
function TTProCompiledTemplate.Render: String;
|
|
var
|
|
lIdx: UInt64;
|
|
lBuff: TStringBuilder;
|
|
lDataSourceName: string;
|
|
lVariable: TVarDataSource;
|
|
lWrapped: ITProWrappedList;
|
|
lJumpTo: Integer;
|
|
lVarName: string;
|
|
lVarValue: TValue;
|
|
lJArr: TJDOJsonArray;
|
|
lJObj: TJDOJsonObject;
|
|
lVarMember: string;
|
|
lBaseVarName: string;
|
|
lFullPath: string;
|
|
lForLoopItem: TLoopStackItem;
|
|
lJValue: TJsonDataValueHelper;
|
|
lMustBeEncoded: Boolean;
|
|
lSavedIdx: UInt64;
|
|
begin
|
|
lBuff := TStringBuilder.Create;
|
|
try
|
|
lIdx := 0;
|
|
while fTokens[lIdx].TokenType <> ttEOF do
|
|
begin
|
|
//Writeln(fTokens[lIdx].ToString);
|
|
case fTokens[lIdx].TokenType of
|
|
ttContent: begin
|
|
lBuff.Append(fTokens[lIdx].Value1);
|
|
end;
|
|
ttFor: begin
|
|
lForLoopItem := PeekLoop;
|
|
if LoopStackIsEmpty or (lForLoopItem.LoopExpression <> fTokens[lIdx].Value1) then
|
|
begin //push a new loop stack item
|
|
SplitVariableName(fTokens[lIdx].Value1, lVarName, lVarMember);
|
|
{lVarName maybe an iterator, so I've to walk the stack to know
|
|
the real information about the iterator}
|
|
if WalkThroughLoopStack(lVarName, lBaseVarName, lFullPath) then
|
|
begin
|
|
lFullPath := lFullPath + '.' + lVarMember;
|
|
PushLoop(TLoopStackItem.Create(lBaseVarName, fTokens[lIdx].Value1, lFullPath, fTokens[lIdx].Value2));
|
|
end
|
|
else
|
|
begin
|
|
PushLoop(TLoopStackItem.Create(lVarName, fTokens[lIdx].Value1, lVarMember, fTokens[lIdx].Value2));
|
|
end;
|
|
end;
|
|
lForLoopItem := PeekLoop;
|
|
|
|
// Now, work with the stack head
|
|
if GetVariables.TryGetValue(PeekLoop.DataSourceName, lVariable) then
|
|
begin
|
|
if lForLoopItem.FullPath.IsEmpty then
|
|
begin
|
|
if not (viIterable in lVariable.VarOption) then
|
|
begin
|
|
Error(Format('Cannot iterate over a not iterable object [%s]', [fTokens[lIdx].Value1]));
|
|
end;
|
|
end;
|
|
|
|
if viDataSet in lVariable.VarOption then
|
|
begin
|
|
if lForLoopItem.IteratorPosition = -1 then
|
|
begin
|
|
TDataset(lVariable.VarValue.AsObject).First;
|
|
end;
|
|
|
|
if TDataset(lVariable.VarValue.AsObject).Eof then
|
|
begin
|
|
lIdx := fTokens[lIdx].Ref1; //skip to endfor
|
|
Continue;
|
|
end
|
|
end else if viListOfObject in lVariable.VarOption then
|
|
begin
|
|
lWrapped := WrapAsList(lVariable.VarValue.AsObject);
|
|
//if lVariable.VarIterator = lWrapped.Count - 1 then
|
|
if lForLoopItem.IteratorPosition = lWrapped.Count - 1 then
|
|
begin
|
|
lIdx := fTokens[lIdx].Ref1; //skip to endif
|
|
Continue;
|
|
end
|
|
else
|
|
begin
|
|
PeekLoop.IncrementIteratorPosition; // lVariable.VarIterator := lVariable.VarIterator + 1;
|
|
end;
|
|
end else if viJSONObject in lVariable.VarOption then
|
|
begin
|
|
lJObj := TJDOJsonObject(lVariable.VarValue.AsObject);
|
|
lForLoopItem := PeekLoop;
|
|
lJValue := lJObj.Path[lForLoopItem.FullPath];
|
|
|
|
case lJValue.Typ of
|
|
jdtNone: begin
|
|
lIdx := fTokens[lIdx].Ref1; //skip to endfor
|
|
Continue;
|
|
end;
|
|
|
|
jdtArray: begin
|
|
if lForLoopItem.IteratorPosition = lJObj.Path[lForLoopItem.FullPath].ArrayValue.Count - 1 then
|
|
begin
|
|
lIdx := fTokens[lIdx].Ref1; //skip to endfor
|
|
Continue;
|
|
end
|
|
else
|
|
begin
|
|
lForLoopItem.IncrementIteratorPosition;
|
|
end;
|
|
end;
|
|
|
|
else
|
|
begin
|
|
Error('Only JSON array can be iterated');
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
Error('Iteration not allowed for "' + fTokens[lIdx].Value1 + '"');
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
Error(Format('Unknown variable in for..in statement [%s]', [fTokens[lIdx].Value1]));
|
|
end;
|
|
end;
|
|
ttEndFor: begin
|
|
if LoopStackIsEmpty then
|
|
begin
|
|
raise ETProRenderException.Create('Inconsistent "endfor"');
|
|
end;
|
|
|
|
lForLoopItem := PeekLoop;
|
|
lDataSourceName := lForLoopItem.DataSourceName;
|
|
if GetVariables.TryGetValue(lDataSourceName, lVariable) then
|
|
begin
|
|
if viDataSet in lVariable.VarOption then
|
|
begin
|
|
TDataset(lVariable.VarValue.AsObject).Next;
|
|
lForLoopItem.IteratorPosition := TDataset(lVariable.VarValue.AsObject).RecNo;
|
|
if not TDataset(lVariable.VarValue.AsObject).Eof then
|
|
begin
|
|
lIdx := fTokens[lIdx].Ref1; //goto loop
|
|
Continue;
|
|
end
|
|
else
|
|
begin
|
|
PopLoop;
|
|
end;
|
|
end
|
|
else if viJSONObject in lVariable.VarOption then
|
|
begin
|
|
lJObj := TJDOJsonObject(lVariable.VarValue.AsObject);
|
|
lJArr := lJObj.Path[lForLoopItem.FullPath];
|
|
if lForLoopItem.IteratorPosition < lJArr.Count - 1 then
|
|
begin
|
|
lIdx := fTokens[lIdx].Ref1; //skip to loop
|
|
Continue;
|
|
end
|
|
else
|
|
begin
|
|
PopLoop;
|
|
end;
|
|
end
|
|
else if viListOfObject in lVariable.VarOption then
|
|
begin
|
|
lWrapped := TTProDuckTypedList.Wrap(lVariable.VarValue.AsObject);
|
|
if lForLoopItem.IteratorPosition < lWrapped.Count - 1 then
|
|
begin
|
|
lIdx := fTokens[lIdx].Ref1; //skip to loop
|
|
Continue;
|
|
end
|
|
else
|
|
begin
|
|
PopLoop;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
ttIfThen: begin
|
|
lSavedIdx := lIdx;
|
|
if EvaluateIfExpressionAt(lIdx) then
|
|
begin
|
|
//do nothing
|
|
end
|
|
else
|
|
begin
|
|
lIdx := lSavedIdx;
|
|
if fTokens[lIdx].Ref1 > -1 then {there is an else}
|
|
begin
|
|
lJumpTo := fTokens[lIdx].Ref1 + 1;
|
|
//jump to the statement "after" ttElse (if it is ttLineBreak, jump it)
|
|
if fTokens[lJumpTo].TokenType <> ttLineBreak then
|
|
lIdx := lJumpTo
|
|
else
|
|
lIdx := lJumpTo + 1;
|
|
Continue;
|
|
end;
|
|
lIdx := fTokens[lIdx].Ref2; //jump to "endif"
|
|
Continue;
|
|
end;
|
|
end;
|
|
ttElse: begin
|
|
//always jump to ttEndIf which it reference is at ttElse.Ref2
|
|
lIdx := fTokens[lIdx].Ref2;
|
|
Continue;
|
|
end;
|
|
ttEndIf, ttStartTag, ttEndTag: begin end;
|
|
ttInclude:
|
|
begin
|
|
Error('Invalid token in RENDER phase: ttInclude');
|
|
end;
|
|
ttBoolExpression:
|
|
begin
|
|
Error('Token ttBoolExpression cannot be at first RENDER level, should be handled by ttIfThen TOKEN');
|
|
end;
|
|
ttValue, ttLiteralString: begin
|
|
lVarValue := EvaluateValue(lIdx, lMustBeEncoded {must be encoded});
|
|
|
|
// // Ref1 contains the optional filter parameter number (-1 if there isn't any filter)
|
|
// // Ref2 is -1 if the variable must be HTMLEncoded, while contains 1 is the value must not be HTMLEncoded
|
|
// lRef2 := fTokens[lIdx].Ref2;
|
|
// lCurrTokenType := fTokens[lIdx].TokenType;
|
|
// if fTokens[lIdx].Ref1 > -1 {has a filter with Ref1 parameters} then
|
|
// begin
|
|
// lVarName := fTokens[lIdx].Value1;
|
|
// Inc(lIdx);
|
|
// lFilterName := fTokens[lIdx].Value1;
|
|
// lFilterParCount := fTokens[lIdx].Ref1; // parameter count
|
|
// SetLength(lFilterParameters, lFilterParCount);
|
|
// for I := 0 to lFilterParCount - 1 do
|
|
// begin
|
|
// Inc(lIdx);
|
|
// Assert(fTokens[lIdx].TokenType = ttFilterParameter);
|
|
// lFilterParameters[I] := fTokens[lIdx].Value1;
|
|
// end;
|
|
// if lCurrTokenType = ttValue then
|
|
// begin
|
|
// lVarValue := ExecuteFilter(lFilterName, lFilterParameters, GetVarAsTValue(lVarName));
|
|
// end
|
|
// else
|
|
// begin
|
|
// lVarValue := ExecuteFilter(lFilterName, lFilterParameters, lVarName);
|
|
// end;
|
|
// end
|
|
// else
|
|
// begin
|
|
// if lCurrTokenType = ttValue then
|
|
// begin
|
|
// lVarValue := GetVarAsString(fTokens[lIdx].Value1);
|
|
// end
|
|
// else
|
|
// begin
|
|
// lVarValue := fTokens[lIdx].Value1;
|
|
// end;
|
|
// end;
|
|
|
|
if lMustBeEncoded {lRef2 = -1 // encoded} then
|
|
lBuff.Append(HTMLEncode(lVarValue.ToString))
|
|
else
|
|
lBuff.Append(lVarValue.ToString);
|
|
if lVarValue.IsObjectInstance then
|
|
begin
|
|
lVarValue.AsObject.Free;
|
|
end;
|
|
end;
|
|
ttLineBreak: begin
|
|
lBuff.AppendLine;
|
|
end;
|
|
ttSystemVersion: begin
|
|
if fTokens[lIdx].Value1 <> TEMPLATEPRO_VERSION then
|
|
begin
|
|
Error('Compiled template has been compiled with a different version. Expected ' + TEMPLATEPRO_VERSION + ' got ' + fTokens[lIdx].Value1);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
Error('Invalid token at index #' + lIdx.ToString + ': ' + fTokens[lIdx].TokenTypeAsString);
|
|
end;
|
|
end;
|
|
Inc(lIdx);
|
|
end;
|
|
Result := lBuff.ToString;
|
|
finally
|
|
lBuff.Free;
|
|
end;
|
|
end;
|
|
|
|
function TTProCompiledTemplate.GetVarAsString(const Name: string): string;
|
|
var
|
|
lValue: TValue;
|
|
begin
|
|
lValue := GetVarAsTValue(Name);
|
|
Result := GetTValueVarAsString(lValue, Name);
|
|
end;
|
|
|
|
function TTProCompiledTemplate.GetVarAsTValue(const aName: string): TValue;
|
|
var
|
|
lVariable: TVarDataSource;
|
|
lField: TField;
|
|
lHasMember: Boolean;
|
|
lJPath: string;
|
|
lDataSource: string;
|
|
lIsAnIterator: Boolean;
|
|
lJObj: TJDOJsonObject;
|
|
lVarName: string;
|
|
lVarMembers: string;
|
|
lCurrentIterator: TLoopStackItem;
|
|
lPJSONDataValue: TJsonDataValueHelper;
|
|
lHandled: Boolean;
|
|
begin
|
|
lCurrentIterator := nil;
|
|
SplitVariableName(aName, lVarName, lVarMembers);
|
|
lHasMember := not lVarMembers.IsEmpty;
|
|
lIsAnIterator := IsAnIterator(lVarName, lDataSource, lCurrentIterator);
|
|
|
|
if not lIsAnIterator then
|
|
begin
|
|
lDataSource := lVarName;
|
|
end;
|
|
|
|
if GetVariables.TryGetValue(lDataSource, lVariable) then
|
|
begin
|
|
if lVariable = nil then
|
|
begin
|
|
Exit(nil);
|
|
end;
|
|
if viDataSet in lVariable.VarOption then
|
|
begin
|
|
if lIsAnIterator then
|
|
begin
|
|
if lHasMember and lVarMembers.StartsWith('@@') then
|
|
begin
|
|
lCurrentIterator.IteratorPosition := TDataSet(lVariable.VarValue.AsObject).RecNo - 1;
|
|
//lVariable.VarIterator := TDataSet(lVariable.VarValue.AsObject).RecNo - 1;
|
|
Result := GetPseudoVariable(lCurrentIterator.IteratorPosition, lVarMembers);
|
|
end
|
|
else
|
|
begin
|
|
lField := TDataSet(lVariable.VarValue.AsObject).FieldByName(lVarMembers);
|
|
case lField.DataType of
|
|
ftInteger: Result := lField.AsInteger;
|
|
ftLargeint, ftAutoInc: Result := lField.AsLargeInt;
|
|
ftString, ftWideString, ftMemo, ftWideMemo: Result := lField.AsWideString;
|
|
else
|
|
Error('Invalid data type for field "' + lVarMembers + '": ' + TRttiEnumerationType.GetName<TFieldType>(lField.DataType));
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
{ not an interator }
|
|
if lHasMember then
|
|
Error(lDataSource + ' members can be read only through an iterator')
|
|
else
|
|
begin
|
|
Result := lVariable.VarValue.AsObject;
|
|
end;
|
|
end;
|
|
end
|
|
else if viJSONObject in lVariable.VarOption then
|
|
begin
|
|
lJObj := TJDOJsonObject(lVariable.VarValue.AsObject);
|
|
|
|
if lIsAnIterator then
|
|
begin
|
|
if lVarMembers.StartsWith('@@') then
|
|
begin
|
|
Result := GetPseudoVariable(lCurrentIterator.IteratorPosition, lVarMembers);
|
|
end
|
|
else
|
|
begin
|
|
lJPath := lCurrentIterator.FullPath;
|
|
lPJSONDataValue := lJObj.Path[lJPath].ArrayValue[lCurrentIterator.IteratorPosition];
|
|
if lPJSONDataValue.Typ in [jdtArray, jdtObject] then
|
|
begin
|
|
if not lVarMembers.IsEmpty then
|
|
lPJSONDataValue := lPJSONDataValue.Path[lVarMembers];
|
|
case lPJSONDataValue.Typ of
|
|
jdtArray: begin
|
|
Result := lPJSONDataValue.ArrayValue.ToJSON();
|
|
end;
|
|
jdtObject: begin
|
|
Result := lPJSONDataValue.ObjectValue.ToJSON();
|
|
end;
|
|
else
|
|
Result := lPJSONDataValue.Value;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if lVarMembers.IsEmpty then
|
|
Result := lPJSONDataValue.Value
|
|
else
|
|
Result := '';
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
lJPath := aName.Remove(0, Length(lVarName) + 1);
|
|
if lJPath.IsEmpty then
|
|
Result := lJObj
|
|
else
|
|
Result := lJObj.Path[lJPath].Value;
|
|
end;
|
|
end
|
|
else if viListOfObject in lVariable.VarOption then
|
|
begin
|
|
if lVarMembers.StartsWith('@@') then
|
|
begin
|
|
Result := GetPseudoVariable(lCurrentIterator.IteratorPosition, lVarMembers);
|
|
end
|
|
else
|
|
begin
|
|
if lIsAnIterator then
|
|
begin
|
|
if lHasMember then
|
|
Result := TTProRTTIUtils.GetProperty(WrapAsList(lVariable.VarValue.AsObject).GetItem(lCurrentIterator.IteratorPosition), lVarMembers)
|
|
else
|
|
Result := WrapAsList(lVariable.VarValue.AsObject).GetItem(lCurrentIterator.IteratorPosition);
|
|
end
|
|
else
|
|
begin
|
|
if lHasMember then
|
|
Error(lDataSource + ' can be used only with filters or iterated using its alias')
|
|
else
|
|
begin
|
|
Result := lVariable.VarValue.AsObject;
|
|
end;
|
|
end;
|
|
end;
|
|
end
|
|
else if viObject in lVariable.VarOption then
|
|
begin
|
|
if lHasMember then
|
|
Result := TTProRTTIUtils.GetProperty(lVariable.VarValue.AsObject, lVarMembers)
|
|
else
|
|
Result := lVariable.VarValue;
|
|
end
|
|
else if viSimpleType in lVariable.VarOption then
|
|
begin
|
|
if lVariable.VarValue.IsEmpty then
|
|
begin
|
|
Result := TValue.Empty;
|
|
end
|
|
else
|
|
begin
|
|
Result := lVariable.VarValue;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
DoOnGetValue(lDataSource, lVarMembers, Result, lHandled);
|
|
if not lHandled then
|
|
begin
|
|
Result := TValue.Empty;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TTProCompiledTemplate.GetVariables: TTProVariables;
|
|
begin
|
|
if not Assigned(fVariables) then
|
|
begin
|
|
fVariables := TTProVariables.Create;
|
|
end;
|
|
Result := fVariables;
|
|
end;
|
|
|
|
function TTProCompiledTemplate.IsAnIterator(const VarName: String; out DataSourceName: String; out CurrentIterator: TLoopStackItem): Boolean;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := False;
|
|
if not LoopStackIsEmpty then {search datasource using current iterators stack}
|
|
begin
|
|
for I := fLoopsStack.Count - 1 downto 0 do
|
|
begin
|
|
if fLoopsStack[I].IteratorName = VarName then
|
|
begin
|
|
Result := True;
|
|
DataSourceName := fLoopsStack[I].DataSourceName;
|
|
CurrentIterator := fLoopsStack[I];
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TTProCompiledTemplate.IsTruthy(const Value: TValue): Boolean;
|
|
var
|
|
lStrValue: String;
|
|
lWrappedList: ITProWrappedList;
|
|
begin
|
|
if Value.IsEmpty then
|
|
begin
|
|
Exit(False);
|
|
end;
|
|
lStrValue := Value.ToString;
|
|
if Value.IsObjectInstance then
|
|
begin
|
|
if Value.AsObject = nil then
|
|
begin
|
|
lStrValue := '';
|
|
end
|
|
else if Value.AsObject is TDataSet then
|
|
begin
|
|
lStrValue := TDataSet(Value.AsObject).RecordCount.ToString;
|
|
end
|
|
else if Value.AsObject is TJsonArray then
|
|
begin
|
|
lStrValue := TJsonArray(Value.AsObject).Count.ToString;
|
|
end
|
|
else if Value.AsObject is TJsonObject then
|
|
begin
|
|
lStrValue := TJsonObject(Value.AsObject).Count.ToString;
|
|
end
|
|
else
|
|
begin
|
|
lWrappedList := TTProDuckTypedList.Wrap(Value.AsObject);
|
|
if lWrappedList = nil then
|
|
begin
|
|
lStrValue := '';
|
|
end
|
|
else
|
|
begin
|
|
lStrValue := lWrappedList.Count.ToString;
|
|
end;
|
|
end;
|
|
end;
|
|
Result := not (SameText(lStrValue,'false') or SameText(lStrValue,'0') or SameText(lStrValue,''));
|
|
end;
|
|
|
|
function TTProCompiledTemplate.LoopStackIsEmpty: Boolean;
|
|
begin
|
|
Result := fLoopsStack.Count = 0;
|
|
end;
|
|
|
|
function TTProCompiledTemplate.PeekLoop: TLoopStackItem;
|
|
begin
|
|
if fLoopsStack.Count = 0 then
|
|
begin
|
|
Result := nil;
|
|
end
|
|
else
|
|
begin
|
|
Result := fLoopsStack.Last;
|
|
end;
|
|
end;
|
|
|
|
procedure TTProCompiledTemplate.PopLoop;
|
|
begin
|
|
fLoopsStack.Delete(fLoopsStack.Count - 1);
|
|
end;
|
|
|
|
procedure TTProCompiledTemplate.PushLoop(const LoopStackItem: TLoopStackItem);
|
|
begin
|
|
fLoopsStack.Add(LoopStackItem);
|
|
end;
|
|
|
|
//function TTProCompiledTemplate.EvaluateIfExpression(aIdentifier: string): Boolean;
|
|
//var
|
|
// lVarValue: TValue;
|
|
// lNegation: Boolean;
|
|
// lVariable: TVarDataSource;
|
|
// lTmp: Boolean;
|
|
// lDataSourceName: String;
|
|
// lHasMember: Boolean;
|
|
// lList: ITProWrappedList;
|
|
// lVarName, lVarMembers: String;
|
|
// lCurrentIterator: TLoopStackItem;
|
|
// lIsAnIterator: Boolean;
|
|
// lHandled: Boolean;
|
|
//begin
|
|
// lNegation := aIdentifier.StartsWith('!');
|
|
// if lNegation then
|
|
// aIdentifier := aIdentifier.Remove(0,1);
|
|
//
|
|
// SplitVariableName(aIdentifier, lVarName, lVarMembers);
|
|
//
|
|
// lHasMember := Length(lVarMembers) > 0;
|
|
//
|
|
// lIsAnIterator := IsAnIterator(lVarName, lDataSourceName, lCurrentIterator);
|
|
//
|
|
// if not lIsAnIterator then
|
|
// begin
|
|
// lDataSourceName := lVarName;
|
|
// end;
|
|
//
|
|
// if GetVariables.TryGetValue(lDataSourceName, lVariable) then
|
|
// begin
|
|
// if lVariable = nil then
|
|
// begin
|
|
// Exit(lNegation xor False);
|
|
// end;
|
|
// if viDataSet in lVariable.VarOption then
|
|
// begin
|
|
// if lHasMember then
|
|
// begin
|
|
// if lVarMembers.StartsWith('@@') then
|
|
// begin
|
|
// if not lIsAnIterator then
|
|
// begin
|
|
// Error('Pseudovariables (@@) can be used only on iterators');
|
|
// end;
|
|
// lVarValue := GetPseudoVariable(lCurrentIterator.IteratorPosition, lVarMembers);
|
|
// end
|
|
// else
|
|
// begin
|
|
// lVarValue := TValue.From<Variant>(TDataSet(lVariable.VarValue.AsObject).FieldByName(lVarMembers).Value);
|
|
// end;
|
|
// lTmp := IsTruthy(lVarValue);
|
|
// end
|
|
// else
|
|
// begin
|
|
// lTmp := not TDataSet(lVariable.VarValue.AsObject).Eof;
|
|
// end;
|
|
// Exit(lNegation xor lTmp);
|
|
// end
|
|
// else if viListOfObject in lVariable.VarOption then
|
|
// begin
|
|
// lList := WrapAsList(lVariable.VarValue.AsObject);
|
|
// if lHasMember then
|
|
// begin
|
|
// if lVarMembers.StartsWith('@@') then
|
|
// begin
|
|
// lVarValue := GetPseudoVariable(lCurrentIterator.IteratorPosition, lVarMembers);
|
|
// end
|
|
// else
|
|
// begin
|
|
// lVarValue := TTProRTTIUtils.GetProperty(lList.GetItem(lCurrentIterator.IteratorPosition), lVarMembers);
|
|
// end;
|
|
// lTmp := IsTruthy(lVarValue);
|
|
// end
|
|
// else
|
|
// begin
|
|
// lTmp := lList.Count > 0;
|
|
// end;
|
|
//
|
|
// if lNegation then
|
|
// begin
|
|
// Exit(not lTmp);
|
|
// end;
|
|
// Exit(lTmp);
|
|
// end
|
|
// else if [viObject, viJSONObject] * lVariable.VarOption <> [] then
|
|
// begin
|
|
// if lHasMember then
|
|
// begin
|
|
// if lVarMembers.StartsWith('@@') then
|
|
// begin
|
|
// lVarValue := GetPseudoVariable(lCurrentIterator.IteratorPosition, lVarMembers);
|
|
// end
|
|
// else
|
|
// begin
|
|
// lVarValue := GetVarAsTValue(lDataSourceName);
|
|
// end;
|
|
// lTmp := IsTruthy(lVarValue);
|
|
// end
|
|
// else
|
|
// begin
|
|
// lTmp := not lVarValue.IsEmpty;
|
|
// end;
|
|
// if lNegation then
|
|
// begin
|
|
// Exit(not lTmp);
|
|
// end;
|
|
// Exit(lTmp);
|
|
// end
|
|
// else if viSimpleType in lVariable.VarOption then
|
|
// begin
|
|
// lTmp := IsTruthy(lVariable.VarValue);
|
|
// Exit(lNegation xor lTmp)
|
|
// end;
|
|
// end
|
|
// else
|
|
// begin
|
|
// lHandled := False;
|
|
// DoOnGetValue(lVarName, lVarMembers, lVarValue, lHandled);
|
|
// if lHandled then
|
|
// begin
|
|
// lTmp := IsTruthy(lVarValue);
|
|
// if lNegation then
|
|
// begin
|
|
// Exit(not lTmp);
|
|
// end;
|
|
// Exit(lTmp);
|
|
// end;
|
|
// end;
|
|
// Exit(lNegation xor False);
|
|
//end;
|
|
|
|
function TTProCompiledTemplate.EvaluateIfExpressionAt(var Idx: UInt64): Boolean;
|
|
var
|
|
lMustBeEncoded: Boolean;
|
|
begin
|
|
Inc(Idx);
|
|
if fTokens[Idx].TokenType <> ttBoolExpression then
|
|
begin
|
|
Error('Expected ttBoolExpression after ttIfThen');
|
|
end;
|
|
Result := IsTruthy(EvaluateValue(Idx, lMustBeEncoded));
|
|
end;
|
|
|
|
function TTProCompiledTemplate.EvaluateValue(var Idx: UInt64; out MustBeEncoded: Boolean): TValue;
|
|
var
|
|
lCurrTokenType: TTokenType;
|
|
lVarName: string;
|
|
lFilterName: string;
|
|
lFilterParCount: Int64;
|
|
lFilterParameters: TArray<String>;
|
|
I: Integer;
|
|
lNegated: Boolean;
|
|
begin
|
|
// Ref1 contains the optional filter parameter number (-1 if there isn't any filter)
|
|
// Ref2 is -1 if the variable must be HTMLEncoded, while contains 1 is the value must not be HTMLEncoded
|
|
MustBeEncoded := fTokens[Idx].Ref2 = -1;
|
|
lCurrTokenType := fTokens[Idx].TokenType;
|
|
lVarName := fTokens[Idx].Value1;
|
|
lNegated := lVarName.StartsWith('!');
|
|
if lNegated then
|
|
begin
|
|
lVarName := lVarName.Substring(1);
|
|
end;
|
|
|
|
if fTokens[Idx].Ref1 > -1 {has a filter with Ref1 parameters cout} then
|
|
begin
|
|
Inc(Idx);
|
|
lFilterName := fTokens[Idx].Value1;
|
|
lFilterParCount := fTokens[Idx].Ref1; // parameter count
|
|
SetLength(lFilterParameters, lFilterParCount);
|
|
for I := 0 to lFilterParCount - 1 do
|
|
begin
|
|
Inc(Idx);
|
|
Assert(fTokens[Idx].TokenType = ttFilterParameter);
|
|
lFilterParameters[I] := fTokens[Idx].Value1;
|
|
end;
|
|
case lCurrTokenType of
|
|
ttValue: Result := ExecuteFilter(lFilterName, lFilterParameters, GetVarAsTValue(lVarName));
|
|
ttBoolExpression: Result := IsTruthy(ExecuteFilter(lFilterName, lFilterParameters, GetVarAsTValue(lVarName)));
|
|
ttLiteralString: Result := ExecuteFilter(lFilterName, lFilterParameters, lVarName);
|
|
else
|
|
Error('Invalid token in EvaluateValue');
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
case lCurrTokenType of
|
|
ttValue: Result := GetVarAsString(lVarName);
|
|
ttBoolExpression: Result := IsTruthy(GetVarAsTValue(lVarName));
|
|
ttLiteralString: Result := lVarName;
|
|
else
|
|
Error('Invalid token in EvaluateValue');
|
|
end;
|
|
end;
|
|
if lNegated then
|
|
begin
|
|
Result := not Result.AsBoolean;
|
|
end;
|
|
end;
|
|
|
|
procedure TTProCompiledTemplate.SaveToFile(const FileName: String);
|
|
var
|
|
lToken: TToken;
|
|
lBW: TBinaryWriter;
|
|
begin
|
|
lBW := TBinaryWriter.Create(TFileStream.Create(FileName, fmCreate or fmOpenWrite or fmShareDenyNone), nil, True);
|
|
try
|
|
for lToken in fTokens do
|
|
begin
|
|
lToken.SaveToBytes(lBW);
|
|
end;
|
|
finally
|
|
lBW.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TTProCompiledTemplate.SetData(const Name: String; Value: TValue);
|
|
var
|
|
lWrappedList: ITProWrappedList;
|
|
begin
|
|
if Value.IsEmpty then
|
|
begin
|
|
GetVariables.Add(Name, nil);
|
|
Exit;
|
|
end;
|
|
|
|
case Value.Kind of
|
|
tkClass:
|
|
begin
|
|
if Value.AsObject is TDataSet then
|
|
begin
|
|
GetVariables.Add(Name, TVarDataSource.Create(Value.AsObject, [viDataSet, viIterable]));
|
|
end
|
|
else
|
|
if Value.AsObject is TJDOJsonObject then
|
|
begin
|
|
GetVariables.Add(Name, TVarDataSource.Create(TJDOJsonObject(Value.AsObject), [viJSONObject]));
|
|
end
|
|
else
|
|
if Value.AsObject is TJDOJsonObject then
|
|
begin
|
|
GetVariables.Add(Name, TVarDataSource.Create(TJDOJsonObject(Value.AsObject), [viJSONObject]));
|
|
end
|
|
else
|
|
begin
|
|
if TTProDuckTypedList.CanBeWrappedAsList(Value.AsObject, lWrappedList) then
|
|
begin
|
|
GetVariables.Add(Name, TVarDataSource.Create(TTProDuckTypedList(Value.AsObject), [viListOfObject, viIterable]));
|
|
end
|
|
else
|
|
begin
|
|
GetVariables.Add(Name, TVarDataSource.Create(Value.AsObject, [viObject]));
|
|
end;
|
|
end;
|
|
end;
|
|
tkInteger, tkString, tkUString, tkFloat, tkEnumeration : GetVariables.Add(Name, TVarDataSource.Create(Value, [viSimpleType]));
|
|
else
|
|
raise ETProException.Create('Invalid type for variable "' + Name + '": ' + TRttiEnumerationType.GetName<TTypeKind>(Value.Kind));
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
procedure TTProCompiledTemplate.SetOnGetValue(
|
|
const Value: TTProCompiledTemplateGetValueEvent);
|
|
begin
|
|
fOnGetValue := Value;
|
|
end;
|
|
|
|
procedure TTProCompiledTemplate.SplitVariableName(
|
|
const VariableWithMember: String; out VarName, VarMembers: String);
|
|
var
|
|
lDotPos: Integer;
|
|
begin
|
|
VarName := VariableWithMember;
|
|
VarMembers := '';
|
|
lDotPos := VarName.IndexOf('.');
|
|
if lDotPos > -1 then
|
|
begin
|
|
VarName := VariableWithMember.Substring(0, lDotPos);
|
|
VarMembers := VariableWithMember.Substring(lDotPos + 1);
|
|
end;
|
|
end;
|
|
|
|
function TTProCompiledTemplate.WalkThroughLoopStack(const VarName: String;
|
|
out BaseVarName, FullPath: String): Boolean;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := False;
|
|
for I := fLoopsStack.Count - 1 downto 0 do
|
|
begin
|
|
if VarName = fLoopsStack[I].IteratorName then
|
|
begin
|
|
BaseVarName := fLoopsStack[I].DataSourceName;
|
|
FullPath := fLoopsStack[I].FullPath + '[' + fLoopsStack[I].IteratorPosition.ToString + ']';
|
|
Result := True;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TTProCompiledTemplate.ClearData;
|
|
begin
|
|
GetVariables.Clear;
|
|
end;
|
|
|
|
{ TVarInfo }
|
|
|
|
constructor TVarDataSource.Create(const VarValue: TValue;
|
|
const VarOption: TTProVariablesInfos);
|
|
begin
|
|
Self.VarValue := VarValue;
|
|
Self.VarOption := VarOption;
|
|
end;
|
|
|
|
{ TTProVariables }
|
|
|
|
constructor TTProVariables.Create;
|
|
begin
|
|
inherited Create([doOwnsValues]);
|
|
end;
|
|
|
|
|
|
//////////////////////
|
|
/// UTILS
|
|
|
|
class function TTProRTTIUtils.GetProperty(AObject: TObject; const APropertyName: string): TValue;
|
|
var
|
|
Prop: TRttiProperty;
|
|
ARttiType: TRttiType;
|
|
begin
|
|
ARttiType := GlContext.GetType(AObject.ClassType);
|
|
if not Assigned(ARttiType) then
|
|
raise Exception.CreateFmt('Cannot get RTTI for type [%s]', [ARttiType.ToString]);
|
|
Prop := ARttiType.GetProperty(APropertyName);
|
|
if not Assigned(Prop) then
|
|
raise Exception.CreateFmt('Cannot get RTTI for property [%s.%s]', [ARttiType.ToString, APropertyName]);
|
|
if Prop.IsReadable then
|
|
Result := Prop.GetValue(AObject)
|
|
else
|
|
raise Exception.CreateFmt('Property is not readable [%s.%s]', [ARttiType.ToString, APropertyName]);
|
|
end;
|
|
|
|
{ TDuckTypedList }
|
|
|
|
procedure TTProDuckTypedList.Add(const AObject: TObject);
|
|
begin
|
|
if not Assigned(FAddMethod) then
|
|
raise ETProDuckTypingException.Create('Cannot find method "Add" in the Duck Object.');
|
|
FAddMethod.Invoke(FObjectAsDuck, [AObject]);
|
|
end;
|
|
|
|
class function TTProDuckTypedList.CanBeWrappedAsList(const AInterfaceAsDuck: IInterface): Boolean;
|
|
begin
|
|
Result := CanBeWrappedAsList(TObject(AInterfaceAsDuck));
|
|
end;
|
|
|
|
class function TTProDuckTypedList.CanBeWrappedAsList(const AObjectAsDuck: TObject): Boolean;
|
|
var
|
|
lList: ITProWrappedList;
|
|
begin
|
|
Result := CanBeWrappedAsList(AObjectAsDuck, lList);
|
|
end;
|
|
|
|
class function TTProDuckTypedList.CanBeWrappedAsList(const AObjectAsDuck: TObject; out AMVCList: ITProWrappedList): Boolean;
|
|
var
|
|
List: ITProWrappedList;
|
|
begin
|
|
List := TTProDuckTypedList.Create(AObjectAsDuck);
|
|
Result := List.IsWrappedList;
|
|
if Result then
|
|
AMVCList := List;
|
|
end;
|
|
|
|
procedure TTProDuckTypedList.Clear;
|
|
begin
|
|
if not Assigned(FClearMethod) then
|
|
raise ETProDuckTypingException.Create('Cannot find method "Clear" in the Duck Object.');
|
|
FClearMethod.Invoke(FObjectAsDuck, []);
|
|
end;
|
|
|
|
function TTProDuckTypedList.Count: Integer;
|
|
begin
|
|
Result := 0;
|
|
|
|
if (not Assigned(FGetCountMethod)) and (not Assigned(FCountProperty)) then
|
|
raise ETProDuckTypingException.Create('Cannot find property/method "Count" in the Duck Object.');
|
|
|
|
if Assigned(FCountProperty) then
|
|
Result := FCountProperty.GetValue(FObjectAsDuck).AsInteger
|
|
else if Assigned(FGetCountMethod) then
|
|
Result := FGetCountMethod.Invoke(FObjectAsDuck, []).AsInteger;
|
|
end;
|
|
|
|
constructor TTProDuckTypedList.Create(const AInterfaceAsDuck: IInterface);
|
|
begin
|
|
Create(TObject(AInterfaceAsDuck));
|
|
end;
|
|
|
|
constructor TTProDuckTypedList.Create(const AObjectAsDuck: TObject);
|
|
begin
|
|
inherited Create;
|
|
FObjectAsDuck := AObjectAsDuck;
|
|
|
|
if not Assigned(FObjectAsDuck) then
|
|
raise ETProDuckTypingException.Create('Duck Object can not be null.');
|
|
|
|
FObjType := GlContext.GetType(FObjectAsDuck.ClassInfo);
|
|
|
|
FAddMethod := nil;
|
|
FClearMethod := nil;
|
|
FGetItemMethod := nil;
|
|
FGetCountMethod := nil;
|
|
FCountProperty := nil;
|
|
|
|
if IsWrappedList then
|
|
begin
|
|
FAddMethod := FObjType.GetMethod('Add');
|
|
FClearMethod := FObjType.GetMethod('Clear');
|
|
|
|
{$IF CompilerVersion >= 23}
|
|
if Assigned(FObjType.GetIndexedProperty('Items')) then
|
|
FGetItemMethod := FObjType.GetIndexedProperty('Items').ReadMethod;
|
|
|
|
{$IFEND}
|
|
if not Assigned(FGetItemMethod) then
|
|
FGetItemMethod := FObjType.GetMethod('GetItem');
|
|
|
|
if not Assigned(FGetItemMethod) then
|
|
FGetItemMethod := FObjType.GetMethod('GetElement');
|
|
|
|
FGetCountMethod := nil;
|
|
FCountProperty := FObjType.GetProperty('Count');
|
|
if not Assigned(FCountProperty) then
|
|
FGetCountMethod := FObjType.GetMethod('Count');
|
|
end;
|
|
end;
|
|
|
|
function TTProDuckTypedList.GetItem(const AIndex: Integer): TObject;
|
|
var
|
|
lValue: TValue;
|
|
begin
|
|
if not Assigned(FGetItemMethod) then
|
|
raise ETProDuckTypingException.Create
|
|
('Cannot find method Indexed property "Items" or method "GetItem" or method "GetElement" in the Duck Object.');
|
|
GetItemAsTValue(AIndex, lValue);
|
|
|
|
if lValue.Kind = tkInterface then
|
|
begin
|
|
Exit(TObject(lValue.AsInterface));
|
|
end;
|
|
if lValue.Kind = tkClass then
|
|
begin
|
|
Exit(lValue.AsObject);
|
|
end;
|
|
raise ETProDuckTypingException.Create('Items in list can be only objects or interfaces');
|
|
end;
|
|
|
|
procedure TTProDuckTypedList.GetItemAsTValue(const AIndex: Integer;
|
|
out AValue: TValue);
|
|
begin
|
|
AValue := FGetItemMethod.Invoke(FObjectAsDuck, [AIndex]);
|
|
end;
|
|
|
|
function TTProDuckTypedList.IsWrappedList: Boolean;
|
|
var
|
|
ObjectType: TRttiType;
|
|
begin
|
|
ObjectType := GlContext.GetType(FObjectAsDuck.ClassInfo);
|
|
|
|
Result := (ObjectType.GetMethod('Add') <> nil) and (ObjectType.GetMethod('Clear') <> nil)
|
|
|
|
{$IF CompilerVersion >= 23}
|
|
and (ObjectType.GetIndexedProperty('Items') <> nil) and (ObjectType.GetIndexedProperty('Items').ReadMethod <> nil)
|
|
|
|
{$IFEND}
|
|
and (ObjectType.GetMethod('GetItem') <> nil) or (ObjectType.GetMethod('GetElement') <> nil) and
|
|
(ObjectType.GetProperty('Count') <> nil);
|
|
end;
|
|
|
|
function TTProDuckTypedList.ItemIsObject(const AIndex: Integer; out AValue: TValue): Boolean;
|
|
begin
|
|
GetItemAsTValue(AIndex, AValue);
|
|
Result := AValue.IsObject;
|
|
end;
|
|
|
|
class function TTProDuckTypedList.Wrap(const AObjectAsDuck: TObject): ITProWrappedList;
|
|
var
|
|
List: ITProWrappedList;
|
|
begin
|
|
if AObjectAsDuck is TTProDuckTypedList then
|
|
Exit(TTProDuckTypedList(AObjectAsDuck));
|
|
Result := nil;
|
|
List := TTProDuckTypedList.Create(AObjectAsDuck);
|
|
if List.IsWrappedList then
|
|
Result := List;
|
|
end;
|
|
|
|
|
|
{ TLoopStackItem }
|
|
|
|
constructor TLoopStackItem.Create(DataSourceName, LoopExpression,
|
|
FullPath: String; IteratorName: String);
|
|
begin
|
|
Self.DataSourceName := DataSourceName;
|
|
Self.LoopExpression := LoopExpression;
|
|
Self.FullPath := FullPath;
|
|
Self.IteratorName := IteratorName;
|
|
Self.IteratorPosition := -1;
|
|
end;
|
|
|
|
function TLoopStackItem.IncrementIteratorPosition: Integer;
|
|
begin
|
|
Inc(IteratorPosition);
|
|
Result := IteratorPosition;
|
|
end;
|
|
|
|
{ TTProConfiguration }
|
|
|
|
class procedure TTProConfiguration.RegisterHandlers(const TemplateProCompiledTemplate: ITProCompiledTemplate);
|
|
begin
|
|
if Assigned(fOnContextConfiguration) then
|
|
begin
|
|
fOnContextConfiguration(TemplateProCompiledTemplate);
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
GlContext := TRttiContext.Create;
|
|
JsonSerializationConfig.LineBreak := sLineBreak;
|
|
|
|
finalization
|
|
GlContext.Free;
|
|
|
|
end.
|