-----------------------------------------------------------------------
--  ado-statements-tests -- Test statements package
--  Copyright (C) 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 Util.Test_Caller;
with Util.Strings.Transforms;

with ADO.Sessions;

with Regtests.Statements.Model;
package body ADO.Statements.Tests is

   use Util.Tests;

   procedure Populate (Tst : in out Test);
   function Get_Sum (T     : in Test;
                     Table : in String) return Natural;

   --  Test the query statement Get_Xxx operation for various types.
   generic
      type T (<>) is private;
      with function Get_Value (Stmt   : in ADO.Statements.Query_Statement;
                               Column : in Natural) return T is <>;
      Name   : String;
      Column : String;
   procedure Test_Query_Get_Value_T (Tst   : in out Test);

   procedure Populate (Tst : in out Test) is
      DB    : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
   begin
      DB.Begin_Transaction;
      for I in 1 .. 10 loop
         declare
            Item : Regtests.Statements.Model.Table_Ref;
         begin
            Item.Set_Id_Value (ADO.Identifier (I * I));
            Item.Set_Int_Value (I);
            Item.Set_Bool_Value ((I mod 2) = 0);
            Item.Set_String_Value ("Item" & Integer'Image (I));
            Item.Set_Time_Value (Ada.Calendar.Clock);
            Item.Set_Entity_Value (ADO.Entity_Type (10 - I));
            Item.Save (DB);
            Tst.Assert (Item.Is_Inserted, "Item inserted in database");
         end;
      end loop;
      DB.Commit;
   end Populate;

   --  ------------------------------
   --  Test the query statement Get_Xxx operation for various types.
   --  ------------------------------
   procedure Test_Query_Get_Value_T (Tst   : in out Test) is
      Stmt : ADO.Statements.Query_Statement;
      DB   : constant ADO.Sessions.Session := Regtests.Get_Database;
   begin
      Populate (Tst);

      --  Check that Get_Value raises an exception if the statement is invalid.
      begin
         declare
            V    : T := Get_Value (Stmt, 0);
            pragma Unreferenced (V);
         begin
            Util.Tests.Fail (Tst, "No Invalid_Statement exception raised for " & Name);
         end;

      exception
         when Invalid_Statement =>
            null;
      end;

      --  Execute a query to fetch one column.
      Stmt := DB.Create_Statement ("SELECT " & Column & " FROM test_table WHERE id = 1");
      Stmt.Execute;

      --  Verify the query result and the Get_Value operation.
      Tst.Assert (Stmt.Has_Elements, "The query statement must return a value for "
                  & Name & ":" & Column);
      Tst.Assert (not Stmt.Is_Null (0), "The query statement must return a non null value for "
                  & Name & ":" & Column);
      Util.Tests.Assert_Equals (Tst, Column,
                                Util.Strings.Transforms.To_Lower_Case (Stmt.Get_Column_Name (0)),
                                "The query returns an invalid column name");
      declare
         V : T := Get_Value (Stmt, 0);
         pragma Unreferenced (V);
      begin
         Stmt.Clear;
      end;

   end Test_Query_Get_Value_T;

   procedure Test_Query_Get_Int64 is
     new Test_Query_Get_Value_T (Int64, ADO.Statements.Get_Int64, "Get_Int64", "id_value");

   procedure Test_Query_Get_Integer is
     new Test_Query_Get_Value_T (Integer, ADO.Statements.Get_Integer, "Get_Integer", "int_value");

   procedure Test_Query_Get_Nullable_Integer is
     new Test_Query_Get_Value_T (Nullable_Integer, ADO.Statements.Get_Nullable_Integer,
                                 "Get_Nullable_Integer", "int_value");

   procedure Test_Query_Get_Nullable_Entity_Type is
     new Test_Query_Get_Value_T (Nullable_Entity_Type, ADO.Statements.Get_Nullable_Entity_Type,
                                 "Get_Nullable_Entity_Type", "entity_value");

   procedure Test_Query_Get_Natural is
     new Test_Query_Get_Value_T (Natural, ADO.Statements.Get_Natural, "Get_Natural", "int_value");

   procedure Test_Query_Get_Identifier is
     new Test_Query_Get_Value_T (ADO.Identifier, ADO.Statements.Get_Identifier,
                                 "Get_Identifier", "id_value");

   procedure Test_Query_Get_Boolean is
     new Test_Query_Get_Value_T (Boolean, ADO.Statements.Get_Boolean, "Get_Boolean", "bool_value");

   procedure Test_Query_Get_String is
     new Test_Query_Get_Value_T (String, ADO.Statements.Get_String, "Get_String", "string_value");

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ADO.Statements.Save",
                       Test_Save'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Int64",
                       Test_Query_Get_Int64'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Integer",
                       Test_Query_Get_Integer'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Nullable_Integer",
                       Test_Query_Get_Nullable_Integer'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Natural",
                       Test_Query_Get_Natural'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Identifier",
                       Test_Query_Get_Identifier'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Boolean",
                       Test_Query_Get_Boolean'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_String",
                       Test_Query_Get_String'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Nullable_Entity_Type",
                       Test_Query_Get_Nullable_Entity_Type'Access);
   end Add_Tests;

   function Get_Sum (T : in Test;
                     Table : in String) return Natural is
      DB   : constant ADO.Sessions.Session := Regtests.Get_Database;
      Stmt : ADO.Statements.Query_Statement := DB.Create_Statement ("SELECT SUM(id_value) FROM "
                                                                    & Table);
   begin
      Stmt.Execute;
      T.Assert (Stmt.Has_Elements, "The query statement must return a value for table " & Table);
--        Util.Tests.Assert_Equals (T, 1, Stmt.Get_Row_Count, "The query must return one row "
--                                  & Table);
      return Stmt.Get_Integer (0);
   end Get_Sum;

   --  ------------------------------
   --  Test creation of several rows in test_table with different column type.
   --  ------------------------------
   procedure Test_Save (T : in out Test) is
      First : constant Natural := Get_Sum (T, "test_table");
      DB    : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
   begin
      DB.Begin_Transaction;
      for I in 1 .. 10 loop
         declare
            Item : Regtests.Statements.Model.Table_Ref;
         begin
            Item.Set_Id_Value (ADO.Identifier (I * I));
            Item.Set_Int_Value (I);
            Item.Set_Bool_Value ((I mod 2) = 0);
            Item.Set_String_Value ("Item" & Integer'Image (I));
            Item.Set_Time_Value (Ada.Calendar.Clock);
            Item.Set_Entity_Value (ADO.Entity_Type (10 - I));
            Item.Save (DB);
         end;
      end loop;
      DB.Commit;

      Util.Tests.Assert_Equals (T, First + 385, Get_Sum (T, "test_table"),
                                "The SUM query returns an invalid value for test_table");
   end Test_Save;

end ADO.Statements.Tests;

-----------------------------------------------------------------------
--  ado-statements-tests -- Test statements package
--  Copyright (C) 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 Util.Test_Caller;
with Util.Strings.Transforms;

with ADO.Utils;
with ADO.Sessions;

with Regtests.Statements.Model;
package body ADO.Statements.Tests is

   use Util.Tests;

   procedure Populate (Tst : in out Test);
   function Get_Sum (T     : in Test;
                     Table : in String) return Natural;

   --  Test the query statement Get_Xxx operation for various types.
   generic
      type T (<>) is private;
      with function Get_Value (Stmt   : in ADO.Statements.Query_Statement;
                               Column : in Natural) return T is <>;
      Name   : String;
      Column : String;
   procedure Test_Query_Get_Value_T (Tst   : in out Test);

   procedure Populate (Tst : in out Test) is
      DB    : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
   begin
      DB.Begin_Transaction;
      for I in 1 .. 10 loop
         declare
            Item : Regtests.Statements.Model.Table_Ref;
         begin
            Item.Set_Id_Value (ADO.Identifier (I * I));
            Item.Set_Int_Value (I);
            Item.Set_Bool_Value ((I mod 2) = 0);
            Item.Set_String_Value ("Item" & Integer'Image (I));
            Item.Set_Time_Value (Ada.Calendar.Clock);
            Item.Set_Entity_Value (ADO.Entity_Type (10 - I));
            Item.Save (DB);
            Tst.Assert (Item.Is_Inserted, "Item inserted in database");
         end;
      end loop;
      DB.Commit;
   end Populate;

   --  ------------------------------
   --  Test the query statement Get_Xxx operation for various types.
   --  ------------------------------
   procedure Test_Query_Get_Value_T (Tst   : in out Test) is
      Stmt : ADO.Statements.Query_Statement;
      DB   : constant ADO.Sessions.Session := Regtests.Get_Database;
   begin
      Populate (Tst);

      --  Check that Get_Value raises an exception if the statement is invalid.
      begin
         declare
            V    : T := Get_Value (Stmt, 0);
            pragma Unreferenced (V);
         begin
            Util.Tests.Fail (Tst, "No Invalid_Statement exception raised for " & Name);
         end;

      exception
         when Invalid_Statement =>
            null;
      end;

      --  Execute a query to fetch one column.
      Stmt := DB.Create_Statement ("SELECT " & Column & " FROM test_table WHERE id = 1");
      Stmt.Execute;

      --  Verify the query result and the Get_Value operation.
      Tst.Assert (Stmt.Has_Elements, "The query statement must return a value for "
                  & Name & ":" & Column);
      Tst.Assert (not Stmt.Is_Null (0), "The query statement must return a non null value for "
                  & Name & ":" & Column);
      Util.Tests.Assert_Equals (Tst, Column,
                                Util.Strings.Transforms.To_Lower_Case (Stmt.Get_Column_Name (0)),
                                "The query returns an invalid column name");
      declare
         V : T := Get_Value (Stmt, 0);
         pragma Unreferenced (V);
      begin
         Stmt.Clear;
      end;

   end Test_Query_Get_Value_T;

   procedure Test_Query_Get_Int64 is
     new Test_Query_Get_Value_T (Int64, ADO.Statements.Get_Int64, "Get_Int64", "id_value");

   procedure Test_Query_Get_Integer is
     new Test_Query_Get_Value_T (Integer, ADO.Statements.Get_Integer, "Get_Integer", "int_value");

   procedure Test_Query_Get_Nullable_Integer is
     new Test_Query_Get_Value_T (Nullable_Integer, ADO.Statements.Get_Nullable_Integer,
                                 "Get_Nullable_Integer", "int_value");

   procedure Test_Query_Get_Nullable_Entity_Type is
     new Test_Query_Get_Value_T (Nullable_Entity_Type, ADO.Statements.Get_Nullable_Entity_Type,
                                 "Get_Nullable_Entity_Type", "entity_value");

   procedure Test_Query_Get_Natural is
     new Test_Query_Get_Value_T (Natural, ADO.Statements.Get_Natural, "Get_Natural", "int_value");

   procedure Test_Query_Get_Identifier is
     new Test_Query_Get_Value_T (ADO.Identifier, ADO.Statements.Get_Identifier,
                                 "Get_Identifier", "id_value");

   procedure Test_Query_Get_Boolean is
     new Test_Query_Get_Value_T (Boolean, ADO.Statements.Get_Boolean, "Get_Boolean", "bool_value");

   procedure Test_Query_Get_String is
     new Test_Query_Get_Value_T (String, ADO.Statements.Get_String, "Get_String", "string_value");

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ADO.Statements.Save",
                       Test_Save'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Int64",
                       Test_Query_Get_Int64'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Integer",
                       Test_Query_Get_Integer'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Nullable_Integer",
                       Test_Query_Get_Nullable_Integer'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Natural",
                       Test_Query_Get_Natural'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Identifier",
                       Test_Query_Get_Identifier'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Boolean",
                       Test_Query_Get_Boolean'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_String",
                       Test_Query_Get_String'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Nullable_Entity_Type",
                       Test_Query_Get_Nullable_Entity_Type'Access);
   end Add_Tests;

   function Get_Sum (T : in Test;
                     Table : in String) return Natural is
      DB   : constant ADO.Sessions.Session := Regtests.Get_Database;
      Stmt : ADO.Statements.Query_Statement := DB.Create_Statement ("SELECT SUM(id_value) FROM "
                                                                    & Table);
   begin
      Stmt.Execute;
      T.Assert (Stmt.Has_Elements, "The query statement must return a value for table " & Table);
      return Stmt.Get_Integer (0);
   end Get_Sum;

   function Get_Sum (T     : in Test;
                     Table : in String;
                     Ids   : in ADO.Utils.Identifier_Vector) return Natural is
      DB   : constant ADO.Sessions.Session := Regtests.Get_Database;
      Stmt : ADO.Statements.Query_Statement := DB.Create_Statement ("SELECT SUM(id_value) FROM "
                                                                    & Table
                                                                    & " WHERE id IN (:ids)");
   begin
      Stmt.Bind_Param ("ids", Ids);
      Stmt.Execute;
      T.Assert (Stmt.Has_Elements, "The query statement must return a value for table " & Table);
      return Stmt.Get_Integer (0);
   end Get_Sum;

   --  ------------------------------
   --  Test creation of several rows in test_table with different column type.
   --  ------------------------------
   procedure Test_Save (T : in out Test) is
      First  : constant Natural := Get_Sum (T, "test_table");
      DB     : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      List   : ADO.Utils.Identifier_Vector;
   begin
      DB.Begin_Transaction;
      for I in 1 .. 10 loop
         declare
            Item : Regtests.Statements.Model.Table_Ref;
         begin
            Item.Set_Id_Value (ADO.Identifier (I * I));
            Item.Set_Int_Value (I);
            Item.Set_Bool_Value ((I mod 2) = 0);
            Item.Set_String_Value ("Item" & Integer'Image (I));
            Item.Set_Time_Value (Ada.Calendar.Clock);
            Item.Set_Entity_Value (ADO.Entity_Type (10 - I));
            Item.Save (DB);
            List.Append (Item.Get_Id);
         end;
      end loop;
      DB.Commit;

      Util.Tests.Assert_Equals (T, First + 385, Get_Sum (T, "test_table"),
                                "The SUM query returns an invalid value for test_table");
      Util.Tests.Assert_Equals (T, 385, Get_Sum (T, "test_table", List),
                                "The SUM query returns an invalid value for test_table");
   end Test_Save;

end ADO.Statements.Tests;

Update the tests to also use ADO.Utils.Identifier_Vector and verify the string conversion


-----------------------------------------------------------------------
--  babel-strategies -- Strategies to backup files
--  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 Util.Log.Loggers;
with Babel.Files;
with Babel.Files.Buffers;
with Babel.Files.Lifecycles;
with Babel.Stores;
package body Babel.Strategies is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Babel.Strategies");

   --  ------------------------------
   --  Allocate a buffer to read the file content.
   --  ------------------------------
   function Allocate_Buffer (Strategy : in Strategy_Type) return Babel.Files.Buffers.Buffer_Access is
      Result : Babel.Files.Buffers.Buffer_Access;
   begin
      Strategy.Buffers.Get_Instance (Result);
      return Result;
   end Allocate_Buffer;

   --  ------------------------------
   --  Release the buffer that was allocated by Allocate_Buffer.
   --  ------------------------------
   procedure Release_Buffer (Strategy : in Strategy_Type;
                             Buffer   : in out Babel.Files.Buffers.Buffer_Access) is
   begin
      Strategy.Buffers.Release (Buffer);
      Buffer := null;
   end Release_Buffer;

   --  ------------------------------
   --  Set the buffer pool to be used by Allocate_Buffer.
   --  ------------------------------
   procedure Set_Buffers (Strategy : in out Strategy_Type;
                          Buffers  : in Babel.Files.Buffers.Buffer_Pool_Access) is
   begin
      Strategy.Buffers := Buffers;
   end Set_Buffers;

   --  Read the file from the read store into the local buffer.
   procedure Read_File (Strategy : in Strategy_Type;
                        File     : in Babel.Files.File_Type;
                        Into     : in Babel.Files.Buffers.Buffer_Access) is
      Path : constant String := Babel.Files.Get_Path (File);
   begin
      Strategy.Read_Store.Read (Path, Into.all);
   end Read_File;

   --  Write the file from the local buffer into the write store.
   procedure Write_File (Strategy : in Strategy_Type;
                         File     : in Babel.Files.File_Type;
                         Content  : in Babel.Files.Buffers.Buffer_Access) is
      Path : constant String := Babel.Files.Get_Path (File);
   begin
      Strategy.Write_Store.Write (Path, Content.all);
   end Write_File;

   procedure Print_Sha (File : in Babel.Files.File_Type) is
      Sha : constant String := Babel.Files.Get_SHA1 (File);
   begin
      Log.Info (Babel.Files.Get_Path (File) & " => " & Sha);
   end Print_Sha;

   --  Backup the file from the local buffer into the write store.
   procedure Backup_File (Strategy : in Strategy_Type;
                          File     : in Babel.Files.File_Type;
                          Content  : in out Babel.Files.Buffers.Buffer_Access) is
   begin
      if Babel.Files.Is_New (File) then
         Babel.Files.Lifecycles.Notify_Create (Strategy.Listeners.all, File);
      else
         Babel.Files.Lifecycles.Notify_Update (Strategy.Listeners.all, File);
      end if;
      Print_Sha (File);
      Strategy.Write_File (File, Content);
      Strategy.Release_Buffer (Content);
   end Backup_File;

   --  Scan the directory
   procedure Scan (Strategy  : in out Strategy_Type;
                   Directory : in Babel.Files.Directory_Type;
                   Container : in out Babel.Files.File_Container'Class) is
      Path : constant String := Babel.Files.Get_Path (Directory);
   begin
      Strategy.Read_Store.Scan (Path, Container, Strategy.Filters.all);
   end Scan;

   --  ------------------------------
   --  Scan the directories which are defined in the directory queue and
   --  use the file container to scan the files and directories.
   --  ------------------------------
   procedure Scan (Strategy  : in out Strategy_Type;
                   Queue     : in out Babel.Files.Queues.Directory_Queue;
                   Container : in out Babel.Files.File_Container'Class) is

      procedure Append_Directory (Directory : in Babel.Files.Directory_Type) is
      begin
         Babel.Files.Queues.Add_Directory (Queue, Directory);
      end Append_Directory;

      Dir : Babel.Files.Directory_Type;
   begin
      while Babel.Files.Queues.Has_Directory (Queue) loop
         Babel.Files.Queues.Peek_Directory (Queue, Dir);
         Container.Set_Directory (Dir);
         Strategy_Type'Class (Strategy).Scan (Dir, Container);
         Container.Each_Directory (Append_Directory'Access);
      end loop;
   end Scan;

   --  ------------------------------
   --  Set the file filters that will be used when scanning the read store.
   --  ------------------------------
   procedure Set_Filters (Strategy : in out Strategy_Type;
                          Filters  : in Babel.Filters.Filter_Type_Access) is
   begin
      Strategy.Filters := Filters;
   end Set_Filters;

   --  ------------------------------
   --  Set the read and write stores that the strategy will use.
   --  ------------------------------
   procedure Set_Stores (Strategy : in out Strategy_Type;
                         Read     : in Babel.Stores.Store_Type_Access;
                         Write    : in Babel.Stores.Store_Type_Access) is
   begin
      Strategy.Read_Store  := Read;
      Strategy.Write_Store := Write;
   end Set_Stores;

   --  ------------------------------
   --  Set the listeners to inform about changes.
   --  ------------------------------
   procedure Set_Listeners (Strategy  : in out Strategy_Type;
                            Listeners : access Util.Listeners.List) is
   begin
      Strategy.Listeners := Listeners;
   end Set_Listeners;

   --  ------------------------------
   --  Set the database for use by the strategy.
   --  ------------------------------
   procedure Set_Database (Strategy : in out Strategy_Type;
                           Database : in Babel.Base.Database_Access) is
   begin
      Strategy.Database := Database;
   end Set_Database;

end Babel.Strategies;

-----------------------------------------------------------------------
--  babel-strategies -- Strategies to backup files
--  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 Util.Log.Loggers;
with Babel.Files;
with Babel.Files.Buffers;
with Babel.Files.Lifecycles;
with Babel.Stores;
package body Babel.Strategies is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Babel.Strategies");

   --  ------------------------------
   --  Allocate a buffer to read the file content.
   --  ------------------------------
   function Allocate_Buffer (Strategy : in Strategy_Type) return Babel.Files.Buffers.Buffer_Access is
      Result : Babel.Files.Buffers.Buffer_Access;
   begin
      Strategy.Buffers.Get_Instance (Result);
      return Result;
   end Allocate_Buffer;

   --  ------------------------------
   --  Release the buffer that was allocated by Allocate_Buffer.
   --  ------------------------------
   procedure Release_Buffer (Strategy : in Strategy_Type;
                             Buffer   : in out Babel.Files.Buffers.Buffer_Access) is
   begin
      Strategy.Buffers.Release (Buffer);
      Buffer := null;
   end Release_Buffer;

   --  ------------------------------
   --  Set the buffer pool to be used by Allocate_Buffer.
   --  ------------------------------
   procedure Set_Buffers (Strategy : in out Strategy_Type;
                          Buffers  : in Babel.Files.Buffers.Buffer_Pool_Access) is
   begin
      Strategy.Buffers := Buffers;
   end Set_Buffers;

   --  Read the file from the read store into the local buffer.
   procedure Read_File (Strategy : in Strategy_Type;
                        File     : in Babel.Files.File_Type;
                        Into     : in Babel.Files.Buffers.Buffer_Access) is
      Path : constant String := Babel.Files.Get_Path (File);
   begin
      Strategy.Read_Store.Read (Path, Into.all);
   end Read_File;

   --  Write the file from the local buffer into the write store.
   procedure Write_File (Strategy : in Strategy_Type;
                         File     : in Babel.Files.File_Type;
                         Content  : in Babel.Files.Buffers.Buffer_Access) is
      Path : constant String := Babel.Files.Get_Path (File);
   begin
      Strategy.Write_Store.Write (Path, Content.all);
   end Write_File;

   procedure Print_Sha (File : in Babel.Files.File_Type) is
      Sha : constant String := Babel.Files.Get_SHA1 (File);
   begin
      Log.Info (Babel.Files.Get_Path (File) & " => " & Sha);
   end Print_Sha;

   --  Backup the file from the local buffer into the write store.
   procedure Backup_File (Strategy : in Strategy_Type;
                          File     : in Babel.Files.File_Type;
                          Content  : in out Babel.Files.Buffers.Buffer_Access) is
   begin
      Strategy.Database.Insert (File);
      if Strategy.Listeners /= null then
         if Babel.Files.Is_New (File) then
            Babel.Files.Lifecycles.Notify_Create (Strategy.Listeners.all, File);
         else
            Babel.Files.Lifecycles.Notify_Update (Strategy.Listeners.all, File);
         end if;
      end if;
      Print_Sha (File);
      Strategy.Write_File (File, Content);
      Strategy.Release_Buffer (Content);
   end Backup_File;

   --  Scan the directory
   procedure Scan (Strategy  : in out Strategy_Type;
                   Directory : in Babel.Files.Directory_Type;
                   Container : in out Babel.Files.File_Container'Class) is
      Path : constant String := Babel.Files.Get_Path (Directory);
   begin
      Strategy.Read_Store.Scan (Path, Container, Strategy.Filters.all);
   end Scan;

   --  ------------------------------
   --  Scan the directories which are defined in the directory queue and
   --  use the file container to scan the files and directories.
   --  ------------------------------
   procedure Scan (Strategy  : in out Strategy_Type;
                   Queue     : in out Babel.Files.Queues.Directory_Queue;
                   Container : in out Babel.Files.File_Container'Class) is

      procedure Append_Directory (Directory : in Babel.Files.Directory_Type) is
      begin
         Babel.Files.Queues.Add_Directory (Queue, Directory);
      end Append_Directory;

      Dir : Babel.Files.Directory_Type;
   begin
      while Babel.Files.Queues.Has_Directory (Queue) loop
         Babel.Files.Queues.Peek_Directory (Queue, Dir);
         Container.Set_Directory (Dir);
         Strategy_Type'Class (Strategy).Scan (Dir, Container);
         Container.Each_Directory (Append_Directory'Access);
      end loop;
   end Scan;

   --  ------------------------------
   --  Set the file filters that will be used when scanning the read store.
   --  ------------------------------
   procedure Set_Filters (Strategy : in out Strategy_Type;
                          Filters  : in Babel.Filters.Filter_Type_Access) is
   begin
      Strategy.Filters := Filters;
   end Set_Filters;

   --  ------------------------------
   --  Set the read and write stores that the strategy will use.
   --  ------------------------------
   procedure Set_Stores (Strategy : in out Strategy_Type;
                         Read     : in Babel.Stores.Store_Type_Access;
                         Write    : in Babel.Stores.Store_Type_Access) is
   begin
      Strategy.Read_Store  := Read;
      Strategy.Write_Store := Write;
   end Set_Stores;

   --  ------------------------------
   --  Set the listeners to inform about changes.
   --  ------------------------------
   procedure Set_Listeners (Strategy  : in out Strategy_Type;
                            Listeners : access Util.Listeners.List) is
   begin
      Strategy.Listeners := Listeners;
   end Set_Listeners;

   --  ------------------------------
   --  Set the database for use by the strategy.
   --  ------------------------------
   procedure Set_Database (Strategy : in out Strategy_Type;
                           Database : in Babel.Base.Database_Access) is
   begin
      Strategy.Database := Database;
   end Set_Database;

end Babel.Strategies;

Insert the file in the database when the backup is proceeding


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

--  with Ada.Finalization;

with ADO.Databases;
with ADO.Schemas.Entities;
with ADO.Sequences;

--  The <b>ADO.Sessions.Factory</b> package defines the factory for creating
--  sessions.
package ADO.Sessions.Factory is

   pragma Elaborate_Body;

   --  ------------------------------
   --  Session factory
   --  ------------------------------
   type Session_Factory is tagged limited private;
   type Session_Factory_Access is access all Session_Factory'Class;

   --  Get a read-only session from the factory.
   function Get_Session (Factory : in Session_Factory) return Session;

   --  Get a read-write session from the factory.
   function Get_Master_Session (Factory : in Session_Factory) return Master_Session;

   --  Open a session
   procedure Open_Session (Factory : in out Session_Factory;
                           Database : out Session);

   --  Open a session
   procedure Open_Session (Factory : in Session_Factory;
                           Database : out Master_Session);

   --  Create the session factory to connect to the database represented
   --  by the data source.
   procedure Create (Factory : out Session_Factory;
                     Source  : in ADO.Databases.DataSource);

   --  Create the session factory to connect to the database identified
   --  by the URI.
   procedure Create (Factory : out Session_Factory;
                     URI     : in String);

   --  Get a read-only session from the session proxy.
   --  If the session has been invalidated, raise the SESSION_EXPIRED exception.
   function Get_Session (Proxy : in Session_Proxy_Access) return Session;

   function Get_Session (Proxy : in Session_Record_Access) return Session;
private

   --  The session factory holds the necessary information to obtain a master or slave
   --  database connection.  The sequence factory is shared by all sessions of the same
   --  factory (implementation is thread-safe).  The factory also contains the entity type
   --  cache which is initialized when the factory is created.
   type Session_Factory is tagged limited record --  new Ada.Finalization.Limited_Controlled with record
      Source       : ADO.Databases.DataSource;
      Sequences    : Factory_Access := null;
      Seq_Factory  : aliased ADO.Sequences.Factory;
      Entity_Cache : aliased ADO.Schemas.Entities.Entity_Cache;
      Entities     : ADO.Sessions.Entity_Cache_Access := null;
   end record;

   --  Initialize the sequence factory associated with the session factory.
   procedure Initialize_Sequences (Factory : in out Session_Factory);

end ADO.Sessions.Factory;

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

with ADO.Databases;
with ADO.Schemas.Entities;
with ADO.Sequences;

--  The <b>ADO.Sessions.Factory</b> package defines the factory for creating
--  sessions.
package ADO.Sessions.Factory is

   pragma Elaborate_Body;

   --  ------------------------------
   --  Session factory
   --  ------------------------------
   type Session_Factory is tagged limited private;
   type Session_Factory_Access is access all Session_Factory'Class;

   --  Get a read-only session from the factory.
   function Get_Session (Factory : in Session_Factory) return Session;

   --  Get a read-write session from the factory.
   function Get_Master_Session (Factory : in Session_Factory) return Master_Session;

   --  Open a session
   procedure Open_Session (Factory : in out Session_Factory;
                           Database : out Session);

   --  Open a session
   procedure Open_Session (Factory : in Session_Factory;
                           Database : out Master_Session);

   --  Create the session factory to connect to the database represented
   --  by the data source.
   procedure Create (Factory : out Session_Factory;
                     Source  : in ADO.Databases.DataSource);

   --  Create the session factory to connect to the database identified
   --  by the URI.
   procedure Create (Factory : out Session_Factory;
                     URI     : in String);

   --  Get a read-only session from the session proxy.
   --  If the session has been invalidated, raise the SESSION_EXPIRED exception.
   function Get_Session (Proxy : in Session_Proxy_Access) return Session;

   function Get_Session (Proxy : in Session_Record_Access) return Session;
private

   --  The session factory holds the necessary information to obtain a master or slave
   --  database connection.  The sequence factory is shared by all sessions of the same
   --  factory (implementation is thread-safe).  The factory also contains the entity type
   --  cache which is initialized when the factory is created.
   type Session_Factory is tagged limited record
      Source       : ADO.Databases.DataSource;
      Sequences    : Factory_Access := null;
      Seq_Factory  : aliased ADO.Sequences.Factory;
      Entity_Cache : aliased ADO.Schemas.Entities.Entity_Cache;
      Entities     : ADO.Sessions.Entity_Cache_Access := null;
   end record;

   --  Initialize the sequence factory associated with the session factory.
   procedure Initialize_Sequences (Factory : in out Session_Factory);

end ADO.Sessions.Factory;

Fix compilation warning

Fix compilation warning


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

--  The <b>ASF.Responses</b> package is an Ada implementation of
--  the Java servlet response (JSR 315 5. The Response).
package body ASF.Responses.Mockup is

   --  ------------------------------
   --  Adds the specified cookie to the response. This method can be called multiple
   --  times to set more than one cookie.
   --  ------------------------------
   procedure Add_Cookie (Resp : in out Response;
                         Cookie : in String) is
   begin
      null;
   end Add_Cookie;

   --  ------------------------------
   --  Returns a boolean indicating whether the named response header has already
   --  been set.
   --  ------------------------------
   function Contains_Header (Resp : in Response;
                             Name : in String) return Boolean is
      Pos : constant Util.Strings.Maps.Cursor := Resp.Headers.Find (Name);
   begin
      return Util.Strings.Maps.Has_Element (Pos);
   end Contains_Header;

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

   --  ------------------------------
   --  Adds a response header with the given name and value.
   --  This method allows response headers to have multiple values.
   --  ------------------------------
   procedure Add_Header (Resp  : in out Response;
                         Name  : in String;
                         Value : in String) is
   begin
      Resp.Headers.Insert (Name, Value);
   end Add_Header;

   --  ------------------------------
   --  Get the content written to the mockup output stream.
   --  ------------------------------
   procedure Read_Content (Resp : in out Response;
                           Into : out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Resp.Content.Read (Into => Into);
   end Read_Content;

   --  ------------------------------
   --  Initialize the response mockup output stream.
   --  ------------------------------
   overriding
   procedure Initialize (Resp : in out Response) is
   begin
      Resp.Content.Initialize (8192);
      Resp.Stream := Resp.Content'Unchecked_Access;
   end Initialize;

end ASF.Responses.Mockup;

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

--  The <b>ASF.Responses</b> package is an Ada implementation of
--  the Java servlet response (JSR 315 5. The Response).
package body ASF.Responses.Mockup is

   --  ------------------------------
   --  Adds the specified cookie to the response. This method can be called multiple
   --  times to set more than one cookie.
   --  ------------------------------
   procedure Add_Cookie (Resp : in out Response;
                         Cookie : in String) is
   begin
      null;
   end Add_Cookie;

   --  ------------------------------
   --  Returns a boolean indicating whether the named response header has already
   --  been set.
   --  ------------------------------
   function Contains_Header (Resp : in Response;
                             Name : in String) return Boolean is
      Pos : constant Util.Strings.Maps.Cursor := Resp.Headers.Find (Name);
   begin
      return Util.Strings.Maps.Has_Element (Pos);
   end Contains_Header;

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

   --  ------------------------------
   --  Adds a response header with the given name and value.
   --  This method allows response headers to have multiple values.
   --  ------------------------------
   procedure Add_Header (Resp  : in out Response;
                         Name  : in String;
                         Value : in String) is
   begin
      Resp.Headers.Insert (Name, Value);
   end Add_Header;

   --  ------------------------------
   --  Get the content written to the mockup output stream.
   --  ------------------------------
   procedure Read_Content (Resp : in out Response;
                           Into : out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Resp.Content.Read (Into => Into);
   end Read_Content;

   --  ------------------------------
   --  Initialize the response mockup output stream.
   --  ------------------------------
   overriding
   procedure Initialize (Resp : in out Response) is
   begin
      Resp.Content.Initialize (128 * 1024);
      Resp.Stream := Resp.Content'Unchecked_Access;
   end Initialize;

end ASF.Responses.Mockup;

Increase the response buffer for the mockup response


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

package body ASF.Servlets.Mappers is

   --  ------------------------------
   --  Save in the servlet config object the value associated with the given field.
   --  When the FILTER_MAPPING, SERVLET_MAPPING or CONTEXT_PARAM field
   --  is reached, insert the new configuration rule in the servlet registry.
   --  ------------------------------
   procedure Set_Member (N     : in out Servlet_Config;
                         Field : in Servlet_Fields;
                         Value : in Util.Beans.Objects.Object) is
      use Util.Beans.Objects;
      use type Ada.Containers.Count_Type;

      procedure Add_Filter (Pattern : in Util.Beans.Objects.Object);
      procedure Add_Mapping (Pattern : in Util.Beans.Objects.Object);
      procedure Add_Mapping (Handler : access procedure (Pattern : in Util.Beans.Objects.Object);
                             Message : in String);

      procedure Add_Filter (Pattern : in Util.Beans.Objects.Object) is
      begin
         N.Handler.Add_Filter_Mapping (Pattern => To_String (Pattern),
                                       Name    => To_String (N.Filter_Name));
      end Add_Filter;

      procedure Add_Mapping (Pattern : in Util.Beans.Objects.Object) is
      begin
         N.Handler.Add_Mapping (Pattern => To_String (Pattern),
                                Name    => To_String (N.Servlet_Name));
      end Add_Mapping;

      procedure Add_Mapping (Handler : access procedure (Pattern : in Util.Beans.Objects.Object);
                             Message : in String) is
         Last : constant Ada.Containers.Count_Type := N.URL_Patterns.Length;
      begin
         if Last = 0 then
            raise Util.Serialize.Mappers.Field_Error with Message;
         end if;
         for I in 0 .. Last - 1 loop
            N.URL_Patterns.Query_Element (Natural (I), Handler);
         end loop;
         N.URL_Patterns.Clear;
      end Add_Mapping;

   begin
      --  <context-param>
      --    <param-name>property</param-name>
      --    <param-value>false</param-value>
      --  </context-param>
      --  <filter-mapping>
      --    <filter-name>Dump Filter</filter-name>
      --    <servlet-name>Faces Servlet</servlet-name>
      --  </filter-mapping>
      case Field is
         when FILTER_NAME =>
            N.Filter_Name := Value;

         when SERVLET_NAME =>
            N.Servlet_Name := Value;

         when URL_PATTERN =>
            N.URL_Patterns.Append (Value);

         when PARAM_NAME =>
            N.Param_Name := Value;

         when PARAM_VALUE =>
            N.Param_Value := EL.Utils.Eval (To_String (Value), N.Context.all);

         when MIME_TYPE =>
            N.Mime_Type := Value;

         when EXTENSION =>
            N.Extension := Value;

         when ERROR_CODE =>
            N.Error_Code := Value;

         when LOCATION =>
            N.Location := Value;

         when FILTER_MAPPING =>
            Add_Mapping (Add_Filter'Access, "Missing url-pattern for the filter mapping");

         when SERVLET_MAPPING =>
            Add_Mapping (Add_Mapping'Access, "Missing url-pattern for the servlet mapping");

         when CONTEXT_PARAM =>
            declare
               Name : constant String := To_String (N.Param_Name);
            begin
               --  If the context parameter already has a value, do not set it again.
               --  The value comes from an application setting and we want to keep it.
               if N.Override_Context
                 or else String '(N.Handler.all.Get_Init_Parameter (Name)) = ""
               then
                  if Util.Beans.Objects.Is_Null (N.Param_Value) then
                     N.Handler.Set_Init_Parameter (Name  => Name,
                                                   Value => "");
                  else
                     N.Handler.Set_Init_Parameter (Name  => Name,
                                                   Value => To_String (N.Param_Value));
                  end if;
               end if;
            end;

         when MIME_MAPPING =>
            null;

         when ERROR_PAGE =>
            N.Handler.Set_Error_Page (Error => To_Integer (N.Error_Code),
                                      Page  => To_String (N.Location));

      end case;
   end Set_Member;

   SMapper : aliased Servlet_Mapper.Mapper;

   --  ------------------------------
   --  Setup the XML parser to read the servlet and mapping rules context-param,
   --  filter-mapping and servlet-mapping.
   --  ------------------------------
   package body Reader_Config is
   begin
      Mapper.Add_Mapping ("faces-config", SMapper'Access);
      Mapper.Add_Mapping ("module", SMapper'Access);
      Mapper.Add_Mapping ("web-app", SMapper'Access);
      Config.Handler := Handler;
      Config.Context := Context;
      Servlet_Mapper.Set_Context (Mapper, Config'Unchecked_Access);
   end Reader_Config;

begin
   SMapper.Add_Mapping ("filter-mapping", FILTER_MAPPING);
   SMapper.Add_Mapping ("filter-mapping/filter-name", FILTER_NAME);
   SMapper.Add_Mapping ("filter-mapping/servlet-name", SERVLET_NAME);
   SMapper.Add_Mapping ("filter-mapping/url-pattern", URL_PATTERN);

   SMapper.Add_Mapping ("servlet-mapping", SERVLET_MAPPING);
   SMapper.Add_Mapping ("servlet-mapping/servlet-name", SERVLET_NAME);
   SMapper.Add_Mapping ("servlet-mapping/url-pattern", URL_PATTERN);

   SMapper.Add_Mapping ("context-param", CONTEXT_PARAM);
   SMapper.Add_Mapping ("context-param/param-name", PARAM_NAME);
   SMapper.Add_Mapping ("context-param/param-value", PARAM_VALUE);

   SMapper.Add_Mapping ("error-page", ERROR_PAGE);
   SMapper.Add_Mapping ("error-page/error-code", ERROR_CODE);
   SMapper.Add_Mapping ("error-page/location", LOCATION);

end ASF.Servlets.Mappers;

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

package body ASF.Servlets.Mappers is

   --  ------------------------------
   --  Save in the servlet config object the value associated with the given field.
   --  When the FILTER_MAPPING, SERVLET_MAPPING or CONTEXT_PARAM field
   --  is reached, insert the new configuration rule in the servlet registry.
   --  ------------------------------
   procedure Set_Member (N     : in out Servlet_Config;
                         Field : in Servlet_Fields;
                         Value : in Util.Beans.Objects.Object) is
      use Util.Beans.Objects;
      use type Ada.Containers.Count_Type;

      procedure Add_Filter (Pattern : in Util.Beans.Objects.Object);
      procedure Add_Mapping (Pattern : in Util.Beans.Objects.Object);
      procedure Add_Mapping (Handler : access procedure (Pattern : in Util.Beans.Objects.Object);
                             Message : in String);

      procedure Add_Filter (Pattern : in Util.Beans.Objects.Object) is
      begin
         N.Handler.Add_Filter_Mapping (Pattern => To_String (Pattern),
                                       Name    => To_String (N.Filter_Name));
      end Add_Filter;

      procedure Add_Mapping (Pattern : in Util.Beans.Objects.Object) is
      begin
         N.Handler.Add_Mapping (Pattern => To_String (Pattern),
                                Name    => To_String (N.Servlet_Name));
      end Add_Mapping;

      procedure Add_Mapping (Handler : access procedure (Pattern : in Util.Beans.Objects.Object);
                             Message : in String) is
         Last : constant Ada.Containers.Count_Type := N.URL_Patterns.Length;
      begin
         if Last = 0 then
            raise Util.Serialize.Mappers.Field_Error with Message;
         end if;
         for I in 1 .. Last - 1 loop
            N.URL_Patterns.Query_Element (Positive (I), Handler);
         end loop;
         N.URL_Patterns.Clear;
      end Add_Mapping;

   begin
      --  <context-param>
      --    <param-name>property</param-name>
      --    <param-value>false</param-value>
      --  </context-param>
      --  <filter-mapping>
      --    <filter-name>Dump Filter</filter-name>
      --    <servlet-name>Faces Servlet</servlet-name>
      --  </filter-mapping>
      case Field is
         when FILTER_NAME =>
            N.Filter_Name := Value;

         when SERVLET_NAME =>
            N.Servlet_Name := Value;

         when URL_PATTERN =>
            N.URL_Patterns.Append (Value);

         when PARAM_NAME =>
            N.Param_Name := Value;

         when PARAM_VALUE =>
            N.Param_Value := EL.Utils.Eval (To_String (Value), N.Context.all);

         when MIME_TYPE =>
            N.Mime_Type := Value;

         when EXTENSION =>
            N.Extension := Value;

         when ERROR_CODE =>
            N.Error_Code := Value;

         when LOCATION =>
            N.Location := Value;

         when FILTER_MAPPING =>
            Add_Mapping (Add_Filter'Access, "Missing url-pattern for the filter mapping");

         when SERVLET_MAPPING =>
            Add_Mapping (Add_Mapping'Access, "Missing url-pattern for the servlet mapping");

         when CONTEXT_PARAM =>
            declare
               Name : constant String := To_String (N.Param_Name);
            begin
               --  If the context parameter already has a value, do not set it again.
               --  The value comes from an application setting and we want to keep it.
               if N.Override_Context
                 or else String '(N.Handler.all.Get_Init_Parameter (Name)) = ""
               then
                  if Util.Beans.Objects.Is_Null (N.Param_Value) then
                     N.Handler.Set_Init_Parameter (Name  => Name,
                                                   Value => "");
                  else
                     N.Handler.Set_Init_Parameter (Name  => Name,
                                                   Value => To_String (N.Param_Value));
                  end if;
               end if;
            end;

         when MIME_MAPPING =>
            null;

         when ERROR_PAGE =>
            N.Handler.Set_Error_Page (Error => To_Integer (N.Error_Code),
                                      Page  => To_String (N.Location));

      end case;
   end Set_Member;

   SMapper : aliased Servlet_Mapper.Mapper;

   --  ------------------------------
   --  Setup the XML parser to read the servlet and mapping rules context-param,
   --  filter-mapping and servlet-mapping.
   --  ------------------------------
   package body Reader_Config is
   begin
      Mapper.Add_Mapping ("faces-config", SMapper'Access);
      Mapper.Add_Mapping ("module", SMapper'Access);
      Mapper.Add_Mapping ("web-app", SMapper'Access);
      Config.Handler := Handler;
      Config.Context := Context;
      Servlet_Mapper.Set_Context (Mapper, Config'Unchecked_Access);
   end Reader_Config;

begin
   SMapper.Add_Mapping ("filter-mapping", FILTER_MAPPING);
   SMapper.Add_Mapping ("filter-mapping/filter-name", FILTER_NAME);
   SMapper.Add_Mapping ("filter-mapping/servlet-name", SERVLET_NAME);
   SMapper.Add_Mapping ("filter-mapping/url-pattern", URL_PATTERN);

   SMapper.Add_Mapping ("servlet-mapping", SERVLET_MAPPING);
   SMapper.Add_Mapping ("servlet-mapping/servlet-name", SERVLET_NAME);
   SMapper.Add_Mapping ("servlet-mapping/url-pattern", URL_PATTERN);

   SMapper.Add_Mapping ("context-param", CONTEXT_PARAM);
   SMapper.Add_Mapping ("context-param/param-name", PARAM_NAME);
   SMapper.Add_Mapping ("context-param/param-value", PARAM_VALUE);

   SMapper.Add_Mapping ("error-page", ERROR_PAGE);
   SMapper.Add_Mapping ("error-page/error-code", ERROR_CODE);
   SMapper.Add_Mapping ("error-page/location", LOCATION);

end ASF.Servlets.Mappers;

Fix iteration over url patterns

Fix iteration over url patterns


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

with Util.Encoders.Base64;

--  The ASF.Sessions.Factory package is a factory for creating, searching
--  and deleting sessions.
package body ASF.Sessions.Factory is

   use Ada.Finalization;
   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Allocate a unique and random session identifier.  The default implementation
   --  generates a 256 bit random number that it serializes as base64 in the string.
   --  Upon successful completion, the sequence string buffer is allocated and
   --  returned in Id.  The buffer will be freed when the session is removed.
   --  ------------------------------
   procedure Allocate_Session_Id (Factory : in out Session_Factory;
                                  Id      : out Ada.Strings.Unbounded.String_Access) is
      use Ada.Streams;
      use Interfaces;

      Rand    : Stream_Element_Array (0 .. 4 * Factory.Id_Size - 1);
      Buffer  : Stream_Element_Array (0 .. 4 * 3 * Factory.Id_Size);
      Encoder : Util.Encoders.Base64.Encoder;
      Last    : Stream_Element_Offset;
      Encoded : Stream_Element_Offset;
   begin
      Factory.Lock.Write;

      --  Generate the random sequence.
      for I in 0 .. Factory.Id_Size - 1 loop
         declare
            Value : constant Unsigned_32 := Id_Random.Random (Factory.Random);
         begin
            Rand (4 * I)     := Stream_Element (Value and 16#0FF#);
            Rand (4 * I + 1) := Stream_Element (Shift_Right (Value, 8) and 16#0FF#);
            Rand (4 * I + 2) := Stream_Element (Shift_Right (Value, 16) and 16#0FF#);
            Rand (4 * I + 3) := Stream_Element (Shift_Right (Value, 24) and 16#0FF#);
         end;
      end loop;
      Factory.Lock.Release_Write;

      --  Encode the random stream in base64 and save it into the Id string.
      Encoder.Transform (Data => Rand, Into => Buffer,
                         Last => Last, Encoded => Encoded);

      Id := new String (1 .. Natural (Encoded + 1));
      for I in 0 .. Encoded loop
         Id (Natural (I + 1)) := Character'Val (Buffer (I));
      end loop;

   end Allocate_Session_Id;

   --  ------------------------------
   --  Create a new session
   --  ------------------------------
   procedure Create_Session (Factory : in out Session_Factory;
                             Result  : out Session) is

      Sess    : Session;
      Impl    : constant Session_Record_Access := new Session_Record;
   begin
      Impl.Ref_Counter  := Util.Concurrent.Counters.ONE;
      Impl.Create_Time  := Ada.Calendar.Clock;
      Impl.Access_Time  := Impl.Create_Time;
      Impl.Max_Inactive := Factory.Max_Inactive;
      Sess.Impl         := Impl;

      Session_Factory'Class (Factory).Allocate_Session_Id (Impl.Id);

      Factory.Lock.Write;
      Factory.Sessions.Insert (Impl.Id.all'Access, Sess);
      Factory.Lock.Release_Write;

      Result := Sess;
   end Create_Session;

   --  ------------------------------
   --  Deletes the session.
   --  ------------------------------
   procedure Delete_Session (Factory : in out Session_Factory;
                             Sess    : in out Session) is
   begin
      null;
   end Delete_Session;

   --  ------------------------------
   --  Finds the session knowing the session identifier.
   --  If the session is found, the last access time is updated.
   --  Otherwise, the null session object is returned.
   --  ------------------------------
   procedure Find_Session (Factory : in out Session_Factory;
                           Id      : in String;
                           Result  : out Session) is
   begin
      Result := Null_Session;
      Factory.Lock.Read;
      declare
         Pos : constant Session_Maps.Cursor := Factory.Sessions.Find (Id'Unrestricted_Access);
      begin
         if Session_Maps.Has_Element (Pos) then
            Result := Session_Maps.Element (Pos);
         end if;
      end;
      Factory.Lock.Release_Read;

      if Result.Is_Valid then
         Result.Impl.Access_Time := Ada.Calendar.Clock;
      end if;
   end Find_Session;

   --  ------------------------------
   --  Returns the maximum time interval, in seconds, that the servlet container will
   --  keep this session open between client accesses. After this interval, the servlet
   --  container will invalidate the session. The maximum time interval can be set with
   --  the Set_Max_Inactive_Interval method.
   --  A negative time indicates the session should never timeout.
   --  ------------------------------
   function Get_Max_Inactive_Interval (Factory : in Session_Factory) return Duration is
   begin
      return Factory.Max_Inactive;
   end Get_Max_Inactive_Interval;

   --  ------------------------------
   --  Specifies the time, in seconds, between client requests before the servlet
   --  container will invalidate this session. A negative time indicates the session
   --  should never timeout.
   --  ------------------------------
   procedure Set_Max_Inactive_Interval (Factory  : in out Session_Factory;
                                        Interval : in Duration) is
   begin
      Factory.Max_Inactive := Interval;
   end Set_Max_Inactive_Interval;

   --  ------------------------------
   --  Initialize the session factory.
   --  ------------------------------
   overriding
   procedure Initialize (Factory : in out Session_Factory) is
   begin
      Id_Random.Reset (Factory.Random);
   end Initialize;

end ASF.Sessions.Factory;

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

with Util.Encoders.Base64;
with Util.Log.Loggers;

--  The ASF.Sessions.Factory package is a factory for creating, searching
--  and deleting sessions.
package body ASF.Sessions.Factory is

   use Ada.Finalization;
   use Ada.Strings.Unbounded;

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ASF.Sessions.Factory");

   --  ------------------------------
   --  Allocate a unique and random session identifier.  The default implementation
   --  generates a 256 bit random number that it serializes as base64 in the string.
   --  Upon successful completion, the sequence string buffer is allocated and
   --  returned in Id.  The buffer will be freed when the session is removed.
   --  ------------------------------
   procedure Allocate_Session_Id (Factory : in out Session_Factory;
                                  Id      : out Ada.Strings.Unbounded.String_Access) is
      use Ada.Streams;
      use Interfaces;

      Rand    : Stream_Element_Array (0 .. 4 * Factory.Id_Size - 1);
      Buffer  : Stream_Element_Array (0 .. 4 * 3 * Factory.Id_Size);
      Encoder : Util.Encoders.Base64.Encoder;
      Last    : Stream_Element_Offset;
      Encoded : Stream_Element_Offset;
   begin
      Factory.Lock.Write;

      --  Generate the random sequence.
      for I in 0 .. Factory.Id_Size - 1 loop
         declare
            Value : constant Unsigned_32 := Id_Random.Random (Factory.Random);
         begin
            Rand (4 * I)     := Stream_Element (Value and 16#0FF#);
            Rand (4 * I + 1) := Stream_Element (Shift_Right (Value, 8) and 16#0FF#);
            Rand (4 * I + 2) := Stream_Element (Shift_Right (Value, 16) and 16#0FF#);
            Rand (4 * I + 3) := Stream_Element (Shift_Right (Value, 24) and 16#0FF#);
         end;
      end loop;
      Factory.Lock.Release_Write;

      --  Encode the random stream in base64 and save it into the Id string.
      Encoder.Transform (Data => Rand, Into => Buffer,
                         Last => Last, Encoded => Encoded);

      Id := new String (1 .. Natural (Encoded + 1));
      for I in 0 .. Encoded loop
         Id (Natural (I + 1)) := Character'Val (Buffer (I));
      end loop;

      Log.Info ("Allocated session {0}", Id.all);
   end Allocate_Session_Id;

   --  ------------------------------
   --  Create a new session
   --  ------------------------------
   procedure Create_Session (Factory : in out Session_Factory;
                             Result  : out Session) is

      Sess    : Session;
      Impl    : constant Session_Record_Access := new Session_Record;
   begin
      Impl.Ref_Counter  := Util.Concurrent.Counters.ONE;
      Impl.Create_Time  := Ada.Calendar.Clock;
      Impl.Access_Time  := Impl.Create_Time;
      Impl.Max_Inactive := Factory.Max_Inactive;
      Sess.Impl         := Impl;

      Session_Factory'Class (Factory).Allocate_Session_Id (Impl.Id);

      Factory.Lock.Write;
      Factory.Sessions.Insert (Impl.Id.all'Access, Sess);
      Factory.Lock.Release_Write;

      Result := Sess;
   end Create_Session;

   --  ------------------------------
   --  Deletes the session.
   --  ------------------------------
   procedure Delete_Session (Factory : in out Session_Factory;
                             Sess    : in out Session) is
   begin
      null;
   end Delete_Session;

   --  ------------------------------
   --  Finds the session knowing the session identifier.
   --  If the session is found, the last access time is updated.
   --  Otherwise, the null session object is returned.
   --  ------------------------------
   procedure Find_Session (Factory : in out Session_Factory;
                           Id      : in String;
                           Result  : out Session) is
   begin
      Result := Null_Session;
      Factory.Lock.Read;
      declare
         Pos : constant Session_Maps.Cursor := Factory.Sessions.Find (Id'Unrestricted_Access);
      begin
         if Session_Maps.Has_Element (Pos) then
            Result := Session_Maps.Element (Pos);
         end if;
      end;
      Factory.Lock.Release_Read;

      if Result.Is_Valid then
         Result.Impl.Access_Time := Ada.Calendar.Clock;
         Log.Info ("Found active session {0}", Id);
      else
         Log.Info ("Invalid session {0}", Id);
      end if;
   end Find_Session;

   --  ------------------------------
   --  Returns the maximum time interval, in seconds, that the servlet container will
   --  keep this session open between client accesses. After this interval, the servlet
   --  container will invalidate the session. The maximum time interval can be set with
   --  the Set_Max_Inactive_Interval method.
   --  A negative time indicates the session should never timeout.
   --  ------------------------------
   function Get_Max_Inactive_Interval (Factory : in Session_Factory) return Duration is
   begin
      return Factory.Max_Inactive;
   end Get_Max_Inactive_Interval;

   --  ------------------------------
   --  Specifies the time, in seconds, between client requests before the servlet
   --  container will invalidate this session. A negative time indicates the session
   --  should never timeout.
   --  ------------------------------
   procedure Set_Max_Inactive_Interval (Factory  : in out Session_Factory;
                                        Interval : in Duration) is
   begin
      Factory.Max_Inactive := Interval;
   end Set_Max_Inactive_Interval;

   --  ------------------------------
   --  Initialize the session factory.
   --  ------------------------------
   overriding
   procedure Initialize (Factory : in out Session_Factory) is
   begin
      Id_Random.Reset (Factory.Random);
   end Initialize;

end ASF.Sessions.Factory;

Add logs on servlet session to help in fixing session issues in applications


-----------------------------------------------------------------------
--  gen-commands-project -- Project creation command for dynamo
--  Copyright (C) 2011, 2017, 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.
-----------------------------------------------------------------------

package Gen.Commands.Project is

   --  ------------------------------
   --  Generator Command
   --  ------------------------------
   type Command is new Gen.Commands.Command with null record;

   --  Execute the command with the arguments.
   overriding
   procedure Execute (Cmd       : in out Command;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Generator : in out Gen.Generator.Handler);

   --  Write the help associated with the command.
   overriding
   procedure Help (Cmd       : in out Command;
                   Generator : in out Gen.Generator.Handler);

end Gen.Commands.Project;

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

package Gen.Commands.Project is

   --  ------------------------------
   --  Generator Command
   --  ------------------------------
   type Command is new Gen.Commands.Command with null record;

   --  Execute the command with the arguments.
   overriding
   procedure Execute (Cmd       : in out Command;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Generator : in out Gen.Generator.Handler);

   --  Write the help associated with the command.
   overriding
   procedure Help (Cmd       : in out Command;
                   Name      : in String;
                   Generator : in out Gen.Generator.Handler);

end Gen.Commands.Project;

Add Name parameter to the Help procedure


-----------------------------------------------------------------------
--  gen-commands-propset -- Set a property on dynamo project
--  Copyright (C) 2011, 2012, 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.Text_IO;

package body Gen.Commands.Propset is

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Cmd       : in Command;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Name);
      use Ada.Strings.Unbounded;

   begin
      if Args.Get_Count /= 2 then
         Cmd.Usage;
         return;
      end if;

      Generator.Read_Project ("dynamo.xml", True);
      Generator.Set_Project_Property (Args.Get_Argument (1), Args.Get_Argument (2));
      Generator.Save_Project;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("propset: Set the value of a property in the dynamo project file");
      Put_Line ("Usage: propset NAME VALUEE");
      New_Line;
   end Help;

end Gen.Commands.Propset;

-----------------------------------------------------------------------
--  gen-commands-propset -- Set a property on dynamo project
--  Copyright (C) 2011, 2012, 2017, 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.Text_IO;

package body Gen.Commands.Propset is

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Cmd       : in Command;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Name);
      use Ada.Strings.Unbounded;

   begin
      if Args.Get_Count /= 2 then
         Cmd.Usage;
         return;
      end if;

      Generator.Read_Project ("dynamo.xml", True);
      Generator.Set_Project_Property (Args.Get_Argument (1), Args.Get_Argument (2));
      Generator.Save_Project;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("propset: Set the value of a property in the dynamo project file");
      Put_Line ("Usage: propset NAME VALUE");
      New_Line;
   end Help;

end Gen.Commands.Propset;

Fix help message for the propset command


-----------------------------------------------------------------------
--  util-http-clients-curl -- HTTP Clients with CURL
--  Copyright (C) 2012, 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 System;
with Interfaces.C;
with Interfaces.C.Strings;
with Ada.Strings.Unbounded;
with Util.Http.Mockups;
package Util.Http.Clients.Curl is

   --  Register the CURL Http manager.
   procedure Register;

private

   package C renames Interfaces.C;
   package Strings renames Interfaces.C.Strings;

   use type C.size_t;
   use type C.int;

   --  Define 'Int' and 'Chars_Ptr' with capitals to avoid GNAT warnings due
   --  to Eclipse capitalization.
   subtype Int is C.int;
   subtype Chars_Ptr is Strings.chars_ptr;
   subtype Size_T is C.size_t;

   subtype CURL is System.Address;

   type CURL_Code is new Interfaces.C.int;

   CURLE_OK               : constant CURL_Code := 0;

   type CURL_Info is new Int;

   type Curl_Option is new Int;

   type CURL_Slist;
   type CURL_Slist_Access is access CURL_Slist;

   type CURL_Slist is record
      Data : Chars_Ptr;
      Next : CURL_Slist_Access;
   end record;

   --  Check the CURL result code and report and exception and a log message if
   --  the CURL code indicates an error.
   procedure Check_Code (Code    : in CURL_Code;
                         Message : in String);

   type Curl_Http_Manager is new Http_Manager with null record;
   type Curl_Http_Manager_Access is access all Http_Manager'Class;

   --  Create a new HTTP request associated with the current request manager.
   procedure Create (Manager  : in Curl_Http_Manager;
                     Http     : in out Client'Class);

   overriding
   procedure Do_Get (Manager  : in Curl_Http_Manager;
                     Http     : in Client'Class;
                     URI      : in String;
                     Reply    : out Response'Class);

   overriding
   procedure Do_Post (Manager  : in Curl_Http_Manager;
                      Http     : in Client'Class;
                      URI      : in String;
                      Data     : in String;
                      Reply    : out Response'Class);

   overriding
   procedure Do_Put (Manager  : in Curl_Http_Manager;
                     Http     : in Client'Class;
                     URI      : in String;
                     Data     : in String;
                     Reply    : out Response'Class);

   overriding
   procedure Do_Delete (Manager  : in Curl_Http_Manager;
                        Http     : in Client'Class;
                        URI      : in String;
                        Reply    : out Response'Class);

   --  Set the timeout for the connection.
   overriding
   procedure Set_Timeout (Manager : in Curl_Http_Manager;
                          Http    : in Client'Class;
                          Timeout : in Duration);

   type Curl_Http_Request is new Util.Http.Mockups.Mockup_Request with record
      Data         : CURL := System.Null_Address;
      URL          : Chars_Ptr := Interfaces.C.Strings.Null_Ptr;
      Content      : Chars_Ptr := Interfaces.C.Strings.Null_Ptr;
      Curl_Headers : CURL_Slist_Access := null;
   end record;
   type Curl_Http_Request_Access is access all Curl_Http_Request'Class;

   --  Prepare to setup the headers in the request.
   procedure Set_Headers (Request : in out Curl_Http_Request);

   overriding
   procedure Finalize (Request : in out Curl_Http_Request);

   type Curl_Http_Response is new Util.Http.Mockups.Mockup_Response with record
      C : CURL;
      Content : Ada.Strings.Unbounded.Unbounded_String;
      Status  : Natural;
      Parsing_Body : Boolean := False;
   end record;
   type Curl_Http_Response_Access is access all Curl_Http_Response'Class;

   --  Get the response body as a string.
   overriding
   function Get_Body (Reply : in Curl_Http_Response) return String;

   --  Get the response status code.
   overriding
   function Get_Status (Reply : in Curl_Http_Response) return Natural;

   --  Add a string to a CURL slist.
   function Curl_Slist_Append (List  : in CURL_Slist_Access;
                               Value : in Chars_Ptr) return CURL_Slist_Access;
   pragma Import (C, Curl_Slist_Append, "curl_slist_append");

   --  Free an entrire CURL slist.
   procedure Curl_Slist_Free_All (List : in CURL_Slist_Access);
   pragma Import (C, Curl_Slist_Free_All, "curl_slist_free_all");

   --  Start a libcurl easy session.
   function Curl_Easy_Init return CURL;
   pragma Import (C, Curl_Easy_Init, "curl_easy_init");

   --  End a libcurl easy session.
   procedure Curl_Easy_Cleanup (Handle : in CURL);
   pragma Import (C, Curl_Easy_Cleanup, "curl_easy_cleanup");

   --  Perform a file transfer.
   function Curl_Easy_Perform (Handle : in CURL) return CURL_Code;
   pragma Import (C, Curl_Easy_Perform, "curl_easy_perform");

   --  Return the error message which correspond to the given CURL error code.
   function Curl_Easy_Strerror (Code : in CURL_Code) return Chars_Ptr;
   pragma Import (C, Curl_Easy_Strerror, "curl_easy_strerror");

   --  Set options for a curl easy handle.
   function Curl_Easy_Setopt_String (Handle : in CURL;
                                     Option : in Curl_Option;
                                     Value  : in Chars_Ptr) return CURL_Code;
   pragma Import (C, Curl_Easy_Setopt_String, "curl_easy_setopt");

   --  Set options for a curl easy handle.
   function Curl_Easy_Setopt_Slist (Handle : in CURL;
                                     Option : in Curl_Option;
                                     Value  : in CURL_Slist_Access) return CURL_Code;
   pragma Import (C, Curl_Easy_Setopt_Slist, "curl_easy_setopt");

   --  Set options for a curl easy handle.
   function Curl_Easy_Setopt_Long (Handle : in CURL;
                                     Option : in Curl_Option;
                                     Value  : in Interfaces.C.long) return CURL_Code;
   pragma Import (C, Curl_Easy_Setopt_Long, "curl_easy_setopt");

   --  Get information from a CURL handle for an option returning a String.
   function Curl_Easy_Getinfo_String (Handle : in CURL;
                                      Option : in CURL_Info;
                                      Value  : access Chars_Ptr) return CURL_Code;
   pragma Import (C, Curl_Easy_Getinfo_String, "curl_easy_getinfo");

   --  Get information from a CURL handle for an option returning a Long.
   function Curl_Easy_Getinfo_Long (Handle : in CURL;
                                    Option : in CURL_Info;
                                    Value  : access C.long) return CURL_Code;
   pragma Import (C, Curl_Easy_Getinfo_Long, "curl_easy_getinfo");

   type Write_Callback_Access is access
     function (Data  : in Chars_Ptr;
               Size  : in Size_T;
               Nmemb : in Size_T;
               Ptr   : in Curl_Http_Response_Access) return Size_T;
   pragma Convention (C, Write_Callback_Access);

   function Curl_Easy_Setopt_Write_Callback
     (Handle : in CURL;
      Option : in Curl_Option;
      Func   : in Write_Callback_Access)
      return CURL_Code;
   pragma Import (C, Curl_Easy_Setopt_Write_Callback, "curl_easy_setopt");

   --  Set options for a curl easy handle.
   function Curl_Easy_Setopt_Data (Handle : in CURL;
                                   Option : in Curl_Option;
                                   Value  : in Curl_Http_Response_Access) return CURL_Code;
   pragma Import (C, Curl_Easy_Setopt_Data, "curl_easy_setopt");

   function Read_Response (Data     : in Chars_Ptr;
                           Size     : in Size_T;
                           Nmemb    : in Size_T;
                           Response : in Curl_Http_Response_Access) return Size_T;
   pragma Convention (C, Read_Response);

end Util.Http.Clients.Curl;

-----------------------------------------------------------------------
--  util-http-clients-curl -- HTTP Clients with CURL
--  Copyright (C) 2012, 2017, 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 System;
with Interfaces.C;
with Interfaces.C.Strings;
with Ada.Strings.Unbounded;
with Util.Http.Mockups;
package Util.Http.Clients.Curl is

   --  Register the CURL Http manager.
   procedure Register;

private

   package C renames Interfaces.C;
   package Strings renames Interfaces.C.Strings;

   use type C.size_t;

   --  Define 'Int' and 'Chars_Ptr' with capitals to avoid GNAT warnings due
   --  to Eclipse capitalization.
   subtype Int is C.int;
   subtype Chars_Ptr is Strings.chars_ptr;
   subtype Size_T is C.size_t;

   subtype CURL is System.Address;

   type CURL_Code is new Interfaces.C.int;

   CURLE_OK               : constant CURL_Code := 0;

   type CURL_Info is new Int;

   type Curl_Option is new Int;

   type CURL_Slist;
   type CURL_Slist_Access is access CURL_Slist;

   type CURL_Slist is record
      Data : Chars_Ptr;
      Next : CURL_Slist_Access;
   end record;

   --  Check the CURL result code and report and exception and a log message if
   --  the CURL code indicates an error.
   procedure Check_Code (Code    : in CURL_Code;
                         Message : in String);

   type Curl_Http_Manager is new Http_Manager with null record;
   type Curl_Http_Manager_Access is access all Http_Manager'Class;

   --  Create a new HTTP request associated with the current request manager.
   procedure Create (Manager  : in Curl_Http_Manager;
                     Http     : in out Client'Class);

   overriding
   procedure Do_Get (Manager  : in Curl_Http_Manager;
                     Http     : in Client'Class;
                     URI      : in String;
                     Reply    : out Response'Class);

   overriding
   procedure Do_Post (Manager  : in Curl_Http_Manager;
                      Http     : in Client'Class;
                      URI      : in String;
                      Data     : in String;
                      Reply    : out Response'Class);

   overriding
   procedure Do_Put (Manager  : in Curl_Http_Manager;
                     Http     : in Client'Class;
                     URI      : in String;
                     Data     : in String;
                     Reply    : out Response'Class);

   overriding
   procedure Do_Delete (Manager  : in Curl_Http_Manager;
                        Http     : in Client'Class;
                        URI      : in String;
                        Reply    : out Response'Class);

   --  Set the timeout for the connection.
   overriding
   procedure Set_Timeout (Manager : in Curl_Http_Manager;
                          Http    : in Client'Class;
                          Timeout : in Duration);

   type Curl_Http_Request is new Util.Http.Mockups.Mockup_Request with record
      Data         : CURL := System.Null_Address;
      URL          : Chars_Ptr := Interfaces.C.Strings.Null_Ptr;
      Content      : Chars_Ptr := Interfaces.C.Strings.Null_Ptr;
      Curl_Headers : CURL_Slist_Access := null;
   end record;
   type Curl_Http_Request_Access is access all Curl_Http_Request'Class;

   --  Prepare to setup the headers in the request.
   procedure Set_Headers (Request : in out Curl_Http_Request);

   overriding
   procedure Finalize (Request : in out Curl_Http_Request);

   type Curl_Http_Response is new Util.Http.Mockups.Mockup_Response with record
      C : CURL;
      Content : Ada.Strings.Unbounded.Unbounded_String;
      Status  : Natural;
      Parsing_Body : Boolean := False;
   end record;
   type Curl_Http_Response_Access is access all Curl_Http_Response'Class;

   --  Get the response body as a string.
   overriding
   function Get_Body (Reply : in Curl_Http_Response) return String;

   --  Get the response status code.
   overriding
   function Get_Status (Reply : in Curl_Http_Response) return Natural;

   --  Add a string to a CURL slist.
   function Curl_Slist_Append (List  : in CURL_Slist_Access;
                               Value : in Chars_Ptr) return CURL_Slist_Access;
   pragma Import (C, Curl_Slist_Append, "curl_slist_append");

   --  Free an entrire CURL slist.
   procedure Curl_Slist_Free_All (List : in CURL_Slist_Access);
   pragma Import (C, Curl_Slist_Free_All, "curl_slist_free_all");

   --  Start a libcurl easy session.
   function Curl_Easy_Init return CURL;
   pragma Import (C, Curl_Easy_Init, "curl_easy_init");

   --  End a libcurl easy session.
   procedure Curl_Easy_Cleanup (Handle : in CURL);
   pragma Import (C, Curl_Easy_Cleanup, "curl_easy_cleanup");

   --  Perform a file transfer.
   function Curl_Easy_Perform (Handle : in CURL) return CURL_Code;
   pragma Import (C, Curl_Easy_Perform, "curl_easy_perform");

   --  Return the error message which correspond to the given CURL error code.
   function Curl_Easy_Strerror (Code : in CURL_Code) return Chars_Ptr;
   pragma Import (C, Curl_Easy_Strerror, "curl_easy_strerror");

   --  Set options for a curl easy handle.
   function Curl_Easy_Setopt_String (Handle : in CURL;
                                     Option : in Curl_Option;
                                     Value  : in Chars_Ptr) return CURL_Code;
   pragma Import (C, Curl_Easy_Setopt_String, "curl_easy_setopt");

   --  Set options for a curl easy handle.
   function Curl_Easy_Setopt_Slist (Handle : in CURL;
                                     Option : in Curl_Option;
                                     Value  : in CURL_Slist_Access) return CURL_Code;
   pragma Import (C, Curl_Easy_Setopt_Slist, "curl_easy_setopt");

   --  Set options for a curl easy handle.
   function Curl_Easy_Setopt_Long (Handle : in CURL;
                                     Option : in Curl_Option;
                                     Value  : in Interfaces.C.long) return CURL_Code;
   pragma Import (C, Curl_Easy_Setopt_Long, "curl_easy_setopt");

   --  Get information from a CURL handle for an option returning a String.
   function Curl_Easy_Getinfo_String (Handle : in CURL;
                                      Option : in CURL_Info;
                                      Value  : access Chars_Ptr) return CURL_Code;
   pragma Import (C, Curl_Easy_Getinfo_String, "curl_easy_getinfo");

   --  Get information from a CURL handle for an option returning a Long.
   function Curl_Easy_Getinfo_Long (Handle : in CURL;
                                    Option : in CURL_Info;
                                    Value  : access C.long) return CURL_Code;
   pragma Import (C, Curl_Easy_Getinfo_Long, "curl_easy_getinfo");

   type Write_Callback_Access is access
     function (Data  : in Chars_Ptr;
               Size  : in Size_T;
               Nmemb : in Size_T;
               Ptr   : in Curl_Http_Response_Access) return Size_T;
   pragma Convention (C, Write_Callback_Access);

   function Curl_Easy_Setopt_Write_Callback
     (Handle : in CURL;
      Option : in Curl_Option;
      Func   : in Write_Callback_Access)
      return CURL_Code;
   pragma Import (C, Curl_Easy_Setopt_Write_Callback, "curl_easy_setopt");

   --  Set options for a curl easy handle.
   function Curl_Easy_Setopt_Data (Handle : in CURL;
                                   Option : in Curl_Option;
                                   Value  : in Curl_Http_Response_Access) return CURL_Code;
   pragma Import (C, Curl_Easy_Setopt_Data, "curl_easy_setopt");

   function Read_Response (Data     : in Chars_Ptr;
                           Size     : in Size_T;
                           Nmemb    : in Size_T;
                           Response : in Curl_Http_Response_Access) return Size_T;
   pragma Convention (C, Read_Response);

end Util.Http.Clients.Curl;

Remove unecessary use type clause

Remove unecessary use type clause