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

with Ada.Containers;
with Util.Test_Caller;
with Ada.Strings.Fixed;
with Ada.Text_IO;
with Ada.Calendar;
with EL.Objects.Hash;
package body EL.Objects.Discrete_Tests is

   use EL.Objects;
   use Ada.Strings.Fixed;
   use Ada.Containers;

   procedure Test_Eq (T : Test; V : String; N : Test_Type);
   procedure Test_Conversion (T : Test; V : String; N : Test_Type);
   procedure Test_Lt_Gt (T : Test; V : String; N : Test_Type);
   procedure Test_Sub (T : Test; V : String; N : Test_Type);
   procedure Test_Add (T : Test; V : String; N : Test_Type);

   --  Generic test for To_Object and To_XXX types
   --  Several values are specified in the Test_Values string.
   generic
      with procedure Basic_Test (T : in Test; V : String; N : Test_Type);
   procedure Test_Basic_Object (T : in out Test);

   procedure Test_Basic_Object (T : in out Test) is
      pragma Unmodified (T);

      Pos, Next : Natural;
   begin
      Pos := Test_Values'First;
      while Pos <= Test_Values'Last loop
         Next := Index (Test_Values, ",", Pos);
         if Next < Pos then
            Next := Test_Values'Last + 1;
         end if;
         declare
            V : constant String := Test_Values (Pos .. Next - 1);
            N : constant Test_Type := Value (V);
         begin
            Basic_Test (T, V, N);
         end;
         Pos := Next + 1;
      end loop;
   end Test_Basic_Object;

   --  ------------------------------
   --  Test EL.Objects.To_Object
   --  ------------------------------
   procedure Test_Conversion (T : Test; V : String; N : Test_Type) is
      Value : EL.Objects.Object;
   begin
      Value := To_Object (V);
      T.Assert (Condition => To_Type (Value) = N,
                Message   => Test_Name & " returned invalid value: "
                & To_String (Value) & " when we expected: " & V);

      T.Assert (Condition => V = To_String (Value),
                Message   => Test_Name & ".To_String returned invalid value: "
                & To_String (Value) & " when we expected: " & V);
   end Test_Conversion;
   procedure Test_To_Object is new Test_Basic_Object (Basic_Test => Test_Conversion);

   --  ------------------------------
   --  Test EL.Objects.Hash
   --  ------------------------------
    procedure Test_Hash (T : in out Test) is
      pragma Unmodified (T);

      Pos, Next   : Natural;
      Hash_Values : array (Test_Values'Range) of Hash_Type := (others => 0);
      Nb_Hash     : Natural := 0;
   begin
      Pos := Test_Values'First;
      while Pos <= Test_Values'Last loop
         Next := Index (Test_Values, ",", Pos);
         if Next < Pos then
            Next := Test_Values'Last + 1;
         end if;
         declare
            V     : constant String := Test_Values (Pos .. Next - 1);
            N     : constant Test_Type := Value (V);
            Value : constant EL.Objects.Object := To_Object_Test (N);
            H     : constant Hash_Type := EL.Objects.Hash (Value);
            Found : Boolean := False;
         begin
            for J in 1 .. Nb_Hash loop
               if Hash_Values (J) = H then
                  Found := True;
               end if;
            end loop;
            if not Found then
               Nb_Hash := Nb_Hash + 1;
               Hash_Values (Nb_Hash) := H;
            end if;
         end;
         Pos := Next + 1;
      end loop;

      Ada.Text_IO.Put_Line ("Found " & Natural'Image (Nb_Hash) & " hash values");
      Assert (T, Nb_Hash > 1, "Only one hash value found");
   end Test_Hash;

   --  ------------------------------
   --  Test EL.Objects."+"
   --  ------------------------------
   procedure Test_Add (T : Test; V : String; N : Test_Type) is
      Value : EL.Objects.Object := To_Object_Test (N);
   begin
      Value := Value + To_Object_Test (N);
      T.Assert (Condition => To_Type (Value) = N + N,
                Message   => Test_Name & " returned invalid value: "
                & To_String (Value) & " when we expected: " & V);
   end Test_Add;

   procedure Test_Add is new Test_Basic_Object (Test_Add);

   --  ------------------------------
   --  Test EL.Objects."-"
   --  ------------------------------
   procedure Test_Sub (T : Test; V : String; N : Test_Type) is
      pragma Unreferenced (V);

      Value : EL.Objects.Object;
   begin
      Value := To_Object_Test (N) - To_Object_Test (N);
      T.Assert (Condition => To_Type (Value) = N - N,
                Message   => Test_Name & " returned invalid value: "
                & To_String (Value) & " when we expected: 0");
   end Test_Sub;

   procedure Test_Sub is new Test_Basic_Object (Test_Sub);

   --  ------------------------------
   --  Test EL.Objects."<" and EL.Objects.">"
   --  ------------------------------
   procedure Test_Lt_Gt (T : Test; V : String; N : Test_Type) is
      Res   : Boolean;
      Is_Neg : constant Boolean := Index (V, "-") = V'First;
      O : EL.Objects.Object := To_Object_Test (N);
   begin
      Res := To_Object_Test (N) < To_Object_Test (N);
      T.Assert (Condition => Res = False,
                Message   => Test_Name & ".'<' returned invalid value: "
                & Boolean'Image (Res) & " when we expected: false");
      Res := To_Object_Test (N) > To_Object_Test (N);
      T.Assert (Condition => Res = False,
                Message   => Test_Name & ".'>' returned invalid value: "
                & Boolean'Image (Res) & " when we expected: false");
      Res := To_Object_Test (N) + To_Object_Test (N) < To_Object_Test (N);
      T.Assert (Condition => Res = Is_Neg,
                Message   => Test_Name & ".'<' returned invalid value: "
                & Boolean'Image (Res) & " when we expected: "
                & Boolean'Image (Is_Neg)
                & " with value: " & V & "Num=" & Long_Long_Integer'Image (To_Long_Long_Integer (O))
                & " Sum=" & Long_Long_Integer'Image (To_Long_Long_Integer (O + O)));
      Res := To_Object_Test (N) > To_Object_Test (N) + To_Object_Test (N);
      T.Assert (Condition => Res = Is_Neg,
                Message   => Test_Name & ".'>' returned invalid value: "
                & Boolean'Image (Res) & " when we expected: "
                & Boolean'Image (Is_Neg)
                & " with value: " & V);
      if V /= "0" and V /= "false" and V /= "true" then
         Res := To_Object_Test (N) < To_Object_Test (N) + To_Object_Test (N);
         T.Assert (Condition => Res = not Is_Neg,
                   Message   => Test_Name & ".'<' returned invalid value: "
                   & Boolean'Image (Res) & " when we expected: "
                   & Boolean'Image (not Is_Neg)
                   & " with value: " & V);
         Res := To_Object_Test (N) + To_Object_Test (N) > To_Object_Test (N);
         T.Assert (Condition => Res = not Is_Neg,
                   Message   => Test_Name & ".'>' returned invalid value: "
                   & Boolean'Image (Res) & " when we expected: "
                   & Boolean'Image (not Is_Neg)
                   & " with value: " & V);
      end if;
   end Test_Lt_Gt;

   procedure Test_Lt_Gt is new Test_Basic_Object (Test_Lt_Gt);

   --  ------------------------------
   --  Test EL.Objects."="
   --  ------------------------------
   procedure Test_Eq (T : Test; V : String; N : Test_Type) is
      Res   : Boolean;
   begin
      Res := To_Object_Test (N) = To_Object_Test (N);
      T.Assert (Condition => Res,
                Message   => Test_Name & ".'=' returned invalid value: "
                & Boolean'Image (Res) & " when we expected: true");

      Res := To_Object_Test (N) = To_Object ("Something" & V);
      T.Assert (Condition => Res = False,
                Message   => Test_Name & ".'=' returned invalid value: "
                & Boolean'Image (Res) & " where we expected: False");
   end Test_Eq;
   procedure Test_Eq is new Test_Basic_Object (Test_Eq);

   --  ------------------------------
   --  Test EL.Objects."="
   --  ------------------------------
   procedure Test_Perf (T : Test; V : String; N : Test_Type) is
      pragma Unreferenced (T, V);

      use Ada.Calendar;

      Start : Ada.Calendar.Time;
      Value : constant EL.Objects.Object := To_Object_Test (N);
      D     : Duration;
   begin
      Start := Ada.Calendar.Clock;
      for I in 1 .. 1_000 loop
         declare
            V : EL.Objects.Object := Value;
         begin
            V := V + V;

            pragma Unreferenced (V);
         end;
      end loop;
      D := Ada.Calendar.Clock - Start;
      Ada.Text_IO.Put_Line ("Perf " & Test_Name & ": " & Duration'Image (D * 1000.0));
   end Test_Perf;
   procedure Test_Perf is new Test_Basic_Object (Test_Perf);

   package Caller is new Util.Test_Caller (Test);

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test EL.Objects.To_Object." & Test_Name,
                       Test_To_Object'Access);
      Caller.Add_Test (Suite, "Test EL.Objects.To_String." & Test_Name,
                       Test_To_Object'Access);
      Caller.Add_Test (Suite, "Test EL.Objects.'='." & Test_Name,
                       Test_Eq'Access);
      Caller.Add_Test (Suite, "Test EL.Objects.'+'." & Test_Name,
                       Test_Add'Access);
      Caller.Add_Test (Suite, "Test EL.Objects.'-'." & Test_Name,
                       Test_Sub'Access);
      Caller.Add_Test (Suite, "Test EL.Objects.'<'." & Test_Name,
                       Test_Lt_Gt'Access);
      Caller.Add_Test (Suite, "Test EL.Objects.'>'." & Test_Name,
                       Test_Lt_Gt'Access);
      Caller.Add_Test (Suite, "Performance EL.Objects.'>'." & Test_Name,
                       Test_Perf'Access);
      Caller.Add_Test (Suite, "Test EL.Objects.Hash." & Test_Name,
                       Test_Hash'Access);
   end Add_Tests;

end EL.Objects.Discrete_Tests;

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

with Ada.Containers;
with Util.Test_Caller;
with Ada.Strings.Fixed;
with Ada.Text_IO;
with Ada.Calendar;
with EL.Objects.Hash;
package body EL.Objects.Discrete_Tests is

   use EL.Objects;
   use Ada.Strings.Fixed;
   use Ada.Containers;

   procedure Test_Eq (T : Test; V : String; N : Test_Type);
   procedure Test_Conversion (T : Test; V : String; N : Test_Type);
   procedure Test_Lt_Gt (T : Test; V : String; N : Test_Type);
   procedure Test_Sub (T : Test; V : String; N : Test_Type);
   procedure Test_Add (T : Test; V : String; N : Test_Type);

   --  Generic test for To_Object and To_XXX types
   --  Several values are specified in the Test_Values string.
   generic
      with procedure Basic_Test (T : in Test; V : String; N : Test_Type);
   procedure Test_Basic_Object (T : in out Test);

   procedure Test_Basic_Object (T : in out Test) is
      pragma Unmodified (T);

      Pos, Next : Natural;
   begin
      Pos := Test_Values'First;
      while Pos <= Test_Values'Last loop
         Next := Index (Test_Values, ",", Pos);
         if Next < Pos then
            Next := Test_Values'Last + 1;
         end if;
         declare
            V : constant String := Test_Values (Pos .. Next - 1);
            N : constant Test_Type := Value (V);
         begin
            Basic_Test (T, V, N);
         end;
         Pos := Next + 1;
      end loop;
   end Test_Basic_Object;

   --  ------------------------------
   --  Test EL.Objects.To_Object
   --  ------------------------------
   procedure Test_Conversion (T : Test; V : String; N : Test_Type) is
      Value : EL.Objects.Object;
   begin
      Value := To_Object (V);
      T.Assert (Condition => To_Type (Value) = N,
                Message   => Test_Name & " returned invalid value: "
                & To_String (Value) & " when we expected: " & V);

      T.Assert (Condition => V = To_String (Value),
                Message   => Test_Name & ".To_String returned invalid value: "
                & To_String (Value) & " when we expected: " & V);
   end Test_Conversion;
   procedure Test_To_Object is new Test_Basic_Object (Basic_Test => Test_Conversion);

   --  ------------------------------
   --  Test EL.Objects.Hash
   --  ------------------------------
    procedure Test_Hash (T : in out Test) is
      pragma Unmodified (T);

      Pos, Next   : Natural;
      Hash_Values : array (Test_Values'Range) of Hash_Type := (others => 0);
      Nb_Hash     : Natural := 0;
   begin
      Pos := Test_Values'First;
      while Pos <= Test_Values'Last loop
         Next := Index (Test_Values, ",", Pos);
         if Next < Pos then
            Next := Test_Values'Last + 1;
         end if;
         declare
            V     : constant String := Test_Values (Pos .. Next - 1);
            N     : constant Test_Type := Value (V);
            Value : constant EL.Objects.Object := To_Object_Test (N);
            H     : constant Hash_Type := EL.Objects.Hash (Value);
            Found : Boolean := False;
         begin
            for J in 1 .. Nb_Hash loop
               if Hash_Values (J) = H then
                  Found := True;
               end if;
            end loop;
            if not Found then
               Nb_Hash := Nb_Hash + 1;
               Hash_Values (Nb_Hash) := H;
            end if;
         end;
         Pos := Next + 1;
      end loop;

      Ada.Text_IO.Put_Line ("Found " & Natural'Image (Nb_Hash) & " hash values");
      Assert (T, Nb_Hash > 1, "Only one hash value found");
   end Test_Hash;

   --  ------------------------------
   --  Test EL.Objects."+"
   --  ------------------------------
   procedure Test_Add (T : Test; V : String; N : Test_Type) is
      Value : EL.Objects.Object := To_Object_Test (N);
   begin
      Value := Value + To_Object_Test (N);
      T.Assert (Condition => To_Type (Value) = N + N,
                Message   => Test_Name & " returned invalid value: "
                & To_String (Value) & " when we expected: " & V);
   end Test_Add;

   procedure Test_Add is new Test_Basic_Object (Test_Add);

   --  ------------------------------
   --  Test EL.Objects."-"
   --  ------------------------------
   procedure Test_Sub (T : Test; V : String; N : Test_Type) is
      pragma Unreferenced (V);

      Value : EL.Objects.Object;
   begin
      Value := To_Object_Test (N) - To_Object_Test (N);
      T.Assert (Condition => To_Type (Value) = N - N,
                Message   => Test_Name & " returned invalid value: "
                & To_String (Value) & " when we expected: 0");
   end Test_Sub;

   procedure Test_Sub is new Test_Basic_Object (Test_Sub);

   --  ------------------------------
   --  Test EL.Objects."<" and EL.Objects.">"
   --  ------------------------------
   procedure Test_Lt_Gt (T : Test; V : String; N : Test_Type) is
      Res   : Boolean;
      Is_Neg : constant Boolean := Index (V, "-") = V'First;
      O : EL.Objects.Object := To_Object_Test (N);
   begin
      Res := To_Object_Test (N) < To_Object_Test (N);
      T.Assert (Condition => Res = False,
                Message   => Test_Name & ".'<' returned invalid value: "
                & Boolean'Image (Res) & " when we expected: false");
      Res := To_Object_Test (N) > To_Object_Test (N);
      T.Assert (Condition => Res = False,
                Message   => Test_Name & ".'>' returned invalid value: "
                & Boolean'Image (Res) & " when we expected: false");
      Res := To_Object_Test (N) + To_Object_Test (N) < To_Object_Test (N);
      T.Assert (Condition => Res = Is_Neg,
                Message   => Test_Name & ".'<' returned invalid value: "
                & Boolean'Image (Res) & " when we expected: "
                & Boolean'Image (Is_Neg)
                & " with value: " & V & "Num=" & Long_Long_Integer'Image (To_Long_Long_Integer (O))
                & " Sum=" & Long_Long_Integer'Image (To_Long_Long_Integer (O + O)));
      Res := To_Object_Test (N) > To_Object_Test (N) + To_Object_Test (N);
      T.Assert (Condition => Res = Is_Neg,
                Message   => Test_Name & ".'>' returned invalid value: "
                & Boolean'Image (Res) & " when we expected: "
                & Boolean'Image (Is_Neg)
                & " with value: " & V);
      if V /= "0" and V /= "false" and V /= "true" then
         Res := To_Object_Test (N) < To_Object_Test (N) + To_Object_Test (N);
         T.Assert (Condition => Res = not Is_Neg,
                   Message   => Test_Name & ".'<' returned invalid value: "
                   & Boolean'Image (Res) & " when we expected: "
                   & Boolean'Image (not Is_Neg)
                   & " with value: " & V);
         Res := To_Object_Test (N) + To_Object_Test (N) > To_Object_Test (N);
         T.Assert (Condition => Res = not Is_Neg,
                   Message   => Test_Name & ".'>' returned invalid value: "
                   & Boolean'Image (Res) & " when we expected: "
                   & Boolean'Image (not Is_Neg)
                   & " with value: " & V);
      end if;
   end Test_Lt_Gt;

   procedure Test_Lt_Gt is new Test_Basic_Object (Test_Lt_Gt);

   --  ------------------------------
   --  Test EL.Objects."="
   --  ------------------------------
   procedure Test_Eq (T : Test; V : String; N : Test_Type) is
      Res   : Boolean;
   begin
      Res := To_Object_Test (N) = To_Object_Test (N);
      T.Assert (Condition => Res,
                Message   => Test_Name & ".'=' returned invalid value: "
                & Boolean'Image (Res) & " when we expected: true");

      Res := To_Object_Test (N) = To_Object ("Something" & V);
      T.Assert (Condition => Res = False,
                Message   => Test_Name & ".'=' returned invalid value: "
                & Boolean'Image (Res) & " where we expected: False");
   end Test_Eq;
   procedure Test_Eq is new Test_Basic_Object (Test_Eq);

   --  ------------------------------
   --  Test EL.Objects."="
   --  ------------------------------
   procedure Test_Perf (T : Test; V : String; N : Test_Type) is
      pragma Unreferenced (T, V);

      use Ada.Calendar;

      Start : Ada.Calendar.Time;
      Value : constant EL.Objects.Object := To_Object_Test (N);
      D     : Duration;
   begin
      Start := Ada.Calendar.Clock;
      for I in 1 .. 1_000 loop
         declare
            V : EL.Objects.Object := Value;
         begin
            V := V + V;

            pragma Unreferenced (V);
         end;
      end loop;
      D := Ada.Calendar.Clock - Start;
      Ada.Text_IO.Put_Line ("Perf " & Test_Name & ": " & Duration'Image (D * 1000.0));
   end Test_Perf;
   procedure Test_Perf is new Test_Basic_Object (Test_Perf);

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test EL.Objects.To_Object." & Test_Name,
                       Test_To_Object'Access);
      Caller.Add_Test (Suite, "Test EL.Objects.To_String." & Test_Name,
                       Test_To_Object'Access);
      Caller.Add_Test (Suite, "Test EL.Objects.'='." & Test_Name,
                       Test_Eq'Access);
      Caller.Add_Test (Suite, "Test EL.Objects.'+'." & Test_Name,
                       Test_Add'Access);
      Caller.Add_Test (Suite, "Test EL.Objects.'-'." & Test_Name,
                       Test_Sub'Access);
      Caller.Add_Test (Suite, "Test EL.Objects.'<'." & Test_Name,
                       Test_Lt_Gt'Access);
      Caller.Add_Test (Suite, "Test EL.Objects.'>'." & Test_Name,
                       Test_Lt_Gt'Access);
      Caller.Add_Test (Suite, "Performance EL.Objects.'>'." & Test_Name,
                       Test_Perf'Access);
      Caller.Add_Test (Suite, "Test EL.Objects.Hash." & Test_Name,
                       Test_Hash'Access);
   end Add_Tests;

end EL.Objects.Discrete_Tests;

Use the test name EL.Objects

Use the test name EL.Objects


-----------------------------------------------------------------------
--  ADO Drivers -- Database Drivers
--  Copyright (C) 2010, 2011, 2012, 2016, 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.Finalization;

with ADO.Statements;
with ADO.Schemas;
with ADO.Configs;
with Util.Strings;
with Util.Strings.Vectors;
with Util.Refs;

--  The <b>ADO.Drivers</b> package represents the database driver that will create
--  database connections and provide the database specific implementation.
package ADO.Drivers.Connections is

   use ADO.Statements;

   type Driver;
   type Driver_Access is access all Driver'Class;

   --  ------------------------------
   --  Database connection implementation
   --  ------------------------------
   --
   type Database_Connection is abstract new Util.Refs.Ref_Entity with record
      Ident : String (1 .. 8) := (others => ' ');
   end record;
   type Database_Connection_Access is access all Database_Connection'Class;

   --  Get the database driver index.
   function Get_Driver_Index (Database : in Database_Connection) return Driver_Index;

   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement_Access is abstract;

   function Create_Statement (Database : in Database_Connection;
                              Query    : in String)
                              return Query_Statement_Access is abstract;

   --  Create a delete statement.
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement_Access is abstract;

   --  Create an insert statement.
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement_Access is abstract;

   --  Create an update statement.
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement_Access is abstract;

   --  Start a transaction.
   procedure Begin_Transaction (Database : in out Database_Connection) is abstract;

   --  Commit the current transaction.
   procedure Commit (Database : in out Database_Connection) is abstract;

   --  Rollback the current transaction.
   procedure Rollback (Database : in out Database_Connection) is abstract;

   --  Load the database schema definition for the current database.
   procedure Load_Schema (Database : in Database_Connection;
                          Schema   : out ADO.Schemas.Schema_Definition) is abstract;

   --  Get the database driver which manages this connection.
   function Get_Driver (Database : in Database_Connection)
                        return Driver_Access is abstract;

   --  Closes the database connection
   procedure Close (Database : in out Database_Connection) is abstract;

   package Ref is
      new Util.Refs.Indefinite_References (Element_Type   => Database_Connection'Class,
                                           Element_Access => Database_Connection_Access);

   --  ------------------------------
   --  The database configuration properties
   --  ------------------------------
   type Configuration is new ADO.Configs.Configuration with null record;

   --  Get the driver index that corresponds to the driver for this database connection string.
   function Get_Driver (Config : in Configuration) return Driver_Index;

   --  Create a new connection using the configuration parameters.
   procedure Create_Connection (Config : in Configuration'Class;
                                Result : in out Ref.Ref'Class);

   --  ------------------------------
   --  Database Driver
   --  ------------------------------
   type Driver is abstract tagged limited private;

   --  Create a new connection using the configuration parameters.
   procedure Create_Connection (D      : in out Driver;
                                Config : in Configuration'Class;
                                Result : in out Ref.Ref'Class) is abstract;

   --  Create the database and initialize it with the schema SQL file.
   --  The `Admin` parameter describes the database connection with administrator access.
   --  The `Config` parameter describes the target database connection.
   procedure Create_Database (D           : in out Driver;
                              Admin       : in Configs.Configuration'Class;
                              Config      : in Configs.Configuration'Class;
                              Schema_Path : in String;
                              Messages    : out Util.Strings.Vectors.Vector) is abstract;

   --  Get the driver unique index.
   function Get_Driver_Index (D : in Driver) return Driver_Index;

   --  Get the driver name.
   function Get_Driver_Name (D : in Driver) return String;

   --  Register a database driver.
   procedure Register (Driver : in Driver_Access);

   --  Get a database driver given its name.
   function Get_Driver (Name : in String) return Driver_Access;

private

   type Driver is abstract new Ada.Finalization.Limited_Controlled with record
      Name  : Util.Strings.Name_Access;
      Index : Driver_Index;
   end record;

end ADO.Drivers.Connections;

-----------------------------------------------------------------------
--  ADO Drivers -- Database Drivers
--  Copyright (C) 2010, 2011, 2012, 2016, 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.Finalization;

with ADO.Statements;
with ADO.Schemas;
with ADO.Configs;
with Util.Strings;
with Util.Strings.Vectors;
with Util.Refs;

--  The <b>ADO.Drivers</b> package represents the database driver that will create
--  database connections and provide the database specific implementation.
package ADO.Drivers.Connections is

   use ADO.Statements;

   type Driver is abstract tagged limited private;
   type Driver_Access is access all Driver'Class;

   --  ------------------------------
   --  Database connection implementation
   --  ------------------------------
   --
   type Database_Connection is abstract new Util.Refs.Ref_Entity with record
      Ident : String (1 .. 8) := (others => ' ');
   end record;
   type Database_Connection_Access is access all Database_Connection'Class;

   --  Get the database driver index.
   function Get_Driver_Index (Database : in Database_Connection) return Driver_Index;

   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement_Access is abstract;

   function Create_Statement (Database : in Database_Connection;
                              Query    : in String)
                              return Query_Statement_Access is abstract;

   --  Create a delete statement.
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement_Access is abstract;

   --  Create an insert statement.
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement_Access is abstract;

   --  Create an update statement.
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement_Access is abstract;

   --  Start a transaction.
   procedure Begin_Transaction (Database : in out Database_Connection) is abstract;

   --  Commit the current transaction.
   procedure Commit (Database : in out Database_Connection) is abstract;

   --  Rollback the current transaction.
   procedure Rollback (Database : in out Database_Connection) is abstract;

   --  Load the database schema definition for the current database.
   procedure Load_Schema (Database : in Database_Connection;
                          Schema   : out ADO.Schemas.Schema_Definition) is abstract;

   --  Get the database driver which manages this connection.
   function Get_Driver (Database : in Database_Connection)
                        return Driver_Access is abstract;

   --  Closes the database connection
   procedure Close (Database : in out Database_Connection) is abstract;

   package Ref is
      new Util.Refs.Indefinite_References (Element_Type   => Database_Connection'Class,
                                           Element_Access => Database_Connection_Access);

   --  ------------------------------
   --  The database configuration properties
   --  ------------------------------
   type Configuration is new ADO.Configs.Configuration with null record;

   --  Get the driver index that corresponds to the driver for this database connection string.
   function Get_Driver (Config : in Configuration) return Driver_Index;

   --  Create a new connection using the configuration parameters.
   procedure Create_Connection (Config : in Configuration'Class;
                                Result : in out Ref.Ref'Class);

   --  ------------------------------
   --  Database Driver
   --  ------------------------------

   --  Create a new connection using the configuration parameters.
   procedure Create_Connection (D      : in out Driver;
                                Config : in Configuration'Class;
                                Result : in out Ref.Ref'Class) is abstract;

   --  Create the database and initialize it with the schema SQL file.
   --  The `Admin` parameter describes the database connection with administrator access.
   --  The `Config` parameter describes the target database connection.
   procedure Create_Database (D           : in out Driver;
                              Admin       : in Configs.Configuration'Class;
                              Config      : in Configs.Configuration'Class;
                              Schema_Path : in String;
                              Messages    : out Util.Strings.Vectors.Vector) is abstract;

   --  Get the driver unique index.
   function Get_Driver_Index (D : in Driver) return Driver_Index;

   --  Get the driver name.
   function Get_Driver_Name (D : in Driver) return String;

   --  Register a database driver.
   procedure Register (Driver : in Driver_Access);

   --  Get a database driver given its name.
   function Get_Driver (Name : in String) return Driver_Access;

private

   type Driver is abstract new Ada.Finalization.Limited_Controlled with record
      Name  : Util.Strings.Name_Access;
      Index : Driver_Index;
   end record;

end ADO.Drivers.Connections;

Revert change to make the Driver type declaration near its methods (this was ok with GNAT 2018 but fails with FSF gcc 4.9.3)


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

   use Ada.Strings.Unbounded;

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Bbox.API");

   --  ------------------------------
   --  Set the server IP address.
   --  ------------------------------
   procedure Set_Server (Client : in out Client_Type;
                         Server : in String) is
   begin
      Log.Debug ("Using bbox server {0}", Server);
      Client.Server := Ada.Strings.Unbounded.To_Unbounded_String (Server);
   end Set_Server;

   --  ------------------------------
   --  Internal operation to get the URI based on the operation being called.
   --  ------------------------------
   function Get_URI (Client    : in Client_Type;
                     Operation : in String) return String is
   begin
      return "http://" & To_String (Client.Server) & "/api/v1/" & Operation;
   end Get_URI;

   --  ------------------------------
   --  Login to the server Bbox API with the password.
   --  ------------------------------
   procedure Login (Client   : in out Client_Type;
                    Password : in String) is
      procedure Process (Name, Value : in String);

      URI      : constant String := Client.Get_URI ("login");
      Response : Util.Http.Clients.Response;

      procedure Process (Name, Value : in String) is
         Pos, Last : Natural;
      begin
         if Name = "Set-Cookie" then
            Pos := Util.Strings.Index (Value, '=');
            if Pos = 0 then
               return;
            end if;
            Last := Util.Strings.Index (Value, ';');
            if Last = 0 or else Last < Pos then
               return;
            end if;
            Client.Http.Set_Header ("Cookie", Value (Value'First .. Last - 1));
         end if;
      end Process;

   begin
      Log.Debug ("Login to {0}", URI);
      Client.Http.Add_Header ("X-Requested-By", "Bbox Ada Api");
      Client.Http.Post (URI, "password=" & Password, Response);
      if Response.Get_Status = Util.Http.SC_OK then
         Response.Iterate_Headers (Process'Access);
      else
         Log.Error ("Connection and login to {0} failed", URI);
      end if;
   end Login;

   --  ------------------------------
   --  Execute a GET operation on the Bbox API to retrieve the result into the property list.
   --  ------------------------------
   procedure Get (Client    : in out Client_Type;
                  Operation : in String;
                  Result    : in out Util.Properties.Manager) is
      URI      : constant String := Client.Get_URI (Operation);
      Response : Util.Http.Clients.Response;
   begin
      Log.Debug ("Get {0}", URI);
      Client.Http.Get (URI, Response);
      Util.Properties.JSON.Parse_JSON (Result, Response.Get_Body);
   end Get;

   --  ------------------------------
   --  Execute a GET operation on the Bbox API to retrieve the JSON result and return it.
   --  ------------------------------
   function Get (Client    : in out Client_Type;
                 Operation : in String) return String is
      URI      : constant String := Client.Get_URI (Operation);
      Response : Util.Http.Clients.Response;
   begin
      Log.Debug ("Get {0}", URI);
      Client.Http.Get (URI, Response);
      return Response.Get_Body;
   end Get;

   --  ------------------------------
   --  Execute a PUT operation on the Bbox API to change some parameter.
   --  ------------------------------
   procedure Put (Client    : in out Client_Type;
                  Operation : in String;
                  Params    : in String) is
      URI      : constant String := Client.Get_URI (Operation);
      Response : Util.Http.Clients.Response;
   begin
      Log.Debug ("Put {0}", URI);
      Client.Http.Put (URI, Params, Response);
   end Put;

end Bbox.API;

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

   use Ada.Strings.Unbounded;

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Bbox.API");

   function Strip_Unecessary_Array (Content : in String) return String;

   --  ------------------------------
   --  Set the server IP address.
   --  ------------------------------
   procedure Set_Server (Client : in out Client_Type;
                         Server : in String) is
   begin
      Log.Debug ("Using bbox server {0}", Server);
      Client.Server := Ada.Strings.Unbounded.To_Unbounded_String (Server);
   end Set_Server;

   --  ------------------------------
   --  Internal operation to get the URI based on the operation being called.
   --  ------------------------------
   function Get_URI (Client    : in Client_Type;
                     Operation : in String) return String is
   begin
      return "http://" & To_String (Client.Server) & "/api/v1/" & Operation;
   end Get_URI;

   --  ------------------------------
   --  Login to the server Bbox API with the password.
   --  ------------------------------
   procedure Login (Client   : in out Client_Type;
                    Password : in String) is
      procedure Process (Name, Value : in String);

      URI      : constant String := Client.Get_URI ("login");
      Response : Util.Http.Clients.Response;

      procedure Process (Name, Value : in String) is
         Pos, Last : Natural;
      begin
         if Name = "Set-Cookie" then
            Pos := Util.Strings.Index (Value, '=');
            if Pos = 0 then
               return;
            end if;
            Last := Util.Strings.Index (Value, ';');
            if Last = 0 or else Last < Pos then
               return;
            end if;
            Client.Http.Set_Header ("Cookie", Value (Value'First .. Last - 1));
         end if;
      end Process;

   begin
      Log.Debug ("Login to {0}", URI);
      Client.Http.Add_Header ("X-Requested-By", "Bbox Ada Api");
      Client.Http.Post (URI, "password=" & Password, Response);
      if Response.Get_Status = Util.Http.SC_OK then
         Response.Iterate_Headers (Process'Access);
      else
         Log.Error ("Connection and login to {0} failed", URI);
      end if;
   end Login;

   --  ------------------------------
   --  Strip [] for some Json content.
   --  We did a mistake when we designed the Bbox API and used '[' ... ']' arrays
   --  for most of the JSON result.  Strip that unecessary array.
   --  ------------------------------
   function Strip_Unecessary_Array (Content : in String) return String is
      Last      : Natural := Content'Last;
   begin
      while Last > Content'First and Content (Last) = ASCII.LF loop
         Last := Last - 1;
      end loop;
      if Content (Content'First) = '[' and Content (Last) = ']' then
         return Content (Content'First + 1 .. Last - 1);
      else
         return Content;
      end if;
   end Strip_Unecessary_Array;

   --  ------------------------------
   --  Execute a GET operation on the Bbox API to retrieve the result into the property list.
   --  ------------------------------
   procedure Get (Client    : in out Client_Type;
                  Operation : in String;
                  Result    : in out Util.Properties.Manager) is
      URI      : constant String := Client.Get_URI (Operation);
      Response : Util.Http.Clients.Response;
   begin
      Log.Debug ("Get {0}", URI);
      Client.Http.Get (URI, Response);
      Util.Properties.JSON.Parse_JSON (Result, Strip_Unecessary_Array (Response.Get_Body));
   end Get;

   --  ------------------------------
   --  Execute a GET operation on the Bbox API to retrieve the JSON result and return it.
   --  ------------------------------
   function Get (Client    : in out Client_Type;
                 Operation : in String) return String is
      URI      : constant String := Client.Get_URI (Operation);
      Response : Util.Http.Clients.Response;
   begin
      Log.Debug ("Get {0}", URI);
      Client.Http.Get (URI, Response);
      return Response.Get_Body;
   end Get;

   --  ------------------------------
   --  Execute a PUT operation on the Bbox API to change some parameter.
   --  ------------------------------
   procedure Put (Client    : in out Client_Type;
                  Operation : in String;
                  Params    : in String) is
      URI      : constant String := Client.Get_URI (Operation);
      Response : Util.Http.Clients.Response;
   begin
      Log.Debug ("Put {0}", URI);
      Client.Http.Put (URI, Params, Response);
   end Put;

end Bbox.API;

Declare Strip_Unecessary_Array function and use it to strip the stupid JSON array we introduced by mistake in the Bboxd API JSON output


-----------------------------------------------------------------------
--  mat-commands -- Command support and execution
--  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 GNAT.Sockets;

with MAT.Targets;
package MAT.Commands is

   Stop_Interp : exception;

   --  The options that can be configured through the command line.
   type Options_Type is record
      Interactive : Boolean := True;
      Graphical   : Boolean := False;
      Address     : GNAT.Sockets.Sock_Addr_Type := (Port => 4096, others => <>);
   end record;

   --  Procedure that defines a command handler.
   type Command_Handler is access procedure (Target : in out MAT.Targets.Target_Type'Class;
                                             Args   : in String);

   --  Execute the command given in the line.
   procedure Execute (Target : in out MAT.Targets.Target_Type'Class;
                      Line   : in String);

   --  Enter in the interactive loop reading the commands from the standard input
   --  and executing the commands.
   procedure Interactive (Target : in out MAT.Targets.Target_Type'Class);

   --  Parse the command line arguments and configure the target instance.
   procedure Initialize_Options (Target  : in out MAT.Targets.Target_Type'Class;
                                 Options : in out Options_Type);

end MAT.Commands;

-----------------------------------------------------------------------
--  mat-commands -- Command support and execution
--  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 GNAT.Sockets;

with MAT.Targets;
package MAT.Commands is

   Stop_Interp : exception;

   --  The options that can be configured through the command line.
   type Options_Type is record
      Interactive : Boolean := True;
      Graphical   : Boolean := False;
      Address     : GNAT.Sockets.Sock_Addr_Type := (Port => 4096, others => <>);
   end record;

   --  Procedure that defines a command handler.
   type Command_Handler is access procedure (Target : in out MAT.Targets.Target_Type'Class;
                                             Args   : in String);

   --  Execute the command given in the line.
   procedure Execute (Target : in out MAT.Targets.Target_Type'Class;
                      Line   : in String);

   --  Enter in the interactive loop reading the commands from the standard input
   --  and executing the commands.
   procedure Interactive (Target : in out MAT.Targets.Target_Type'Class);

   --  Parse the command line arguments and configure the target instance.
   procedure Initialize_Options (Target  : in out MAT.Targets.Target_Type'Class;
                                 Options : in out Options_Type);

   --  Convert the string to a socket address.  The string can have two forms:
   --     port
   --     host:port
   function To_Sock_Addr_Type (Param : in String) return GNAT.Sockets.Sock_Addr_Type;

end MAT.Commands;

Declare the To_Sock_Addr_Type function

Declare the To_Sock_Addr_Type function


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

with AWA.Services.Contexts;
with AWA.Questions.Services;
package body AWA.Questions.Beans is

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Question_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "count" then
         return Util.Beans.Objects.To_Object (From.Count);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Question_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "count" then
         From.Count := Util.Beans.Objects.To_Integer (Value);
      end if;
   end Set_Value;

   procedure Save (Bean : in out Question_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Manager : constant Services.Question_Service_Access := Bean.Module.Get_Question_Manager;
   begin
      Manager.Save_Question (Bean);
   end Save;

   procedure Delete (Bean : in out Question_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      null;
   end Delete;

   --  ------------------------------
   --  Create the Question_Bean bean instance.
   --  ------------------------------
   function Create_Question_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Question_Bean_Access := new Question_Bean;
   begin
      Object.Module := Module;
      return Object.all'Access;
   end Create_Question_Bean;

   --  ------------------------------
   --  Create the Question_Info_List_Bean bean instance.
   --  ------------------------------
   function Create_Question_List_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                       return Util.Beans.Basic.Readonly_Bean_Access is
      use AWA.Questions.Models;
      use AWA.Services;

      Ctx     : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      Object  : constant Question_Info_List_Bean_Access := new Question_Info_List_Bean;
      Session : ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;
   begin
      Query.Set_Query (AWA.Questions.Models.Query_Question_List);
      AWA.Questions.Models.List (Object.all, Session, Query);
      return Object.all'Access;
   end Create_Question_List_Bean;

end AWA.Questions.Beans;

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

with AWA.Services.Contexts;
with AWA.Questions.Services;
package body AWA.Questions.Beans is

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Question_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if From.Is_Null then
         return Util.Beans.Objects.Null_Object;
      else
         return AWA.Questions.Models.Question_Bean (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Question_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "title" then
         From.Set_Title (Util.Beans.Objects.To_String (Value));

      elsif Name = "description" then
         From.Set_Description (Util.Beans.Objects.To_String (Value));

      elsif Name = "id" and not Util.Beans.Objects.Is_Empty (Value) then
            From.Service.Load_Question (From,
                                        ADO.Identifier (Util.Beans.Objects.To_Integer (Value)));
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create or save the question.
   --  ------------------------------
   procedure Save (Bean    : in out Question_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Bean.Service.Save_Question (Bean);
   end Save;

   --  ------------------------------
   --  Delete the question.
   --  ------------------------------
   procedure Delete (Bean    : in out Question_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Bean.Service.Delete_Question (Bean);
   end Delete;

   --  ------------------------------
   --  Create the Question_Bean bean instance.
   --  ------------------------------
   function Create_Question_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Question_Bean_Access := new Question_Bean;
   begin
      Object.Service := Module.Get_Question_Manager;
      return Object.all'Access;
   end Create_Question_Bean;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Answer_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if From.Is_Null then
         return Util.Beans.Objects.Null_Object;
      else
         return AWA.Questions.Models.Answer_Bean (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Answer_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "id" then
         null;

      elsif Name = "answer" then
         From.Set_Answer (Util.Beans.Objects.To_String (Value));

      elsif Name = "question_id" and not Util.Beans.Objects.Is_Null (Value) then
         From.Service.Load_Question (From.Question,
                                     ADO.Identifier (Util.Beans.Objects.To_Integer (Value)));
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create or save the answer.
   --  ------------------------------
   procedure Save (Bean    : in out Answer_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Bean.Service.Save_Answer (Question => Bean.Question,
                                Answer   => Bean);
   end Save;

   --  Delete the question.
   procedure Delete (Bean    : in out Answer_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      null;
   end Delete;

   --  ------------------------------
   --  Create the Question_Info_List_Bean bean instance.
   --  ------------------------------
   function Create_Question_List_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                       return Util.Beans.Basic.Readonly_Bean_Access is
      use AWA.Questions.Models;
      use AWA.Services;

      Ctx     : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      Object  : constant Question_Info_List_Bean_Access := new Question_Info_List_Bean;
      Session : ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;
   begin
      Query.Set_Query (AWA.Questions.Models.Query_Question_List);
      AWA.Questions.Models.List (Object.all, Session, Query);
      return Object.all'Access;
   end Create_Question_List_Bean;

end AWA.Questions.Beans;

Implement the answer bean

Implement the answer bean


-----------------------------------------------------------------------
--  asf.beans -- Bean Registration and Factory
--  Copyright (C) 2009, 2010, 2011 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;
package body ASF.Beans is

   use Util.Log;

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

   --  ------------------------------
   --  Register under the name identified by Name the class instance Class.
   --  ------------------------------
   procedure Register_Class (Factory : in out Bean_Factory;
                             Name    : in String;
                             Class   : in Class_Binding_Access) is
   begin
      Log.Info ("Register bean class {0}", Name);

      Factory.Registry.Include (Name, Class_Binding_Ref.Create (Class));
   end Register_Class;

   --  ------------------------------
   --  Register under the name identified by Name a function to create a bean.
   --  This is a simplified class registration.
   --  ------------------------------
   procedure Register_Class (Factory : in out Bean_Factory;
                             Name    : in String;
                             Handler : in Create_Bean_Access) is
      Class : Default_Class_Binding_Access := new Default_Class_Binding;
   begin
      Class.Create := Handler;
      Register_Class (Factory, Name, Class.all'Access);
   end Register_Class;

   --  ------------------------------
   --  Register the bean identified by Name and associated with the class Class.
   --  The class must have been registered by using the Register class operation.
   --  The scope defines the scope of the bean.
   --  ------------------------------
   procedure Register (Factory : in out Bean_Factory;
                       Name    : in String;
                       Class   : in String;
                       Params  : in Parameter_Bean_Ref.Ref;
                       Scope   : in Scope_Type := REQUEST_SCOPE) is
   begin
      Log.Info ("Register bean '{0}' created by '{1}' in scope {2}",
                Name, Class, Scope_Type'Image (Scope));

      declare
         Pos     : constant Registry_Maps.Cursor := Factory.Registry.Find (Class);
         Binding : Bean_Binding;
      begin
         if not Registry_Maps.Has_Element (Pos) then
            Log.Error ("Class '{0}' does not exist.  Cannot register bean '{1}'",
                       Class, Name);
            return;
         end if;
         Binding.Create := Registry_Maps.Element (Pos);
         Binding.Scope  := Scope;
         Binding.Params := Params;
         Factory.Map.Include (Ada.Strings.Unbounded.To_Unbounded_String (Name), Binding);
      end;
   end Register;

   --  ------------------------------
   --  Register the bean identified by Name and associated with the class Class.
   --  The class must have been registered by using the Register class operation.
   --  The scope defines the scope of the bean.
   --  ------------------------------
   procedure Register (Factory : in out Bean_Factory;
                       Name    : in String;
                       Class   : in Class_Binding_Access;
                       Params  : in Parameter_Bean_Ref.Ref;
                       Scope   : in Scope_Type := REQUEST_SCOPE) is
      Binding : Bean_Binding;
   begin
      Log.Info ("Register bean '{0}' in scope {2}",
                Name, Scope_Type'Image (Scope));

      Binding.Create := Class_Binding_Ref.Create (Class);
      Binding.Scope  := Scope;
      Binding.Params := Params;
      Factory.Map.Include (Ada.Strings.Unbounded.To_Unbounded_String (Name), Binding);
   end Register;

   --  ------------------------------
   --  Register all the definitions from a factory to a main factory.
   --  ------------------------------
   procedure Register (Factory : in out Bean_Factory;
                       From    : in Bean_Factory) is
   begin
      declare
         Pos : Registry_Maps.Cursor := From.Registry.First;
      begin
         while Registry_Maps.Has_Element (Pos) loop
            Factory.Registry.Include (Key      => Registry_Maps.Key (Pos),
                                      New_Item => Registry_Maps.Element (Pos));
            Registry_Maps.Next (Pos);
         end loop;
      end;
      declare
         Pos : Bean_Maps.Cursor := Bean_Maps.First (From.Map);
      begin
         while Bean_Maps.Has_Element (Pos) loop
            Factory.Map.Include (Key      => Bean_Maps.Key (Pos),
                                 New_Item => Bean_Maps.Element (Pos));
            Bean_Maps.Next (Pos);
         end loop;
      end;
   end Register;

   --  ------------------------------
   --  Create a bean by using the create operation registered for the name
   --  ------------------------------
   procedure Create (Factory : in Bean_Factory;
                     Name    : in Unbounded_String;
                     Context : in EL.Contexts.ELContext'Class;
                     Result  : out Util.Beans.Basic.Readonly_Bean_Access;
                     Scope   : out Scope_Type) is
      use type Util.Beans.Basic.Readonly_Bean_Access;
      Pos : constant Bean_Maps.Cursor := Factory.Map.Find (Name);
   begin
      if Bean_Maps.Has_Element (Pos) then
         declare
            Binding : constant Bean_Binding := Bean_Maps.Element (Pos);
         begin
            Binding.Create.Value.Create (Name, Result);
            if Result /= null and then not Binding.Params.Is_Null then
               if Result.all in Util.Beans.Basic.Bean'Class then
                  EL.Beans.Initialize (Util.Beans.Basic.Bean'Class (Result.all),
                                       Binding.Params.Value.Params,
                                       Context);
               else
                  Log.Warn ("Bean {0} cannot be set with pre-defined properties as it does "
                            & "not implement the Bean interface", To_String (Name));
               end if;
            end if;
            Scope := Binding.Scope;
         end;
      else
         Result := null;
         Scope := ANY_SCOPE;
      end if;
   end Create;

   --  ------------------------------
   --  Create a bean by using the registered create function.
   --  ------------------------------
   procedure Create (Factory : in Default_Class_Binding;
                     Name    : in Ada.Strings.Unbounded.Unbounded_String;
                     Result  : out Util.Beans.Basic.Readonly_Bean_Access) is
      pragma Unreferenced (Name);
   begin
      Result := Factory.Create.all;
   end Create;

end ASF.Beans;

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

with Util.Log.Loggers;
package body ASF.Beans is

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

   --  ------------------------------
   --  Register under the name identified by Name the class instance Class.
   --  ------------------------------
   procedure Register_Class (Factory : in out Bean_Factory;
                             Name    : in String;
                             Class   : in Class_Binding_Access) is
   begin
      Log.Info ("Register bean class {0}", Name);

      Factory.Registry.Include (Name, Class_Binding_Ref.Create (Class));
   end Register_Class;

   --  ------------------------------
   --  Register under the name identified by Name a function to create a bean.
   --  This is a simplified class registration.
   --  ------------------------------
   procedure Register_Class (Factory : in out Bean_Factory;
                             Name    : in String;
                             Handler : in Create_Bean_Access) is
      Class : constant Default_Class_Binding_Access := new Default_Class_Binding;
   begin
      Class.Create := Handler;
      Register_Class (Factory, Name, Class.all'Access);
   end Register_Class;

   --  ------------------------------
   --  Register the bean identified by Name and associated with the class Class.
   --  The class must have been registered by using the Register class operation.
   --  The scope defines the scope of the bean.
   --  ------------------------------
   procedure Register (Factory : in out Bean_Factory;
                       Name    : in String;
                       Class   : in String;
                       Params  : in Parameter_Bean_Ref.Ref;
                       Scope   : in Scope_Type := REQUEST_SCOPE) is
   begin
      Log.Info ("Register bean '{0}' created by '{1}' in scope {2}",
                Name, Class, Scope_Type'Image (Scope));

      declare
         Pos     : constant Registry_Maps.Cursor := Factory.Registry.Find (Class);
         Binding : Bean_Binding;
      begin
         if not Registry_Maps.Has_Element (Pos) then
            Log.Error ("Class '{0}' does not exist.  Cannot register bean '{1}'",
                       Class, Name);
            return;
         end if;
         Binding.Create := Registry_Maps.Element (Pos);
         Binding.Scope  := Scope;
         Binding.Params := Params;
         Factory.Map.Include (Ada.Strings.Unbounded.To_Unbounded_String (Name), Binding);
      end;
   end Register;

   --  ------------------------------
   --  Register the bean identified by Name and associated with the class Class.
   --  The class must have been registered by using the Register class operation.
   --  The scope defines the scope of the bean.
   --  ------------------------------
   procedure Register (Factory : in out Bean_Factory;
                       Name    : in String;
                       Class   : in Class_Binding_Access;
                       Params  : in Parameter_Bean_Ref.Ref;
                       Scope   : in Scope_Type := REQUEST_SCOPE) is
      Binding : Bean_Binding;
   begin
      Log.Info ("Register bean '{0}' in scope {2}",
                Name, Scope_Type'Image (Scope));

      Binding.Create := Class_Binding_Ref.Create (Class);
      Binding.Scope  := Scope;
      Binding.Params := Params;
      Factory.Map.Include (Ada.Strings.Unbounded.To_Unbounded_String (Name), Binding);
   end Register;

   --  ------------------------------
   --  Register all the definitions from a factory to a main factory.
   --  ------------------------------
   procedure Register (Factory : in out Bean_Factory;
                       From    : in Bean_Factory) is
   begin
      declare
         Pos : Registry_Maps.Cursor := From.Registry.First;
      begin
         while Registry_Maps.Has_Element (Pos) loop
            Factory.Registry.Include (Key      => Registry_Maps.Key (Pos),
                                      New_Item => Registry_Maps.Element (Pos));
            Registry_Maps.Next (Pos);
         end loop;
      end;
      declare
         Pos : Bean_Maps.Cursor := Bean_Maps.First (From.Map);
      begin
         while Bean_Maps.Has_Element (Pos) loop
            Factory.Map.Include (Key      => Bean_Maps.Key (Pos),
                                 New_Item => Bean_Maps.Element (Pos));
            Bean_Maps.Next (Pos);
         end loop;
      end;
   end Register;

   --  ------------------------------
   --  Create a bean by using the create operation registered for the name
   --  ------------------------------
   procedure Create (Factory : in Bean_Factory;
                     Name    : in Unbounded_String;
                     Context : in EL.Contexts.ELContext'Class;
                     Result  : out Util.Beans.Basic.Readonly_Bean_Access;
                     Scope   : out Scope_Type) is
      use type Util.Beans.Basic.Readonly_Bean_Access;
      Pos : constant Bean_Maps.Cursor := Factory.Map.Find (Name);
   begin
      if Bean_Maps.Has_Element (Pos) then
         declare
            Binding : constant Bean_Binding := Bean_Maps.Element (Pos);
         begin
            Binding.Create.Value.Create (Name, Result);
            if Result /= null and then not Binding.Params.Is_Null then
               if Result.all in Util.Beans.Basic.Bean'Class then
                  EL.Beans.Initialize (Util.Beans.Basic.Bean'Class (Result.all),
                                       Binding.Params.Value.Params,
                                       Context);
               else
                  Log.Warn ("Bean {0} cannot be set with pre-defined properties as it does "
                            & "not implement the Bean interface", To_String (Name));
               end if;
            end if;
            Scope := Binding.Scope;
         end;
      else
         Result := null;
         Scope := ANY_SCOPE;
      end if;
   end Create;

   --  ------------------------------
   --  Create a bean by using the registered create function.
   --  ------------------------------
   procedure Create (Factory : in Default_Class_Binding;
                     Name    : in Ada.Strings.Unbounded.Unbounded_String;
                     Result  : out Util.Beans.Basic.Readonly_Bean_Access) is
      pragma Unreferenced (Name);
   begin
      Result := Factory.Create.all;
   end Create;

end ASF.Beans;

Fix compilation warning

Fix compilation warning


-----------------------------------------------------------------------
--  asf-parts -- ASF Parts
--  Copyright (C) 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;

--  The ASF.Parts package is an Ada implementation of the Java servlet part
--  (JSR 315 3. The Request) provided by the <tt>javax.servlet.http.Part</tt> class.
package ASF.Parts is

   --  ------------------------------
   --  Multi part content
   --  ------------------------------
   --  The Part type describes a mime part received in a request.
   --  The content is stored in a file and several operations are provided
   --  to manage the content.
   type Part is abstract new Ada.Finalization.Limited_Controlled with private;

   --  Get the size of the mime part.
   function Get_Size (Data : in Part) return Natural is abstract;

   --  Get the content name submitted in the mime part.
   function Get_Name (Data : in Part) return String is abstract;

   --  Get the path of the local file which contains the part.
   function Get_Local_Filename (Data : in Part) return String is abstract;

   --  Get the content type of the part.
   function Get_Content_Type (Data : in Part) return String is abstract;

   --  Write the part data item to the file.  This method is not guaranteed to succeed
   --  if called more than once for the same part. This allows a particular implementation
   --  to use, for example, file renaming, where possible, rather than copying all of
   --  the underlying data, thus gaining a significant performance benefit.
   procedure Save (Data : in Part;
                   Path : in String);

   --  Deletes the underlying storage for a file item, including deleting any associated
   --  temporary disk file.
   procedure Delete (Data : in out Part);

private

   type Part is abstract new Ada.Finalization.Limited_Controlled with null record;

end ASF.Parts;

-----------------------------------------------------------------------
--  asf-parts -- ASF Parts
--  Copyright (C) 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 Servlet.Parts;

--  The ASF.Parts package is an Ada implementation of the Java servlet part
--  (JSR 315 3. The Request) provided by the <tt>javax.servlet.http.Part</tt> class.
package ASF.Parts is

   --  ------------------------------
   --  Multi part content
   --  ------------------------------
   --  The Part type describes a mime part received in a request.
   --  The content is stored in a file and several operations are provided
   --  to manage the content.
   subtype Part is Servlet.Parts.Part;

   --  Get the size of the mime part.
   function Get_Size (Data : in Part) return Natural is abstract;

   --  Get the content name submitted in the mime part.
   function Get_Name (Data : in Part) return String is abstract;

   --  Get the path of the local file which contains the part.
   function Get_Local_Filename (Data : in Part) return String is abstract;

   --  Get the content type of the part.
   function Get_Content_Type (Data : in Part) return String is abstract;

   --  Write the part data item to the file.  This method is not guaranteed to succeed
   --  if called more than once for the same part. This allows a particular implementation
   --  to use, for example, file renaming, where possible, rather than copying all of
   --  the underlying data, thus gaining a significant performance benefit.
   procedure Save (Data : in Part;
                   Path : in String);

   --  Deletes the underlying storage for a file item, including deleting any associated
   --  temporary disk file.
   procedure Delete (Data : in out Part);

end ASF.Parts;

Package ASF.Parts moved to Servlet.Parts


-----------------------------------------------------------------------
--  Util.Files -- Various File Utility Packages
--  Copyright (C) 2001, 2002, 2003, 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.Strings.Unbounded;
with Util.Strings.Maps;
package Util.Files is

   use Ada.Strings.Unbounded;

   subtype Direction is Ada.Strings.Direction;

   --  Read a complete file into a string.
   --  The Max_Size parameter indicates the maximum size that is read.
   procedure Read_File (Path     : in String;
                        Into     : out Unbounded_String;
                        Max_Size : in Natural := 0);

   --  Read the file with the given path, one line at a time and execute the Process
   --  procedure with each line as argument.
   procedure Read_File (Path     : in String;
                        Process  : not null access procedure (Line : in String));

   --  Save the string into a file creating the file if necessary
   procedure Write_File (Path    : in String;
                         Content : in String);

   --  Save the string into a file creating the file if necessary
   procedure Write_File (Path    : in String;
                         Content : in Unbounded_String);

   --  Iterate over the search directories defined in Path and execute
   --  Process with each directory until it returns True in Done
   --  or the last search directory is found.  Each search directory
   --  is separated by ';' (yes, even on Unix).  When Going is set to Backward, the
   --  directories are searched in reverse order.
   procedure Iterate_Path (Path     : in String;
                           Process  : not null access procedure (Dir  : in String;
                                                                 Done : out Boolean);
                           Going    : in Direction := Ada.Strings.Forward);

   --  Iterate over the search directories defined in Path and search
   --  for files matching the pattern defined by Pattern.  For each file,
   --  execute Process with the file basename and the full file path.
   --  Stop iterating when the Process procedure returns True.
   --  Each search directory is separated by ';'.  When Going is set to Backward, the
   --  directories are searched in reverse order.
   procedure Iterate_Files_Path (Pattern  : in String;
                                 Path     : in String;
                                 Process  : not null access procedure (Name : in String;
                                                                       File : in String;
                                                                       Done : out Boolean);
                                 Going    : in Direction := Ada.Strings.Forward);

   --  Find the file in one of the search directories.  Each search directory
   --  is separated by ';' (yes, even on Unix).
   --  Returns the path to be used for reading the file.
   function Find_File_Path (Name  : String;
                            Paths : String) return String;

   --  Find the files which match the pattern in the directories specified in the
   --  search path Path.  Each search directory is separated by ';'.
   --  File names are added to the string set in Into.
   procedure Find_Files_Path (Pattern : in String;
                              Path    : in String;
                              Into    : in out Util.Strings.Maps.Map);

   --  Returns the name of the external file with the specified directory
   --  and the name.  Unlike the Ada.Directories.Compose, the name can represent
   --  a relative path and thus include directory separators.
   function Compose (Directory : in String;
                     Name      : in String) return String;

   --  Compose an existing path by adding the specified name to each path component
   --  and return a new paths having only existing directories.  Each directory is
   --  separated by ';'.
   --  If the composed path exists, it is added to the result path.
   --  Example:
   --    paths = 'web;regtests'  name = 'info'
   --    result = 'web/info;regtests/info'
   --  Returns the composed path.
   function Compose_Path (Paths : in String;
                          Name  : in String) return String;

   --  Returns a relative path whose origin is defined by From and which refers
   --  to the absolute path referenced by To.  Both From and To are
   --  assumed to be absolute pathes.  Returns the absolute path To if the relative
   --  path could not be found.  Both paths must have at least one root component in common.
   function Get_Relative_Path (From : in String;
                               To   : in String) return String;

end Util.Files;

-----------------------------------------------------------------------
--  Util.Files -- Various File Utility Packages
--  Copyright (C) 2001, 2002, 2003, 2009, 2010, 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.Strings.Unbounded;
with Util.Strings.Maps;
with Util.Strings.Vectors;
package Util.Files is

   use Ada.Strings.Unbounded;

   subtype Direction is Ada.Strings.Direction;

   --  Read a complete file into a string.
   --  The Max_Size parameter indicates the maximum size that is read.
   procedure Read_File (Path     : in String;
                        Into     : out Unbounded_String;
                        Max_Size : in Natural := 0);

   --  Read the file with the given path, one line at a time and execute the Process
   --  procedure with each line as argument.
   procedure Read_File (Path     : in String;
                        Process  : not null access procedure (Line : in String));

   --  Read the file with the given path, one line at a time and append each line to
   --  the Into vector.
   procedure Read_File (Path  : in String;
                        Into  : in out Util.Strings.Vectors.Vector);

   --  Save the string into a file creating the file if necessary
   procedure Write_File (Path    : in String;
                         Content : in String);

   --  Save the string into a file creating the file if necessary
   procedure Write_File (Path    : in String;
                         Content : in Unbounded_String);

   --  Iterate over the search directories defined in Path and execute
   --  Process with each directory until it returns True in Done
   --  or the last search directory is found.  Each search directory
   --  is separated by ';' (yes, even on Unix).  When Going is set to Backward, the
   --  directories are searched in reverse order.
   procedure Iterate_Path (Path     : in String;
                           Process  : not null access procedure (Dir  : in String;
                                                                 Done : out Boolean);
                           Going    : in Direction := Ada.Strings.Forward);

   --  Iterate over the search directories defined in Path and search
   --  for files matching the pattern defined by Pattern.  For each file,
   --  execute Process with the file basename and the full file path.
   --  Stop iterating when the Process procedure returns True.
   --  Each search directory is separated by ';'.  When Going is set to Backward, the
   --  directories are searched in reverse order.
   procedure Iterate_Files_Path (Pattern  : in String;
                                 Path     : in String;
                                 Process  : not null access procedure (Name : in String;
                                                                       File : in String;
                                                                       Done : out Boolean);
                                 Going    : in Direction := Ada.Strings.Forward);

   --  Find the file in one of the search directories.  Each search directory
   --  is separated by ';' (yes, even on Unix).
   --  Returns the path to be used for reading the file.
   function Find_File_Path (Name  : String;
                            Paths : String) return String;

   --  Find the files which match the pattern in the directories specified in the
   --  search path Path.  Each search directory is separated by ';'.
   --  File names are added to the string set in Into.
   procedure Find_Files_Path (Pattern : in String;
                              Path    : in String;
                              Into    : in out Util.Strings.Maps.Map);

   --  Returns the name of the external file with the specified directory
   --  and the name.  Unlike the Ada.Directories.Compose, the name can represent
   --  a relative path and thus include directory separators.
   function Compose (Directory : in String;
                     Name      : in String) return String;

   --  Compose an existing path by adding the specified name to each path component
   --  and return a new paths having only existing directories.  Each directory is
   --  separated by ';'.
   --  If the composed path exists, it is added to the result path.
   --  Example:
   --    paths = 'web;regtests'  name = 'info'
   --    result = 'web/info;regtests/info'
   --  Returns the composed path.
   function Compose_Path (Paths : in String;
                          Name  : in String) return String;

   --  Returns a relative path whose origin is defined by From and which refers
   --  to the absolute path referenced by To.  Both From and To are
   --  assumed to be absolute pathes.  Returns the absolute path To if the relative
   --  path could not be found.  Both paths must have at least one root component in common.
   function Get_Relative_Path (From : in String;
                               To   : in String) return String;

end Util.Files;

Declare a Read_File procedure to load the file line by line in a Strings.Vector object


--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

package Definitions is

   pragma Pure;

   raven_version_major : constant String := "0";
   raven_version_minor : constant String := "20";
   copyright_years     : constant String := "2015-2017";

   raven_tool        : constant String := "ravenadm";
   variant_standard  : constant String := "standard";
   contact_nobody    : constant String := "nobody";
   contact_automaton : constant String := "automaton";
   dlgroup_main      : constant String := "main";
   dlgroup_none      : constant String := "none";
   options_none      : constant String := "none";
   options_all       : constant String := "all";
   broken_all        : constant String := "all";
   boolean_yes       : constant String := "yes";
   homepage_none     : constant String := "none";
   spkg_complete     : constant String := "complete";
   spkg_docs         : constant String := "docs";
   spkg_examples     : constant String := "examples";
   ports_default     : constant String := "floating";
   default_ssl       : constant String := "libressl";
   default_mysql     : constant String := "oracle-5.7";
   default_lua       : constant String := "5.3";
   default_perl      : constant String := "5.24";
   default_pgsql     : constant String := "9.6";
   default_python3   : constant String := "3.5";
   default_ruby      : constant String := "2.4";
   default_tcltk     : constant String := "8.6";
   default_compiler  : constant String := "gcc6";
   compiler_version  : constant String := "6.20170202";
   arc_ext           : constant String := ".txz";
   jobs_per_cpu      : constant := 2;

   type supported_opsys is (dragonfly, freebsd, netbsd, openbsd, sunos, linux, macos);
   type supported_arch  is (x86_64, i386, aarch64);

   type cpu_range is range 1 .. 32;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;
   type count_type is (total, success, failure, ignored, skipped);

   --  Modify following with post-patch sed accordingly
   platform_type  : constant supported_opsys := dragonfly;
   host_localbase : constant String := "/raven";
   host_pkg8      : constant String := host_localbase & "/sbin/pkg";
   ravenexec      : constant String := host_localbase & "/libexec/ravenexec";

end Definitions;

--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

package Definitions is

   pragma Pure;

   raven_version_major : constant String := "0";
   raven_version_minor : constant String := "50";
   copyright_years     : constant String := "2015-2017";

   raven_tool        : constant String := "ravenadm";
   variant_standard  : constant String := "standard";
   contact_nobody    : constant String := "nobody";
   contact_automaton : constant String := "automaton";
   dlgroup_main      : constant String := "main";
   dlgroup_none      : constant String := "none";
   options_none      : constant String := "none";
   options_all       : constant String := "all";
   broken_all        : constant String := "all";
   boolean_yes       : constant String := "yes";
   homepage_none     : constant String := "none";
   spkg_complete     : constant String := "complete";
   spkg_docs         : constant String := "docs";
   spkg_examples     : constant String := "examples";
   ports_default     : constant String := "floating";
   default_ssl       : constant String := "libressl";
   default_mysql     : constant String := "oracle-5.7";
   default_lua       : constant String := "5.3";
   default_perl      : constant String := "5.24";
   default_pgsql     : constant String := "9.6";
   default_python3   : constant String := "3.5";
   default_ruby      : constant String := "2.4";
   default_tcltk     : constant String := "8.6";
   default_compiler  : constant String := "gcc6";
   compiler_version  : constant String := "6.20170202";
   arc_ext           : constant String := ".txz";
   jobs_per_cpu      : constant := 2;

   type supported_opsys is (dragonfly, freebsd, netbsd, openbsd, sunos, linux, macos);
   type supported_arch  is (x86_64, i386, aarch64);

   type cpu_range is range 1 .. 32;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;
   type count_type is (total, success, failure, ignored, skipped);

   --  Modify following with post-patch sed accordingly
   platform_type  : constant supported_opsys := dragonfly;
   host_localbase : constant String := "/raven";
   host_pkg8      : constant String := host_localbase & "/sbin/pkg";
   ravenexec      : constant String := host_localbase & "/libexec/ravenexec";

end Definitions;

Bump version a lot

Bump version a lot