-----------------------------------------------------------------------
--  util-log-appenders-rolling_files -- Rolling file log appenders
--  Copyright (C) 2001 - 2021 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,
                       Interval => Inter);
            else
               return (Kind => Util.Files.Rolling.Size_Policy,
                       Size => Ada.Directories.File_Size'Value (Size));
            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;
         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;

Fix indentation

Fix indentation


-----------------------------------------------------------------------
--  Util.Streams -- Stream utilities
--  Copyright (C) 2010 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.Streams;
package Util.Streams is

   pragma Preelaborate;

   --  -----------------------
   --  Output stream
   --  -----------------------
   --  The Output_Stream is an interface that accepts output bytes
   --  and sends them to a sink.
   type Output_Stream is limited interface;
   type Output_Stream_Access is access all Output_Stream'Class;

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

   --  Flush the buffer (if any) to the sink.
   procedure Flush (Stream : in out Output_Stream) is null;

   --  Close the sink.
   procedure Close (Stream : in out Output_Stream) is null;

   --  -----------------------
   --  Input stream
   --  -----------------------
   --  The Input_Stream is the interface that reads input bytes
   --  from a source and returns them.
   type Input_Stream is limited interface;
   type Input_Stream_Access is access all Input_Stream'Class;

   --  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_Stream;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset) is abstract;

   --  Copy the input stream to the output stream until the end of the input stream
   --  is reached.
   procedure Copy (From : in out Input_Stream'Class;
                   Into : in out Output_Stream'Class);

   --  Notes:
   --  ------
   --  The Ada.Streams.Root_Stream_Type implements the Output_Stream
   --  and Input_Stream.  It is however not easy to use for composing various
   --  stream behaviors.
end Util.Streams;

-----------------------------------------------------------------------
--  Util.Streams -- Stream utilities
--  Copyright (C) 2010, 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.Streams;
package Util.Streams is

   pragma Preelaborate;

   --  -----------------------
   --  Output stream
   --  -----------------------
   --  The Output_Stream is an interface that accepts output bytes
   --  and sends them to a sink.
   type Output_Stream is limited interface;
   type Output_Stream_Access is access all Output_Stream'Class;

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

   --  Flush the buffer (if any) to the sink.
   procedure Flush (Stream : in out Output_Stream) is null;

   --  Close the sink.
   procedure Close (Stream : in out Output_Stream) is null;

   --  -----------------------
   --  Input stream
   --  -----------------------
   --  The Input_Stream is the interface that reads input bytes
   --  from a source and returns them.
   type Input_Stream is limited interface;
   type Input_Stream_Access is access all Input_Stream'Class;

   --  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_Stream;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset) is abstract;

   --  Copy the input stream to the output stream until the end of the input stream
   --  is reached.
   procedure Copy (From : in out Input_Stream'Class;
                   Into : in out Output_Stream'Class);

   --  Copy the stream array to the string.
   --  The string must be large enough to hold the stream array
   --  or a Constraint_Error exception is raised.
   procedure Copy (From : in Ada.Streams.Stream_Element_Array;
                   Into : in out String);

   --  Copy the string to the stream array.
   --  The stream array must be large enough to hold the string
   --  or a Constraint_Error exception is raised.
   procedure Copy (From : in String;
                   Into : in out Ada.Streams.Stream_Element_Array);

   --  Notes:
   --  ------
   --  The Ada.Streams.Root_Stream_Type implements the Output_Stream
   --  and Input_Stream.  It is however not easy to use for composing various
   --  stream behaviors.
end Util.Streams;

Declare the Copy procedure to copy a string to a Stream_Element_Array


-----------------------------------------------------------------------
--  wiki-parsers -- Wiki parser
--  Copyright (C) 2011, 2015, 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.Strings.Wide_Wide_Unbounded;

with Wiki.Documents;
with Wiki.Attributes;

--  == Wiki Parsers ==
--  The Wikis.Parsers package implements a parser for several well known wiki formats.
--  The parser works with the Document_Reader interface type which defines several
--  procedures that are called by the parser when the wiki text is scanned.
package Wiki.Parsers is

   pragma Preelaborate;

   --  Defines the possible wiki syntax supported by the parser.
   type Wiki_Syntax_Type
     is (
         --  Google wiki syntax http://code.google.com/p/support/wiki/WikiSyntax
         SYNTAX_GOOGLE,

         --  Creole wiki syntax http://www.wikicreole.org/wiki/Creole1.0
         SYNTAX_CREOLE,

         --  Dotclear syntax http://dotclear.org/documentation/2.0/usage/syntaxes
         SYNTAX_DOTCLEAR,

         --  PhpBB syntax http://wiki.phpbb.com/Help:Formatting
         SYNTAX_PHPBB,

         --  MediaWiki syntax http://www.mediawiki.org/wiki/Help:Formatting
         SYNTAX_MEDIA_WIKI,

         --  Markdown
         SYNTAX_MARKDOWN,

         --  A mix of the above
         SYNTAX_MIX,

         --  The input is plain possibly incorrect HTML.
         SYNTAX_HTML);

   --  Parse the wiki text contained in Text according to the wiki syntax
   --  specified in Syntax and invoke the document reader procedures defined
   --  by into.
   procedure Parse (Into   : in Wiki.Documents.Document_Reader_Access;
                    Text   : in Wide_Wide_String;
                    Syntax : in Wiki_Syntax_Type := SYNTAX_MIX);

private

   use Ada.Strings.Wide_Wide_Unbounded;

   HT : constant Wide_Wide_Character := Wide_Wide_Character'Val (16#09#);
   LF : constant Wide_Wide_Character := Wide_Wide_Character'Val (16#0A#);
   CR : constant Wide_Wide_Character := Wide_Wide_Character'Val (16#0D#);

   type Input is interface;
   type Input_Access is access all Input'Class;
   procedure Read_Char (From : in out Input;
                        Token : out Wide_Wide_Character;
                        Eof   : out Boolean) is abstract;

   type Parser is limited record
      Pending             : Wide_Wide_Character;
      Has_Pending         : Boolean;
      Document            : Wiki.Documents.Document_Reader_Access;
      Format              : Wiki.Documents.Format_Map;
      Text                : Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String;
      Token               : Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String;
      Empty_Line          : Boolean := True;
      Is_Eof              : Boolean := False;
      In_Paragraph        : Boolean := False;
      In_List             : Boolean := False;
      Need_Paragraph      : Boolean := True;
      Link_Double_Bracket : Boolean := False;
      Is_Dotclear         : Boolean := False;
      Header_Offset       : Integer := 0;
      Quote_Level         : Natural := 0;
      Escape_Char         : Wide_Wide_Character;
      List_Level          : Natural := 0;
      Reader              : Input_Access := null;
      Attributes          : Wiki.Attributes.Attribute_List_Type;
   end record;

   type Parser_Handler is access procedure (P     : in out Parser;
                                            Token : in Wide_Wide_Character);

   type Parser_Table is array (0 .. 127) of Parser_Handler;
   type Parser_Table_Access is access Parser_Table;

   --  Peek the next character from the wiki text buffer.
   procedure Peek (P     : in out Parser;
                   Token : out Wide_Wide_Character);

   --  Put back the character so that it will be returned by the next call to Peek.
   procedure Put_Back (P     : in out Parser;
                       Token : in Wide_Wide_Character);

   --  Skip all the spaces and tabs as well as end of the current line (CR+LF).
   procedure Skip_End_Of_Line (P : in out Parser);

   --  Flush the wiki text that was collected in the text buffer.
   procedure Flush_Text (P : in out Parser);

   --  Flush the wiki dl/dt/dd definition list.
   procedure Flush_List (P : in out Parser);

   procedure Start_Element (P          : in out Parser;
                            Name       : in Unbounded_Wide_Wide_String;
                            Attributes : in Wiki.Attributes.Attribute_List_Type);

   procedure End_Element (P    : in out Parser;
                          Name : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String);

end Wiki.Parsers;

-----------------------------------------------------------------------
--  wiki-parsers -- Wiki parser
--  Copyright (C) 2011, 2015, 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.Strings.Wide_Wide_Unbounded;

with Wiki.Documents;
with Wiki.Attributes;

--  == Wiki Parsers ==
--  The Wikis.Parsers package implements a parser for several well known wiki formats.
--  The parser works with the Document_Reader interface type which defines several
--  procedures that are called by the parser when the wiki text is scanned.
package Wiki.Parsers is

   pragma Preelaborate;

   --  Defines the possible wiki syntax supported by the parser.
   type Wiki_Syntax_Type
     is (
         --  Google wiki syntax http://code.google.com/p/support/wiki/WikiSyntax
         SYNTAX_GOOGLE,

         --  Creole wiki syntax http://www.wikicreole.org/wiki/Creole1.0
         SYNTAX_CREOLE,

         --  Dotclear syntax http://dotclear.org/documentation/2.0/usage/syntaxes
         SYNTAX_DOTCLEAR,

         --  PhpBB syntax http://wiki.phpbb.com/Help:Formatting
         SYNTAX_PHPBB,

         --  MediaWiki syntax http://www.mediawiki.org/wiki/Help:Formatting
         SYNTAX_MEDIA_WIKI,

         --  Markdown
         SYNTAX_MARKDOWN,

         --  A mix of the above
         SYNTAX_MIX,

         --  The input is plain possibly incorrect HTML.
         SYNTAX_HTML);

   --  Parse the wiki text contained in Text according to the wiki syntax
   --  specified in Syntax and invoke the document reader procedures defined
   --  by into.
   procedure Parse (Into   : in Wiki.Documents.Document_Reader_Access;
                    Text   : in Wide_Wide_String;
                    Syntax : in Wiki_Syntax_Type := SYNTAX_MIX);

private

   use Ada.Strings.Wide_Wide_Unbounded;

   HT : constant Wide_Wide_Character := Wide_Wide_Character'Val (16#09#);
   LF : constant Wide_Wide_Character := Wide_Wide_Character'Val (16#0A#);
   CR : constant Wide_Wide_Character := Wide_Wide_Character'Val (16#0D#);

   type Input is interface;
   type Input_Access is access all Input'Class;
   procedure Read_Char (From : in out Input;
                        Token : out Wide_Wide_Character;
                        Eof   : out Boolean) is abstract;

   type Parser is limited record
      Pending             : Wide_Wide_Character;
      Has_Pending         : Boolean;
      Document            : Wiki.Documents.Document_Reader_Access;
      Format              : Wiki.Documents.Format_Map;
      Text                : Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String;
      Token               : Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String;
      Empty_Line          : Boolean := True;
      Is_Eof              : Boolean := False;
      In_Paragraph        : Boolean := False;
      In_List             : Boolean := False;
      Need_Paragraph      : Boolean := True;
      Link_Double_Bracket : Boolean := False;
      Is_Dotclear         : Boolean := False;
      Header_Offset       : Integer := 0;
      Quote_Level         : Natural := 0;
      Escape_Char         : Wide_Wide_Character;
      List_Level          : Natural := 0;
      Reader              : Input_Access := null;
      Attributes          : Wiki.Attributes.Attribute_List_Type;
   end record;

   type Parser_Handler is access procedure (P     : in out Parser;
                                            Token : in Wide_Wide_Character);

   type Parser_Table is array (0 .. 127) of Parser_Handler;
   type Parser_Table_Access is access Parser_Table;

   --  Peek the next character from the wiki text buffer.
   procedure Peek (P     : in out Parser;
                   Token : out Wide_Wide_Character);

   --  Put back the character so that it will be returned by the next call to Peek.
   procedure Put_Back (P     : in out Parser;
                       Token : in Wide_Wide_Character);

   --  Skip all the spaces and tabs as well as end of the current line (CR+LF).
   procedure Skip_End_Of_Line (P : in out Parser);

   --  Flush the wiki text that was collected in the text buffer.
   procedure Flush_Text (P : in out Parser);

   --  Flush the wiki dl/dt/dd definition list.
   procedure Flush_List (P : in out Parser);

   --  Append a character to the wiki text buffer.
   procedure Parse_Text (P     : in out Parser;
                         Token : in Wide_Wide_Character);

   procedure Start_Element (P          : in out Parser;
                            Name       : in Unbounded_Wide_Wide_String;
                            Attributes : in Wiki.Attributes.Attribute_List_Type);

   procedure End_Element (P    : in out Parser;
                          Name : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String);

end Wiki.Parsers;

Declare the Parse_Text procedure

Declare the Parse_Text procedure


-----------------------------------------------------------------------
--  util-commands -- Support to make command line tools
--  Copyright (C) 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.
-----------------------------------------------------------------------
package Util.Commands is

   --  The argument list interface that gives access to command arguments.
   type Argument_List is limited interface;

   --  Get the number of arguments available.
   function Get_Count (List : in Argument_List) return Natural is abstract;

   --  Get the argument at the given position.
   function Get_Argument (List : in Argument_List;
                          Pos  : in Positive) return String is abstract;

end Util.Commands;

-----------------------------------------------------------------------
--  util-commands -- Support to make command line tools
--  Copyright (C) 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.
-----------------------------------------------------------------------
package Util.Commands is

   --  The argument list interface that gives access to command arguments.
   type Argument_List is limited interface;

   --  Get the number of arguments available.
   function Get_Count (List : in Argument_List) return Natural is abstract;

   --  Get the argument at the given position.
   function Get_Argument (List : in Argument_List;
                          Pos  : in Positive) return String is abstract;

   type Default_Argument_List (Offset : Natural) is new Argument_List with null record;

   --  Get the number of arguments available.
   overriding
   function Get_Count (List : in Default_Argument_List) return Natural;

   --  Get the argument at the given position.
   overriding
   function Get_Argument (List : in Default_Argument_List;
                          Pos  : in Positive) return String;

end Util.Commands;

Declare the Default_Argument_List and override the Get_Count and Get_Argument operations


-----------------------------------------------------------------------
--  dynamo -- Ada Code Generator
--  Copyright (C) 2009, 2010, 2011, 2012, 2015 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.Command_Line;  use GNAT.Command_Line;
with GNAT.Traceback.Symbolic;

with Sax.Readers;
with Ada.Text_IO;

with Ada.Strings.Unbounded;
with Ada.Exceptions;
with Ada.Directories;
with Ada.Command_Line;
with Ada.Environment_Variables;

with Util.Files;
with Util.Log.Loggers;
with Util.Systems.Os;
with Gen.Utils.GNAT;
with Gen.Generator;
with Gen.Commands;
with Gen.Configs;
procedure Dynamo is
   use Ada;
   use Ada.Strings.Unbounded;
   use Ada.Directories;
   use Ada.Command_Line;
   use Gen.Commands;

   procedure Set_Config_Directory (Path   : in String;
                                   Silent : in Boolean := False);

   procedure Print_Configuration (Generator : in Gen.Generator.Handler);

   --  Print environment variable setup
   procedure Print_Environment (Generator : in Gen.Generator.Handler;
                                C_Env     : in Boolean := False);

   Out_Dir      : Unbounded_String;
   Config_Dir   : Unbounded_String;
   Template_Dir : Unbounded_String;
   Status       : Exit_Status := Success;
   Debug        : Boolean := False;
   Print_Config : Boolean := False;
   Print_Env    : Boolean := False;
   Print_CEnv   : Boolean := False;

   --  ------------------------------
   --  Print information about dynamo configuration
   --  ------------------------------
   procedure Print_Configuration (Generator : in Gen.Generator.Handler) is
   begin
      Ada.Text_IO.Put_Line ("Dynamo version          : " & Gen.Configs.VERSION);
      Ada.Text_IO.Put_Line ("Config directory        : " & Generator.Get_Config_Directory);
      Ada.Text_IO.Put_Line ("UML directory           : "
                            & Generator.Get_Parameter (Gen.Configs.GEN_UML_DIR));
      Ada.Text_IO.Put_Line ("Templates directory     : "
                            & Generator.Get_Parameter (Gen.Configs.GEN_TEMPLATES_DIRS));
      Ada.Text_IO.Put_Line ("GNAT project directory  : "
                            & Generator.Get_Parameter (Gen.Configs.GEN_GNAT_PROJECT_DIRS));
   end Print_Configuration;

   --  ------------------------------
   --  Print environment variable setup
   --  ------------------------------
   procedure Print_Environment (Generator : in Gen.Generator.Handler;
                                C_Env     : in Boolean := False) is
   begin
      if C_Env then
         Ada.Text_IO.Put ("setenv " & Gen.Utils.GNAT.ADA_PROJECT_PATH_NAME & " """);
      else
         Ada.Text_IO.Put ("export " & Gen.Utils.GNAT.ADA_PROJECT_PATH_NAME & "=""");
      end if;
      if Ada.Environment_Variables.Exists (Gen.Utils.GNAT.ADA_PROJECT_PATH_NAME) then
         Ada.Text_IO.Put (Ada.Environment_Variables.Value (Gen.Utils.GNAT.ADA_PROJECT_PATH_NAME));
         Ada.Text_IO.Put (Util.Systems.Os.Path_Separator);
      end if;
      Ada.Text_IO.Put_Line (Generator.Get_Parameter (Gen.Configs.GEN_GNAT_PROJECT_DIRS) & """");
   end Print_Environment;

   --  ------------------------------
   --  Verify and set the configuration path
   --  ------------------------------
   procedure Set_Config_Directory (Path   : in String;
                                   Silent : in Boolean := False) is
      Log_Path : constant String := Ada.Directories.Compose (Path, "log4j.properties");
   begin
      --  Ignore if the config directory was already set.
      if Length (Config_Dir) > 0 then
         return;
      end if;

      --  Check that we can read some configuration file.
      if not Ada.Directories.Exists (Log_Path) then
         if not Silent then
            Ada.Text_IO.Put_Line ("Invalid config directory: " & Path);
            Status := Failure;
         end if;
         return;
      end if;

      --  Configure the logs
      Util.Log.Loggers.Initialize (Log_Path);
      Config_Dir := To_Unbounded_String (Path);
   end Set_Config_Directory;

begin
   Initialize_Option_Scan (Stop_At_First_Non_Switch => True, Section_Delimiters => "targs");
   --  Parse the command line
   loop
      case Getopt ("* v d e E o: t: c:") is
         when ASCII.NUL => exit;

         when 'o' =>
            Out_Dir := To_Unbounded_String (Parameter & "/");

         when 't' =>
            Template_Dir := To_Unbounded_String (Parameter & "/");

         when 'c' =>
            Set_Config_Directory (Parameter);

         when 'e' =>
            Print_Env := True;

         when 'E' =>
            Print_CEnv := True;

         when 'd' =>
            Debug := True;

         when 'v' =>
            Print_Config := True;

         when '*' =>
            exit;

         when others =>
            null;
      end case;
   end loop;

   if Length (Config_Dir) = 0 then
      declare
         Name : constant String := Ada.Command_Line.Command_Name;
         Path : constant String := Ada.Directories.Containing_Directory (Name);
         Dir  : constant String := Containing_Directory (Path);
      begin
         Set_Config_Directory (Compose (Dir, "config"), True);
         Set_Config_Directory (Util.Files.Compose (Dir, "share/dynamo/base"), True);
         Set_Config_Directory (Gen.Configs.CONFIG_DIR, True);
      end;
   end if;
   if Status /= Success then
      Gen.Commands.Short_Help_Usage;
      Ada.Command_Line.Set_Exit_Status (Status);
      return;
   end if;

   if Ada.Command_Line.Argument_Count = 0 then
      Gen.Commands.Short_Help_Usage;
      Set_Exit_Status (Failure);
      return;
   end if;

   declare
      Cmd_Name  : constant String := Full_Switch;
      Cmd       : Gen.Commands.Command_Access;
      Generator : Gen.Generator.Handler;
   begin
      if Length (Out_Dir) > 0 then
         Gen.Generator.Set_Result_Directory (Generator, To_String (Out_Dir));
      end if;
      if Length (Template_Dir) > 0 then
         Gen.Generator.Set_Template_Directory (Generator, Template_Dir);
      end if;

      Gen.Generator.Initialize (Generator, Config_Dir, Debug);
      if Print_Config then
         Print_Configuration (Generator);
         return;
      elsif Print_Env then
         Print_Environment (Generator, False);
         return;
      elsif Print_CEnv then
         Print_Environment (Generator, True);
         return;
      end if;

      Cmd := Gen.Commands.Find_Command (Cmd_Name);

      --  Check that the command exists.
      if Cmd = null then
         if Cmd_Name'Length > 0 then
            Ada.Text_IO.Put_Line ("Invalid command: '" & Cmd_Name & "'");
         end if;
         Gen.Commands.Short_Help_Usage;
         Set_Exit_Status (Failure);
         return;
      end if;

      Cmd.Execute (Generator);

      Ada.Command_Line.Set_Exit_Status (Gen.Generator.Get_Status (Generator));
   end;

exception
   when E : Invalid_Switch =>
      Ada.Text_IO.Put_Line ("Invalid option: " & Ada.Exceptions.Exception_Message (E));
      Gen.Commands.Short_Help_Usage;
      Ada.Command_Line.Set_Exit_Status (2);

   when E : Gen.Generator.Fatal_Error =>
      Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Message (E));
      Ada.Command_Line.Set_Exit_Status (1);

   when E : Sax.Readers.XML_Fatal_Error =>
      Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Message (E));
      Ada.Command_Line.Set_Exit_Status (1);

   when E : others =>
      Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Message (E));
      Ada.Text_IO.Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback (E));
      Ada.Command_Line.Set_Exit_Status (1);

end Dynamo;

-----------------------------------------------------------------------
--  dynamo -- Ada Code Generator
--  Copyright (C) 2009, 2010, 2011, 2012, 2015, 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 GNAT.Command_Line;  use GNAT.Command_Line;
with GNAT.Traceback.Symbolic;

with Sax.Readers;
with Ada.Text_IO;

with Ada.Strings.Unbounded;
with Ada.Exceptions;
with Ada.Directories;
with Ada.Command_Line;
with Ada.Environment_Variables;

with Util.Files;
with Util.Log.Loggers;
with Util.Systems.Os;
with Util.Commands;
with Gen.Utils.GNAT;
with Gen.Generator;
with Gen.Commands;
with Gen.Configs;
procedure Dynamo is
   use Ada;
   use Ada.Strings.Unbounded;
   use Ada.Directories;
   use Ada.Command_Line;
   use Gen.Commands;

   procedure Set_Config_Directory (Path   : in String;
                                   Silent : in Boolean := False);

   procedure Print_Configuration (Generator : in Gen.Generator.Handler);

   --  Print environment variable setup
   procedure Print_Environment (Generator : in Gen.Generator.Handler;
                                C_Env     : in Boolean := False);

   Out_Dir      : Unbounded_String;
   Config_Dir   : Unbounded_String;
   Template_Dir : Unbounded_String;
   Status       : Exit_Status := Success;
   Debug        : Boolean := False;
   Print_Config : Boolean := False;
   Print_Env    : Boolean := False;
   Print_CEnv   : Boolean := False;
   First        : Natural := 0;

   --  ------------------------------
   --  Print information about dynamo configuration
   --  ------------------------------
   procedure Print_Configuration (Generator : in Gen.Generator.Handler) is
   begin
      Ada.Text_IO.Put_Line ("Dynamo version          : " & Gen.Configs.VERSION);
      Ada.Text_IO.Put_Line ("Config directory        : " & Generator.Get_Config_Directory);
      Ada.Text_IO.Put_Line ("UML directory           : "
                            & Generator.Get_Parameter (Gen.Configs.GEN_UML_DIR));
      Ada.Text_IO.Put_Line ("Templates directory     : "
                            & Generator.Get_Parameter (Gen.Configs.GEN_TEMPLATES_DIRS));
      Ada.Text_IO.Put_Line ("GNAT project directory  : "
                            & Generator.Get_Parameter (Gen.Configs.GEN_GNAT_PROJECT_DIRS));
   end Print_Configuration;

   --  ------------------------------
   --  Print environment variable setup
   --  ------------------------------
   procedure Print_Environment (Generator : in Gen.Generator.Handler;
                                C_Env     : in Boolean := False) is
   begin
      if C_Env then
         Ada.Text_IO.Put ("setenv " & Gen.Utils.GNAT.ADA_PROJECT_PATH_NAME & " """);
      else
         Ada.Text_IO.Put ("export " & Gen.Utils.GNAT.ADA_PROJECT_PATH_NAME & "=""");
      end if;
      if Ada.Environment_Variables.Exists (Gen.Utils.GNAT.ADA_PROJECT_PATH_NAME) then
         Ada.Text_IO.Put (Ada.Environment_Variables.Value (Gen.Utils.GNAT.ADA_PROJECT_PATH_NAME));
         Ada.Text_IO.Put (Util.Systems.Os.Path_Separator);
      end if;
      Ada.Text_IO.Put_Line (Generator.Get_Parameter (Gen.Configs.GEN_GNAT_PROJECT_DIRS) & """");
   end Print_Environment;

   --  ------------------------------
   --  Verify and set the configuration path
   --  ------------------------------
   procedure Set_Config_Directory (Path   : in String;
                                   Silent : in Boolean := False) is
      Log_Path : constant String := Ada.Directories.Compose (Path, "log4j.properties");
   begin
      --  Ignore if the config directory was already set.
      if Length (Config_Dir) > 0 then
         return;
      end if;

      --  Check that we can read some configuration file.
      if not Ada.Directories.Exists (Log_Path) then
         if not Silent then
            Ada.Text_IO.Put_Line ("Invalid config directory: " & Path);
            Status := Failure;
         end if;
         return;
      end if;

      --  Configure the logs
      Util.Log.Loggers.Initialize (Log_Path);
      Config_Dir := To_Unbounded_String (Path);
   end Set_Config_Directory;

begin
   Initialize_Option_Scan (Stop_At_First_Non_Switch => True, Section_Delimiters => "targs");
   --  Parse the command line
   loop
      case Getopt ("* v d e E o: t: c:") is
         when ASCII.NUL => exit;

         when 'o' =>
            Out_Dir := To_Unbounded_String (Parameter & "/");
            First := First + 1;

         when 't' =>
            Template_Dir := To_Unbounded_String (Parameter & "/");
            First := First + 1;

         when 'c' =>
            Set_Config_Directory (Parameter);
            First := First + 1;

         when 'e' =>
            Print_Env := True;

         when 'E' =>
            Print_CEnv := True;

         when 'd' =>
            Debug := True;

         when 'v' =>
            Print_Config := True;

         when '*' =>
            exit;

         when others =>
            null;
      end case;
      First := First + 1;
   end loop;

   if Length (Config_Dir) = 0 then
      declare
         Name : constant String := Ada.Command_Line.Command_Name;
         Path : constant String := Ada.Directories.Containing_Directory (Name);
         Dir  : constant String := Containing_Directory (Path);
      begin
         Set_Config_Directory (Compose (Dir, "config"), True);
         Set_Config_Directory (Util.Files.Compose (Dir, "share/dynamo/base"), True);
         Set_Config_Directory (Gen.Configs.CONFIG_DIR, True);
      end;
   end if;
   if Status /= Success then
      Gen.Commands.Short_Help_Usage;
      Ada.Command_Line.Set_Exit_Status (Status);
      return;
   end if;

   if Ada.Command_Line.Argument_Count = 0 then
      Gen.Commands.Short_Help_Usage;
      Set_Exit_Status (Failure);
      return;
   end if;

   declare
      use type Gen.Commands.Command_Access;

      Args      : Util.Commands.Default_Argument_List (First + 1);
      Cmd_Name  : constant String := Full_Switch;
      Cmd       : Gen.Commands.Command_Access;
      Generator : Gen.Generator.Handler;
   begin
      if Length (Out_Dir) > 0 then
         Gen.Generator.Set_Result_Directory (Generator, To_String (Out_Dir));
      end if;
      if Length (Template_Dir) > 0 then
         Gen.Generator.Set_Template_Directory (Generator, Template_Dir);
      end if;

      Gen.Generator.Initialize (Generator, Config_Dir, Debug);
      if Print_Config then
         Print_Configuration (Generator);
         return;
      elsif Print_Env then
         Print_Environment (Generator, False);
         return;
      elsif Print_CEnv then
         Print_Environment (Generator, True);
         return;
      end if;

      Cmd := Gen.Commands.Driver.Find_Command (Cmd_Name);

      --  Check that the command exists.
      if Cmd = null then
         if Cmd_Name'Length > 0 then
            Ada.Text_IO.Put_Line ("Invalid command: '" & Cmd_Name & "'");
         end if;
         Gen.Commands.Short_Help_Usage;
         Set_Exit_Status (Failure);
         return;
      end if;

      Cmd.Execute (Cmd_Name, Args, Generator);

      Ada.Command_Line.Set_Exit_Status (Gen.Generator.Get_Status (Generator));
   end;

exception
   when E : Invalid_Switch =>
      Ada.Text_IO.Put_Line ("Invalid option: " & Ada.Exceptions.Exception_Message (E));
      Gen.Commands.Short_Help_Usage;
      Ada.Command_Line.Set_Exit_Status (2);

   when E : Gen.Generator.Fatal_Error =>
      Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Message (E));
      Ada.Command_Line.Set_Exit_Status (1);

   when E : Sax.Readers.XML_Fatal_Error =>
      Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Message (E));
      Ada.Command_Line.Set_Exit_Status (1);

   when E : others =>
      Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Message (E));
      Ada.Text_IO.Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback (E));
      Ada.Command_Line.Set_Exit_Status (1);

end Dynamo;

Update to use the Ada Util command support


------------------------------------------------------------------------------
-- Copyright (c) 2014-2017, Natacha Porté                                   --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Natools.S_Expressions.Atom_Ref_Constructors;
with Natools.S_Expressions.Interpreter_Loop;
with Natools.S_Expressions.Printers;
with Natools.Time_IO.RFC_3339;

package body Natools.Web.Containers is

   procedure Add_Atom
     (List : in out Unsafe_Atom_Lists.List;
      Context : in Meaningless_Type;
      Atom : in S_Expressions.Atom);
      --  Append a new atom to List

   procedure Add_Date
     (Map : in out Date_Maps.Unsafe_Maps.Map;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Value : in out S_Expressions.Lockable.Descriptor'Class);
      --  Append a new named date to Map

   procedure Add_Expression
     (Map : in out Expression_Maps.Unsafe_Maps.Map;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Value : in out S_Expressions.Lockable.Descriptor'Class);
      --  Insert a new node (Name -> Cache (Value)) in Map

   procedure Add_Expression_Map
     (Map : in out Expression_Map_Maps.Unsafe_Maps.Map;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Value : in out S_Expressions.Lockable.Descriptor'Class);
      --  Insert a new node (Name -> Expression_Map (Value)) in Map

   procedure Date_Reader is new S_Expressions.Interpreter_Loop
     (Date_Maps.Unsafe_Maps.Map, Meaningless_Type, Add_Date);

   procedure List_Reader is new S_Expressions.Interpreter_Loop
     (Unsafe_Atom_Lists.List, Meaningless_Type,
      Dispatch_Without_Argument => Add_Atom);

   procedure Map_Map_Reader is new S_Expressions.Interpreter_Loop
     (Expression_Map_Maps.Unsafe_Maps.Map, Meaningless_Type,
      Add_Expression_Map);

   procedure Map_Reader is new S_Expressions.Interpreter_Loop
     (Expression_Maps.Unsafe_Maps.Map, Meaningless_Type, Add_Expression);

   ------------------------------
   -- Local Helper Subprograms --
   ------------------------------

   procedure Add_Atom
     (List : in out Unsafe_Atom_Lists.List;
      Context : in Meaningless_Type;
      Atom : in S_Expressions.Atom)
   is
      pragma Unreferenced (Context);
   begin
      List.Append (Atom);
   end Add_Atom;

   procedure Add_Date
     (Map : in out Date_Maps.Unsafe_Maps.Map;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Value : in out S_Expressions.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);
      use type S_Expressions.Events.Event;
      Item : Date;
   begin
      if Value.Current_Event = S_Expressions.Events.Add_Atom then
         declare
            Image : constant String
              := S_Expressions.To_String (Value.Current_Atom);
         begin
            if Time_IO.RFC_3339.Is_Valid (Image) then
               Time_IO.RFC_3339.Value (Image, Item.Time, Item.Offset);
               Map.Include (Name, Item);
            else
               Log (Severities.Warning, "Ignoring invalid date named """
                 & S_Expressions.To_String (Name) & '"');
            end if;
         end;
      else
         Map.Exclude (Name);
      end if;
   end Add_Date;

   procedure Add_Expression
     (Map : in out Expression_Maps.Unsafe_Maps.Map;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Value : in out S_Expressions.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);
      Expression : S_Expressions.Caches.Reference;
   begin
      S_Expressions.Printers.Transfer (Value, Expression);
      Map.Include (Name, Expression.First);
   end Add_Expression;

   procedure Add_Expression_Map
     (Map : in out Expression_Map_Maps.Unsafe_Maps.Map;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Value : in out S_Expressions.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);
      Expression_Map : Expression_Maps.Constant_Map;
   begin
      if Map.Contains (Name) then
         Log (Severities.Error,
           "Duplicate name """ & S_Expressions.To_String (Name)
           & """ in expression map map");
         return;
      end if;

      Set_Expressions (Expression_Map, Value);
      Map.Insert (Name, Expression_Map);
   end Add_Expression_Map;

   --------------------
   -- Map Interfaces --
   --------------------

   procedure Set_Dates
     (Map : in out Date_Maps.Constant_Map;
      Date_List : in out S_Expressions.Lockable.Descriptor'Class)
   is
      New_Map : Date_Maps.Unsafe_Maps.Map;
   begin
      Date_Reader (Date_List, New_Map, Meaningless_Value);
      Map.Replace (New_Map);
   end Set_Dates;

   procedure Set_Expressions
     (Map : in out Expression_Maps.Constant_Map;
      Expression_List : in out S_Expressions.Lockable.Descriptor'Class)
   is
      New_Map : Expression_Maps.Unsafe_Maps.Map;
   begin
      Map_Reader (Expression_List, New_Map, Meaningless_Value);
      Map.Replace (New_Map);
   end Set_Expressions;

   procedure Set_Expression_Maps
     (Map : in out Expression_Map_Maps.Constant_Map;
      Expression_Map_List : in out S_Expressions.Lockable.Descriptor'Class)
   is
      New_Map : Expression_Map_Maps.Unsafe_Maps.Map;
   begin
      Map_Map_Reader (Expression_Map_List, New_Map, Meaningless_Value);
      Map.Replace (New_Map);
   end Set_Expression_Maps;

   ---------------------------
   -- Atom Arrays Interface --
   ---------------------------

   procedure Append_Atoms
     (Target : in out Unsafe_Atom_Lists.List;
      Expression : in out S_Expressions.Lockable.Descriptor'Class) is
   begin
      List_Reader (Expression, Target, Meaningless_Value);
   end Append_Atoms;

   function Create (Source : Unsafe_Atom_Lists.List)
     return Atom_Array_Refs.Immutable_Reference
   is
      function Create_Array return Atom_Array;

      function Create_Array return Atom_Array is
         Cursor : Unsafe_Atom_Lists.Cursor := Source.First;
         Result : Atom_Array (1 .. S_Expressions.Count (Source.Length));
      begin
         for I in Result'Range loop
            Result (I) := S_Expressions.Atom_Ref_Constructors.Create
              (Unsafe_Atom_Lists.Element (Cursor));
            Unsafe_Atom_Lists.Next (Cursor);
         end loop;

         return Result;
      end Create_Array;
   begin
      return Atom_Array_Refs.Create (Create_Array'Access);
   end Create;

   function Create
     (Expression : in out S_Expressions.Lockable.Descriptor'Class)
     return Atom_Array_Refs.Immutable_Reference
   is
      List : Unsafe_Atom_Lists.List;
   begin
      Append_Atoms (List, Expression);
      return Create (List);
   end Create;

   --------------------------
   -- Atom Table Interface --
   --------------------------

   function Create
     (Expression : in out S_Expressions.Lockable.Descriptor'Class)
     return Atom_Table_Refs.Immutable_Reference
   is
      List : Atom_Row_Lists.List;
      Event : S_Expressions.Events.Event := Expression.Current_Event;
      Lock : S_Expressions.Lockable.Lock_State;
   begin
      Read_Expression :
      loop
         case Event is
            when S_Expressions.Events.Close_List
              | S_Expressions.Events.End_Of_Input
              | S_Expressions.Events.Error
            =>
               exit Read_Expression;

            when S_Expressions.Events.Add_Atom => null;

            when S_Expressions.Events.Open_List =>
               Expression.Lock (Lock);
               begin
                  Expression.Next (Event);

                  if Event in S_Expressions.Events.Add_Atom
                            | S_Expressions.Events.Open_List
                  then
                     List.Append (Create (Expression));
                  end if;

                  Expression.Unlock (Lock);
               exception
                  when others =>
                     Expression.Unlock (Lock, False);
                     raise;
               end;
         end case;

         Expression.Next (Event);
      end loop Read_Expression;

      return Create (List);
   end Create;

   function Create
     (Row_List : in Atom_Row_Lists.List)
     return Atom_Table_Refs.Immutable_Reference is
   begin
      if Atom_Row_Lists.Is_Empty (Row_List) then
         return Atom_Table_Refs.Null_Immutable_Reference;
      end if;

      Build_Table :
      declare
         Data : constant Atom_Table_Refs.Data_Access
           := new Atom_Table (1 .. S_Expressions.Count
                                     (Atom_Row_Lists.Length (Row_List)));
         Ref : constant Atom_Table_Refs.Immutable_Reference
           := Atom_Table_Refs.Create (Data);
         Cursor : Atom_Row_Lists.Cursor := Atom_Row_Lists.First (Row_List);
      begin
         for I in Data.all'Range loop
            Data (I) := Atom_Row_Lists.Element (Cursor);
            Atom_Row_Lists.Next (Cursor);
         end loop;

         pragma Assert (not Atom_Row_Lists.Has_Element (Cursor));

         return Ref;
      end Build_Table;
   end Create;

end Natools.Web.Containers;

------------------------------------------------------------------------------
-- Copyright (c) 2014-2017, Natacha Porté                                   --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Natools.S_Expressions.Atom_Ref_Constructors;
with Natools.S_Expressions.Interpreter_Loop;
with Natools.S_Expressions.Printers;
with Natools.Time_IO.RFC_3339;

package body Natools.Web.Containers is

   procedure Add_Atom
     (List : in out Unsafe_Atom_Lists.List;
      Context : in Meaningless_Type;
      Atom : in S_Expressions.Atom);
      --  Append a new atom to List

   procedure Add_Date
     (Map : in out Date_Maps.Unsafe_Maps.Map;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Value : in out S_Expressions.Lockable.Descriptor'Class);
      --  Append a new named date to Map

   procedure Add_Expression
     (Map : in out Expression_Maps.Unsafe_Maps.Map;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Value : in out S_Expressions.Lockable.Descriptor'Class);
      --  Insert a new node (Name -> Cache (Value)) in Map

   procedure Add_Expression_Map
     (Map : in out Expression_Map_Maps.Unsafe_Maps.Map;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Value : in out S_Expressions.Lockable.Descriptor'Class);
      --  Insert a new node (Name -> Expression_Map (Value)) in Map

   procedure Date_Reader is new S_Expressions.Interpreter_Loop
     (Date_Maps.Unsafe_Maps.Map, Meaningless_Type, Add_Date);

   procedure List_Reader is new S_Expressions.Interpreter_Loop
     (Unsafe_Atom_Lists.List, Meaningless_Type,
      Dispatch_Without_Argument => Add_Atom);

   procedure Map_Map_Reader is new S_Expressions.Interpreter_Loop
     (Expression_Map_Maps.Unsafe_Maps.Map, Meaningless_Type,
      Add_Expression_Map);

   procedure Map_Reader is new S_Expressions.Interpreter_Loop
     (Expression_Maps.Unsafe_Maps.Map, Meaningless_Type, Add_Expression);

   ------------------------------
   -- Local Helper Subprograms --
   ------------------------------

   procedure Add_Atom
     (List : in out Unsafe_Atom_Lists.List;
      Context : in Meaningless_Type;
      Atom : in S_Expressions.Atom)
   is
      pragma Unreferenced (Context);
   begin
      List.Append (Atom);
   end Add_Atom;

   procedure Add_Date
     (Map : in out Date_Maps.Unsafe_Maps.Map;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Value : in out S_Expressions.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);
      use type S_Expressions.Events.Event;
      Item : Date;
   begin
      if Value.Current_Event = S_Expressions.Events.Add_Atom then
         declare
            Image : constant String
              := S_Expressions.To_String (Value.Current_Atom);
         begin
            if Time_IO.RFC_3339.Is_Valid (Image) then
               Time_IO.RFC_3339.Value (Image, Item.Time, Item.Offset);
               Map.Include (Name, Item);
            else
               Log (Severities.Warning, "Ignoring invalid date named """
                 & S_Expressions.To_String (Name) & '"');
            end if;
         end;
      else
         Map.Exclude (Name);
      end if;
   end Add_Date;

   procedure Add_Expression
     (Map : in out Expression_Maps.Unsafe_Maps.Map;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Value : in out S_Expressions.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);
      Expression : S_Expressions.Caches.Reference;
   begin
      S_Expressions.Printers.Transfer (Value, Expression);
      Map.Include (Name, Expression.First);
   end Add_Expression;

   procedure Add_Expression_Map
     (Map : in out Expression_Map_Maps.Unsafe_Maps.Map;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Value : in out S_Expressions.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);
      Expression_Map : Expression_Maps.Constant_Map;
   begin
      if Map.Contains (Name) then
         Log (Severities.Error,
           "Duplicate name """ & S_Expressions.To_String (Name)
           & """ in expression map map");
         return;
      end if;

      Set_Expressions (Expression_Map, Value);
      Map.Insert (Name, Expression_Map);
   end Add_Expression_Map;

   --------------------
   -- Map Interfaces --
   --------------------

   procedure Set_Dates
     (Map : in out Date_Maps.Constant_Map;
      Date_List : in out S_Expressions.Lockable.Descriptor'Class)
   is
      New_Map : Date_Maps.Unsafe_Maps.Map;
   begin
      Date_Reader (Date_List, New_Map, Meaningless_Value);
      Map.Replace (New_Map);
   end Set_Dates;

   procedure Set_Expressions
     (Map : in out Expression_Maps.Constant_Map;
      Expression_List : in out S_Expressions.Lockable.Descriptor'Class)
   is
      New_Map : Expression_Maps.Unsafe_Maps.Map;
   begin
      Map_Reader (Expression_List, New_Map, Meaningless_Value);
      Map.Replace (New_Map);
   end Set_Expressions;

   procedure Set_Expression_Maps
     (Map : in out Expression_Map_Maps.Constant_Map;
      Expression_Map_List : in out S_Expressions.Lockable.Descriptor'Class)
   is
      New_Map : Expression_Map_Maps.Unsafe_Maps.Map;
   begin
      Map_Map_Reader (Expression_Map_List, New_Map, Meaningless_Value);
      Map.Replace (New_Map);
   end Set_Expression_Maps;

   ---------------------------
   -- Atom Arrays Interface --
   ---------------------------

   procedure Append_Atoms
     (Target : in out Unsafe_Atom_Lists.List;
      Expression : in out S_Expressions.Lockable.Descriptor'Class) is
   begin
      List_Reader (Expression, Target, Meaningless_Value);
   end Append_Atoms;

   function Create (Source : Unsafe_Atom_Lists.List)
     return Atom_Array_Refs.Immutable_Reference
   is
      function Create_Array return Atom_Array;

      function Create_Array return Atom_Array is
         Cursor : Unsafe_Atom_Lists.Cursor := Source.First;
         Result : Atom_Array (1 .. S_Expressions.Count (Source.Length));
      begin
         for I in Result'Range loop
            Result (I) := S_Expressions.Atom_Ref_Constructors.Create
              (Unsafe_Atom_Lists.Element (Cursor));
            Unsafe_Atom_Lists.Next (Cursor);
         end loop;

         return Result;
      end Create_Array;
   begin
      return Atom_Array_Refs.Create (Create_Array'Access);
   end Create;

   function Create
     (Expression : in out S_Expressions.Lockable.Descriptor'Class)
     return Atom_Array_Refs.Immutable_Reference
   is
      List : Unsafe_Atom_Lists.List;
   begin
      Append_Atoms (List, Expression);
      return Create (List);
   end Create;

   --------------------------
   -- Atom Table Interface --
   --------------------------

   function Create
     (Expression : in out S_Expressions.Lockable.Descriptor'Class)
     return Atom_Table_Refs.Immutable_Reference
   is
      List : Atom_Row_Lists.List;
      Event : S_Expressions.Events.Event := Expression.Current_Event;
      Lock : S_Expressions.Lockable.Lock_State;
   begin
      Read_Expression :
      loop
         case Event is
            when S_Expressions.Events.Close_List
              | S_Expressions.Events.End_Of_Input
              | S_Expressions.Events.Error
            =>
               exit Read_Expression;

            when S_Expressions.Events.Add_Atom => null;

            when S_Expressions.Events.Open_List =>
               Expression.Lock (Lock);
               begin
                  Expression.Next (Event);

                  if Event in S_Expressions.Events.Add_Atom
                            | S_Expressions.Events.Open_List
                  then
                     List.Append (Create (Expression));
                  end if;

                  Expression.Unlock (Lock);
               exception
                  when others =>
                     Expression.Unlock (Lock, False);
                     raise;
               end;
         end case;

         Expression.Next (Event);
      end loop Read_Expression;

      return Create (List);
   end Create;

   function Create
     (Row_List : in Atom_Row_Lists.List)
     return Atom_Table_Refs.Immutable_Reference is
   begin
      Build_Table :
      declare
         Data : constant Atom_Table_Refs.Data_Access
           := new Atom_Table (1 .. S_Expressions.Count
                                     (Atom_Row_Lists.Length (Row_List)));
         Ref : constant Atom_Table_Refs.Immutable_Reference
           := Atom_Table_Refs.Create (Data);
         Cursor : Atom_Row_Lists.Cursor := Atom_Row_Lists.First (Row_List);
      begin
         for I in Data.all'Range loop
            Data (I) := Atom_Row_Lists.Element (Cursor);
            Atom_Row_Lists.Next (Cursor);
         end loop;

         pragma Assert (not Atom_Row_Lists.Has_Element (Cursor));

         return Ref;
      end Build_Table;
   end Create;

end Natools.Web.Containers;

containers: create non-empty reference when the list is empty


-----------------------------------------------------------------------
--  log.tests -- Unit tests for loggers
--  Copyright (C) 2009, 2010, 2011, 2013, 2015, 2018, 2021 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.Fixed;
with Ada.Directories;
with Ada.Text_IO;
with Ada.Strings.Unbounded;

with Util.Test_Caller;

with Util.Log;
with Util.Log.Loggers;
with Util.Files;
with Util.Properties;
with Util.Measures;
package body Util.Log.Tests is

   Log : constant Loggers.Logger := Loggers.Create ("util.log.test");

   procedure Test_Log (T : in out Test) is
      pragma Unreferenced (T);

      L : Loggers.Logger := Loggers.Create ("util.log.test.debug");
   begin
      L.Set_Level (DEBUG_LEVEL);
      Log.Info ("My log message");
      Log.Error ("My error message");
      Log.Debug ("A debug message Not printed");

      L.Info ("An info message");
      L.Debug ("A debug message on logger 'L'");
   end Test_Log;

   --  Test configuration and creation of file
   procedure Test_File_Appender (T : in out Test) is
      pragma Unreferenced (T);

      Props : Util.Properties.Manager;
   begin
      Props.Set ("log4j.appender.test", "File");
      Props.Set ("log4j.appender.test.File", "test.log");
      Props.Set ("log4j.logger.util.log.test.file", "DEBUG,test");
      Util.Log.Loggers.Initialize (Props);

      declare
         L : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
      begin
         L.Debug ("Writing a debug message");
         L.Debug ("{0}: {1}", "Parameter", "Value");
      end;
   end Test_File_Appender;

   procedure Test_Log_Perf (T : in out Test) is
      pragma Unreferenced (T);

      Props : Util.Properties.Manager;
   begin
      Props.Set ("log4j.appender.test", "File");
      Props.Set ("log4j.appender.test.File", "test.log");
      Props.Set ("log4j.logger.util.log.test.perf", "DEBUG,test");
      Util.Log.Loggers.Initialize (Props);

      for I in 1 .. 1000 loop
         declare
            S : Util.Measures.Stamp;
         begin
            Util.Measures.Report (S, "Util.Measures.Report", 1000);
         end;
      end loop;

      declare
         L : Loggers.Logger := Loggers.Create ("util.log.test.perf");
         S : Util.Measures.Stamp;
      begin
         L.Set_Level (DEBUG_LEVEL);
         for I in 1 .. 1000 loop
            L.Info ("My log message: {0}: {1}", "A message",
                    "A second parameter");
         end loop;
         Util.Measures.Report (S, "Log.Info message (output)", 1000);

         L.Set_Level (INFO_LEVEL);
         for I in 1 .. 10_000 loop
            L.Debug ("My log message: {0}: {1}", "A message",
                     "A second parameter");
         end loop;
         Util.Measures.Report (S, "Log.Debug message (no output)", 10_000);
      end;
   end Test_Log_Perf;

   --  ------------------------------
   --  Test appending the log on several log files
   --  ------------------------------
   procedure Test_List_Appender (T : in out Test) is
      use Ada.Strings;
      use Ada.Directories;
      Props : Util.Properties.Manager;
   begin
      for I in 1 .. 10 loop
         declare
            Id   : constant String := Fixed.Trim (Integer'Image (I), Both);
            Name : constant String := "log4j.appender.test" & Id;
         begin
            Props.Set (Name, "File");
            Props.Set (Name & ".File", "test" & Id & ".log");
            Props.Set (Name & ".layout", "date-level-message");
            if I > 5 then
               Props.Set (Name & ".level", "INFO");
            end if;
         end;
      end loop;
      Props.Set ("log4j.rootCategory", "DEBUG, test.log");
      Props.Set ("log4j.logger.util.log.test.file",
                 "DEBUG,test4,test1 , test2,test3, test4, test5 ,  test6 , test7,test8,");
      Util.Log.Loggers.Initialize (Props);

      declare
         L : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
      begin
         L.Debug ("Writing a debug message");
         L.Debug ("{0}: {1}", "Parameter", "Value");
         L.Debug ("Done");
      end;

      --  Check that we have non empty log files (up to test8.log).
      for I in 1 .. 8 loop
         declare
            Id   : constant String := Fixed.Trim (Integer'Image (I), Both);
            Path : constant String := "test" & Id & ".log";
         begin
            T.Assert (Ada.Directories.Exists (Path), "Log file " & Path & " not found");
            if I > 5 then
               T.Assert (Ada.Directories.Size (Path) < 100, "Log file "
                         & Path & " should be empty");
            else
               T.Assert (Ada.Directories.Size (Path) > 100, "Log file " & Path & " is empty");
            end if;
         end;
      end loop;
   end Test_List_Appender;

   --  ------------------------------
   --  Test file appender with different modes.
   --  ------------------------------
   procedure Test_File_Appender_Modes (T : in out Test) is
      use Ada.Directories;

      Props : Util.Properties.Manager;
   begin
      Props.Set ("log4j.appender.test", "File");
      Props.Set ("log4j.appender.test.File", "test-append.log");
      Props.Set ("log4j.appender.test.append", "true");
      Props.Set ("log4j.appender.test.immediateFlush", "true");
      Props.Set ("log4j.appender.test_global", "File");
      Props.Set ("log4j.appender.test_global.File", "test-append-global.log");
      Props.Set ("log4j.appender.test_global.append", "false");
      Props.Set ("log4j.appender.test_global.immediateFlush", "false");
      Props.Set ("log4j.logger.util.log.test.file", "DEBUG");
      Props.Set ("log4j.rootCategory", "DEBUG,test_global,test");
      Util.Log.Loggers.Initialize (Props);

      declare
         L : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
      begin
         L.Debug ("Writing a debug message");
         L.Debug ("{0}: {1}", "Parameter", "Value");
         L.Debug ("Done");
         L.Error ("This is the error test message");
      end;

      Props.Set ("log4j.appender.test_append", "File");
      Props.Set ("log4j.appender.test_append.File", "test-append2.log");
      Props.Set ("log4j.appender.test_append.append", "true");
      Props.Set ("log4j.appender.test_append.immediateFlush", "true");
      Props.Set ("log4j.logger.util.log.test2.file", "DEBUG,test_append,test_global");
      Util.Log.Loggers.Initialize (Props);

      declare
         L1 : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
         L2 : constant Loggers.Logger := Loggers.Create ("util.log.test2.file");
      begin
         L1.Info ("L1-1 Writing a info message");
         L2.Info ("L2-2 {0}: {1}", "Parameter", "Value");
         L1.Info ("L1-3 Done");
         L2.Error ("L2-4 This is the error test2 message");
      end;

      Props.Set ("log4j.appender.test_append.append", "plop");
      Props.Set ("log4j.appender.test_append.immediateFlush", "falsex");
      Props.Set ("log4j.rootCategory", "DEBUG, test.log");
      Util.Log.Loggers.Initialize (Props);

      T.Assert (Ada.Directories.Size ("test-append.log") > 100,
                "Log file test-append.log is empty");
      T.Assert (Ada.Directories.Size ("test-append2.log") > 100,
                "Log file test-append2.log is empty");
      T.Assert (Ada.Directories.Size ("test-append-global.log") > 100,
                "Log file test-append.log is empty");
   end Test_File_Appender_Modes;

   --  ------------------------------
   --  Test file appender with different modes.
   --  ------------------------------
   procedure Test_Console_Appender (T : in out Test) is
      Props   : Util.Properties.Manager;
      File    : Ada.Text_IO.File_Type;
      Content : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Ada.Text_IO.Create (File, Ada.Text_IO.Out_File, "test_err.log");
      Ada.Text_IO.Set_Error (File);

      Props.Set ("log4j.appender.test_console", "Console");
      Props.Set ("log4j.appender.test_console.stderr", "true");
      Props.Set ("log4j.appender.test_console.level", "WARN");
      Props.Set ("log4j.rootCategory", "INFO,test_console");
      Util.Log.Loggers.Initialize (Props);

      declare
         L : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
      begin
         L.Debug ("Writing a debug message");
         L.Debug ("{0}: {1}", "Parameter", "Value");
         L.Debug ("Done");
         L.Info ("INFO MESSAGE!");
         L.Warn ("WARN MESSAGE!");
         L.Error ("This {0} {1} {2} test message", "is", "the", "error");
      end;
      Ada.Text_IO.Flush (Ada.Text_IO.Current_Error);
      Ada.Text_IO.Set_Error (Ada.Text_IO.Standard_Error);
      Ada.Text_IO.Close (File);

      Util.Files.Read_File ("test_err.log", Content);
      Util.Tests.Assert_Matches (T, ".*WARN MESSAGE!", Content,
                                 "Invalid console log (WARN)");
      Util.Tests.Assert_Matches (T, ".*This is the error test message", Content,
                                 "Invalid console log (ERROR)");
   exception
      when others =>
         Ada.Text_IO.Set_Error (Ada.Text_IO.Standard_Error);
         raise;

   end Test_Console_Appender;

   procedure Test_Missing_Config (T : in out Test) is
      L : Loggers.Logger := Loggers.Create ("util.log.test.debug");
   begin
      Util.Log.Loggers.Initialize ("plop");

      L.Info ("An info message");
      L.Debug ("A debug message on logger 'L'");
   end Test_Missing_Config;

   procedure Test_Log_Traceback (T : in out Test) is
      Props   : Util.Properties.Manager;
      Content : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Props.Set ("log4j.appender.test", "File");
      Props.Set ("log4j.appender.test.File", "test-traceback.log");
      Props.Set ("log4j.appender.test.append", "false");
      Props.Set ("log4j.appender.test.immediateFlush", "true");
      Props.Set ("log4j.rootCategory", "DEBUG,test");
      Util.Log.Loggers.Initialize (Props);

      declare
         L : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
      begin
         L.Error ("This is the error test message");
         raise Constraint_Error with "Test";

      exception
         when E : others =>
            L.Error ("Something wrong", E, True);
      end;

      Props.Set ("log4j.rootCategory", "DEBUG,console");
      Props.Set ("log4j.appender.console", "Console");
      Util.Log.Loggers.Initialize (Props);

      Util.Files.Read_File ("test-traceback.log", Content);
      Util.Tests.Assert_Matches (T, ".*Something wrong: Exception CONSTRAINT_ERROR:", Content,
                                 "Invalid console log (ERROR)");
   end Test_Log_Traceback;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Info",
                       Test_Log'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Debug",
                       Test_Log'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Set_Level",
                       Test_Log'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Error",
                       Test_Log_Traceback'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Initialize",
                       Test_Missing_Config'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Appenders.File_Appender",
                       Test_File_Appender'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Appenders.File_Appender (append)",
                       Test_File_Appender_Modes'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Appenders.List_Appender",
                       Test_List_Appender'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Appenders.Console",
                       Test_Console_Appender'Access);

      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Log (Perf)",
                       Test_Log_Perf'Access);
   end Add_Tests;

end Util.Log.Tests;

-----------------------------------------------------------------------
--  log.tests -- Unit tests for loggers
--  Copyright (C) 2009, 2010, 2011, 2013, 2015, 2018, 2021 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.Fixed;
with Ada.Directories;
with Ada.Text_IO;
with Ada.Strings.Unbounded;

with Util.Test_Caller;

with Util.Log;
with Util.Log.Loggers;
with Util.Files;
with Util.Properties;
with Util.Measures;
package body Util.Log.Tests is

   Log : constant Loggers.Logger := Loggers.Create ("util.log.test");

   procedure Test_Log (T : in out Test) is
      L : Loggers.Logger := Loggers.Create ("util.log.test.debug");
   begin
      L.Set_Level (DEBUG_LEVEL);
      Log.Info ("My log message");
      Log.Error ("My error message");
      Log.Debug ("A debug message Not printed");

      L.Info ("An info message");
      L.Debug ("A debug message on logger 'L'");
      Util.Tests.Assert_Equals (T, "DEBUG", L.Get_Level_Name,
                               "Get_Level_Name function is invalid");
   end Test_Log;

   --  Test configuration and creation of file
   procedure Test_File_Appender (T : in out Test) is
      pragma Unreferenced (T);

      Props : Util.Properties.Manager;
   begin
      Props.Set ("log4j.appender.test", "File");
      Props.Set ("log4j.appender.test.File", "test.log");
      Props.Set ("log4j.logger.util.log.test.file", "DEBUG,test");
      Util.Log.Loggers.Initialize (Props);

      declare
         L : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
      begin
         L.Debug ("Writing a debug message");
         L.Debug ("{0}: {1}", "Parameter", "Value");
      end;
   end Test_File_Appender;

   procedure Test_Log_Perf (T : in out Test) is
      pragma Unreferenced (T);

      Props : Util.Properties.Manager;
   begin
      Props.Set ("log4j.appender.test", "File");
      Props.Set ("log4j.appender.test.File", "test.log");
      Props.Set ("log4j.logger.util.log.test.perf", "DEBUG,test");
      Util.Log.Loggers.Initialize (Props);

      for I in 1 .. 1000 loop
         declare
            S : Util.Measures.Stamp;
         begin
            Util.Measures.Report (S, "Util.Measures.Report", 1000);
         end;
      end loop;

      declare
         L : Loggers.Logger := Loggers.Create ("util.log.test.perf");
         S : Util.Measures.Stamp;
      begin
         L.Set_Level (DEBUG_LEVEL);
         for I in 1 .. 1000 loop
            L.Info ("My log message: {0}: {1}", "A message",
                    "A second parameter");
         end loop;
         Util.Measures.Report (S, "Log.Info message (output)", 1000);

         L.Set_Level (INFO_LEVEL);
         for I in 1 .. 10_000 loop
            L.Debug ("My log message: {0}: {1}", "A message",
                     "A second parameter");
         end loop;
         Util.Measures.Report (S, "Log.Debug message (no output)", 10_000);
      end;
   end Test_Log_Perf;

   --  ------------------------------
   --  Test appending the log on several log files
   --  ------------------------------
   procedure Test_List_Appender (T : in out Test) is
      use Ada.Strings;
      use Ada.Directories;
      Props : Util.Properties.Manager;
   begin
      for I in 1 .. 10 loop
         declare
            Id   : constant String := Fixed.Trim (Integer'Image (I), Both);
            Name : constant String := "log4j.appender.test" & Id;
         begin
            Props.Set (Name, "File");
            Props.Set (Name & ".File", "test" & Id & ".log");
            Props.Set (Name & ".layout", "date-level-message");
            if I > 5 then
               Props.Set (Name & ".level", "INFO");
            end if;
         end;
      end loop;
      Props.Set ("log4j.rootCategory", "DEBUG, test.log");
      Props.Set ("log4j.logger.util.log.test.file",
                 "DEBUG,test4,test1 , test2,test3, test4, test5 ,  test6 , test7,test8,");
      Util.Log.Loggers.Initialize (Props);

      declare
         L : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
      begin
         L.Debug ("Writing a debug message");
         L.Debug ("{0}: {1}", "Parameter", "Value");
         L.Debug ("Done");
      end;

      --  Check that we have non empty log files (up to test8.log).
      for I in 1 .. 8 loop
         declare
            Id   : constant String := Fixed.Trim (Integer'Image (I), Both);
            Path : constant String := "test" & Id & ".log";
         begin
            T.Assert (Ada.Directories.Exists (Path), "Log file " & Path & " not found");
            if I > 5 then
               T.Assert (Ada.Directories.Size (Path) < 100, "Log file "
                         & Path & " should be empty");
            else
               T.Assert (Ada.Directories.Size (Path) > 100, "Log file " & Path & " is empty");
            end if;
         end;
      end loop;
   end Test_List_Appender;

   --  ------------------------------
   --  Test file appender with different modes.
   --  ------------------------------
   procedure Test_File_Appender_Modes (T : in out Test) is
      use Ada.Directories;

      Props : Util.Properties.Manager;
   begin
      Props.Set ("log4j.appender.test", "File");
      Props.Set ("log4j.appender.test.File", "test-append.log");
      Props.Set ("log4j.appender.test.append", "true");
      Props.Set ("log4j.appender.test.immediateFlush", "true");
      Props.Set ("log4j.appender.test_global", "File");
      Props.Set ("log4j.appender.test_global.File", "test-append-global.log");
      Props.Set ("log4j.appender.test_global.append", "false");
      Props.Set ("log4j.appender.test_global.immediateFlush", "false");
      Props.Set ("log4j.logger.util.log.test.file", "DEBUG");
      Props.Set ("log4j.rootCategory", "DEBUG,test_global,test");
      Util.Log.Loggers.Initialize (Props);

      declare
         L : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
      begin
         L.Debug ("Writing a debug message");
         L.Debug ("{0}: {1}", "Parameter", "Value");
         L.Debug ("Done");
         L.Error ("This is the error test message");
      end;

      Props.Set ("log4j.appender.test_append", "File");
      Props.Set ("log4j.appender.test_append.File", "test-append2.log");
      Props.Set ("log4j.appender.test_append.append", "true");
      Props.Set ("log4j.appender.test_append.immediateFlush", "true");
      Props.Set ("log4j.logger.util.log.test2.file", "DEBUG,test_append,test_global");
      Util.Log.Loggers.Initialize (Props);

      declare
         L1 : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
         L2 : constant Loggers.Logger := Loggers.Create ("util.log.test2.file");
      begin
         L1.Info ("L1-1 Writing a info message");
         L2.Info ("L2-2 {0}: {1}", "Parameter", "Value");
         L1.Info ("L1-3 Done");
         L2.Error ("L2-4 This is the error test2 message");
      end;

      Props.Set ("log4j.appender.test_append.append", "plop");
      Props.Set ("log4j.appender.test_append.immediateFlush", "falsex");
      Props.Set ("log4j.rootCategory", "DEBUG, test.log");
      Util.Log.Loggers.Initialize (Props);

      T.Assert (Ada.Directories.Size ("test-append.log") > 100,
                "Log file test-append.log is empty");
      T.Assert (Ada.Directories.Size ("test-append2.log") > 100,
                "Log file test-append2.log is empty");
      T.Assert (Ada.Directories.Size ("test-append-global.log") > 100,
                "Log file test-append.log is empty");
   end Test_File_Appender_Modes;

   --  ------------------------------
   --  Test file appender with different modes.
   --  ------------------------------
   procedure Test_Console_Appender (T : in out Test) is
      Props   : Util.Properties.Manager;
      File    : Ada.Text_IO.File_Type;
      Content : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Ada.Text_IO.Create (File, Ada.Text_IO.Out_File, "test_err.log");
      Ada.Text_IO.Set_Error (File);

      Props.Set ("log4j.appender.test_console", "Console");
      Props.Set ("log4j.appender.test_console.stderr", "true");
      Props.Set ("log4j.appender.test_console.level", "WARN");
      Props.Set ("log4j.rootCategory", "INFO,test_console");
      Util.Log.Loggers.Initialize (Props);

      declare
         L : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
      begin
         L.Debug ("Writing a debug message");
         L.Debug ("{0}: {1}", "Parameter", "Value");
         L.Debug ("Done");
         L.Info ("INFO MESSAGE!");
         L.Warn ("WARN MESSAGE!");
         L.Error ("This {0} {1} {2} test message", "is", "the", "error");
      end;
      Ada.Text_IO.Flush (Ada.Text_IO.Current_Error);
      Ada.Text_IO.Set_Error (Ada.Text_IO.Standard_Error);
      Ada.Text_IO.Close (File);

      Util.Files.Read_File ("test_err.log", Content);
      Util.Tests.Assert_Matches (T, ".*WARN MESSAGE!", Content,
                                 "Invalid console log (WARN)");
      Util.Tests.Assert_Matches (T, ".*This is the error test message", Content,
                                 "Invalid console log (ERROR)");
   exception
      when others =>
         Ada.Text_IO.Set_Error (Ada.Text_IO.Standard_Error);
         raise;

   end Test_Console_Appender;

   procedure Test_Missing_Config (T : in out Test) is
      L : Loggers.Logger := Loggers.Create ("util.log.test.debug");
   begin
      Util.Log.Loggers.Initialize ("plop");

      L.Info ("An info message");
      L.Debug ("A debug message on logger 'L'");
   end Test_Missing_Config;

   procedure Test_Log_Traceback (T : in out Test) is
      Props   : Util.Properties.Manager;
      Content : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Props.Set ("log4j.appender.test", "File");
      Props.Set ("log4j.appender.test.File", "test-traceback.log");
      Props.Set ("log4j.appender.test.append", "false");
      Props.Set ("log4j.appender.test.immediateFlush", "true");
      Props.Set ("log4j.rootCategory", "DEBUG,test");
      Util.Log.Loggers.Initialize (Props);

      declare
         L : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
      begin
         L.Error ("This is the error test message");
         raise Constraint_Error with "Test";

      exception
         when E : others =>
            L.Error ("Something wrong", E, True);
      end;

      Props.Set ("log4j.rootCategory", "DEBUG,console");
      Props.Set ("log4j.appender.console", "Console");
      Util.Log.Loggers.Initialize (Props);

      Util.Files.Read_File ("test-traceback.log", Content);
      Util.Tests.Assert_Matches (T, ".*Something wrong: Exception CONSTRAINT_ERROR:", Content,
                                 "Invalid console log (ERROR)");
   end Test_Log_Traceback;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Info",
                       Test_Log'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Debug",
                       Test_Log'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Set_Level",
                       Test_Log'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Error",
                       Test_Log_Traceback'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Initialize",
                       Test_Missing_Config'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Appenders.File_Appender",
                       Test_File_Appender'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Appenders.File_Appender (append)",
                       Test_File_Appender_Modes'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Appenders.List_Appender",
                       Test_List_Appender'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Appenders.Console",
                       Test_Console_Appender'Access);

      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Log (Perf)",
                       Test_Log_Perf'Access);
   end Add_Tests;

end Util.Log.Tests;

Update Test_Log to check the Get_Level_Name function


-----------------------------------------------------------------------
--  awa-storages -- Storage module
--  Copyright (C) 2012 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.
-----------------------------------------------------------------------

--  == Introduction ==
--  The <b>Storages</b> module provides a set of storage services allowing an application
--  to store data files, documents, images in a persistent area.  The persistent store can
--  be on a file system, in the database or provided by a remote service such as
--  Amazon Simple Storage Service.
--
--  == Creating a storage ==
--  A content in the storage is represented by a `Storage_Ref` instance.  The data itself
--  can be physically stored in the file system (`FILE` mode), in the database (`DATABASE`
--  mode) or on a remote server (`URL` mode).  To put a file in the storage, first create
--  the storage object instance:
--
--    Data : AWA.Storages.Models.Storage_Ref;
--
--  Then setup the storage mode that you want.  The storage service uses this information
--  to save the data in a file, in the database or in a remote service (in the future).
--
--    Data.Set_Storage (Storage => AWA.Storages.Models.DATABASE);
--
--  To save a file in the store, we can use the `Save` operation.  It will read the file
--  and put in in the corresponding persistent store (the database in this example).
--
--    Service.Save (Into => Data, Path => Path_To_The_File);
--
--  Upon successful completion, the storage instance `Data` will be allocated a unique
--  identifier that can be retrieved by `Get_Id` or `Get_Key`.
--
--  == Getting the data ==
--  Several operations are defined to retrieve the data.  Each of them has been designed
--  to optimize the retrieval and
--
--    * The data can be retrieved in a local file.
--      This mode is useful if an external program must be launched and be able to read
--      the file.  If the storage mode of the data is `FILE`, the path of the file on
--      the storage file system is used.  For other storage modes, the file is saved
--      in a temporary file.  In that case the `Store_Local` database table is used
--      to track such locally saved data.
--    * The data can be returned as a stream.
--      When the application has to read the data, opening a read stream connection is
--      the most efficient mechanism.
--
--  To access the data by using a local file, we must define a local storage reference:
--
--    Data : AWA.Storages.Models.Store_Local_Ref;
--
--  and use the `Load` operation with the storage identifier:
--
--    Service.Load (From => Id, Into => Data);
--
--  Once the load operation succeeded, the data is stored on the file system and
--  the local path is obtained by using the `Get_Path` operation:
--
--    Path : constant String := Data.Get_Path;
--
--  == Ada Beans ==
--  @include storages.xml
--
--  == Model ==
--  [http://ada-awa.googlecode.com/svn/wiki/awa_storage_model.png]
--
--  @include Storages.hbm.xml
package AWA.Storages is

end AWA.Storages;

-----------------------------------------------------------------------
--  awa-storages -- Storage module
--  Copyright (C) 2012 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.
-----------------------------------------------------------------------

--  == Introduction ==
--  The <b>Storages</b> module provides a set of storage services allowing an application
--  to store data files, documents, images in a persistent area.  The persistent store can
--  be on a file system, in the database or provided by a remote service such as
--  Amazon Simple Storage Service.
--
--  == Creating a storage ==
--  A content in the storage is represented by a `Storage_Ref` instance.  The data itself
--  can be physically stored in the file system (`FILE` mode), in the database (`DATABASE`
--  mode) or on a remote server (`URL` mode).  To put a file in the storage, first create
--  the storage object instance:
--
--    Data : AWA.Storages.Models.Storage_Ref;
--
--  Then setup the storage mode that you want.  The storage service uses this information
--  to save the data in a file, in the database or in a remote service (in the future).
--
--    Data.Set_Storage (Storage => AWA.Storages.Models.DATABASE);
--
--  To save a file in the store, we can use the `Save` operation.  It will read the file
--  and put in in the corresponding persistent store (the database in this example).
--
--    Service.Save (Into => Data, Path => Path_To_The_File);
--
--  Upon successful completion, the storage instance `Data` will be allocated a unique
--  identifier that can be retrieved by `Get_Id` or `Get_Key`.
--
--  == Getting the data ==
--  Several operations are defined to retrieve the data.  Each of them has been designed
--  to optimize the retrieval and
--
--    * The data can be retrieved in a local file.
--      This mode is useful if an external program must be launched and be able to read
--      the file.  If the storage mode of the data is `FILE`, the path of the file on
--      the storage file system is used.  For other storage modes, the file is saved
--      in a temporary file.  In that case the `Store_Local` database table is used
--      to track such locally saved data.
--
--    * The data can be returned as a stream.
--      When the application has to read the data, opening a read stream connection is
--      the most efficient mechanism.
--
--  === Local file ===
--  To access the data by using a local file, we must define a local storage reference:
--
--    Data : AWA.Storages.Models.Store_Local_Ref;
--
--  and use the `Load` operation with the storage identifier.  When loading locally we
--  also indicate whether the file will be read or written.  A file that is in `READ` mode
--  can be shared by several tasks or processes.  A file that is in `WRITE` mode will have
--  a specific copy for the caller.  An optional expiration parameter indicate when the
--  local file representation can expire.
--
--    Service.Load (From => Id, Into => Data, Mode => READ, Expire => ONE_DAY);
--
--  Once the load operation succeeded, the data is stored on the file system and
--  the local path is obtained by using the `Get_Path` operation:
--
--    Path : constant String := Data.Get_Path;
--
--  == Ada Beans ==
--  @include storages.xml
--
--  == Model ==
--  [http://ada-awa.googlecode.com/svn/wiki/awa_storage_model.png]
--
--  @include Storages.hbm.xml
package AWA.Storages is

end AWA.Storages;

Update the documentation of the storage module