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
gcarreno · Sep 25, 2023 · 6af372e · 6af372e
1 parent d90243e
commit 6af372e
Show file tree

Hide file tree

Showing 12 changed files with 235 additions and 37 deletions.
diff --git 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
@@ -0,0 +1,10 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<fpdoc-descriptions>
+  <package name="PolyKerma">
+    <module name="PolyKerma.Threading.ThreadProcessMessages">
+      <element name="TProcedureProcessMessages">
+        <short>Event procedure to call the Dispatcher or Module ProcessMessages member.</short>
+      </element>
+    </module>
+  </package>
+</fpdoc-descriptions>
diff --git a/examples/CLI/polykermacli.lpi b/examples/CLI/polykermacli.lpi
@@ -15,6 +15,7 @@
       <UseAppBundle Value="False"/>
       <ResourceType Value="res"/>
     </General>
+    <LazDoc Paths="../../docs"/>
     <BuildModes Count="3">
       <Item1 Name="Default" Default="True"/>
       <Item2 Name="Debug">
@@ -102,41 +103,41 @@
     <RunParams>
       <FormatVersion Value="2"/>
     </RunParams>
-    <Units Count="12">
+    <Units Count="14">
       <Unit0>
         <Filename Value="polykermacli.lpr"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="PolyKermaCLI"/>
       </Unit0>
       <Unit1>
-        <Filename Value="../../src/logging/polykerma.logging.pas"/>
+        <Filename Value="../../src/dispatching/polykerma.dispatching.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="PolyKerma.Logging"/>
+        <UnitName Value="PolyKerma.Dispatching"/>
       </Unit1>
       <Unit2>
-        <Filename Value="../../src/dispatching/polykerma.dispatching.pas"/>
+        <Filename Value="../../src/dispatching/polykerma.dispatching.dispatcher.interfaces.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="PolyKerma.Dispatching"/>
+        <UnitName Value="PolyKerma.Dispatching.Dispatcher.Interfaces"/>
       </Unit2>
       <Unit3>
-        <Filename Value="../../src/dispatching/polykerma.dispatching.interfaces.pas"/>
+        <Filename Value="../../src/dispatching/polykerma.dispatching.dispatcher.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="PolyKerma.Dispatching.Interfaces"/>
+        <UnitName Value="PolyKerma.Dispatching.Dispatcher"/>
       </Unit3>
       <Unit4>
-        <Filename Value="../../src/dispatching/polykerma.dispatching.dispatcher.pas"/>
+        <Filename Value="../../src/modules/polykerma.modules.interfaces.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="PolyKerma.Dispatching.Dispatcher"/>
+        <UnitName Value="PolyKerma.Modules.Interfaces"/>
       </Unit4>
       <Unit5>
-        <Filename Value="../../src/modules/polykerma.modules.interfaces.pas"/>
+        <Filename Value="../../src/modules/polykerma.modules.module.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="PolyKerma.Modules.Interfaces"/>
+        <UnitName Value="PolyKerma.Modules.Module"/>
       </Unit5>
       <Unit6>
-        <Filename Value="../../src/modules/polykerma.modules.module.pas"/>
+        <Filename Value="../../src/dispatching/polykerma.dispatching.message.interfaces.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="PolyKerma.Modules.Module"/>
+        <UnitName Value="PolyKerma.Dispatching.Message.Interfaces"/>
       </Unit6>
       <Unit7>
         <Filename Value="../../src/dispatching/polykerma.dispatching.message.pas"/>
@@ -146,21 +147,33 @@
       <Unit8>
         <Filename Value="../../src/threading/polykerma.threading.interfaces.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="PolyKerma.Threading.Interfaces"/>
       </Unit8>
       <Unit9>
         <Filename Value="../../src/threading/polykerma.threading.thread.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="PolyKerma.Threading.Thread"/>
       </Unit9>
       <Unit10>
-        <Filename Value="../../src/logging/polykerma.logging.interfaces.pas"/>
+        <Filename Value="../../src/threading/polykerma.threading.threadprocessmessages.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="PolyKerma.Logging.Interfaces"/>
+        <UnitName Value="PolyKerma.Threading.ThreadProcessMessages"/>
       </Unit10>
       <Unit11>
+        <Filename Value="../../src/logging/polykerma.logging.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="PolyKerma.Logging"/>
+      </Unit11>
+      <Unit12>
+        <Filename Value="../../src/logging/polykerma.logging.interfaces.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="PolyKerma.Logging.Interfaces"/>
+      </Unit12>
+      <Unit13>
         <Filename Value="../../src/logging/polykerma.logging.logger.pas"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="PolyKerma.Logging.Logger"/>
-      </Unit11>
+      </Unit13>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

diff --git 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
@@ -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
@@ -14,25 +14,29 @@ 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
 { TInterfacedDispatcher }
   TInterfacedDispatcher = class(TInterfacedObject, IDispatcher)
   private
     FMessageList: IInterfaceList;
+    FThreadProcessMessages: IThreadProcessMessages;
 
     procedure ProcessMessage(const AMessage: IMessage);
   protected
   public
     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/...hing/polykerma.dispatching.interfaces.pas → ...ykerma.dispatching.message.interfaces.pas b/...hing/polykerma.dispatching.interfaces.pas → ...ykerma.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
@@ -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
@@ -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
@@ -7,20 +7,30 @@ 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
 { TInterfacedModule }
   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.