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

with Util.Test_Caller;

with Ada.Text_IO;

with Util.Properties;
with Util.Properties.Basic;

package body Util.Properties.Tests is

   use Ada.Text_IO;
   use type Ada.Containers.Count_Type;
   use Util.Properties.Basic;

   --  Test
   --    Properties.Set
   --    Properties.Exists
   --    Properties.Get
   procedure Test_Property (T : in out Test) is
      Props : Properties.Manager;
   begin
      T.Assert (Exists (Props, "test") = False,
                "Invalid properties");
      T.Assert (Exists (Props, +("test")) = False,
                "Invalid properties");
      T.Assert (Props.Is_Empty, "Property manager should be empty");
      Props.Set ("test", "toto");
      T.Assert (Exists (Props, "test"),
                "Property was not inserted");
      declare
         V : constant String := Props.Get ("test");
      begin

         T.Assert (V = "toto",
                   "Property was not set correctly");
      end;

      declare
         V : constant String := Props.Get (+("test"));
      begin
         T.Assert (V = "toto",
                   "Property was not set correctly");
      end;

      declare
         V : constant Unbounded_String := Props.Get (+("test"));
      begin
         T.Assert (V = "toto",
                   "Property was not set correctly");
      end;
   end Test_Property;

   --  Test basic properties
   --     Get
   --     Set
   procedure Test_Integer_Property (T : in out Test) is
      Props : Properties.Manager;
      V     : Integer := 23;
   begin
      Integer_Property.Set (Props, "test-integer", V);
      T.Assert (Props.Exists ("test-integer"), "Invalid properties");

      V := Integer_Property.Get (Props, "test-integer");
      T.Assert (V = 23, "Property was not inserted");

      Integer_Property.Set (Props, "test-integer", 24);
      V := Integer_Property.Get (Props, "test-integer");
      T.Assert (V = 24, "Property was not inserted");

      V := Integer_Property.Get (Props, "unknown", 25);
      T.Assert (V = 25, "Default value must be returned for a Get");
   end Test_Integer_Property;

   --  Test loading of property files
   procedure Test_Load_Property (T : in out Test) is
      Props : Properties.Manager;
      F : File_Type;
   begin
      Open (F, In_File, "regtests/test.properties");
      Load_Properties (Props, F);
      Close (F);

      declare
         Names : Util.Strings.Vectors.Vector;
      begin
         Props.Get_Names (Names);
         T.Assert (Names.Length > 30,
                   "Loading the test properties returned too few properties");

         T.Assert (To_String (Props.Get ("root.dir")) = ".",
                   "Invalid property 'root.dir'");
         T.Assert (To_String (Props.Get ("console.lib")) = "${dist.lib.dir}/console.jar",
                   "Invalid property 'console.lib'");
      end;
   exception
      when Ada.Text_IO.Name_Error =>
         Ada.Text_IO.Put_Line ("Cannot find test file: regtests/test.properties");
         raise;
   end Test_Load_Property;

   --  ------------------------------
   --  Test loading of property files
   --  ------------------------------
   procedure Test_Load_Strip_Property (T : in out Test) is
      Props : Properties.Manager;
      F : File_Type;
   begin
      --  Load, filter and strip properties
      Open (F, In_File, "regtests/test.properties");
      Load_Properties (Props, F, "tomcat.", True);
      Close (F);

      declare
         Names : Util.Strings.Vectors.Vector;
      begin
         Props.Get_Names (Names);
         T.Assert (Names.Length > 3,
                   "Loading the test properties returned too few properties");

         T.Assert (To_String (Props.Get ("version")) = "0.6",
                   "Invalid property 'root.dir'");
      end;
   exception
      when Ada.Text_IO.Name_Error =>
         Ada.Text_IO.Put_Line ("Cannot find test file: regtests/test.properties");
         raise;
   end Test_Load_Strip_Property;

   --  ------------------------------
   --  Test copy of properties
   --  ------------------------------
   procedure Test_Copy_Property (T : in out Test) is
      Props : Properties.Manager;
   begin
      Props.Set ("prefix.one", "1");
      Props.Set ("prefix.two", "2");
      Props.Set ("prefix", "Not copied");
      Props.Set ("prefix.", "Copied");
      declare
         Copy : Properties.Manager;
      begin
         Copy.Copy (From   => Props,
                    Prefix => "prefix.",
                    Strip  => True);
         T.Assert (Copy.Exists ("one"), "Property one not found");
         T.Assert (Copy.Exists ("two"), "Property two not found");
         T.Assert (Copy.Exists (""), "Property '' does not exist.");
      end;
   end Test_Copy_Property;

   procedure Test_Set_Preserve_Original (T : in out Test) is
      Props1 : Properties.Manager;
   begin
      Props1.Set ("a", "b");
      Props1.Set ("c", "d");
      declare
         Props2 : Properties.Manager;
      begin
         Props2 := Props1;
         T.Assert (Props2.Exists ("a"), "Property a not found in props2 after assignment");
         T.Assert (Props2.Exists ("c"), "Property b not found in props2 after assignment");
         Util.Tests.Assert_Equals (T, "b", String '(Props2.Get ("a")), "Invalid property a");
         Props1.Set ("a", "d");
         Util.Tests.Assert_Equals (T, "d", String '(Props1.Get ("a")),
                                   "Wrong property a in props1");
         Util.Tests.Assert_Equals (T, "b", String '(Props2.Get ("a")),
                                   "Wrong property a in props2");
         Props2 := Props1;
         Util.Tests.Assert_Equals (T, "d", String '(Props2.Get ("a")),
                                   "Wrong property a in props2");
         Props2.Set ("e", "f");
         Props2.Set ("c", "g");
         Props1 := Props2;

         --  Release Props2 but the property manager is internally shared so the Props1 is
         --  not changed.
      end;
      T.Assert (Props1.Exists ("e"), "Property e not found in props1 after assignment");
      T.Assert (Props1.Exists ("c"), "Property c not found in props1 after assignment");
      Util.Tests.Assert_Equals (T, "g", String '(Props1.Get ("c")),
                                "Wrong property c in props1");
   end Test_Set_Preserve_Original;

   procedure Test_Remove_Preserve_Original (T : in out Test) is
      Props1 : Properties.Manager;
   begin
      Props1.Set ("a", "b");
      Props1.Set ("c", "d");
      declare
         Props2 : Properties.Manager;
      begin
         Props2 := Props1;
         T.Assert (Props2.Exists ("a"), "Property a not found in props2 after assignment");
         T.Assert (Props2.Exists ("c"), "Property b not found in props2 after assignment");
         Props1.Remove ("a");
         T.Assert (not Props1.Exists ("a"), "Property a was not removed from props1");
         T.Assert (Props2.Exists ("a"), "Property a was removed from props2");
         Props1 := Props2;

         --  Release Props2 but the property manager is internally shared so the Props1 is
         --  not changed.
      end;
      Util.Tests.Assert_Equals (T, "b", String '(Props1.Get ("a")),
                                "Wrong property a in props1");
   end Test_Remove_Preserve_Original;

   procedure Test_Missing_Property (T : in out Test) is
      Props  : Properties.Manager;
      V      : Unbounded_String;
   begin
      T.Assert (Util.Beans.Objects.Is_Null (Props.Get_Value ("missing")),
                "The Get_Value operation must return a null object");
      begin
         V := Props.Get ("missing");
         T.Fail ("Exception NO_PROPERTY was not raised");

      exception
         when NO_PROPERTY =>
            null;
      end;

      begin
         V := Props.Get (+("missing"));
         T.Fail ("Exception NO_PROPERTY was not raised");

      exception
         when NO_PROPERTY =>
            null;
      end;
      T.Assert (Ada.Strings.Unbounded.Length (V) = 0, "Variable get's corrupted");

      --  Check exception on Get returning a String.
      begin
         declare
            S : constant String := Props.Get ("missing");
            pragma Unreferenced (S);
         begin
            T.Fail ("Exception NO_PROPERTY was not raised");
         end;
      exception
         when NO_PROPERTY =>
            null;
      end;

      --  Check exception on Get returning a String.
      begin
         declare
            S : constant String := Props.Get (+("missing"));
            pragma Unreferenced (S);
         begin
            T.Fail ("Exception NO_PROPERTY was not raised");
         end;
      exception
         when NO_PROPERTY =>
            null;
      end;

      Props.Set ("a", "b");
      T.Assert (Util.Beans.Objects.Is_Null (Props.Get_Value ("missing")),
                "The Get_Value operation must return a null object");
      begin
         V := Props.Get ("missing");
         T.Fail ("Exception NO_PROPERTY was not raised");

      exception
         when NO_PROPERTY =>
            null;
      end;
   end Test_Missing_Property;

   procedure Test_Load_Ini_Property (T : in out Test) is
      Props : Properties.Manager;
      F : File_Type;
   begin
      Open (F, In_File, "regtests/files/my.cnf");
      Load_Properties (Props, F);
      Close (F);

      declare
         V : Util.Properties.Value;
         P : Properties.Manager;
      begin
         V := Props.Get_Value ("mysqld");
         T.Assert (Util.Properties.Is_Manager (V),
                   "Value 'mysqld' must be a property manager");
         P := Util.Properties.To_Manager (V);
         T.Assert (P.Exists ("user"),
                   "The [mysqld] property manager should contain a 'user' property");

         V := Props.Get_Value ("mysqld_safe");
         T.Assert (Util.Properties.Is_Manager (V),
                   "Value 'mysqld_safe' must be a property manager");
         P := Util.Properties.To_Manager (V);
         T.Assert (P.Exists ("socket"),
                   "The [mysqld] property manager should contain a 'socket' property");

      end;

      declare
         P : Properties.Manager;
      begin
         P := Props.Get ("mysqld");
         T.Assert (P.Exists ("user"),
                   "The [mysqld] property manager should contain a 'user' property");

         P := Props.Get ("mysqld_safe");
         T.Assert (P.Exists ("socket"),
                   "The [mysqld] property manager should contain a 'socket' property");
      end;

      declare
         P : Properties.Manager with Unreferenced;
      begin
         P := Props.Get ("bad");
         T.Fail ("No exception raised for Get()");

      exception
         when NO_PROPERTY =>
            null;
      end;

   exception
      when Ada.Text_IO.Name_Error =>
         Ada.Text_IO.Put_Line ("Cannot find test file: regtests/files/my.cnf");
         raise;

   end Test_Load_Ini_Property;

   procedure Test_Save_Properties (T : in out Test) is
      Path : constant String := Util.Tests.Get_Test_Path ("save-props.properties");
   begin
      declare
         Props  : Properties.Manager;
         F      : File_Type;
      begin
         Open (F, In_File, "regtests/files/my.cnf");
         Load_Properties (Props, F);
         Close (F);

         Props.Set ("New-Property", "Some-Value");
         Props.Remove ("mysqld");
         T.Assert (not Props.Exists ("mysqld"), "mysqld property was not removed");
         Props.Save_Properties (Path);
      end;

      declare
         Props : Properties.Manager;
         V : Util.Properties.Value;
         P : Properties.Manager;
      begin
         Props.Load_Properties (Path => Path);

         T.Assert (not Props.Exists ("mysqld"), "mysqld property was not removed (2)");
         T.Assert (Props.Exists ("New-Property"), "Invalid Save_Properties");

         V := Props.Get_Value ("mysqld_safe");
         T.Assert (Util.Properties.Is_Manager (V),
                   "Value 'mysqld_safe' must be a property manager");
         P := Util.Properties.To_Manager (V);
         T.Assert (P.Exists ("socket"),
                   "The [mysqld] property manager should contain a 'socket' property");
      end;
   end Test_Save_Properties;

   procedure Test_Remove_Property (T : in out Test) is
      Props : Properties.Manager;
   begin
      begin
         Props.Remove ("missing");
         T.Fail ("Remove should raise exception");

      exception
         when NO_PROPERTY =>
            null;
      end;

      begin
         Props.Remove (+("missing"));
         T.Fail ("Remove should raise exception");

      exception
         when NO_PROPERTY =>
            null;
      end;

      Props.Set ("a", "b");
      T.Assert (Props.Exists ("a"), "Property not inserted");

      Props.Remove ("a");
      T.Assert (not Props.Exists ("a"), "Property not removed");

      Props.Set ("a", +("b"));
      T.Assert (Props.Exists ("a"), "Property not inserted");

      Props.Remove (+("a"));
      T.Assert (not Props.Exists ("a"), "Property not removed");
   end Test_Remove_Property;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Properties.Set",
                       Test_Property'Access);
      Caller.Add_Test (Suite, "Test Util.Properties.Get",
                       Test_Property'Access);
      Caller.Add_Test (Suite, "Test Util.Properties.Exists",
                       Test_Property'Access);
      Caller.Add_Test (Suite, "Test Util.Properties.Remove",
                       Test_Remove_Property'Access);
      Caller.Add_Test (Suite, "Test Util.Properties.Get (NO_PROPERTY)",
                       Test_Missing_Property'Access);

      Caller.Add_Test (Suite, "Test Util.Properties.Discrete.Get",
                       Test_Integer_Property'Access);

      Caller.Add_Test (Suite, "Test Util.Properties.Discrete.Set",
                       Test_Integer_Property'Access);

      Caller.Add_Test (Suite, "Test Util.Properties.Load_Properties",
                       Test_Load_Property'Access);
      Caller.Add_Test (Suite, "Test Util.Properties.Load_Properties (INI)",
                       Test_Load_Ini_Property'Access);
      Caller.Add_Test (Suite, "Test Util.Properties.Load_Strip_Properties",
                       Test_Load_Strip_Property'Access);
      Caller.Add_Test (Suite, "Test Util.Properties.Copy",
                       Test_Copy_Property'Access);
      Caller.Add_Test (Suite, "Test Util.Properties.Set+Assign",
                       Test_Set_Preserve_Original'Access);
      Caller.Add_Test (Suite, "Test Util.Properties.Set+Assign+Remove",
                       Test_Remove_Preserve_Original'Access);
      Caller.Add_Test (Suite, "Test Util.Properties.Save_Properties",
                       Test_Save_Properties'Access);
   end Add_Tests;

end Util.Properties.Tests;

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

with Util.Test_Caller;

with Ada.Text_IO;

with Util.Properties;
with Util.Properties.Basic;

package body Util.Properties.Tests is

   use Ada.Text_IO;
   use type Ada.Containers.Count_Type;
   use Util.Properties.Basic;

   --  Test
   --    Properties.Set
   --    Properties.Exists
   --    Properties.Get
   procedure Test_Property (T : in out Test) is
      Props : Properties.Manager;
   begin
      T.Assert (Exists (Props, "test") = False,
                "Invalid properties");
      T.Assert (Exists (Props, +("test")) = False,
                "Invalid properties");
      T.Assert (Props.Is_Empty, "Property manager should be empty");
      Props.Set ("test", "toto");
      T.Assert (Exists (Props, "test"),
                "Property was not inserted");
      declare
         V : constant String := Props.Get ("test");
      begin

         T.Assert (V = "toto",
                   "Property was not set correctly");
      end;

      declare
         V : constant String := Props.Get (+("test"));
      begin
         T.Assert (V = "toto",
                   "Property was not set correctly");
      end;

      declare
         V : constant Unbounded_String := Props.Get (+("test"));
      begin
         T.Assert (V = "toto",
                   "Property was not set correctly");
      end;
   end Test_Property;

   --  Test basic properties
   --     Get
   --     Set
   procedure Test_Integer_Property (T : in out Test) is
      Props : Properties.Manager;
      V     : Integer := 23;
   begin
      Integer_Property.Set (Props, "test-integer", V);
      T.Assert (Props.Exists ("test-integer"), "Invalid properties");

      V := Integer_Property.Get (Props, "test-integer");
      T.Assert (V = 23, "Property was not inserted");

      Integer_Property.Set (Props, "test-integer", 24);
      V := Integer_Property.Get (Props, "test-integer");
      T.Assert (V = 24, "Property was not inserted");

      V := Integer_Property.Get (Props, "unknown", 25);
      T.Assert (V = 25, "Default value must be returned for a Get");
   end Test_Integer_Property;

   --  Test loading of property files
   procedure Test_Load_Property (T : in out Test) is
      Props : Properties.Manager;
      F : File_Type;
   begin
      Open (F, In_File, "regtests/test.properties");
      Load_Properties (Props, F);
      Close (F);

      declare
         Names : Util.Strings.Vectors.Vector;
      begin
         Props.Get_Names (Names);
         T.Assert (Names.Length > 30,
                   "Loading the test properties returned too few properties");

         T.Assert (To_String (Props.Get ("root.dir")) = ".",
                   "Invalid property 'root.dir'");
         T.Assert (To_String (Props.Get ("console.lib")) = "${dist.lib.dir}/console.jar",
                   "Invalid property 'console.lib'");
      end;
   exception
      when Ada.Text_IO.Name_Error =>
         Ada.Text_IO.Put_Line ("Cannot find test file: regtests/test.properties");
         raise;
   end Test_Load_Property;

   --  ------------------------------
   --  Test loading of property files
   --  ------------------------------
   procedure Test_Load_Strip_Property (T : in out Test) is
      Props : Properties.Manager;
      F : File_Type;
   begin
      --  Load, filter and strip properties
      Open (F, In_File, "regtests/test.properties");
      Load_Properties (Props, F, "tomcat.", True);
      Close (F);

      declare
         Names : Util.Strings.Vectors.Vector;
      begin
         Props.Get_Names (Names);
         T.Assert (Names.Length > 3,
                   "Loading the test properties returned too few properties");

         T.Assert (To_String (Props.Get ("version")) = "0.6",
                   "Invalid property 'root.dir'");
      end;
   exception
      when Ada.Text_IO.Name_Error =>
         Ada.Text_IO.Put_Line ("Cannot find test file: regtests/test.properties");
         raise;
   end Test_Load_Strip_Property;

   --  ------------------------------
   --  Test copy of properties
   --  ------------------------------
   procedure Test_Copy_Property (T : in out Test) is
      Props : Properties.Manager;
   begin
      Props.Set ("prefix.one", "1");
      Props.Set ("prefix.two", "2");
      Props.Set ("prefix", "Not copied");
      Props.Set ("prefix.", "Copied");
      declare
         Copy : Properties.Manager;
      begin
         Copy.Copy (From   => Props,
                    Prefix => "prefix.",
                    Strip  => True);
         T.Assert (Copy.Exists ("one"), "Property one not found");
         T.Assert (Copy.Exists ("two"), "Property two not found");
         T.Assert (Copy.Exists (""), "Property '' does not exist.");
      end;
   end Test_Copy_Property;

   procedure Test_Set_Preserve_Original (T : in out Test) is
      Props1 : Properties.Manager;
   begin
      Props1.Set ("a", "b");
      Props1.Set ("c", "d");
      declare
         Props2 : Properties.Manager;
      begin
         Props2 := Props1;
         T.Assert (Props2.Exists ("a"), "Property a not found in props2 after assignment");
         T.Assert (Props2.Exists ("c"), "Property b not found in props2 after assignment");
         Util.Tests.Assert_Equals (T, "b", String '(Props2.Get ("a")), "Invalid property a");
         Props1.Set ("a", "d");
         Util.Tests.Assert_Equals (T, "d", String '(Props1.Get ("a")),
                                   "Wrong property a in props1");
         Util.Tests.Assert_Equals (T, "b", String '(Props2.Get ("a")),
                                   "Wrong property a in props2");
         Props2 := Props1;
         Util.Tests.Assert_Equals (T, "d", String '(Props2.Get ("a")),
                                   "Wrong property a in props2");
         Props2.Set ("e", "f");
         Props2.Set ("c", "g");
         Props1 := Props2;

         --  Release Props2 but the property manager is internally shared so the Props1 is
         --  not changed.
      end;
      T.Assert (Props1.Exists ("e"), "Property e not found in props1 after assignment");
      T.Assert (Props1.Exists ("c"), "Property c not found in props1 after assignment");
      Util.Tests.Assert_Equals (T, "g", String '(Props1.Get ("c")),
                                "Wrong property c in props1");
   end Test_Set_Preserve_Original;

   procedure Test_Remove_Preserve_Original (T : in out Test) is
      Props1 : Properties.Manager;
   begin
      Props1.Set ("a", "b");
      Props1.Set ("c", "d");
      declare
         Props2 : Properties.Manager;
      begin
         Props2 := Props1;
         T.Assert (Props2.Exists ("a"), "Property a not found in props2 after assignment");
         T.Assert (Props2.Exists ("c"), "Property b not found in props2 after assignment");
         Props1.Remove ("a");
         T.Assert (not Props1.Exists ("a"), "Property a was not removed from props1");
         T.Assert (Props2.Exists ("a"), "Property a was removed from props2");
         Props1 := Props2;

         --  Release Props2 but the property manager is internally shared so the Props1 is
         --  not changed.
      end;
      Util.Tests.Assert_Equals (T, "b", String '(Props1.Get ("a")),
                                "Wrong property a in props1");
   end Test_Remove_Preserve_Original;

   procedure Test_Missing_Property (T : in out Test) is
      Props  : Properties.Manager;
      V      : Unbounded_String;
   begin
      T.Assert (Util.Beans.Objects.Is_Null (Props.Get_Value ("missing")),
                "The Get_Value operation must return a null object");
      begin
         V := Props.Get ("missing");
         T.Fail ("Exception NO_PROPERTY was not raised");

      exception
         when NO_PROPERTY =>
            null;
      end;

      begin
         V := Props.Get (+("missing"));
         T.Fail ("Exception NO_PROPERTY was not raised");

      exception
         when NO_PROPERTY =>
            null;
      end;
      T.Assert (Ada.Strings.Unbounded.Length (V) = 0, "Variable get's corrupted");

      --  Check exception on Get returning a String.
      begin
         declare
            S : constant String := Props.Get ("missing");
            pragma Unreferenced (S);
         begin
            T.Fail ("Exception NO_PROPERTY was not raised");
         end;
      exception
         when NO_PROPERTY =>
            null;
      end;

      --  Check exception on Get returning a String.
      begin
         declare
            S : constant String := Props.Get (+("missing"));
            pragma Unreferenced (S);
         begin
            T.Fail ("Exception NO_PROPERTY was not raised");
         end;
      exception
         when NO_PROPERTY =>
            null;
      end;

      Props.Set ("a", "b");
      T.Assert (Util.Beans.Objects.Is_Null (Props.Get_Value ("missing")),
                "The Get_Value operation must return a null object");
      begin
         V := Props.Get ("missing");
         T.Fail ("Exception NO_PROPERTY was not raised");

      exception
         when NO_PROPERTY =>
            null;
      end;
   end Test_Missing_Property;

   procedure Test_Load_Ini_Property (T : in out Test) is
      Props : Properties.Manager;
      F : File_Type;
   begin
      Open (F, In_File, "regtests/files/my.cnf");
      Load_Properties (Props, F);
      Close (F);

      declare
         V : Util.Properties.Value;
         P : Properties.Manager;
      begin
         V := Props.Get_Value ("mysqld");
         T.Assert (Util.Properties.Is_Manager (V),
                   "Value 'mysqld' must be a property manager");
         P := Util.Properties.To_Manager (V);
         T.Assert (P.Exists ("user"),
                   "The [mysqld] property manager should contain a 'user' property");

         V := Props.Get_Value ("mysqld_safe");
         T.Assert (Util.Properties.Is_Manager (V),
                   "Value 'mysqld_safe' must be a property manager");
         P := Util.Properties.To_Manager (V);
         T.Assert (P.Exists ("socket"),
                   "The [mysqld] property manager should contain a 'socket' property");

      end;

      declare
         P : Properties.Manager;
      begin
         P := Props.Get ("mysqld");
         T.Assert (P.Exists ("user"),
                   "The [mysqld] property manager should contain a 'user' property");

         P := Props.Get ("mysqld_safe");
         T.Assert (P.Exists ("socket"),
                   "The [mysqld] property manager should contain a 'socket' property");
      end;

      declare
         P : Properties.Manager with Unreferenced;
      begin
         P := Props.Get ("bad");
         T.Fail ("No exception raised for Get()");

      exception
         when NO_PROPERTY =>
            null;
      end;

   exception
      when Ada.Text_IO.Name_Error =>
         Ada.Text_IO.Put_Line ("Cannot find test file: regtests/files/my.cnf");
         raise;

   end Test_Load_Ini_Property;

   procedure Test_Save_Properties (T : in out Test) is
      Path : constant String := Util.Tests.Get_Test_Path ("save-props.properties");
   begin
      declare
         Props  : Properties.Manager;
         F      : File_Type;
      begin
         Open (F, In_File, "regtests/files/my.cnf");
         Load_Properties (Props, F);
         Close (F);

         Props.Set ("New-Property", "Some-Value");
         Props.Remove ("mysqld");
         T.Assert (not Props.Exists ("mysqld"), "mysqld property was not removed");
         Props.Save_Properties (Path);
      end;

      declare
         Props : Properties.Manager;
         V : Util.Properties.Value;
         P : Properties.Manager;
      begin
         Props.Load_Properties (Path => Path);

         T.Assert (not Props.Exists ("mysqld"), "mysqld property was not removed (2)");
         T.Assert (Props.Exists ("New-Property"), "Invalid Save_Properties");

         V := Props.Get_Value ("mysqld_safe");
         T.Assert (Util.Properties.Is_Manager (V),
                   "Value 'mysqld_safe' must be a property manager");
         P := Util.Properties.To_Manager (V);
         T.Assert (P.Exists ("socket"),
                   "The [mysqld] property manager should contain a 'socket' property");
      end;

      declare
         V : Util.Properties.Value;
         P : Properties.Manager;
      begin
         P := Util.Properties.To_Manager (V);
         T.Fail ("No exception raised by To_Manager");

      exception
         when Util.Beans.Objects.Conversion_Error =>
            null;
      end;
   end Test_Save_Properties;

   procedure Test_Remove_Property (T : in out Test) is
      Props : Properties.Manager;
   begin
      begin
         Props.Remove ("missing");
         T.Fail ("Remove should raise exception");

      exception
         when NO_PROPERTY =>
            null;
      end;

      begin
         Props.Remove (+("missing"));
         T.Fail ("Remove should raise exception");

      exception
         when NO_PROPERTY =>
            null;
      end;

      Props.Set ("a", "b");
      T.Assert (Props.Exists ("a"), "Property not inserted");

      Props.Remove ("a");
      T.Assert (not Props.Exists ("a"), "Property not removed");

      Props.Set ("a", +("b"));
      T.Assert (Props.Exists ("a"), "Property not inserted");

      Props.Remove (+("a"));
      T.Assert (not Props.Exists ("a"), "Property not removed");
   end Test_Remove_Property;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Properties.Set",
                       Test_Property'Access);
      Caller.Add_Test (Suite, "Test Util.Properties.Get",
                       Test_Property'Access);
      Caller.Add_Test (Suite, "Test Util.Properties.Exists",
                       Test_Property'Access);
      Caller.Add_Test (Suite, "Test Util.Properties.Remove",
                       Test_Remove_Property'Access);
      Caller.Add_Test (Suite, "Test Util.Properties.Get (NO_PROPERTY)",
                       Test_Missing_Property'Access);

      Caller.Add_Test (Suite, "Test Util.Properties.Discrete.Get",
                       Test_Integer_Property'Access);

      Caller.Add_Test (Suite, "Test Util.Properties.Discrete.Set",
                       Test_Integer_Property'Access);

      Caller.Add_Test (Suite, "Test Util.Properties.Load_Properties",
                       Test_Load_Property'Access);
      Caller.Add_Test (Suite, "Test Util.Properties.Load_Properties (INI)",
                       Test_Load_Ini_Property'Access);
      Caller.Add_Test (Suite, "Test Util.Properties.Load_Strip_Properties",
                       Test_Load_Strip_Property'Access);
      Caller.Add_Test (Suite, "Test Util.Properties.Copy",
                       Test_Copy_Property'Access);
      Caller.Add_Test (Suite, "Test Util.Properties.Set+Assign",
                       Test_Set_Preserve_Original'Access);
      Caller.Add_Test (Suite, "Test Util.Properties.Set+Assign+Remove",
                       Test_Remove_Preserve_Original'Access);
      Caller.Add_Test (Suite, "Test Util.Properties.Save_Properties",
                       Test_Save_Properties'Access);
   end Add_Tests;

end Util.Properties.Tests;

Add more test for To_Manager function

Add more test for To_Manager function


-----------------------------------------------------------------------
--  util-streams -- Stream utilities
--  Copyright (C) 2010, 2016, 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.Streams;

--  = Streams =
--  The `Util.Streams` package provides several types and operations to allow the
--  composition of input and output streams.  Input streams can be chained together so that
--  they traverse the different stream objects when the data is read from them.  Similarly,
--  output streams can be chained and the data that is written will traverse the different
--  streams from the first one up to the last one in the chain.  During such traversal, the
--  stream object is able to bufferize the data or make transformations on the data.
--
--  The `Input_Stream` interface represents the stream to read data.  It only provides a
--  `Read` procedure.  The `Output_Stream` interface represents the stream to write data.
--  It provides a `Write`, `Flush` and `Close` operation.
--
--  @include util-streams-buffered.ads
--  @include util-streams-texts.ads
--  @include util-streams-files.ads
--  @include util-streams-pipes.ads
--  @include util-streams-sockets.ads
--  @include util-streams-raw.ads
--  @include util-streams-buffered-encoders.ads
package Util.Streams is

   pragma Preelaborate;

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

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

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

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

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

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

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

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

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

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

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

with Ada.Streams;

--  = Streams =
--  The `Util.Streams` package provides several types and operations to allow the
--  composition of input and output streams.  Input streams can be chained together so that
--  they traverse the different stream objects when the data is read from them.  Similarly,
--  output streams can be chained and the data that is written will traverse the different
--  streams from the first one up to the last one in the chain.  During such traversal, the
--  stream object is able to bufferize the data or make transformations on the data.
--
--  The `Input_Stream` interface represents the stream to read data.  It only provides a
--  `Read` procedure.  The `Output_Stream` interface represents the stream to write data.
--  It provides a `Write`, `Flush` and `Close` operation.
--
--  @include util-streams-buffered.ads
--  @include util-streams-texts.ads
--  @include util-streams-files.ads
--  @include util-streams-pipes.ads
--  @include util-streams-sockets.ads
--  @include util-streams-raw.ads
--  @include util-streams-base16.ads
--  @include util-streams-base64.ads
--  @include util-streams-aes.ads
package Util.Streams is

   pragma Preelaborate;

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

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

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

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

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

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

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

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

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

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

Document the base16, base64, AES streams


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

with AWA.Storages.Models;
with AWA.Storages.Modules;

with ASF.Parts;

with ADO;

with Util.Beans.Objects;
with Util.Beans.Basic;

--  == Storage Beans ==
--  The <tt>Upload_Bean</tt> type is used to upload a file in the storage space.
--  It expect that the folder already exists.
--
--  The <tt>Folder_Bean</tt> type controls the creation of new folders.
--
--  The <tt>Storage_List_Bean</tt> type gives the files associated with a given folder.
package AWA.Storages.Beans is

   FOLDER_ID_PARAMETER : constant String := "folderId";

   --  ------------------------------
   --  Upload Bean
   --  ------------------------------
   --  The Upload_Bean allows to upload a file in the storage space.
   type Upload_Bean is new AWA.Storages.Models.Upload_Bean with record
      Module    : AWA.Storages.Modules.Storage_Module_Access := null;
      Folder_Id : ADO.Identifier;
      Error     : Boolean := False;
   end record;
   type Upload_Bean_Access is access all Upload_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Upload_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Upload_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Save the uploaded file in the storage service.
   --  @method
   procedure Save_Part (Bean : in out Upload_Bean;
                        Part : in ASF.Parts.Part'Class);

   --  Upload the file.
   overriding
   procedure Upload (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the file.
   overriding
   procedure Delete (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Publish the file.
   overriding
   procedure Publish (Bean    : in out Upload_Bean;
                      Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Upload_Bean bean instance.
   function Create_Upload_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Folder Bean
   --  ------------------------------
   --  The Folder_Bean allows to create or update the folder name.
   type Folder_Bean is new AWA.Storages.Models.Storage_Folder_Ref
     and Util.Beans.Basic.Bean with record
      Module  : AWA.Storages.Modules.Storage_Module_Access := null;
   end record;
   type Folder_Bean_Access is access all Folder_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Folder_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Folder_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create or save the folder.
   procedure Save (Bean    : in out Folder_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   type Init_Flag is (INIT_FOLDER, INIT_FOLDER_LIST, INIT_FILE_LIST);
   type Init_Map is array (Init_Flag) of Boolean;

   --  ------------------------------
   --  Storage List Bean
   --  ------------------------------
   --  This bean represents a list of storage files for a given folder.
   type Storage_List_Bean is new AWA.Storages.Models.Storage_List_Bean with record
      Module           : AWA.Storages.Modules.Storage_Module_Access := null;

      --  Current folder.
      Folder           : aliased Folder_Bean;
      Folder_Bean      : Folder_Bean_Access;
      Folder_Id        : ADO.Identifier := ADO.NO_IDENTIFIER;

      --  List of folders.
      Folder_List      : aliased AWA.Storages.Models.Folder_Info_List_Bean;
      Folder_List_Bean : AWA.Storages.Models.Folder_Info_List_Bean_Access;

      --  List of files.
      Files_List       : aliased AWA.Storages.Models.Storage_Info_List_Bean;
      Files_List_Bean  : AWA.Storages.Models.Storage_Info_List_Bean_Access;

      Init_Flags       : aliased Init_Map := (others => False);
      Flags            : access Init_Map;
   end record;
   type Storage_List_Bean_Access is access all Storage_List_Bean'Class;

   --  Load the folder instance.
   procedure Load_Folder (Storage : in out Storage_List_Bean);

   --  Load the list of folders.
   procedure Load_Folders (Storage : in out Storage_List_Bean);

   --  Load the list of files associated with the current folder.
   procedure Load_Files (Storage : in out Storage_List_Bean);

   overriding
   function Get_Value (List : in Storage_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Storage_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the files and folder information.
   overriding
   procedure Load (List    : in out Storage_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Folder_List_Bean bean instance.
   function Create_Folder_List_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access;

   --  Create the Storage_List_Bean bean instance.
   function Create_Storage_List_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Storage Bean
   --  ------------------------------
   --  Information about a document (excluding the document data itself).
   type Storage_Bean is new AWA.Storages.Models.Storage_Bean with record
      Module : AWA.Storages.Modules.Storage_Module_Access;
   end record;
   type Storage_Bean_Access is access all Storage_Bean'Class;

   overriding
   function Get_Value (From : in Storage_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   overriding
   procedure Load (Into    : in out Storage_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Storage_Bean bean instance.
   function Create_Storage_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                               return Util.Beans.Basic.Readonly_Bean_Access;

   --  Returns true if the given mime type can be displayed by a browser.
   --  Mime types: application/pdf, text/*, image/*
   function Is_Browser_Visible (Mime_Type : in String) return Boolean;

end AWA.Storages.Beans;

-----------------------------------------------------------------------
--  awa-storages-beans -- Storage Ada Beans
--  Copyright (C) 2012, 2016, 2018, 2019, 2020 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 AWA.Storages.Models;
with AWA.Storages.Modules;

with ASF.Parts;

with ADO;

with Util.Beans.Objects;
with Util.Beans.Basic;

--  == Storage Beans ==
--  The <tt>Upload_Bean</tt> type is used to upload a file in the storage space.
--  It expect that the folder already exists.
--
--  The <tt>Folder_Bean</tt> type controls the creation of new folders.
--
--  The <tt>Storage_List_Bean</tt> type gives the files associated with a given folder.
package AWA.Storages.Beans is

   FOLDER_ID_PARAMETER : constant String := "folderId";

   --  ------------------------------
   --  Upload Bean
   --  ------------------------------
   --  The Upload_Bean allows to upload a file in the storage space.
   type Upload_Bean is new AWA.Storages.Models.Upload_Bean with record
      Module    : AWA.Storages.Modules.Storage_Module_Access := null;
      Folder_Id : ADO.Identifier;
      Error     : Boolean := False;
   end record;
   type Upload_Bean_Access is access all Upload_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Upload_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Upload_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Save the uploaded file in the storage service.
   --  @method
   procedure Save_Part (Bean : in out Upload_Bean;
                        Part : in ASF.Parts.Part'Class);

   --  Upload the file.
   overriding
   procedure Upload (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the file.
   overriding
   procedure Delete (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Publish the file.
   overriding
   procedure Publish (Bean    : in out Upload_Bean;
                      Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Upload_Bean bean instance.
   function Create_Upload_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Folder Bean
   --  ------------------------------
   --  The Folder_Bean allows to create or update the folder name.
   type Folder_Bean is new AWA.Storages.Models.Folder_Bean with record
      Module  : AWA.Storages.Modules.Storage_Module_Access := null;
   end record;
   type Folder_Bean_Access is access all Folder_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Folder_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Folder_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create or save the folder.
   overriding
   procedure Save (Bean    : in out Folder_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Folder_Bean bean instance.
   function Create_Folder_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                return Util.Beans.Basic.Readonly_Bean_Access;

   type Init_Flag is (INIT_FOLDER, INIT_FOLDER_LIST, INIT_FILE_LIST);
   type Init_Map is array (Init_Flag) of Boolean;

   --  ------------------------------
   --  Storage List Bean
   --  ------------------------------
   --  This bean represents a list of storage files for a given folder.
   type Storage_List_Bean is new AWA.Storages.Models.Storage_List_Bean with record
      Module           : AWA.Storages.Modules.Storage_Module_Access := null;

      --  Current folder.
      Folder           : aliased Folder_Bean;
      Folder_Bean      : Folder_Bean_Access;
      Folder_Id        : ADO.Identifier := ADO.NO_IDENTIFIER;

      --  List of folders.
      Folder_List      : aliased AWA.Storages.Models.Folder_Info_List_Bean;
      Folder_List_Bean : AWA.Storages.Models.Folder_Info_List_Bean_Access;

      --  List of files.
      Files_List       : aliased AWA.Storages.Models.Storage_Info_List_Bean;
      Files_List_Bean  : AWA.Storages.Models.Storage_Info_List_Bean_Access;

      Init_Flags       : aliased Init_Map := (others => False);
      Flags            : access Init_Map;
   end record;
   type Storage_List_Bean_Access is access all Storage_List_Bean'Class;

   --  Load the folder instance.
   procedure Load_Folder (Storage : in out Storage_List_Bean);

   --  Load the list of folders.
   procedure Load_Folders (Storage : in out Storage_List_Bean);

   --  Load the list of files associated with the current folder.
   procedure Load_Files (Storage : in out Storage_List_Bean);

   overriding
   function Get_Value (List : in Storage_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Storage_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the files and folder information.
   overriding
   procedure Load (List    : in out Storage_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Folder_List_Bean bean instance.
   function Create_Folder_List_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access;

   --  Create the Storage_List_Bean bean instance.
   function Create_Storage_List_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Storage Bean
   --  ------------------------------
   --  Information about a document (excluding the document data itself).
   type Storage_Bean is new AWA.Storages.Models.Storage_Bean with record
      Module : AWA.Storages.Modules.Storage_Module_Access;
   end record;
   type Storage_Bean_Access is access all Storage_Bean'Class;

   overriding
   function Get_Value (From : in Storage_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   overriding
   procedure Load (Into    : in out Storage_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Storage_Bean bean instance.
   function Create_Storage_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                               return Util.Beans.Basic.Readonly_Bean_Access;

   --  Returns true if the given mime type can be displayed by a browser.
   --  Mime types: application/pdf, text/*, image/*
   function Is_Browser_Visible (Mime_Type : in String) return Boolean;

end AWA.Storages.Beans;

Add Create_Folder_Bean and use the generated bean model for Folder_Bean


-----------------------------------------------------------------------
--  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 ADO.Sessions.Entities;

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

   package ASC renames AWA.Services.Contexts;

   --  ------------------------------
   --  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 = "tags" then
         return Util.Beans.Objects.To_Object (From.Tags_Bean, Util.Beans.Objects.STATIC);
      elsif 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
         declare
            Ctx : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
            DB  : constant ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
            Id  : constant ADO.Identifier := ADO.Identifier (Util.Beans.Objects.To_Integer (Value));
         begin
            From.Service.Load_Question (From, Id);
            From.Tags.Load_Tags (DB, Id);
         end;
      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
      pragma Unreferenced (Outcome);
   begin
      Bean.Service.Save_Question (Bean);
      Bean.Tags.Update_Tags (Bean.Get_Id);
   end Save;

   --  ------------------------------
   --  Delete the question.
   --  ------------------------------
   procedure Delete (Bean    : in out Question_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   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;
      Object.Tags_Bean := Object.Tags'Access;
      Object.Tags.Set_Entity_Type (AWA.Questions.Models.QUESTION_TABLE);
      Object.Tags.Set_Permission ("question-edit");
      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 Name = "question_id" then
         return Util.Beans.Objects.To_Object (Long_Long_Integer (From.Question.Get_Id));
      elsif 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" and not Util.Beans.Objects.Is_Empty (Value) then
         From.Service.Load_Answer (From, From.Question,
                                   ADO.Identifier (Util.Beans.Objects.To_Integer (Value)));

      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
      pragma Unreferenced (Outcome);
   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
      pragma Unreferenced (Outcome);
   begin
      Bean.Service.Delete_Answer (Answer => Bean);
   end Delete;

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

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Question_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      return AWA.Questions.Models.Question_Info_List_Bean (From).Get_Value (Name);
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Question_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "tag" then
         From.Tag := Util.Beans.Objects.To_Unbounded_String (Value);
         From.Load_List;
      end if;
   end Set_Value;

   --  ------------------------------
   --  Load the list of question.  If a tag was set, filter the list of questions with the tag.
   --  ------------------------------
   procedure Load_List (Into : in out Question_List_Bean) is
      use AWA.Questions.Models;
      use AWA.Services;
      use type ADO.Identifier;

      Session : ADO.Sessions.Session := Into.Service.Get_Session;
      Query   : ADO.Queries.Context;
      Tag_Id  : ADO.Identifier;
   begin
      AWA.Tags.Modules.Find_Tag_Id (Session, Ada.Strings.Unbounded.To_String (Into.Tag), Tag_Id);
      if Tag_Id /= ADO.NO_IDENTIFIER then
         Query.Set_Query (AWA.Questions.Models.Query_Question_Tag_List);
         Query.Bind_Param (Name => "tag", Value => Tag_Id);
      else
         Query.Set_Query (AWA.Questions.Models.Query_Question_List);
      end if;
      ADO.Sessions.Entities.Bind_Param (Params  => Query,
                                        Name    => "entity_type",
                                        Table   => AWA.Questions.Models.QUESTION_TABLE,
                                        Session => Session);
      AWA.Questions.Models.List (Into, Session, Query);
   end Load_List;

   --  ------------------------------
   --  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;

      Object  : constant Question_List_Bean_Access := new Question_List_Bean;
      Session : ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;
   begin
      Object.Service := Module;
      Query.Set_Query (AWA.Questions.Models.Query_Question_List);
      ADO.Sessions.Entities.Bind_Param (Params  => Query,
                                        Name    => "entity_type",
                                        Table   => AWA.Questions.Models.QUESTION_TABLE,
                                        Session => Session);
      AWA.Questions.Models.List (Object.all, Session, Query);
      return Object.all'Access;
   end Create_Question_List_Bean;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Question_Display_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "answers" then
         return Util.Beans.Objects.To_Object (Value   => From.Answer_List_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      elsif Name = "question" then
         return Util.Beans.Objects.To_Object (Value   => From.Question_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      elsif Name = "tags" then
         return Util.Beans.Objects.To_Object (Value   => From.Tags_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      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_Display_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "id" and not Util.Beans.Objects.Is_Empty (Value) then
         declare
            package ASC renames AWA.Services.Contexts;
            use AWA.Questions.Models;
            use AWA.Services;

            Session : ADO.Sessions.Session := From.Service.Get_Session;
            Query   : ADO.Queries.Context;
            List    : AWA.Questions.Models.Question_Display_Info_List_Bean;
            Ctx     : constant ASC.Service_Context_Access := ASC.Current;
            Id      : ADO.Identifier := ADO.Identifier (Util.Beans.Objects.To_Long_Long_Integer (Value));
         begin
            Query.Set_Query (AWA.Questions.Models.Query_Question_Info);
            Query.Bind_Param ("question_id", Id);
            Query.Bind_Param ("user_id", Ctx.Get_User_Identifier);
            ADO.Sessions.Entities.Bind_Param (Params  => Query,
                                              Name    => "entity_type",
                                              Table   => AWA.Questions.Models.QUESTION_TABLE,
                                              Session => Session);
            AWA.Questions.Models.List (List, Session, Query);
            if not List.List.Is_Empty then
               From.Question := List.List.Element (0);
            end if;
            Query.Clear;
            Query.Bind_Param ("question_id", Util.Beans.Objects.To_Integer (Value));
            Query.Bind_Param ("user_id", Ctx.Get_User_Identifier);
            ADO.Sessions.Entities.Bind_Param (Params  => Query,
                                              Name    => "entity_type",
                                              Table   => AWA.Questions.Models.ANSWER_TABLE,
                                              Session => Session);

            Query.Set_Query (AWA.Questions.Models.Query_Answer_List);
            AWA.Questions.Models.List (From.Answer_List, Session, Query);

            --  Load the tags if any.
            From.Tags.Load_Tags (Session, Id);
         end;
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create the Question_Display_Bean bean instance.
   --  ------------------------------
   function Create_Question_Display_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                       return Util.Beans.Basic.Readonly_Bean_Access is
      Object  : constant Question_Display_Bean_Access := new Question_Display_Bean;
   begin
      Object.Service          := Module;
      Object.Question_Bean    := Object.Question'Access;
      Object.Answer_List_Bean := Object.Answer_List'Access;
      Object.Tags_Bean        := Object.Tags'Access;
      Object.Tags.Set_Entity_Type (AWA.Questions.Models.QUESTION_TABLE);
      return Object.all'Access;
   end Create_Question_Display_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.Utils;
with ADO.Sessions;
with ADO.Sessions.Entities;

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

   package ASC renames AWA.Services.Contexts;

   --  ------------------------------
   --  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 = "tags" then
         return Util.Beans.Objects.To_Object (From.Tags_Bean, Util.Beans.Objects.STATIC);
      elsif 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
         declare
            Ctx : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
            DB  : constant ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
            Id  : constant ADO.Identifier := ADO.Utils.To_Identifier (Value);
         begin
            From.Service.Load_Question (From, Id);
            From.Tags.Load_Tags (DB, Id);
         end;
      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
      pragma Unreferenced (Outcome);
   begin
      Bean.Service.Save_Question (Bean);
      Bean.Tags.Update_Tags (Bean.Get_Id);
   end Save;

   --  ------------------------------
   --  Delete the question.
   --  ------------------------------
   procedure Delete (Bean    : in out Question_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   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;
      Object.Tags_Bean := Object.Tags'Access;
      Object.Tags.Set_Entity_Type (AWA.Questions.Models.QUESTION_TABLE);
      Object.Tags.Set_Permission ("question-edit");
      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 Name = "question_id" then
         return Util.Beans.Objects.To_Object (Long_Long_Integer (From.Question.Get_Id));
      elsif 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" and not Util.Beans.Objects.Is_Empty (Value) then
         From.Service.Load_Answer (From, From.Question,
                                   ADO.Utils.To_Identifier (Value));

      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.Utils.To_Identifier (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
      pragma Unreferenced (Outcome);
   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
      pragma Unreferenced (Outcome);
   begin
      Bean.Service.Delete_Answer (Answer => Bean);
   end Delete;

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

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Question_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      return AWA.Questions.Models.Question_Info_List_Bean (From).Get_Value (Name);
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Question_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "tag" then
         From.Tag := Util.Beans.Objects.To_Unbounded_String (Value);
         From.Load_List;
      end if;
   end Set_Value;

   --  ------------------------------
   --  Load the list of question.  If a tag was set, filter the list of questions with the tag.
   --  ------------------------------
   procedure Load_List (Into : in out Question_List_Bean) is
      use AWA.Questions.Models;
      use AWA.Services;
      use type ADO.Identifier;

      Session : ADO.Sessions.Session := Into.Service.Get_Session;
      Query   : ADO.Queries.Context;
      Tag_Id  : ADO.Identifier;
   begin
      AWA.Tags.Modules.Find_Tag_Id (Session, Ada.Strings.Unbounded.To_String (Into.Tag), Tag_Id);
      if Tag_Id /= ADO.NO_IDENTIFIER then
         Query.Set_Query (AWA.Questions.Models.Query_Question_Tag_List);
         Query.Bind_Param (Name => "tag", Value => Tag_Id);
      else
         Query.Set_Query (AWA.Questions.Models.Query_Question_List);
      end if;
      ADO.Sessions.Entities.Bind_Param (Params  => Query,
                                        Name    => "entity_type",
                                        Table   => AWA.Questions.Models.QUESTION_TABLE,
                                        Session => Session);
      AWA.Questions.Models.List (Into, Session, Query);
   end Load_List;

   --  ------------------------------
   --  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;

      Object  : constant Question_List_Bean_Access := new Question_List_Bean;
      Session : ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;
   begin
      Object.Service := Module;
      Query.Set_Query (AWA.Questions.Models.Query_Question_List);
      ADO.Sessions.Entities.Bind_Param (Params  => Query,
                                        Name    => "entity_type",
                                        Table   => AWA.Questions.Models.QUESTION_TABLE,
                                        Session => Session);
      AWA.Questions.Models.List (Object.all, Session, Query);
      return Object.all'Access;
   end Create_Question_List_Bean;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Question_Display_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "answers" then
         return Util.Beans.Objects.To_Object (Value   => From.Answer_List_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      elsif Name = "question" then
         return Util.Beans.Objects.To_Object (Value   => From.Question_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      elsif Name = "tags" then
         return Util.Beans.Objects.To_Object (Value   => From.Tags_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      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_Display_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "id" and not Util.Beans.Objects.Is_Empty (Value) then
         declare
            package ASC renames AWA.Services.Contexts;
            use AWA.Questions.Models;
            use AWA.Services;

            Session : ADO.Sessions.Session := From.Service.Get_Session;
            Query   : ADO.Queries.Context;
            List    : AWA.Questions.Models.Question_Display_Info_List_Bean;
            Ctx     : constant ASC.Service_Context_Access := ASC.Current;
            Id      : constant ADO.Identifier := ADO.Utils.To_Identifier (Value);
         begin
            Query.Set_Query (AWA.Questions.Models.Query_Question_Info);
            Query.Bind_Param ("question_id", Id);
            Query.Bind_Param ("user_id", Ctx.Get_User_Identifier);
            ADO.Sessions.Entities.Bind_Param (Params  => Query,
                                              Name    => "entity_type",
                                              Table   => AWA.Questions.Models.QUESTION_TABLE,
                                              Session => Session);
            AWA.Questions.Models.List (List, Session, Query);
            if not List.List.Is_Empty then
               From.Question := List.List.Element (0);
            end if;
            Query.Clear;
            Query.Bind_Param ("question_id", Util.Beans.Objects.To_Integer (Value));
            Query.Bind_Param ("user_id", Ctx.Get_User_Identifier);
            ADO.Sessions.Entities.Bind_Param (Params  => Query,
                                              Name    => "entity_type",
                                              Table   => AWA.Questions.Models.ANSWER_TABLE,
                                              Session => Session);

            Query.Set_Query (AWA.Questions.Models.Query_Answer_List);
            AWA.Questions.Models.List (From.Answer_List, Session, Query);

            --  Load the tags if any.
            From.Tags.Load_Tags (Session, Id);
         end;
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create the Question_Display_Bean bean instance.
   --  ------------------------------
   function Create_Question_Display_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                       return Util.Beans.Basic.Readonly_Bean_Access is
      Object  : constant Question_Display_Bean_Access := new Question_Display_Bean;
   begin
      Object.Service          := Module;
      Object.Question_Bean    := Object.Question'Access;
      Object.Answer_List_Bean := Object.Answer_List'Access;
      Object.Tags_Bean        := Object.Tags'Access;
      Object.Tags.Set_Entity_Type (AWA.Questions.Models.QUESTION_TABLE);
      return Object.all'Access;
   end Create_Question_Display_Bean;

end AWA.Questions.Beans;

Use the ADO.Utils.To_Identifier operation