// *************************************************************************** // // Delphi MVC Framework // // Copyright (c) 2010-2024 Daniele Teti and the DMVCFramework Team // // https://github.com/danieleteti/delphimvcframework // // *************************************************************************** // // 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 MVCFramework.View.Renderers.Mustache; {$IFDEF LINUX} This unit is not compatible with Linux {$ENDIF} interface uses MVCFramework, System.SysUtils, System.Generics.Collections, MVCFramework.Commons, System.IOUtils, System.RTTI, System.Classes, Data.DB, SynMustache, SynCommons, MVCFramework.IntfObjectPool; type { This class implements the mustache view engine for server side views } TMVCMustacheViewEngine = class(TMVCBaseViewEngine) strict private procedure PrepareModels; private fModelPrepared: Boolean; class var fPartials: TSynMustachePartials; class var fHelpers: TSynMustacheHelpers; class var fSerializerPool: IIntfObjectPool; var FJSONModelAsString: string; procedure LoadPartials; procedure LoadHelpers; protected function RenderJSON(lViewEngine: TSynMustache; const JSON: RawUTF8; Partials: TSynMustachePartials; Helpers: TSynMustacheHelpers; OnTranslate: TOnStringTranslate; EscapeInvert: boolean): RawUTF8; virtual; public procedure Execute(const ViewName: string; const OutputStream: TStream); override; constructor Create(const AEngine: TMVCEngine; const AWebContext: TWebContext; const AViewModel: TMVCViewDataObject; const AContentType: string); override; class destructor Destroy; class constructor Create; end; TLoadCustomHelpersProc = reference to procedure(var MustacheHelpers: TSynMustacheHelpers); TMVCMustacheHelpers = class sealed private class var fOnLoadCustomHelpers: TLoadCustomHelpersProc; protected class procedure RegisterHandlers(var MustacheHelpers: TSynMustacheHelpers); class procedure ToLowerCase(const Value: variant; out Result: variant); class procedure ToUpperCase(const Value: variant; out Result: variant); class procedure Capitalize(const Value: variant; out Result: variant); class procedure SnakeCase(const Value: variant; out Result: variant); public class property OnLoadCustomHelpers: TLoadCustomHelpersProc read fOnLoadCustomHelpers write fOnLoadCustomHelpers; end; implementation uses JsonDataObjects, MVCFramework.Serializer.Defaults, MVCFramework.Serializer.Intf, MVCFramework.Serializer.Commons, MVCFramework.DuckTyping, MVCFramework.Serializer.JsonDataObjects.OptionalCustomTypes, MVCFramework.Serializer.JsonDataObjects; {$WARNINGS OFF} type TSynMustacheAccess = class(TSynMustache) end; var gPartialsLoaded : Boolean = False; gHelpersLoaded : Boolean = False; constructor TMVCMustacheViewEngine.Create(const AEngine: TMVCEngine; const AWebContext: TWebContext; const AViewModel: TMVCViewDataObject; const AContentType: string); begin inherited; fModelPrepared := False; LoadPartials; LoadHelpers; end; class constructor TMVCMustacheViewEngine.Create; begin fSerializerPool := MVCFramework.IntfObjectPool.TIntfObjectPool.Create(10000, 10,1, function: IInterface begin Result := TMVCJsonDataObjectsSerializer.Create(nil); RegisterOptionalCustomTypesSerializers(Result as IMVCSerializer); end); end; class destructor TMVCMustacheViewEngine.Destroy; begin fPartials.Free; end; function TMVCMustacheViewEngine.RenderJSON(lViewEngine: TSynMustache; const JSON: RawUTF8; Partials: TSynMustachePartials; Helpers: TSynMustacheHelpers; OnTranslate: TOnStringTranslate; EscapeInvert: boolean): RawUTF8; begin Result := lViewEngine.RenderJSON(JSON, Partials, Helpers, OnTranslate, EscapeInvert); end; procedure TMVCMustacheViewEngine.Execute(const ViewName: string; const OutputStream: TStream); var lViewFileName: string; lViewTemplate: RawUTF8; lViewEngine: TSynMustache; lSW: TStreamWriter; begin PrepareModels; lViewFileName := GetRealFileName(ViewName); if not FileExists(lViewFileName) then raise EMVCFrameworkViewException.CreateFmt('View [%s] not found', [ViewName]); lViewTemplate := StringToUTF8(TFile.ReadAllText(lViewFileName, TEncoding.UTF8)); lViewEngine := TSynMustache.Parse(lViewTemplate); lSW := TStreamWriter.Create(OutputStream); try lSW.Write(UTF8Tostring(RenderJSON(lViewEngine, FJSONModelAsString, fPartials, fHelpers, nil, false))); finally lSW.Free; end; end; procedure TMVCMustacheViewEngine.LoadHelpers; begin if gHelpersLoaded then begin Exit end else begin TMonitor.Enter(gLock); try if not gHelpersLoaded then begin fHelpers := TSynMustache.HelpersGetStandardList; TMVCMustacheHelpers.RegisterHandlers(fHelpers); {dmvcframework specific helpers} gHelpersLoaded := True; end; finally TMonitor.Exit(gLock); end; end; end; procedure TMVCMustacheViewEngine.LoadPartials; var lViewsExtension: string; lViewPath: string; lPartialName: String; lPartialFileNames: TArray; I: Integer; begin if gPartialsLoaded then begin Exit end else begin TMonitor.Enter(gLock); try if not gPartialsLoaded then begin lViewsExtension := Config[TMVCConfigKey.DefaultViewFileExtension]; lViewPath := Config[TMVCConfigKey.ViewPath]; lPartialFileNames := TDirectory.GetFiles(lViewPath, '*.' + lViewsExtension, TSearchOption.soAllDirectories); FreeAndNil(fPartials); fPartials := TSynMustachePartials.Create; for I := 0 to High(lPartialFileNames) do begin lPartialName := lPartialFileNames[i] .Remove(lPartialFileNames[i].Length - lViewsExtension.Length - 1) .Replace(TPath.DirectorySeparatorChar, '/'); lPartialName := lPartialName.Remove(0, lViewPath.Length + 1); fPartials.Add(lPartialName, TFile.ReadAllText(lPartialFileNames[i])); end; gPartialsLoaded := SameText(Config[TMVCConfigKey.ViewCache], 'true'); end; finally TMonitor.Exit(gLock); end; end; end; {$WARNINGS ON} procedure TMVCMustacheViewEngine.PrepareModels; var DataObj: TPair; lSer: IMVCSerializer; lJSONModel: TJsonObject; begin if fModelPrepared then begin Exit; end; if Assigned(FJSONModel) and (not Assigned(ViewModel)) then begin // if only jsonmodel is <> nil then we take the "fast path" FJSONModelAsString := FJSONModel.ToJSON(False); end else begin lSer := fSerializerPool.GetFromPool(True) as IMVCSerializer; try if Assigned(FJSONModel) then begin lJSONModel := FJSONModel.Clone as TJsonObject; end else begin lJSONModel := TJsonObject.Create; end; try if Assigned(ViewModel) then begin for DataObj in ViewModel do begin TMVCJsonDataObjectsSerializer(lSer).TValueToJSONObjectProperty(lJSONModel, DataObj.Key, DataObj.Value, TMVCSerializationType.stDefault, nil, nil); end; end; // if Assigned(ViewDataSets) then // begin // for lDSPair in ViewDataSets do // begin // TMVCJsonDataObjectsSerializer(lSer).DataSetToJsonArray(lDSPair.Value, lJSONModel.A[lDSPair.Key], TMVCNameCase.ncAsIs, nil); // end; // end; FJSONModelAsString := lJSONModel.ToJSON(False); finally lJSONModel.Free; end; finally fSerializerPool.ReleaseToPool(lSer) end; end; fModelPrepared := True; end; { dmvcframework specific helpers} class procedure TMVCMustacheHelpers.Capitalize(const Value: variant; out Result: variant); begin Result := MVCFramework.Commons.CamelCase(Value, True); end; class procedure TMVCMustacheHelpers.RegisterHandlers(var MustacheHelpers: TSynMustacheHelpers); begin TSynMustache.HelperAdd(MustacheHelpers, 'UpperCase', TMVCMustacheHelpers.ToUpperCase); TSynMustache.HelperAdd(MustacheHelpers, 'LowerCase', TMVCMustacheHelpers.ToLowerCase); TSynMustache.HelperAdd(MustacheHelpers, 'Capitalize', TMVCMustacheHelpers.Capitalize); TSynMustache.HelperAdd(MustacheHelpers, 'SnakeCase', TMVCMustacheHelpers.SnakeCase); if Assigned(fOnLoadCustomHelpers) then begin fOnLoadCustomHelpers(MustacheHelpers); end; end; class procedure TMVCMustacheHelpers.SnakeCase(const Value: variant; out Result: variant); begin Result := MVCFramework.Commons.SnakeCase(Value); end; class procedure TMVCMustacheHelpers.ToLowerCase(const Value: variant; out Result: variant); begin Result := System.SysUtils.LowerCase(Value); end; class procedure TMVCMustacheHelpers.ToUpperCase(const Value: variant; out Result: variant); begin Result := System.SysUtils.UpperCase(Value); end; end.