Common.Logging.pas

unit Common.Logging;

interface

uses
  System.Classes,
  System.SysUtils;

type
  // Type de messages
  TTypeMessage = ( trInformation, trAvertissement, trErreur, trTrace );
  TModesExecution = ( meCiCd, meCli );

  // Class représentant un log
  TLog = class
  private
    FTexteMessage: string;
    FTypeMessage: TTypeMessage;
    FDateMessage: TDateTime;

    procedure SetTexteMessage( const Value: string );
    procedure SetTypeMessage( const Value: TTypeMessage );
    procedure SetDateMessage( const Value: TDateTime );
  public
    property DateMessage: TDateTime read FDateMessage write SetDateMessage;
    property TypeMessage: TTypeMessage read FTypeMessage write SetTypeMessage;
    property TexteMessage: string read FTexteMessage write SetTexteMessage;
  end;

  // Objet Thread pour vider le cache dans le fichier logs
  TThreadLog = class( TThread )
  private
    FListe: TThreadList;
    FInternalListe: TList;
    FFileName: string;
  protected
    procedure FlushLog;
    procedure Execute; override;
  public
    constructor Create( aListe: TThreadList; const aFileName: string );
    destructor Destroy; override;
  end;

  // Objet singleton permettant de logguer les messages applicatifs
  TTrace = class
  private
    FActive: Boolean;
    FFileName: string;
    FFolderName: string;
    FApplicationName: string;
    FLogLevel: TTypeMessage;
    FListeMsg: TThreadList;
    FThread: TThreadLog;
    FModeExecution: TModesExecution;

    class var FInstanceTrace: TTrace;

    procedure SetLogLevel( const Value: TTypeMessage );
    procedure SetModeExecution( const Value: TModesExecution );
  public
    constructor Create;
    destructor Destroy; override;
    class destructor DestroyClass;

    procedure AddTrace( aTpMessage: TTypeMessage; const aMessage: string );
    procedure StartTrace;
    procedure StopTrace;

    class function CreateTrace( const aFolder, aApplication: string; const aFileName: string = '' ): TTrace;
    class function GetInstanceTrace: TTrace;

    property Active: Boolean read FActive;
    property FolderName: string read FFolderName;
    property ApplicationName: string read FApplicationName;
    property FileName: string read FFileName;
    property LogLevel: TTypeMessage read FLogLevel write SetLogLevel;
    property ModeExecution: TModesExecution read FModeExecution write SetModeExecution;
  end;

procedure AddTrace( aTpMessage: TTypeMessage; const aMessage: string );
procedure StartGroupLog( aGroupeName: string );
procedure EndGroupLog( aGroupeName: string );
procedure InitializeTrace( aLogLevel: TTypeMessage; const aFolder, aApplication: string; const aFileName: string = '';
  aModeExecution: TModesExecution = meCli );
procedure StopTrace;

implementation

uses
  System.IOUtils;

procedure StartGroupLog( aGroupeName: string );
var
  wTrace: TTrace;
begin
  wTrace := TTrace.GetInstanceTrace;
  wTrace.AddTrace( trInformation, '------------------- ' + aGroupeName + ' -------------------' );

  if ( wTrace.ModeExecution = meCiCd ) then
  begin
    writeln( '::group::' + aGroupeName );
  end;
end;

procedure EndGroupLog( aGroupeName: string );
var
  wTrace: TTrace;
begin
  wTrace := TTrace.GetInstanceTrace;
  wTrace.AddTrace( trInformation, StringOfChar( '-', length( '------------------- ' + aGroupeName + ' -------------------' ) ) );

  if ( wTrace.ModeExecution = meCiCd ) then
  begin
    writeln( '::endgroup::' );
  end;
end;

{ -------------------------------------------------------------------------------
  Procedure: AddTrace
  Permet d"ajouter un message dans le log
  Author:    Dany
  DateTime:  2012.11.27
  Arguments: aTpMessage:TTypeMessage; const aMessage:string
  Result:    None
  ------------------------------------------------------------------------------- }
procedure AddTrace( aTpMessage: TTypeMessage; const aMessage: string );
var
  wTrace: TTrace;
begin
  wTrace := TTrace.GetInstanceTrace;
  wTrace.AddTrace( aTpMessage, aMessage );
end;

