Added: RollingLogFile Observer

Packages/X2LogDXE2.dpk

@@ -51,7 +51,8 @@ contains
   X2Log.Details.Registry in '..\X2Log.Details.Registry.pas',
   X2Log.Util.Stream in '..\X2Log.Util.Stream.pas',
   X2Log.Translations.Dutch in '..\X2Log.Translations.Dutch.pas',
-  X2Log.Decorator in '..\X2Log.Decorator.pas';
+  X2Log.Decorator in '..\X2Log.Decorator.pas',
+  X2Log.Observer.RollingLogFile in '..\X2Log.Observer.RollingLogFile.pas';
 
 end.
 

Packages/X2LogDXE2.dproj

@@ -108,6 +108,7 @@
 			<DCCReference Include="..\X2Log.Util.Stream.pas"/>
 			<DCCReference Include="..\X2Log.Translations.Dutch.pas"/>
 			<DCCReference Include="..\X2Log.Decorator.pas"/>
+			<DCCReference Include="..\X2Log.Observer.RollingLogFile.pas"/>
 			<BuildConfiguration Include="Base">
 				<Key>Base</Key>
 			</BuildConfiguration>

Test/X2LogTest.dpr

@@ -23,7 +23,8 @@ uses
   X2Log.Details.Registry in '..\X2Log.Details.Registry.pas',
   X2Log.Details.Intf in '..\X2Log.Details.Intf.pas',
   X2Log.Util.Stream in '..\X2Log.Util.Stream.pas',
-  X2Log.Decorator in '..\X2Log.Decorator.pas';
+  X2Log.Decorator in '..\X2Log.Decorator.pas',
+  X2Log.Observer.RollingLogFile in '..\X2Log.Observer.RollingLogFile.pas';
 
 {$R *.res}
 

Test/X2LogTest.dproj

@@ -195,6 +195,7 @@
 			<DCCReference Include="..\X2Log.Details.Intf.pas"/>
 			<DCCReference Include="..\X2Log.Util.Stream.pas"/>
 			<DCCReference Include="..\X2Log.Decorator.pas"/>
+			<DCCReference Include="..\X2Log.Observer.RollingLogFile.pas"/>
 			<RcItem Include="resources\Graphic.jpg">
 				<ResourceType>RCDATA</ResourceType>
 				<ResourceId>GraphicDetails</ResourceId>

Test/source/MainFrm.dfm

@@ -26,14 +26,12 @@ object MainForm: TMainForm
     Margins.Top = 8
     Margins.Right = 8
     Margins.Bottom = 8
-    ActivePage = tsNamedPipe
+    ActivePage = tsRollingFile
     Align = alClient
     Images = ilsObservers
     TabOrder = 0
-    ExplicitWidth = 595
     object tsEvent: TTabSheet
       Caption = 'Event'
-      ExplicitWidth = 587
       object mmoEvent: TMemo
         AlignWithMargins = True
         Left = 8
@@ -48,7 +46,6 @@ object MainForm: TMainForm
         ReadOnly = True
         ScrollBars = ssVertical
         TabOrder = 0
-        ExplicitWidth = 571
       end
       object btnEventStart: TButton
         Left = 8
@@ -71,7 +68,6 @@ object MainForm: TMainForm
     end
     object tsFile: TTabSheet
       Caption = 'File'
-      ExplicitWidth = 587
       DesignSize = (
         623
         299)
@@ -122,7 +118,7 @@ object MainForm: TMainForm
       object rbUserData: TRadioButton
         Left = 88
         Top = 111
-        Width = 113
+        Width = 141
         Height = 17
         Caption = 'User Application Data'
         TabOrder = 4
@@ -136,9 +132,89 @@ object MainForm: TMainForm
         TabOrder = 5
       end
     end
