From 6af372e7724b11c0c59a42d0be3b13b71430fc05 Mon Sep 17 00:00:00 2001 From: Gustavo Carreno Date: Mon, 25 Sep 2023 14:57:26 +0100 Subject: [PATCH] feat: Many improvements CI/CD: - Cleaning the old `history.md` and `release-notes.md` in favour of `CHANGELOG.md` with `git cliff`. Documentation: - Started the `fpdoc` `XML` file. Dispatcher: - Added the message list and the message list thread processor. - Added the `Run(WaitFor)` method Module: - Added the message list and the message list thread processor. ThreadProcessMessages: - Created the class --- .github/workflows/build.yml | 2 +- ...ykerma.threading.threadprocessmessages.xml | 10 ++ examples/CLI/polykermacli.lpi | 45 +++++---- examples/CLI/polykermacli.lpr | 8 +- ...erma.dispatching.dispatcher.interfaces.pas | 29 ++++++ .../polykerma.dispatching.dispatcher.pas | 23 ++++- ...ykerma.dispatching.message.interfaces.pas} | 13 +-- src/logging/polykerma.logging.logger.pas | 1 + src/modules/polykerma.modules.interfaces.pas | 5 +- src/modules/polykerma.modules.module.pas | 37 +++++++- .../polykerma.threading.interfaces.pas | 8 +- ...ykerma.threading.threadprocessmessages.pas | 91 +++++++++++++++++++ 12 files changed, 235 insertions(+), 37 deletions(-) create mode 100644 docs/polykerma.threading.threadprocessmessages.xml create mode 100644 src/dispatching/polykerma.dispatching.dispatcher.interfaces.pas rename src/dispatching/{polykerma.dispatching.interfaces.pas => polykerma.dispatching.message.interfaces.pas} (56%) create mode 100644 src/threading/polykerma.threading.threadprocessmessages.pas diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 0da6a98..b07373f 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -4,7 +4,7 @@ on: push: branches: [ main ] tags: [ "*" ] - paths-ignore: [ "README.md", "history.md", "release-notes.md" ] + paths-ignore: [ "README.md", "CHANGELOG.md" ] pull_request: branches: [ main ] diff --git a/docs/polykerma.threading.threadprocessmessages.xml b/docs/polykerma.threading.threadprocessmessages.xml new file mode 100644 index 0000000..83c6a1e --- /dev/null +++ b/docs/polykerma.threading.threadprocessmessages.xml @@ -0,0 +1,10 @@ + + + + + + Event procedure to call the Dispatcher or Module ProcessMessages member. + + + + diff --git a/examples/CLI/polykermacli.lpi b/examples/CLI/polykermacli.lpi index fb573ac..86979b3 100644 --- a/examples/CLI/polykermacli.lpi +++ b/examples/CLI/polykermacli.lpi @@ -15,6 +15,7 @@ + @@ -102,41 +103,41 @@ - + - + - + - + - + - + - + - + - + - + - + - + - + @@ -146,21 +147,33 @@ + + - + - + + + + + + + + + + + - + diff --git a/examples/CLI/polykermacli.lpr b/examples/CLI/polykermacli.lpr index 5259c45..bcd561b 100644 --- a/examples/CLI/polykermacli.lpr +++ b/examples/CLI/polykermacli.lpr @@ -24,7 +24,7 @@ , PolyKerma.Logging // Dispatching -, PolyKerma.Dispatching.Interfaces +, PolyKerma.Dispatching.Dispatcher.Interfaces , PolyKerma.Dispatching.Dispatcher // Modules @@ -71,7 +71,7 @@ procedure TPolyKermaCLI.LoadParams; ErrorOptions:= CheckOptions('h', 'help'); if ErrorOptions <> '' then begin Debug({$I %FILE%}, {$I %LINE%}, ErrorOptions); - Terminate; + Terminate(1); Exit; end; @@ -99,7 +99,7 @@ procedure TPolyKermaCLI.PolyKermaTearDown; procedure TPolyKermaCLI.WriteHelp; begin { add your help code here } - WriteLn('Usage: polykerma [-h|--help]'); + WriteLn('Usage: polykermacli [-h|--help]'); end; procedure TPolyKermaCLI.DoRun; @@ -108,6 +108,8 @@ procedure TPolyKermaCLI.DoRun; PolyKermaSetup; + FDispatcher.Run(True); + // stop program loop Terminate; end; diff --git a/src/dispatching/polykerma.dispatching.dispatcher.interfaces.pas b/src/dispatching/polykerma.dispatching.dispatcher.interfaces.pas new file mode 100644 index 0000000..84fad29 --- /dev/null +++ b/src/dispatching/polykerma.dispatching.dispatcher.interfaces.pas @@ -0,0 +1,29 @@ +unit PolyKerma.Dispatching.Dispatcher.Interfaces; + +{$mode objfpc}{$H+} + +interface + +uses +{$IFDEF FPC_DOTTEDUNITS} + System.Classes +{$ELSE FPC_DOTTEDUNITS} + Classes +{$ENDIF FPC_DOTTEDUNITS} +, PolyKerma.Dispatching.Message.Interfaces +, PolyKerma.Modules.Interfaces +; + +type +{ IDispatcher } + IDispatcher = Interface + ['{1CD54522-D37B-486E-9181-A97CCF768DE9}'] + procedure Post(const AMessage: IMessage); + procedure ProcessMessage(const AMessage: IMessage); + function Register(const AChannel: String; const AModule: IModule): Boolean; + procedure Run(const WaitFor: Boolean); + end; + +implementation + +end. diff --git a/src/dispatching/polykerma.dispatching.dispatcher.pas b/src/dispatching/polykerma.dispatching.dispatcher.pas index 71f1401..f8fadb5 100644 --- a/src/dispatching/polykerma.dispatching.dispatcher.pas +++ b/src/dispatching/polykerma.dispatching.dispatcher.pas @@ -14,9 +14,11 @@ interface {$ENDIF FPC_DOTTEDUNITS} //, contnrs , PolyKerma.Logging -, PolyKerma.Dispatching.Interfaces -//, PolyKerma.Dispatching +, PolyKerma.Dispatching.Dispatcher.Interfaces +, PolyKerma.Dispatching.Message.Interfaces , PolyKerma.Modules.Interfaces +, PolyKerma.Threading.Interfaces +, PolyKerma.Threading.ThreadProcessMessages ; type @@ -24,6 +26,7 @@ interface TInterfacedDispatcher = class(TInterfacedObject, IDispatcher) private FMessageList: IInterfaceList; + FThreadProcessMessages: IThreadProcessMessages; procedure ProcessMessage(const AMessage: IMessage); protected @@ -31,8 +34,9 @@ TInterfacedDispatcher = class(TInterfacedObject, IDispatcher) constructor Create; destructor Destroy; override; - function Register(const AChannel: String; const AModule: IModule): Boolean; procedure Post(const AMessage: IMessage); + function Register(const AChannel: String; const AModule: IModule): Boolean; + procedure Run(const WaitFor: Boolean); published end; TInterfacedDispatcherClass = class of TInterfacedDispatcher; @@ -45,11 +49,18 @@ constructor TInterfacedDispatcher.Create; begin Debug({$I %FILE%}, {$I %LINE%}, 'Dispatcher Create'); FMessageList:= TInterfaceList.Create; + FThreadProcessMessages:= TInterfacedThreadProcessingMessages.Create( + @ProcessMessage, + FMessageList, + False + ); end; destructor TInterfacedDispatcher.Destroy; begin Debug({$I %FILE%}, {$I %LINE%}, 'Dispatcher Destroy'); + FThreadProcessMessages.Terminate; + FThreadProcessMessages.WaitFor; inherited Destroy; end; @@ -68,6 +79,12 @@ function TInterfacedDispatcher.Register(const AChannel: String; Result:= false; end; +procedure TInterfacedDispatcher.Run(const WaitFor: Boolean); +begin + Debug({$I %FILE%}, {$I %LINE%}, 'Dispatcher Run'); + if WaitFor then FThreadProcessMessages.WaitFor; +end; + procedure TInterfacedDispatcher.Post(const AMessage: IMessage); begin Debug({$I %FILE%}, {$I %LINE%}, Format('Dispatcher Post: %s', [ diff --git a/src/dispatching/polykerma.dispatching.interfaces.pas b/src/dispatching/polykerma.dispatching.message.interfaces.pas similarity index 56% rename from src/dispatching/polykerma.dispatching.interfaces.pas rename to src/dispatching/polykerma.dispatching.message.interfaces.pas index 59993b7..d81cd81 100644 --- a/src/dispatching/polykerma.dispatching.interfaces.pas +++ b/src/dispatching/polykerma.dispatching.message.interfaces.pas @@ -1,6 +1,6 @@ -unit PolyKerma.Dispatching.Interfaces; +unit PolyKerma.Dispatching.Message.Interfaces; -{$mode objfpc}{$H+} +{$mode ObjFPC}{$H+} interface @@ -10,7 +10,6 @@ interface {$ELSE FPC_DOTTEDUNITS} Classes {$ENDIF FPC_DOTTEDUNITS} -, PolyKerma.Modules.Interfaces ; type @@ -29,14 +28,8 @@ interface write SetPayload; end; -{ IDispatcher } - IDispatcher = Interface - ['{1CD54522-D37B-486E-9181-A97CCF768DE9}'] - function Register(const AChannel: String; const AModule: IModule): Boolean; - procedure Post(const AMessage: IMessage); - procedure ProcessMessage(const AMessage: IMessage); - end; implementation end. + diff --git a/src/logging/polykerma.logging.logger.pas b/src/logging/polykerma.logging.logger.pas index 80ffbe4..8a04987 100644 --- a/src/logging/polykerma.logging.logger.pas +++ b/src/logging/polykerma.logging.logger.pas @@ -26,6 +26,7 @@ TInterfacedLogger = class(TInterfacedObject, ILogger) procedure Log(const ALogType: TLogType; const AMessage: String); published end; + TInterfacedLoggerClass = class of TInterfacedLogger; implementation diff --git a/src/modules/polykerma.modules.interfaces.pas b/src/modules/polykerma.modules.interfaces.pas index cd77a1d..978cb22 100644 --- a/src/modules/polykerma.modules.interfaces.pas +++ b/src/modules/polykerma.modules.interfaces.pas @@ -10,14 +10,15 @@ interface {$ELSE FPC_DOTTEDUNITS} Classes {$ENDIF FPC_DOTTEDUNITS} -//, PolyKerma.Dispatching.Interfaces +, PolyKerma.Dispatching.Message.Interfaces ; type { IModule } IModule = Interface ['{3D802B56-58A0-4E9C-97D9-8602B52EF731}'] -// procedure Receive(const AMessage: IMessage); + procedure ProcessMessage(const AMessage: IMessage); + procedure Receive(const AMessage: IMessage); end; implementation diff --git a/src/modules/polykerma.modules.module.pas b/src/modules/polykerma.modules.module.pas index 5ed6820..9294430 100644 --- a/src/modules/polykerma.modules.module.pas +++ b/src/modules/polykerma.modules.module.pas @@ -7,13 +7,18 @@ interface uses {$IFDEF FPC_DOTTEDUNITS} System.Classes +, System.SysUtils {$ELSE FPC_DOTTEDUNITS} Classes +, SysUtils {$ENDIF FPC_DOTTEDUNITS} , PolyKerma.Logging , PolyKerma.Dispatching -, PolyKerma.Dispatching.Interfaces +, PolyKerma.Dispatching.Dispatcher.Interfaces +, PolyKerma.Dispatching.Message.Interfaces , PolyKerma.Modules.Interfaces +, PolyKerma.Threading.Interfaces +, PolyKerma.Threading.ThreadProcessMessages ; type @@ -21,6 +26,11 @@ interface TInterfacedModule = class(TInterfacedObject, IModule) private FDispatcher: IDispatcher; + FMessageList: IInterfaceList; + FThreadProcessMessages: IThreadProcessMessages; + + procedure ProcessMessage(const AMessage: IMessage); + procedure Receive(const AMessage: IMessage); protected public constructor Create(const ADispatcher: IDispatcher); @@ -38,15 +48,40 @@ constructor TInterfacedModule.Create(const ADispatcher: IDispatcher); begin Debug({$I %FILE%}, {$I %LINE%}, 'Module Create'); FDispatcher:= ADispatcher; + FMessageList:= TInterfaceList.Create; + FThreadProcessMessages:= TInterfacedThreadProcessingMessages.Create( + @ProcessMessage, + FMessageList, + False + ); + // Register FDispatcher.Register(cChannelModuleIn, Self); end; destructor TInterfacedModule.Destroy; begin Debug({$I %FILE%}, {$I %LINE%}, 'Module Destroy'); + FThreadProcessMessages.Terminate; + FThreadProcessMessages.WaitFor; inherited Destroy; end; +procedure TInterfacedModule.ProcessMessage(const AMessage: IMessage); +begin + Debug({$I %FILE%}, {$I %LINE%}, Format('Module Process Message: %s', [ + AMessage.Channel + ])); + // +end; + +procedure TInterfacedModule.Receive(const AMessage: IMessage); +begin + Debug({$I %FILE%}, {$I %LINE%}, Format('Module Receive Message: %s', [ + AMessage.Channel + ])); + FMessageList.Add(AMessage); +end; + end. diff --git a/src/threading/polykerma.threading.interfaces.pas b/src/threading/polykerma.threading.interfaces.pas index f46dd9a..5c7a26f 100644 --- a/src/threading/polykerma.threading.interfaces.pas +++ b/src/threading/polykerma.threading.interfaces.pas @@ -15,7 +15,7 @@ interface type { IThread } IThread = interface - ['{5D340B25-31E7-40C3-A5AB-8AFE68AA31C0}'] + ['{EAA30789-6A3B-47FB-B6D7-20338C8E5F89}'] procedure Start; procedure Resume; @@ -24,6 +24,12 @@ interface end; +{ IThreadProcessMessages } + IThreadProcessMessages = interface(IThread) + ['{4F58FD48-C5DA-4DC4-960F-A9FEA4591C79}'] + + end; + implementation end. diff --git a/src/threading/polykerma.threading.threadprocessmessages.pas b/src/threading/polykerma.threading.threadprocessmessages.pas new file mode 100644 index 0000000..5affe48 --- /dev/null +++ b/src/threading/polykerma.threading.threadprocessmessages.pas @@ -0,0 +1,91 @@ +unit PolyKerma.Threading.ThreadProcessMessages; + +{$mode ObjFPC}{$H+} + +interface + +uses +{$IFDEF FPC_DOTTEDUNITS} + System.Classes +{$ELSE FPC_DOTTEDUNITS} + Classes +{$ENDIF FPC_DOTTEDUNITS} +, PolyKerma.Logging +, PolyKerma.Dispatching.Message.Interfaces +, PolyKerma.Threading.Interfaces +, PolyKerma.Threading.Thread +; + +type +{ TProcedureProcessMessages } + TProcedureProcessMessages = procedure (const AMessage: IMessage) of object; + +{ TInterfacedThreadProcessingMessages } + TInterfacedThreadProcessingMessages = class( + TInterfacedThread, + IThreadProcessMessages + ) + private + FProcedureProcessMessages: TProcedureProcessMessages; + FMessageList: IInterfaceList; + protected + procedure Execute; override; + public + constructor Create( + const AProcedureProcessMessages: TProcedureProcessMessages; + const AMessageList: IInterfaceList; + const CreateSuspended: Boolean + ); + destructor Destroy; override; + published + end; + TInterfacedThreadProcessingMessagesClass = + class of TInterfacedThreadProcessingMessages; + +implementation + +{ TInterfacedThreadProcessingMessages } + +constructor TInterfacedThreadProcessingMessages.Create( + const AProcedureProcessMessages: TProcedureProcessMessages; + const AMessageList: IInterfaceList; + const CreateSuspended: Boolean +); +begin + Debug({$I %FILE%}, {$I %LINE%}, 'Thread Process Messages Create'); + FProcedureProcessMessages:= AProcedureProcessMessages; + FMessageList:= AMessageList; + inherited Create(CreateSuspended); +end; + +destructor TInterfacedThreadProcessingMessages.Destroy; +begin + Debug({$I %FILE%}, {$I %LINE%}, 'Thread Process Messages Destroy'); + inherited Destroy; +end; + +procedure TInterfacedThreadProcessingMessages.Execute; +var + message: IMessage; +begin + Debug({$I %FILE%}, {$I %LINE%}, 'Thread Process Messages Execute'); + while not Terminated do + begin + FMessageList.Lock; + try + if FMessageList.Count > 0 then + begin + message:= FMessageList[0] as IMessage; + FProcedureProcessMessages(message); + message:= nil; + FMessageList.Delete(0); + end; + Sleep(1); + finally + FMessageList.Unlock; + end; + end; +end; + +end. +