{ -------------------------------------------------------------------------------
  Procedure: InitializeTrace
  procédure d'initialisation du système de log
  Author:    Dany
  DateTime:  2012.11.27
  Arguments: aLogLevel:TTypeMessage; Niveu de gravité du message à partir duquel il est effectivemenbt tracé
  const aFolder: string; Répertoire dans lequel est stocké le fichier logs
  const aApplication: String; Nom de l'application (sera le nom du dossier contenant les fichiers logs pour cette application
  const aFileName: String = ''; permet de forcer le nom du fichier log
  Result:    None
  ------------------------------------------------------------------------------- }
procedure InitializeTrace( aLogLevel: TTypeMessage; const aFolder, aApplication
  : string; const aFileName: string = '';
  aModeExecution: TModesExecution = meCli );
begin
  TTrace.FInstanceTrace := TTrace.CreateTrace( aFolder, aApplication, aFileName );
  TTrace.FInstanceTrace.LogLevel := aLogLevel;
  TTrace.FInstanceTrace.ModeExecution := aModeExecution;
  TTrace.FInstanceTrace.StartTrace;
end;

{ -------------------------------------------------------------------------------
  Procedure: StopTrace
  Arrête la trace
  Author:    Dany
  DateTime:  2012.11.27
  Arguments: None
  Result:    None
  ------------------------------------------------------------------------------- }
procedure StopTrace;
var
  wTrace: TTrace;
begin
  wTrace := TTrace.GetInstanceTrace;
  wTrace.StopTrace;
end;

{ TLog }

procedure TLog.SetDateMessage( const Value: TDateTime );
begin
  FDateMessage := Value;
end;

procedure TLog.SetTexteMessage( const Value: string );
begin
  FTexteMessage := Value;
end;

procedure TLog.SetTypeMessage( const Value: TTypeMessage );
begin
  FTypeMessage := Value;
end;

{ TThreadLog }

constructor TThreadLog.Create( aListe: TThreadList; const aFileName: string );
begin
  inherited Create( True );

  FListe := aListe;
  FFileName := aFileName;

  FInternalListe := TList.Create;
end;

destructor TThreadLog.Destroy;
begin
  FlushLog;
  FInternalListe.Free;
  FListe.Free;

  inherited;
end;

{ -------------------------------------------------------------------------------
  Procedure: TThreadLog.Execute
  Execute FlushLog toute les 5 secondes
  Author:    Dany
  DateTime:  2012.11.27
  Arguments: None
  Result:    None
  ------------------------------------------------------------------------------- }
procedure TThreadLog.Execute;
begin
  inherited;

  while not ( Terminated ) do
  begin
    FlushLog;

    Sleep( 5000 );
  end;
end;

{ -------------------------------------------------------------------------------
  Procedure: TThreadLog.FlushLog
  Recopie le cache dans le fichier log
  Author:    Dany
  DateTime:  2012.11.27
  Arguments: None
  Result:    None
  ------------------------------------------------------------------------------- }
procedure TThreadLog.FlushLog;
var
  wListe: TList;
  wLog: TLog;
  //  wFile: TextFile;
  LFile: TStreamWriter;
  wLine: string;
  i: Integer;
begin
  // On recopie la liste protégée dans la liste locale
  // pour pénaliser le moins possible le traitement
  wListe := FListe.LockList;
  try
    for i := 0 to wListe.Count - 1 do
    begin
      wLog := TLog( wListe[ i ] );

      FInternalListe.Add( wLog );
    end;

    wListe.Clear;
  finally
    FListe.UnlockList;
  end;

  // Maintenant on écrit tranquillement dans le fichier log
//  AssignFile( wFile, FFileName );
//  if FileExists( FFileName ) then
//    Append( wFile )
//  else
//    Rewrite( wFile );

  LFile := TStreamWriter.Create( FFileName, not ( FileExists( FFileName ) ), TEncoding.UTF8 );

  try
    for i := 0 to FInternalListe.Count - 1 do
    begin
      wLog := TLog( FInternalListe[ i ] );

      wLine := FormatDateTime( 'dd/mm/yyyy hh:nn:ss', wLog.DateMessage ) + ' ';

      case wLog.TypeMessage of
        trInformation:
          wLine := wLine + 'Information ';
        trAvertissement:
          wLine := wLine + 'Avertissement ';
        trErreur:
          wLine := wLine + 'Erreur ';
        trTrace:
          wLine := wLine + 'Trace ';
      end;

      wLine := wLine + wLog.TexteMessage;

      LFile.WriteLine( wLine );

      wLog.Free;
    end;

    FInternalListe.Clear;
  finally
    FreeAndNil( LFile );
  end;
end;

{ TTrace }

