-----------------------------------------------------------------------
--  util-files-rolling -- Rolling file manager
--  Copyright (C) 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 GNAT.Regpat;
with Util.Dates.Simple_Format;
package body Util.Files.Rolling is

   use type Ada.Calendar.Time;
   use type Ada.Directories.File_Size;

   --  ------------------------------
   --  Format the file pattern with the date and index to produce a file path.
   --  ------------------------------
   function Format (Pattern : in String;
                    Date    : in Ada.Calendar.Time;
                    Index   : in Natural) return String is
      Pos    : Natural := Pattern'First;
      Result : Unbounded_String;
      Info   : Util.Dates.Date_Record;
      First  : Natural;
   begin
      Util.Dates.Split (Info, Date);
      while Pos <= Pattern'Last loop
         if Pattern (Pos) /= '%' or else Pos = Pattern'Last then
            Ada.Strings.Unbounded.Append (Result, Pattern (Pos));
            Pos := Pos + 1;
         elsif Pattern (Pos + 1) = 'i' then
            Ada.Strings.Unbounded.Append (Result, Util.Strings.Image (Index));
            Pos := Pos + 2;
         elsif Pos + 3 < Pattern'Last and then Pattern (Pos + 1) = 'd'
           and then Pattern (Pos + 2) = '{'
         then
            Pos := Pos + 3;
            First := Pos;
            while Pos <= Pattern'Last and Pattern (Pos) /= '}' loop
               Pos := Pos + 1;
            end loop;
            Append (Result, Util.Dates.Simple_Format (Pattern (First .. Pos - 1), Date));
            Pos := Pos + 1;
         else
            Ada.Strings.Unbounded.Append (Result, Pattern (Pos));
            Pos := Pos + 1;
         end if;
      end loop;
      return To_String (Result);
   end Format;

   --  ------------------------------
   --  Initialize the file manager to roll the file referred by `Path` by using
   --  the pattern defined in `Pattern`.
   --  ------------------------------
   procedure Initialize (Manager  : in out File_Manager;
                         Path     : in String;
                         Pattern  : in String;
                         Policy   : in Policy_Type;
                         Strategy : in Strategy_Type) is
   begin
      Manager.Deadline := Ada.Calendar.Clock;
      Manager.File_Path := To_Unbounded_String (Path);
      Manager.Pattern := To_Unbounded_String (Pattern);
      Manager.Cur_Index := 0;
      Manager.Policy := Policy.Kind;
      case Policy.Kind is
         when Size_Policy =>
            Manager.Max_Size := Policy.Size;

         when Time_Policy =>
            Manager.Interval := Policy.Interval;

         when others =>
            null;
      end case;
      Manager.Strategy := Strategy.Kind;
      case Strategy.Kind is
         when Ascending_Strategy | Descending_Strategy =>
            Manager.Min_Index := Strategy.Min_Index;
            Manager.Max_Index := Strategy.Max_Index;
            Manager.Max_Files := Manager.Max_Index - Manager.Min_Index;

         when Direct_Strategy =>
            Manager.Max_Files := Strategy.Max_Files;

      end case;
      Manager.Rollover;
   end Initialize;

   --  ------------------------------
   --  Get the current path (it may or may not exist).
   --  ------------------------------
   function Get_Current_Path (Manager : in File_Manager) return String is
   begin
      return To_String (Manager.File_Path);
   end Get_Current_Path;

   --  ------------------------------
   --  Check if a rollover is necessary based on the rolling strategy.
   --  ------------------------------
   function Is_Rollover_Necessary (Manager : in File_Manager) return Boolean is
   begin
      case Manager.Policy is
         when No_Policy =>
            return False;

         when Time_Policy =>
            return Manager.Deadline < Ada.Calendar.Clock;

         when Size_Policy =>
            declare
               Path : constant String := To_String (Manager.File_Path);
            begin
               if not Ada.Directories.Exists (Path) then
                  return False;
               end if;
               return Ada.Directories.Size (Path) >= Manager.Max_Size;

            exception
               when Ada.Directories.Name_Error =>
                  --  Even if we check for file existence, an exception could
                  --  be raised if the file is moved/deleted.
                  return False;
            end;

      end case;
   end Is_Rollover_Necessary;

   --  Perform a rollover according to the strategy that was configured.
   procedure Rollover (Manager : in out File_Manager) is
   begin
      case (Manager.Strategy) is
         when Ascending_Strategy =>
            Manager.Rollover_Ascending;

         when Descending_Strategy =>
            Manager.Rollover_Descending;

         when Direct_Strategy =>
            Manager.Rollover_Direct;

      end case;
      if Manager.Policy = Time_Policy then
         Manager.Deadline := Ada.Calendar.Clock + Duration (3600 * Manager.Interval);
      end if;
   end Rollover;

   procedure Rollover_Ascending (Manager : in out File_Manager) is
      Old   : constant String := Manager.Get_Current_Path;
      Path  : constant String := Format (Pattern => To_String (Manager.Pattern),
                                         Date    => Manager.Deadline,
                                         Index   => Manager.Cur_Index);
      Dir   : constant String := Ada.Directories.Containing_Directory (Path);
      Names : Util.Strings.Vectors.Vector;
      First : Natural := 0;
      Last  : Natural := 0;
   begin
      if Ada.Directories.Exists (Dir) then
         Manager.Eligible_Files (Dir, Names, First, Last);

         while Natural (Names.Length) > Manager.Max_Files loop
            begin
               Ada.Directories.Delete_File (Compose (Dir, Names.First_Element));

            exception
               when Ada.Directories.Name_Error =>
                  null;
            end;
            Names.Delete_First;
         end loop;
      end if;

      Manager.Cur_Index := Last + 1;

      --  Too many files, rename old ones.
      if Manager.Cur_Index > Manager.Max_Index then
         Manager.Cur_Index := Manager.Max_Index - Natural (Names.Length);
         for Name of Names loop
            Manager.Rename (Compose (Dir, Name));
            Manager.Cur_Index := Manager.Cur_Index + 1;
         end loop;
      end if;

      Manager.Rename (Old);
   end Rollover_Ascending;

   procedure Rename (Manager : in File_Manager;
                     Old     : in String) is
      Path  : constant String := Format (Pattern => To_String (Manager.Pattern),
                                         Date    => Manager.Deadline,
                                         Index   => Manager.Cur_Index);
      Dir   : constant String := Ada.Directories.Containing_Directory (Path);
   begin
      if Ada.Directories.Exists (Old) then
         if not Ada.Directories.Exists (Dir) then
            Ada.Directories.Create_Path (Dir);
         end if;

         Util.Files.Rename (Old_Name => Old,
                            New_Name => Path);
      end if;
   end Rename;

   procedure Rollover_Descending (Manager : in out File_Manager) is
      Old   : constant String := Manager.Get_Current_Path;
      Path  : constant String := Format (Pattern => To_String (Manager.Pattern),
                                         Date    => Manager.Deadline,
                                         Index   => Manager.Cur_Index);
      Dir   : constant String := Ada.Directories.Containing_Directory (Path);
      Names : Util.Strings.Vectors.Vector;
      First : Natural := 0;
      Last  : Natural := 0;
   begin
      if Ada.Directories.Exists (Dir) then
         Manager.Eligible_Files (Dir, Names, First, Last);

         while Natural (Names.Length) > Manager.Max_Files loop
            begin
               Ada.Directories.Delete_File (Compose (Dir, Names.Last_Element));

            exception
               when Ada.Directories.Name_Error =>
                  null;
            end;
            Names.Delete_Last;
         end loop;
      end if;

      Manager.Cur_Index := First;

      if not Names.Is_Empty then
         Manager.Cur_Index := Manager.Min_Index + Natural (Names.Length);
         for Name of reverse Names loop
            Manager.Rename (Compose (Dir, Name));
            Manager.Cur_Index := Manager.Cur_Index - 1;
         end loop;
      end if;

      Manager.Rename (Old);
   end Rollover_Descending;

   procedure Rollover_Direct (Manager : in out File_Manager) is
   begin
      null;
   end Rollover_Direct;

   --  ------------------------------
   --  Get the regex pattern to identify a file that must be purged.
   --  The default is to extract the file pattern part of the file manager pattern.
   --  ------------------------------
   function Get_Purge_Pattern (Manager : in File_Manager) return String is
      Full_Pat : constant String := To_String (Manager.Pattern);
      Name_Pat : constant String := Ada.Directories.Simple_Name (Full_Pat);
      Pos      : Natural := Name_Pat'First;
      Result   : Unbounded_String;
      Found    : Boolean := False;
   begin
      while Pos <= Name_Pat'Last loop
         if Name_Pat (Pos) = '%' and then Pos + 1 <= Name_Pat'Last
           and then Name_Pat (Pos + 1) = 'i'
         then
            if not Found then
               Append (Result, "([0-9]+)");
               Found := True;
            else
               Append (Result, "[0-9]+");
            end if;
            Pos := Pos + 2;
         else
            Append (Result, Name_Pat (Pos));
            Pos := Pos + 1;
         end if;
      end loop;
      return To_String (Result);
   end Get_Purge_Pattern;

   --  ------------------------------
   --  Find the files that are eligible to purge in the given directory.
   --  ------------------------------
   procedure Eligible_Files (Manager     : in out File_Manager;
                             Path        : in String;
                             Names       : in out Util.Strings.Vectors.Vector;
                             First_Index : out Natural;
                             Last_Index  : out Natural) is
      function Get_Index (Name : in String) return Natural;
      function Compare (Left, Right : in String) return Boolean;

      Search_Filter : constant Ada.Directories.Filter_Type
        := (Ada.Directories.Ordinary_File => True,
            Ada.Directories.Directory     => False,
            Ada.Directories.Special_File  => False);
      Pattern  : constant String := Manager.Get_Purge_Pattern;
      Regex    : constant GNAT.Regpat.Pattern_Matcher := GNAT.Regpat.Compile (Pattern);
      Glob1    : constant String := Util.Strings.Replace (Pattern, "([0-9]+)", "*", False);
      Glob2    : constant String := Util.Strings.Replace (Glob1, "[0-9]+", "*", False);
      Search   : Ada.Directories.Search_Type;
      Ent      : Ada.Directories.Directory_Entry_Type;

      function Get_Index (Name : in String) return Natural is
         Matches : GNAT.Regpat.Match_Array (0 .. 1);
      begin
         if GNAT.Regpat.Match (Regex, Name) then
            GNAT.Regpat.Match (Regex, Name, Matches);
            return Natural'Value (Name (Matches (1).First .. Matches (1).Last));
         else
            return 0;
         end if;

      exception
         when others =>
            return 0;
      end Get_Index;

      function Compare (Left, Right : in String) return Boolean is
         Left_Index  : constant Natural := Get_Index (Left);
         Right_Index : constant Natural := Get_Index (Right);
      begin
         return Left_Index < Right_Index;
      end Compare;

      package Sort_Names is new Util.Strings.Vectors.Generic_Sorting (Compare);
   begin
      Ada.Directories.Start_Search (Search,
                                    Directory => Path,
                                    Pattern   => Glob2,
                                    Filter    => Search_Filter);
      while Ada.Directories.More_Entries (Search) loop
         Ada.Directories.Get_Next_Entry (Search, Ent);
         declare
            Name    : constant String := Ada.Directories.Simple_Name (Ent);
         begin
            Names.Append (Name);
         end;
      end loop;
      Sort_Names.Sort (Names);
      if not Names.Is_Empty then
         First_Index := Get_Index (Names.First_Element);
         Last_Index := Get_Index (Names.Last_Element);
      else
         First_Index := Manager.Min_Index;
         Last_Index := Manager.Min_Index;
      end if;
   end Eligible_Files;

