Delphi/delphimvcframework
1
0
Fork 0
mirror of https://github.com/danieleteti/delphimvcframework.git synced 2024-11-15 07:45:54 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

https://github.com/danieleteti/delphimvcframework/issues/693

Browse Source
This commit is contained in:
Daniele Teti 2024-04-29 13:35:07 +02:00
parent dc29941164
commit 8e8c31b904
8 changed files with 193 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

106
ideexpert/DMVC.Expert.CodeGen.Commands.pas
View File

@ -140,6 +140,19 @@ type
); override;
end;
TUnitMustacheHelpersDeclarationCommand = class(TCustomCommand)
public
procedure ExecuteInterface(
Section: TStringBuilder;
Model: TJSONObject
); override;
procedure ExecuteImplementation(
Section: TStringBuilder;
Model: TJsonObject
); override;
end;
TUnitFooterCommand = class(TCustomCommand)
public
procedure ExecuteImplementation(
@ -273,7 +286,14 @@ begin
.AppendLine(' Web.WebReq,')
.AppendLine(' Web.WebBroker,')
.AppendLine(' IdContext,')
.AppendLine(' IdHTTPWebBrokerBridge,')
.AppendLine(' IdHTTPWebBrokerBridge,');
if Model.B[TConfigKey.program_ssv_mustache] then
begin
Section
.AppendLine(' MVCFramework.View.Renderers.Mustache,')
.AppendLine(' SynMustache,');
end;
Section
.AppendLine(' MVCFramework,')
.AppendLine(' MVCFramework.Logger,')
.AppendLine(' MVCFramework.DotEnv,')
@ -649,7 +669,13 @@ begin
Section
.AppendLine(' System.IOUtils,')
.AppendLine(' MVCFramework.Commons,')
.AppendLine(' MVCFramework.Commons,');
if Model.B[TConfigKey.program_ssv_mustache] then
begin
Section
.AppendLine(' MVCFramework.View.Renderers.Mustache,')
end;
Section
.AppendLine(' MVCFramework.Middleware.ActiveRecord,')
.AppendLine(' MVCFramework.Middleware.StaticFiles,')
.AppendLine(' MVCFramework.Middleware.Analytics,')
@ -692,7 +718,16 @@ begin
.AppendLine(' // Controllers')
.AppendLine(' FMVC.AddController(' + Model[TConfigKey.controller_classname] + ');')
.AppendLine(' // Controllers - END')
.AppendLine
.AppendLine;
if Model.B[TConfigKey.program_ssv_mustache] then
begin
Section
.AppendLine(' // Server Side View')
.AppendLine(' FMVC.SetViewEngine(TMVCMustacheViewEngine);')
.AppendLine(' // Server Side View - END')
.AppendLine;
end;
Section
.AppendLine(' // Middleware');
if Model.B[TConfigKey.webmodule_middleware_analytics] then
@ -910,7 +945,19 @@ begin
.AppendLine(' Profiler.WarningThreshold := dotEnv.Env(''dmvc.profiler.warning_threshold'', 2000);')
.AppendLine(' end;')
.AppendLine('{$ENDIF}')
.AppendLine
.AppendLine;
if Model.B[TConfigKey.program_ssv_mustache] then
begin
Section
.AppendLine(' // Project specific Mustache helpers')
.AppendLine(' TMVCMustacheHelpers.OnLoadCustomHelpers := procedure(var MustacheHelpers: TSynMustacheHelpers)')
.AppendLine(' begin')
.AppendLine(' TSynMustache.HelperAdd(MustacheHelpers, ''MyHelper1'', TMyMustacheHelpers.MyHelper1);')
.AppendLine(' TSynMustache.HelperAdd(MustacheHelpers, ''MyHelper2'', TMyMustacheHelpers.MyHelper2);')
.AppendLine(' end;')
.AppendLine;
end;
Section
.AppendLine(' RunServer(dotEnv.Env(''dmvc.server.port'', ' + Model[TConfigKey.program_default_server_port] + '));')
.AppendLine(' except')
.AppendLine(' on E: Exception do')
@ -1044,4 +1091,55 @@ begin
end;
{ TUnitMustacheHelpersDeclarationCommand }
procedure TUnitMustacheHelpersDeclarationCommand.ExecuteImplementation(
Section: TStringBuilder; Model: TJsonObject);
begin
inherited;
Section
.AppendLine('implementation')
.AppendLine
.AppendLine('uses')
.AppendLine(' MVCFramework.View.Renderers.Mustache, System.SysUtils;')
.AppendLine
.AppendLine('{ TMyMustacheHelpers }')
.AppendLine
.AppendLine('class procedure TMyMustacheHelpers.MyHelper1(const Value: variant; out Result: variant);')
.AppendLine('begin')
.AppendLine(' Result := Value + '' (I''''m The MyHelper1)'';')
.AppendLine('end;')
.AppendLine
.AppendLine('class procedure TMyMustacheHelpers.MyHelper2(const Value: variant; out Result: variant);')
.AppendLine('begin')
.AppendLine(' Result := Value + '' (I''''m The MyHelper2)'';')
.AppendLine('end;')
.AppendLine
.AppendLine
.AppendLine('end.');
end;
procedure TUnitMustacheHelpersDeclarationCommand.ExecuteInterface(
Section: TStringBuilder; Model: TJSONObject);
begin
inherited;
CheckFor(TConfigKey.program_ssv_mustache, Model);
CheckFor(TConfigKey.mustache_helpers_unit_name, Model);
Section
.AppendLine('unit ' + Model[TConfigKey.mustache_helpers_unit_name] + ';')
.AppendLine
.AppendLine('interface')
.AppendLine
.AppendLine('uses')
.AppendLine(' SynMustache;')
.AppendLine
.AppendLine('type')
.AppendLine(' TMyMustacheHelpers = class sealed')
.AppendLine(' public')
.AppendLine(' class procedure MyHelper1(const Value: variant; out Result: variant);')
.AppendLine(' class procedure MyHelper2(const Value: variant; out Result: variant);')
.AppendLine(' end;')
.AppendLine;
end;
end.

25
ideexpert/DMVC.Expert.CodeGen.NewControllerUnit.pas
View File

@ -38,7 +38,7 @@ uses
ToolsApi,
System.IOUtils,
DMVC.Expert.CodeGen.NewUnit,
JsonDataObjects;
JsonDataObjects, DMVC.Expert.CodeGen.Executor;
type
TNewControllerUnitEx = class(TNewUnit)
@ -51,13 +51,20 @@ type
const APersonality: string = ''); reintroduce;
end;
TNewJSONRPCUnitEx = class(TNewUnit)
TTemplateLoadProcedure = procedure(Gen: TMVCCodeGenerator);
TNewGenericUnitFromTemplate = class(TNewUnit)
private
fTemplateLoadProcedure: TTemplateLoadProcedure;
fUnitIdentKeyName: string;
protected
function NewImplSource(const ModuleIdent, FormIdent, AncestorIdent: string)
: IOTAFile; override;
public
constructor Create(
const ConfigModelRef: TJSONObject;
const TemplateLoadProcedure: TTemplateLoadProcedure;
const UnitIdentKeyName: String;
const APersonality: string = '');reintroduce;
end;
@ -66,7 +73,6 @@ implementation
uses
System.SysUtils,
DMVC.Expert.CodeGen.SourceFile,
DMVC.Expert.CodeGen.Executor,
DMVC.Expert.Commands.Templates,
DMVC.Expert.Commons;
@ -103,15 +109,19 @@ end;
{ TNewJSONRPCUnitEx }
constructor TNewJSONRPCUnitEx.Create(
constructor TNewGenericUnitFromTemplate.Create(
const ConfigModelRef: TJSONObject;
const TemplateLoadProcedure: TTemplateLoadProcedure;
const UnitIdentKeyName: String;
const APersonality: string);
begin
inherited Create(ConfigModelRef);
fTemplateLoadProcedure := TemplateLoadProcedure;
fUnitIdentKeyName := UnitIdentKeyName;
Personality := aPersonality;
end;
function TNewJSONRPCUnitEx.NewImplSource(const ModuleIdent, FormIdent,
function TNewGenericUnitFromTemplate.NewImplSource(const ModuleIdent, FormIdent,
AncestorIdent: string): IOTAFile;
var
lUnitIdent: string;
@ -123,11 +133,12 @@ begin
lFileName := '';
(BorlandIDEServices as IOTAModuleServices).GetNewModuleAndClassName('',
lUnitIdent, lDummy, lFileName);
fConfigModelRef.S[TConfigKey.jsonrpc_unit_name] := lUnitIdent;
fConfigModelRef.S[fUnitIdentKeyName] := lUnitIdent;
Result := TSourceFile.Create(
procedure (Gen: TMVCCodeGenerator)
begin
FillJSONRPCTemplates(Gen);
//FillJSONRPCTemplates(Gen);
fTemplateLoadProcedure(Gen);
end,
fConfigModelRef);
end;

9
ideexpert/DMVC.Expert.Commands.Templates.pas
View File

@ -34,6 +34,7 @@ procedure FillControllerTemplates(Gen: TMVCCodeGenerator);
procedure FillWebModuleTemplates(Gen: TMVCCodeGenerator);
procedure FillWebModuleDFMTemplates(Gen: TMVCCodeGenerator);
procedure FillJSONRPCTemplates(Gen: TMVCCodeGenerator);
procedure FillMustacheTemplates(Gen: TMVCCodeGenerator);
implementation
@ -82,4 +83,12 @@ begin
end;
procedure FillMustacheTemplates(Gen: TMVCCodeGenerator);
begin
Gen.Commands.AddRange([
TUnitMustacheHelpersDeclarationCommand.Create
]);
end;
end.

2
ideexpert/DMVC.Expert.Commons.pas
View File

@ -57,6 +57,8 @@ type
program_default_server_port= 'program.default_server_port';
program_msheap='program.msheap';
program_dotenv='program.dotenv';
program_ssv_mustache='program.ssv.mustache';
mustache_helpers_unit_name = 'mustache.helpers_unit_name';
controller_unit_name='controller.unit_name';
controller_classname= 'controller.classname';
controller_index_methods_generate= 'controller.index_methods.generate';

31
ideexpert/DMVC.Expert.Forms.NewProjectWizard.dfm
View File

@ -3,7 +3,7 @@ object frmDMVCNewProject: TfrmDMVCNewProject
Top = 0
BorderStyle = bsDialog
Caption = 'DelphiMVCFramework :: New Project Wizard'
ClientHeight = 576
ClientHeight = 598
ClientWidth = 729
Color = clBtnFace
Constraints.MinHeight = 145
@ -18,7 +18,7 @@ object frmDMVCNewProject: TfrmDMVCNewProject
OnDestroy = FormDestroy
DesignSize = (
729
576)
598)
TextHeight = 13
object Shape1: TShape
Left = 0
@ -400,7 +400,7 @@ object frmDMVCNewProject: TfrmDMVCNewProject
object lblBook: TLabel
AlignWithMargins = True
Left = 15
Top = 542
Top = 563
Width = 259
Height = 16
Cursor = crHandPoint
@ -458,7 +458,7 @@ object frmDMVCNewProject: TfrmDMVCNewProject
end
object btnOK: TButton
Left = 549
Top = 541
Top = 563
Width = 77
Height = 27
Anchors = [akRight, akBottom]
@ -467,10 +467,11 @@ object frmDMVCNewProject: TfrmDMVCNewProject
ModalResult = 1
TabOrder = 3
OnClick = btnOKClick
ExplicitTop = 541
end
object btnCancel: TButton
Left = 632
Top = 541
Top = 563
Width = 77
Height = 27
Anchors = [akRight, akBottom]
@ -478,6 +479,7 @@ object frmDMVCNewProject: TfrmDMVCNewProject
Caption = 'Cancel'
ModalResult = 2
TabOrder = 4
ExplicitTop = 541
end
object chkAddToProjectGroup: TCheckBox
Left = 24
@ -506,7 +508,7 @@ object frmDMVCNewProject: TfrmDMVCNewProject
end
object Panel2: TPanel
Left = 0
Top = 320
Top = 342
Width = 308
Height = 215
Anchors = [akLeft, akBottom]
@ -516,6 +518,7 @@ object frmDMVCNewProject: TfrmDMVCNewProject
ParentCtl3D = False
ShowCaption = False
TabOrder = 5
ExplicitTop = 320
DesignSize = (
308
215)
@ -726,12 +729,13 @@ object frmDMVCNewProject: TfrmDMVCNewProject
end
object GroupBoxJSONRPC: TGroupBox
Left = 314
Top = 349
Top = 371
Width = 396
Height = 105
Anchors = [akLeft, akRight, akBottom]
Caption = 'JSON-RPC 2.0'
TabOrder = 7
ExplicitTop = 349
DesignSize = (
396
105)
@ -765,7 +769,7 @@ object frmDMVCNewProject: TfrmDMVCNewProject
end
object chkMSHeap: TCheckBox
Left = 24
Top = 288
Top = 286
Width = 225
Height = 17
Anchors = [akLeft, akRight, akBottom]
@ -774,13 +778,22 @@ object frmDMVCNewProject: TfrmDMVCNewProject
end
object chkCustomConfigDotEnv: TCheckBox
Left = 24
Top = 268
Top = 267
Width = 225
Height = 17
Anchors = [akLeft, akRight, akBottom]
Caption = 'Generate custom .env configuration'
TabOrder = 9
end
object chkMustache: TCheckBox
Left = 24
Top = 306
Width = 225
Height = 17
Anchors = [akLeft, akRight, akBottom]
Caption = 'Use Mustache as Server Side View engine'
TabOrder = 10
end
object ApplicationEvents: TApplicationEvents
OnIdle = ApplicationEventsIdle
Left = 232

2
ideexpert/DMVC.Expert.Forms.NewProjectWizard.pas
View File

@ -97,6 +97,7 @@ type
chkCustomConfigDotEnv: TCheckBox;
chkProfileActions: TCheckBox;
lblPATREON: TLabel;
chkMustache: TCheckBox;
procedure chkCreateControllerUnitClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Image1Click(Sender: TObject);
@ -339,6 +340,7 @@ begin
fModel.S[TConfigKey.program_default_server_port] := GetServerPort.ToString;
fModel.B[TConfigKey.program_msheap] := chkMSHeap.Checked;
fModel.B[TConfigKey.program_dotenv] := chkCustomConfigDotEnv.Checked;
fModel.B[TConfigKey.program_ssv_mustache] := chkMustache.Checked;
fModel.S[TConfigKey.controller_unit_name] := 'TBA';
fModel.S[TConfigKey.controller_classname] := GetControllerClassName;
fModel.B[TConfigKey.controller_index_methods_generate] := chkCreateIndexMethod.Checked;

30
ideexpert/DMVC.Expert.ProjectWizardEx.pas
View File

@ -65,7 +65,8 @@ uses
DMVC.Expert.CodeGen.NewWebModuleUnit,
ExpertsRepository,
JsonDataObjects,
DMVC.Expert.Commons;
DMVC.Expert.Commons, DMVC.Expert.CodeGen.SourceFile,
DMVC.Expert.Commands.Templates;
resourcestring
sNewDMVCProjectCaption = 'DelphiMVCFramework Project';
@ -92,12 +93,15 @@ begin
ControllerUnit: IOTAModule;
JSONRPCUnit: IOTAModule;
WebModuleUnit: IOTAModule;
MustacheHelperUnit: IOTAModule;
ControllerCreator: IOTACreator;
JSONRPCUnitCreator: IOTACreator;
MustacheHelpersUnitCreator: IOTACreator;
WebModuleCreator: IOTAModuleCreator;
lProjectSourceCreator: IOTACreator;
lJSONRPCUnitName: string;
lJSON: TJSONObject;
lMustacheHelpersUnitName: string;
begin
WizardForm := TfrmDMVCNewProject.Create(Application);
try
@ -135,8 +139,10 @@ begin
// Create JSONRPC Unit
if lJSON.B[TConfigKey.jsonrpc_generate] then
begin
JSONRPCUnitCreator := TNewJSONRPCUnitEx.Create(
JSONRPCUnitCreator := TNewGenericUnitFromTemplate.Create(
lJSON,
FillJSONRPCTemplates,
TConfigKey.jsonrpc_unit_name,
APersonality);
JSONRPCUnit := ModuleServices.CreateModule(JSONRPCUnitCreator);
ChangeIOTAModuleFileNamePrefix(JSONRPCUnit, 'JSONRPC.' + lJSON.S[TConfigKey.jsonrpc_classname].Substring(1));
@ -148,6 +154,26 @@ begin
end;
end;
lMustacheHelpersUnitName := '';
// Create Mustache Helpers Unit
if lJSON.B[TConfigKey.program_ssv_mustache] then
begin
MustacheHelpersUnitCreator := TNewGenericUnitFromTemplate.Create(
lJSON,
FillMustacheTemplates,
TConfigKey.mustache_helpers_unit_name,
APersonality);
MustacheHelperUnit := ModuleServices.CreateModule(MustacheHelpersUnitCreator);
ChangeIOTAModuleFileNamePrefix(MustacheHelperUnit, 'MustacheHelpers');
lMustacheHelpersUnitName := GetUnitName(MustacheHelperUnit.FileName);
lJSON.S[TConfigKey.mustache_helpers_unit_name] := lMustacheHelpersUnitName;
if Project <> nil then
begin
Project.AddFile(MustacheHelperUnit.FileName, True);
end;
end;
// Create Webmodule Unit
WebModuleCreator := TNewWebModuleUnitEx.Create(
lJSON,

20
samples/activerecord_restful_crud/activerecord_restful_crud.dpr
View File

@ -15,19 +15,17 @@ uses
Web.WebBroker,
IdHTTPWebBrokerBridge,
MVCFramework.Signal,
MVCFramework.Logger,
MVCFramework.SQLGenerators.PostgreSQL,
MVCFramework.SQLGenerators.Firebird,
MVCFramework.SQLGenerators.Interbase,
MVCFramework.SQLGenerators.MSSQL,
MVCFramework.SQLGenerators.MySQL,
WebModuleU in 'WebModuleU.pas' {MyWebModule: TWebModule} ,
WebModuleU in 'WebModuleU.pas' {MyWebModule: TWebModule},
Entities in 'Entities.pas',
MVCFramework.ActiveRecordController in '..\..\sources\MVCFramework.ActiveRecordController.pas',
MVCFramework.ActiveRecord in '..\..\sources\MVCFramework.ActiveRecord.pas',
EntitiesProcessors in 'EntitiesProcessors.pas',
FDConnectionConfigU in '..\activerecord_showcase\FDConnectionConfigU.pas',
OtherControllerU in 'OtherControllerU.pas',
MVCFramework.SysControllers in '..\..\sources\MVCFramework.SysControllers.pas';
OtherControllerU in 'OtherControllerU.pas';
{$R *.res}
@ -36,7 +34,7 @@ var
lServer: TIdHTTPWebBrokerBridge;
lCmd: string;
begin
Writeln('** DMVCFramework Server ** build ' + DMVCFRAMEWORK_VERSION);
LogI('** DMVCFramework Server ** build ' + DMVCFRAMEWORK_VERSION);
if ParamCount >= 1 then
lCmd := ParamStr(1)
else
@ -56,7 +54,7 @@ begin
CreatePostgreSQLPrivateConnDef(True);
end;
WriteLn('Using ' + lCmd.Substring(1));
LogI('Using ' + lCmd.Substring(1));
lServer := TIdHTTPWebBrokerBridge.Create(nil);
try
@ -65,8 +63,8 @@ begin
lServer.MaxConnections := 0;
lServer.ListenQueue := 200;
lServer.Active := True;
WriteLn('Running on port ', APort);
Write('CTRL+C to Quit');
LogI('Running on port ' + APort.ToString);
LogI('CTRL+C to Quit');
WaitForTerminationSignal;
EnterInShutdownState;
finally
@ -81,10 +79,10 @@ begin
if WebRequestHandler <> nil then
WebRequestHandler.WebModuleClass := WebModuleClass;
WebRequestHandlerProc.MaxConnections := 1024;
RunServer(8080);
RunServer(dotEnv.Env('dmvc.server.port', 8080));
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
LogI(E.ClassName + ': ' + E.Message);
end;
end.