{ -------------------------------------------------------------------------------
  Procedure: TTrace.AddTrace
  Ajoute un message à la trace
  Author:    Dany
  DateTime:  2012.11.27
  Arguments: aTpMessage: TTypeMessage; const aMessage: string
  Result:    None
  ------------------------------------------------------------------------------- }
procedure TTrace.AddTrace( aTpMessage: TTypeMessage; const aMessage: string );
var
  wLog: TLog;
begin
  if FActive and ( aTpMessage >= FLogLevel ) then
  begin
    wLog := TLog.Create;
    wLog.DateMessage := Now;
    wLog.TypeMessage := aTpMessage;
    wLog.TexteMessage := aMessage;

    FListeMsg.Add( wLog );

    if ( FModeExecution = meCiCd ) then
    begin
      case aTpMessage of
        trInformation, trTrace:
          begin
            Writeln( '::notice::' + aMessage );
          end;
        trAvertissement:
          begin
            Writeln( '::warning::' + aMessage );
          end;
        trErreur:
          begin
            Writeln( '::error::' + aMessage );
          end;
      end;
    end;
  end;
end;

constructor TTrace.Create;
begin
  inherited Create;

  FListeMsg := nil;
  FThread := nil;
end;

{ -------------------------------------------------------------------------------
  Procedure: TTrace.CreateTrace
  Création de l'instance de la trace
  Author:    Dany
  DateTime:  2012.11.27
  Arguments: const aFolder, aApplication, aFileName: String
  Result:    TTrace
  ------------------------------------------------------------------------------- }
class function TTrace.CreateTrace( const aFolder, aApplication,
  aFileName: string ): TTrace;
begin
  Result := TTrace.Create;
  Result.FFolderName := IncludeTrailingPathDelimiter( aFolder );
  Result.FApplicationName := aApplication;
  Result.FFileName := aFileName;

  if Result.FFileName = '' then
    Result.FFileName := 'Log-' + FormatDateTime( 'yyyymmdd', Now ) + '.log';

  if not ( ForceDirectories( TPath.Combine( Result.FolderName, Result.ApplicationName ) ) ) then
  begin
    raise Exception.Create( 'ERR_CREATIONDIR_FAILED' );
  end;

  Result.LogLevel := trErreur;
end;

destructor TTrace.Destroy;
begin
  if FActive then
    FThread.Terminate;

  FThread.Free;

  inherited;
end;

class destructor TTrace.DestroyClass;
begin
  if Assigned( TTrace.FInstanceTrace ) then
    TTrace.FInstanceTrace.Free;
end;

{ -------------------------------------------------------------------------------
  Procedure: TTrace.GetInstanceTrace
  Fournit l'instance de l'objet singleton TTrace
  Author:    Dany
  DateTime:  2012.11.27
  Arguments: None
  Result:    TTrace
  ------------------------------------------------------------------------------- }
class function TTrace.GetInstanceTrace: TTrace;
begin
  if not ( Assigned( FInstanceTrace ) ) then
  begin
    FInstanceTrace := TTrace.Create;
  end;

  Result := FInstanceTrace;
end;

procedure TTrace.SetLogLevel( const Value: TTypeMessage );
begin
  FLogLevel := Value;
end;

procedure TTrace.SetModeExecution( const Value: TModesExecution );
begin
  FModeExecution := Value;
end;

{ -------------------------------------------------------------------------------
  Procedure: TTrace.StartTrace
  Démarrage du thread qui va régulièrement stocker le cache dans le
  fichier log
  Author:    Dany
  DateTime:  2012.11.27
  Arguments: None
  Result:    None
  ------------------------------------------------------------------------------- }
procedure TTrace.StartTrace;
begin
  if not ( FActive ) then
  begin
    FListeMsg := TThreadList.Create;

    FThread := TThreadLog.Create( FListeMsg, IncludeTrailingPathDelimiter( FFolderName ) + IncludeTrailingPathDelimiter(
        ApplicationName ) + FFileName );
    FThread.FreeOnTerminate := False;
    // FThread.Priority := tpNormal;
    FThread.Start;

    FActive := True;
  end;
end;

{ -------------------------------------------------------------------------------
  Procedure: TTrace.StopTrace
  Arrêt de la trace
  Author:    Dany
  DateTime:  2012.11.27
  Arguments: None
  Result:    None
  ------------------------------------------------------------------------------- }
procedure TTrace.StopTrace;
begin
  if not ( FActive ) then
  begin
    FThread.Terminate;

    FActive := False;
  end;
end;

end.