+    object tsRollingFile: TTabSheet
+      Caption = 'Rolling File'
+      DesignSize = (
+        623
+        299)
+      object lblRollingFileName: TLabel
+        Left = 12
+        Top = 64
+        Width = 46
+        Height = 13
+        Caption = 'Filename:'
+      end
+      object lblRollingDays: TLabel
+        Left = 12
+        Top = 176
+        Width = 67
+        Height = 13
+        Caption = 'Days to keep:'
+      end
+      object btnRollingFileStart: TButton
+        Left = 8
+        Top = 8
+        Width = 75
+        Height = 25
+        Caption = 'Start'
+        TabOrder = 0
+        OnClick = btnRollingFileStartClick
+      end
+      object btnRollingFileStop: TButton
+        Left = 89
+        Top = 8
+        Width = 75
+        Height = 25
+        Caption = 'Stop'
+        TabOrder = 1
+        OnClick = btnRollingFileStopClick
+      end
+      object edtRollingFileName: TEdit
+        Left = 88
+        Top = 61
+        Width = 525
+        Height = 21
+        Anchors = [akLeft, akTop, akRight]
+        TabOrder = 2
+        Text = 'X2LogTest\Test.log'
+      end
+      object rbRollingProgramData: TRadioButton
+        Left = 88
+        Top = 88
+        Width = 113
+        Height = 17
+        Caption = 'Program Data'
+        Checked = True
+        TabOrder = 3
+        TabStop = True
+      end
+      object rbRollingUserData: TRadioButton
+        Left = 88
+        Top = 111
+        Width = 141
+        Height = 17
+        Caption = 'User Application Data'
+        TabOrder = 4
+      end
+      object rbRollingAbsolute: TRadioButton
+        Left = 88
+        Top = 134
+        Width = 113
+        Height = 17
+        Caption = 'Absolute path'
+        TabOrder = 5
+      end
+      object edtRollingDays: TEdit
+        Left = 88
+        Top = 173
+        Width = 61
+        Height = 21
+        TabOrder = 6
+        Text = '7'
+      end
+    end
     object tsNamedPipe: TTabSheet
       Caption = 'Named Pipe'
-      ExplicitWidth = 587
       DesignSize = (
         623
         299)
@@ -192,7 +268,6 @@ object MainForm: TMainForm
         Caption = '&Refresh'
         TabOrder = 3
         OnClick = btnNamedPipeRefreshClick
-        ExplicitLeft = 502
       end
       object lbNamedPipeServers: TListBox
         Left = 8
@@ -202,7 +277,6 @@ object MainForm: TMainForm
         Anchors = [akLeft, akTop, akRight, akBottom]
         ItemHeight = 13
         TabOrder = 4
-        ExplicitWidth = 569
       end
     end
   end
@@ -219,7 +293,6 @@ object MainForm: TMainForm
     Align = alBottom
     BevelOuter = bvNone
     TabOrder = 1
-    ExplicitWidth = 595
     object btnClose: TButton
       Left = 556
       Top = 0
@@ -230,7 +303,6 @@ object MainForm: TMainForm
       Caption = 'Close'
       TabOrder = 1
       OnClick = btnCloseClick
-      ExplicitLeft = 520
     end
     object btnMonitorForm: TButton
       Left = 0
@@ -289,10 +361,8 @@ object MainForm: TMainForm
     ActivePage = tsTimer
     Align = alTop
     TabOrder = 2
-    ExplicitWidth = 595
     object tsText: TTabSheet
       Caption = 'Text'
-      ExplicitWidth = 587
       DesignSize = (
         623
         76)
@@ -348,7 +418,6 @@ object MainForm: TMainForm
         TabOrder = 4
         Text = 'Hello world!'
         OnKeyDown = edtMessageKeyDown
-        ExplicitWidth = 477
       end
       object btnCategory: TButton
         Left = 416
@@ -363,7 +432,6 @@ object MainForm: TMainForm
     object tsException: TTabSheet
       Caption = 'Exception'
       ImageIndex = 1
-      ExplicitWidth = 587
       DesignSize = (
         623
         76)
@@ -392,13 +460,11 @@ object MainForm: TMainForm
         TabOrder = 1
         Text = 'Horrible things are happening.'
         OnKeyDown = edtExceptionKeyDown
-        ExplicitWidth = 477
       end
     end
     object tsBinary: TTabSheet
       Caption = 'Binary'
       ImageIndex = 2
