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

Huge refactoring of IDE Wizard (WIP)

Browse Source
This commit is contained in:
Daniele Teti 2024-04-12 12:28:34 +02:00
parent 4d3ce6a82d
commit 8ebf4a253e
27 changed files with 1545 additions and 397 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

971
ideexpert/DMVC.Expert.CodeGen.Commands.pas Normal file
View File

@ -0,0 +1,971 @@
unit DMVC.Expert.CodeGen.Commands;
interface
uses
System.SysUtils, MVCFramework.Commons, System.DateUtils,
JsonDataObjects, DMVC.Expert.Commons;
type
TUnitInterfaceKeywordCommand = class(TCustomCommand)
public
procedure ExecuteInterface(
Section: TStringBuilder;
Model: TJSONObject
); override;
procedure ExecuteImplementation(
Section: TStringBuilder;
Model: TJSONObject
); override;
end;
TUnitDMVCLicenseCommand = class(TCustomCommand)
public
procedure ExecuteInterface(
Section: TStringBuilder;
Model: TJSONObject
); override;
end;
TUnitControllerCommand = class(TCustomCommand)
public
procedure ExecuteInterface(
Section: TStringBuilder;
Model: TJSONObject
); override;
procedure ExecuteImplementation(
Section: TStringBuilder;
Model: TJsonObject
); override;
end;
TUnitControllerEntityDeclarationCommand = class(TCustomCommand)
public
procedure ExecuteInterface(
Section: TStringBuilder;
Model: TJSONObject
); override;
procedure ExecuteImplementation(
Section: TStringBuilder;
Model: TJsonObject
); override;
end;
TUnitControllerDeclarationCommand = class(TCustomCommand)
public
procedure ExecuteInterface(
Section: TStringBuilder;
Model: TJSONObject
); override;
end;
TUnitControllerControllerDeclarationCommand = class(TCustomCommand)
public
procedure ExecuteInterface(
Section: TStringBuilder;
Model: TJSONObject
); override;
procedure ExecuteImplementation(
Section: TStringBuilder;
Model: TJsonObject
); override;
end;
TUnitProgramCommand = class(TCustomCommand)
public
procedure ExecuteInterface(
Section: TStringBuilder;
Model: TJSONObject
); override;
procedure ExecuteImplementation(Section: TStringBuilder; Model: TJsonObject); override;
end;
TUnitUsesCommand = class(TCustomCommand)
public
procedure ExecuteInterface(
Section: TStringBuilder;
Model: TJSONObject
); override;
end;
TWebModuleDFMCommand = class(TCustomCommand)
public
procedure ExecuteInterface(
Section: TStringBuilder;
Model: TJSONObject
); override;
procedure ExecuteImplementation(
Section: TStringBuilder;
Model: TJsonObject); override;
end;
TUnitWebModuleDeclarationCommand = class(TCustomCommand)
public
procedure ExecuteInterface(
Section: TStringBuilder;
Model: TJSONObject
); override;
procedure ExecuteImplementation(
Section: TStringBuilder;
Model: TJsonObject
); override;
end;
TUnitJSONRPCDeclarationCommand = class(TCustomCommand)
public
procedure ExecuteInterface(
Section: TStringBuilder;
Model: TJSONObject
); override;
procedure ExecuteImplementation(
Section: TStringBuilder;
Model: TJsonObject
); override;
end;
TUnitFooterCommand = class(TCustomCommand)
public
procedure ExecuteImplementation(
Section: TStringBuilder;
Model: TJSONObject
); override;
procedure ExecuteInterface(
Section: TStringBuilder;
Model: TJsonObject); override;
end;
TUnitMainBeginEndCommand = class(TCustomCommand)
public
procedure ExecuteImplementation(
Section: TStringBuilder;
Model: TJSONObject
); override;
procedure ExecuteInterface(Section: TStringBuilder; Model: TJsonObject); override;
end;
TUnitRunServerProcBody = class(TCustomCommand)
public
procedure ExecuteImplementation(
Section: TStringBuilder;
Model: TJSONObject
); override;
procedure ExecuteInterface(Section: TStringBuilder; Model: TJsonObject); override;
end;
TUnitControllerEntityImplementationCommand = class(TCustomCommand)
public
procedure ExecuteImplementation(
Section: TStringBuilder;
Model: TJSONObject
); override;
end;
TUnitControllerControllerImplementationCommand = class(TCustomCommand)
public
procedure ExecuteImplementation(
Section: TStringBuilder;
Model: TJSONObject
); override;
end;
implementation
{ TUnitUsesCommand }
procedure TUnitUsesCommand.ExecuteInterface(Section: TStringBuilder;
Model: TJSONObject);
begin
inherited;
Section
.AppendLine('uses')
.AppendLine(' System.SysUtils')
.AppendLine(' ;')
.AppendLine
end;
{ TUnitDMVCLicenseCommand }
procedure TUnitDMVCLicenseCommand.ExecuteInterface(Section: TStringBuilder;
Model: TJSONObject);
begin
inherited;
Section
.AppendLine('// ***************************************************************************')
.AppendLine('//')
.AppendLine('// Delphi MVC Framework')
.AppendLine('//')
.AppendLine('// Copyright (c) 2010-' + YearOf(Date).ToString + ' Daniele Teti and the DMVCFramework Team')
.AppendLine('//')
.AppendLine('// https://github.com/danieleteti/delphimvcframework')
.AppendLine('//')
.AppendLine('// ***************************************************************************')
.AppendLine('//')
.AppendLine('// Licensed under the Apache License, Version 2.0 (the "License");')
.AppendLine('// you may not use this file except in compliance with the License.')
.AppendLine('// You may obtain a copy of the License at')
.AppendLine('//')
.AppendLine('// http://www.apache.org/licenses/LICENSE-2.0')
.AppendLine('//')
.AppendLine('// Unless required by applicable law or agreed to in writing, software')
.AppendLine('// distributed under the License is distributed on an "AS IS" BASIS,')
.AppendLine('// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.')
.AppendLine('// See the License for the specific language governing permissions and')
.AppendLine('// limitations under the License.')
.AppendLine('//')
.AppendLine('// This IDE expert is based off of the one included with the DUnitX')
.AppendLine('// project. Original source by Robert Love. Adapted by Nick Hodges and Daniele Teti.')
.AppendLine('//')
.AppendLine('// The DUnitX project is run by Vincent Parrett and can be found at:')
.AppendLine('//')
.AppendLine('// https://github.com/VSoftTechnologies/DUnitX')
.AppendLine('// ***************************************************************************')
.AppendLine;
end;
{ TUnitProgramCommand }
procedure TUnitProgramCommand.ExecuteImplementation(Section: TStringBuilder;
Model: TJsonObject);
begin
inherited;
end;
procedure TUnitProgramCommand.ExecuteInterface(
Section: TStringBuilder;
Model: TJSONObject);
begin
inherited;
CheckFor('program.name', Model);
Section
.AppendLine('program ' + Model[TConfigKey.program_name] + ';')
.AppendLine
.AppendLine('{$APPTYPE CONSOLE}')
.AppendLine
.AppendLine('uses');
if Model[TConfigKey.program_msheap] then
begin
Section.AppendLine(' MSHeap,');
end;
Section
.AppendLine(' System.SysUtils,')
.AppendLine(' Web.ReqMulti,')
.AppendLine(' Web.WebReq,')
.AppendLine(' Web.WebBroker,')
.AppendLine(' IdContext,')
.AppendLine(' IdHTTPWebBrokerBridge,')
.AppendLine(' MVCFramework,')
.AppendLine(' MVCFramework.Logger,')
.AppendLine(' MVCFramework.DotEnv,')
.AppendLine(' MVCFramework.Commons,')
.AppendLine(' MVCFramework.Signal;')
.AppendLine()
.AppendLine('{$R *.res}')
.AppendLine
end;
{ TUnitControllerCommand }
procedure TUnitControllerCommand.ExecuteImplementation(Section: TStringBuilder;
Model: TJsonObject);
begin
inherited;
Section
.AppendLine('implementation')
.AppendLine
.AppendLine('uses')
.AppendLine(' System.StrUtils, System.SysUtils, MVCFramework.Logger;')
.AppendLine;
end;
procedure TUnitControllerCommand.ExecuteInterface(Section: TStringBuilder;
Model: TJSONObject);
begin
inherited;
Section
.AppendLine('unit ' + Model[TConfigKey.controller_unit_name] + ';')
.AppendLine
.AppendLine('interface')
.AppendLine
.AppendLine('uses')
.AppendLine(' MVCFramework, MVCFramework.Commons, MVCFramework.Serializer.Commons, System.Generics.Collections;')
.AppendLine
.AppendLine('type')
end;
{ TUnitControllerDeclarationCommand }
procedure TUnitControllerDeclarationCommand.ExecuteInterface(Section: TStringBuilder;
Model: TJSONObject);
begin
inherited;
end;
procedure TUnitControllerEntityDeclarationCommand.ExecuteImplementation(
Section: TStringBuilder; Model: TJsonObject);
begin
inherited;
if not Model.B[TConfigKey.entity_generate] then Exit;
Section
.AppendLine('constructor ' + Model[TConfigKey.entity_classname] + '.Create(FirstName, LastName: String; DOB: TDate);')
.AppendLine('begin')
.AppendLine(' inherited Create;')
.AppendLine(' fFirstName := FirstName;')
.AppendLine(' fLastName := LastName;')
.AppendLine(' fDOB := DOB;')
.AppendLine('end;')
end;
{ TUnitControllerEntitiesCommand }
procedure TUnitControllerEntityDeclarationCommand.ExecuteInterface(Section: TStringBuilder;
Model: TJSONObject);
begin
inherited;
if not Model.B[TConfigKey.entity_generate] then Exit;
CheckFor('entity.classname', Model);
Section
.AppendLine(' [MVCNameCase(ncCamelCase)]')
.AppendLine(' ' + Model[TConfigKey.entity_classname] + ' = class')
.AppendLine(' private')
.AppendLine(' fFirstName: String;')
.AppendLine(' fLastName: String;')
.AppendLine(' fDOB: TDate;')
.AppendLine(' public')
.AppendLine(' property FirstName: String read fFirstName write fFirstName;')
.AppendLine(' property LastName: String read fLastName write fLastName;')
.AppendLine(' property DOB: TDate read fDOB write fDOB; ')
.AppendLine(' constructor Create(FirstName, LastName: String; DOB: TDate);')
.AppendLine(' end;')
.AppendLine
end;
{ TUnitInterfaceKeywordCommand }
procedure TUnitInterfaceKeywordCommand.ExecuteImplementation(
Section: TStringBuilder; Model: TJSONObject);
begin
inherited;
Section.AppendLine('implementation').AppendLine;
end;
procedure TUnitInterfaceKeywordCommand.ExecuteInterface(Section: TStringBuilder;
Model: TJSONObject);
begin
inherited;
Section.AppendLine('interface').AppendLine;
end;
{ TUnitControllerControllerDeclarationCommand }
procedure TUnitControllerControllerDeclarationCommand.ExecuteImplementation(
Section: TStringBuilder; Model: TJsonObject);
begin
inherited;
CheckFor(TConfigKey.controller_classname, Model);
if Model.B[TConfigKey.controller_action_filters_generate] then
begin
Section
.AppendLine
.AppendLine('procedure ' + Model[TConfigKey.controller_classname] + '.OnAfterAction(Context: TWebContext; const AActionName: string);')
.AppendLine('begin')
.AppendLine(' { Executed after each action }')
.AppendLine(' inherited;')
.AppendLine('end;')
.AppendLine
.AppendLine('procedure ' + Model[TConfigKey.controller_classname] + '.OnBeforeAction(Context: TWebContext; const AActionName: string; var Handled: Boolean);')
.AppendLine('begin')
.AppendLine(' { Executed before each action')
.AppendLine(' if handled is true (or an exception is raised) the actual')
.AppendLine(' action will not be called }')
.AppendLine(' inherited;')
.AppendLine('end;')
end;
if Model.B[TConfigKey.controller_index_methods_generate] then
begin
Section
.AppendLine
.AppendLine('function ' + Model[TConfigKey.controller_classname] + '.Index: String;')
.AppendLine('begin')
.AppendLine(' //use Context property to access to the HTTP request and response')
.AppendLine(' Result := ''Hello DelphiMVCFramework World'';')
.AppendLine('end;')
.AppendLine
.AppendLine('function ' + Model[TConfigKey.controller_classname] + '.GetReversedString(const Value: String): String;')
.AppendLine('begin')
.AppendLine(' Result := System.StrUtils.ReverseString(Value.Trim);')
.AppendLine('end;')
end;
if Model.B[TConfigKey.controller_crud_methods_generate] then
begin
Section
.AppendLine
.AppendLine('//Sample CRUD Actions for a "People" entity')
.AppendLine('function ' + Model[TConfigKey.controller_classname] + '.GetPeople: TObjectList<TPerson>;')
.AppendLine('var')
.AppendLine(' lPeople: TObjectList<TPerson>;')
.AppendLine('begin')
.AppendLine(' lPeople := TObjectList<TPerson>.Create(True);')
.AppendLine(' try')
.AppendLine(' lPeople.Add(TPerson.Create(''Peter'',''Parker'', EncodeDate(1965, 10, 4)));')
.AppendLine(' lPeople.Add(TPerson.Create(''Bruce'',''Banner'', EncodeDate(1945, 9, 6)));')
.AppendLine(' lPeople.Add(TPerson.Create(''Reed'',''Richards'', EncodeDate(1955, 3, 7)));')
.AppendLine(' Result := lPeople;')
.AppendLine(' except')
.AppendLine(' lPeople.Free;')
.AppendLine(' raise;')
.AppendLine(' end;')
.AppendLine('end;')
.AppendLine
.AppendLine('function ' + Model[TConfigKey.controller_classname] + '.GetPerson(ID: Integer): TPerson;')
.AppendLine('var')
.AppendLine(' lPeople: TObjectList<TPerson>;')
.AppendLine('begin')
.AppendLine(' lPeople := GetPeople;')
.AppendLine(' try')
.AppendLine(' Result := lPeople.ExtractAt(ID mod lPeople.Count);')
.AppendLine(' finally')
.AppendLine(' lPeople.Free;')
.AppendLine(' end;')
.AppendLine('end;')
.AppendLine
.AppendLine('function ' + Model[TConfigKey.controller_classname] + '.CreatePerson([MVCFromBody] Person: TPerson): IMVCResponse;')
.AppendLine('begin')
.AppendLine(' LogI(''Created '' + Person.FirstName + '' '' + Person.LastName);')
.AppendLine(' Result := MVCResponseBuilder')
.AppendLine(' .StatusCode(HTTP_STATUS.Created)')
.AppendLine(' .Body(''Person created'')')
.AppendLine(' .Build;')
.AppendLine('end;')
.AppendLine
.AppendLine('function ' + Model[TConfigKey.controller_classname] + '.UpdatePerson(ID: Integer; [MVCFromBody] Person: TPerson): IMVCResponse;')
.AppendLine('begin')
.AppendLine(' LogI(''Updated '' + Person.FirstName + '' '' + Person.LastName);')
.AppendLine(' Result := MVCResponseBuilder')
.AppendLine(' .StatusCode(HTTP_STATUS.NoContent)')
.AppendLine(' .Build;')
.AppendLine('end;')
.AppendLine
.AppendLine('function ' + Model[TConfigKey.controller_classname] + '.DeletePerson(ID: Integer): IMVCResponse;')
.AppendLine('begin')
.AppendLine(' LogI(''Deleted person with id '' + ID.ToString);')
.AppendLine(' Result := MVCResponseBuilder')
.AppendLine(' .StatusCode(HTTP_STATUS.NoContent)')
.AppendLine(' .Build;')
.AppendLine('end;')
end;
end;
procedure TUnitControllerControllerDeclarationCommand.ExecuteInterface(
Section: TStringBuilder; Model: TJSONObject);
begin
inherited;
CheckFor('controller.classname', Model);
Section
.AppendLine(' [MVCPath(''/api'')]')
.AppendLine(' ' + Model[TConfigKey.controller_classname] + ' = class(TMVCController)');
if Model.B[TConfigKey.controller_action_filters_generate] then
begin
Section
.AppendLine(' protected')
.AppendLine(' procedure OnBeforeAction(Context: TWebContext; const AActionName: string; var Handled: Boolean); override;')
.AppendLine(' procedure OnAfterAction(Context: TWebContext; const AActionName: string); override;')
end;
if Model.B[TConfigKey.controller_index_methods_generate] then
begin
Section
.AppendLine(' public')
.AppendLine(' [MVCPath]')
.AppendLine(' [MVCHTTPMethod([httpGET])]')
.AppendLine(' function Index: String;')
.AppendLine(' [MVCPath(''/reversedstrings/($Value)'')]')
.AppendLine(' [MVCHTTPMethod([httpGET])]')
.AppendLine(' [MVCProduces(TMVCMediaType.TEXT_PLAIN)]')
.AppendLine(' function GetReversedString(const Value: String): String;')
end;
if Model.B[TConfigKey.controller_crud_methods_generate] then
begin
if not Model.B[TConfigKey.controller_index_methods_generate] then
begin
Section
.AppendLine(' public')
end;
Section
.AppendLine(' //Sample CRUD Actions for a "People" entity')
.AppendLine(' [MVCPath(''/people'')]')
.AppendLine(' [MVCHTTPMethod([httpGET])]')
.AppendLine(' function GetPeople: TObjectList<TPerson>;')
.AppendLine(' [MVCPath(''/people/($ID)'')]')
.AppendLine(' [MVCHTTPMethod([httpGET])]')
.AppendLine(' function GetPerson(ID: Integer): TPerson;')
.AppendLine(' [MVCPath(''/people'')]')
.AppendLine(' [MVCHTTPMethod([httpPOST])]')
.AppendLine(' function CreatePerson([MVCFromBody] Person: TPerson): IMVCResponse;')
.AppendLine(' [MVCPath(''/people/($ID)'')]')
.AppendLine(' [MVCHTTPMethod([httpPUT])]')
.AppendLine(' function UpdatePerson(ID: Integer; [MVCFromBody] Person: TPerson): IMVCResponse;')
.AppendLine(' [MVCPath(''/people/($ID)'')]')
.AppendLine(' [MVCHTTPMethod([httpDELETE])]')
.AppendLine(' function DeletePerson(ID: Integer): IMVCResponse;')
end;
Section
.AppendLine(' end;')
.AppendLine
end;
{ TWebModuleDFMCommand }
procedure TWebModuleDFMCommand.ExecuteImplementation(Section: TStringBuilder;
Model: TJsonObject);
begin
inherited;
Section
.AppendLine('object ' + Model.S[TConfigKey.webmodule_classname].Substring(1) + ': ' + Model[TConfigKey.webmodule_classname])
.AppendLine(' OldCreateOrder = False')
.AppendLine(' OnCreate = WebModuleCreate')
.AppendLine(' OnDestroy = WebModuleDestroy')
.AppendLine(' Height = 230')
.AppendLine(' Width = 415')
.AppendLine('end')
end;
procedure TWebModuleDFMCommand.ExecuteInterface(Section: TStringBuilder;
Model: TJSONObject);
begin
inherited;
end;
{ TUnitWebModuleDeclarationCommand }
procedure TUnitWebModuleDeclarationCommand.ExecuteImplementation(
Section: TStringBuilder; Model: TJsonObject);
var
activerecord_con_def_name: string;
activerecord_con_def_filename: string;
begin
inherited;
Section
.AppendLine
.AppendLine('implementation')
.AppendLine
.AppendLine('{$R *.dfm}')
.AppendLine
.AppendLine('uses')
.AppendLine(' ' + Model[TConfigKey.controller_unit_name] + ',');
if Model.B[TConfigKey.jsonrpc_generate] then
begin
Section.AppendLine(' ' + Model[TConfigKey.jsonrpc_unit_name] + ',')
end;
Section
.AppendLine(' System.IOUtils,')
.AppendLine(' MVCFramework.Commons,')
.AppendLine(' MVCFramework.Middleware.ActiveRecord,')
.AppendLine(' MVCFramework.Middleware.StaticFiles,')
.AppendLine(' MVCFramework.Middleware.Analytics,')
.AppendLine(' MVCFramework.Middleware.Trace,')
.AppendLine(' MVCFramework.Middleware.CORS,')
.AppendLine(' MVCFramework.Middleware.ETag,')
.AppendLine(' MVCFramework.Middleware.Compression;')
.AppendLine
.AppendLine('procedure ' + Model.S[TConfigKey.webmodule_classname] + '.WebModuleCreate(Sender: TObject);')
.AppendLine('begin')
.AppendLine(' FMVC := TMVCEngine.Create(Self,')
.AppendLine(' procedure(Config: TMVCConfig)')
.AppendLine(' begin')
.AppendLine(' Config.dotEnv := dotEnv; ')
.AppendLine(' // session timeout (0 means session cookie)')
.AppendLine(' Config[TMVCConfigKey.SessionTimeout] := dotEnv.Env(''dmvc.session_timeout'', ''0'');')
.AppendLine(' //default content-type')
.AppendLine(' Config[TMVCConfigKey.DefaultContentType] := dotEnv.Env(''dmvc.default.content_type'', TMVCConstants.DEFAULT_CONTENT_TYPE);')
.AppendLine(' //default content charset')
.AppendLine(' Config[TMVCConfigKey.DefaultContentCharset] := dotEnv.Env(''dmvc.default.content_charset'', TMVCConstants.DEFAULT_CONTENT_CHARSET);')
.AppendLine(' //unhandled actions are permitted?')
.AppendLine(' Config[TMVCConfigKey.AllowUnhandledAction] := dotEnv.Env(''dmvc.allow_unhandled_actions'', ''false'');')
.AppendLine(' //enables or not system controllers loading (available only from localhost requests)')
.AppendLine(' Config[TMVCConfigKey.LoadSystemControllers] := dotEnv.Env(''dmvc.load_system_controllers'', ''true'');')
.AppendLine(' //default view file extension')
.AppendLine(' Config[TMVCConfigKey.DefaultViewFileExtension] := dotEnv.Env(''dmvc.default.view_file_extension'', ''html'');')
.AppendLine(' //view path')
.AppendLine(' Config[TMVCConfigKey.ViewPath] := dotEnv.Env(''dmvc.view_path'', ''templates'');')
.AppendLine(' //use cache for server side views (use "false" in debug and "true" in production for faster performances')
.AppendLine(' Config[TMVCConfigKey.ViewCache] := dotEnv.Env(''dmvc.view_cache'', ''false'');')
.AppendLine(' //Max Record Count for automatic Entities CRUD')
.AppendLine(' Config[TMVCConfigKey.MaxEntitiesRecordCount] := dotEnv.Env(''dmvc.max_entities_record_count'', IntToStr(TMVCConstants.MAX_RECORD_COUNT));')
.AppendLine(' //Enable Server Signature in response')
.AppendLine(' Config[TMVCConfigKey.ExposeServerSignature] := dotEnv.Env(''dmvc.expose_server_signature'', ''false'');')
.AppendLine(' //Enable X-Powered-By Header in response')
.AppendLine(' Config[TMVCConfigKey.ExposeXPoweredBy] := dotEnv.Env(''dmvc.expose_x_powered_by'', ''true'');')
.AppendLine(' // Max request size in bytes')
.AppendLine(' Config[TMVCConfigKey.MaxRequestSize] := dotEnv.Env(''dmvc.max_request_size'', IntToStr(TMVCConstants.DEFAULT_MAX_REQUEST_SIZE));')
.AppendLine(' end);')
.AppendLine
.AppendLine(' // Controllers')
.AppendLine(' FMVC.AddController(' + Model[TConfigKey.controller_classname] + ');')
.AppendLine(' // Controllers - END')
.AppendLine
.AppendLine(' // Middleware');
if Model.B[TConfigKey.webmodule_middleware_analytics] then
begin
Section.AppendLine(' fMVC.AddMiddleware(TMVCAnalyticsMiddleware.Create(GetAnalyticsDefaultLogger));')
end;
if Model.B[TConfigKey.webmodule_middleware_staticfiles] then
begin
Section.AppendLine(' fMVC.AddMiddleware(TMVCStaticFilesMiddleware.Create(''/static'', TPath.Combine(ExtractFilePath(GetModuleName(HInstance)), ''www'')));')
end;
if Model.B[TConfigKey.webmodule_middleware_trace] then
begin
Section.AppendLine(' fMVC.AddMiddleware(TMVCTraceMiddleware.Create);')
end;
if Model.B[TConfigKey.webmodule_middleware_compression] then
begin
Section.AppendLine(' fMVC.AddMiddleware(TMVCCompressionMiddleware.Create);')
end;
if Model.B[TConfigKey.webmodule_middleware_etag] then
begin
Section.AppendLine(' fMVC.AddMiddleware(TMVCETagMiddleware.Create);')
end;
if Model.B[TConfigKey.webmodule_middleware_cors] then
begin
Section.AppendLine(' fMVC.AddMiddleware(TMVCCORSMiddleware.Create);')
end;
if Model.B[TConfigKey.webmodule_middleware_activerecord] then
begin
activerecord_con_def_name := Model[TConfigKey.webmodule_middleware_activerecord_con_def_name];
activerecord_con_def_filename := Model[TConfigKey.webmodule_middleware_activerecord_con_def_filename];
Section
.AppendLine(' fMVC.AddMiddleware(TMVCActiveRecordMiddleware.Create(')
.AppendLine(' dotEnv.Env(''firedac.connection_definition_name'', ''' + activerecord_con_def_name + '''),')
.AppendLine(' dotEnv.Env(''firedac.connection_definitions_filename'', ''' + activerecord_con_def_filename + ''')')
.AppendLine(' ));')
end;
Section
.AppendLine(' // Middleware - END');
if Model.B[TConfigKey.jsonrpc_generate] then
begin
Section
.AppendLine
.AppendLine(' // JSONRPC')
.AppendLine(' fMVC.PublishObject(')
.AppendLine(' function : TObject')
.AppendLine(' begin')
.AppendLine(' Result := ' + Model[TConfigKey.jsonrpc_classname] + '.Create;')
.AppendLine(' end, ''/jsonrpc'');')
.AppendLine(' // JSONRPC - END')
end;
Section
.AppendLine
.AppendLine('end;')
.AppendLine
.AppendLine('procedure ' + Model.S[TConfigKey.webmodule_classname] + '.WebModuleDestroy(Sender: TObject);')
.AppendLine('begin')
.AppendLine(' FMVC.Free;')
.AppendLine('end;')
.AppendLine
.AppendLine('end.')
end;
procedure TUnitWebModuleDeclarationCommand.ExecuteInterface(
Section: TStringBuilder; Model: TJSONObject);
begin
inherited;
CheckFor(TConfigKey.webmodule_unit_name, Model);
CheckFor(TConfigKey.webmodule_classname, Model);
Section
.AppendLine('unit ' + Model.S[TConfigKey.webmodule_unit_name] + ';')
.AppendLine('')
.AppendLine('interface')
.AppendLine
.AppendLine('uses ')
.AppendLine(' System.SysUtils,')
.AppendLine(' System.Classes,')
.AppendLine(' Web.HTTPApp,')
.AppendLine(' MVCFramework;')
.AppendLine
.AppendLine('type')
.AppendLine(' ' + Model.S[TConfigKey.webmodule_classname] + ' = class(TWebModule)')
.AppendLine(' procedure WebModuleCreate(Sender: TObject);')
.AppendLine(' procedure WebModuleDestroy(Sender: TObject);')
.AppendLine(' private')
.AppendLine(' fMVC: TMVCEngine;')
.AppendLine(' end;')
.AppendLine
.AppendLine('var')
.AppendLine(' WebModuleClass: TComponentClass = ' + Model.S[TConfigKey.webmodule_classname] + ';')
end;
{ TUnitJSONRPCDeclarationCommand }
procedure TUnitJSONRPCDeclarationCommand.ExecuteImplementation(
Section: TStringBuilder; Model: TJsonObject);
begin
inherited;
if not Model.B[TConfigKey.jsonrpc_generate] then
begin
Exit;
end;
Section
.AppendLine('implementation')
.AppendLine
.AppendLine('uses')
.AppendLine(' System.StrUtils;')
.AppendLine
.AppendLine('function ' + Model.S[TConfigKey.jsonrpc_classname] + '.ReverseString(const Value: String): String;')
.AppendLine('begin')
.AppendLine(' Result := System.StrUtils.ReverseString(Value);')
.AppendLine('end;')
.AppendLine
.AppendLine('end.')
end;
procedure TUnitJSONRPCDeclarationCommand.ExecuteInterface(
Section: TStringBuilder; Model: TJSONObject);
begin
inherited;
CheckFor(TConfigKey.jsonrpc_generate, Model);
if not Model.B[TConfigKey.jsonrpc_generate] then
begin
Exit;
end;
CheckFor(TConfigKey.jsonrpc_unit_name, Model);
CheckFor(TConfigKey.jsonrpc_classname, Model);
Section
.AppendLine('unit ' + Model[TConfigKey.jsonrpc_unit_name] + ';')
.AppendLine
.AppendLine('interface')
.AppendLine
.AppendLine('type')
.AppendLine(' ' + Model[TConfigKey.jsonrpc_classname] + ' = class')
.AppendLine(' public')
.AppendLine(' function ReverseString(const Value: String): String;')
.AppendLine(' end;')
.AppendLine;
end;
{ TUnitFooterCommand }
procedure TUnitFooterCommand.ExecuteImplementation(Section: TStringBuilder;
Model: TJSONObject);
begin
inherited;
Section.AppendLine.AppendLine('end.');
end;
procedure TUnitFooterCommand.ExecuteInterface(Section: TStringBuilder;
Model: TJsonObject);
begin
inherited;
end;
{ TUnitMainBeginEndCommand }
procedure TUnitMainBeginEndCommand.ExecuteImplementation(Section: TStringBuilder;
Model: TJSONObject);
begin
inherited;
Section
.AppendLine
.AppendLine('begin')
.AppendLine(' { Enable ReportMemoryLeaksOnShutdown during debug }')
.AppendLine(' // ReportMemoryLeaksOnShutdown := True;')
.AppendLine(' IsMultiThread := True;')
.AppendLine(' // DMVCFramework Specific Configuration ')
.AppendLine(' // When MVCSerializeNulls = True empty nullables and nil are serialized as json null.')
.AppendLine(' // When MVCSerializeNulls = False empty nullables and nil are not serialized at all.')
.AppendLine(' MVCSerializeNulls := True;')
.AppendLine(' UseConsoleLogger := True;')
.AppendLine
.AppendLine(' LogI(''** DMVCFramework Server ** build '' + DMVCFRAMEWORK_VERSION);')
.AppendLine(' try')
.AppendLine(' if WebRequestHandler <> nil then')
.AppendLine(' WebRequestHandler.WebModuleClass := WebModuleClass;')
.AppendLine
.AppendLine(' dotEnvConfigure(')
.AppendLine(' function: IMVCDotEnv')
.AppendLine(' begin')
.AppendLine(' Result := NewDotEnv')
.AppendLine(' .UseStrategy(TMVCDotEnvPriority.FileThenEnv)')
.AppendLine(' //if available, by default, loads default environment (.env)')
.AppendLine(' .UseProfile(''test'') //if available loads the test environment (.env.test)')
.AppendLine(' .UseProfile(''prod'') //if available loads the prod environment (.env.prod)')
.AppendLine(' .UseLogger(procedure(LogItem: String)')
.AppendLine(' begin')
.AppendLine(' LogD(''dotEnv: '' + LogItem);')
.AppendLine(' end)')
.AppendLine(' .Build(); //uses the executable folder to look for .env* files')
.AppendLine(' end);')
.AppendLine
.AppendLine(' WebRequestHandlerProc.MaxConnections := dotEnv.Env(''dmvc.handler.max_connections'', 1024);')
.AppendLine
.AppendLine('{$IF Defined(SYDNEYORBETTER)}')
.AppendLine(' if dotEnv.Env(''dmvc.profiler.enabled'', false) then')
.AppendLine(' begin')
.AppendLine(' Profiler.ProfileLogger := Log;')
.AppendLine(' Profiler.WarningThreshold := dotEnv.Env(''dmvc.profiler.warning_threshold'', 2000);')
.AppendLine(' end;')
.AppendLine('{$ENDIF}')
.AppendLine
.AppendLine(' RunServer(dotEnv.Env(''dmvc.server.port'', ' + Model[TConfigKey.program_default_server_port] + '));')
.AppendLine(' except')
.AppendLine(' on E: Exception do')
.AppendLine(' LogF(E.ClassName + '': '' + E.Message);')
.AppendLine(' end;')
.AppendLine('end.')
end;
procedure TUnitMainBeginEndCommand.ExecuteInterface(Section: TStringBuilder;
Model: TJsonObject);
begin
inherited;
end;
{ TUnitRunServerProcBody }
procedure TUnitRunServerProcBody.ExecuteImplementation(Section: TStringBuilder;
Model: TJSONObject);
begin
inherited;
Section
.AppendLine('procedure RunServer(APort: Integer);')
.AppendLine('var')
.AppendLine(' LServer: TIdHTTPWebBrokerBridge;')
.AppendLine('begin')
.AppendLine(' LServer := TIdHTTPWebBrokerBridge.Create(nil);')
.AppendLine(' try')
.AppendLine(' LServer.OnParseAuthentication := TMVCParseAuthentication.OnParseAuthentication;')
.AppendLine(' LServer.DefaultPort := APort;')
.AppendLine(' LServer.KeepAlive := True;')
.AppendLine(' LServer.MaxConnections := dotEnv.Env(''dmvc.webbroker.max_connections'', 0);')
.AppendLine(' LServer.ListenQueue := dotEnv.Env(''dmvc.indy.listen_queue'', 500);')
.AppendLine(' LServer.Active := True;')
.AppendLine(' LogI(''Listening on port '' + APort.ToString);')
.AppendLine(' LogI(''Application started. Press Ctrl+C to shut down.'');')
.AppendLine(' WaitForTerminationSignal;')
.AppendLine(' EnterInShutdownState;')
.AppendLine(' LServer.Active := False;')
.AppendLine(' finally')
.AppendLine(' LServer.Free;')
.AppendLine(' end;')
.AppendLine('end;')
end;
procedure TUnitRunServerProcBody.ExecuteInterface(Section: TStringBuilder;
Model: TJsonObject);
begin
inherited;
end;
{ TUnitControllerEntityImplementationCommand }
procedure TUnitControllerEntityImplementationCommand.ExecuteImplementation(
Section: TStringBuilder; Model: TJSONObject);
begin
inherited;
if not Model.B[TConfigKey.entity_generate] then Exit;
CheckFor(TConfigKey.entity_classname, Model);
Section
.AppendLine('constructor ' + Model[TConfigKey.entity_classname] + '.Create(FirstName, LastName: String; DOB: TDate);')
.AppendLine('begin')
.AppendLine(' inherited Create;')
.AppendLine(' fFirstName := FirstName;')
.AppendLine(' fLastName := LastName;')
.AppendLine(' fDOB := DOB;')
.AppendLine('end;')
end;
{ TUnitControllerControllerImplementationCommand }
procedure TUnitControllerControllerImplementationCommand.ExecuteImplementation(
Section: TStringBuilder; Model: TJSONObject);
begin
inherited;
CheckFor(TConfigKey.controller_classname, Model);
Section
.AppendLine('[MVCPath(''/api'')]')
.AppendLine(Model[TConfigKey.controller_classname] + ' = class(TMVCController)')
.AppendLine(' public');
if Model.B[TConfigKey.controller_index_methods_generate] then
begin
Section
.AppendLine(' [MVCPath]')
.AppendLine(' [MVCHTTPMethod([httpGET])]')
.AppendLine(' function Index: String;')
.AppendLine(' [MVCPath(''/reversedstrings/($Value)'')]')
.AppendLine(' [MVCHTTPMethod([httpGET])]')
.AppendLine(' [MVCProduces(TMVCMediaType.TEXT_PLAIN)]')
.AppendLine(' function GetReversedString(const Value: String): String;')
end;
if Model.B[TConfigKey.controller_action_filters_generate] then
begin
Section
.AppendLine(' protected')
.AppendLine(' procedure OnBeforeAction(Context: TWebContext; const AActionName: string; var Handled: Boolean); override;')
.AppendLine
.AppendLine(' procedure OnAfterAction(Context: TWebContext; const AActionName: string); override;')
end;
if Model.B[TConfigKey.controller_crud_methods_generate] then
begin
Section
.AppendLine(' public')
.AppendLine(' //Sample CRUD Actions for a "People" entity')
.AppendLine(' [MVCPath(''/people'')]')
.AppendLine(' [MVCHTTPMethod([httpGET])]')
.AppendLine(' function GetPeople: TObjectList<TPerson>;')
.AppendLine(' [MVCPath(''/people/($ID)'')]')
.AppendLine(' [MVCHTTPMethod([httpGET])]')
.AppendLine(' function GetPerson(ID: Integer): TPerson;')
.AppendLine(' [MVCPath(''/people'')]')
.AppendLine(' [MVCHTTPMethod([httpPOST])]')
.AppendLine(' function CreatePerson([MVCFromBody] Person: TPerson): IMVCResponse;')
.AppendLine(' [MVCPath(''/people/($ID)'')]')
.AppendLine(' [MVCHTTPMethod([httpPUT])]')
.AppendLine(' function UpdatePerson(ID: Integer; [MVCFromBody] Person: TPerson): IMVCResponse;')
.AppendLine(' [MVCPath(''/people/($ID)'')]')
.AppendLine(' [MVCHTTPMethod([httpDELETE])]')
.AppendLine(' function DeletePerson(ID: Integer): IMVCResponse;')
end;
Section
.AppendLine('end;')
.AppendLine
end;
end.

94
ideexpert/DMVC.Expert.CodeGen.Executor.pas Normal file
View File

@ -0,0 +1,94 @@
unit DMVC.Expert.CodeGen.Executor;
interface
uses
MVCFramework.Commons, System.SysUtils, System.Generics.Collections,
JsonDataObjects, DMVC.Expert.Commons;
type
TMVCCodeGenerator = class
private
fIntf: TStringBuilder;
fImpl: TStringBuilder;
fCommands: TList<IGenCommand>;
fSource: string;
public
constructor Create; virtual;
destructor Destroy; override;
procedure Execute(Model: TJSONObject);
function Commands: TList<IGenCommand>;
function Source: String;
class function GenerateSource(ConfigModelRef: TJSONObject; FillerProc: TProc<TMVCCodeGenerator>): String;
end;
implementation
function TMVCCodeGenerator.Commands: TList<IGenCommand>;
begin
Result := fCommands;
end;
constructor TMVCCodeGenerator.Create;
begin
inherited;
fCommands := TList<IGenCommand>.Create;
fSource := '';
end;
destructor TMVCCodeGenerator.Destroy;
begin
fCommands.Free;
inherited;
end;
{ TMVCProjectGenerator }
procedure TMVCCodeGenerator.Execute(Model: TJSONObject);
var
I: Integer;
begin
fSource := '';
fIntf := TStringBuilder.Create;
try
fImpl := TStringBuilder.Create;
try
for I := 0 to fCommands.Count - 1 do
begin
fCommands[I].ExecuteInterface(fIntf, Model);
fCommands[I].ExecuteImplementation(fImpl, Model);
end;
fSource := fIntf.ToString + fImpl.ToString;
finally
fImpl.Free;
end;
finally
fIntf.Free;
end;
end;
class function TMVCCodeGenerator.GenerateSource(ConfigModelRef: TJSONObject;
FillerProc: TProc<TMVCCodeGenerator>): String;
var
lGenerator: TMVCCodeGenerator;
begin
lGenerator := TMVCCodeGenerator.Create;
try
lGenerator.Commands.Clear;
FillerProc(lGenerator);
lGenerator.Execute(ConfigModelRef);
Result := lGenerator.Source;
finally
lGenerator.Free;
end;
end;
{ TIntfCommand }
function TMVCCodeGenerator.Source: String;
begin
Result := fSource;
end;
end.

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

@ -23,7 +23,7 @@
// *************************************************************************** // ***************************************************************************
// //
// This IDE expert is based off of the one included with the DUnitX } // This IDE expert is based off of the one included with the DUnitX }
// project. Original source by Robert Love. Adapted by Nick Hodges. } // project. Original source by Robert Love. Adapted by Nick Hodges and Daniele Teti. }
// //
// The DUnitX project is run by Vincent Parrett and can be found at: } // The DUnitX project is run by Vincent Parrett and can be found at: }
// //
@ -37,7 +37,7 @@ interface
uses uses
ToolsApi, ToolsApi,
System.IOUtils, System.IOUtils,
DMVC.Expert.CodeGen.NewUnit; DMVC.Expert.CodeGen.NewUnit, JsonDataObjects;
type type
TNewControllerUnitEx = class(TNewUnit) TNewControllerUnitEx = class(TNewUnit)
@ -50,9 +50,10 @@ type
: IOTAFile; override; : IOTAFile; override;
public public
constructor Create( constructor Create(
const ConfigModelRef: TJSONObject;
const aCreateIndexMethod, aCreateCRUDMethods, aCreateActionFiltersMethods: Boolean; const aCreateIndexMethod, aCreateCRUDMethods, aCreateActionFiltersMethods: Boolean;
const AControllerClassName: string; const AControllerClassName: string;
const APersonality: string = ''); const APersonality: string = ''); reintroduce;
end; end;
TNewJSONRPCUnitEx = class(TNewUnit) TNewJSONRPCUnitEx = class(TNewUnit)
@ -61,8 +62,9 @@ type
function NewImplSource(const ModuleIdent, FormIdent, AncestorIdent: string) function NewImplSource(const ModuleIdent, FormIdent, AncestorIdent: string)
: IOTAFile; override; : IOTAFile; override;
public public
constructor Create(const aJSONRPCClassName: String; constructor Create(
const APersonality: string = ''); const ConfigModelRef: TJSONObject;
const APersonality: string = '');reintroduce;
end; end;
implementation implementation
@ -71,14 +73,19 @@ uses
System.SysUtils, System.SysUtils,
VCL.Dialogs, VCL.Dialogs,
DMVC.Expert.CodeGen.Templates, DMVC.Expert.CodeGen.Templates,
DMVC.Expert.CodeGen.SourceFile; DMVC.Expert.CodeGen.SourceFile,
DMVC.Expert.CodeGen.Executor,
DMVC.Expert.Commands.Templates,
DMVC.Expert.Commons;
constructor TNewControllerUnitEx.Create( constructor TNewControllerUnitEx.Create(
const ConfigModelRef: TJSONObject;
const aCreateIndexMethod, aCreateCRUDMethods, const aCreateIndexMethod, aCreateCRUDMethods,
aCreateActionFiltersMethods: Boolean; aCreateActionFiltersMethods: Boolean;
const AControllerClassName: string; const AControllerClassName: string;
const APersonality: string = ''); const APersonality: string = '');
begin begin
inherited Create(ConfigModelRef);
Assert(Length(AControllerClassName) > 0); Assert(Length(AControllerClassName) > 0);
FAncestorName := ''; FAncestorName := '';
FFormName := ''; FFormName := '';
@ -97,16 +104,17 @@ var
lUnitIdent: string; lUnitIdent: string;
lFormName: string; lFormName: string;
lFileName: string; lFileName: string;
lIndexMethodIntf: string; // lIndexMethodIntf: string;
lIndexMethodImpl: string; // lIndexMethodImpl: string;
lControllerUnit: string; // lControllerUnit: string;
lActionFiltersMethodsIntf: string; // lActionFiltersMethodsIntf: string;
lActionFiltersMethodsImpl: string; // lActionFiltersMethodsImpl: string;
lCRUDMethodsIntf: string; // lCRUDMethodsIntf: string;
lCRUDMethodsImpl: string; // lCRUDMethodsImpl: string;
lBOClassesIntf: string; // lBOClassesIntf: string;
lBOClassesImpl: string; // lBOClassesImpl: string;
begin begin
{
lControllerUnit := sControllerUnit; lControllerUnit := sControllerUnit;
lIndexMethodIntf := sIndexMethodIntf; lIndexMethodIntf := sIndexMethodIntf;
@ -141,33 +149,43 @@ begin
lActionFiltersMethodsIntf := ''; lActionFiltersMethodsIntf := '';
lActionFiltersMethodsImpl := ''; lActionFiltersMethodsImpl := '';
end; end;
}
// http://stackoverflow.com/questions/4196412/how-do-you-retrieve-a-new-unit-name-from-delphis-open-tools-api // http://stackoverflow.com/questions/4196412/how-do-you-retrieve-a-new-unit-name-from-delphis-open-tools-api
// So using method mentioned by Marco Cantu. // So using method mentioned by Marco Cantu.
(BorlandIDEServices as IOTAModuleServices).GetNewModuleAndClassName('', (BorlandIDEServices as IOTAModuleServices).GetNewModuleAndClassName('',
lUnitIdent, lFormName, lFileName); lUnitIdent, lFormName, lFileName);
Result := TSourceFile.Create(sControllerUnit,
[
lUnitIdent, fConfigModelRef.S[TConfigKey.controller_unit_name] := lUnitIdent;
FControllerClassName,
lIndexMethodIntf, Result := TSourceFile.Create(
lIndexMethodImpl, procedure (Gen: TMVCCodeGenerator)
lActionFiltersMethodsIntf, begin
lActionFiltersMethodsImpl, FillControllerTemplates(Gen);
lCRUDMethodsIntf, end,
lCRUDMethodsImpl, fConfigModelRef);
lBOClassesIntf, // Result := TSourceFile.Create(sControllerUnit,
lBOClassesImpl // [
]); // lUnitIdent,
// FControllerClassName,
// lIndexMethodIntf,
// lIndexMethodImpl,
// lActionFiltersMethodsIntf,
// lActionFiltersMethodsImpl,
// lCRUDMethodsIntf,
// lCRUDMethodsImpl,
// lBOClassesIntf,
// lBOClassesImpl
// ]);
end; end;
{ TNewJSONRPCUnitEx } { TNewJSONRPCUnitEx }
constructor TNewJSONRPCUnitEx.Create(const aJSONRPCClassName, constructor TNewJSONRPCUnitEx.Create(
APersonality: string); const ConfigModelRef: TJSONObject;
const APersonality: string);
begin begin
inherited Create; inherited Create(ConfigModelRef);
fJSONRPCClassName := aJSONRPCClassName;
Personality := aPersonality; Personality := aPersonality;
end; end;
@ -180,14 +198,21 @@ var
begin begin
// http://stackoverflow.com/questions/4196412/how-do-you-retrieve-a-new-unit-name-from-delphis-open-tools-api // http://stackoverflow.com/questions/4196412/how-do-you-retrieve-a-new-unit-name-from-delphis-open-tools-api
// So using method mentioned by Marco Cantu. // So using method mentioned by Marco Cantu.
lFileName := ''; //fJSONRPCClassName + 'U'; lFileName := '';
(BorlandIDEServices as IOTAModuleServices).GetNewModuleAndClassName('', (BorlandIDEServices as IOTAModuleServices).GetNewModuleAndClassName('',
lUnitIdent, lDummy, lFileName); lUnitIdent, lDummy, lFileName);
Result := TSourceFile.Create(sJSONRPCUnit, // Result := TSourceFile.Create(sJSONRPCUnit,
[ // [
lUnitIdent, // lUnitIdent,
fJSONRPCClassName // fJSONRPCClassName
]); // ]);
fConfigModelRef.S[TConfigKey.jsonrpc_unit_name] := lUnitIdent;
Result := TSourceFile.Create(
procedure (Gen: TMVCCodeGenerator)
begin
FillJSONRPCTemplates(Gen);
end,
fConfigModelRef);
end; end;
end. end.

30
ideexpert/DMVC.Expert.CodeGen.NewDMVCProject.pas
View File

@ -23,7 +23,7 @@
// *************************************************************************** // ***************************************************************************
// //
// This IDE expert is based off of the one included with the DUnitX // This IDE expert is based off of the one included with the DUnitX
// project. Original source by Robert Love. Adapted by Nick Hodges. // project. Original source by Robert Love. Adapted by Nick Hodges and Daniele Teti.
// //
// The DUnitX project is run by Vincent Parrett and can be found at: // The DUnitX project is run by Vincent Parrett and can be found at:
// //
@ -36,13 +36,14 @@ interface
uses uses
ToolsAPI, ToolsAPI,
DMVC.Expert.CodeGen.NewProject; DMVC.Expert.CodeGen.NewProject, JsonDataObjects;
type type
TDMVCProjectFile = class(TNewProjectEx) TDMVCProjectFile = class(TNewProjectEx)
private private
FDefaultPort: Integer; FDefaultPort: Integer;
FUseMSHeapOnWindows: Boolean; FUseMSHeapOnWindows: Boolean;
fConfigModelRef: TJsonObject;
procedure SetDefaultPort(const Value: Integer); procedure SetDefaultPort(const Value: Integer);
procedure SetUseMSHeapOnWindows(const Value: Boolean); procedure SetUseMSHeapOnWindows(const Value: Boolean);
protected protected
@ -50,7 +51,7 @@ type
function GetFrameworkType: string; override; function GetFrameworkType: string; override;
public public
constructor Create; overload; constructor Create; overload;
constructor Create(const APersonality: string); overload; constructor Create(const APersonality: string; const ConfigModelRef: TJSONObject); overload;
property DefaultPort: Integer read FDefaultPort write SetDefaultPort; property DefaultPort: Integer read FDefaultPort write SetDefaultPort;
property UseMSHeapOnWindows: Boolean read FUseMSHeapOnWindows write SetUseMSHeapOnWindows; property UseMSHeapOnWindows: Boolean read FUseMSHeapOnWindows write SetUseMSHeapOnWindows;
end; end;
@ -60,7 +61,11 @@ implementation
uses uses
DMVC.Expert.CodeGen.SourceFile, DMVC.Expert.CodeGen.SourceFile,
DMVC.Expert.CodeGen.Templates, DMVC.Expert.CodeGen.Templates,
System.SysUtils; System.SysUtils,
DMVC.Expert.CodeGen.Executor,
MVCFramework.Logger,
DMVC.Expert.Commands.Templates,
DMVC.Expert.Commons;
constructor TDMVCProjectFile.Create; constructor TDMVCProjectFile.Create;
begin begin
@ -72,10 +77,11 @@ begin
FUseMSHeapOnWindows := False; FUseMSHeapOnWindows := False;
end; end;
constructor TDMVCProjectFile.Create(const APersonality: string); constructor TDMVCProjectFile.Create(const APersonality: string; const ConfigModelRef: TJSONObject);
begin begin
Create; Create;
Personality := APersonality; Personality := APersonality;
fConfigModelRef := ConfigModelRef;
end; end;
function TDMVCProjectFile.GetFrameworkType: string; function TDMVCProjectFile.GetFrameworkType: string;
@ -87,12 +93,24 @@ function TDMVCProjectFile.NewProjectSource(const ProjectName: string): IOTAFile;
var var
lCodeForUseMSHeapOnWindows: String; lCodeForUseMSHeapOnWindows: String;
begin begin
LogI('TDMVCProjectFile.NewProjectSource - 100');
lCodeForUseMSHeapOnWindows := ''; lCodeForUseMSHeapOnWindows := '';
if FUseMSHeapOnWindows then if FUseMSHeapOnWindows then
begin begin
lCodeForUseMSHeapOnWindows := '{$IF Defined(MSWINDOWS)}' + sLineBreak + ' MSHeap,' + sLineBreak + '{$ENDIF}'; lCodeForUseMSHeapOnWindows := '{$IF Defined(MSWINDOWS)}' + sLineBreak + ' MSHeap,' + sLineBreak + '{$ENDIF}';
end; end;
Result := TSourceFile.Create(sDMVCDPR, [ProjectName, FDefaultPort, lCodeForUseMSHeapOnWindows]); //Result := TSourceFile.Create(sDMVCDPR, [ProjectName, FDefaultPort, lCodeForUseMSHeapOnWindows]);
fConfigModelRef.S[TConfigKey.program_name] := ProjectName;
LogI('TDMVCProjectFile.NewProjectSource - 120');
fConfigModelRef.SaveToFile('C:\todelete\configmodelref.json', False);
Result := TSourceFile.Create(
procedure (Gen: TMVCCodeGenerator)
begin
FillProgramTemplates(Gen);
end,
fConfigModelRef);
end; end;
procedure TDMVCProjectFile.SetDefaultPort(const Value: Integer); procedure TDMVCProjectFile.SetDefaultPort(const Value: Integer);

2
ideexpert/DMVC.Expert.CodeGen.NewProject.pas
View File

@ -24,7 +24,7 @@
// *************************************************************************** // ***************************************************************************
// //
// This IDE expert is based off of the one included with the DUnitX // This IDE expert is based off of the one included with the DUnitX
// project. Original source by Robert Love. Adapted by Nick Hodges. // project. Original source by Robert Love. Adapted by Nick Hodges and Daniele Teti.
// //
// The DUnitX project is run by Vincent Parrett and can be found at: // The DUnitX project is run by Vincent Parrett and can be found at:
// //

12
ideexpert/DMVC.Expert.CodeGen.NewUnit.pas
View File

@ -23,7 +23,7 @@
// *************************************************************************** // ***************************************************************************
// //
// This IDE expert is based off of the one included with the DUnitX // This IDE expert is based off of the one included with the DUnitX
// project. Original source by Robert Love. Adapted by Nick Hodges. // project. Original source by Robert Love. Adapted by Nick Hodges and Daniele Teti.
// //
// The DUnitX project is run by Vincent Parrett and can be found at: // The DUnitX project is run by Vincent Parrett and can be found at:
// //
@ -38,7 +38,7 @@ unit DMVC.Expert.CodeGen.NewUnit;
interface interface
uses uses
ToolsAPI; ToolsAPI, JsonDataObjects;
type type
@ -46,6 +46,7 @@ type
private private
FPersonality : string; FPersonality : string;
protected protected
fConfigModelRef: TJsonObject;
//Specific to class //Specific to class
FFormName: string; FFormName: string;
FImplFileName: string; FImplFileName: string;
@ -74,6 +75,7 @@ type
function NewIntfSource(const ModuleIdent, FormIdent, AncestorIdent: string): IOTAFile; virtual; function NewIntfSource(const ModuleIdent, FormIdent, AncestorIdent: string): IOTAFile; virtual;
procedure FormCreated(const FormEditor: IOTAFormEditor); virtual; procedure FormCreated(const FormEditor: IOTAFormEditor); virtual;
public public
constructor Create(ConfigModelRef: TJSONObject); virtual;
property FormName: string read GetFormName write SetFormName; property FormName: string read GetFormName write SetFormName;
property ImplFileName: string read GetImplFileName write SetImplFileName; property ImplFileName: string read GetImplFileName write SetImplFileName;
property IntfFileName: string read GetIntfFileName write SetIntfFileName; property IntfFileName: string read GetIntfFileName write SetIntfFileName;
@ -83,6 +85,12 @@ type
implementation implementation
constructor TNewUnit.Create(ConfigModelRef: TJSONObject);
begin
inherited Create;
fConfigModelRef := ConfigModelRef;
end;
{ TUnitCreator } { TUnitCreator }
procedure TNewUnit.FormCreated(const FormEditor: IOTAFormEditor); procedure TNewUnit.FormCreated(const FormEditor: IOTAFormEditor);

45
ideexpert/DMVC.Expert.CodeGen.NewWebModuleUnit.pas
View File

@ -23,7 +23,7 @@
// *************************************************************************** // ***************************************************************************
// //
// This IDE expert is based off of the one included with the DUnitX // This IDE expert is based off of the one included with the DUnitX
// project. Original source by Robert Love. Adapted by Nick Hodges. // project. Original source by Robert Love. Adapted by Nick Hodges and Daniele Teti.
// //
// The DUnitX project is run by Vincent Parrett and can be found at: // The DUnitX project is run by Vincent Parrett and can be found at:
// //
@ -36,7 +36,7 @@ interface
uses uses
ToolsApi, ToolsApi,
DMVC.Expert.CodeGen.NewUnit; DMVC.Expert.CodeGen.NewUnit, JsonDataObjects;
type type
TNewWebModuleUnitEx = class(TNewUnit) TNewWebModuleUnitEx = class(TNewUnit)
@ -54,13 +54,14 @@ type
function NewImplSource(const ModuleIdent, FormIdent, AncestorIdent: string): IOTAFile; override; function NewImplSource(const ModuleIdent, FormIdent, AncestorIdent: string): IOTAFile; override;
public public
constructor Create( constructor Create(
const ConfigModelRef: TJSONObject;
const aWebModuleClassName: string; const aWebModuleClassName: string;
const aControllerClassName: string; const aControllerClassName: string;
const aControllerUnit: string; const aControllerUnit: string;
const aMiddlewares: TArray<String>; const aMiddlewares: TArray<String>;
const aJSONRPCClassName: String; const aJSONRPCClassName: String;
const aJSONRPCClassUnit: String; const aJSONRPCClassUnit: String;
const aPersonality : String); const aPersonality : String);reintroduce;
end; end;
implementation implementation
@ -70,9 +71,13 @@ uses
System.SysUtils, System.SysUtils,
VCL.Dialogs, VCL.Dialogs,
DMVC.Expert.CodeGen.Templates, DMVC.Expert.CodeGen.Templates,
DMVC.Expert.CodeGen.SourceFile; DMVC.Expert.CodeGen.SourceFile,
DMVC.Expert.CodeGen.Executor,
DMVC.Expert.Commands.Templates,
DMVC.Expert.Commons;
constructor TNewWebModuleUnitEx.Create( constructor TNewWebModuleUnitEx.Create(
const ConfigModelRef: TJSONObject;
const aWebModuleClassName: string; const aWebModuleClassName: string;
const aControllerClassName: string; const aControllerClassName: string;
const aControllerUnit: string; const aControllerUnit: string;
@ -81,6 +86,7 @@ constructor TNewWebModuleUnitEx.Create(
const aJSONRPCClassUnit: String; const aJSONRPCClassUnit: String;
const aPersonality : String); const aPersonality : String);
begin begin
inherited Create(ConfigModelRef);
Assert(Length(aWebModuleClassName) > 0); Assert(Length(aWebModuleClassName) > 0);
FAncestorName := ''; FAncestorName := '';
FFormName := ''; FFormName := '';
@ -104,7 +110,13 @@ end;
function TNewWebModuleUnitEx.NewFormFile(const FormIdent, AncestorIdent: string): IOTAFile; function TNewWebModuleUnitEx.NewFormFile(const FormIdent, AncestorIdent: string): IOTAFile;
begin begin
Result := TSourceFile.Create(sWebModuleDFM, [FormIdent, FWebModuleClassName]); //Result := TSourceFile.Create(sWebModuleDFM, [FormIdent, FWebModuleClassName]);
Result := TSourceFile.Create(
procedure (Gen: TMVCCodeGenerator)
begin
FillWebModuleDFMTemplates(Gen);
end,
fConfigModelRef);
end; end;
function TNewWebModuleUnitEx.NewImplSource(const ModuleIdent, FormIdent, AncestorIdent: string): IOTAFile; function TNewWebModuleUnitEx.NewImplSource(const ModuleIdent, FormIdent, AncestorIdent: string): IOTAFile;
@ -140,14 +152,21 @@ begin
end; end;
end; end;
Result := TSourceFile.Create(sWebModuleUnit, [ fConfigModelRef.S[TConfigKey.webmodule_unit_name] := FUnitIdent;
FUnitIdent, // Result := TSourceFile.Create(sWebModuleUnit, [
FWebModuleClassName, // FUnitIdent,
FControllerUnit, // FWebModuleClassName,
FControllerClassName, // FControllerUnit,
lMiddlewaresCode, // FControllerClassName,
lJSONRPCCode, // lMiddlewaresCode,
FJSONRPCClassUnit]); // lJSONRPCCode,
// FJSONRPCClassUnit]);
Result := TSourceFile.Create(
procedure (Gen: TMVCCodeGenerator)
begin
FillWebModuleTemplates(Gen);
end,
fConfigModelRef);
end; end;

32
ideexpert/DMVC.Expert.CodeGen.SourceFile.pas
View File

@ -23,7 +23,7 @@
// *************************************************************************** // ***************************************************************************
// //
// This IDE expert is based off of the one included with the DUnitX // This IDE expert is based off of the one included with the DUnitX
// project. Original source by Robert Love. Adapted by Nick Hodges. // project. Original source by Robert Love. Adapted by Nick Hodges and Daniele Teti.
// //
// The DUnitX project is run by Vincent Parrett and can be found at: // The DUnitX project is run by Vincent Parrett and can be found at:
// //
@ -37,36 +37,52 @@ interface
uses uses
System.SysUtils, System.SysUtils,
System.Classes, System.Classes,
ToolsAPI; JsonDataObjects,
ToolsAPI,
DMVC.Expert.CodeGen.Executor;
type type
TSourceFile = class(TInterfacedObject, IOTAFile) TSourceFile = class(TInterfacedObject, IOTAFile)
private private
FSource: string; fGeneratorCallback: TProc<TMVCCodeGenerator>;
fJSON: TJsonObject;
public public
function GetSource: string; function GetSource: string;
function GetAge: TDateTime; function GetAge: TDateTime;
constructor Create(const Source: string; const Args: array of const ); constructor Create(const GeneratorCallback: TProc<TMVCCodeGenerator>; const Args: TJsonObject);
destructor Destroy; override;
end; end;
implementation implementation
{ TSourceFile } { TSourceFile }
constructor TSourceFile.Create(const Source: string; const Args: array of const ); constructor TSourceFile.Create(const GeneratorCallback: TProc<TMVCCodeGenerator>; const Args: TJsonObject);
begin begin
inherited Create; inherited Create;
FSource := Format(Source, Args); fGeneratorCallback := GeneratorCallback;
fJSON := Args.Clone as TJsonObject;
end;
destructor TSourceFile.Destroy;
begin
fJSON.Free;
inherited;
end; end;
function TSourceFile.GetAge: TDateTime; function TSourceFile.GetAge: TDateTime;
begin begin
Result := -1; Result := Now;
end; end;
function TSourceFile.GetSource: string; function TSourceFile.GetSource: string;
begin begin
Result := FSource; //Result := FSource;
Result := TMVCCodeGenerator.GenerateSource(fJSON,
procedure (Gen: TMVCCodeGenerator)
begin
fGeneratorCallback(Gen)
end);
end; end;
end. end.

2
ideexpert/DMVC.Expert.CodeGen.Templates.pas
View File

@ -21,7 +21,7 @@
// limitations under the License. // limitations under the License.
// //
// This IDE expert is based off of the one included with the DUnitX // This IDE expert is based off of the one included with the DUnitX
// project. Original source by Robert Love. Adapted by Nick Hodges. // project. Original source by Robert Love. Adapted by Nick Hodges and Daniele Teti.
// //
// The DUnitX project is run by Vincent Parrett and can be found at: // The DUnitX project is run by Vincent Parrett and can be found at:
// //

61
ideexpert/DMVC.Expert.Commands.Templates.pas Normal file
View File

@ -0,0 +1,61 @@
unit DMVC.Expert.Commands.Templates;
interface
uses
System.Generics.Collections, DMVC.Expert.CodeGen.Executor;
procedure FillProgramTemplates(Gen: TMVCCodeGenerator);
procedure FillControllerTemplates(Gen: TMVCCodeGenerator);
procedure FillWebModuleTemplates(Gen: TMVCCodeGenerator);
procedure FillWebModuleDFMTemplates(Gen: TMVCCodeGenerator);
procedure FillJSONRPCTemplates(Gen: TMVCCodeGenerator);
implementation
uses
DMVC.Expert.Commons,
DMVC.Expert.CodeGen.Commands;
procedure FillProgramTemplates(Gen: TMVCCodeGenerator);
begin
Gen.Commands.AddRange([
TUnitProgramCommand.Create,
TUnitRunServerProcBody.Create,
TUnitMainBeginEndCommand.Create
]);
end;
procedure FillControllerTemplates(Gen: TMVCCodeGenerator);
begin
Gen.Commands.AddRange([
TUnitControllerCommand.Create,
TUnitControllerEntityDeclarationCommand.Create,
TUnitControllerControllerDeclarationCommand.Create,
TUnitFooterCommand.Create
]);
end;
procedure FillWebModuleTemplates(Gen: TMVCCodeGenerator);
begin
Gen.Commands.AddRange([
TUnitWebModuleDeclarationCommand.Create
]);
end;
procedure FillJSONRPCTemplates(Gen: TMVCCodeGenerator);
begin
Gen.Commands.AddRange([
TUnitJSONRPCDeclarationCommand.Create
]);
end;
procedure FillWebModuleDFMTemplates(Gen: TMVCCodeGenerator);
begin
Gen.Commands.AddRange([
TWebModuleDFMCommand.Create
]);
end;
end.

65
ideexpert/DMVC.Expert.Commons.pas Normal file
View File

@ -0,0 +1,65 @@
unit DMVC.Expert.Commons;
interface
uses
MVCFramework.Commons, System.SysUtils, JsonDataObjects;
type
IGenCommand = interface
['{B5F6B048-FB5A-48EA-80F9-D8395B4DE40D}']
procedure ExecuteInterface(Section: TStringBuilder; Model: TJSONObject);
procedure ExecuteImplementation(Section: TStringBuilder; Model: TJSONObject);
end;
TCustomCommand = class abstract(TInterfacedObject, IGenCommand)
protected
procedure CheckFor(const Key: String; Model: TJSONObject);
public
procedure ExecuteInterface(Section: TStringBuilder; Model: TJSONObject); virtual; abstract;
procedure ExecuteImplementation(Section: TStringBuilder; Model: TJSONObject); virtual; abstract;
end;
TConfigKey = class sealed
public const
program_name = 'program.name';
program_default_server_port= 'program.default_server_port';
program_msheap='program.msheap';
controller_unit_name='controller.unit_name';
controller_classname= 'controller.classname';
controller_index_methods_generate= 'controller.index_methods.generate';
controller_action_filters_generate= 'controller.action_filters.generate';
controller_crud_methods_generate= 'controller.crud_methods.generate';
entity_generate= 'entity.generate';
entity_classname= 'entity.classname';
jsonrpc_generate= 'jsonrpc.generate';
jsonrpc_classname= 'jsonrpc.classname';
jsonrpc_unit_name='jsonrpc.unit_name';
webmodule_classname= 'webmodule.classname';
webmodule_unit_name= 'webmodule.unit_name';
webmodule_middleware_analytics= 'webmodule.middleware.analytics';
webmodule_middleware_staticfiles= 'webmodule.middleware.staticfiles';
webmodule_middleware_trace= 'webmodule.middleware.trace';
webmodule_middleware_compression= 'webmodule.middleware.compression';
webmodule_middleware_etag= 'webmodule.middleware.etag';
webmodule_middleware_cors= 'webmodule.middleware.cors';
webmodule_middleware_activerecord= 'webmodule.middleware.activerecord';
webmodule_middleware_activerecord_con_def_name= 'webmodule.middleware.activerecord.con_def_name';
webmodule_middleware_activerecord_con_def_filename= 'webmodule.middleware.activerecord.con_def_filename';
end;
implementation
{ TCustomCommand }
procedure TCustomCommand.CheckFor(const Key: String;
Model: TJSONObject);
begin
if (not Model.Contains(Key)) or Model.S[Key].IsEmpty then
begin
Model.SaveToFile('C:\todelete\configmodelref.json');
raise Exception.CreateFmt('Required key "%s" not found or empty while processing %s', [Key, ClassName]);
end;
end;
end.

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

@ -15,6 +15,7 @@ object frmDMVCNewProject: TfrmDMVCNewProject
Font.Style = [] Font.Style = []
Position = poMainFormCenter Position = poMainFormCenter
OnCreate = FormCreate OnCreate = FormCreate
OnDestroy = FormDestroy
DesignSize = ( DesignSize = (
710 710
527) 527)
@ -445,7 +446,6 @@ object frmDMVCNewProject: TfrmDMVCNewProject
ModalResult = 1 ModalResult = 1
TabOrder = 3 TabOrder = 3
OnClick = btnOKClick OnClick = btnOKClick
ExplicitTop = 517
end end
object btnCancel: TButton object btnCancel: TButton
Left = 613 Left = 613
@ -457,7 +457,6 @@ object frmDMVCNewProject: TfrmDMVCNewProject
Caption = 'Cancel' Caption = 'Cancel'
ModalResult = 2 ModalResult = 2
TabOrder = 4 TabOrder = 4
ExplicitTop = 517
end end
object chkAddToProjectGroup: TCheckBox object chkAddToProjectGroup: TCheckBox
Left = 24 Left = 24
@ -496,7 +495,6 @@ object frmDMVCNewProject: TfrmDMVCNewProject
ParentCtl3D = False ParentCtl3D = False
ShowCaption = False ShowCaption = False
TabOrder = 5 TabOrder = 5
ExplicitTop = 313
DesignSize = ( DesignSize = (
273 273
198) 198)
@ -536,7 +534,7 @@ object frmDMVCNewProject: TfrmDMVCNewProject
State = cbChecked State = cbChecked
TabOrder = 0 TabOrder = 0
end end
object edtClassName: TEdit object edtControllerClassName: TEdit
Left = 16 Left = 16
Top = 130 Top = 130
Width = 225 Width = 225
@ -703,7 +701,6 @@ object frmDMVCNewProject: TfrmDMVCNewProject
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
Caption = 'JSON-RPC 2.0' Caption = 'JSON-RPC 2.0'
TabOrder = 7 TabOrder = 7
ExplicitTop = 397
DesignSize = ( DesignSize = (
403 403
105) 105)
@ -743,7 +740,6 @@ object frmDMVCNewProject: TfrmDMVCNewProject
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
Caption = 'Use MSHeap on MS Windows' Caption = 'Use MSHeap on MS Windows'
TabOrder = 8 TabOrder = 8
ExplicitTop = 291
end end
object ApplicationEvents: TApplicationEvents object ApplicationEvents: TApplicationEvents
OnIdle = ApplicationEventsIdle OnIdle = ApplicationEventsIdle

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

@ -23,7 +23,7 @@
// *************************************************************************** // ***************************************************************************
// //
// This IDE expert is based off of the one included with the DUnitX } // This IDE expert is based off of the one included with the DUnitX }
// project. Original source by Robert Love. Adapted by Nick Hodges. } // project. Original source by Robert Love. Adapted by Nick Hodges and Daniele Teti. }
// //
// The DUnitX project is run by Vincent Parrett and can be found at: } // The DUnitX project is run by Vincent Parrett and can be found at: }
// //
@ -50,7 +50,7 @@ uses
VCL.ExtCtrls, VCL.ExtCtrls,
System.Actions, System.Actions,
Vcl.ActnList, Vcl.ActnList,
Vcl.AppEvnts; Vcl.AppEvnts, JsonDataObjects;
type type
TfrmDMVCNewProject = class(TForm) TfrmDMVCNewProject = class(TForm)
@ -68,7 +68,7 @@ type
lblClassName: TLabel; lblClassName: TLabel;
Label1: TLabel; Label1: TLabel;
chkCreateIndexMethod: TCheckBox; chkCreateIndexMethod: TCheckBox;
edtClassName: TEdit; edtControllerClassName: TEdit;
chkCreateActionFiltersMethods: TCheckBox; chkCreateActionFiltersMethods: TCheckBox;
chkCreateCRUDMethods: TCheckBox; chkCreateCRUDMethods: TCheckBox;
chkCreateControllerUnit: TCheckBox; chkCreateControllerUnit: TCheckBox;
@ -105,8 +105,10 @@ type
procedure lblFrameworkVersionClick(Sender: TObject); procedure lblFrameworkVersionClick(Sender: TObject);
procedure ApplicationEventsIdle(Sender: TObject; var Done: Boolean); procedure ApplicationEventsIdle(Sender: TObject; var Done: Boolean);
procedure btnOKClick(Sender: TObject); procedure btnOKClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private private
{ Private declarations } { Private declarations }
fModel: TJsonObject;
function GetAddToProjectGroup: boolean; function GetAddToProjectGroup: boolean;
function GetCreateIndexMethod: boolean; function GetCreateIndexMethod: boolean;
function GetCreateControllerUnit: boolean; function GetCreateControllerUnit: boolean;
@ -134,6 +136,7 @@ type
property WebModuleClassName: string read GetWebModuleClassName; property WebModuleClassName: string read GetWebModuleClassName;
property ServerPort: Integer read GetServerPort; property ServerPort: Integer read GetServerPort;
property UseMSHeapOnWindows: Boolean read GetUseMSHeapOnWindows; property UseMSHeapOnWindows: Boolean read GetUseMSHeapOnWindows;
function GetConfigModel: TJSONObject;
end; end;
var var
@ -144,7 +147,8 @@ implementation
uses uses
DMVC.Expert.CodeGen.Templates, DMVC.Expert.CodeGen.Templates,
MVCFramework.Commons, MVCFramework.Commons,
System.StrUtils; System.StrUtils,
DMVC.Expert.Commons;
{$R *.dfm} {$R *.dfm}
@ -169,17 +173,23 @@ begin
chkCreateIndexMethod.Enabled := chkCreateControllerUnit.Checked; chkCreateIndexMethod.Enabled := chkCreateControllerUnit.Checked;
chkCreateActionFiltersMethods.Enabled := chkCreateControllerUnit.Checked; chkCreateActionFiltersMethods.Enabled := chkCreateControllerUnit.Checked;
chkCreateCRUDMethods.Enabled := chkCreateControllerUnit.Checked; chkCreateCRUDMethods.Enabled := chkCreateControllerUnit.Checked;
edtClassName.Enabled := chkCreateControllerUnit.Checked; edtControllerClassName.Enabled := chkCreateControllerUnit.Checked;
end; end;
procedure TfrmDMVCNewProject.FormCreate(Sender: TObject); procedure TfrmDMVCNewProject.FormCreate(Sender: TObject);
begin begin
edtClassName.TextHint := sDefaultControllerName; edtControllerClassName.TextHint := sDefaultControllerName;
edtWebModuleName.TextHint := sDefaultWebModuleName; edtWebModuleName.TextHint := sDefaultWebModuleName;
edtServerPort.TextHint := sDefaultServerPort; edtServerPort.TextHint := sDefaultServerPort;
lblFrameworkVersion.Caption := 'dmvcframework-' + DMVCFRAMEWORK_VERSION; lblFrameworkVersion.Caption := 'dmvcframework-' + DMVCFRAMEWORK_VERSION;
chkJSONRPC.Checked := False; chkJSONRPC.Checked := False;
lblCopyRight.Caption := TMVCConstants.COPYRIGHT; lblCopyRight.Caption := TMVCConstants.COPYRIGHT;
fModel := TJsonObject.Create;
end;
procedure TfrmDMVCNewProject.FormDestroy(Sender: TObject);
begin
fModel.Free;
end; end;
function TfrmDMVCNewProject.GetAddToProjectGroup: boolean; function TfrmDMVCNewProject.GetAddToProjectGroup: boolean;
@ -349,15 +359,49 @@ begin
Result := chkCreateCRUDMethods.Checked; Result := chkCreateCRUDMethods.Checked;
end; end;
function TfrmDMVCNewProject.GetConfigModel: TJSONObject;
begin
fModel.Clear;
fModel.S[TConfigKey.program_name] := 'TBA';
fModel.S[TConfigKey.program_default_server_port] := GetServerPort.ToString;
fModel.B[TConfigKey.program_msheap] := chkMSHeap.Checked;
fModel.S[TConfigKey.controller_unit_name] := 'TBA';
fModel.S[TConfigKey.controller_classname] := GetControllerClassName;
fModel.B[TConfigKey.controller_index_methods_generate] := chkCreateIndexMethod.Checked;
fModel.B[TConfigKey.controller_action_filters_generate] := chkCreateActionFiltersMethods.Checked;
fModel.B[TConfigKey.controller_crud_methods_generate] := chkCreateCRUDMethods.Checked;
fModel.B[TConfigKey.entity_generate] := fModel.B[TConfigKey.controller_crud_methods_generate];
fModel.S[TConfigKey.entity_classname] := 'TPerson';
fModel.B[TConfigKey.jsonrpc_generate] := GetCreateJSONRPCInterface;
fModel.S[TConfigKey.jsonrpc_classname] := GetJSONRPCClassName;
fModel.S[TConfigKey.jsonrpc_unit_name] := 'TBA';
//webmodule
fModel.S[TConfigKey.webmodule_classname] := GetWebModuleClassName;
fModel.B[TConfigKey.webmodule_middleware_analytics] := chkAnalyticsMiddleware.Checked;
fModel.B[TConfigKey.webmodule_middleware_staticfiles] := chkStaticFiles.Checked;
fModel.B[TConfigKey.webmodule_middleware_trace] := chkTrace.Checked;
fModel.B[TConfigKey.webmodule_middleware_compression] := chkCompression.Checked;
fModel.B[TConfigKey.webmodule_middleware_etag] := chkETAG.Checked;
fModel.B[TConfigKey.webmodule_middleware_cors] := chkCORS.Checked;
fModel.B[TConfigKey.webmodule_middleware_activerecord] := chkActiveRecord.Checked;
fModel.S[TConfigKey.webmodule_middleware_activerecord_con_def_name] := EdtConnDefName.Text;
fModel.S[TConfigKey.webmodule_middleware_activerecord_con_def_filename] := EdtFDConnDefFileName.Text;
//webmodule - end
Result := fModel;
end;
function TfrmDMVCNewProject.GetControllerClassName: string; function TfrmDMVCNewProject.GetControllerClassName: string;
begin begin
if Trim(edtClassName.Text) = '' then if Trim(edtControllerClassName.Text) = '' then
begin begin
Result := sDefaultControllerName Result := sDefaultControllerName
end end
else else
begin begin
Result := Trim(edtClassName.Text); Result := Trim(edtControllerClassName.Text);
end; end;
end; end;

1
ideexpert/DMVC.Expert.Forms.NewUnitWizard.dfm
View File

@ -15,6 +15,7 @@ object frmDMVCNewUnit: TfrmDMVCNewUnit
Font.Style = [] Font.Style = []
Position = poMainFormCenter Position = poMainFormCenter
OnCreate = FormCreate OnCreate = FormCreate
OnDestroy = FormDestroy
DesignSize = ( DesignSize = (
271 271
236) 236)

19
ideexpert/DMVC.Expert.Forms.NewUnitWizard.pas
View File

@ -23,7 +23,7 @@
// *************************************************************************** // ***************************************************************************
// //
// This IDE expert is based off of the one included with the DUnitX } // This IDE expert is based off of the one included with the DUnitX }
// project. Original source by Robert Love. Adapted by Nick Hodges. } // project. Original source by Robert Love. Adapted by Nick Hodges and Daniele Teti. }
// //
// The DUnitX project is run by Vincent Parrett and can be found at: } // The DUnitX project is run by Vincent Parrett and can be found at: }
// //
@ -44,7 +44,7 @@ uses
VCL.Controls, VCL.Controls,
VCL.Forms, VCL.Forms,
VCL.Dialogs, VCL.Dialogs,
VCL.StdCtrls; VCL.StdCtrls, JsonDataObjects;
type type
TfrmDMVCNewUnit = class(TForm) TfrmDMVCNewUnit = class(TForm)
@ -57,7 +57,9 @@ type
chkCreateActionFiltersMethods: TCheckBox; chkCreateActionFiltersMethods: TCheckBox;
chkCreateCRUDMethods: TCheckBox; chkCreateCRUDMethods: TCheckBox;
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private private
fModel: TJSONObject;
function GetCreateIndexMethod: boolean; function GetCreateIndexMethod: boolean;
function GetControllerClassName: string; function GetControllerClassName: string;
function GetCreateActionFiltersMethods: boolean; function GetCreateActionFiltersMethods: boolean;
@ -71,7 +73,7 @@ type
property CreateCRUDMethods: boolean read GetCreateCRUDMethods; property CreateCRUDMethods: boolean read GetCreateCRUDMethods;
property CreateActionFiltersMethods: boolean read GetCreateActionFiltersMethods; property CreateActionFiltersMethods: boolean read GetCreateActionFiltersMethods;
property AddAnalyticsMiddleware: boolean read GetAddAnalyticsMiddleware; property AddAnalyticsMiddleware: boolean read GetAddAnalyticsMiddleware;
function GetConfigModel: TJSONObject;
end; end;
var var
@ -87,6 +89,7 @@ uses
procedure TfrmDMVCNewUnit.FormCreate(Sender: TObject); procedure TfrmDMVCNewUnit.FormCreate(Sender: TObject);
begin begin
edtClassName.TextHint := sDefaultControllerName; edtClassName.TextHint := sDefaultControllerName;
fModel := TJsonObject.Create;
end; end;
function TfrmDMVCNewUnit.GetCreateActionFiltersMethods: boolean; function TfrmDMVCNewUnit.GetCreateActionFiltersMethods: boolean;
@ -104,11 +107,21 @@ begin
Result := chkCreateIndexMethod.Checked; Result := chkCreateIndexMethod.Checked;
end; end;
procedure TfrmDMVCNewUnit.FormDestroy(Sender: TObject);
begin
fModel.Free;
end;
function TfrmDMVCNewUnit.GetAddAnalyticsMiddleware: boolean; function TfrmDMVCNewUnit.GetAddAnalyticsMiddleware: boolean;
begin begin
Result := False; Result := False;
end; end;
function TfrmDMVCNewUnit.GetConfigModel: TJSONObject;
begin
Result := fModel;
end;
function TfrmDMVCNewUnit.GetControllerClassName: string; function TfrmDMVCNewUnit.GetControllerClassName: string;
begin begin
if Trim(edtClassName.Text) = '' then if Trim(edtClassName.Text) = '' then

7
ideexpert/DMVC.Expert.NewUnitWizardEx.pas
View File

@ -23,7 +23,7 @@
// *************************************************************************** // ***************************************************************************
// //
// This IDE expert is based off of the one included with the DUnitX // This IDE expert is based off of the one included with the DUnitX
// project. Original source by Robert Love. Adapted by Nick Hodges. // project. Original source by Robert Love. Adapted by Nick Hodges and Daniele Teti.
// //
// The DUnitX project is run by Vincent Parrett and can be found at: // The DUnitX project is run by Vincent Parrett and can be found at:
// //
@ -55,7 +55,7 @@ uses
VCL.Controls, VCL.Controls,
VCL.Forms, VCL.Forms,
WinApi.Windows, WinApi.Windows,
ExpertsRepository; ExpertsRepository, JsonDataObjects;
resourcestring resourcestring
sNewDMVCUnitCaption = 'DelphiMVCFramework Controller'; sNewDMVCUnitCaption = 'DelphiMVCFramework Controller';
@ -72,15 +72,18 @@ begin
ModuleServices: IOTAModuleServices; ModuleServices: IOTAModuleServices;
Project: IOTAProject; Project: IOTAProject;
ControllerUnit: IOTAModule; ControllerUnit: IOTAModule;
lJSON: TJSONObject;
begin begin
WizardForm := TfrmDMVCNewUnit.Create(Application); WizardForm := TfrmDMVCNewUnit.Create(Application);
try try
if WizardForm.ShowModal = mrOk then if WizardForm.ShowModal = mrOk then
begin begin
lJSON := WizardForm.GetConfigModel;
ModuleServices := (BorlandIDEServices as IOTAModuleServices); ModuleServices := (BorlandIDEServices as IOTAModuleServices);
Project := GetActiveProject; Project := GetActiveProject;
ControllerUnit := ModuleServices.CreateModule( ControllerUnit := ModuleServices.CreateModule(
TNewControllerUnitEx.Create( TNewControllerUnitEx.Create(
lJSON,
WizardForm.CreateIndexMethod, WizardForm.CreateIndexMethod,
WizardForm.CreateCRUDMethods, WizardForm.CreateCRUDMethods,
WizardForm.CreateActionFiltersMethods, WizardForm.CreateActionFiltersMethods,

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

@ -23,7 +23,7 @@
// *************************************************************************** // ***************************************************************************
// //
// This IDE expert is based off of the one included with the DUnitX // This IDE expert is based off of the one included with the DUnitX
// project. Original source by Robert Love. Adapted by Nick Hodges. // project. Original source by Robert Love. Adapted by Nick Hodges and Daniele Teti.
// //
// The DUnitX project is run by Vincent Parrett and can be found at: // The DUnitX project is run by Vincent Parrett and can be found at:
// //
@ -53,6 +53,7 @@ implementation
{$I ..\sources\dmvcframework.inc} {$I ..\sources\dmvcframework.inc}
uses uses
MVCFramework.Logger,
DccStrs, DccStrs,
System.IOUtils, System.IOUtils,
VCL.Controls, VCL.Controls,
@ -63,7 +64,9 @@ uses
DMVC.Expert.CodeGen.NewDMVCProject, DMVC.Expert.CodeGen.NewDMVCProject,
DMVC.Expert.CodeGen.NewControllerUnit, DMVC.Expert.CodeGen.NewControllerUnit,
DMVC.Expert.CodeGen.NewWebModuleUnit, DMVC.Expert.CodeGen.NewWebModuleUnit,
ExpertsRepository; ExpertsRepository,
JsonDataObjects,
DMVC.Expert.Commons;
resourcestring resourcestring
sNewDMVCProjectCaption = 'DelphiMVCFramework Project'; sNewDMVCProjectCaption = 'DelphiMVCFramework Project';
@ -95,38 +98,49 @@ begin
WebModuleCreator: IOTAModuleCreator; WebModuleCreator: IOTAModuleCreator;
lProjectSourceCreator: IOTACreator; lProjectSourceCreator: IOTACreator;
lJSONRPCUnitName: string; lJSONRPCUnitName: string;
lJSON: TJSONObject;
begin begin
WizardForm := TfrmDMVCNewProject.Create(Application); WizardForm := TfrmDMVCNewProject.Create(Application);
try try
if WizardForm.ShowModal = mrOk then if WizardForm.ShowModal = mrOk then
begin begin
LogI('step10');
if not WizardForm.AddToProjectGroup then if not WizardForm.AddToProjectGroup then
begin begin
(BorlandIDEServices as IOTAModuleServices).CloseAll; (BorlandIDEServices as IOTAModuleServices).CloseAll;
end; end;
ModuleServices := (BorlandIDEServices as IOTAModuleServices); ModuleServices := (BorlandIDEServices as IOTAModuleServices);
LogI('step20');
lJSON := WizardForm.GetConfigModel;
// Create Project Source // Create Project Source
lProjectSourceCreator := TDMVCProjectFile.Create(APersonality); lProjectSourceCreator := TDMVCProjectFile.Create(APersonality, lJSON);
LogI('step30');
TDMVCProjectFile(lProjectSourceCreator).DefaultPort := WizardForm.ServerPort; TDMVCProjectFile(lProjectSourceCreator).DefaultPort := WizardForm.ServerPort;
TDMVCProjectFile(lProjectSourceCreator).UseMSHeapOnWindows := WizardForm.UseMSHeapOnWindows; TDMVCProjectFile(lProjectSourceCreator).UseMSHeapOnWindows := WizardForm.UseMSHeapOnWindows;
ModuleServices.CreateModule(lProjectSourceCreator); ModuleServices.CreateModule(lProjectSourceCreator);
LogI('step40');
Project := GetActiveProject; Project := GetActiveProject;
LogI('step50');
Config := (Project.ProjectOptions as IOTAProjectOptionsConfigurations).BaseConfiguration; Config := (Project.ProjectOptions as IOTAProjectOptionsConfigurations).BaseConfiguration;
Config.SetValue(sUnitSearchPath, '$(DMVC)'); Config.SetValue(sUnitSearchPath, '$(DMVC)');
Config.SetValue(sFramework, 'VCL'); Config.SetValue(sFramework, 'VCL');
LogI('step60');
// Create Controller Unit // Create Controller Unit
if WizardForm.CreateControllerUnit then if WizardForm.CreateControllerUnit then
begin begin
LogI('step70');
ControllerCreator := TNewControllerUnitEx.Create( ControllerCreator := TNewControllerUnitEx.Create(
lJSON,
WizardForm.CreateIndexMethod, WizardForm.CreateIndexMethod,
WizardForm.CreateCRUDMethods, WizardForm.CreateCRUDMethods,
WizardForm.CreateActionFiltersMethods, WizardForm.CreateActionFiltersMethods,
WizardForm.ControllerClassName, WizardForm.ControllerClassName,
APersonality); APersonality);
LogI('step80');
ControllerUnit := ModuleServices.CreateModule(ControllerCreator); ControllerUnit := ModuleServices.CreateModule(ControllerCreator);
LogI('step90');
if Project <> nil then if Project <> nil then
begin begin
Project.AddFile(ControllerUnit.FileName, True); Project.AddFile(ControllerUnit.FileName, True);
@ -135,22 +149,29 @@ begin
lJSONRPCUnitName := ''; lJSONRPCUnitName := '';
// Create JSONRPC Unit // Create JSONRPC Unit
if not WizardForm.JSONRPCClassName.IsEmpty then if lJSON.B[TConfigKey.jsonrpc_generate] then
begin begin
LogI('step100');
JSONRPCUnitCreator := TNewJSONRPCUnitEx.Create( JSONRPCUnitCreator := TNewJSONRPCUnitEx.Create(
WizardForm.JSONRPCClassName, lJSON,
//WizardForm.JSONRPCClassName,
APersonality); APersonality);
LogI('step110');
JSONRPCUnit := ModuleServices.CreateModule(JSONRPCUnitCreator); JSONRPCUnit := ModuleServices.CreateModule(JSONRPCUnitCreator);
LogI('step120');
lJSONRPCUnitName := GetUnitName(JSONRPCUnit.FileName); lJSONRPCUnitName := GetUnitName(JSONRPCUnit.FileName);
//lJSON.S[TConfigKey.jsonrpc_unit_name] := lJSONRPCUnitName;
if Project <> nil then if Project <> nil then
begin begin
Project.AddFile(JSONRPCUnit.FileName, True); Project.AddFile(JSONRPCUnit.FileName, True);
LogI('step130');
end; end;
end; end;
LogI('step140');
// Create Webmodule Unit // Create Webmodule Unit
WebModuleCreator := TNewWebModuleUnitEx.Create( WebModuleCreator := TNewWebModuleUnitEx.Create(
lJSON,
WizardForm.WebModuleClassName, WizardForm.WebModuleClassName,
WizardForm.ControllerClassName, WizardForm.ControllerClassName,
GetUnitName(ControllerUnit.FileName), GetUnitName(ControllerUnit.FileName),
@ -159,6 +180,7 @@ begin
lJSONRPCUnitName, lJSONRPCUnitName,
APersonality); APersonality);
WebModuleUnit := ModuleServices.CreateModule(WebModuleCreator); WebModuleUnit := ModuleServices.CreateModule(WebModuleCreator);
LogI('step150');
if Project <> nil then if Project <> nil then
begin begin
Project.AddFile(WebModuleUnit.FileName, True); Project.AddFile(WebModuleUnit.FileName, True);

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

@ -23,7 +23,7 @@
// *************************************************************************** // ***************************************************************************
// //
// This IDE expert is based off of the one included with the DUnitX // This IDE expert is based off of the one included with the DUnitX
// project. Original source by Robert Love. Adapted by Nick Hodges. // project. Original source by Robert Love. Adapted by Nick Hodges and Daniele Teti.
// //
// The DUnitX project is run by Vincent Parrett and can be found at: // The DUnitX project is run by Vincent Parrett and can be found at:
// //

2
ideexpert/DMVC.Splash.Registration.pas
View File

@ -23,7 +23,7 @@
// *************************************************************************** // ***************************************************************************
// //
// This IDE expert is based off of the one included with the DUnitX // This IDE expert is based off of the one included with the DUnitX
// project. Original source by Robert Love. Adapted by Nick Hodges. // project. Original source by Robert Love. Adapted by Nick Hodges and Daniele Teti.
// //
// The DUnitX project is run by Vincent Parrett and can be found at: // The DUnitX project is run by Vincent Parrett and can be found at:
// //

6
packages/d120/dmvcframeworkDT.dpk
View File

@ -53,6 +53,10 @@ contains
DMVC.Expert.NewUnitWizardEx in '..\..\ideexpert\DMVC.Expert.NewUnitWizardEx.pas', DMVC.Expert.NewUnitWizardEx in '..\..\ideexpert\DMVC.Expert.NewUnitWizardEx.pas',
DMVC.Expert.ProjectWizardEx in '..\..\ideexpert\DMVC.Expert.ProjectWizardEx.pas', DMVC.Expert.ProjectWizardEx in '..\..\ideexpert\DMVC.Expert.ProjectWizardEx.pas',
DMVC.Expert.Registration in '..\..\ideexpert\DMVC.Expert.Registration.pas', DMVC.Expert.Registration in '..\..\ideexpert\DMVC.Expert.Registration.pas',
DMVC.Splash.Registration in '..\..\ideexpert\DMVC.Splash.Registration.pas'; DMVC.Splash.Registration in '..\..\ideexpert\DMVC.Splash.Registration.pas',
DMVC.Expert.Commons in '..\..\ideexpert\DMVC.Expert.Commons.pas',
DMVC.Expert.CodeGen.Executor in '..\..\ideexpert\DMVC.Expert.CodeGen.Executor.pas',
DMVC.Expert.Commands.Templates in '..\..\ideexpert\DMVC.Expert.Commands.Templates.pas',
DMVC.Expert.CodeGen.Commands in '..\..\ideexpert\DMVC.Expert.CodeGen.Commands.pas';
end. end.

13
packages/d120/dmvcframeworkDT.dproj
View File

@ -101,6 +101,7 @@
<VerInfo_Locale>1033</VerInfo_Locale> <VerInfo_Locale>1033</VerInfo_Locale>
<DCC_UNSUPPORTED_CONSTRUCT>false</DCC_UNSUPPORTED_CONSTRUCT> <DCC_UNSUPPORTED_CONSTRUCT>false</DCC_UNSUPPORTED_CONSTRUCT>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=Daniele Teti and the DMVCFramework Team;LegalTrademarks=DelphiMVCFramework;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys> <VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=Daniele Teti and the DMVCFramework Team;LegalTrademarks=DelphiMVCFramework;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<DCC_MapFile>2</DCC_MapFile>
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''"> <PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols> <DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
@ -141,6 +142,10 @@
<DCCReference Include="..\..\ideexpert\DMVC.Expert.ProjectWizardEx.pas"/> <DCCReference Include="..\..\ideexpert\DMVC.Expert.ProjectWizardEx.pas"/>
<DCCReference Include="..\..\ideexpert\DMVC.Expert.Registration.pas"/> <DCCReference Include="..\..\ideexpert\DMVC.Expert.Registration.pas"/>
<DCCReference Include="..\..\ideexpert\DMVC.Splash.Registration.pas"/> <DCCReference Include="..\..\ideexpert\DMVC.Splash.Registration.pas"/>
<DCCReference Include="..\..\ideexpert\DMVC.Expert.Commons.pas"/>
<DCCReference Include="..\..\ideexpert\DMVC.Expert.CodeGen.Executor.pas"/>
<DCCReference Include="..\..\ideexpert\DMVC.Expert.Commands.Templates.pas"/>
<DCCReference Include="..\..\ideexpert\DMVC.Expert.CodeGen.Commands.pas"/>
<RcItem Include="..\..\ideexpert\DMVC.Expert.NewProject.ico"> <RcItem Include="..\..\ideexpert\DMVC.Expert.NewProject.ico">
<ResourceType>ICON</ResourceType> <ResourceType>ICON</ResourceType>
<ResourceId>DMVCNewProjectIcon</ResourceId> <ResourceId>DMVCNewProjectIcon</ResourceId>
@ -176,6 +181,8 @@
<Excluded_Packages> <Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k290.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages> <Excluded_Packages Name="$(BDSBIN)\dcloffice2k290.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp290.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages> <Excluded_Packages Name="$(BDSBIN)\dclofficexp290.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\bcboffice2k290.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\bcbofficexp290.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages>
</Excluded_Packages> </Excluded_Packages>
</Delphi.Personality> </Delphi.Personality>
<Deployment Version="4"> <Deployment Version="4">
@ -198,6 +205,12 @@
</DeployFile> </DeployFile>
<DeployFile LocalName="$(BDS)\Redist\osx64\libcgsqlite3.dylib" Class="DependencyModule"/> <DeployFile LocalName="$(BDS)\Redist\osx64\libcgsqlite3.dylib" Class="DependencyModule"/>
<DeployFile LocalName="C:\Users\Public\Documents\Embarcadero\Studio\20.0\Bpl\dmvcframeworkDT104.bpl" Configuration="Debug" Class="ProjectOutput"/> <DeployFile LocalName="C:\Users\Public\Documents\Embarcadero\Studio\20.0\Bpl\dmvcframeworkDT104.bpl" Configuration="Debug" Class="ProjectOutput"/>
<DeployFile LocalName="C:\Users\Public\Documents\Embarcadero\Studio\23.0\Bpl\dmvcframeworkDT120.bpl" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>dmvcframeworkDT.bpl</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployClass Name="AdditionalDebugSymbols"> <DeployClass Name="AdditionalDebugSymbols">
<Platform Name="OSX32"> <Platform Name="OSX32">
<Operation>1</Operation> <Operation>1</Operation>

40
packages/d120/dmvcframeworkRT.dproj
View File

@ -9,20 +9,11 @@
<Platform Condition="'$(Platform)'==''">Win32</Platform> <Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>1</TargetedPlatforms> <TargetedPlatforms>1</TargetedPlatforms>
<AppType>Package</AppType> <AppType>Package</AppType>
<ProjectName Condition="'$(ProjectName)'==''">dmvcframeworkRT</ProjectName>
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''"> <PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base> <Base>true</Base>
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Android' and '$(Base)'=='true') or '$(Base_Android)'!=''">
<Base_Android>true</Base_Android>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Android64' and '$(Base)'=='true') or '$(Base_Android64)'!=''">
<Base_Android64>true</Base_Android64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''"> <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32> <Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent> <CfgParent>Base</CfgParent>
@ -33,6 +24,11 @@
<CfgParent>Base</CfgParent> <CfgParent>Base</CfgParent>
<Base>true</Base> <Base>true</Base>
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64x' and '$(Base)'=='true') or '$(Base_Win64x)'!=''">
<Base_Win64x>true</Base_Win64x>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''"> <PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1> <Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent> <CfgParent>Base</CfgParent>
@ -74,16 +70,6 @@
<DCC_Description>DMVCFramework - CopyRight (2010-2020) Daniele Teti and the DMVCFramework Team</DCC_Description> <DCC_Description>DMVCFramework - CopyRight (2010-2020) Daniele Teti and the DMVCFramework Team</DCC_Description>
<DllSuffix>120</DllSuffix> <DllSuffix>120</DllSuffix>
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition="'$(Base_Android)'!=''">
<VerInfo_Keys>package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey=</VerInfo_Keys>
<BT_BuildType>Debug</BT_BuildType>
<EnabledSysJars>activity-1.7.2.dex.jar;annotation-experimental-1.3.0.dex.jar;annotation-jvm-1.6.0.dex.jar;annotations-13.0.dex.jar;appcompat-1.2.0.dex.jar;appcompat-resources-1.2.0.dex.jar;billing-6.0.1.dex.jar;biometric-1.1.0.dex.jar;browser-1.4.0.dex.jar;cloud-messaging.dex.jar;collection-1.1.0.dex.jar;concurrent-futures-1.1.0.dex.jar;core-1.10.1.dex.jar;core-common-2.2.0.dex.jar;core-ktx-1.10.1.dex.jar;core-runtime-2.2.0.dex.jar;cursoradapter-1.0.0.dex.jar;customview-1.0.0.dex.jar;documentfile-1.0.0.dex.jar;drawerlayout-1.0.0.dex.jar;error_prone_annotations-2.9.0.dex.jar;exifinterface-1.3.6.dex.jar;firebase-annotations-16.2.0.dex.jar;firebase-common-20.3.1.dex.jar;firebase-components-17.1.0.dex.jar;firebase-datatransport-18.1.7.dex.jar;firebase-encoders-17.0.0.dex.jar;firebase-encoders-json-18.0.0.dex.jar;firebase-encoders-proto-16.0.0.dex.jar;firebase-iid-interop-17.1.0.dex.jar;firebase-installations-17.1.3.dex.jar;firebase-installations-interop-17.1.0.dex.jar;firebase-measurement-connector-19.0.0.dex.jar;firebase-messaging-23.1.2.dex.jar;fmx.dex.jar;fragment-1.2.5.dex.jar;google-play-licensing.dex.jar;interpolator-1.0.0.dex.jar;javax.inject-1.dex.jar;kotlin-stdlib-1.8.22.dex.jar;kotlin-stdlib-common-1.8.22.dex.jar;kotlin-stdlib-jdk7-1.8.22.dex.jar;kotlin-stdlib-jdk8-1.8.22.dex.jar;kotlinx-coroutines-android-1.6.4.dex.jar;kotlinx-coroutines-core-jvm-1.6.4.dex.jar;legacy-support-core-utils-1.0.0.dex.jar;lifecycle-common-2.6.1.dex.jar;lifecycle-livedata-2.6.1.dex.jar;lifecycle-livedata-core-2.6.1.dex.jar;lifecycle-runtime-2.6.1.dex.jar;lifecycle-service-2.6.1.dex.jar;lifecycle-viewmodel-2.6.1.dex.jar;lifecycle-viewmodel-savedstate-2.6.1.dex.jar;listenablefuture-1.0.dex.jar;loader-1.0.0.dex.jar;localbroadcastmanager-1.0.0.dex.jar;okio-jvm-3.4.0.dex.jar;play-services-ads-22.2.0.dex.jar;play-services-ads-base-22.2.0.dex.jar;play-services-ads-identifier-18.0.0.dex.jar;play-services-ads-lite-22.2.0.dex.jar;play-services-appset-16.0.1.dex.jar;play-services-base-18.1.0.dex.jar;play-services-basement-18.1.0.dex.jar;play-services-cloud-messaging-17.0.1.dex.jar;play-services-location-21.0.1.dex.jar;play-services-maps-18.1.0.dex.jar;play-services-measurement-base-20.1.2.dex.jar;play-services-measurement-sdk-api-20.1.2.dex.jar;play-services-stats-17.0.2.dex.jar;play-services-tasks-18.0.2.dex.jar;print-1.0.0.dex.jar;profileinstaller-1.3.0.dex.jar;room-common-2.2.5.dex.jar;room-runtime-2.2.5.dex.jar;savedstate-1.2.1.dex.jar;sqlite-2.1.0.dex.jar;sqlite-framework-2.1.0.dex.jar;startup-runtime-1.1.1.dex.jar;tracing-1.0.0.dex.jar;transport-api-3.0.0.dex.jar;transport-backend-cct-3.1.8.dex.jar;transport-runtime-3.1.8.dex.jar;user-messaging-platform-2.0.0.dex.jar;vectordrawable-1.1.0.dex.jar;vectordrawable-animated-1.1.0.dex.jar;versionedparcelable-1.1.1.dex.jar;viewpager-1.0.0.dex.jar;work-runtime-2.7.0.dex.jar</EnabledSysJars>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Android64)'!=''">
<VerInfo_Keys>package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey=</VerInfo_Keys>
<BT_BuildType>Debug</BT_BuildType>
<EnabledSysJars>activity-1.7.2.dex.jar;annotation-experimental-1.3.0.dex.jar;annotation-jvm-1.6.0.dex.jar;annotations-13.0.dex.jar;appcompat-1.2.0.dex.jar;appcompat-resources-1.2.0.dex.jar;billing-6.0.1.dex.jar;biometric-1.1.0.dex.jar;browser-1.4.0.dex.jar;cloud-messaging.dex.jar;collection-1.1.0.dex.jar;concurrent-futures-1.1.0.dex.jar;core-1.10.1.dex.jar;core-common-2.2.0.dex.jar;core-ktx-1.10.1.dex.jar;core-runtime-2.2.0.dex.jar;cursoradapter-1.0.0.dex.jar;customview-1.0.0.dex.jar;documentfile-1.0.0.dex.jar;drawerlayout-1.0.0.dex.jar;error_prone_annotations-2.9.0.dex.jar;exifinterface-1.3.6.dex.jar;firebase-annotations-16.2.0.dex.jar;firebase-common-20.3.1.dex.jar;firebase-components-17.1.0.dex.jar;firebase-datatransport-18.1.7.dex.jar;firebase-encoders-17.0.0.dex.jar;firebase-encoders-json-18.0.0.dex.jar;firebase-encoders-proto-16.0.0.dex.jar;firebase-iid-interop-17.1.0.dex.jar;firebase-installations-17.1.3.dex.jar;firebase-installations-interop-17.1.0.dex.jar;firebase-measurement-connector-19.0.0.dex.jar;firebase-messaging-23.1.2.dex.jar;fmx.dex.jar;fragment-1.2.5.dex.jar;google-play-licensing.dex.jar;interpolator-1.0.0.dex.jar;javax.inject-1.dex.jar;kotlin-stdlib-1.8.22.dex.jar;kotlin-stdlib-common-1.8.22.dex.jar;kotlin-stdlib-jdk7-1.8.22.dex.jar;kotlin-stdlib-jdk8-1.8.22.dex.jar;kotlinx-coroutines-android-1.6.4.dex.jar;kotlinx-coroutines-core-jvm-1.6.4.dex.jar;legacy-support-core-utils-1.0.0.dex.jar;lifecycle-common-2.6.1.dex.jar;lifecycle-livedata-2.6.1.dex.jar;lifecycle-livedata-core-2.6.1.dex.jar;lifecycle-runtime-2.6.1.dex.jar;lifecycle-service-2.6.1.dex.jar;lifecycle-viewmodel-2.6.1.dex.jar;lifecycle-viewmodel-savedstate-2.6.1.dex.jar;listenablefuture-1.0.dex.jar;loader-1.0.0.dex.jar;localbroadcastmanager-1.0.0.dex.jar;okio-jvm-3.4.0.dex.jar;play-services-ads-22.2.0.dex.jar;play-services-ads-base-22.2.0.dex.jar;play-services-ads-identifier-18.0.0.dex.jar;play-services-ads-lite-22.2.0.dex.jar;play-services-appset-16.0.1.dex.jar;play-services-base-18.1.0.dex.jar;play-services-basement-18.1.0.dex.jar;play-services-cloud-messaging-17.0.1.dex.jar;play-services-location-21.0.1.dex.jar;play-services-maps-18.1.0.dex.jar;play-services-measurement-base-20.1.2.dex.jar;play-services-measurement-sdk-api-20.1.2.dex.jar;play-services-stats-17.0.2.dex.jar;play-services-tasks-18.0.2.dex.jar;print-1.0.0.dex.jar;profileinstaller-1.3.0.dex.jar;room-common-2.2.5.dex.jar;room-runtime-2.2.5.dex.jar;savedstate-1.2.1.dex.jar;sqlite-2.1.0.dex.jar;sqlite-framework-2.1.0.dex.jar;startup-runtime-1.1.1.dex.jar;tracing-1.0.0.dex.jar;transport-api-3.0.0.dex.jar;transport-backend-cct-3.1.8.dex.jar;transport-runtime-3.1.8.dex.jar;user-messaging-platform-2.0.0.dex.jar;vectordrawable-1.1.0.dex.jar;vectordrawable-animated-1.1.0.dex.jar;versionedparcelable-1.1.1.dex.jar;viewpager-1.0.0.dex.jar;work-runtime-2.7.0.dex.jar</EnabledSysJars>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''"> <PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace> <DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<BT_BuildType>Debug</BT_BuildType> <BT_BuildType>Debug</BT_BuildType>
@ -95,6 +81,12 @@
<PropertyGroup Condition="'$(Base_Win64)'!=''"> <PropertyGroup Condition="'$(Base_Win64)'!=''">
<DCC_UsePackage>rtl;dbrtl;IndySystem;IndyProtocols;IndyCore;$(DCC_UsePackage)</DCC_UsePackage> <DCC_UsePackage>rtl;dbrtl;IndySystem;IndyProtocols;IndyCore;$(DCC_UsePackage)</DCC_UsePackage>
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64x)'!=''">
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)</DCC_Namespace>
<BT_BuildType>Debug</BT_BuildType>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Locale>1033</VerInfo_Locale>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''"> <PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define> <DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_DebugDCUs>true</DCC_DebugDCUs> <DCC_DebugDCUs>true</DCC_DebugDCUs>
@ -852,6 +844,9 @@
<Platform Name="Win64"> <Platform Name="Win64">
<Operation>1</Operation> <Operation>1</Operation>
</Platform> </Platform>
<Platform Name="Win64x">
<Operation>1</Operation>
</Platform>
</DeployClass> </DeployClass>
<DeployClass Name="ProjectiOSDeviceDebug"> <DeployClass Name="ProjectiOSDeviceDebug">
<Platform Name="iOSDevice32"> <Platform Name="iOSDevice32">
@ -1113,13 +1108,12 @@
<ProjectRoot Platform="OSXARM64" Name="$(PROJECTNAME)"/> <ProjectRoot Platform="OSXARM64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/> <ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/> <ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win64x" Name="$(PROJECTNAME)"/>
</Deployment> </Deployment>
<Platforms> <Platforms>
<Platform value="Android">False</Platform>
<Platform value="Android64">False</Platform>
<Platform value="Linux64">False</Platform>
<Platform value="Win32">True</Platform> <Platform value="Win32">True</Platform>
<Platform value="Win64">False</Platform> <Platform value="Win64">False</Platform>
<Platform value="Win64x">False</Platform>
</Platforms> </Platforms>
</BorlandProject> </BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion> <ProjectFileVersion>12</ProjectFileVersion>

250
tools/projectgenerator/Commands.ImplementationU.pas
View File

@ -1,250 +0,0 @@
unit Commands.ImplementationU;
interface
uses CommonsU, System.SysUtils, MVCFramework.Commons, JsonDataObjects;
type
TUnitFooterCommand = class(TCustomCommand)
public
procedure ExecuteImplementation(
Section: TStringBuilder;
Model: TJSONObject
); override;
procedure ExecuteInterface(
Section: TStringBuilder;
Model: TJsonObject); override;
end;
TUnitMainBeginEndCommand = class(TCustomCommand)
public
procedure ExecuteImplementation(
Section: TStringBuilder;
Model: TJSONObject
); override;
procedure ExecuteInterface(Section: TStringBuilder; Model: TJsonObject); override;
end;
TUnitRunServerProcBody = class(TCustomCommand)
public
procedure ExecuteImplementation(
Section: TStringBuilder;
Model: TJSONObject
); override;
procedure ExecuteInterface(Section: TStringBuilder; Model: TJsonObject); override;
end;
TUnitControllerEntityImplementationCommand = class(TCustomCommand)
public
procedure ExecuteImplementation(
Section: TStringBuilder;
Model: TJSONObject
); override;
end;
TUnitControllerControllerImplementationCommand = class(TCustomCommand)
public
procedure ExecuteImplementation(
Section: TStringBuilder;
Model: TJSONObject
); override;
end;
implementation
{ TUnitFooterCommand }
procedure TUnitFooterCommand.ExecuteImplementation(Section: TStringBuilder;
Model: TJSONObject);
begin
inherited;
Section.AppendLine.AppendLine('end.');
end;
procedure TUnitFooterCommand.ExecuteInterface(Section: TStringBuilder;
Model: TJsonObject);
begin
inherited;
end;
{ TUnitMainBeginEndCommand }
procedure TUnitMainBeginEndCommand.ExecuteImplementation(Section: TStringBuilder;
Model: TJSONObject);
begin
inherited;
Section
.AppendLine
.AppendLine('begin')
.AppendLine(' { Enable ReportMemoryLeaksOnShutdown during debug }')
.AppendLine(' // ReportMemoryLeaksOnShutdown := True;')
.AppendLine(' IsMultiThread := True;'' + sLineBreak + sLineBreak +')
.AppendLine(' // DMVCFramework Specific Configuration ')
.AppendLine(' // When MVCSerializeNulls = True empty nullables and nil are serialized as json null.')
.AppendLine(' // When MVCSerializeNulls = False empty nullables and nil are not serialized at all.')
.AppendLine(' MVCSerializeNulls := True;')
.AppendLine(' UseConsoleLogger := True;')
.AppendLine(' LogI(''** DMVCFramework Server ** build '' + DMVCFRAMEWORK_VERSION);')
.AppendLine(' try')
.AppendLine(' if WebRequestHandler <> nil then')
.AppendLine(' WebRequestHandler.WebModuleClass := WebModuleClass;')
.AppendLine
.AppendLine(' dotEnvConfigure(')
.AppendLine(' function: IMVCDotEnv')
.AppendLine(' begin')
.AppendLine(' Result := NewDotEnv')
.AppendLine(' .UseStrategy(TMVCDotEnvPriority.FileThenEnv)')
.AppendLine(' //if available, by default, loads default environment (.env)')
.AppendLine(' .UseProfile(''test'') //if available loads the test environment (.env.test)')
.AppendLine(' .UseProfile(''prod'') //if available loads the prod environment (.env.prod)')
.AppendLine(' .UseLogger(procedure(LogItem: String)')
.AppendLine(' begin')
.AppendLine(' LogD(''dotEnv: '' + LogItem);')
.AppendLine(' end)')
.AppendLine(' .Build(); //uses the executable folder to look for .env* files')
.AppendLine(' end);')
.AppendLine
.AppendLine(' WebRequestHandlerProc.MaxConnections := dotEnv.Env(''dmvc.handler.max_connections'', 1024);')
.AppendLine
.AppendLine('{$IF Defined(SYDNEYORBETTER)}')
.AppendLine(' if dotEnv.Env(''dmvc.profiler.enabled'', false) then')
.AppendLine(' begin')
.AppendLine(' Profiler.ProfileLogger := Log;')
.AppendLine(' Profiler.WarningThreshold := dotEnv.Env(''dmvc.profiler.warning_threshold'', 2000);')
.AppendLine(' end;')
.AppendLine('{$ENDIF}')
.AppendLine
.AppendLine(' RunServer(dotEnv.Env(''dmvc.server.port'', %1:d));')
.AppendLine(' except')
.AppendLine(' on E: Exception do')
.AppendLine(' LogF(E.ClassName + '': '' + E.Message);')
.AppendLine(' end;')
.AppendLine('end.')
end;
procedure TUnitMainBeginEndCommand.ExecuteInterface(Section: TStringBuilder;
Model: TJsonObject);
begin
inherited;
end;
{ TUnitRunServerProcBody }
procedure TUnitRunServerProcBody.ExecuteImplementation(Section: TStringBuilder;
Model: TJSONObject);
begin
inherited;
Section
.AppendLine('procedure RunServer(APort: Integer);')
.AppendLine('var')
.AppendLine(' LServer: TIdHTTPWebBrokerBridge;')
.AppendLine('begin')
.AppendLine(' LServer := TIdHTTPWebBrokerBridge.Create(nil);')
.AppendLine(' try')
.AppendLine(' LServer.OnParseAuthentication := TMVCParseAuthentication.OnParseAuthentication;')
.AppendLine(' LServer.DefaultPort := APort;')
.AppendLine(' LServer.KeepAlive := True;')
.AppendLine(' LServer.MaxConnections := dotEnv.Env(''dmvc.webbroker.max_connections'', 0);')
.AppendLine(' LServer.ListenQueue := dotEnv.Env(''dmvc.indy.listen_queue'', 500);')
.AppendLine(' LServer.Active := True;')
.AppendLine(' LogI(''Listening on port '' + APort.ToString);')
.AppendLine(' LogI(''Application started. Press Ctrl+C to shut down.'');')
.AppendLine(' WaitForTerminationSignal;')
.AppendLine(' EnterInShutdownState;')
.AppendLine(' LServer.Active := False;')
.AppendLine(' finally')
.AppendLine(' LServer.Free;')
.AppendLine(' end;')
.AppendLine('end;')
end;
procedure TUnitRunServerProcBody.ExecuteInterface(Section: TStringBuilder;
Model: TJsonObject);
begin
inherited;
end;
{ TUnitControllerEntityImplementationCommand }
procedure TUnitControllerEntityImplementationCommand.ExecuteImplementation(
Section: TStringBuilder; Model: TJSONObject);
begin
inherited;
if not Model.B['entity.generate'] then Exit;
CheckFor('entity.class_name', Model);
Section
.AppendLine('constructor ' + Model['entity.class_name'] + '.Create(FirstName, LastName: String; DOB: TDate);')
.AppendLine('begin')
.AppendLine(' inherited Create;')
.AppendLine(' fFirstName := FirstName;')
.AppendLine(' fLastName := LastName;')
.AppendLine(' fDOB := DOB;')
.AppendLine('end;')
end;
{ TUnitControllerControllerImplementationCommand }
procedure TUnitControllerControllerImplementationCommand.ExecuteImplementation(
Section: TStringBuilder; Model: TJSONObject);
begin
inherited;
CheckFor('controller.name', Model);
Section
.AppendLine('[MVCPath(''/api'')]')
.AppendLine(Model['controller.name'] + ' = class(TMVCController)')
.AppendLine(' public');
if Model.B['controller.index_methods.generate'] then
begin
Section
.AppendLine(' [MVCPath]')
.AppendLine(' [MVCHTTPMethod([httpGET])]')
.AppendLine(' function Index: String;')
.AppendLine(' [MVCPath(''/reversedstrings/($Value)'')]')
.AppendLine(' [MVCHTTPMethod([httpGET])]')
.AppendLine(' [MVCProduces(TMVCMediaType.TEXT_PLAIN)]')
.AppendLine(' function GetReversedString(const Value: String): String;')
end;
if Model.B['controller.action_filters.generate'] then
begin
Section
.AppendLine(' protected')
.AppendLine(' procedure OnBeforeAction(Context: TWebContext; const AActionName: string; var Handled: Boolean); override;')
.AppendLine
.AppendLine(' procedure OnAfterAction(Context: TWebContext; const AActionName: string); override;')
end;
if Model.B['controller.crud_methods.generate'] then
begin
Section
.AppendLine(' public')
.AppendLine(' //Sample CRUD Actions for a "People" entity')
.AppendLine(' [MVCPath(''/people'')]')
.AppendLine(' [MVCHTTPMethod([httpGET])]')
.AppendLine(' function GetPeople: TObjectList<TPerson>;')
.AppendLine(' [MVCPath(''/people/($ID)'')]')
.AppendLine(' [MVCHTTPMethod([httpGET])]')
.AppendLine(' function GetPerson(ID: Integer): TPerson;')
.AppendLine(' [MVCPath(''/people'')]')
.AppendLine(' [MVCHTTPMethod([httpPOST])]')
.AppendLine(' function CreatePerson([MVCFromBody] Person: TPerson): IMVCResponse;')
.AppendLine(' [MVCPath(''/people/($ID)'')]')
.AppendLine(' [MVCHTTPMethod([httpPUT])]')
.AppendLine(' function UpdatePerson(ID: Integer; [MVCFromBody] Person: TPerson): IMVCResponse;')
.AppendLine(' [MVCPath(''/people/($ID)'')]')
.AppendLine(' [MVCHTTPMethod([httpDELETE])]')
.AppendLine(' function DeletePerson(ID: Integer): IMVCResponse;')
end;
Section
.AppendLine('end;')
.AppendLine
end;
end.

2
tools/projectgenerator/Commands.TemplatesU.pas
View File

@ -13,7 +13,7 @@ procedure FillJSONRPCTemplates(Gen: TMVCCodeGenerator);
implementation implementation
uses Commands.ImplementationU, CommandsU; uses CommandsU;
procedure FillProgramTemplates(Gen: TMVCCodeGenerator); procedure FillProgramTemplates(Gen: TMVCCodeGenerator);
begin begin

53
tools/projectgenerator/CommandsU.pas
View File

@ -571,7 +571,7 @@ begin
.AppendLine('uses') .AppendLine('uses')
.AppendLine(' ' + Model[TConfigKey.controller_unit_name] + ','); .AppendLine(' ' + Model[TConfigKey.controller_unit_name] + ',');
if Model.B['jsonrpc.generate'] then if Model.B[TConfigKey.jsonrpc_generate] then
begin begin
Section.AppendLine(' ' + Model[TConfigKey.jsonrpc_unit_name] + ',') Section.AppendLine(' ' + Model[TConfigKey.jsonrpc_unit_name] + ',')
end; end;
@ -587,7 +587,7 @@ begin
.AppendLine(' MVCFramework.Middleware.ETag,') .AppendLine(' MVCFramework.Middleware.ETag,')
.AppendLine(' MVCFramework.Middleware.Compression;') .AppendLine(' MVCFramework.Middleware.Compression;')
.AppendLine .AppendLine
.AppendLine('procedure ' + Model.S['webmodule.classname'] + '.WebModuleCreate(Sender: TObject);') .AppendLine('procedure ' + Model.S[TConfigKey.webmodule_classname] + '.WebModuleCreate(Sender: TObject);')
.AppendLine('begin') .AppendLine('begin')
.AppendLine(' FMVC := TMVCEngine.Create(Self,') .AppendLine(' FMVC := TMVCEngine.Create(Self,')
.AppendLine(' procedure(Config: TMVCConfig)') .AppendLine(' procedure(Config: TMVCConfig)')
@ -625,37 +625,37 @@ begin
.AppendLine .AppendLine
.AppendLine(' // Middleware'); .AppendLine(' // Middleware');
if Model.B['webmodule.middleware.analytics'] then if Model.B[TConfigKey.webmodule_middleware_analytics] then
begin begin
Section.AppendLine(' fMVC.AddMiddleware(TMVCAnalyticsMiddleware.Create(GetAnalyticsDefaultLogger));') Section.AppendLine(' fMVC.AddMiddleware(TMVCAnalyticsMiddleware.Create(GetAnalyticsDefaultLogger));')
end; end;
if Model.B['webmodule.middleware.staticfiles'] then if Model.B[TConfigKey.webmodule_middleware_staticfiles] then
begin begin
Section.AppendLine(' fMVC.AddMiddleware(TMVCStaticFilesMiddleware.Create(''/static'', TPath.Combine(ExtractFilePath(GetModuleName(HInstance)), ''www'')));') Section.AppendLine(' fMVC.AddMiddleware(TMVCStaticFilesMiddleware.Create(''/static'', TPath.Combine(ExtractFilePath(GetModuleName(HInstance)), ''www'')));')
end; end;
if Model.B['webmodule.middleware.trace'] then if Model.B[TConfigKey.webmodule_middleware_trace] then
begin begin
Section.AppendLine(' fMVC.AddMiddleware(TMVCTraceMiddleware.Create);') Section.AppendLine(' fMVC.AddMiddleware(TMVCTraceMiddleware.Create);')
end; end;
if Model.B['webmodule.middleware.compression'] then if Model.B[TConfigKey.webmodule_middleware_compression] then
begin begin
Section.AppendLine(' fMVC.AddMiddleware(TMVCCompressionMiddleware.Create);') Section.AppendLine(' fMVC.AddMiddleware(TMVCCompressionMiddleware.Create);')
end; end;
if Model.B['webmodule.middleware.etag'] then if Model.B[TConfigKey.webmodule_middleware_etag] then
begin begin
Section.AppendLine(' fMVC.AddMiddleware(TMVCETagMiddleware.Create);') Section.AppendLine(' fMVC.AddMiddleware(TMVCETagMiddleware.Create);')
end; end;
if Model.B['webmodule.middleware.cors'] then if Model.B[TConfigKey.webmodule_middleware_cors] then
begin begin
Section.AppendLine(' fMVC.AddMiddleware(TMVCCORSMiddleware.Create);') Section.AppendLine(' fMVC.AddMiddleware(TMVCCORSMiddleware.Create);')
end; end;
if Model.B['webmodule.middleware.activerecord'] then if Model.B[TConfigKey.webmodule_middleware_activerecord] then
begin begin
activerecord_con_def_name := Model[TConfigKey.webmodule_middleware_activerecord_con_def_name]; activerecord_con_def_name := Model[TConfigKey.webmodule_middleware_activerecord_con_def_name];
activerecord_con_def_filename := Model[TConfigKey.webmodule_middleware_activerecord_con_def_filename]; activerecord_con_def_filename := Model[TConfigKey.webmodule_middleware_activerecord_con_def_filename];
@ -669,7 +669,7 @@ begin
Section Section
.AppendLine(' // Middleware - END'); .AppendLine(' // Middleware - END');
if Model.B['jsonrpc.generate'] then if Model.B[TConfigKey.jsonrpc_generate] then
begin begin
Section Section
.AppendLine .AppendLine
@ -686,7 +686,7 @@ begin
.AppendLine .AppendLine
.AppendLine('end;') .AppendLine('end;')
.AppendLine .AppendLine
.AppendLine('procedure ' + Model.S['webmodule.classname'] + '.WebModuleDestroy(Sender: TObject);') .AppendLine('procedure ' + Model.S[TConfigKey.webmodule_classname] + '.WebModuleDestroy(Sender: TObject);')
.AppendLine('begin') .AppendLine('begin')
.AppendLine(' FMVC.Free;') .AppendLine(' FMVC.Free;')
.AppendLine('end;') .AppendLine('end;')
@ -698,9 +698,10 @@ procedure TUnitWebModuleDeclarationCommand.ExecuteInterface(
Section: TStringBuilder; Model: TJSONObject); Section: TStringBuilder; Model: TJSONObject);
begin begin
inherited; inherited;
CheckFor('webmodule.classname', Model); CheckFor(TConfigKey.webmodule_unit_name, Model);
CheckFor(TConfigKey.webmodule_classname, Model);
Section Section
.AppendLine('unit ' + Model.S['webmodule.classname'].Substring(1) + 'U;') .AppendLine('unit ' + Model.S[TConfigKey.webmodule_unit_name] + ';')
.AppendLine('') .AppendLine('')
.AppendLine('interface') .AppendLine('interface')
.AppendLine .AppendLine
@ -719,7 +720,7 @@ begin
.AppendLine(' end;') .AppendLine(' end;')
.AppendLine .AppendLine
.AppendLine('var') .AppendLine('var')
.AppendLine(' WebModuleClass: TComponentClass = ' + Model.S['webmodule.classname'] + ';') .AppendLine(' WebModuleClass: TComponentClass = ' + Model.S[TConfigKey.webmodule_classname] + ';')
end; end;
{ TUnitJSONRPCDeclarationCommand } { TUnitJSONRPCDeclarationCommand }
@ -728,13 +729,17 @@ procedure TUnitJSONRPCDeclarationCommand.ExecuteImplementation(
Section: TStringBuilder; Model: TJsonObject); Section: TStringBuilder; Model: TJsonObject);
begin begin
inherited; inherited;
if not Model.B[TConfigKey.jsonrpc_generate] then
begin
Exit;
end;
Section Section
.AppendLine('implementation') .AppendLine('implementation')
.AppendLine .AppendLine
.AppendLine('uses') .AppendLine('uses')
.AppendLine(' System.StrUtils;') .AppendLine(' System.StrUtils;')
.AppendLine .AppendLine
.AppendLine('function ' + Model.S['jsonrpc.classname'] + '.ReverseString(const Value: String): String;') .AppendLine('function ' + Model.S[TConfigKey.jsonrpc_classname] + '.ReverseString(const Value: String): String;')
.AppendLine('begin') .AppendLine('begin')
.AppendLine(' Result := System.StrUtils.ReverseString(Value);') .AppendLine(' Result := System.StrUtils.ReverseString(Value);')
.AppendLine('end;') .AppendLine('end;')
@ -746,6 +751,14 @@ procedure TUnitJSONRPCDeclarationCommand.ExecuteInterface(
Section: TStringBuilder; Model: TJSONObject); Section: TStringBuilder; Model: TJSONObject);
begin begin
inherited; inherited;
CheckFor(TConfigKey.jsonrpc_generate, Model);
if not Model.B[TConfigKey.jsonrpc_generate] then
begin
Exit;
end;
CheckFor(TConfigKey.jsonrpc_unit_name, Model);
CheckFor(TConfigKey.jsonrpc_classname, Model);
Section Section
.AppendLine('unit ' + Model[TConfigKey.jsonrpc_unit_name] + ';') .AppendLine('unit ' + Model[TConfigKey.jsonrpc_unit_name] + ';')
.AppendLine .AppendLine
@ -881,8 +894,8 @@ procedure TUnitControllerEntityImplementationCommand.ExecuteImplementation(
Section: TStringBuilder; Model: TJSONObject); Section: TStringBuilder; Model: TJSONObject);
begin begin
inherited; inherited;
if not Model.B['entity.generate'] then Exit; if not Model.B[TConfigKey.entity_generate] then Exit;
CheckFor('entity.class_name', Model); CheckFor(TConfigKey.entity_classname, Model);
Section Section
.AppendLine('constructor ' + Model[TConfigKey.entity_classname] + '.Create(FirstName, LastName: String; DOB: TDate);') .AppendLine('constructor ' + Model[TConfigKey.entity_classname] + '.Create(FirstName, LastName: String; DOB: TDate);')
.AppendLine('begin') .AppendLine('begin')
@ -899,7 +912,7 @@ procedure TUnitControllerControllerImplementationCommand.ExecuteImplementation(
Section: TStringBuilder; Model: TJSONObject); Section: TStringBuilder; Model: TJSONObject);
begin begin
inherited; inherited;
CheckFor('controller.name', Model); CheckFor(TConfigKey.controller_classname, Model);
Section Section
.AppendLine('[MVCPath(''/api'')]') .AppendLine('[MVCPath(''/api'')]')
@ -918,7 +931,7 @@ begin
.AppendLine(' function GetReversedString(const Value: String): String;') .AppendLine(' function GetReversedString(const Value: String): String;')
end; end;
if Model.B['controller.action_filters.generate'] then if Model.B[TConfigKey.controller_action_filters_generate] then
begin begin
Section Section
.AppendLine(' protected') .AppendLine(' protected')
@ -927,7 +940,7 @@ begin
.AppendLine(' procedure OnAfterAction(Context: TWebContext; const AActionName: string); override;') .AppendLine(' procedure OnAfterAction(Context: TWebContext; const AActionName: string); override;')
end; end;
if Model.B['controller.crud_methods.generate'] then if Model.B[TConfigKey.controller_crud_methods_generate] then
begin begin
Section Section
.AppendLine(' public') .AppendLine(' public')

5
tools/projectgenerator/CommonsU.pas
View File

@ -36,6 +36,7 @@ type
jsonrpc_classname= 'jsonrpc.classname'; jsonrpc_classname= 'jsonrpc.classname';
jsonrpc_unit_name='jsonrpc.unit_name'; jsonrpc_unit_name='jsonrpc.unit_name';
webmodule_classname= 'webmodule.classname'; webmodule_classname= 'webmodule.classname';
webmodule_unit_name= 'webmodule.unit_name';
webmodule_middleware_analytics= 'webmodule.middleware.analytics'; webmodule_middleware_analytics= 'webmodule.middleware.analytics';
webmodule_middleware_staticfiles= 'webmodule.middleware.staticfiles'; webmodule_middleware_staticfiles= 'webmodule.middleware.staticfiles';
webmodule_middleware_trace= 'webmodule.middleware.trace'; webmodule_middleware_trace= 'webmodule.middleware.trace';
@ -54,9 +55,9 @@ implementation
procedure TCustomCommand.CheckFor(const Key: String; procedure TCustomCommand.CheckFor(const Key: String;
Model: TJSONObject); Model: TJSONObject);
begin begin
if not Model.Contains(Key) then if (not Model.Contains(Key)) or Model.S[Key].IsEmpty then
begin begin
raise Exception.CreateFmt('Required key "%s" not found while processing %s', [Key, ClassName]); raise Exception.CreateFmt('Required key "%s" not found or empty while processing %s', [Key, ClassName]);
end; end;
end; end;

21
tools/projectgenerator/ProjectGeneratorU.pas
View File

@ -3,8 +3,8 @@ unit ProjectGeneratorU;
interface interface
uses uses
MVCFramework.Commons, System.SysUtils, System.Generics.Collections, CommonsU, MVCFramework.Commons, System.SysUtils, System.Generics.Collections,
JsonDataObjects; JsonDataObjects, DMVC.Expert.Commons;
type type
TMVCCodeGenerator = class TMVCCodeGenerator = class
@ -19,6 +19,7 @@ type
procedure Execute(Model: TJSONObject); procedure Execute(Model: TJSONObject);
function Commands: TList<IGenCommand>; function Commands: TList<IGenCommand>;
function Source: String; function Source: String;
class function GenerateSource(ConfigModelRef: TJSONObject; FillerProc: TProc<TMVCCodeGenerator>): String;
end; end;
@ -67,6 +68,22 @@ begin
end; end;
end; end;
class function TMVCCodeGenerator.GenerateSource(ConfigModelRef: TJSONObject;
FillerProc: TProc<TMVCCodeGenerator>): String;
var
lGenerator: TMVCCodeGenerator;
begin
lGenerator := TMVCCodeGenerator.Create;
try
lGenerator.Commands.Clear;
FillerProc(lGenerator);
lGenerator.Execute(ConfigModelRef);
Result := lGenerator.Source;
finally
lGenerator.Free;
end;
end;
{ TIntfCommand } { TIntfCommand }
function TMVCCodeGenerator.Source: String; function TMVCCodeGenerator.Source: String;