keystoreada_1.3.3_e0e9d5ef/ada-util/src/base/log/util-log-appenders-rolling_files.adb

  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 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;