-----------------------------------------------------------------------
--  util-texts-builders -- Text builder
--  Copyright (C) 2013, 2016, 2017, 2021, 2022 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Unchecked_Deallocation;

package body Util.Texts.Builders is

   --  ------------------------------
   --  Get the length of the item builder.
   --  ------------------------------
   function Length (Source : in Builder) return Natural is
   begin
      return Source.Length;
   end Length;

   --  ------------------------------
   --  Get the capacity of the builder.
   --  ------------------------------
   function Capacity (Source : in Builder) return Natural is
      B : constant Block_Access := Source.Current;
   begin
      return Source.Length + B.Len - B.Last;
   end Capacity;

   --  ------------------------------
   --  Get the builder block size.
   --  ------------------------------
   function Block_Size (Source : in Builder) return Positive is
   begin
      return Source.Block_Size;
   end Block_Size;

   --  ------------------------------
   --  Set the block size for the allocation of next chunks.
   --  ------------------------------
   procedure Set_Block_Size (Source : in out Builder;
                             Size   : in Positive) is
   begin
      Source.Block_Size := Size;
   end Set_Block_Size;

   --  ------------------------------
   --  Append the <tt>New_Item</tt> at the end of the source growing the buffer if necessary.
   --  ------------------------------
   procedure Append (Source   : in out Builder;
                     New_Item : in Input) is
      B     : Block_Access := Source.Current;
      Start : Natural := New_Item'First;
      Last  : constant Natural := New_Item'Last;
   begin
      while Start <= Last loop
         declare
            Space : Natural := B.Len - B.Last;
            Size  : constant Natural := Last - Start + 1;
         begin
            if Space > Size then
               Space := Size;
            elsif Space = 0 then
               if Size > Source.Block_Size then
                  B.Next_Block := new Block (Size);
               else
                  B.Next_Block := new Block (Source.Block_Size);
               end if;
               B := B.Next_Block;
               Source.Current := B;
               if B.Len > Size then
                  Space := Size;
               else
                  Space  := B.Len;
               end if;
            end if;
            B.Content (B.Last + 1 .. B.Last + Space) := New_Item (Start .. Start + Space - 1);
            Source.Length := Source.Length + Space;
            B.Last := B.Last + Space;
            Start  := Start + Space;
         end;
      end loop;
   end Append;

   --  ------------------------------
   --  Append the <tt>New_Item</tt> at the end of the source growing the buffer if necessary.
   --  ------------------------------
   procedure Append (Source   : in out Builder;
                     New_Item : in Element_Type) is
      B     : Block_Access := Source.Current;
   begin
      if B.Len = B.Last then
         B.Next_Block := new Block (Source.Block_Size);
         B := B.Next_Block;
         Source.Current := B;
      end if;
      Source.Length := Source.Length + 1;
      B.Last := B.Last + 1;
      B.Content (B.Last) := New_Item;
   end Append;

   procedure Inline_Append (Source   : in out Builder) is
      B     : Block_Access := Source.Current;
      Last  : Natural;
   begin
      loop
         if B.Len = B.Last then
            B.Next_Block := new Block (Source.Block_Size);
            B := B.Next_Block;
            Source.Current := B;
         end if;
         Process (B.Content (B.Last + 1 .. B.Len), Last);
         exit when Last > B.Len or Last <= B.Last;
         Source.Length := Source.Length + Last - B.Last;
         B.Last := Last;
         exit when Last < B.Len;
      end loop;
   end Inline_Append;

   --  ------------------------------
   --  Clear the source freeing any storage allocated for the buffer.
   --  ------------------------------
   procedure Clear (Source : in out Builder) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => Block, Name => Block_Access);
      Current, Next : Block_Access;
   begin
      Next := Source.First.Next_Block;
      while Next /= null loop
         Current := Next;
         Next    := Current.Next_Block;
         Free (Current);
      end loop;
      Source.First.Next_Block := null;
      Source.First.Last       := 0;
      Source.Current          := Source.First'Unchecked_Access;
      Source.Length           := 0;
   end Clear;

   --  ------------------------------
   --  Iterate over the buffer content calling the <tt>Process</tt> procedure with each
   --  chunk.
   --  ------------------------------
   procedure Iterate (Source  : in Builder;
                      Process : not null access procedure (Chunk : in Input)) is
   begin
      if Source.First.Last > 0 then
         Process (Source.First.Content (1 .. Source.First.Last));
         declare
            B : Block_Access := Source.First.Next_Block;
         begin
            while B /= null loop
               Process (B.Content (1 .. B.Last));
               B := B.Next_Block;
            end loop;
         end;
      end if;
   end Iterate;

   procedure Inline_Iterate (Source  : in Builder) is
   begin
      if Source.First.Last > 0 then
         Process (Source.First.Content (1 .. Source.First.Last));
         declare
            B : Block_Access := Source.First.Next_Block;
         begin
            while B /= null loop
               Process (B.Content (1 .. B.Last));
               B := B.Next_Block;
            end loop;
         end;
      end if;
   end Inline_Iterate;

   --  ------------------------------
   --  Return the content starting from the tail and up to <tt>Length</tt> items.
   --  ------------------------------
   function Tail (Source : in Builder;
                  Length : in Natural) return Input is
      Last : constant Natural := Source.Current.Last;
   begin
      if Last >= Length then
         return Source.Current.Content (Last - Length + 1 .. Last);
      elsif Length >= Source.Length then
         return To_Array (Source);
      else
         declare
            Result  : Input (1 .. Length);
            Offset  : Natural := Source.Length - Length;
            B       : access constant Block := Source.First'Access;
            Src_Pos : Positive := 1;
            Dst_Pos : Positive := 1;
            Len     : Natural;
         begin
            --  Skip the data moving to next blocks as needed.
            while Offset /= 0 loop
               if Offset < B.Last then
                  Src_Pos := Offset + 1;
                  Offset := 0;
               else
                  Offset := Offset - B.Last + 1;
                  B := B.Next_Block;
               end if;
            end loop;

            --  Copy what remains until we reach the length.
            while Dst_Pos <= Length loop
               Len := B.Last - Src_Pos + 1;
               Result (Dst_Pos .. Dst_Pos + Len - 1) := B.Content (Src_Pos .. B.Last);
               Src_Pos := 1;
               Dst_Pos := Dst_Pos + Len;
               B := B.Next_Block;
            end loop;
            return Result;
         end;
      end if;
   end Tail;

   --  ------------------------------
   --  Get the buffer content as an array.
   --  ------------------------------
   function To_Array (Source : in Builder) return Input is
      Result : Input (1 .. Source.Length);
   begin
      if Source.First.Last > 0 then
         declare
            Pos : Positive := Source.First.Last;
            B   : Block_Access := Source.First.Next_Block;
         begin
            Result (1 .. Pos) := Source.First.Content (1 .. Pos);
            while B /= null loop
               Result (Pos + 1 .. Pos + B.Last) := B.Content (1 .. B.Last);
               Pos := Pos + B.Last;
               B   := B.Next_Block;
            end loop;
         end;
      end if;
      return Result;
   end To_Array;

   --  ------------------------------
   --  Get the element at the given position.
   --  ------------------------------
   function Element (Source   : in Builder;
                     Position : in Positive) return Element_Type is
   begin
      if Position <= Source.First.Last then
         return Source.First.Content (Position);
      else
         declare
            Pos : Positive := Position - Source.First.Last;
            B   : Block_Access := Source.First.Next_Block;
         begin
            loop
               if Pos <= B.Last then
                  return B.Content (Pos);
               end if;
               Pos := Pos - B.Last;
               B := B.Next_Block;
            end loop;
         end;
      end if;
   end Element;

   --  ------------------------------
   --  Call the <tt>Process</tt> procedure with the full buffer content, trying to avoid
   --  secondary stack copies as much as possible.
   --  ------------------------------
   procedure Get (Source : in Builder) is
   begin
      if Source.Length < Source.First.Len then
         Process (Source.First.Content (1 .. Source.Length));
      else
         declare
            Content : constant Input := To_Array (Source);
         begin
            Process (Content);
         end;
      end if;
   end Get;

   --  ------------------------------
   --  Format the message and replace occurrences of argument patterns by
   --  their associated value.
   --  Returns the formatted message in the stream
   --  ------------------------------
   procedure Format (Into      : in out Builder;
                     Message   : in Input;
                     Arguments : in Value_List) is
      C       : Element_Type;
      Old_Pos : Natural;
      N       : Natural := 0;
      Pos     : Natural := Message'First;
      First   : Natural := Pos;
   begin
      --  Replace {N} with arg1, arg2, arg3 or ?
      while Pos <= Message'Last loop
         C := Message (Pos);
         if Element_Type'Pos (C) = Character'Pos ('{') and then Pos + 1 <= Message'Last then
            if First /= Pos then
               Append (Into, Message (First .. Pos - 1));
            end if;
            N := 0;
            Pos := Pos + 1;
            C := Message (Pos);

            --  Handle {} replacement to emit the current argument and advance argument position.
            if Element_Type'Pos (C) = Character'Pos ('}') then
               Pos := Pos + 1;
               if N >= Arguments'Length then
                  First := Pos - 2;
               else
                  Append (Into, Arguments (N + Arguments'First));
                  First := Pos;
               end if;
               N := N + 1;
            else
               N := 0;
               Old_Pos := Pos - 1;
               loop
                  if Element_Type'Pos (C) >= Character'Pos ('0')
                    and Element_Type'Pos (C) <= Character'Pos ('9')
                  then
                     N := N * 10 + Natural (Element_Type'Pos (C) - Character'Pos ('0'));
                     Pos := Pos + 1;
                     if Pos > Message'Last then
                        First := Old_Pos;
                        exit;
                     end if;
                  elsif Element_Type'Pos (C) = Character'Pos ('}') then
                     Pos := Pos + 1;
                     if N >= Arguments'Length then
                        First := Old_Pos;
                     else
                        Append (Into, Arguments (N + Arguments'First));
                        First := Pos;
                     end if;
                     exit;
                  else
                     First := Old_Pos;
                     exit;
                  end if;
                  C := Message (Pos);
               end loop;
            end if;
         else
            Pos := Pos + 1;
         end if;
      end loop;
      if First /= Pos then
         Append (Into, Message (First .. Pos - 1));
      end if;
   end Format;

   --  ------------------------------
   --  Setup the builder.
   --  ------------------------------
   overriding
   procedure Initialize (Source : in out Builder) is
   begin
      Source.Current := Source.First'Unchecked_Access;
   end Initialize;

   --  ------------------------------
   --  Finalize the builder releasing the storage.
   --  ------------------------------
   overriding
   procedure Finalize (Source : in out Builder) is
   begin
      Clear (Source);
   end Finalize;

end Util.Texts.Builders;

-----------------------------------------------------------------------
--  util-texts-builders -- Text builder
--  Copyright (C) 2013, 2016, 2017, 2021, 2022 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Unchecked_Deallocation;

package body Util.Texts.Builders is

   --  ------------------------------
   --  Get the length of the item builder.
   --  ------------------------------
   function Length (Source : in Builder) return Natural is
   begin
      return Source.Length;
   end Length;

   --  ------------------------------
   --  Get the capacity of the builder.
   --  ------------------------------
   function Capacity (Source : in Builder) return Natural is
      B : constant Block_Access := Source.Current;
   begin
      return Source.Length + B.Len - B.Last;
   end Capacity;

   --  ------------------------------
   --  Get the builder block size.
   --  ------------------------------
   function Block_Size (Source : in Builder) return Positive is
   begin
      return Source.Block_Size;
   end Block_Size;

   --  ------------------------------
   --  Set the block size for the allocation of next chunks.
   --  ------------------------------
   procedure Set_Block_Size (Source : in out Builder;
                             Size   : in Positive) is
   begin
      Source.Block_Size := Size;
   end Set_Block_Size;

   --  ------------------------------
   --  Append the <tt>New_Item</tt> at the end of the source growing the buffer if necessary.
   --  ------------------------------
   procedure Append (Source   : in out Builder;
                     New_Item : in Input) is
      B     : Block_Access := Source.Current;
      Start : Natural := New_Item'First;
      Last  : constant Natural := New_Item'Last;
   begin
      while Start <= Last loop
         declare
            Space : Natural := B.Len - B.Last;
            Size  : constant Natural := Last - Start + 1;
         begin
            if Space > Size then
               Space := Size;
            elsif Space = 0 then
               if Size > Source.Block_Size then
                  B.Next_Block := new Block (Size);
               else
                  B.Next_Block := new Block (Source.Block_Size);
               end if;
               B := B.Next_Block;
               Source.Current := B;
               if B.Len > Size then
                  Space := Size;
               else
                  Space  := B.Len;
               end if;
            end if;
            B.Content (B.Last + 1 .. B.Last + Space) := New_Item (Start .. Start + Space - 1);
            Source.Length := Source.Length + Space;
            B.Last := B.Last + Space;
            Start  := Start + Space;
         end;
      end loop;
   end Append;

   --  ------------------------------
   --  Append the <tt>New_Item</tt> at the end of the source growing the buffer if necessary.
   --  ------------------------------
   procedure Append (Source   : in out Builder;
                     New_Item : in Element_Type) is
      B     : Block_Access := Source.Current;
   begin
      if B.Len = B.Last then
         B.Next_Block := new Block (Source.Block_Size);
         B := B.Next_Block;
         Source.Current := B;
      end if;
      Source.Length := Source.Length + 1;
      B.Last := B.Last + 1;
      B.Content (B.Last) := New_Item;
   end Append;

   procedure Inline_Append (Source   : in out Builder) is
      B     : Block_Access := Source.Current;
      Last  : Natural;
   begin
      loop
         if B.Len = B.Last then
            B.Next_Block := new Block (Source.Block_Size);
            B := B.Next_Block;
            Source.Current := B;
         end if;
         Process (B.Content (B.Last + 1 .. B.Len), Last);
         exit when Last > B.Len or Last <= B.Last;
         Source.Length := Source.Length + Last - B.Last;
         B.Last := Last;
         exit when Last < B.Len;
      end loop;
   end Inline_Append;

   --  ------------------------------
   --  Clear the source freeing any storage allocated for the buffer.
   --  ------------------------------
   procedure Clear (Source : in out Builder) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => Block, Name => Block_Access);
      Current, Next : Block_Access;
   begin
      Next := Source.First.Next_Block;
      while Next /= null loop
         Current := Next;
         Next    := Current.Next_Block;
         Free (Current);
      end loop;
      Source.First.Next_Block := null;
      Source.First.Last       := 0;
      Source.Current          := Source.First'Unchecked_Access;
      Source.Length           := 0;
   end Clear;

   --  ------------------------------
   --  Iterate over the buffer content calling the <tt>Process</tt> procedure with each
   --  chunk.
   --  ------------------------------
   procedure Iterate (Source  : in Builder;
                      Process : not null access procedure (Chunk : in Input)) is
   begin
      if Source.First.Last > 0 then
         Process (Source.First.Content (1 .. Source.First.Last));
         declare
            B : Block_Access := Source.First.Next_Block;
         begin
            while B /= null loop
               Process (B.Content (1 .. B.Last));
               B := B.Next_Block;
            end loop;
         end;
      end if;
   end Iterate;

   procedure Inline_Iterate (Source  : in Builder) is
   begin
      if Source.First.Last > 0 then
         Process (Source.First.Content (1 .. Source.First.Last));
         declare
            B : Block_Access := Source.First.Next_Block;
         begin
            while B /= null loop
               Process (B.Content (1 .. B.Last));
               B := B.Next_Block;
            end loop;
         end;
      end if;
   end Inline_Iterate;

   --  ------------------------------
   --  Return the content starting from the tail and up to <tt>Length</tt> items.
   --  ------------------------------
   function Tail (Source : in Builder;
                  Length : in Natural) return Input is
      Last : constant Natural := Source.Current.Last;
   begin
      if Last >= Length then
         return Source.Current.Content (Last - Length + 1 .. Last);
      elsif Length >= Source.Length then
         return To_Array (Source);
      else
         declare
            Result  : Input (1 .. Length);
            Offset  : Natural := Source.Length - Length;
            B       : access constant Block := Source.First'Access;
            Src_Pos : Positive := 1;
            Dst_Pos : Positive := 1;
            Len     : Natural;
         begin
            --  Skip the data moving to next blocks as needed.
            while Offset /= 0 loop
               if Offset < B.Last then
                  Src_Pos := Offset + 1;
                  Offset := 0;
               else
                  Offset := Offset - B.Last + 1;
                  B := B.Next_Block;
               end if;
            end loop;

            --  Copy what remains until we reach the length.
            while Dst_Pos <= Length loop
               Len := B.Last - Src_Pos + 1;
               Result (Dst_Pos .. Dst_Pos + Len - 1) := B.Content (Src_Pos .. B.Last);
               Src_Pos := 1;
               Dst_Pos := Dst_Pos + Len;
               B := B.Next_Block;
            end loop;
            return Result;
         end;
      end if;
   end Tail;

   --  ------------------------------
   --  Get the buffer content as an array.
   --  ------------------------------
   function To_Array (Source : in Builder) return Input is
      Result : Input (1 .. Source.Length);
   begin
      if Source.First.Last > 0 then
         declare
            Pos : Positive := Source.First.Last;
            B   : Block_Access := Source.First.Next_Block;
         begin
            Result (1 .. Pos) := Source.First.Content (1 .. Pos);
            while B /= null loop
               Result (Pos + 1 .. Pos + B.Last) := B.Content (1 .. B.Last);
               Pos := Pos + B.Last;
               B   := B.Next_Block;
            end loop;
         end;
      end if;
      return Result;
   end To_Array;

   --  ------------------------------
   --  Get the element at the given position.
   --  ------------------------------
   function Element (Source   : in Builder;
                     Position : in Positive) return Element_Type is
   begin
      if Position <= Source.First.Last then
         return Source.First.Content (Position);
      else
         declare
            Pos : Positive := Position - Source.First.Last;
            B   : Block_Access := Source.First.Next_Block;
         begin
            loop
               if Pos <= B.Last then
                  return B.Content (Pos);
               end if;
               Pos := Pos - B.Last;
               B := B.Next_Block;
            end loop;
         end;
      end if;
   end Element;

   --  ------------------------------
   --  Find the position of some content by running the `Index` function.
   --  The `Index` function is called with chunks starting at the given position and
   --  until it returns a positive value or we reach the last chunk.  It must return
   --  the found position in the chunk.
   --  ------------------------------
   function Find (Source   : in Builder;
                  Position : in Positive) return Natural is
      Result : Natural;
   begin
      if Position <= Source.First.Last then
         Result := Index (Source.First.Content (Position .. Source.First.Last));
         if Result > 0 then
            return Result;
         end if;
      end if;
      declare
         Pos    : Integer := Position - Source.First.Last;
         Offset : Positive := Source.First.Last;
         B      : Block_Access := Source.First.Next_Block;
      begin
         loop
            if B = null then
               return 0;
            end if;
            if Pos <= B.Last then
               Result := Index (B.Content (1 .. B.Last));
               if Result > 0 then
                  return Offset + Result;
               end if;
            end if;
            Pos := Pos - B.Last;
            Offset := Offset + B.Last;
            B := B.Next_Block;
         end loop;
      end;
   end Find;

   --  ------------------------------
   --  Call the <tt>Process</tt> procedure with the full buffer content, trying to avoid
   --  secondary stack copies as much as possible.
   --  ------------------------------
   procedure Get (Source : in Builder) is
   begin
      if Source.Length < Source.First.Len then
         Process (Source.First.Content (1 .. Source.Length));
      else
         declare
            Content : constant Input := To_Array (Source);
         begin
            Process (Content);
         end;
      end if;
   end Get;

   --  ------------------------------
   --  Format the message and replace occurrences of argument patterns by
   --  their associated value.
   --  Returns the formatted message in the stream
   --  ------------------------------
   procedure Format (Into      : in out Builder;
                     Message   : in Input;
                     Arguments : in Value_List) is
      C       : Element_Type;
      Old_Pos : Natural;
      N       : Natural := 0;
      Pos     : Natural := Message'First;
      First   : Natural := Pos;
   begin
      --  Replace {N} with arg1, arg2, arg3 or ?
      while Pos <= Message'Last loop
         C := Message (Pos);
         if Element_Type'Pos (C) = Character'Pos ('{') and then Pos + 1 <= Message'Last then
            if First /= Pos then
               Append (Into, Message (First .. Pos - 1));
            end if;
            N := 0;
            Pos := Pos + 1;
            C := Message (Pos);

            --  Handle {} replacement to emit the current argument and advance argument position.
            if Element_Type'Pos (C) = Character'Pos ('}') then
               Pos := Pos + 1;
               if N >= Arguments'Length then
                  First := Pos - 2;
               else
                  Append (Into, Arguments (N + Arguments'First));
                  First := Pos;
               end if;
               N := N + 1;
            else
               N := 0;
               Old_Pos := Pos - 1;
               loop
                  if Element_Type'Pos (C) >= Character'Pos ('0')
                    and Element_Type'Pos (C) <= Character'Pos ('9')
                  then
                     N := N * 10 + Natural (Element_Type'Pos (C) - Character'Pos ('0'));
                     Pos := Pos + 1;
                     if Pos > Message'Last then
                        First := Old_Pos;
                        exit;
                     end if;
                  elsif Element_Type'Pos (C) = Character'Pos ('}') then
                     Pos := Pos + 1;
                     if N >= Arguments'Length then
                        First := Old_Pos;
                     else
                        Append (Into, Arguments (N + Arguments'First));
                        First := Pos;
                     end if;
                     exit;
                  else
                     First := Old_Pos;
                     exit;
                  end if;
                  C := Message (Pos);
               end loop;
            end if;
         else
            Pos := Pos + 1;
         end if;
      end loop;
      if First /= Pos then
         Append (Into, Message (First .. Pos - 1));
      end if;
   end Format;

   --  ------------------------------
   --  Setup the builder.
   --  ------------------------------
   overriding
   procedure Initialize (Source : in out Builder) is
   begin
      Source.Current := Source.First'Unchecked_Access;
   end Initialize;

   --  ------------------------------
   --  Finalize the builder releasing the storage.
   --  ------------------------------
   overriding
   procedure Finalize (Source : in out Builder) is
   begin
      Clear (Source);
   end Finalize;

end Util.Texts.Builders;

Add the generic Find function

Add the generic Find function


-----------------------------------------------------------------------
--  util-texts-builders -- Text builder
--  Copyright (C) 2013, 2016, 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Unchecked_Deallocation;

package body Util.Texts.Builders is

   --  ------------------------------
   --  Get the length of the item builder.
   --  ------------------------------
   function Length (Source : in Builder) return Natural is
   begin
      return Source.Length;
   end Length;

   --  ------------------------------
   --  Get the capacity of the builder.
   --  ------------------------------
   function Capacity (Source : in Builder) return Natural is
      B : constant Block_Access := Source.Current;
   begin
      return Source.Length + B.Len - B.Last;
   end Capacity;

   --  ------------------------------
   --  Get the builder block size.
   --  ------------------------------
   function Block_Size (Source : in Builder) return Positive is
   begin
      return Source.Block_Size;
   end Block_Size;

   --  ------------------------------
   --  Set the block size for the allocation of next chunks.
   --  ------------------------------
   procedure Set_Block_Size (Source : in out Builder;
                             Size   : in Positive) is
   begin
      Source.Block_Size := Size;
   end Set_Block_Size;

   --  ------------------------------
   --  Append the <tt>New_Item</tt> at the end of the source growing the buffer if necessary.
   --  ------------------------------
   procedure Append (Source   : in out Builder;
                     New_Item : in Input) is
      B     : Block_Access := Source.Current;
      Start : Natural := New_Item'First;
      Last  : constant Natural := New_Item'Last;
   begin
      while Start <= Last loop
         declare
            Space : Natural := B.Len - B.Last;
            Size  : constant Natural := Last - Start + 1;
         begin
            if Space > Size then
               Space := Size;
            elsif Space = 0 then
               if Size > Source.Block_Size then
                  B.Next_Block := new Block (Size);
               else
                  B.Next_Block := new Block (Source.Block_Size);
               end if;
               B := B.Next_Block;
               Source.Current := B;
               if B.Len > Size then
                  Space := Size;
               else
                  Space  := B.Len;
               end if;
            end if;
            B.Content (B.Last + 1 .. B.Last + Space) := New_Item (Start .. Start + Space - 1);
            Source.Length := Source.Length + Space;
            B.Last := B.Last + Space;
            Start  := Start + Space;
         end;
      end loop;
   end Append;

   --  ------------------------------
   --  Append the <tt>New_Item</tt> at the end of the source growing the buffer if necessary.
   --  ------------------------------
   procedure Append (Source   : in out Builder;
                     New_Item : in Element_Type) is
      B     : Block_Access := Source.Current;
   begin
      if B.Len = B.Last then
         B.Next_Block := new Block (Source.Block_Size);
         B := B.Next_Block;
         Source.Current := B;
      end if;
      Source.Length := Source.Length + 1;
      B.Last := B.Last + 1;
      B.Content (B.Last) := New_Item;
   end Append;

   --  ------------------------------
   --  Clear the source freeing any storage allocated for the buffer.
   --  ------------------------------
   procedure Clear (Source : in out Builder) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => Block, Name => Block_Access);
      Current, Next : Block_Access;
   begin
      Next := Source.First.Next_Block;
      while Next /= null loop
         Current := Next;
         Next    := Current.Next_Block;
         Free (Current);
      end loop;
      Source.First.Next_Block := null;
      Source.First.Last       := 0;
      Source.Current          := Source.First'Unchecked_Access;
      Source.Length           := 0;
   end Clear;

   --  ------------------------------
   --  Iterate over the buffer content calling the <tt>Process</tt> procedure with each
   --  chunk.
   --  ------------------------------
   procedure Iterate (Source  : in Builder;
                      Process : not null access procedure (Chunk : in Input)) is
   begin
      if Source.First.Last > 0 then
         Process (Source.First.Content (1 .. Source.First.Last));
         declare
            B : Block_Access := Source.First.Next_Block;
         begin
            while B /= null loop
               Process (B.Content (1 .. B.Last));
               B := B.Next_Block;
            end loop;
         end;
      end if;
   end Iterate;

   --  ------------------------------
   --  Return the content starting from the tail and up to <tt>Length</tt> items.
   --  ------------------------------
   function Tail (Source : in Builder;
                  Length : in Natural) return Input is
      Last : constant Natural := Source.Current.Last;
   begin
      if Last >= Length then
         return Source.Current.Content (Last - Length + 1 .. Last);
      elsif Length >= Source.Length then
         return To_Array (Source);
      else
         declare
            Result  : Input (1 .. Length);
            Offset  : Natural := Source.Length - Length;
            B       : access constant Block := Source.First'Access;
            Src_Pos : Positive := 1;
            Dst_Pos : Positive := 1;
            Len     : Natural;
         begin
            --  Skip the data moving to next blocks as needed.
            while Offset /= 0 loop
               if Offset < B.Last then
                  Src_Pos := Offset + 1;
                  Offset := 0;
               else
                  Offset := Offset - B.Last + 1;
                  B := B.Next_Block;
               end if;
            end loop;

            --  Copy what remains until we reach the length.
            while Dst_Pos <= Length loop
               Len := B.Last - Src_Pos + 1;
               Result (Dst_Pos .. Dst_Pos + Len - 1) := B.Content (Src_Pos .. B.Last);
               Src_Pos := 1;
               Dst_Pos := Dst_Pos + Len;
               B := B.Next_Block;
            end loop;
            return Result;
         end;
      end if;
   end Tail;

   --  ------------------------------
   --  Get the buffer content as an array.
   --  ------------------------------
   function To_Array (Source : in Builder) return Input is
      Result : Input (1 .. Source.Length);
   begin
      if Source.First.Last > 0 then
         declare
            Pos : Positive := Source.First.Last;
            B   : Block_Access := Source.First.Next_Block;
         begin
            Result (1 .. Pos) := Source.First.Content (1 .. Pos);
            while B /= null loop
               Result (Pos + 1 .. Pos + B.Last) := B.Content (1 .. B.Last);
               Pos := Pos + B.Last;
               B   := B.Next_Block;
            end loop;
         end;
      end if;
      return Result;
   end To_Array;

   --  ------------------------------
   --  Call the <tt>Process</tt> procedure with the full buffer content, trying to avoid
   --  secondary stack copies as much as possible.
   --  ------------------------------
   procedure Get (Source : in Builder) is
   begin
      if Source.Length < Source.First.Len then
         Process (Source.First.Content (1 .. Source.Length));
      else
         declare
            Content : constant Input := To_Array (Source);
         begin
            Process (Content);
         end;
      end if;
   end Get;

   --  ------------------------------
   --  Setup the builder.
   --  ------------------------------
   overriding
   procedure Initialize (Source : in out Builder) is
   begin
      Source.Current := Source.First'Unchecked_Access;
   end Initialize;

   --  ------------------------------
   --  Finalize the builder releasing the storage.
   --  ------------------------------
   overriding
   procedure Finalize (Source : in out Builder) is
   begin
      Clear (Source);
   end Finalize;

end Util.Texts.Builders;

-----------------------------------------------------------------------
--  util-texts-builders -- Text builder
--  Copyright (C) 2013, 2016, 2017, 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.Unchecked_Deallocation;

package body Util.Texts.Builders is

   --  ------------------------------
   --  Get the length of the item builder.
   --  ------------------------------
   function Length (Source : in Builder) return Natural is
   begin
      return Source.Length;
   end Length;

   --  ------------------------------
   --  Get the capacity of the builder.
   --  ------------------------------
   function Capacity (Source : in Builder) return Natural is
      B : constant Block_Access := Source.Current;
   begin
      return Source.Length + B.Len - B.Last;
   end Capacity;

   --  ------------------------------
   --  Get the builder block size.
   --  ------------------------------
   function Block_Size (Source : in Builder) return Positive is
   begin
      return Source.Block_Size;
   end Block_Size;

   --  ------------------------------
   --  Set the block size for the allocation of next chunks.
   --  ------------------------------
   procedure Set_Block_Size (Source : in out Builder;
                             Size   : in Positive) is
   begin
      Source.Block_Size := Size;
   end Set_Block_Size;

   --  ------------------------------
   --  Append the <tt>New_Item</tt> at the end of the source growing the buffer if necessary.
   --  ------------------------------
   procedure Append (Source   : in out Builder;
                     New_Item : in Input) is
      B     : Block_Access := Source.Current;
      Start : Natural := New_Item'First;
      Last  : constant Natural := New_Item'Last;
   begin
      while Start <= Last loop
         declare
            Space : Natural := B.Len - B.Last;
            Size  : constant Natural := Last - Start + 1;
         begin
            if Space > Size then
               Space := Size;
            elsif Space = 0 then
               if Size > Source.Block_Size then
                  B.Next_Block := new Block (Size);
               else
                  B.Next_Block := new Block (Source.Block_Size);
               end if;
               B := B.Next_Block;
               Source.Current := B;
               if B.Len > Size then
                  Space := Size;
               else
                  Space  := B.Len;
               end if;
            end if;
            B.Content (B.Last + 1 .. B.Last + Space) := New_Item (Start .. Start + Space - 1);
            Source.Length := Source.Length + Space;
            B.Last := B.Last + Space;
            Start  := Start + Space;
         end;
      end loop;
   end Append;

   --  ------------------------------
   --  Append the <tt>New_Item</tt> at the end of the source growing the buffer if necessary.
   --  ------------------------------
   procedure Append (Source   : in out Builder;
                     New_Item : in Element_Type) is
      B     : Block_Access := Source.Current;
   begin
      if B.Len = B.Last then
         B.Next_Block := new Block (Source.Block_Size);
         B := B.Next_Block;
         Source.Current := B;
      end if;
      Source.Length := Source.Length + 1;
      B.Last := B.Last + 1;
      B.Content (B.Last) := New_Item;
   end Append;

   --  ------------------------------
   --  Clear the source freeing any storage allocated for the buffer.
   --  ------------------------------
   procedure Clear (Source : in out Builder) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => Block, Name => Block_Access);
      Current, Next : Block_Access;
   begin
      Next := Source.First.Next_Block;
      while Next /= null loop
         Current := Next;
         Next    := Current.Next_Block;
         Free (Current);
      end loop;
      Source.First.Next_Block := null;
      Source.First.Last       := 0;
      Source.Current          := Source.First'Unchecked_Access;
      Source.Length           := 0;
   end Clear;

   --  ------------------------------
   --  Iterate over the buffer content calling the <tt>Process</tt> procedure with each
   --  chunk.
   --  ------------------------------
   procedure Iterate (Source  : in Builder;
                      Process : not null access procedure (Chunk : in Input)) is
   begin
      if Source.First.Last > 0 then
         Process (Source.First.Content (1 .. Source.First.Last));
         declare
            B : Block_Access := Source.First.Next_Block;
         begin
            while B /= null loop
               Process (B.Content (1 .. B.Last));
               B := B.Next_Block;
            end loop;
         end;
      end if;
   end Iterate;

   --  ------------------------------
   --  Return the content starting from the tail and up to <tt>Length</tt> items.
   --  ------------------------------
   function Tail (Source : in Builder;
                  Length : in Natural) return Input is
      Last : constant Natural := Source.Current.Last;
   begin
      if Last >= Length then
         return Source.Current.Content (Last - Length + 1 .. Last);
      elsif Length >= Source.Length then
         return To_Array (Source);
      else
         declare
            Result  : Input (1 .. Length);
            Offset  : Natural := Source.Length - Length;
            B       : access constant Block := Source.First'Access;
            Src_Pos : Positive := 1;
            Dst_Pos : Positive := 1;
            Len     : Natural;
         begin
            --  Skip the data moving to next blocks as needed.
            while Offset /= 0 loop
               if Offset < B.Last then
                  Src_Pos := Offset + 1;
                  Offset := 0;
               else
                  Offset := Offset - B.Last + 1;
                  B := B.Next_Block;
               end if;
            end loop;

            --  Copy what remains until we reach the length.
            while Dst_Pos <= Length loop
               Len := B.Last - Src_Pos + 1;
               Result (Dst_Pos .. Dst_Pos + Len - 1) := B.Content (Src_Pos .. B.Last);
               Src_Pos := 1;
               Dst_Pos := Dst_Pos + Len;
               B := B.Next_Block;
            end loop;
            return Result;
         end;
      end if;
   end Tail;

   --  ------------------------------
   --  Get the buffer content as an array.
   --  ------------------------------
   function To_Array (Source : in Builder) return Input is
      Result : Input (1 .. Source.Length);
   begin
      if Source.First.Last > 0 then
         declare
            Pos : Positive := Source.First.Last;
            B   : Block_Access := Source.First.Next_Block;
         begin
            Result (1 .. Pos) := Source.First.Content (1 .. Pos);
            while B /= null loop
               Result (Pos + 1 .. Pos + B.Last) := B.Content (1 .. B.Last);
               Pos := Pos + B.Last;
               B   := B.Next_Block;
            end loop;
         end;
      end if;
      return Result;
   end To_Array;

   --  ------------------------------
   --  Call the <tt>Process</tt> procedure with the full buffer content, trying to avoid
   --  secondary stack copies as much as possible.
   --  ------------------------------
   procedure Get (Source : in Builder) is
   begin
      if Source.Length < Source.First.Len then
         Process (Source.First.Content (1 .. Source.Length));
      else
         declare
            Content : constant Input := To_Array (Source);
         begin
            Process (Content);
         end;
      end if;
   end Get;

   --  ------------------------------
   --  Format the message and replace occurrences of argument patterns by
   --  their associated value.
   --  Returns the formatted message in the stream
   --  ------------------------------
   procedure Format (Into      : in out Builder;
                     Message   : in Input;
                     Arguments : in Value_List) is
      C       : Element_Type;
      Old_Pos : Natural;
      N       : Natural := 0;
      Pos     : Natural := Message'First;
      First   : Natural := Pos;
   begin
      --  Replace {N} with arg1, arg2, arg3 or ?
      while Pos <= Message'Last loop
         C := Message (Pos);
         if Element_Type'Pos (C) = Character'Pos ('{') and then Pos + 1 <= Message'Last then
            if First /= Pos then
               Append (Into, Message (First .. Pos - 1));
            end if;
            N := 0;
            Pos := Pos + 1;
            C := Message (Pos);

            --  Handle {} replacement to emit the current argument and advance argument position.
            if Element_Type'Pos (C) = Character'Pos ('}') then
               Pos := Pos + 1;
               if N >= Arguments'Length then
                  First := Pos - 2;
               else
                  Append (Into, Arguments (N + Arguments'First));
                  First := Pos;
               end if;
               N := N + 1;
            else
               N := 0;
               Old_Pos := Pos - 1;
               loop
                  if Element_Type'Pos (C) >= Character'Pos ('0') and Element_Type'Pos (C) <= Character'Pos ('9') then
                     N := N * 10 + Natural (Element_Type'Pos (C) - Character'Pos ('0'));
                     Pos := Pos + 1;
                     if Pos > Message'Last then
                        First := Old_Pos;
                        exit;
                     end if;
                  elsif Element_Type'Pos (C) = Character'Pos ('}') then
                     Pos := Pos + 1;
                     if N >= Arguments'Length then
                        First := Old_Pos;
                     else
                        Append (Into, Arguments (N + Arguments'First));
                        First := Pos;
                     end if;
                     exit;
                  else
                     First := Old_Pos;
                     exit;
                  end if;
                  C := Message (Pos);
               end loop;
            end if;
         else
            Pos := Pos + 1;
         end if;
      end loop;
      if First /= Pos then
         Append (Into, Message (First .. Pos - 1));
      end if;
   end Format;

   --  ------------------------------
   --  Setup the builder.
   --  ------------------------------
   overriding
   procedure Initialize (Source : in out Builder) is
   begin
      Source.Current := Source.First'Unchecked_Access;
   end Initialize;

   --  ------------------------------
   --  Finalize the builder releasing the storage.
   --  ------------------------------
   overriding
   procedure Finalize (Source : in out Builder) is
   begin
      Clear (Source);
   end Finalize;

end Util.Texts.Builders;

Implement the generic Format procedure (implementation taken from the Util.Tests.Formats package and Util.Log.Loggers.Format procedure)


-----------------------------------------------------------------------
--  awa -- Ada Web Application
--  Copyright (C) 2009, 2010, 2011, 2012, 2013 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 Util.Serialize.IO;

with ASF.Applications.Main;
with ASF.Applications.Main.Configs;
with ADO.Sessions.Factory;
with AWA.Modules;
with AWA.Events;
with AWA.Events.Services;
package AWA.Applications is

   --  Directories where the configuration files are searched.
   package P_Module_Dir is
     new ASF.Applications.Main.Configs.Parameter ("app.modules.dir",
                                                  "#{fn:composePath(app_search_dirs,'config')}");

   --  A list of configuration files separated by ';'.  These files are searched in
   --  'app.modules.dir' and loaded in the order specified.
   package P_Config_File is
     new ASF.Applications.Main.Configs.Parameter ("app.config", "awa.xml");

   --  Module manager
   --
   --  The Module_Manager represents the root of the logic manager

   type Application is new ASF.Applications.Main.Application with private;
   type Application_Access is access all Application'Class;

   --  Initialize the application
   overriding
   procedure Initialize (App     : in out Application;
                         Conf    : in ASF.Applications.Config;
                         Factory : in out ASF.Applications.Main.Application_Factory'Class);

   --  Initialize the application configuration properties.  Properties defined in Conf
   --  are expanded by using the EL expression resolver.
   overriding
   procedure Initialize_Config (App  : in out Application;
                                Conf : in out ASF.Applications.Config);

   --  Initialize the servlets provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application servlets.
   overriding
   procedure Initialize_Servlets (App : in out Application);

   --  Initialize the filters provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application filters.
   overriding
   procedure Initialize_Filters (App : in out Application);

   --  Initialize the ASF components provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the component factories used by the application.
   overriding
   procedure Initialize_Components (App : in out Application);

   --  Read the application configuration file awa.xml.  This is called after the servlets
   --  and filters have been registered in the application but before the module registration.
   procedure Load_Configuration (App : in out Application);

   --  Initialize the AWA modules provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the modules used by the application.
   procedure Initialize_Modules (App : in out Application);

   --  Start the application.  This is called by the server container when the server is started.
   overriding
   procedure Start (App : in out Application);

   --  Register the module in the application
   procedure Register (App     : in Application_Access;
                       Module  : access AWA.Modules.Module'Class;
                       Name    : in String;
                       URI     : in String := "");

   --  Get the database connection for reading
   function Get_Session (App : Application)
                         return ADO.Sessions.Session;

   --  Get the database connection for writing
   function Get_Master_Session (App : Application)
                                return ADO.Sessions.Master_Session;

   --  Register the module in the application
   procedure Register (App     : in out Application;
                       Module  : in AWA.Modules.Module_Access;
                       Name    : in String;
                       URI     : in String := "");

   --  Find the module with the given name
   function Find_Module (App  : in Application;
                         Name : in String) return AWA.Modules.Module_Access;

   --  Send the event in the application event queues.
   procedure Send_Event (App   : in Application;
                         Event : in AWA.Events.Module_Event'Class);

   --  Execute the <tt>Process</tt> procedure with the event manager used by the application.
   procedure Do_Event_Manager (App : in out Application;
                               Process : access procedure
                                 (Events : in out AWA.Events.Services.Event_Manager));

   --  Get the current application from the servlet context or service context.
   function Current return Application_Access;

private

   --  Initialize the parser represented by Parser to recognize the configuration
   --  that are specific to the plugins that have been registered so far.
   procedure Initialize_Parser (App : in out Application'Class;
                                Parser : in out Util.Serialize.IO.Parser'Class);

   type Application is new ASF.Applications.Main.Application with record
      DB_Factory : ADO.Sessions.Factory.Session_Factory;
      Modules    : aliased AWA.Modules.Module_Registry;
      Events     : aliased AWA.Events.Services.Event_Manager;
   end record;

end AWA.Applications;

-----------------------------------------------------------------------
--  awa -- Ada Web Application
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Serialize.IO;

with ASF.Applications.Main;
with ASF.Applications.Main.Configs;
with ADO.Sessions.Factory;
with AWA.Modules;
with AWA.Events;
with AWA.Events.Services;
package AWA.Applications is

   --  Directories where the configuration files are searched.
   package P_Module_Dir is
     new ASF.Applications.Main.Configs.Parameter ("app.modules.dir",
                                                  "#{fn:composePath(app_search_dirs,'config')}");

   --  A list of configuration files separated by ';'.  These files are searched in
   --  'app.modules.dir' and loaded in the order specified before the application modules.
   package P_Config_File is
     new ASF.Applications.Main.Configs.Parameter ("app.config", "awa.xml");

   --  A list of configuration files separated by ';'.  These files are searched in
   --  'app.modules.dir' and loaded in the order specified after all the application modules
   --  are initialized.
   package P_Plugin_Config_File is
     new ASF.Applications.Main.Configs.Parameter ("app.config.plugins", "");

   --  Module manager
   --
   --  The Module_Manager represents the root of the logic manager

   type Application is new ASF.Applications.Main.Application with private;
   type Application_Access is access all Application'Class;

   --  Initialize the application
   overriding
   procedure Initialize (App     : in out Application;
                         Conf    : in ASF.Applications.Config;
                         Factory : in out ASF.Applications.Main.Application_Factory'Class);

   --  Initialize the application configuration properties.  Properties defined in Conf
   --  are expanded by using the EL expression resolver.
   overriding
   procedure Initialize_Config (App  : in out Application;
                                Conf : in out ASF.Applications.Config);

   --  Initialize the servlets provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application servlets.
   overriding
   procedure Initialize_Servlets (App : in out Application);

   --  Initialize the filters provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application filters.
   overriding
   procedure Initialize_Filters (App : in out Application);

   --  Initialize the ASF components provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the component factories used by the application.
   overriding
   procedure Initialize_Components (App : in out Application);

   --  Read the application configuration file awa.xml.  This is called after the servlets
   --  and filters have been registered in the application but before the module registration.
   procedure Load_Configuration (App   : in out Application;
                                 Files : in String);

   --  Initialize the AWA modules provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the modules used by the application.
   procedure Initialize_Modules (App : in out Application);

   --  Start the application.  This is called by the server container when the server is started.
   overriding
   procedure Start (App : in out Application);

   --  Register the module in the application
   procedure Register (App     : in Application_Access;
                       Module  : access AWA.Modules.Module'Class;
                       Name    : in String;
                       URI     : in String := "");

   --  Get the database connection for reading
   function Get_Session (App : Application)
                         return ADO.Sessions.Session;

   --  Get the database connection for writing
   function Get_Master_Session (App : Application)
                                return ADO.Sessions.Master_Session;

   --  Register the module in the application
   procedure Register (App     : in out Application;
                       Module  : in AWA.Modules.Module_Access;
                       Name    : in String;
                       URI     : in String := "");

   --  Find the module with the given name
   function Find_Module (App  : in Application;
                         Name : in String) return AWA.Modules.Module_Access;

   --  Send the event in the application event queues.
   procedure Send_Event (App   : in Application;
                         Event : in AWA.Events.Module_Event'Class);

   --  Execute the <tt>Process</tt> procedure with the event manager used by the application.
   procedure Do_Event_Manager (App : in out Application;
                               Process : access procedure
                                 (Events : in out AWA.Events.Services.Event_Manager));

   --  Get the current application from the servlet context or service context.
   function Current return Application_Access;

private

   --  Initialize the parser represented by Parser to recognize the configuration
   --  that are specific to the plugins that have been registered so far.
   procedure Initialize_Parser (App : in out Application'Class;
                                Parser : in out Util.Serialize.IO.Parser'Class);

   type Application is new ASF.Applications.Main.Application with record
      DB_Factory : ADO.Sessions.Factory.Session_Factory;
      Modules    : aliased AWA.Modules.Module_Registry;
      Events     : aliased AWA.Events.Services.Event_Manager;
   end record;

end AWA.Applications;

Change Load_Configuration to allow reading a custom configuration file New configuration property to define a configuration file for plugins


-----------------------------------------------------------------------
--  ado.schemas -- Database Schemas
--  Copyright (C) 2009, 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.Strings.Unbounded;
with Ada.Finalization;
with Ada.Containers;
with Util.Strings;
package ADO.Schemas is

   type Member_Names is array (Natural range <>) of Util.Strings.Name_Access;

   type Class_Mapping (Count : Natural) is tagged record
      Table   : Util.Strings.Name_Access;
--        Name : Natural := 0;
      Members : Member_Names (1 .. Count);
   end record;

   type Class_Mapping_Access is access constant Class_Mapping'Class;

   --  Get the hash value associated with the class mapping.
   function Hash (Mapping : Class_Mapping_Access) return Ada.Containers.Hash_Type;

   --  Get the Ada type mapping for the column
   type Column_Type is
     (
      T_UNKNOWN,

      --  Boolean column
      T_BOOLEAN,

      T_TINYINT,
      T_SMALLINT,
      T_INTEGER,
      T_LONG_INTEGER,

      T_FLOAT,
      T_DOUBLE,

      T_DECIMAL,

      T_ENUM,
      T_SET,

      T_TIME,
      T_YEAR,
      T_DATE,
      T_DATE_TIME,
      T_TIMESTAMP,

      T_CHAR,
      T_VARCHAR,
      T_BLOB,

      T_NULL
     );

   --  ------------------------------
   --  Column Representation
   --  ------------------------------
   --  Describes a column in a table.
   type Column_Definition is private;

   --  Get the column name
   function Get_Name (Column : Column_Definition) return String;

   --  Get the column type
   function Get_Type (Column : Column_Definition) return Column_Type;

   --  Get the default column value
   function Get_Default (Column : Column_Definition) return String;

   --  Get the column collation (for string based columns)
   function Get_Collation (Column : Column_Definition) return String;

   --  Check whether the column can be null
   function Is_Null (Column : Column_Definition) return Boolean;

   --  Check whether the column is an unsigned number
   function Is_Unsigned (Column : Column_Definition) return Boolean;

   --  Returns true if the column can hold a binary string
   function Is_Binary (Column : Column_Definition) return Boolean;

   --  Get the column length
   function Get_Size (Column : Column_Definition) return Natural;

   --  ------------------------------
   --  Column iterator
   --  ------------------------------
   type Column_Cursor is private;

   --  Returns true if the iterator contains more column
   function Has_Element (Cursor : Column_Cursor) return Boolean;

   --  Move to the next column
   procedure Next (Cursor : in out Column_Cursor);

   --  Get the current column definition
   function Element (Cursor : Column_Cursor) return Column_Definition;

   --  ------------------------------
   --  Table Representation
   --  ------------------------------
   --  Describes a table in the database.  The table contains a list
   --  of columns described by Column_Definition.
   type Table_Definition is private;

   --  Get the table name
   function Get_Name (Table : Table_Definition) return String;

   --  Get the column iterator
   function Get_Columns (Table : Table_Definition) return Column_Cursor;

   --  Find the column having the given name
   function Find_Column (Table : Table_Definition;
                         Name  : String) return Column_Definition;

   --  ------------------------------
   --  Table iterator
   --  ------------------------------
   type Table_Cursor is private;

   --  Returns true if the iterator contains more tables
   function Has_Element (Cursor : Table_Cursor) return Boolean;

   --  Move to the next column
   procedure Next (Cursor : in out Table_Cursor);

   --  Get the current table definition
   function Element (Cursor : Table_Cursor) return Table_Definition;

   --  ------------------------------
   --  Database Schema
   --  ------------------------------

   type Schema_Definition is limited private;

   --  Find a table knowing its name
   function Find_Table (Schema : Schema_Definition;
                        Name   : String) return Table_Definition;

   function Get_Tables (Schema : Schema_Definition) return Table_Cursor;

private
   use Ada.Strings.Unbounded;

   type Column;
   type Column_Definition is access all Column;

   type Table;
   type Table_Definition is access all Table;

   type Schema;
   type Schema_Access is access all Schema;

   type Schema_Definition is new Ada.Finalization.Limited_Controlled with record
      Schema : Schema_Access;
   end record;

   procedure Finalize (Schema : in out Schema_Definition);

   type Column_Cursor is record
      Current    : Column_Definition;
   end record;

   type Table_Cursor is record
      Current    : Table_Definition;
   end record;

   type Column is record
      Next_Column : Column_Definition;
      Table       : Table_Definition;
      Name        : Unbounded_String;
      Default     : Unbounded_String;
      Collation   : Unbounded_String;
      Col_Type    : Column_Type   := T_VARCHAR;
      Size        : Natural       := 0;
      Is_Null     : Boolean       := False;
      Is_Binary   : Boolean       := False;
      Is_Unsigned : Boolean       := False;
   end record;

   type Table is record
      Name         : Unbounded_String;
      First_Column : Column_Definition;
      Next_Table   : Table_Definition;
   end record;

   type Schema is record
      --        Tables : Table_Definition;
      First_Table : Table_Definition;
   end record;

end ADO.Schemas;

-----------------------------------------------------------------------
--  ado.schemas -- Database Schemas
--  Copyright (C) 2009, 2010, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Finalization;
with Ada.Containers;
with Util.Strings;
package ADO.Schemas is

   type Member_Names is array (Natural range <>) of Util.Strings.Name_Access;

   type Class_Mapping (Count : Natural) is tagged record
      Table   : Util.Strings.Name_Access;
      Members : Member_Names (1 .. Count);
   end record;

   type Class_Mapping_Access is access constant Class_Mapping'Class;

   --  Get the hash value associated with the class mapping.
   function Hash (Mapping : Class_Mapping_Access) return Ada.Containers.Hash_Type;

   --  Get the Ada type mapping for the column
   type Column_Type is
     (
      T_UNKNOWN,

      --  Boolean column
      T_BOOLEAN,

      T_TINYINT,
      T_SMALLINT,
      T_INTEGER,
      T_LONG_INTEGER,

      T_FLOAT,
      T_DOUBLE,

      T_DECIMAL,

      T_ENUM,
      T_SET,

      T_TIME,
      T_YEAR,
      T_DATE,
      T_DATE_TIME,
      T_TIMESTAMP,

      T_CHAR,
      T_VARCHAR,
      T_BLOB,

      T_NULL
     );

   --  ------------------------------
   --  Column Representation
   --  ------------------------------
   --  Describes a column in a table.
   type Column_Definition is private;

   --  Get the column name
   function Get_Name (Column : Column_Definition) return String;

   --  Get the column type
   function Get_Type (Column : Column_Definition) return Column_Type;

   --  Get the default column value
   function Get_Default (Column : Column_Definition) return String;

   --  Get the column collation (for string based columns)
   function Get_Collation (Column : Column_Definition) return String;

   --  Check whether the column can be null
   function Is_Null (Column : Column_Definition) return Boolean;

   --  Check whether the column is an unsigned number
   function Is_Unsigned (Column : Column_Definition) return Boolean;

   --  Returns true if the column can hold a binary string
   function Is_Binary (Column : Column_Definition) return Boolean;

   --  Returns true if the column is a primary key.
   function Is_Primary (Column : Column_Definition) return Boolean;

   --  Get the column length
   function Get_Size (Column : Column_Definition) return Natural;

   --  ------------------------------
   --  Column iterator
   --  ------------------------------
   type Column_Cursor is private;

   --  Returns true if the iterator contains more column
   function Has_Element (Cursor : Column_Cursor) return Boolean;

   --  Move to the next column
   procedure Next (Cursor : in out Column_Cursor);

   --  Get the current column definition
   function Element (Cursor : Column_Cursor) return Column_Definition;

   --  ------------------------------
   --  Table Representation
   --  ------------------------------
   --  Describes a table in the database.  The table contains a list
   --  of columns described by Column_Definition.
   type Table_Definition is private;

   --  Get the table name
   function Get_Name (Table : Table_Definition) return String;

   --  Get the column iterator
   function Get_Columns (Table : Table_Definition) return Column_Cursor;

   --  Find the column having the given name
   function Find_Column (Table : Table_Definition;
                         Name  : String) return Column_Definition;

   --  ------------------------------
   --  Table iterator
   --  ------------------------------
   type Table_Cursor is private;

   --  Returns true if the iterator contains more tables
   function Has_Element (Cursor : Table_Cursor) return Boolean;

   --  Move to the next column
   procedure Next (Cursor : in out Table_Cursor);

   --  Get the current table definition
   function Element (Cursor : Table_Cursor) return Table_Definition;

   --  ------------------------------
   --  Database Schema
   --  ------------------------------

   type Schema_Definition is limited private;

   --  Find a table knowing its name
   function Find_Table (Schema : Schema_Definition;
                        Name   : String) return Table_Definition;

   function Get_Tables (Schema : Schema_Definition) return Table_Cursor;

private
   use Ada.Strings.Unbounded;

   type Column;
   type Column_Definition is access all Column;

   type Table;
   type Table_Definition is access all Table;

   type Schema;
   type Schema_Access is access all Schema;

   type Schema_Definition is new Ada.Finalization.Limited_Controlled with record
      Schema : Schema_Access;
   end record;

   procedure Finalize (Schema : in out Schema_Definition);

   type Column_Cursor is record
      Current    : Column_Definition;
   end record;

   type Table_Cursor is record
      Current    : Table_Definition;
   end record;

   type Column is record
      Next_Column : Column_Definition;
      Table       : Table_Definition;
      Name        : Unbounded_String;
      Default     : Unbounded_String;
      Collation   : Unbounded_String;
      Col_Type    : Column_Type   := T_VARCHAR;
      Size        : Natural       := 0;
      Is_Null     : Boolean       := False;
      Is_Binary   : Boolean       := False;
      Is_Unsigned : Boolean       := False;
      Is_Primary  : Boolean       := False;
   end record;

   type Table is record
      Name         : Unbounded_String;
      First_Column : Column_Definition;
      Next_Table   : Table_Definition;
   end record;

   type Schema is record
      --        Tables : Table_Definition;
      First_Table : Table_Definition;
   end record;

end ADO.Schemas;

Declare the Is_Primary function.

Declare the Is_Primary function.


-----------------------------------------------------------------------
--  mat-callbacks - Callbacks for Gtk
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Gtkada.Builder;

with MAT.Targets.Gtkmat;
package MAT.Callbacks is

   --  Initialize and register the callbacks.
   procedure Initialize (Target  : in MAT.Targets.Gtkmat.Target_Type_Access;
                         Builder : in Gtkada.Builder.Gtkada_Builder);

   --  Callback executed when the "quit" action is executed from the menu.
   procedure On_Menu_Quit (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

   --  Callback executed when the "about" action is executed from the menu.
   procedure On_Menu_About (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

   --  Callback executed when the "close-about" action is executed from the about box.
   procedure On_Close_About (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

   --  Callback executed when the "cmd-sizes" action is executed from the "Sizes" action.
   procedure On_Btn_Sizes (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

end MAT.Callbacks;

-----------------------------------------------------------------------
--  mat-callbacks - Callbacks for Gtk
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Gtkada.Builder;

with MAT.Targets.Gtkmat;
package MAT.Callbacks is

   --  Initialize and register the callbacks.
   procedure Initialize (Target  : in MAT.Targets.Gtkmat.Target_Type_Access;
                         Builder : in Gtkada.Builder.Gtkada_Builder);

   --  Callback executed when the "quit" action is executed from the menu.
   procedure On_Menu_Quit (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

   --  Callback executed when the "about" action is executed from the menu.
   procedure On_Menu_About (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

   --  Callback executed when the "close-about" action is executed from the about box.
   procedure On_Close_About (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

   --  Callback executed when the "cmd-sizes" action is executed from the "Sizes" action.
   procedure On_Btn_Sizes (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

   --  Callback executed when the "cmd-threads" action is executed from the "Threads" action.
   procedure On_Btn_Threads (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

end MAT.Callbacks;

Declare the On_Btn_Threads procedure

Declare the On_Btn_Threads procedure


-----------------------------------------------------------------------
--  gen-model-tables -- Database table model representation
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Containers.Hashed_Maps;
with Ada.Containers.Vectors;
with Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Hash;

with Util.Beans.Objects;

with Gen.Model.List;
with Gen.Model.Packages;
with Gen.Model.Mappings;
with Gen.Model.Operations;
package Gen.Model.Tables is

   use Ada.Strings.Unbounded;

   type Table_Definition;
   type Table_Definition_Access is access all Table_Definition'Class;

   --  ------------------------------
   --  Column Definition
   --  ------------------------------
   type Column_Definition is new Definition with record
      Number   : Natural := 0;
      Table    : Table_Definition_Access;
      Bean     : Util.Beans.Objects.Object;

      --  The column type name.
      Type_Name : Unbounded_String;

      --  The SQL type associated with the column.
      Sql_Type  : Unbounded_String;

      --  The SQL name associated with the column.
      Sql_Name   : Unbounded_String;

      --  The SQL length for strings.
      Sql_Length : Positive := 255;

      --  Whether the column must not be null in the database
      Not_Null : Boolean := False;

      --  Whether the column must be unique
      Unique    : Boolean := False;

      --  True if this column is the optimistic locking version column.
      Is_Version : Boolean := False;

      --  True if this column is the primary key column.
      Is_Key : Boolean := False;

      --  True if the column can be read by the application.
      Is_Readable  : Boolean := True;

      --  True if the column is included in the insert statement
      Is_Inserted  : Boolean := True;

      --  True if the column is included in the update statement
      Is_Updated   : Boolean := True;

      --  True if the Ada mapping must use the foreign key type.
      Use_Foreign_Key_Type : Boolean := False;

      --  The class generator to use for this column.
      Generator    : Util.Beans.Objects.Object;

      --  The type mapping of the column.
      Type_Mapping : Gen.Model.Mappings.Mapping_Definition_Access;
   end record;
   type Column_Definition_Access is access all Column_Definition'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : Column_Definition;
                       Name : String) return Util.Beans.Objects.Object;

   --  Prepare the generation of the model.
   overriding
   procedure Prepare (O : in out Column_Definition);

   --  Returns true if the column type is a basic type.
   function Is_Basic_Type (From : Column_Definition) return Boolean;

   --  Returns the column type.
   function Get_Type (From : Column_Definition) return String;

   --  Returns the column type mapping.
   function Get_Type_Mapping (From : in Column_Definition)
                              return Gen.Model.Mappings.Mapping_Definition_Access;

   package Column_List is new Gen.Model.List (T         => Column_Definition,
                                              T_Access  => Column_Definition_Access);

   --  ------------------------------
   --  Association Definition
   --  ------------------------------
   type Association_Definition is new Column_Definition with private;
   type Association_Definition_Access is access all Association_Definition'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : Association_Definition;
                       Name : String) return Util.Beans.Objects.Object;

   --  Prepare the generation of the model.
   overriding
   procedure Prepare (O : in out Association_Definition);

   package Operation_List is
     new Gen.Model.List (T         => Gen.Model.Operations.Operation_Definition,
                         T_Access  => Gen.Model.Operations.Operation_Definition_Access);

   package Table_Vectors is new Ada.Containers.Vectors (Index_Type   => Positive,
                                                        Element_Type => Table_Definition_Access);
   --  ------------------------------
   --  Table Definition
   --  ------------------------------
   type Table_Definition is new Mappings.Mapping_Definition with record
      Members        : aliased Column_List.List_Definition;
      Members_Bean   : Util.Beans.Objects.Object;
      Operations     : aliased Operation_List.List_Definition;
      Operations_Bean : Util.Beans.Objects.Object;
      Parent         : Table_Definition_Access;
      Parent_Name    : Unbounded_String;
      Package_Def    : Gen.Model.Packages.Package_Definition_Access;
      Type_Name      : Unbounded_String;
      Pkg_Name       : Unbounded_String;
      Table_Name     : Unbounded_String;
      Version_Column : Column_Definition_Access;
      Id_Column      : Column_Definition_Access;
      Has_Associations : Boolean := False;

      --  The list of tables that this table depends on.
      Dependencies     : Table_Vectors.Vector;

      --  Controls whether the <tt>Vector</tt> type and the <tt>List</tt> procedure must
      --  be generated.
      Has_List         : Boolean := True;

      --  Mark flag used by the dependency calculation.
      Has_Mark         : Boolean := False;

      --  Whether the bean type is a limited type or not.
      Is_Limited       : Boolean := False;
   end record;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : Table_Definition;
                       Name : String) return Util.Beans.Objects.Object;

   --  Prepare the generation of the model.
   overriding
   procedure Prepare (O : in out Table_Definition);

   --  Initialize the table definition instance.
   overriding
   procedure Initialize (O : in out Table_Definition);

   --  Collect the dependencies to other tables.
   procedure Collect_Dependencies (O : in out Table_Definition);

   type Dependency_Type is (NONE, FORWARD, BACKWARD);  -- CIRCULAR is not yet managed.

   --  Get the dependency between the two tables.
   --  Returns NONE if both table don't depend on each other.
   --  Returns FORWARD if the <tt>Left</tt> table depends on <tt>Right</tt>.
   --  Returns BACKWARD if the <tt>Right</tt> table depends on <tt>Left</tt>.
   function Depends_On (Left, Right : in Table_Definition_Access) return Dependency_Type;

   --  Create a table with the given name.
   function Create_Table (Name : in Unbounded_String) return Table_Definition_Access;

   --  Create a table column with the given name and add it to the table.
   procedure Add_Column (Table  : in out Table_Definition;
                         Name   : in Unbounded_String;
                         Column : out Column_Definition_Access);

   --  Create a table association with the given name and add it to the table.
   procedure Add_Association (Table  : in out Table_Definition;
                              Name   : in Unbounded_String;
                              Assoc  : out Association_Definition_Access);

   --  Create an operation with the given name and add it to the table.
   procedure Add_Operation (Table     : in out Table_Definition;
                            Name      : in Unbounded_String;
                            Operation : out Model.Operations.Operation_Definition_Access);

   --  Set the table name and determines the package name.
   procedure Set_Table_Name (Table : in out Table_Definition;
                             Name  : in String);

   package Table_Map is
     new Ada.Containers.Hashed_Maps (Key_Type        => Unbounded_String,
                                     Element_Type    => Table_Definition_Access,
                                     Hash            => Ada.Strings.Unbounded.Hash,
                                     Equivalent_Keys => "=");

   subtype Table_Cursor is Table_Map.Cursor;

   --  Returns true if the table cursor contains a valid table
   function Has_Element (Position : Table_Cursor) return Boolean
     renames Table_Map.Has_Element;

   --  Returns the table definition.
   function Element (Position : Table_Cursor) return Table_Definition_Access
     renames Table_Map.Element;

   --  Move the iterator to the next table definition.
   procedure Next (Position : in out Table_Cursor)
     renames Table_Map.Next;

   package Table_List is new Gen.Model.List (T        => Definition,
                                             T_Access => Definition_Access);

private

   type Association_Definition is new Column_Definition with null record;

end Gen.Model.Tables;

-----------------------------------------------------------------------
--  gen-model-tables -- Database table model representation
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014, 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 Ada.Containers.Hashed_Maps;
with Ada.Containers.Vectors;
with Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Hash;

with Util.Beans.Objects;

with Gen.Model.List;
with Gen.Model.Packages;
with Gen.Model.Mappings;
with Gen.Model.Operations;
package Gen.Model.Tables is

   use Ada.Strings.Unbounded;

   type Table_Definition;
   type Table_Definition_Access is access all Table_Definition'Class;

   --  ------------------------------
   --  Column Definition
   --  ------------------------------
   type Column_Definition is new Definition with record
      Number   : Natural := 0;
      Table    : Table_Definition_Access;
      Bean     : Util.Beans.Objects.Object;

      --  The column type name.
      Type_Name : Unbounded_String;

      --  The SQL type associated with the column.
      Sql_Type  : Unbounded_String;

      --  The SQL name associated with the column.
      Sql_Name   : Unbounded_String;

      --  The SQL length for strings.
      Sql_Length : Positive := 255;

      --  Whether the column must not be null in the database
      Not_Null : Boolean := False;

      --  Whether the column must be unique
      Unique    : Boolean := False;

      --  True if this column is the optimistic locking version column.
      Is_Version : Boolean := False;

      --  True if this column is the primary key column.
      Is_Key : Boolean := False;

      --  True if the column can be read by the application.
      Is_Readable  : Boolean := True;

      --  True if the column is included in the insert statement
      Is_Inserted  : Boolean := True;

      --  True if the column is included in the update statement
      Is_Updated   : Boolean := True;

      --  True if the column is auditable (generate code to track changes).
      Is_Auditable : Boolean := False;

      --  True if the Ada mapping must use the foreign key type.
      Use_Foreign_Key_Type : Boolean := False;

      --  The class generator to use for this column.
      Generator    : Util.Beans.Objects.Object;

      --  The type mapping of the column.
      Type_Mapping : Gen.Model.Mappings.Mapping_Definition_Access;
   end record;
   type Column_Definition_Access is access all Column_Definition'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : Column_Definition;
                       Name : String) return Util.Beans.Objects.Object;

   --  Prepare the generation of the model.
   overriding
   procedure Prepare (O : in out Column_Definition);

   --  Returns true if the column type is a basic type.
   function Is_Basic_Type (From : Column_Definition) return Boolean;

   --  Returns the column type.
   function Get_Type (From : Column_Definition) return String;

   --  Returns the column type mapping.
   function Get_Type_Mapping (From : in Column_Definition)
                              return Gen.Model.Mappings.Mapping_Definition_Access;

   package Column_List is new Gen.Model.List (T         => Column_Definition,
                                              T_Access  => Column_Definition_Access);

   --  ------------------------------
   --  Association Definition
   --  ------------------------------
   type Association_Definition is new Column_Definition with private;
   type Association_Definition_Access is access all Association_Definition'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : Association_Definition;
                       Name : String) return Util.Beans.Objects.Object;

   --  Prepare the generation of the model.
   overriding
   procedure Prepare (O : in out Association_Definition);

   package Operation_List is
     new Gen.Model.List (T         => Gen.Model.Operations.Operation_Definition,
                         T_Access  => Gen.Model.Operations.Operation_Definition_Access);

   package Table_Vectors is new Ada.Containers.Vectors (Index_Type   => Positive,
                                                        Element_Type => Table_Definition_Access);
   --  ------------------------------
   --  Table Definition
   --  ------------------------------
   type Table_Definition is new Mappings.Mapping_Definition with record
      Members        : aliased Column_List.List_Definition;
      Members_Bean   : Util.Beans.Objects.Object;
      Operations     : aliased Operation_List.List_Definition;
      Operations_Bean : Util.Beans.Objects.Object;
      Parent         : Table_Definition_Access;
      Parent_Name    : Unbounded_String;
      Package_Def    : Gen.Model.Packages.Package_Definition_Access;
      Type_Name      : Unbounded_String;
      Pkg_Name       : Unbounded_String;
      Table_Name     : Unbounded_String;
      Version_Column : Column_Definition_Access;
      Id_Column      : Column_Definition_Access;
      Has_Associations : Boolean := False;

      --  The list of tables that this table depends on.
      Dependencies     : Table_Vectors.Vector;

      --  Controls whether the <tt>Vector</tt> type and the <tt>List</tt> procedure must
      --  be generated.
      Has_List         : Boolean := True;

      --  Mark flag used by the dependency calculation.
      Has_Mark         : Boolean := False;

      --  Whether the bean type is a limited type or not.
      Is_Limited       : Boolean := False;
   end record;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : Table_Definition;
                       Name : String) return Util.Beans.Objects.Object;

   --  Prepare the generation of the model.
   overriding
   procedure Prepare (O : in out Table_Definition);

   --  Initialize the table definition instance.
   overriding
   procedure Initialize (O : in out Table_Definition);

   --  Collect the dependencies to other tables.
   procedure Collect_Dependencies (O : in out Table_Definition);

   type Dependency_Type is (NONE, FORWARD, BACKWARD);  -- CIRCULAR is not yet managed.

   --  Get the dependency between the two tables.
   --  Returns NONE if both table don't depend on each other.
   --  Returns FORWARD if the <tt>Left</tt> table depends on <tt>Right</tt>.
   --  Returns BACKWARD if the <tt>Right</tt> table depends on <tt>Left</tt>.
   function Depends_On (Left, Right : in Table_Definition_Access) return Dependency_Type;

   --  Create a table with the given name.
   function Create_Table (Name : in Unbounded_String) return Table_Definition_Access;

   --  Create a table column with the given name and add it to the table.
   procedure Add_Column (Table  : in out Table_Definition;
                         Name   : in Unbounded_String;
                         Column : out Column_Definition_Access);

   --  Create a table association with the given name and add it to the table.
   procedure Add_Association (Table  : in out Table_Definition;
                              Name   : in Unbounded_String;
                              Assoc  : out Association_Definition_Access);

   --  Create an operation with the given name and add it to the table.
   procedure Add_Operation (Table     : in out Table_Definition;
                            Name      : in Unbounded_String;
                            Operation : out Model.Operations.Operation_Definition_Access);

   --  Set the table name and determines the package name.
   procedure Set_Table_Name (Table : in out Table_Definition;
                             Name  : in String);

   package Table_Map is
     new Ada.Containers.Hashed_Maps (Key_Type        => Unbounded_String,
                                     Element_Type    => Table_Definition_Access,
                                     Hash            => Ada.Strings.Unbounded.Hash,
                                     Equivalent_Keys => "=");

   subtype Table_Cursor is Table_Map.Cursor;

   --  Returns true if the table cursor contains a valid table
   function Has_Element (Position : Table_Cursor) return Boolean
     renames Table_Map.Has_Element;

   --  Returns the table definition.
   function Element (Position : Table_Cursor) return Table_Definition_Access
     renames Table_Map.Element;

   --  Move the iterator to the next table definition.
   procedure Next (Position : in out Table_Cursor)
     renames Table_Map.Next;

   package Table_List is new Gen.Model.List (T        => Definition,
                                             T_Access => Definition_Access);

private

   type Association_Definition is new Column_Definition with null record;

end Gen.Model.Tables;

Add the Is_Auditable member to the Column_Definition type to identify the columns that need audit support (represented by the <<Auditable>> stereotype)