Skip to content

Commit

Permalink
Improved WebStancils ViewEngine
Browse files Browse the repository at this point in the history
  • Loading branch information
@danieleteti
danieleteti committed Nov 8, 2024
1 parent 6ac033b commit 9608812
Show file tree
Hide file tree
Showing 2 changed files with 207 additions and 12 deletions.
7 changes: 5 additions & 2 deletions sources/MVCFramework.View.Renderers.TemplatePro.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -43,8 +43,8 @@ implementation
MVCFramework.Serializer.Defaults,
MVCFramework.Serializer.Intf,
MVCFramework.DuckTyping,
TemplatePro,
MVCFramework.Cache,
TemplatePro,
Data.DB,
System.Rtti,
JsonDataObjects;
Expand Down Expand Up @@ -136,7 +136,10 @@ procedure TMVCTemplateProViewEngine.Execute(const ViewName: string; const Builde
if FUseViewCache then
begin
lCacheDir := TPath.Combine(TPath.GetDirectoryName(lViewFileName), '__cache__');
TDirectory.CreateDirectory(lCacheDir);
if not TDirectory.Exists(lCacheDir) then
begin
TDirectory.CreateDirectory(lCacheDir);
end;
lCompiledViewFileName := TPath.Combine(lCacheDir, TPath.ChangeExtension(TPath.GetFileName(lViewFileName), '.' + TEMPLATEPRO_VERSION + '.tpcu'));

if not FileAge(lViewFileName, lActualFileTimeStamp) then
Expand Down
212 changes: 202 additions & 10 deletions sources/MVCFramework.View.Renderers.WebStencils.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -34,14 +34,19 @@ interface

uses
MVCFramework, System.Generics.Collections, System.SysUtils,
MVCFramework.Commons, System.IOUtils, System.Classes, Web.Stencils;
MVCFramework.Commons, System.IOUtils, System.Classes, Web.Stencils,
System.Rtti, MVCFramework.Nullables, System.DateUtils;

type
TMVCWebStencilsEvent = reference to procedure(const WebStencilsProcessor: TWebStencilsProcessor);

{ This class implements the WebStencils view engine for server side views }
TMVCWebStencilsViewEngine = class(TMVCBaseViewEngine)
protected
procedure RegisterWSFunctions(WSProcessor: TWebStencilsProcessor);
procedure OnGetValue(Sender: TObject; const AObjectName, APropName: string; var AReplaceText: string; var AHandled: Boolean);
public
class function GetTValueVarAsString(const Value: TValue; const VarName: string; const Processor: TWebStencilsProcessor): String;
procedure Execute(const ViewName: string; const Builder: TStringBuilder); override;
end;

Expand All @@ -68,7 +73,6 @@ implementation
System.Bindings.Methods,
MVCFramework.Cache,
Data.DB,
System.Rtti,
JsonDataObjects;

{$WARNINGS OFF}
Expand All @@ -81,7 +85,7 @@ function GetDataSetOrObjectListCount(const aValue: TValue; const aParameters: TA
var
lWrappedList: IMVCList;
begin
if not aValue.IsObject then
if aValue.IsEmpty or (not aValue.IsObject) then
begin
Result := False;
end;
Expand Down Expand Up @@ -141,21 +145,39 @@ function DumpAsJSONString(const aValue: TValue; const aParameters: TArray<string

function MakeMethodJSON: IInvokable;
begin
Result := MakeInvokable(function(Args: TArray<IValue>): IValue
begin
Result := TValueWrapper.Create(DumpAsJSONString(Args[0].GetValue.AsObject, []));
end)
Result :=
MakeInvokable(function(Args: TArray<IValue>): IValue
begin
Result := TValueWrapper.Create(DumpAsJSONString(Args[0].GetValue.AsObject, []));
end);
end;

procedure RegisterWSFunctions(WSProcessor: TWebStencilsProcessor);

procedure TMVCWebStencilsViewEngine.OnGetValue(Sender: TObject; const AObjectName, APropName: string; var AReplaceText: string; var AHandled: Boolean);
var
lValue: TValue;
begin
AHandled := False;
if ViewModel.TryGetValue(AObjectName, lValue) then
begin
AReplaceText := GetTValueVarAsString(lValue, AObjectName, TWebStencilsProcessor(Sender));
AHandled := True;
end
else
begin
AReplaceText := '';
AHandled := True;
end;
end;

procedure TMVCWebStencilsViewEngine.RegisterWSFunctions(WSProcessor: TWebStencilsProcessor);
begin
if gFunctionInitialized then Exit;
TMonitor.Enter(gWSLock);
try
if gFunctionInitialized then Exit;
gFunctionInitialized := True;


TBindingMethodsFactory.RegisterMethod(
TMethodDescription.Create(
MakeInvokable(function(Args: TArray<IValue>): IValue
Expand All @@ -168,6 +190,18 @@ procedure RegisterWSFunctions(WSProcessor: TWebStencilsProcessor);
end) as IInvokable,
'json', 'json', '', True, 'Serialize an object to JSON', nil));

TBindingMethodsFactory.RegisterMethod(
TMethodDescription.Create(
MakeInvokable(function(Args: TArray<IValue>): IValue
begin
if Length(Args) <> 1 then
begin
raise EWebStencilsException.Create('Expected 1 parameter, got ' + Length(Args).ToString);
end;
Result := TValueWrapper.Create(TMVCWebStencilsViewEngine.GetTValueVarAsString(Args[0].GetValue, '', nil));
end),
'ValueOf', 'ValueOf', '', True, 'ValueOf returns the inner value of a nullable as string - the non-nullable types are returned as-is', nil));

finally
TMonitor.Exit(gWSLock);
end;
Expand All @@ -191,9 +225,10 @@ procedure TMVCWebStencilsViewEngine.Execute(const ViewName: string; const Builde
begin
TMVCWebStencilsConfiguration.OnProcessorConfiguration(lWebStencilsProcessor);
end;
//lWebStencilsProcessor.OnFile := Self.OnFile; {12.2, any filename starting with ..\ is not read correctly by the parser. Is it a feature? }
lWebStencilsProcessor.OnValue := OnGetValue;
lWebStencilsProcessor.InputFileName := lViewFileName;
lWebStencilsProcessor.PathTemplate := Config[TMVCConfigKey.ViewPath];
lWebStencilsProcessor.WebRequest := WebContext.Request.RawWebRequest;
if Assigned(ViewModel) then
begin
for lPair in ViewModel do
Expand All @@ -202,6 +237,10 @@ procedure TMVCWebStencilsViewEngine.Execute(const ViewName: string; const Builde
lWebStencilsProcessor.AddVar(lPair.Key, ViewModel[lPair.Key].AsObject, False);
end;
end;
if Assigned(WebContext.LoggedUser) then
begin
lWebStencilsProcessor.UserRoles := WebContext.LoggedUser.Roles.ToString;
end;
if Assigned(FBeforeRenderCallback) then
begin
FBeforeRenderCallback(lWebStencilsProcessor);
Expand All @@ -219,6 +258,159 @@ procedure TMVCWebStencilsViewEngine.Execute(const ViewName: string; const Builde
end;
end;

class function TMVCWebStencilsViewEngine.GetTValueVarAsString(const Value: TValue; const VarName: string; const Processor: TWebStencilsProcessor): String;
var
lIsObject: Boolean;
lAsObject: TObject;
lNullableInt32: NullableInt32;
lNullableUInt32: NullableUInt32;
lNullableInt16: NullableInt16;
lNullableUInt16: NullableUInt16;
lNullableInt64: NullableInt64;
lNullableUInt64: NullableUInt64;
lNullableCurrency: NullableCurrency;
lNullableBoolean: NullableBoolean;
lNullableTDate: NullableTDate;
lNullableTTime: NullableTTime;
lNullableTDateTime: NullableTDateTime;
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
Result := '';
if Value.TypeInfo = TypeInfo(NullableInt32) then
begin
lNullableInt32 := Value.AsType<NullableInt32>;
if lNullableInt32.HasValue then
Result := lNullableInt32.Value.ToString
end
else if Value.TypeInfo = TypeInfo(NullableUInt32) then
begin
lNullableUInt32 := Value.AsType<NullableUInt32>;
if lNullableUInt32.HasValue then
Result := lNullableUInt32.Value.ToString
end
else if Value.TypeInfo = TypeInfo(NullableInt16) then
begin
lNullableInt16 := Value.AsType<NullableInt16>;
if lNullableInt16.HasValue then
Result := lNullableInt16.Value.ToString
end
else if Value.TypeInfo = TypeInfo(NullableUInt16) then
begin
lNullableUInt16 := Value.AsType<NullableUInt16>;
if lNullableUInt16.HasValue then
Result := lNullableUInt16.Value.ToString
end
else if Value.TypeInfo = TypeInfo(NullableInt64) then
begin
lNullableInt64 := Value.AsType<NullableInt64>;
if lNullableInt64.HasValue then
Result := lNullableInt64.Value.ToString
end
else if Value.TypeInfo = TypeInfo(NullableUInt64) then
begin
lNullableUInt64 := Value.AsType<NullableUInt64>;
if lNullableUInt64.HasValue then
Result := lNullableUInt64.Value.ToString
end
else if Value.TypeInfo = TypeInfo(NullableString) then
begin
Result := Value.AsType<NullableString>.ValueOrDefault;
end
else if Value.TypeInfo = TypeInfo(NullableCurrency) then
begin
lNullableCurrency := Value.AsType<NullableCurrency>;
if lNullableCurrency.HasValue then
Result := FloatToStr(lNullableCurrency.Value);
//Result := FloatToStr(lNullableCurrency.Value, fLocaleFormatSettings);
end
else if Value.TypeInfo = TypeInfo(NullableBoolean) then
begin
lNullableBoolean := Value.AsType<NullableBoolean>;
if lNullableBoolean.HasValue then
Result := BoolToStr(lNullableBoolean.Value, True);
end
else if Value.TypeInfo = TypeInfo(NullableTDate) then
begin
lNullableTDate := Value.AsType<NullableTDate>;
if lNullableTDate.HasValue then
Result := DateToISO8601(lNullableTDate.Value);
end
else if Value.TypeInfo = TypeInfo(NullableTTime) then
begin
lNullableTTime := Value.AsType<NullableTTime>;
if lNullableTTime.HasValue then
Result := DateToISO8601(lNullableTTime.Value);
end
else if Value.TypeInfo = TypeInfo(NullableTDateTime) then
begin
lNullableTDateTime := Value.AsType<NullableTDateTime>;
if lNullableTDateTime.HasValue then
Result := DateToISO8601(lNullableTDateTime.Value);
end
else
begin
raise EWebStencilsException.Create('Unsupported type for variable "' + VarName + '"');
end;
end
else
begin
case Value.Kind of
tkInteger: Result := Value.AsInteger.ToString;
tkInt64: Result := Value.AsInt64.ToString;
tkString, tkUString, tkWString, tkLString: Result := Value.AsString;
tkWChar, tkChar: Result := Value.AsType<Char>;
tkFloat: begin
if Value.TypeInfo.Name = 'TDate' then
begin
//Result := DateToStr(Value.AsExtended, fLocaleFormatSettings);
Result := DateToStr(Value.AsExtended);
end
else if Value.TypeInfo.Name = 'TDateTime' then
begin
//Result := DateTimeToStr(Value.AsExtended, fLocaleFormatSettings);
Result := DateTimeToStr(Value.AsExtended);
end
else
begin
//Result := FloatToStr(Value.AsExtended, fLocaleFormatSettings);
Result := FloatToStr(Value.AsExtended);
end;
end;
tkEnumeration: Result := Value.ToString.ToLower;
else
raise EWebStencilsException.Create('Unsupported type for variable "' + VarName + '"');
end;
end;
end;

end;


initialization

gWSLock := TObject.Create;
Expand Down

0 comments on commit 9608812

Please sign in to comment.