From 95473d69a7b2a2cf10f22957d9468ff0d6fe117e Mon Sep 17 00:00:00 2001
From: svenbarth <svenbarth@3ad0048d-3df7-0310-abae-a5850022a9f2>
Date: Mon, 1 Feb 2021 18:12:20 +0000
Subject: Merged revision(s) 48458-48459 from trunk: + add support for logging
 to StdOut or StdErr instead of a file or system output; if the specified
 output is not opened an exception will be thrown ........ + add event to
 retrieve the logged messages in addition to writing them to the backend
 ........

git-svn-id: https://svn.freepascal.org/svn/fpc/branches/fixes_3_2@48493 3ad0048d-3df7-0310-abae-a5850022a9f2
---
 packages/fcl-base/src/eventlog.pp | 64 ++++++++++++++++++++++++++++++++++++---
 1 file changed, 59 insertions(+), 5 deletions(-)

diff --git a/packages/fcl-base/src/eventlog.pp b/packages/fcl-base/src/eventlog.pp
index a72bbd1f93..24492b54ea 100644
--- a/packages/fcl-base/src/eventlog.pp
+++ b/packages/fcl-base/src/eventlog.pp
@@ -23,9 +23,10 @@ uses SysUtils,Classes;
 
 Type
   TEventLog = Class;
-  TLogType = (ltSystem,ltFile);
+  TLogType = (ltSystem,ltFile,ltStdOut,ltStdErr);
   TLogCodeEvent = Procedure (Sender : TObject; Var Code : DWord) of Object;
   TLogCategoryEvent = Procedure (Sender : TObject; Var Code : Word) of Object;
+  TLogMessageEvent = Procedure (Sender : TObject; EventType : TEventType; Const Msg : String) of Object;
 
   TEventLog = Class(TComponent)
   Private
@@ -44,6 +45,7 @@ Type
     FOnGetCustomCategory : TLogCategoryEvent;
     FOnGetCustomEventID : TLogCodeEvent;
     FOnGetCustomEvent : TLogCodeEvent;
+    FOnLogMessage: TLogMessageEvent;
     FPaused : Boolean;
     procedure SetActive(const Value: Boolean);
     procedure SetIdentification(const Value: String);
@@ -52,16 +54,20 @@ Type
     procedure DeActivateLog;
     procedure ActivateFileLog;
     procedure SetFileName(const Value: String);
+    procedure ActivateIOLog;
     procedure ActivateSystemLog;
     function DefaultFileName: String;
+    function FormatLogMessage(EventType : TEventType; const Msg: String): String;
     procedure WriteFileLog(EventType : TEventType; const Msg: String);
     procedure WriteSystemLog(EventType: TEventType; const Msg: String);
+    procedure WriteIOLog(EventType: TEventType; const Msg: String; var OutFile: TextFile);
     procedure DeActivateFileLog;
     procedure DeActivateSystemLog;
     procedure CheckIdentification;
     Procedure DoGetCustomEventID(Var Code : DWord);
     Procedure DoGetCustomEventCategory(Var Code : Word);
     Procedure DoGetCustomEvent(Var Code : DWord);
+    Procedure DoLogMessage(EventType : TEventType; const Msg: String);
   Protected
     Procedure CheckInactive;
     Procedure EnsureActive;
@@ -101,6 +107,7 @@ Type
     Property OnGetCustomCategory : TLogCategoryEvent Read FOnGetCustomCategory Write FOnGetCustomCategory;
     Property OnGetCustomEventID : TLogCodeEvent Read FOnGetCustomEventID Write FOnGetCustomEventID;
     Property OnGetCustomEvent : TLogCodeEvent Read FOnGetCustomEvent Write FOnGetCustomEvent;
+    Property OnLogMessage : TLogMessageEvent read FOnLogMessage write FOnLogMessage;
     Property Paused : Boolean Read FPaused Write FPaused;
   End;
 