end Util.Files.Rolling;

-----------------------------------------------------------------------
--  util-files-rolling -- Rolling file manager
--  Copyright (C) 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 GNAT.Regpat;
with Util.Dates.Simple_Format;
package body Util.Files.Rolling is

   use type Ada.Calendar.Time;
   use type Ada.Directories.File_Size;

   --  ------------------------------
   --  Format the file pattern with the date and index to produce a file path.
   --  ------------------------------
   function Format (Pattern : in String;
                    Date    : in Ada.Calendar.Time;
                    Index   : in Natural) return String is
      Pos    : Natural := Pattern'First;
      Result : Unbounded_String;
      Info   : Util.Dates.Date_Record;
      First  : Natural;
   begin
      Util.Dates.Split (Info, Date);
      while Pos <= Pattern'Last loop
         if Pattern (Pos) /= '%' or else Pos = Pattern'Last then
            Ada.Strings.Unbounded.Append (Result, Pattern (Pos));
            Pos := Pos + 1;
         elsif Pattern (Pos + 1) = 'i' then
            Ada.Strings.Unbounded.Append (Result, Util.Strings.Image (Index));
            Pos := Pos + 2;
         elsif Pos + 3 < Pattern'Last and then Pattern (Pos + 1) = 'd'
           and then Pattern (Pos + 2) = '{'
         then
            Pos := Pos + 3;
            First := Pos;
            while Pos <= Pattern'Last and Pattern (Pos) /= '}' loop
               Pos := Pos + 1;
            end loop;
            Append (Result, Util.Dates.Simple_Format (Pattern (First .. Pos - 1), Date));
            Pos := Pos + 1;
         else
            Ada.Strings.Unbounded.Append (Result, Pattern (Pos));
            Pos := Pos + 1;
         end if;
      end loop;
      return To_String (Result);
   end Format;

   --  ------------------------------
   --  Initialize the file manager to roll the file referred by `Path` by using
   --  the pattern defined in `Pattern`.
   --  ------------------------------
   procedure Initialize (Manager  : in out File_Manager;
                         Path     : in String;
                         Pattern  : in String;
                         Policy   : in Policy_Type;
                         Strategy : in Strategy_Type) is
   begin
      Manager.Deadline := Ada.Calendar.Clock;
      Manager.File_Path := To_Unbounded_String (Path);
      Manager.Pattern := To_Unbounded_String (Pattern);
      Manager.Cur_Index := 0;
      Manager.Policy := Policy.Kind;
      case Policy.Kind is
         when Size_Policy | Size_Time_Policy | Time_Policy =>
            Manager.Max_Size := Policy.Size;
            Manager.Interval := Policy.Interval;

         when others =>
            null;

      end case;
      Manager.Strategy := Strategy.Kind;
      case Strategy.Kind is
         when Ascending_Strategy | Descending_Strategy =>
            Manager.Min_Index := Strategy.Min_Index;
            Manager.Max_Index := Strategy.Max_Index;
            Manager.Max_Files := Manager.Max_Index - Manager.Min_Index;

         when Direct_Strategy =>
            Manager.Max_Files := Strategy.Max_Files;

      end case;
      Manager.Rollover;
   end Initialize;

   --  ------------------------------
   --  Get the current path (it may or may not exist).
   --  ------------------------------
   function Get_Current_Path (Manager : in File_Manager) return String is
   begin
      return To_String (Manager.File_Path);
   end Get_Current_Path;

   --  ------------------------------
   --  Check if a rollover is necessary based on the rolling strategy.
   --  ------------------------------
   function Is_Rollover_Necessary (Manager : in out File_Manager) return Boolean is
      Now : Ada.Calendar.Time;
   begin
      if Manager.Policy = No_Policy then
         return False;
      end if;

      if Manager.Policy = Time_Policy then
         Now := Ada.Calendar.Clock;
         if Now < Manager.Deadline then
            return False;
         end if;
         --  Continue checking if the path has changed.
      end if;

      declare
         Current : constant String := To_String (Manager.File_Path);
         Exists  : constant Boolean := Ada.Directories.Exists (Current);
      begin
         if not Exists and Manager.Policy = Size_Policy then
            return False;
         end if;

         if Exists and then Manager.Policy in Size_Policy | Size_Time_Policy
           and then Ada.Directories.Size (Current) >= Manager.Max_Size
         then
            return True;
         end if;

         if Manager.Policy = Size_Policy then
            return False;
         end if;

         --  Time_Policy or Size_Time_Policy
         Now := Ada.Calendar.Clock;
         if Now < Manager.Deadline then
            return False;
         end if;

         --  Check if the file pattern was changed due to the date.
         declare
            Pat  : constant String := To_String (Manager.Pattern);
            Path : constant String := Format (Pattern => Pat,
                                              Date    => Now,
                                              Index   => Manager.Cur_Index);
         begin
            --  Get a new deadline to check for time change.
            Manager.Deadline := Now + Duration (Manager.Interval);
            return Current /= Path;
         end;

      exception
         when Ada.Directories.Name_Error =>
            --  Even if we check for file existence, an exception could
            --  be raised if the file is moved/deleted.
            return False;
      end;
   end Is_Rollover_Necessary;

   --  ------------------------------
   --  Perform a rollover according to the strategy that was configured.
   --  ------------------------------
   procedure Rollover (Manager : in out File_Manager) is
   begin
      case (Manager.Strategy) is
         when Ascending_Strategy =>
            Manager.Rollover_Ascending;

         when Descending_Strategy =>
            Manager.Rollover_Descending;

         when Direct_Strategy =>
            Manager.Rollover_Direct;

      end case;
   end Rollover;

   procedure Rollover_Ascending (Manager : in out File_Manager) is
      Now   : constant Ada.Calendar.Time := Ada.Calendar.Clock;
      Old   : constant String := Manager.Get_Current_Path;
      Path  : constant String := Format (Pattern => To_String (Manager.Pattern),
                                         Date    => Now,
                                         Index   => Manager.Cur_Index);
      Dir   : constant String := Ada.Directories.Containing_Directory (Path);
      Names : Util.Strings.Vectors.Vector;
      First : Natural := 0;
      Last  : Natural := 0;
   begin
      if Ada.Directories.Exists (Dir) then
         Manager.Eligible_Files (Dir, Names, First, Last);

         while Natural (Names.Length) > Manager.Max_Files loop
            begin
               Ada.Directories.Delete_File (Compose (Dir, Names.First_Element));

            exception
               when Ada.Directories.Name_Error =>
                  null;
            end;
            Names.Delete_First;
         end loop;
      end if;

      Manager.Cur_Index := Last + 1;

      --  Too many files, rename old ones.
      if Manager.Cur_Index > Manager.Max_Index then
         Manager.Cur_Index := Manager.Max_Index - Natural (Names.Length);
         for Name of Names loop
            Manager.Rename (Compose (Dir, Name));
            Manager.Cur_Index := Manager.Cur_Index + 1;
         end loop;
      end if;

      Manager.Rename (Old);
   end Rollover_Ascending;

   procedure Rename (Manager : in File_Manager;
                     Old     : in String) is
      Path  : constant String := Format (Pattern => To_String (Manager.Pattern),
                                         Date    => Manager.Deadline,
                                         Index   => Manager.Cur_Index);
      Dir   : constant String := Ada.Directories.Containing_Directory (Path);
   begin
      if Ada.Directories.Exists (Old) then
         if not Ada.Directories.Exists (Dir) then
            Ada.Directories.Create_Path (Dir);
         end if;

         Util.Files.Rename (Old_Name => Old,
                            New_Name => Path);
      end if;
   end Rename;

   procedure Rollover_Descending (Manager : in out File_Manager) is
      Now   : constant Ada.Calendar.Time := Ada.Calendar.Clock;
      Old   : constant String := Manager.Get_Current_Path;
      Path  : constant String := Format (Pattern => To_String (Manager.Pattern),
                                         Date    => Now,
                                         Index   => Manager.Cur_Index);
      Dir   : constant String := Ada.Directories.Containing_Directory (Path);
      Names : Util.Strings.Vectors.Vector;
      First : Natural := 0;
      Last  : Natural := 0;
   begin
      if Ada.Directories.Exists (Dir) then
         Manager.Eligible_Files (Dir, Names, First, Last);

         while Natural (Names.Length) > Manager.Max_Files loop
            begin
               Ada.Directories.Delete_File (Compose (Dir, Names.Last_Element));

            exception
               when Ada.Directories.Name_Error =>
                  null;
            end;
            Names.Delete_Last;
         end loop;
      end if;

      Manager.Cur_Index := First;

      if not Names.Is_Empty then
         Manager.Cur_Index := Manager.Min_Index + Natural (Names.Length);
         for Name of reverse Names loop
            Manager.Rename (Compose (Dir, Name));
            Manager.Cur_Index := Manager.Cur_Index - 1;
         end loop;
      end if;

      Manager.Rename (Old);
   end Rollover_Descending;

   procedure Rollover_Direct (Manager : in out File_Manager) is
   begin
      null;
   end Rollover_Direct;

   --  ------------------------------
   --  Get the regex pattern to identify a file that must be purged.
   --  The default is to extract the file pattern part of the file manager pattern.
   --  ------------------------------
   function Get_Purge_Pattern (Manager : in File_Manager) return String is
      Full_Pat : constant String := To_String (Manager.Pattern);
      Name_Pat : constant String := Ada.Directories.Simple_Name (Full_Pat);
      Pos      : Natural := Name_Pat'First;
      Result   : Unbounded_String;
      Found    : Boolean := False;
   begin
      while Pos <= Name_Pat'Last loop
         if Name_Pat (Pos) = '%' and then Pos + 1 <= Name_Pat'Last
           and then Name_Pat (Pos + 1) = 'i'
         then
            if not Found then
               Append (Result, "([0-9]+)");
               Found := True;
            else
               Append (Result, "[0-9]+");
            end if;
            Pos := Pos + 2;
         elsif Pos + 3 < Name_Pat'Last and then Name_Pat (Pos + 1) = 'd'
           and then Name_Pat (Pos + 2) = '{'
         then
            Pos := Pos + 3;
            while Pos <= Name_Pat'Last and then Name_Pat (Pos) /= '}' loop
               if Pos + 3 <= Name_Pat'Last and then Name_Pat (Pos .. Pos + 3) = "YYYY" then
                  Pos := Pos + 4;
                  Append (Result, "[0-9]+");
               elsif Pos + 1 <= Name_Pat'Last and then Name_Pat (Pos .. Pos + 1) = "MM" then
                  Pos := Pos + 2;
                  Append (Result, "[0-9]+");
               elsif Pos + 1 <= Name_Pat'Last and then Name_Pat (Pos .. Pos + 1) = "dd" then
                  Pos := Pos + 2;
                  Append (Result, "[0-9]+");
               elsif Pos + 1 <= Name_Pat'Last and then Name_Pat (Pos .. Pos + 1) = "HH" then
                  Pos := Pos + 2;
                  Append (Result, "[0-9]+");
               elsif Pos + 1 <= Name_Pat'Last and then Name_Pat (Pos .. Pos + 1) = "mm" then
                  Pos := Pos + 2;
                  Append (Result, "[0-9]+");
               elsif Pos + 1 <= Name_Pat'Last and then Name_Pat (Pos .. Pos + 1) = "ss" then
                  Pos := Pos + 2;
                  Append (Result, "[0-9]+");
               else
                  Append (Result, Name_Pat (Pos));
                  Pos := Pos + 1;
               end if;
            end loop;
            Pos := Pos + 1;

         else
            Append (Result, Name_Pat (Pos));
            Pos := Pos + 1;
         end if;
      end loop;
      return To_String (Result);
   end Get_Purge_Pattern;

   --  ------------------------------
   --  Find the files that are eligible to purge in the given directory.
   --  ------------------------------
   procedure Eligible_Files (Manager     : in out File_Manager;
                             Path        : in String;
                             Names       : in out Util.Strings.Vectors.Vector;
                             First_Index : out Natural;
                             Last_Index  : out Natural) is
      function Get_Index (Name : in String) return Natural;
      function Compare (Left, Right : in String) return Boolean;

      Search_Filter : constant Ada.Directories.Filter_Type
        := (Ada.Directories.Ordinary_File => True,
            Ada.Directories.Directory     => False,
            Ada.Directories.Special_File  => False);
      Pattern  : constant String := Manager.Get_Purge_Pattern;
      Regex    : constant GNAT.Regpat.Pattern_Matcher := GNAT.Regpat.Compile (Pattern);
      Glob1    : constant String := Util.Strings.Replace (Pattern, "([0-9]+)", "*", False);
      Glob2    : constant String := Util.Strings.Replace (Glob1, "[0-9]+", "*", False);
      Search   : Ada.Directories.Search_Type;
      Ent      : Ada.Directories.Directory_Entry_Type;

      function Get_Index (Name : in String) return Natural is
         Matches : GNAT.Regpat.Match_Array (0 .. 1);
      begin
         if GNAT.Regpat.Match (Regex, Name) then
            GNAT.Regpat.Match (Regex, Name, Matches);
            return Natural'Value (Name (Matches (1).First .. Matches (1).Last));
         else
            return 0;
         end if;

      exception
         when others =>
            return 0;
      end Get_Index;

      function Compare (Left, Right : in String) return Boolean is
         Left_Index  : constant Natural := Get_Index (Left);
         Right_Index : constant Natural := Get_Index (Right);
      begin
         return Left_Index < Right_Index;
      end Compare;

      package Sort_Names is new Util.Strings.Vectors.Generic_Sorting (Compare);
   begin
      Ada.Directories.Start_Search (Search,
                                    Directory => Path,
                                    Pattern   => Glob2,
                                    Filter    => Search_Filter);
      while Ada.Directories.More_Entries (Search) loop
         Ada.Directories.Get_Next_Entry (Search, Ent);
         declare
            Name    : constant String := Ada.Directories.Simple_Name (Ent);
         begin
            Names.Append (Name);
         end;
      end loop;
      Sort_Names.Sort (Names);
      if not Names.Is_Empty then
         First_Index := Get_Index (Names.First_Element);
         Last_Index := Get_Index (Names.Last_Element);
      else
         First_Index := Manager.Min_Index;
         Last_Index := Manager.Min_Index;
      end if;
   end Eligible_Files;

