// - returns self so that may be called in a fluent interface
function RegisterExpressionHelpersForCrypto: TMVCViewsMustache;
/// finalize the instance
destructor Destroy; override;
end;
{ ====== Sessions ====== }
type
/// an abstract class able to implement ViewModel/Controller sessions
// - see TMVCSessionWithCookies to implement cookie-based sessions
// - this kind of ViewModel will implement client side storage of sessions,
// storing any (simple) record content on the browser client side
// - at login, a record containing session-related information (session ID,
// display and login name, preferences, rights...) can be computed only once
// on the server side from the Model, then stored on the client side (typically
// in a cookie): later on, session information can be retrieved by the server
// logic (via CheckAndRetrieve - note that any security attribute should be
// verified against the Model), then the renderer (CheckAndRetrieveInfo
// returning the record as TDocVariant in the data context "Session" field) -
// such a pattern is very efficient and allows good scaling
// - session are expected to be tied to the TMVCSessionAbstract instance
// lifetime, so are lost after server restart, unless they are persisted
// via LoadContext/SaveContext methods
TMVCSessionAbstract = class
public
/// create an instance of this ViewModel implementation class
constructor Create; virtual;
/// will create a new session
// - setting an optional record data, and returning the internal session ID
// - you can supply a time period, after which the session will expire -
// default is 1 hour - note that overriden methods may not implement it
function Initialize(PRecordData: pointer=nil; PRecordTypeInfo: pointer=nil;
SessionTimeOutMinutes: cardinal=60): integer; virtual; abstract;
/// fast check if there is a session associated to the current context
function Exists: boolean; virtual; abstract;
/// retrieve the current session ID
// - can optionally retrieve the associated record Data parameter
function CheckAndRetrieve(PRecordData: pointer=nil; PRecordTypeInfo: pointer=nil;
PExpires: PCardinal=nil): integer; virtual; abstract;
/// retrieve the session information as a JSON object
// - returned as a TDocVariant, including any associated record Data
// - will call CheckAndRetrieve() then RecordSaveJSON() and _JsonFast()
function CheckAndRetrieveInfo(PRecordDataTypeInfo: pointer): variant; virtual;
/// clear the session
procedure Finalize; virtual; abstract;
/// return all session generation information as ready-to-be stored string
// - to be retrieved via LoadContext, e.g. after restart
function SaveContext: RawUTF8; virtual; abstract;
/// restore session generation information from SaveContext format
// - returns TRUE on success
function LoadContext(const Saved: RawUTF8): boolean; virtual; abstract;
end;
/// information used by TMVCSessionWithCookies for cookie generation
// - i.e. the session ID, cookie name, encryption and HMAC secret keys
// - this data can be persisted so that the very same cookie information
// are available after server restart
TMVCSessionWithCookiesContext = packed record
/// the cookie name, used for storage on the client side
CookieName: RawUTF8;
/// an increasing counter, to implement unique session ID
SessionSequence: integer;
/// secret information, used for HMAC digital signature of cookie content
Secret: THMAC_CRC32C;
/// random IV used as CTR on Crypt[] secret key
CryptNonce: Cardinal;
/// secret information, used for encryption of the cookie content
Crypt: array[byte] of byte;
end;
/// a class able to implement ViewModel/Controller sessions with cookies
// - this kind of ViewModel will implement cookie-based sessions, able to
// store any (simple) record content in the cookie, on the browser client side
// - those cookies have the same feature set than JWT, but with a lower
// payload (thanks to binary serialization), and cookie safety (not accessible
// from JavaScript): they are digitally signed (with HMAC-CRC32C and a
// temporary secret key), they include an unique session identifier (like
// "jti" claim), issue and expiration dates (like "iat" and "exp" claims),
// and they are encrypted with a temporary key - this secret keys is tied to
// the TMVCSessionWithCookies instance lifetime, so new cookies are generated
// after server restart, unless they are persisted via LoadContext/SaveContext
// - signature and encryption are weak, but very fast, to avoid DDOS attacks
TMVCSessionWithCookies = class(TMVCSessionAbstract)
protected
fContext: TMVCSessionWithCookiesContext;
// overriden e.g. in TMVCSessionWithRestServer using ServiceContext threadvar
function GetCookie: RawUTF8; virtual; abstract;
procedure SetCookie(const cookie: RawUTF8); virtual; abstract;
procedure Crypt(P: PAnsiChar; bytes: integer);
function CheckAndRetrieveFromCookie(const cookie: RawUTF8;
PRecordData, PRecordTypeInfo: pointer; PExpires: PCardinal): integer;
public
/// create an instance of this ViewModel implementation class
constructor Create; override;
/// will initialize the session cookie
// - setting an optional record data, which will be stored Base64-encoded
// - will return the 32-bit internal session ID
// - you can supply a time period, after which the session will expire -
// default is 1 hour, and could go up to
function Initialize(PRecordData: pointer=nil; PRecordTypeInfo: pointer=nil;
SessionTimeOutMinutes: cardinal=60): integer; override;
/// fast check if there is a cookie session associated to the current context
function Exists: boolean; override;
/// retrieve the session ID from the current cookie
// - can optionally retrieve the record Data parameter stored in the cookie
// - will return the 32-bit internal session ID, or 0 if the cookie is invalid
function CheckAndRetrieve(PRecordData: pointer=nil; PRecordTypeInfo: pointer=nil;
PExpires: PCardinal=nil): integer; override;
/// clear the session
// - by deleting the cookie on the client side
procedure Finalize; override;
/// return all cookie generation information as base64 encoded text
// - to be retrieved via LoadContext
function SaveContext: RawUTF8; override;
/// restore cookie generation information from SaveContext text format
// - returns TRUE after checking the crc and unserializing the supplied data
// - WARNING: if the unerlying record type structure changed (i.e. any
// field is modified or added), restoration will lead to data corruption of
// low-level binary content, then trigger unexpected GPF: if you change the
// record type definition, do NOT use LoadContext - and reset all cookies
function LoadContext(const Saved: RawUTF8): boolean; override;
/// direct access to the low-level information used for cookies generation
// - use SaveContext and LoadContext methods to persist this information
// before server shutdown, so that the cookies can be re-used after restart
property Context: TMVCSessionWithCookiesContext read fContext write fContext;
/// you can customize the cookie name
// - default is 'mORMot', and cookie is restricted to Path=/RestRoot
property CookieName: RawUTF8 read fContext.CookieName write fContext.CookieName;
end;
/// implement a ViewModel/Controller sessions in a TSQLRestServer instance
// - will use ServiceContext.Request threadvar to access the client cookies
TMVCSessionWithRestServer = class(TMVCSessionWithCookies)
protected
function GetCookie: RawUTF8; override;
procedure SetCookie(const cookie: RawUTF8); override;
end;
/// implement a single ViewModel/Controller in-memory session
// - this kind of session could be used in-process, e.g. for a VCL/FMX GUI
// - do NOT use it with multiple clients, e.g. from HTTP remote access
TMVCSessionSingle = class(TMVCSessionWithCookies)
protected
fSingleCookie: RawUTF8;
function GetCookie: RawUTF8; override;
procedure SetCookie(const cookie: RawUTF8); override;
end;
{ ====== Application Run ====== }
/// record type to define commands e.g. to redirect to another URI
// - do NOT access those record property directly, but rather use
// TMVCApplication.GotoView/GotoError/GotoDefault methods, e.g.
// ! function TBlogApplication.Logout: TMVCAction;
// ! begin
// ! CurrentSession.Finalize;
// ! GotoDefault(result);
// ! end;
// - this record type should match exactly TServiceCustomAnswer layout,
// so that TServiceMethod.InternalExecute() would handle it directly
TMVCAction = record
/// the method name to be executed
RedirectToMethodName: RawUTF8;
/// may contain a JSON object which will be used to specify parameters
// to the specified method
RedirectToMethodParameters: RawUTF8;
/// which HTTP Status code should be returned
// - if RedirectMethodName is set, will return 307 HTTP_TEMPORARYREDIRECT
// by default, but you can set here the expected HTTP Status code, e.g.
// 201 HTTP_CREATED or 404 HTTP_NOTFOUND
ReturnedStatus: cardinal;
end;
TMVCApplication = class;
/// abstract MVC rendering execution context
// - you shoud not execute this abstract class, but any of the inherited class
// - one instance inherited from this class would be allocated for each event
// - may return some data (when inheriting from TMVCRendererReturningData), or
// even simply display the value in a VCL/FMX GUI, without any output
TMVCRendererAbstract = class
protected
fApplication: TMVCApplication;
fMethodIndex: integer;
fMethodReturnsAction: boolean;
fInput: RawUTF8;
procedure Renders(var outContext: variant; status: cardinal;
forcesError: boolean); virtual; abstract;
function Redirects(const action: TMVCAction): boolean; virtual;
procedure CommandError(const ErrorName: RawUTF8; const ErrorValue: variant;
ErrorCode: Integer); virtual;
public
/// initialize a rendering process for a given MVC Application/ViewModel
constructor Create(aApplication: TMVCApplication); reintroduce;
/// main execution method of the rendering process
// - Input should have been set with the incoming execution context
procedure ExecuteCommand(aMethodIndex: integer); virtual;
/// incoming execution context, to be processed via ExecuteCommand() method
// - should be specified as a raw JSON object
property Input: RawUTF8 read fInput write fInput;
end;
/// how TMVCRendererReturningData should cache its content
TMVCRendererCachePolicy = (
cacheNone,
cacheRootIgnoringSession, cacheRootIfSession, cacheRootIfNoSession,
cacheRootWithSession,
cacheWithParametersIgnoringSession, cacheWithParametersIfSession,
cacheWithParametersIfNoSession);
TMVCRunWithViews = class;
/// abstract MVC rendering execution context, returning some content
// - the Output property would contain the content to be returned
// - can be used to return e.g. some rendered HTML or some raw JSON,
// or even some server-side generated report as PDF, using our mORMotReport.pas
TMVCRendererReturningData = class(TMVCRendererAbstract)
protected
fRun: TMVCRunWithViews;
fOutput: TServiceCustomAnswer;
fOutputFlags: TMVCViewFlags;
fCacheEnabled: boolean;
fCacheCurrent: (noCache, rootCache, inputCache);
fCacheCurrentSec: cardinal;
fCacheCurrentInputValueKey: RawUTF8;
function Redirects(const action: TMVCAction): boolean; override;
public
/// initialize a rendering process for a given MVC Application/ViewModel
// - you need to specify a MVC Views engine, e.g. TMVCViewsMustache instance
constructor Create(aRun: TMVCRunWithViews); reintroduce; virtual;
/// main execution method of the rendering process
// - this overriden method would handle proper caching as defined by
// TMVCRunWithViews.SetCache()
procedure ExecuteCommand(aMethodIndex: integer); override;
/// caller should retrieve this value after ExecuteCommand method execution
property Output: TServiceCustomAnswer read fOutput;
end;
TMVCRendererReturningDataClass = class of TMVCRendererReturningData;
/// MVC rendering execution context, returning some rendered View content
// - will use an associated Views templates system, e.g. a Mustache renderer
TMVCRendererFromViews = class(TMVCRendererReturningData)
protected
// Renders() will fill Output using the corresponding View, to be sent back
procedure Renders(var outContext: variant; status: cardinal; forcesError: boolean); override;
public
/// initialize a rendering process for a given MVC Application/ViewModel
// - this overriden constructor will ensure that cache is enabled
constructor Create(aRun: TMVCRunWithViews); override;
end;
/// MVC rendering execution context, returning some un-rendered JSON content
// - may be used e.g. for debugging purpose
// - for instance, TMVCRunOnRestServer will return such context with the
// supplied URI ends with '/json' (e.g. for any /root/method/json request)
TMVCRendererJson = class(TMVCRendererReturningData)
protected
// Renders() will fill Output with the outgoing JSON, to be sent back
procedure Renders(var outContext: variant; status: cardinal; forcesError: boolean); override;
end;
/// abstract class used by TMVCApplication to run
// - a single TMVCApplication logic may handle several TMVCRun instances
TMVCRun = class
protected
fApplication: TMVCApplication;
public
/// link this runner class to a specified MVC application
// - will also reset the associated Application.Session instance
constructor Create(aApplication: TMVCApplication); reintroduce;
/// method called to flush the caching mechanism for all MVC commands
procedure NotifyContentChanged; virtual;
/// you may call this method to flush any caching mechanism for a MVC command
procedure NotifyContentChangedForMethod(aMethodIndex: integer); overload; virtual;
/// you may call this method to flush any caching mechanism for a MVC command
procedure NotifyContentChangedForMethod(const aMethodName: RawUTF8); overload;
/// read-write access to the associated MVC Application/ViewModel instance
property Application: TMVCApplication read fApplication write fApplication;
end;
/// abstract class used by TMVCApplication to run TMVCViews-based process
// - this inherited class will host a MVC Views instance, and handle
// an optional simple in-memory cache
TMVCRunWithViews = class(TMVCRun)
protected
fViews: TMVCViewsAbstract;
fCacheLocker: IAutoLocker;
fCache: array of record // fCache[MethodIndex]
Policy: TMVCRendererCachePolicy;
TimeOutSeconds: cardinal;
RootValue: RawUTF8;
RootValueExpirationTime: cardinal;
InputValues: TSynNameValue;
end;
public
/// link this runner class to a specified MVC application
constructor Create(aApplication: TMVCApplication;
aViews: TMVCViewsAbstract=nil); reintroduce;
/// method called to flush the caching mechanism for a MVC command
procedure NotifyContentChangedForMethod(aMethodIndex: integer); override;
/// defines the caching policy for a given MVC command
// - a time expiration period (up to 5 minutes) can also be defined per
// MVC command - leaving default 0 will set to 5 minutes expiration delay
// - function calls can be chained to create some fluent definition interface
// like in TAnyBLogapplication.Create:
// ! fMainRunner := TMVCRunWithViews.Create(self).SetCache('default',cacheRoot);
function SetCache(const aMethodName: RawUTF8; aPolicy: TMVCRendererCachePolicy;
aTimeOutSeconds: cardinal=0): TMVCRunWithViews; virtual;
/// finalize this instance
destructor Destroy; override;
/// read-write access to the associated MVC Views instance
property Views: TMVCViewsAbstract read fViews;
end;
/// the kinds of optional content which may be published
// - publishMvcInfo will define a /root/[aSubURI/]mvc-info HTML page,
// which is pretty convenient when working with views
// - publishStatic will define a /root/[aSubURI/].static sub-folder,
// ready to serve any file available in the Views\.static local folder,
// via an in-memory cache (if cacheStatic is also defined)
// - cacheStatic enables an in-memory cache of publishStatic files; if not set,
// TSQLRestServerURIContext.ReturnFile is called to avoid buffering, which may
// be a better solution on http.sys or if NGINX's X-Accel-Redirect header is set
// - registerORMTableAsExpressions will register Mustache Expression Helpers
// for every TSQLRecord table of the Server data model
// - by default, TSQLRestServer authentication would be by-passed for all
// MVC routes, unless bypassAuthentication option is undefined
TMVCPublishOption = (publishMvcInfo, publishStatic, cacheStatic,
registerORMTableAsExpressions, bypassAuthentication);
/// which kind of optional content should be publish
TMVCPublishOptions = set of TMVCPublishOption;
/// run TMVCApplication directly within a TSQLRestServer method-based service
// - this is the easiest way to host and publish a MVC Application, optionally
// in conjunction with REST/AJAX client access
TMVCRunOnRestServer = class(TMVCRunWithViews)
protected
fRestServer: TSQLRestServer;
fPublishOptions: TMVCPublishOptions;
fMvcInfoCache: RawUTF8;
fStaticCache: TSynNameValue;
fStaticCacheControlMaxAge: integer;
/// callback used for the rendering on the TSQLRestServer
procedure RunOnRestServerRoot(Ctxt: TSQLRestServerURIContext);
procedure RunOnRestServerSub(Ctxt: TSQLRestServerURIContext);
procedure InternalRunOnRestServer(Ctxt: TSQLRestServerURIContext;
const MethodName: RawUTF8);
public
/// this constructor will publish some views to a TSQLRestServer instance
// - the associated RestModel can match the supplied TSQLRestServer, or be
// another instance (if the data model is not part of the publishing server)
// - all TMVCApplication methods would be registered to the TSQLRestServer,
// as /root/methodName if aSubURI is '', or as /root/aSubURI/methodName
// - if aApplication has no Views instance associated, this constructor will
// initialize a Mustache renderer in its default folder, with '.html' void
// template generation
// - will also create a TMVCSessionWithRestServer for simple cookie sessions
// - aPublishOptions could be used to specify integration with the server
constructor Create(aApplication: TMVCApplication;
aRestServer: TSQLRestServer=nil; const aSubURI: RawUTF8='';
aViews: TMVCViewsAbstract=nil; aPublishOptions: TMVCPublishOptions=
[low(TMVCPublishOption)..high(TMVCPublishOption)]); reintroduce;
/// define some content for a static file
// - only used if cacheStatic has been defined
function AddStaticCache(const aFileName: TFileName;
const aFileContent: RawByteString): RawByteString;
/// current publishing options, as specify to the constructor
property PublishOptions: TMVCPublishOptions read fPublishOptions write fPublishOptions;
/// optional "Cache-Control: max-age=###" header value for static content
property StaticCacheControlMaxAge: integer
read fStaticCacheControlMaxAge write fStaticCacheControlMaxAge;
end;
{ ====== Application / ViewModel ====== }
/// Exception class triggerred by mORMot MVC/MVVM applications internally
// - those error are internal fatal errors of the server side process
EMVCException = class(ESynException);
/// Exception class triggerred by mORMot MVC/MVVM applications externally
// - those error are external errors which should be notified to the client
// - can be used to change the default view, e.g. on application error
EMVCApplication = class(ESynException)
protected
fAction: TMVCAction;
public
/// same as calling TMVCApplication.GotoView()
// - HTTP_TEMPORARYREDIRECT will change the URI, but HTTP_SUCCESS won't
constructor CreateGotoView(const aMethod: RawUTF8;
const aParametersNameValuePairs: array of const;
aStatus: cardinal=HTTP_TEMPORARYREDIRECT);
/// same as calling TMVCApplication.GotoError()
constructor CreateGotoError(const aErrorMessage: string;
aErrorCode: integer=HTTP_BADREQUEST); overload;
/// same as calling TMVCApplication.GotoError()
constructor CreateGotoError(aHtmlErrorCode: integer); overload;
/// same as calling TMVCApplication.GotoDefault
// - HTTP_TEMPORARYREDIRECT will change the URI, but HTTP_SUCCESS won't
constructor CreateDefault(aStatus: cardinal=HTTP_TEMPORARYREDIRECT);
end;
/// defines the main and error pages for the ViewModel of one application
IMVCApplication = interface(IInvokable)
['{C48718BF-861B-448A-B593-8012DB51E15D}']
/// the default main page
// - whole data context is retrieved and returned as a TDocVariant
procedure Default(var Scope: variant);
/// the error page
// - in addition to the error message, a whole data context is retrieved
// and returned as a TDocVariant
procedure Error(var Msg: RawUTF8; var Scope: variant);
end;
/// parent class to implement a MVC/MVVM application
// - you should inherit from this class, then implement an interface inheriting
// from IMVCApplication to define the various commands of the application
// - here the Model would be a TSQLRest instance, Views will be defined by
// TMVCViewsAbstract (e.g. TMVCViewsMustache), and the ViewModel/Controller
// will be implemented with IMVCApplication methods of the inherited class
// - inherits from TInjectableObject, so that you could resolve dependencies
// via services or stubs, following the IoC pattern
TMVCApplication = class(TInjectableObject)
protected
fFactory: TInterfaceFactory;
fFactoryEntry: pointer;
fFactoryErrorIndex: integer;
fSession: TMVCSessionAbstract;
fRestModel: TSQLRest;
fRestServer: TSQLRestServer;
fLocker: IAutoLocker;
// if any TMVCRun instance is store here, will be freed by Destroy
// but note that a single TMVCApplication logic may handle several TMVCRun
fMainRunner: TMVCRun;
procedure SetSession(Value: TMVCSessionAbstract);
/// to be called when the data model did change to force content re-creation
// - this default implementation will call fMainRunner.NotifyContentChanged
procedure FlushAnyCache; virtual;
/// generic IMVCApplication.Error method implementation
procedure Error(var Msg: RawUTF8; var Scope: variant); virtual;
/// every view will have this data context transmitted as "main":...
procedure GetViewInfo(MethodIndex: integer; out info: variant); virtual;
/// compute the data context e.g. for the /mvc-info URI
procedure GetMvcInfo(out info: variant); virtual;
/// wrappers to redirect to IMVCApplication standard methods
// - if status is HTTP_TEMPORARYREDIRECT, it will change the URI
// whereas HTTP_SUCCESS would just render the view for the current URI
class procedure GotoView(var Action: TMVCAction; const MethodName: RawUTF8;
const ParametersNameValuePairs: array of const;
Status: cardinal=HTTP_TEMPORARYREDIRECT);
class procedure GotoError(var Action: TMVCAction; const Msg: string;
ErrorCode: integer=HTTP_BADREQUEST); overload;
class procedure GotoError(var Action: TMVCAction; ErrorCode: integer); overload;
class procedure GotoDefault(var Action: TMVCAction;
Status: cardinal=HTTP_TEMPORARYREDIRECT);
public
/// initialize the instance of the MVC/MVVM application
// - define the associated REST instance, and the interface definition for
// application commands
// - is not defined as constructor, since this TInjectableObject may
// expect injection using the CreateInjected() constructor
procedure Start(aRestModel: TSQLRest; aInterface: PTypeInfo); virtual;
/// finalize the application
// - and release any associated CurrentSession, Views, and fMainRunner
destructor Destroy; override;
/// read-only access to the associated mORMot REST instance implementing the
// MVC data Model of the application
// - is a TSQLRestServer instance e.g. for TMVCRunOnRestServer
property RestModel: TSQLRest read fRestModel;
/// read-only access to the associated factory for IMVCApplication interface
property Factory: TInterfaceFactory read fFactory;
/// read-write access to the associated Session instance
property CurrentSession: TMVCSessionAbstract read fSession write SetSession;
/// global mutex which may be used to protect ViewModel/Controller code
// - you may call Locker.ProtectMethod in any implementation method to
// ensure that no other thread would access the same data
// - for store some cache data among methods, you may consider defining a
// ILockedDocVariant private field, and use it to store values safely
// - note that regular RestModel CRUD operations are already thread safe, so
// it is not necessary to use this Locker with ORM or SOA methods
property Locker: IAutoLocker read fLocker;
/// read-write access to the main associated TMVCRun instance
// - if any TMVCRun instance is stored here, will be freed by Destroy
// - but note that a single TMVCApplication logic may handle several TMVCRun
property MainRunner: TMVCRun read fMainRunner;
end;
const
/// the pseudo-method name for the MVC information html page
MVCINFO_URI = 'mvc-info';
/// the pseudo-method name for any static content for Views
STATIC_URI = '.static';
implementation
{ TMVCViewsAbstract }
constructor TMVCViewsAbstract.Create(aInterface: PTypeInfo; aLogClass: TSynLogClass);
begin
inherited Create;
fFactory := TInterfaceFactory.Get(aInterface);
fFactoryErrorIndex := fFactory.FindMethodIndex('Error');
if aLogClass=nil then
fLogClass := TSQLLog else
fLogClass := aLogClass;
fViewGenerationTimeTag := '[[GENERATION_TIME_TAG]]';
end;
procedure TMVCViewsAbstract.SetViewTemplateFolder(const aFolder: TFileName);
begin
fViewTemplateFolder := IncludeTrailingPathDelimiter(aFolder);
fViewStaticFolder := IncludeTrailingPathDelimiter(fViewTemplateFolder+STATIC_URI);
end;
function TMVCViewsAbstract.GetStaticFile(const aFileName: TFileName): RawByteString;
begin
result := StringFromFile(fViewStaticFolder + aFileName);
end;
{ TMVCViewsMustache }
const
MUSTACHE_METHODPARTIAL =
'{{Generated by a mORMot {{mORMot}} server
'+
'©Synopse Informatique - '+
'https://synopse.info
Registered interface is:
'#13#10+
' I{{name}} = interface(IInvokable)'#13#10'{{#methods}}'#13#10+
' {{>method}}'#13#10'{{/methods}}'#13#10' end;'#13#10+
'Use this page as reference when writing your Mustache Views.
'+ 'You can access the following commands:
'+ 'Any missing parameter '+ 'would be replaced by its default value.
The following views are defined, with expected data context:
{{>mustache}}'+ '
'+
'Currently, all views are located in the {{viewsFolder}} folder.
A '+
'{{exceptionName}} exception did raise during {{className}} process '+
'with the following message:
{{exceptionMessage}}'+ 'Triggered with the following context:
{{originalErrorContext}}';
function MethodHasView(const aMethod: TServiceMethod): boolean;
begin // any method returning a TMVCAction do not have any associated view
result := (aMethod.ArgsResultIndex<0) or
(aMethod.Args[aMethod.ArgsResultIndex].ValueType<>smvRecord) or
(aMethod.Args[aMethod.ArgsResultIndex].ArgTypeInfo<>TypeInfo(TMVCAction));
end;
constructor TMVCViewsMustache.Create(aInterface: PTypeInfo;
const aParameters: TMVCViewsMustacheParameters; aLogClass: TSynLogClass);
var m, i: integer;
LowerExt: TFileName;
files: TFileNameDynArray;
partial: TSynMustache;
partialName: RawUTF8;
info: variant;
begin
inherited Create(aInterface,aLogClass);
// get views
fViewTemplateFileTimestampMonitor := aParameters.FileTimestampMonitorAfterSeconds;
if aParameters.Folder='' then
ViewTemplateFolder := ExeVersion.ProgramFilePath+'Views' else
ViewTemplateFolder := aParameters.Folder;
if (aParameters.ExtensionForNotExistingTemplate<>'') and
(not DirectoryExists(ViewTemplateFolder)) then
CreateDir(ViewTemplateFolder);
if aParameters.CSVExtensions='' then
LowerExt := ',html,json,css,' else
LowerExt := ','+SysUtils.LowerCase(aParameters.CSVExtensions)+',';
SetLength(fViews,fFactory.MethodsCount);
for m := 0 to fFactory.MethodsCount-1 do
if MethodHasView(fFactory.Methods[m]) then
with fViews[m] do begin
Locker := TAutoLocker.Create;
MethodName := UTF8ToString(fFactory.Methods[m].URI);
SearchPattern := MethodName+'.*';
files := FindTemplates(SearchPattern);
if length(files)>0 then begin
for i := 0 to length(files)-1 do begin
ShortFileName := files[i];
FileExt := SysUtils.LowerCase(copy(ExtractFileExt(ShortFileName),2,100));
if Pos(','+FileExt+',',LowerExt)>0 then
break; // found a template with the right extension
end;
FileName := ViewTemplateFolder+ShortFileName;
ContentType := GetMimeContentType(nil,0,ShortFileName);
end else begin
fLogClass.Add.Log(
sllWarning,'%.Create: Missing View file in %',[self,SearchPattern]);
if aParameters.ExtensionForNotExistingTemplate<>'' then begin
ShortFileName := MethodName+aParameters.ExtensionForNotExistingTemplate;
FileName := ViewTemplateFolder+ShortFileName;
info := ContextFromMethod(fFactory.Methods[m]);
info.interfaceName := fFactory.InterfaceTypeInfo^.Name;
FileFromString(StringReplaceChars(StringReplaceChars(
TSynMustache.Parse(MUSTACHE_VOIDVIEW).Render(info),'<','{'),'>','}'),
FileName);
end;
end;
end;
fViewHelpers := aParameters.Helpers;
// get partials
fViewPartials := TSynMustachePartials.Create;
files := FindTemplates('*.partial');
for i := 0 to length(files)-1 do begin
StringToUTF8(GetFileNameWithoutExt(files[i]),partialName);
try
partial := fViewPartials.Add(partialName,GetTemplate(files[i]));
if not(viewHasGenerationTimeTag in fViewFlags) and
partial.FoundInTemplate(fViewGenerationTimeTag) then
include(fViewFlags,viewHasGenerationTimeTag);
except
on E: Exception do
fLogClass.Add.Log(
sllError,'%.Create: Invalid Partial file % - %',[self,files[i],E]);
end;
end;
end;
constructor TMVCViewsMustache.Create(aInterface: PTypeInfo;
aLogClass: TSynLogClass; aExtensionForNotExistingTemplate: TFileName);
var params: TMVCViewsMustacheParameters;
begin
fillchar(params,sizeof(params),0);
params.FileTimestampMonitorAfterSeconds := 5;
params.ExtensionForNotExistingTemplate := aExtensionForNotExistingTemplate;
params.Helpers := TSynMustache.HelpersGetStandardList;
Create(aInterface,params,aLogClass);
end;
destructor TMVCViewsMustache.Destroy;
begin
inherited;
fViewPartials.Free;
end;
type
THtmlTableStyleLabel = (labelFalse,labelTrue,labelOff,labelOn,labelValue);
TExpressionHtmlTableStyle = class
public
class procedure StartTable(WR: TTextWriter); virtual;
class procedure BeforeFieldName(WR: TTextWriter); virtual;
class procedure BeforeValue(WR: TTextWriter); virtual;
class procedure AddLabel(WR: TTextWriter; const text: string;
kind: THtmlTableStyleLabel); virtual;
class procedure AfterValue(WR: TTextWriter); virtual;
class procedure EndTable(WR: TTextWriter); virtual;
end;
TExpressionHtmlTableStyleBootstrap = class(TExpressionHtmlTableStyle)
public
class procedure StartTable(WR: TTextWriter); override;
class procedure AddLabel(WR: TTextWriter; const text: string;
kind: THtmlTableStyleLabel); override;
end;
TExpressionHtmlTableStyleClass = class of TExpressionHtmlTableStyle;
TExpressionHelperForTable = class
public
Rest: TSQLRest;
Table: TSQLRecordClass;
TableProps: TSQLRecordProperties;
HtmlTableStyle: TExpressionHtmlTableStyleClass;
constructor Create(aRest: TSQLRest; aTable: TSQLRecordClass;
var aHelpers: TSynMustacheHelpers);
procedure ExpressionGet(const Value: variant; out result: variant);
procedure ExpressionHtmlTable(const Value: variant; out result: variant);
end;
constructor TExpressionHelperForTable.Create(aRest: TSQLRest;
aTable: TSQLRecordClass; var aHelpers: TSynMustacheHelpers);
var HelperName: RawUTF8;
begin
aRest.PrivateGarbageCollector.Add(self);
Rest := aRest;
HelperName := RawUTF8(aTable.ClassName);
Table := aTable;
TableProps := aTable.RecordProps;
TSynMustache.HelperAdd(aHelpers,HelperName,ExpressionGet);
HtmlTableStyle := TExpressionHtmlTableStyleBootstrap;
TSynMustache.HelperAdd(aHelpers,HelperName+'.HtmlTable',ExpressionHtmlTable);
end;
procedure TExpressionHelperForTable.ExpressionHtmlTable(const Value: variant;
out result: variant);
var Rec: PDocVariantData;
f,i,j,int: integer;
Field: TSQLPropInfo;
timelog: TTimeLogBits;
caption: string;
sets: TStringList;
utf8: RawUTF8;
W: TTextWriter;
tmp: TTextWriterStackBuffer;
const ONOFF: array[boolean] of THtmlTableStyleLabel = (labelOff,labelOn);
ENUM: array[boolean,boolean] of THtmlTableStyleLabel =
((labelValue,labelValue),(labelFalse,labelTrue));
begin
Rec := _Safe(Value);
if Rec^.Kind=dvObject then begin
W := TTextWriter.CreateOwnedStream(tmp);
try
HtmlTableStyle.StartTable(W);
for f := 0 to TableProps.Fields.Count-1 do begin
Field := TableProps.Fields.List[f];
i := Rec^.GetValueIndex(Field.Name);
if i<0 then
continue;
if not (Field.SQLFieldType in [sftAnsiText,sftUTF8Text,sftInteger,
sftFloat,sftCurrency,sftTimeLog,sftModTime,sftCreateTime,sftDateTime,
sftDateTimeMS,sftUnixTime,sftUnixMSTime,sftBoolean,sftEnumerate,sftSet]) then
continue;
HtmlTableStyle.BeforeFieldName(W);
GetCaptionFromPCharLen(TrimLeftLowerCase(Field.Name),caption);
W.AddHtmlEscapeString(caption);
HtmlTableStyle.BeforeValue(W);
VariantToUTF8(Rec^.Values[i],utf8);
case Field.SQLFieldType of
sftAnsiText,sftUTF8Text,sftInteger,sftFloat,sftCurrency:
W.AddHtmlEscape(pointer(utf8));
sftTimeLog,sftModTime,sftCreateTime:
if VariantToInt64(Rec^.Values[i],timelog.Value) then
W.AddHtmlEscapeString(timeLog.i18nText);
sftDateTime, sftDateTimeMS: begin
timelog.From(utf8);
W.AddHtmlEscapeString(timeLog.i18nText);
end;
sftUnixTime, sftUnixMSTime:
if VariantToInt64(Rec^.Values[i],timelog.Value) then begin
if Field.SQLFieldType=sftUnixTime then
timelog.FromUnixTime(timelog.Value) else
timelog.FromUnixMSTime(timelog.Value);
W.AddHtmlEscapeString(timeLog.i18nText);
end;
sftBoolean,sftEnumerate:
if Field.InheritsFrom(TSQLPropInfoRTTIEnum) then begin
caption := TSQLPropInfoRTTIEnum(Field).GetCaption(utf8,int);
HtmlTableStyle.AddLabel(W,caption,
ENUM[Field.SQLFieldType=sftBoolean,int<>0]);
end;
sftSet:
if Field.InheritsFrom(TSQLPropInfoRTTISet) and
VariantToInteger(Rec^.Values[i],int) then begin
sets := TStringList.Create;
try
TSQLPropInfoRTTISet(Field).SetEnumType^.AddCaptionStrings(sets);
for j := 0 to sets.Count-1 do begin
HtmlTableStyle.AddLabel(W,sets[j],ONOFF[GetBit(int,j)]);
W.AddShort('