@@ -114,6 +121,8 @@ Resourcestring
   SLogDebug     = 'Debug';
   SLogCustom    = 'Custom (%d)';
   SErrLogFailedMsg = 'Failed to log entry (Error: %s)';
+  SErrLogOpenStdOut = 'Standard Output not available for logging';
+  SErrLogOpenStdErr = 'Standard Error not available for logging';
 
 implementation
 
@@ -201,20 +210,31 @@ begin
   Case FlogType of
     ltFile   : WriteFileLog(EventType,Msg);
     ltSystem : WriteSystemLog(EventType,Msg);
+    ltStdOut : WriteIOLog(EventType,Msg,StdOut);
+    ltStdErr : WriteIOLog(EventType,Msg,StdErr);
   end;
+  DoLogMessage(EventType, Msg);
 end;
 
-procedure TEventLog.WriteFileLog(EventType : TEventType; const Msg : String);
-
+function TEventLog.FormatLogMessage(EventType : TEventType; const Msg: String): String;
 Var
-  S,TS,T : String;
+  TS,T : String;
 
 begin
   If FTimeStampFormat='' then
     FTimeStampFormat:='yyyy-mm-dd hh:nn:ss.zzz';
   TS:=FormatDateTime(FTimeStampFormat,Now);
   T:=EventTypeToString(EventType);
-  S:=Format('%s [%s %s] %s%s',[Identification,TS,T,Msg,LineEnding]);
+  Result:=Format('%s [%s %s] %s',[Identification,TS,T,Msg]);
+end;
+
+procedure TEventLog.WriteFileLog(EventType : TEventType; const Msg : String);
+
+Var
+  S : String;
+
+begin
+  S:=FormatLogMessage(EventType, Msg)+LineEnding;
   try
     FStream.WriteBuffer(S[1],Length(S));
     S:='';
@@ -226,6 +246,11 @@ begin
     Raise ELogError.CreateFmt(SErrLogFailedMsg,[S]);
 end;
 
+procedure TEventLog.WriteIOLog(EventType: TEventType; const Msg: String; var OutFile: TextFile);
+begin
+  Writeln(OutFile,FormatLogMessage(EventType,Msg));
+end;
+
 procedure TEventLog.Log(const Fmt: String; Args: array of const);
 begin
   Log(Format(Fmt,Args));
@@ -249,6 +274,8 @@ begin
   Case FLogType of
     ltFile : ActivateFileLog;
     ltSystem : ActivateSystemLog;
+    ltStdOut,
+    ltStdErr : ActivateIOLog;
   end;
 end;
 
@@ -258,6 +285,8 @@ begin
   Case FLogType of
     ltFile : DeActivateFileLog;
     ltSystem : DeActivateSystemLog;
+    { nothing to do here }
+    ltStdOut,ltStdErr : ;
   end;
 end;
 
@@ -279,6 +308,24 @@ begin
     FStream.Seek(0,soFromEnd);
 end;
 
+Procedure TEventLog.ActivateIOLog;
+
+var
+  errmsg: String;
+  m: LongInt;
+
+begin
+  if FLogtype = ltStdOut then begin
+    m := TextRec(StdOut).Mode;
+    errmsg := SErrLogOpenStdOut;
+  end else begin
+    m := TextRec(StdErr).Mode;
+    errmsg := SErrLogOpenStdErr;
+  end;
+  if (m <> fmOutput) and (m <> fmAppend) then
+    raise ELogError.Create(errmsg);
+end;
+
 Procedure TEventLog.DeActivateFileLog;
 
 begin
@@ -354,6 +401,13 @@ begin
     FOnGetCustomEvent(Self,Code);
 end;
 
+Procedure TEventLog.DoLogMessage(EventType : TEventType; const Msg: String);
+
+begin
+  If Assigned(FOnLogMessage) then
+    FOnLogMessage(Self,EventType,Msg);
+end;
+
 
 destructor TEventLog.Destroy;
 begin
-- 
cgit v1.2.1