end Util.Files.Rolling;

Implement the Size_Time_Policy to active a rollover when either the size or the time has ellapsed Fix time rollover to change the path when the date/file pattern produces another path


-----------------------------------------------------------------------
--  util-http -- HTTP Utility Library
--  Copyright (C) 2012, 2018, 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.Calendar;

--  = HTTP =
--  The `Util.Http` package provides a set of APIs that allows applications to use
--  the HTTP protocol.  It defines a common interface on top of CURL and AWS so that
--  it is possible to use one of these two libraries in a transparent manner.
--
--  @include util-http-clients.ads
package Util.Http is

   --  Standard codes returned in HTTP responses.
   SC_CONTINUE                        : constant Natural := 100;
   SC_SWITCHING_PROTOCOLS             : constant Natural := 101;
   SC_OK                              : constant Natural := 200;
   SC_CREATED                         : constant Natural := 201;
   SC_ACCEPTED                        : constant Natural := 202;
   SC_NON_AUTHORITATIVE_INFORMATION   : constant Natural := 203;
   SC_NO_CONTENT                      : constant Natural := 204;
   SC_RESET_CONTENT                   : constant Natural := 205;
   SC_PARTIAL_CONTENT                 : constant Natural := 206;
   SC_MULTIPLE_CHOICES                : constant Natural := 300;
   SC_MOVED_PERMANENTLY               : constant Natural := 301;
   SC_MOVED_TEMPORARILY               : constant Natural := 302;
   SC_FOUND                           : constant Natural := 302;
   SC_SEE_OTHER                       : constant Natural := 303;
   SC_NOT_MODIFIED                    : constant Natural := 304;
   SC_USE_PROXY                       : constant Natural := 305;
   SC_TEMPORARY_REDIRECT              : constant Natural := 307;
   SC_BAD_REQUEST                     : constant Natural := 400;
   SC_UNAUTHORIZED                    : constant Natural := 401;
   SC_PAYMENT_REQUIRED                : constant Natural := 402;
   SC_FORBIDDEN                       : constant Natural := 403;
   SC_NOT_FOUND                       : constant Natural := 404;
   SC_METHOD_NOT_ALLOWED              : constant Natural := 405;
   SC_NOT_ACCEPTABLE                  : constant Natural := 406;
   SC_PROXY_AUTHENTICATION_REQUIRED   : constant Natural := 407;
   SC_REQUEST_TIMEOUT                 : constant Natural := 408;
   SC_CONFLICT                        : constant Natural := 409;
   SC_GONE                            : constant Natural := 410;
   SC_LENGTH_REQUIRED                 : constant Natural := 411;
   SC_PRECONDITION_FAILED             : constant Natural := 412;
   SC_REQUEST_ENTITY_TOO_LARGE        : constant Natural := 413;
   SC_REQUEST_URI_TOO_LONG            : constant Natural := 414;
   SC_UNSUPPORTED_MEDIA_TYPE          : constant Natural := 415;
   SC_REQUESTED_RANGE_NOT_SATISFIABLE : constant Natural := 416;
   SC_EXPECTATION_FAILED              : constant Natural := 417;
   SC_INTERNAL_SERVER_ERROR           : constant Natural := 500;
   SC_NOT_IMPLEMENTED                 : constant Natural := 501;
   SC_BAD_GATEWAY                     : constant Natural := 502;
   SC_SERVICE_UNAVAILABLE             : constant Natural := 503;
   SC_GATEWAY_TIMEOUT                 : constant Natural := 504;
   SC_HTTP_VERSION_NOT_SUPPORTED      : constant Natural := 505;

   --  ------------------------------
   --  Abstract Message
   --  ------------------------------
   --  The Abstract_Message interface describe an HTTP message representing either
   --  a request or a response.
   type Abstract_Message is limited interface;

   --  Returns a boolean indicating whether the named message header has already
   --  been set.
   function Contains_Header (Message : in Abstract_Message;
                             Name    : in String) return Boolean is abstract;

   --  Returns the value of the specified message header as a String. If the message
   --  did not include a header of the specified name, this method returns null.
   --  If there are multiple headers with the same name, this method returns the
   --  first head in the request. The header name is case insensitive. You can use
   --  this method with any message header.
   function Get_Header (Message : in Abstract_Message;
                        Name    : in String) return String is abstract;

   --  Sets a message header with the given name and value. If the header had already
   --  been set, the new value overwrites the previous one. The containsHeader
   --  method can be used to test for the presence of a header before setting its value.
   procedure Set_Header (Message  : in out Abstract_Message;
                         Name     : in String;
                         Value    : in String) is abstract;

   --  Adds a request header with the given name and value.
   --  This method allows request headers to have multiple values.
   procedure Add_Header (Message : in out Abstract_Message;
                         Name    : in String;
                         Value   : in String) is abstract;

   --  Iterate over the message headers and executes the Process procedure.
   procedure Iterate_Headers (Message : in Abstract_Message;
                              Process : not null access
                                procedure (Name  : in String;
                                           Value : in String)) is abstract;

   --  Sets a header with the given name and date-value.
   --  The date is specified in terms of milliseconds since the epoch.
   --  If the header had already been set, the new value overwrites the previous one.
   --  The containsHeader method can be used to test for the presence of a header
   --  before setting its value.
   procedure Set_Date_Header (Request  : in out Abstract_Message'Class;
                              Name     : in String;
                              Date     : in Ada.Calendar.Time);

   --  Adds a header with the given name and date-value. The date is specified
   --  in terms of milliseconds since the epoch. This method allows response headers
   --  to have multiple values.
   procedure Add_Date_Header (Request : in out Abstract_Message'Class;
                              Name    : in String;
                              Date    : in Ada.Calendar.Time);

   --  Sets a header with the given name and integer value.
   --  If the header had already been set, the new value overwrites the previous one.
   --  The containsHeader  method can be used to test for the presence of a header
   --  before setting its value.
   procedure Set_Int_Header (Request  : in out Abstract_Message'Class;
                             Name     : in String;
                             Value    : in Integer);

   --  Adds a header with the given name and integer value. This method
   --  allows headers to have multiple values.
   procedure Add_Int_Header (Request  : in out Abstract_Message'Class;
                             Name     : in String;
                             Value    : in Integer);

   --  ------------------------------
   --  Abstract Request
   --  ------------------------------
   type Abstract_Request is limited interface and Abstract_Message;
   type Abstract_Request_Access is access all Abstract_Request'Class;

   --  ------------------------------
   --  Abstract Response
   --  ------------------------------
   type Abstract_Response is limited interface and Abstract_Message;
   type Abstract_Response_Access is access all Abstract_Response'Class;

   --  Get the response status code.
   function Get_Status (Response : in Abstract_Response) return Natural is abstract;

   --  Get the response body as a string.
   function Get_Body (Response : in Abstract_Response) return String is abstract;

