1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230 | -----------------------------------------------------------------------
-- util-log-appenders-rolling_files -- Rolling file log appenders
-- Copyright (C) 2001 - 2022 Stephane Carrez
-- Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
-- http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
-----------------------------------------------------------------------
with Ada.Finalization;
with Ada.Directories;
with Util.Properties.Basic;
with Util.Log.Appenders.Formatter;
package body Util.Log.Appenders.Rolling_Files is
use Ada;
use Ada.Finalization;
package Bool_Prop renames Util.Properties.Basic.Boolean_Property;
package Int_Prop renames Util.Properties.Basic.Integer_Property;
-- ------------------------------
-- Finalize the referenced object. This is called before the object is freed.
-- ------------------------------
overriding
procedure Finalize (Object : in out File_Entity) is
begin
Text_IO.Close (File => Object.Output);
end Finalize;
protected body Rolling_File is
procedure Initialize (Name : in String;
Base : in String;
Properties : in Util.Properties.Manager) is
function Get_Policy return Util.Files.Rolling.Policy_Type with Inline;
function Get_Strategy return Util.Files.Rolling.Strategy_Type with Inline;
File : constant String := Properties.Get (Base & ".fileName", Name & ".log");
Pat : constant String := Properties.Get (Base & ".filePattern", Base & "-%i.log");
function Get_Policy return Util.Files.Rolling.Policy_Type is
Str : constant String := Properties.Get (Base & ".policy", "time");
Inter : constant Integer := Int_Prop.Get (Properties, Base & ".policyInterval", 1);
Size : constant String := Properties.Get (Base & ".minSize", "1000000");
begin
if Str = "none" then
return (Kind => Util.Files.Rolling.No_Policy);
elsif Str = "time" then
return (Kind => Util.Files.Rolling.Time_Policy,
Size => 0,
Interval => Inter);
elsif Str = "size-time" or else Str = "time-size" then
return (Kind => Util.Files.Rolling.Size_Time_Policy,
Size => Ada.Directories.File_Size'Value (Size),
Interval => Inter);
else
return (Kind => Util.Files.Rolling.Size_Policy,
Size => Ada.Directories.File_Size'Value (Size),
Interval => 0);
end if;
exception
when others =>
return (Kind => Util.Files.Rolling.No_Policy);
end Get_Policy;
function Get_Strategy return Util.Files.Rolling.Strategy_Type is
Str : constant String := Properties.Get (Base & ".strategy", "ascending");
Min : constant Integer := Int_Prop.Get (Properties, Base & ".policyMin", 0);
Max : constant Integer := Int_Prop.Get (Properties, Base & ".policyMax", 0);
begin
if Str = "direct" then
return (Kind => Util.Files.Rolling.Direct_Strategy,
Max_Files => Max);
elsif Str = "descending" then
return (Kind => Util.Files.Rolling.Descending_Strategy,
Min_Index => Min,
Max_Index => Max);
else
return (Kind => Util.Files.Rolling.Ascending_Strategy,
Min_Index => Min,
Max_Index => Max);
end if;
end Get_Strategy;
begin
Append := Bool_Prop.Get (Properties, Base & ".append", True);
Manager.Initialize (Path => File,
Pattern => Pat,
Policy => Get_Policy,
Strategy => Get_Strategy);
end Initialize;
procedure Openlog (File : out File_Refs.Ref) is
begin
if not Current.Is_Null then
if not Manager.Is_Rollover_Necessary then
File := Current;
return;
end if;
Closelog;
Manager.Rollover;
end if;
Current := File_Refs.Create;
declare
Path : constant String := Manager.Get_Current_Path;
Dir : constant String := Ada.Directories.Containing_Directory (Path);
begin
if not Ada.Directories.Exists (Dir) then
Ada.Directories.Create_Path (Dir);
end if;
if not Ada.Directories.Exists (Path) then
Text_IO.Create (File => Current.Value.Output,
Name => Path);
else
Text_IO.Open (File => Current.Value.Output,
Name => Path,
Mode => (if Append then Text_IO.Append_File
else Text_IO.Out_File));
end if;
File := Current;
end;
end Openlog;
procedure Flush (File : out File_Refs.Ref) is
begin
if not Current.Is_Null then
File := Current;
end if;
end Flush;
procedure Closelog is
Empty : File_Refs.Ref;
begin
-- Close the current log by releasing its reference counter.
Current := Empty;
end Closelog;
end Rolling_File;
overriding
procedure Append (Self : in out File_Appender;
Message : in Util.Strings.Builders.Builder;
Date : in Ada.Calendar.Time;
Level : in Level_Type;
Logger : in String) is
begin
if Self.Level >= Level then
declare
File : File_Refs.Ref;
procedure Write_File (Data : in String) with Inline_Always;
procedure Write_File (Data : in String) is
begin
Text_IO.Put (File.Value.Output, Data);
end Write_File;
procedure Write is new Formatter (Write_File);
begin
Self.File.Openlog (File);
if not File.Is_Null then
Write (Self, Message, Date, Level, Logger);
Text_IO.New_Line (File.Value.Output);
if Self.Immediate_Flush then
Text_IO.Flush (File.Value.Output);
end if;
end if;
end;
end if;
end Append;
-- ------------------------------
-- Flush the log events.
-- ------------------------------
overriding
procedure Flush (Self : in out File_Appender) is
File : File_Refs.Ref;
begin
Self.File.Flush (File);
if not File.Is_Null then
Text_IO.Flush (File.Value.Output);
end if;
end Flush;
-- ------------------------------
-- Flush and close the file.
-- ------------------------------
overriding
procedure Finalize (Self : in out File_Appender) is
begin
Self.File.Closelog;
end Finalize;
-- ------------------------------
-- Create a file appender and configure it according to the properties
-- ------------------------------
function Create (Name : in String;
Properties : in Util.Properties.Manager;
Default : in Level_Type)
return Appender_Access is
Base : constant String := "appender." & Name;
Result : constant File_Appender_Access
:= new File_Appender '(Limited_Controlled with Length => Name'Length,
Name => Name,
others => <>);
begin
Result.Set_Level (Name, Properties, Default);
Result.Set_Layout (Name, Properties, FULL);
Result.Immediate_Flush := Bool_Prop.Get (Properties, Base & ".immediateFlush", True);
Result.File.Initialize (Name, Base, Properties);
return Result.all'Access;
end Create;
end Util.Log.Appenders.Rolling_Files;
|