-      ExplicitWidth = 587
       object btnBinaryRawByteString: TButton
         Left = 12
         Top = 15
@@ -421,7 +487,6 @@ object MainForm: TMainForm
     object tsTimer: TTabSheet
       Caption = 'Timer'
       ImageIndex = 3
-      ExplicitWidth = 587
       object lblTimer: TLabel
         Left = 8
         Top = 12
@@ -488,7 +553,6 @@ object MainForm: TMainForm
     Font.Style = [fsBold]
     ParentFont = False
     TabOrder = 3
-    ExplicitWidth = 595
     object bvlDispatch: TBevel
       Left = 80
       Top = 12
@@ -518,7 +582,6 @@ object MainForm: TMainForm
     Font.Style = [fsBold]
     ParentFont = False
     TabOrder = 4
-    ExplicitWidth = 595
     object bvlObservers: TBevel
       Left = 80
       Top = 12
@@ -533,7 +596,7 @@ object MainForm: TMainForm
     Left = 552
     Top = 176
     Bitmap = {
-      494C01010200140054000C000C00FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
+      494C01010200140058000C000C00FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
       0000000000003600000028000000300000000C00000001002000000000000009
       0000000000000000000000000000000000000000000000000000000000000000
       0000000000000000000000000000000000000000000000000000000000000000

Test/source/MainFrm.pas

@@ -69,6 +69,16 @@ type
     btnTimerStart: TButton;
     btnTimerStop: TButton;
     Timer: TTimer;
+    tsRollingFile: TTabSheet;
+    lblRollingFileName: TLabel;
+    btnRollingFileStart: TButton;
+    btnRollingFileStop: TButton;
+    edtRollingFileName: TEdit;
+    rbRollingProgramData: TRadioButton;
+    rbRollingUserData: TRadioButton;
+    rbRollingAbsolute: TRadioButton;
+    lblRollingDays: TLabel;
+    edtRollingDays: TEdit;
     
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
@@ -93,10 +103,13 @@ type
     procedure btnTimerStartClick(Sender: TObject);
     procedure btnTimerStopClick(Sender: TObject);
     procedure TimerTimer(Sender: TObject);
+    procedure btnRollingFileStartClick(Sender: TObject);
+    procedure btnRollingFileStopClick(Sender: TObject);
   private
     FLog: IX2Log;
     FEventObserver: IX2LogObserver;
     FFileObserver: IX2LogObserver;
+    FRollingFileObserver: IX2LogObserver;
     FNamedPipeObserver: IX2LogObserver;
   protected
     procedure DoLog(Sender: TObject; Level: TX2LogLevel; DateTime: TDateTime; const Msg, Category: string; Details: IX2LogDetails);
@@ -119,6 +132,7 @@ uses
   X2Log.Observer.LogFile,
   X2Log.Observer.MonitorForm,
   X2Log.Observer.NamedPipe,
+  X2Log.Observer.RollingLogFile,
   X2Log.Global;
 
 
@@ -334,6 +348,41 @@ begin
 end;
 
 
+procedure TMainForm.btnRollingFileStartClick(Sender: TObject);
+var
+  days: Integer;
+
+begin
+  if not Assigned(FRollingFileObserver) then
+  begin
+    days := StrToIntDef(edtRollingDays.Text, 7);
+
+    if rbRollingProgramData.Checked then
+      FRollingFileObserver := TX2RollingLogFileObserver.CreateInProgramData(edtFilename.Text, days)
+    else if rbRollingUserData.Checked then
+      FRollingFileObserver := TX2RollingLogFileObserver.CreateInUserAppData(edtFilename.Text, days)
+    else
+      FRollingFileObserver := TX2RollingLogFileObserver.Create(edtFilename.Text, days);
+
+    FLog.Attach(FRollingFileObserver);
+
+    tsRollingFile.ImageIndex := 1;
+  end;
+end;
+
+
+procedure TMainForm.btnRollingFileStopClick(Sender: TObject);
+begin
+  if Assigned(FRollingFileObserver) then
+  begin
+    FLog.Detach(FRollingFileObserver);
+    FRollingFileObserver := nil;
+
+    tsRollingFile.ImageIndex := 0;
+  end;
+end;
+
+
 procedure TMainForm.btnNamedPipeStartClick(Sender: TObject);
 begin
   if not Assigned(FNamedPipeObserver) then

X2Log.Constants.pas

@@ -49,6 +49,15 @@ resourcestring
   LogFileLineDetails = '%0:s (details: %1:s)';
 
 
+  {
+    X2Log.Observer.RollingLogFile
+  }
+
+  { Date format used in the rolling log file's file name }
+  RollingLogFileDateFormat = 'yyyy.mm.dd';
+
+
+
   {
     X2Log.Observer.MonitorForm
   }

X2Log.Observer.LogFile.pas

@@ -17,6 +17,8 @@ type
     FFileName: string;
   protected
     function CreateWorkerThread: TX2LogObserverWorkerThread; override;
+
+    property FileName: string read FFileName;
   public
     constructor Create(const AFileName: string; ALogLevels: TX2LogLevels = X2LogLevelsDefault);
     constructor CreateInProgramData(const AFileName: string; ALogLevels: TX2LogLevels = X2LogLevelsDefault);
@@ -24,6 +26,19 @@ type
   end;
 
 
+  TX2LogFileWorkerThread = class(TX2LogObserverWorkerThread)
+  private
+    FFileName: string;
+  protected
+    function GetFileName: string; virtual;
+    procedure ProcessEntry(AEntry: TX2LogQueueEntry); override;
+
+    property FileName: string read GetFileName;
+  public
+    constructor Create(const AFileName: string);
+  end;
+
+
 implementation
 uses
   System.IOUtils,
@@ -35,19 +50,6 @@ uses
   X2Log.Constants;
 
 
-type
-  TX2LogFileWorkerThread = class(TX2LogObserverWorkerThread)
-  private
-    FFileName: string;
-  protected
-    procedure ProcessEntry(AEntry: TX2LogQueueEntry); override;
-
-    property FileName: string read FFileName;
-  public
-    constructor Create(const AFileName: string);
-  end;
-
-
 
 { TX2LogFileObserver }
 constructor TX2LogFileObserver.Create(const AFileName: string; ALogLevels: TX2LogLevels);
@@ -90,7 +92,7 @@ end;
 
 function TX2LogFileObserver.CreateWorkerThread: TX2LogObserverWorkerThread;
 begin
-  Result := TX2LogFileWorkerThread.Create(FFileName);
+  Result := TX2LogFileWorkerThread.Create(FileName);
 end;
 
 
@@ -181,4 +183,10 @@ begin
   end;
 end;
 
+
+function TX2LogFileWorkerThread.GetFileName: string;
+begin
+  Result := FFileName;
+end;
+
 end.

X2Log.Observer.RollingLogFile.pas

@@ -0,0 +1,162 @@
+unit X2Log.Observer.RollingLogFile;
+
+interface
+uses
+  System.SysUtils,
+
+  X2Log.Intf,
+  X2Log.Observer.CustomThreaded,
+  X2Log.Observer.LogFile;
+
+
+const
+  X2LogDefaultDays = 5;
+
+
+type
+  TX2RollingLogFileObserver = class(TX2LogFileObserver)
+  private
+    FDays: Integer;
+  protected
+    function CreateWorkerThread: TX2LogObserverWorkerThread; override;
+
+    property Days: Integer read FDays;
+  public
+    constructor Create(const AFileName: string; ADays: Integer = X2LogDefaultDays; ALogLevels: TX2LogLevels = X2LogLevelsDefault);
+    constructor CreateInProgramData(const AFileName: string; ADays: Integer = X2LogDefaultDays; ALogLevels: TX2LogLevels = X2LogLevelsDefault);
+    constructor CreateInUserAppData(const AFileName: string; ADays: Integer = X2LogDefaultDays; ALogLevels: TX2LogLevels = X2LogLevelsDefault);
+  end;
+
+
+  TX2RollingLogFileWorkerThread = class(TX2LogFileWorkerThread)
+  private
+    FDays: Integer;
+    FLastCleanupDate: TDateTime;
+    FFormatSettings: TFormatSettings;
+    FDateFormat: string;
+  protected
+    function GetFileName: string; override;
+    function GetDateFileName(ADate: TDateTime): string;
+
+    procedure ProcessEntry(AEntry: TX2LogQueueEntry); override;
+    procedure CleanupLogFiles; virtual;
+
+    property Days: Integer read FDays;
+    property LastCleanupDate: TDateTime read FLastCleanupDate write FLastCleanupDate;
+  public
+    constructor Create(const AFileName: string; ADays: Integer);
+  end;
+
+
+implementation
+uses
+  System.DateUtils,
+  System.IOUtils,
+  System.StrUtils,
+  System.Types,
+
+  X2Log.Constants;
+
+
+{ TX2RollingLogFileObserver }
+constructor TX2RollingLogFileObserver.Create(const AFileName: string; ADays: Integer; ALogLevels: TX2LogLevels);
+begin
+  FDays := ADays;
+
+  inherited Create(AFileName, ALogLevels);
+end;
+
+
+constructor TX2RollingLogFileObserver.CreateInProgramData(const AFileName: string; ADays: Integer; ALogLevels: TX2LogLevels);
+begin
+  FDays := ADays;
+
+  inherited CreateInProgramData(AFileName, ALogLevels);
+end;
+
+
+constructor TX2RollingLogFileObserver.CreateInUserAppData(const AFileName: string; ADays: Integer; ALogLevels: TX2LogLevels);
+begin
+  FDays := ADays;
+
+  inherited CreateInUserAppData(AFileName, ALogLevels);
+end;
+
+
+function TX2RollingLogFileObserver.CreateWorkerThread: TX2LogObserverWorkerThread;
+begin
+  Result := TX2RollingLogFileWorkerThread.Create(FileName, Days);
+end;
+
+
+{ TX2RollingLogFileWorkerThread }
+constructor TX2RollingLogFileWorkerThread.Create(const AFileName: string; ADays: Integer);
+begin
+  FDays := ADays;
+  FFormatSettings := TFormatSettings.Create;
+  FDateFormat := GetLogResourceString(@RollingLogFileDateFormat);
+
+  inherited Create(AFileName);
+end;
+
+
+function TX2RollingLogFileWorkerThread.GetFileName: string;
+begin
+  Result := GetDateFileName(Date);
+end;
+
+
+function TX2RollingLogFileWorkerThread.GetDateFileName(ADate: TDateTime): string;
+var
+  baseFileName: string;
+
+begin
+  baseFileName := inherited GetFileName;
+  Result := ChangeFileExt(baseFileName, '') + '.' +
+            FormatDateTime(FDateFormat, ADate, FFormatSettings) +
+            ExtractFileExt(baseFileName);
+end;
+
+
+procedure TX2RollingLogFileWorkerThread.ProcessEntry(AEntry: TX2LogQueueEntry);
+begin
+  if not SameDate(Date, LastCleanupDate) then
+  begin
+    CleanupLogFiles;
+    LastCleanupDate := Date;
+  end;
+
+  inherited ProcessEntry(AEntry);
+end;
+
+
+procedure TX2RollingLogFileWorkerThread.CleanupLogFiles;
+var
+  baseFileName: string;
+  fileMask: string;
+  validFileNames: TStringDynArray;
+  day: Integer;
+  filePath: string;
+  fileName: string;
+
+begin
+  baseFileName := inherited GetFileName;
+  fileMask := ChangeFileExt(ExtractFileName(baseFileName), '') + '.*' +
+              ExtractFileExt(baseFileName);
+
+  { The date format can be customized, so instead of parsing back the file
+    names, use a whitelist }
+  SetLength(validFileNames, Days);
+  for day := 0 to Pred(Days) do
+    validFileNames[day] := ExtractFileName(GetDateFileName(IncDay(Date, -day)));
+
+  for filePath in TDirectory.GetFiles(ExtractFilePath(baseFileName), fileMask) do
+  begin
+    fileName := ExtractFileName(filePath);
+
+    if IndexText(fileName, validFileNames) = -1 then
+      DeleteFile(filePath);
+  end;
+end;
+
+end.