end Util.Http;

-----------------------------------------------------------------------
--  util-http -- HTTP Utility Library
--  Copyright (C) 2012, 2018, 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.Calendar;
with Util.Blobs;

--  = HTTP =
--  The `Util.Http` package provides a set of APIs that allows applications to use
--  the HTTP protocol.  It defines a common interface on top of CURL and AWS so that
--  it is possible to use one of these two libraries in a transparent manner.
--
--  @include util-http-clients.ads
package Util.Http is

   --  Standard codes returned in HTTP responses.
   SC_CONTINUE                        : constant Natural := 100;
   SC_SWITCHING_PROTOCOLS             : constant Natural := 101;
   SC_OK                              : constant Natural := 200;
   SC_CREATED                         : constant Natural := 201;
   SC_ACCEPTED                        : constant Natural := 202;
   SC_NON_AUTHORITATIVE_INFORMATION   : constant Natural := 203;
   SC_NO_CONTENT                      : constant Natural := 204;
   SC_RESET_CONTENT                   : constant Natural := 205;
   SC_PARTIAL_CONTENT                 : constant Natural := 206;
   SC_MULTIPLE_CHOICES                : constant Natural := 300;
   SC_MOVED_PERMANENTLY               : constant Natural := 301;
   SC_MOVED_TEMPORARILY               : constant Natural := 302;
   SC_FOUND                           : constant Natural := 302;
   SC_SEE_OTHER                       : constant Natural := 303;
   SC_NOT_MODIFIED                    : constant Natural := 304;
   SC_USE_PROXY                       : constant Natural := 305;
   SC_TEMPORARY_REDIRECT              : constant Natural := 307;
   SC_BAD_REQUEST                     : constant Natural := 400;
   SC_UNAUTHORIZED                    : constant Natural := 401;
   SC_PAYMENT_REQUIRED                : constant Natural := 402;
   SC_FORBIDDEN                       : constant Natural := 403;
   SC_NOT_FOUND                       : constant Natural := 404;
   SC_METHOD_NOT_ALLOWED              : constant Natural := 405;
   SC_NOT_ACCEPTABLE                  : constant Natural := 406;
   SC_PROXY_AUTHENTICATION_REQUIRED   : constant Natural := 407;
   SC_REQUEST_TIMEOUT                 : constant Natural := 408;
   SC_CONFLICT                        : constant Natural := 409;
   SC_GONE                            : constant Natural := 410;
   SC_LENGTH_REQUIRED                 : constant Natural := 411;
   SC_PRECONDITION_FAILED             : constant Natural := 412;
   SC_REQUEST_ENTITY_TOO_LARGE        : constant Natural := 413;
   SC_REQUEST_URI_TOO_LONG            : constant Natural := 414;
   SC_UNSUPPORTED_MEDIA_TYPE          : constant Natural := 415;
   SC_REQUESTED_RANGE_NOT_SATISFIABLE : constant Natural := 416;
   SC_EXPECTATION_FAILED              : constant Natural := 417;
   SC_INTERNAL_SERVER_ERROR           : constant Natural := 500;
   SC_NOT_IMPLEMENTED                 : constant Natural := 501;
   SC_BAD_GATEWAY                     : constant Natural := 502;
   SC_SERVICE_UNAVAILABLE             : constant Natural := 503;
   SC_GATEWAY_TIMEOUT                 : constant Natural := 504;
   SC_HTTP_VERSION_NOT_SUPPORTED      : constant Natural := 505;

   --  ------------------------------
   --  Abstract Message
   --  ------------------------------
   --  The Abstract_Message interface describe an HTTP message representing either
   --  a request or a response.
   type Abstract_Message is limited interface;

   --  Returns a boolean indicating whether the named message header has already
   --  been set.
   function Contains_Header (Message : in Abstract_Message;
                             Name    : in String) return Boolean is abstract;

   --  Returns the value of the specified message header as a String. If the message
   --  did not include a header of the specified name, this method returns null.
   --  If there are multiple headers with the same name, this method returns the
   --  first head in the request. The header name is case insensitive. You can use
   --  this method with any message header.
   function Get_Header (Message : in Abstract_Message;
                        Name    : in String) return String is abstract;

   --  Sets a message header with the given name and value. If the header had already
   --  been set, the new value overwrites the previous one. The containsHeader
   --  method can be used to test for the presence of a header before setting its value.
   procedure Set_Header (Message  : in out Abstract_Message;
                         Name     : in String;
                         Value    : in String) is abstract;

   --  Adds a request header with the given name and value.
   --  This method allows request headers to have multiple values.
   procedure Add_Header (Message : in out Abstract_Message;
                         Name    : in String;
                         Value   : in String) is abstract;

   --  Iterate over the message headers and executes the Process procedure.
   procedure Iterate_Headers (Message : in Abstract_Message;
                              Process : not null access
                                procedure (Name  : in String;
                                           Value : in String)) is abstract;

   --  Sets a header with the given name and date-value.
   --  The date is specified in terms of milliseconds since the epoch.
   --  If the header had already been set, the new value overwrites the previous one.
   --  The containsHeader method can be used to test for the presence of a header
   --  before setting its value.
   procedure Set_Date_Header (Request  : in out Abstract_Message'Class;
                              Name     : in String;
                              Date     : in Ada.Calendar.Time);

   --  Adds a header with the given name and date-value. The date is specified
   --  in terms of milliseconds since the epoch. This method allows response headers
   --  to have multiple values.
   procedure Add_Date_Header (Request : in out Abstract_Message'Class;
                              Name    : in String;
                              Date    : in Ada.Calendar.Time);

   --  Sets a header with the given name and integer value.
   --  If the header had already been set, the new value overwrites the previous one.
   --  The containsHeader  method can be used to test for the presence of a header
   --  before setting its value.
   procedure Set_Int_Header (Request  : in out Abstract_Message'Class;
                             Name     : in String;
                             Value    : in Integer);

   --  Adds a header with the given name and integer value. This method
   --  allows headers to have multiple values.
   procedure Add_Int_Header (Request  : in out Abstract_Message'Class;
                             Name     : in String;
                             Value    : in Integer);

   --  ------------------------------
   --  Abstract Request
   --  ------------------------------
   type Abstract_Request is limited interface and Abstract_Message;
   type Abstract_Request_Access is access all Abstract_Request'Class;

   --  ------------------------------
   --  Abstract Response
   --  ------------------------------
   type Abstract_Response is limited interface and Abstract_Message;
   type Abstract_Response_Access is access all Abstract_Response'Class;

   --  Get the response status code.
   function Get_Status (Response : in Abstract_Response) return Natural is abstract;

   --  Get the response body as a string.
   function Get_Body (Response : in Abstract_Response) return String is abstract;

   --  Get the response body as a blob content.
   function Get_Body (Response : in Abstract_Response) return Util.Blobs.Blob_Ref is abstract;

end Util.Http;

Add a Get_Body function that returns a Blob_Ref to get a binary content (ex: an image)


-----------------------------------------------------------------------
--  util-streams-buffered -- Buffered streams Stream utilities
--  Copyright (C) 2010, 2013, 2015, 2016, 2017 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.Strings.Unbounded;
with Ada.Strings.Wide_Wide_Unbounded;
with Ada.Finalization;
package Util.Streams.Buffered is

   pragma Preelaborate;

   --  -----------------------
   --  Buffered stream
   --  -----------------------
   --  The Buffered_Stream is an output/input stream which uses
   --  an intermediate buffer.  It can be configured to read or write to
   --  another stream that it will read or write using the buffer.
   --
   --  It is necessary to call Flush to make sure the data
   --  is written to the target stream.  The Flush operation will
   --  be called when finalizing the buffered stream.
   type Buffered_Stream is limited new Output_Stream and Input_Stream with private;

   type Buffer_Access is access Ada.Streams.Stream_Element_Array;

   --  Initialize the stream to read or write on the given streams.
   --  An internal buffer is allocated for writing the stream.
   procedure Initialize (Stream  : in out Buffered_Stream;
                         Output  : in Output_Stream_Access;
                         Input   : in Input_Stream_Access;
                         Size    : in Positive);

   --  Initialize the stream with a buffer of Size bytes.
   procedure Initialize (Stream  : in out Buffered_Stream;
                         Size    : in Positive);

   --  Initialize the stream to read from the string.
   procedure Initialize (Stream  : in out Buffered_Stream;
                         Content : in String);

   --  Close the sink.
   overriding
   procedure Close (Stream : in out Buffered_Stream);

   --  Get the direct access to the buffer.
   function Get_Buffer (Stream : in Buffered_Stream) return Buffer_Access;

   --  Write the buffer array to the output stream.
   overriding
   procedure Write (Stream : in out Buffered_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array);

   --  Flush the buffer by writing on the output stream.
   --  Raises Data_Error if there is no output stream.
   overriding
   procedure Flush (Stream : in out Buffered_Stream);

   --  Get the number of element in the stream.
   function Get_Size (Stream : in Buffered_Stream) return Natural;

   --  Fill the buffer by reading the input stream.
   --  Raises Data_Error if there is no input stream;
   procedure Fill (Stream : in out Buffered_Stream);

   --  Read one character from the input stream.
   procedure Read (Stream : in out Buffered_Stream;
                   Char   : out Character);

   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   overriding
   procedure Read (Stream : in out Buffered_Stream;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset);

   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   procedure Read (Stream : in out Buffered_Stream;
                   Into   : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Returns True if the end of the stream is reached.
   function Is_Eof (Stream : in Buffered_Stream) return Boolean;

private

   use Ada.Streams;

   type Buffered_Stream is limited new Ada.Finalization.Limited_Controlled
     and Output_Stream and Input_Stream with record
      --  The buffer where the data is written before being flushed.
      Buffer      : Buffer_Access := null;

      --  The next write position within the buffer.
      Write_Pos   : Stream_Element_Offset := 0;

      --  The next read position within the buffer.
      Read_Pos    : Stream_Element_Offset := 1;

      --  The last valid write position within the buffer.
      Last        : Stream_Element_Offset := 0;

      --  The output stream to use for flushing the buffer.
      Output      : Output_Stream_Access := null;

      --  The input stream to use to fill the buffer.
      Input       : Input_Stream_Access := null;

      No_Flush    : Boolean := False;

      --  Reached end of file when reading.
      Eof         : Boolean := False;
   end record;

   --  Flush the stream and release the buffer.
   overriding
   procedure Finalize (Object : in out Buffered_Stream);

end Util.Streams.Buffered;

-----------------------------------------------------------------------
--  util-streams-buffered -- Buffered streams utilities
--  Copyright (C) 2010, 2013, 2015, 2016, 2017 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.Strings.Unbounded;
with Ada.Finalization;
package Util.Streams.Buffered is

   pragma Preelaborate;

   type Buffer_Access is access Ada.Streams.Stream_Element_Array;

   --  -----------------------
   --  Output buffer stream
   --  -----------------------
   --  The Output_Buffer_Stream is an output stream which uses
   --  an intermediate buffer to write the data.
   --
   --  It is necessary to call Flush to make sure the data
   --  is written to the target stream.  The Flush operation will
   --  be called when finalizing the output buffer stream.
   type Output_Buffer_Stream is limited new Output_Stream with private;

   --  Initialize the stream to write on the given streams.
   --  An internal buffer is allocated for writing the stream.
   procedure Initialize (Stream  : in out Output_Buffer_Stream;
                         Output  : in Output_Stream_Access;
                         Size    : in Positive);

   --  Initialize the stream with a buffer of Size bytes.
   procedure Initialize (Stream  : in out Output_Buffer_Stream;
                         Size    : in Positive);

   --  Close the sink.
   overriding
   procedure Close (Stream : in out Output_Buffer_Stream);

   --  Get the direct access to the buffer.
   function Get_Buffer (Stream : in Output_Buffer_Stream) return Buffer_Access;

   --  Write the buffer array to the output stream.
   overriding
   procedure Write (Stream : in out Output_Buffer_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array);

   --  Flush the buffer by writing on the output stream.
   --  Raises Data_Error if there is no output stream.
   overriding
   procedure Flush (Stream : in out Output_Buffer_Stream);

   --  Get the number of element in the stream.
   function Get_Size (Stream : in Output_Buffer_Stream) return Natural;

   type Input_Buffer_Stream is limited new Input_Stream with private;

   --  Initialize the stream to read from the string.
   procedure Initialize (Stream  : in out Input_Buffer_Stream;
                         Content : in String);

   --  Initialize the stream to read the given streams.
   procedure Initialize (Stream  : in out Input_Buffer_Stream;
                         Input   : in Input_Stream_Access;
                         Size    : in Positive);

   --  Fill the buffer by reading the input stream.
   --  Raises Data_Error if there is no input stream;
   procedure Fill (Stream : in out Input_Buffer_Stream);

   --  Read one character from the input stream.
   procedure Read (Stream : in out Input_Buffer_Stream;
                   Char   : out Character);

   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   overriding
   procedure Read (Stream : in out Input_Buffer_Stream;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset);

   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   procedure Read (Stream : in out Input_Buffer_Stream;
                   Into   : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Returns True if the end of the stream is reached.
   function Is_Eof (Stream : in Input_Buffer_Stream) return Boolean;

private

   use Ada.Streams;

   type Output_Buffer_Stream is limited new Ada.Finalization.Limited_Controlled
     and Output_Stream with record
      --  The buffer where the data is written before being flushed.
      Buffer      : Buffer_Access := null;

      --  The next write position within the buffer.
      Write_Pos   : Stream_Element_Offset := 0;

      --  The next read position within the buffer.
      Read_Pos    : Stream_Element_Offset := 1;

      --  The last valid write position within the buffer.
      Last        : Stream_Element_Offset := 0;

      --  The output stream to use for flushing the buffer.
      Output      : Output_Stream_Access := null;

      No_Flush    : Boolean := False;
   end record;

   --  Flush the stream and release the buffer.
   overriding
   procedure Finalize (Object : in out Output_Buffer_Stream);

   type Input_Buffer_Stream is limited new Ada.Finalization.Limited_Controlled
     and Input_Stream with record
      --  The buffer where the data is written before being flushed.
      Buffer      : Buffer_Access := null;

      --  The next write position within the buffer.
      Write_Pos   : Stream_Element_Offset := 0;

      --  The next read position within the buffer.
      Read_Pos    : Stream_Element_Offset := 1;

      --  The last valid write position within the buffer.
      Last        : Stream_Element_Offset := 0;

      --  The input stream to use to fill the buffer.
      Input       : Input_Stream_Access := null;

      --  Reached end of file when reading.
      Eof         : Boolean := False;
   end record;

   --  Release the buffer.
   overriding
   procedure Finalize (Object : in out Input_Buffer_Stream);

end Util.Streams.Buffered;

Refactor Buffered_Stream into Output_Buffer_Stream and Input_Buffer_Stream - separate the buffer stream into two separate types for clarity


-----------------------------------------------------------------------
--  util-dates-formats-tests - Test for date formats
--  Copyright (C) 2011, 2013, 2014 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.Calendar.Formatting;
with Util.Test_Caller;
with Util.Assertions;
with Util.Properties.Bundles;
with Util.Log.Loggers;
with Util.Dates.RFC7231;
package body Util.Dates.Formats.Tests is
   use Util.Tests;
   use Ada.Strings.Unbounded;

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Dates.Formats.Tests");

   package Caller is new Util.Test_Caller (Test, "Dates");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Dates.Split",
                       Test_Split'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Formats.Format",
                       Test_Format'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Get_Day_Start",
                       Test_Get_Day_Start'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Get_Week_Start",
                       Test_Get_Week_Start'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Get_Month_Start",
                       Test_Get_Month_Start'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Get_Day_End",
                       Test_Get_Day_End'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Get_Week_End",
                       Test_Get_Week_End'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Get_Month_End",
                       Test_Get_Month_End'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.RFC7231.Append_Date",
                       Test_Append_Date'Access);
   end Add_Tests;

   procedure Test_Format (T : in out Test) is
      Bundle  : Util.Properties.Bundles.Manager;
      procedure Check (Pattern : in String;
                       Date    : in Ada.Calendar.Time;
                       Expect  : in String);

      procedure Check (Pattern : in String;
                       Date    : in Ada.Calendar.Time;
                       Expect  : in String) is
         Result : Ada.Strings.Unbounded.Unbounded_String;
      begin
         Util.Dates.Formats.Format (Pattern => Pattern,
                                    Date    => Date,
                                    Bundle  => Bundle,
                                    Into    => Result);
         Util.Tests.Assert_Equals (T, Expect, To_String (Result),
                                   "Invalid result for: " & Pattern);
      end Check;

      T1 : constant Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (1980, 1, 2, 10, 30, 23);
      T2 : constant Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (2011, 11, 19, 0, 0, 0);
      T3 : constant Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (2011, 11, 19, 23, 0, 0);
   begin
      Check ("%H", T1, "10");
      Check ("%H", T2, "00");
      Check ("%I", T3, "11");
      Check ("%k", T2, " 0");
      Check ("%k", T3, "23");
      Check ("%l", T2, " 0");
      Check ("%l", T3, "11");

      Check ("%r", T3, "11:00:00 PM");
      Check ("%r", T2, "00:00:00 AM");
      Check ("%R:%S", T3, "23:00:00");

      Check ("%y-%Y %m/%d %T", T1, "80-1980 01/02 10:30:23");
      Check ("%C %d %D", T1, "19 02 01/02/80");
      Check ("%e", T1, " 1");
      Check ("%F", T1, "1980-01-02");
      Check ("%G", T1, "1980W01");
      Check ("%g", T1, "80W01");

   end Test_Format;

   procedure Check (T          : in out Test'Class;
                    Year       : in Ada.Calendar.Year_Number;
                    Month      : in Ada.Calendar.Month_Number;
                    Day        : in Ada.Calendar.Day_Number;
                    Expect_Day : in Ada.Calendar.Day_Number;
                    Message    : in String;
                    Is_End     : in Boolean;
                    Operation  : access function (D : in Ada.Calendar.Time)
                    return Ada.Calendar.Time) is
      use type Ada.Calendar.Time;

      Date : Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (Year, Month, Day,
                                                                   0, 0, 0);
   begin
      for I in 1 .. 47 loop
         declare
            R : constant Ada.Calendar.Time := Operation (Date);
            D : Date_Record;
         begin
            Split (D, R);
            Log.Info ("{0} ({1}) => {2}",
                      Ada.Calendar.Formatting.Image (Date),
                      Message, Ada.Calendar.Formatting.Image (R));
            Util.Tests.Assert_Equals (T, Natural (Year), Natural (D.Year),
                                      "Invalid year " & Message);
            Util.Tests.Assert_Equals (T, Natural (Month), Natural (D.Month),
                                      "Invalid month " & Message);
            Util.Tests.Assert_Equals (T, Natural (Expect_Day), Natural (D.Month_Day),
                                      "Invalid day " & Message);
            if Is_End then
               Util.Tests.Assert_Equals (T, 23, Natural (D.Hour),
                                         "Invalid hour " & Message);
               Util.Tests.Assert_Equals (T, 59, Natural (D.Minute),
                                         "Invalid minute " & Message);
               Util.Tests.Assert_Equals (T, 59, Natural (D.Second),
                                         "Invalid second " & Message);
            else
               Util.Tests.Assert_Equals (T, 0, Natural (D.Hour),
                                         "Invalid hour " & Message);
               Util.Tests.Assert_Equals (T, 0, Natural (D.Minute),
                                         "Invalid minute " & Message);
               Util.Tests.Assert_Equals (T, 0, Natural (D.Second),
                                         "Invalid second " & Message);
            end if;
         end;
         Date := Date + 1800.0;
      end loop;
   end Check;

   --  ------------------------------
   --  Test the Get_Day_Start operation.
   --  ------------------------------
   procedure Test_Get_Day_Start (T : in out Test) is
   begin
      Check (T, 2013, 6, 04, 04, "Get_Day_Start", False, Get_Day_Start'Access);
      Check (T, 2010, 2, 14, 14, "Get_Day_Start", False, Get_Day_Start'Access);
   end Test_Get_Day_Start;

   --  ------------------------------
   --  Test the Get_Week_Start operation.
   --  ------------------------------
   procedure Test_Get_Week_Start (T : in out Test) is
   begin
      Check (T, 2013, 6, 04, 03, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2013, 6, 03, 03, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2013, 6, 05, 03, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2013, 6, 08, 03, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2010, 2, 14, 08, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2010, 2, 13, 08, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2010, 2, 10, 08, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2010, 2, 15, 15, "Get_Week_Start", False, Get_Week_Start'Access);
   end Test_Get_Week_Start;

   --  ------------------------------
   --  Test the Get_Month_Start operation.
   --  ------------------------------
   procedure Test_Get_Month_Start (T : in out Test) is
   begin
      Check (T, 2013, 6, 04, 01, "Get_Month_Start", False, Get_Month_Start'Access);
      Check (T, 2010, 2, 14, 01, "Get_Month_Start", False, Get_Month_Start'Access);
   end Test_Get_Month_Start;

   --  ------------------------------
   --  Test the Get_Day_End operation.
   --  ------------------------------
   procedure Test_Get_Day_End (T : in out Test) is
   begin
      Check (T, 2013, 6, 04, 04, "Get_Day_Start", True, Get_Day_End'Access);
      Check (T, 2010, 2, 14, 14, "Get_Day_Start", True, Get_Day_End'Access);
   end Test_Get_Day_End;

   --  ------------------------------
   --  Test the Get_Week_End operation.
   --  ------------------------------
   procedure Test_Get_Week_End (T : in out Test) is
   begin
      Check (T, 2013, 6, 04, 09, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2013, 6, 03, 09, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2013, 6, 05, 09, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2013, 6, 08, 09, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2010, 2, 14, 14, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2010, 2, 13, 14, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2010, 2, 10, 14, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2010, 2, 15, 21, "Get_Week_End", True, Get_Week_End'Access);
   end Test_Get_Week_End;

   --  ------------------------------
   --  Test the Get_Month_End operation.
   --  ------------------------------
   procedure Test_Get_Month_End (T : in out Test) is
   begin
      Check (T, 2013, 6, 04, 30, "Get_Month_End", True, Get_Month_End'Access);
      Check (T, 2010, 2, 14, 28, "Get_Month_End", True, Get_Month_End'Access);
      Check (T, 2000, 2, 14, 29, "Get_Month_End", True, Get_Month_End'Access);
   end Test_Get_Month_End;

   --  ------------------------------
   --  Test the Split operation.
   --  ------------------------------
   procedure Test_Split (T : in out Test) is
      procedure Assert_Equals is
         new Util.Assertions.Assert_Equals_T (Ada.Calendar.Formatting.Day_Name);

      Date : constant Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (2014, 11, 12,
                                                                            23, 30, 0);
      D    : Date_Record;
   begin
      Split (D, Date);
      Util.Tests.Assert_Equals (T, 2014, Natural (D.Year), "Invalid year ");
      Util.Tests.Assert_Equals (T, 11, Natural (D.Month), "Invalid month ");
      Util.Tests.Assert_Equals (T, 12, Natural (D.Month_Day), "Invalid day ");
      Util.Tests.Assert_Equals (T, 23, Natural (D.Hour), "Invalid hour ");
      Util.Tests.Assert_Equals (T, 30, Natural (D.Minute), "Invalid minute ");
      Assert_Equals (T, Ada.Calendar.Formatting.Wednesday, D.Day, "Invalid day ");
   end Test_Split;

   procedure Check (T    : in out Test;
                    Date : in String) is
      D : constant Ada.Calendar.Time := Util.Dates.RFC7231.Value (Date);
      F : constant String := Util.Dates.RFC7231.Image (D);
   begin
      Util.Tests.Assert_Equals (T, Date, F, "Invalid date conversion");
   end Check;

   --  ------------------------------
   --  Test the Append_Date as well as the Image operation
   --  ------------------------------
   procedure Test_Append_Date (T : in out Test) is
   begin
      Check (T, "Mon, 26 Mar 2012 19:43:47 GMT");
      Check (T, "Tue, 02 Feb 2016 15:18:35 GMT");
      Check (T, "Wed, 07 Oct 2015 03:41:11 GMT");
      Check (T, "Thu, 17 Sep 2015 10:07:02 GMT");
      Check (T, "Sat, 03 Oct 2015 17:09:58 GMT");
      Check (T, "Fri, 17 Jul 2015 16:07:54 GMT");
      Check (T, "Sun, 04 Oct 2015 15:10:44 GMT");
   end Test_Append_Date;

end Util.Dates.Formats.Tests;

-----------------------------------------------------------------------
--  util-dates-formats-tests - Test for date formats
--  Copyright (C) 2011, 2013, 2014, 2016 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.Calendar.Formatting;
with Util.Test_Caller;
with Util.Assertions;
with Util.Properties.Bundles;
with Util.Log.Loggers;
with Util.Dates.RFC7231;
with Util.Dates.ISO8601;
package body Util.Dates.Formats.Tests is

   use Util.Tests;
   use Ada.Strings.Unbounded;

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Dates.Formats.Tests");

   package Caller is new Util.Test_Caller (Test, "Dates");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Dates.Split",
                       Test_Split'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Formats.Format",
                       Test_Format'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Get_Day_Start",
                       Test_Get_Day_Start'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Get_Week_Start",
                       Test_Get_Week_Start'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Get_Month_Start",
                       Test_Get_Month_Start'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Get_Day_End",
                       Test_Get_Day_End'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Get_Week_End",
                       Test_Get_Week_End'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.Get_Month_End",
                       Test_Get_Month_End'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.RFC7231.Append_Date",
                       Test_Append_Date'Access);
      Caller.Add_Test (Suite, "Test Util.Dates.ISO8601.Image",
                       Test_ISO8601'Access);
   end Add_Tests;

   procedure Test_Format (T : in out Test) is
      Bundle  : Util.Properties.Bundles.Manager;
      procedure Check (Pattern : in String;
                       Date    : in Ada.Calendar.Time;
                       Expect  : in String);

      procedure Check (Pattern : in String;
                       Date    : in Ada.Calendar.Time;
                       Expect  : in String) is
         Result : Ada.Strings.Unbounded.Unbounded_String;
      begin
         Util.Dates.Formats.Format (Pattern => Pattern,
                                    Date    => Date,
                                    Bundle  => Bundle,
                                    Into    => Result);
         Util.Tests.Assert_Equals (T, Expect, To_String (Result),
                                   "Invalid result for: " & Pattern);
      end Check;

      T1 : constant Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (1980, 1, 2, 10, 30, 23);
      T2 : constant Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (2011, 11, 19, 0, 0, 0);
      T3 : constant Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (2011, 11, 19, 23, 0, 0);
   begin
      Check ("%H", T1, "10");
      Check ("%H", T2, "00");
      Check ("%I", T3, "11");
      Check ("%k", T2, " 0");
      Check ("%k", T3, "23");
      Check ("%l", T2, " 0");
      Check ("%l", T3, "11");

      Check ("%r", T3, "11:00:00 PM");
      Check ("%r", T2, "00:00:00 AM");
      Check ("%R:%S", T3, "23:00:00");

      Check ("%y-%Y %m/%d %T", T1, "80-1980 01/02 10:30:23");
      Check ("%C %d %D", T1, "19 02 01/02/80");
      Check ("%e", T1, " 1");
      Check ("%F", T1, "1980-01-02");
      Check ("%G", T1, "1980W01");
      Check ("%g", T1, "80W01");

   end Test_Format;

   procedure Check (T          : in out Test'Class;
                    Year       : in Ada.Calendar.Year_Number;
                    Month      : in Ada.Calendar.Month_Number;
                    Day        : in Ada.Calendar.Day_Number;
                    Expect_Day : in Ada.Calendar.Day_Number;
                    Message    : in String;
                    Is_End     : in Boolean;
                    Operation  : access function (D : in Ada.Calendar.Time)
                    return Ada.Calendar.Time) is
      use type Ada.Calendar.Time;

      Date : Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (Year, Month, Day,
                                                                   0, 0, 0);
   begin
      for I in 1 .. 47 loop
         declare
            R : constant Ada.Calendar.Time := Operation (Date);
            D : Date_Record;
         begin
            Split (D, R);
            Log.Info ("{0} ({1}) => {2}",
                      Ada.Calendar.Formatting.Image (Date),
                      Message, Ada.Calendar.Formatting.Image (R));
            Util.Tests.Assert_Equals (T, Natural (Year), Natural (D.Year),
                                      "Invalid year " & Message);
            Util.Tests.Assert_Equals (T, Natural (Month), Natural (D.Month),
                                      "Invalid month " & Message);
            Util.Tests.Assert_Equals (T, Natural (Expect_Day), Natural (D.Month_Day),
                                      "Invalid day " & Message);
            if Is_End then
               Util.Tests.Assert_Equals (T, 23, Natural (D.Hour),
                                         "Invalid hour " & Message);
               Util.Tests.Assert_Equals (T, 59, Natural (D.Minute),
                                         "Invalid minute " & Message);
               Util.Tests.Assert_Equals (T, 59, Natural (D.Second),
                                         "Invalid second " & Message);
            else
               Util.Tests.Assert_Equals (T, 0, Natural (D.Hour),
                                         "Invalid hour " & Message);
               Util.Tests.Assert_Equals (T, 0, Natural (D.Minute),
                                         "Invalid minute " & Message);
               Util.Tests.Assert_Equals (T, 0, Natural (D.Second),
                                         "Invalid second " & Message);
            end if;
         end;
         Date := Date + 1800.0;
      end loop;
   end Check;

   --  ------------------------------
   --  Test the Get_Day_Start operation.
   --  ------------------------------
   procedure Test_Get_Day_Start (T : in out Test) is
   begin
      Check (T, 2013, 6, 04, 04, "Get_Day_Start", False, Get_Day_Start'Access);
      Check (T, 2010, 2, 14, 14, "Get_Day_Start", False, Get_Day_Start'Access);
   end Test_Get_Day_Start;

   --  ------------------------------
   --  Test the Get_Week_Start operation.
   --  ------------------------------
   procedure Test_Get_Week_Start (T : in out Test) is
   begin
      Check (T, 2013, 6, 04, 03, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2013, 6, 03, 03, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2013, 6, 05, 03, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2013, 6, 08, 03, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2010, 2, 14, 08, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2010, 2, 13, 08, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2010, 2, 10, 08, "Get_Week_Start", False, Get_Week_Start'Access);
      Check (T, 2010, 2, 15, 15, "Get_Week_Start", False, Get_Week_Start'Access);
   end Test_Get_Week_Start;

   --  ------------------------------
   --  Test the Get_Month_Start operation.
   --  ------------------------------
   procedure Test_Get_Month_Start (T : in out Test) is
   begin
      Check (T, 2013, 6, 04, 01, "Get_Month_Start", False, Get_Month_Start'Access);
      Check (T, 2010, 2, 14, 01, "Get_Month_Start", False, Get_Month_Start'Access);
   end Test_Get_Month_Start;

   --  ------------------------------
   --  Test the Get_Day_End operation.
   --  ------------------------------
   procedure Test_Get_Day_End (T : in out Test) is
   begin
      Check (T, 2013, 6, 04, 04, "Get_Day_Start", True, Get_Day_End'Access);
      Check (T, 2010, 2, 14, 14, "Get_Day_Start", True, Get_Day_End'Access);
   end Test_Get_Day_End;

   --  ------------------------------
   --  Test the Get_Week_End operation.
   --  ------------------------------
   procedure Test_Get_Week_End (T : in out Test) is
   begin
      Check (T, 2013, 6, 04, 09, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2013, 6, 03, 09, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2013, 6, 05, 09, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2013, 6, 08, 09, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2010, 2, 14, 14, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2010, 2, 13, 14, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2010, 2, 10, 14, "Get_Week_End", True, Get_Week_End'Access);
      Check (T, 2010, 2, 15, 21, "Get_Week_End", True, Get_Week_End'Access);
   end Test_Get_Week_End;

   --  ------------------------------
   --  Test the Get_Month_End operation.
   --  ------------------------------
   procedure Test_Get_Month_End (T : in out Test) is
   begin
      Check (T, 2013, 6, 04, 30, "Get_Month_End", True, Get_Month_End'Access);
      Check (T, 2010, 2, 14, 28, "Get_Month_End", True, Get_Month_End'Access);
      Check (T, 2000, 2, 14, 29, "Get_Month_End", True, Get_Month_End'Access);
   end Test_Get_Month_End;

   --  ------------------------------
   --  Test the Split operation.
   --  ------------------------------
   procedure Test_Split (T : in out Test) is
      procedure Assert_Equals is
         new Util.Assertions.Assert_Equals_T (Ada.Calendar.Formatting.Day_Name);

      Date : constant Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (2014, 11, 12,
                                                                            23, 30, 0);
      D    : Date_Record;
   begin
      Split (D, Date);
      Util.Tests.Assert_Equals (T, 2014, Natural (D.Year), "Invalid year ");
      Util.Tests.Assert_Equals (T, 11, Natural (D.Month), "Invalid month ");
      Util.Tests.Assert_Equals (T, 12, Natural (D.Month_Day), "Invalid day ");
      Util.Tests.Assert_Equals (T, 23, Natural (D.Hour), "Invalid hour ");
      Util.Tests.Assert_Equals (T, 30, Natural (D.Minute), "Invalid minute ");
      Assert_Equals (T, Ada.Calendar.Formatting.Wednesday, D.Day, "Invalid day ");
   end Test_Split;

   procedure Check (T    : in out Test;
                    Date : in String) is
      D : constant Ada.Calendar.Time := Util.Dates.RFC7231.Value (Date);
      F : constant String := Util.Dates.RFC7231.Image (D);
   begin
      Util.Tests.Assert_Equals (T, Date, F, "Invalid date conversion");
   end Check;

   --  ------------------------------
   --  Test the Append_Date as well as the Image operation
   --  ------------------------------
   procedure Test_Append_Date (T : in out Test) is
   begin
      Check (T, "Mon, 26 Mar 2012 19:43:47 GMT");
      Check (T, "Tue, 02 Feb 2016 15:18:35 GMT");
      Check (T, "Wed, 07 Oct 2015 03:41:11 GMT");
      Check (T, "Thu, 17 Sep 2015 10:07:02 GMT");
      Check (T, "Sat, 03 Oct 2015 17:09:58 GMT");
      Check (T, "Fri, 17 Jul 2015 16:07:54 GMT");
      Check (T, "Sun, 04 Oct 2015 15:10:44 GMT");
   end Test_Append_Date;

   --  ------------------------------
   --  Test the ISO8601 operations.
   --  ------------------------------
   procedure Test_ISO8601 (T : in out Test) is
      Date : constant Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (2014, 11, 12,
                                                                            23, 30, 4, 0.123456);
      D    : Date_Record;
   begin
      Split (D, Date);
      Util.Tests.Assert_Equals (T, "2014", ISO8601.Image (D, ISO8601.YEAR));
      Util.Tests.Assert_Equals (T, "2014-11", ISO8601.Image (D, ISO8601.MONTH));
      Util.Tests.Assert_Equals (T, "2014-11-12", ISO8601.Image (D, ISO8601.DAY));
      Util.Tests.Assert_Equals (T, "2014-11-12T23", ISO8601.Image (D, ISO8601.HOUR));
      Util.Tests.Assert_Equals (T, "2014-11-12T23:30", ISO8601.Image (D, ISO8601.MINUTE));
      Util.Tests.Assert_Equals (T, "2014-11-12T23:30:04", ISO8601.Image (D, ISO8601.SECOND));
      Util.Tests.Assert_Equals (T, "2014-11-12T23:30:04.123+00:00",
                                ISO8601.Image (D, ISO8601.SUBSECOND));
   end Test_ISO8601;

end Util.Dates.Formats.Tests;

Implement the new date test

Implement the new date test