-----------------------------------------------------------------------
--  properties -- Generic name/value property management
--  Copyright (C) 2001, 2002, 2003, 2006, 2008, 2009, 2010, 2014, 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 Ada.Finalization;
with Ada.Text_IO;
with Util.Beans.Objects;
with Util.Beans.Basic;
with Util.Strings.Vectors;
private with Util.Concurrent.Counters;
private with Util.Beans.Objects.Maps;
package Util.Properties is

   NO_PROPERTY : exception;

   use Ada.Strings.Unbounded;

   subtype Value is Ada.Strings.Unbounded.Unbounded_String;

   function "+" (S : String) return Value renames To_Unbounded_String;

   function "-" (S : Value) return String renames To_String;

   --  The manager holding the name/value pairs and providing the operations
   --  to get and set the properties.
   type Manager is new Ada.Finalization.Controlled and Util.Beans.Basic.Bean with private;
   type Manager_Access is access all Manager'Class;

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

   --  Set the value identified by the name.
   --  If the map contains the given name, the value changed.
   --  Otherwise name is added to the map and the value associated with it.
   overriding
   procedure Set_Value (From  : in out Manager;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Returns TRUE if the property exists.
   function Exists (Self : in Manager'Class;
                    Name : in Value) return Boolean;

   --  Returns TRUE if the property exists.
   function Exists (Self : in Manager'Class;
                    Name : in String) return Boolean;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in String) return String;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in String) return Value;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in Value) return Value;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in Value) return String;

   --  Returns the property value or Default if it does not exist.
   function Get (Self : in Manager'Class;
                 Name : in String;
                 Default : in String) return String;

   --  Set the value of the property.  The property is created if it
   --  does not exists.
   procedure Set (Self : in out Manager'Class;
                  Name : in String;
                  Item : in String);

   --  Set the value of the property.  The property is created if it
   --  does not exists.
   procedure Set (Self : in out Manager'Class;
                  Name : in String;
                  Item : in Value);

   --  Set the value of the property.  The property is created if it
   --  does not exists.
   procedure Set (Self : in out Manager'Class;
                  Name : in Unbounded_String;
                  Item : in Value);

   --  Remove the property given its name.  If the property does not
   --  exist, raises NO_PROPERTY exception.
   procedure Remove (Self : in out Manager'Class;
                     Name : in String);

   --  Remove the property given its name.  If the property does not
   --  exist, raises NO_PROPERTY exception.
   procedure Remove (Self : in out Manager'Class;
                     Name : in Value);

   --  Iterate over the properties and execute the given procedure passing the
   --  property name and its value.
   procedure Iterate (Self    : in Manager'Class;
                      Process : access procedure (Name, Item : Value));

   type Name_Array is array (Natural range <>) of Value;

   --  Return the name of the properties defined in the manager.
   --  When a prefix is specified, only the properties starting with
   --  the prefix are returned.
   function Get_Names (Self   : in Manager;
                       Prefix : in String := "") return Name_Array;

   --  Collect the name of the properties defined in the manager.
   --  When a prefix is specified, only the properties starting with the prefix are
   --  returned.
   procedure Get_Names (Self   : in Manager;
                        Into   : in out Util.Strings.Vectors.Vector;
                        Prefix : in String := "");

   --  Load the properties from the file input stream.  The file must follow
   --  the definition of Java property files.  When a prefix is specified, keep
   --  only the properties that starts with the prefix.  When Strip is True,
   --  the prefix part is removed from the property name.
   procedure Load_Properties (Self   : in out Manager'Class;
                              File   : in Ada.Text_IO.File_Type;
                              Prefix : in String := "";
                              Strip  : in Boolean := False);

   --  Load the properties from the file.  The file must follow the
   --  definition of Java property files.  When a prefix is specified, keep
   --  only the properties that starts with the prefix.  When Strip is True,
   --  the prefix part is removed from the property name.
   --  Raises NAME_ERROR if the file does not exist.
   procedure Load_Properties (Self   : in out Manager'Class;
                              Path   : in String;
                              Prefix : in String := "";
                              Strip  : in Boolean := False);

   --  Save the properties in the given file path.
   procedure Save_Properties (Self   : in out Manager'Class;
                              Path   : in String;
                              Prefix : in String := "");

   --  Copy the properties from FROM which start with a given prefix.
   --  If the prefix is empty, all properties are copied.  When Strip is True,
   --  the prefix part is removed from the property name.
   procedure Copy (Self   : in out Manager'Class;
                   From   : in Manager'Class;
                   Prefix : in String := "";
                   Strip  : in Boolean := False);

private

   --  Abstract interface for the implementation of Properties
   --  (this allows to decouples the implementation from the API)
   package Interface_P is

      type Manager is abstract limited new Util.Beans.Basic.Bean with record
         Count : Util.Concurrent.Counters.Counter;
      end record;
      type Manager_Access is access all Manager'Class;

      --  Returns TRUE if the property exists.
      function Exists (Self : in Manager;
                       Name : in String)
                       return Boolean is abstract;

      --  Remove the property given its name.
      procedure Remove (Self : in out Manager;
                        Name : in String) is abstract;

      --  Iterate over the properties and execute the given procedure passing the
      --  property name and its value.
      procedure Iterate (Self    : in Manager;
                         Process : access procedure (Name : in String;
                                                     Item : in Util.Beans.Objects.Object))
      is abstract;

      --  Deep copy of properties stored in 'From' to 'To'.
      function Create_Copy (Self : in Manager)
                            return Manager_Access is abstract;

   end Interface_P;

   --  Create a property implementation if there is none yet.
   procedure Check_And_Create_Impl (Self : in out Manager);

   type Manager is new Ada.Finalization.Controlled and Util.Beans.Basic.Bean with record
      Impl : Interface_P.Manager_Access := null;
   end record;

   overriding
   procedure Adjust   (Object : in out Manager);

   overriding
   procedure Finalize (Object : in out Manager);

end Util.Properties;

-----------------------------------------------------------------------
--  properties -- Generic name/value property management
--  Copyright (C) 2001, 2002, 2003, 2006, 2008, 2009, 2010, 2014, 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 Ada.Finalization;
with Ada.Text_IO;
with Util.Beans.Objects;
with Util.Beans.Basic;
with Util.Strings.Vectors;
private with Util.Concurrent.Counters;
package Util.Properties is

   NO_PROPERTY : exception;

   use Ada.Strings.Unbounded;

   subtype Value is Ada.Strings.Unbounded.Unbounded_String;

   function "+" (S : String) return Value renames To_Unbounded_String;

   function "-" (S : Value) return String renames To_String;

   --  The manager holding the name/value pairs and providing the operations
   --  to get and set the properties.
   type Manager is new Ada.Finalization.Controlled and Util.Beans.Basic.Bean with private;
   type Manager_Access is access all Manager'Class;

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

   --  Set the value identified by the name.
   --  If the map contains the given name, the value changed.
   --  Otherwise name is added to the map and the value associated with it.
   overriding
   procedure Set_Value (From  : in out Manager;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Returns TRUE if the property exists.
   function Exists (Self : in Manager'Class;
                    Name : in Value) return Boolean;

   --  Returns TRUE if the property exists.
   function Exists (Self : in Manager'Class;
                    Name : in String) return Boolean;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in String) return String;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in String) return Value;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in Value) return Value;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in Value) return String;

   --  Returns the property value or Default if it does not exist.
   function Get (Self : in Manager'Class;
                 Name : in String;
                 Default : in String) return String;

   --  Set the value of the property.  The property is created if it
   --  does not exists.
   procedure Set (Self : in out Manager'Class;
                  Name : in String;
                  Item : in String);

   --  Set the value of the property.  The property is created if it
   --  does not exists.
   procedure Set (Self : in out Manager'Class;
                  Name : in String;
                  Item : in Value);

   --  Set the value of the property.  The property is created if it
   --  does not exists.
   procedure Set (Self : in out Manager'Class;
                  Name : in Unbounded_String;
                  Item : in Value);

   --  Remove the property given its name.  If the property does not
   --  exist, raises NO_PROPERTY exception.
   procedure Remove (Self : in out Manager'Class;
                     Name : in String);

   --  Remove the property given its name.  If the property does not
   --  exist, raises NO_PROPERTY exception.
   procedure Remove (Self : in out Manager'Class;
                     Name : in Value);

   --  Iterate over the properties and execute the given procedure passing the
   --  property name and its value.
   procedure Iterate (Self    : in Manager'Class;
                      Process : access procedure (Name : in String;
                                                  Item : in Util.Beans.Objects.Object));

   --  Collect the name of the properties defined in the manager.
   --  When a prefix is specified, only the properties starting with the prefix are
   --  returned.
   procedure Get_Names (Self   : in Manager;
                        Into   : in out Util.Strings.Vectors.Vector;
                        Prefix : in String := "");

   --  Load the properties from the file input stream.  The file must follow
   --  the definition of Java property files.  When a prefix is specified, keep
   --  only the properties that starts with the prefix.  When Strip is True,
   --  the prefix part is removed from the property name.
   procedure Load_Properties (Self   : in out Manager'Class;
                              File   : in Ada.Text_IO.File_Type;
                              Prefix : in String := "";
                              Strip  : in Boolean := False);

   --  Load the properties from the file.  The file must follow the
   --  definition of Java property files.  When a prefix is specified, keep
   --  only the properties that starts with the prefix.  When Strip is True,
   --  the prefix part is removed from the property name.
   --  Raises NAME_ERROR if the file does not exist.
   procedure Load_Properties (Self   : in out Manager'Class;
                              Path   : in String;
                              Prefix : in String := "";
                              Strip  : in Boolean := False);

   --  Save the properties in the given file path.
   procedure Save_Properties (Self   : in out Manager'Class;
                              Path   : in String;
                              Prefix : in String := "");

   --  Copy the properties from FROM which start with a given prefix.
   --  If the prefix is empty, all properties are copied.  When Strip is True,
   --  the prefix part is removed from the property name.
   procedure Copy (Self   : in out Manager'Class;
                   From   : in Manager'Class;
                   Prefix : in String := "";
                   Strip  : in Boolean := False);

private

   --  Abstract interface for the implementation of Properties
   --  (this allows to decouples the implementation from the API)
   package Interface_P is

      type Manager is abstract limited new Util.Beans.Basic.Bean with record
         Count : Util.Concurrent.Counters.Counter;
      end record;
      type Manager_Access is access all Manager'Class;

      --  Returns TRUE if the property exists.
      function Exists (Self : in Manager;
                       Name : in String)
                       return Boolean is abstract;

      --  Remove the property given its name.
      procedure Remove (Self : in out Manager;
                        Name : in String) is abstract;

      --  Iterate over the properties and execute the given procedure passing the
      --  property name and its value.
      procedure Iterate (Self    : in Manager;
                         Process : access procedure (Name : in String;
                                                     Item : in Util.Beans.Objects.Object))
      is abstract;

      --  Deep copy of properties stored in 'From' to 'To'.
      function Create_Copy (Self : in Manager)
                            return Manager_Access is abstract;

   end Interface_P;

   --  Create a property implementation if there is none yet.
   procedure Check_And_Create_Impl (Self : in out Manager);

   type Manager is new Ada.Finalization.Controlled and Util.Beans.Basic.Bean with record
      Impl : Interface_P.Manager_Access := null;
   end record;

   overriding
   procedure Adjust   (Object : in out Manager);

   overriding
   procedure Finalize (Object : in out Manager);

end Util.Properties;

Refactor the Properties implementation (step 4): - Change the Iterate procedure to get the Name/Value as String and Object - Remove the Get_Names function and Name_Array type


-----------------------------------------------------------------------
--  AUnit utils - Helper for writing unit tests
--  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 Ada.Strings.Unbounded;
with Ada.Calendar;

with GNAT.Source_Info;

with Util.Properties;
with Util.Assertions;
with Util.XUnit;
package Util.Tests is

   use Ada.Strings.Unbounded;

   subtype Message_String is Util.XUnit.Message_String;
   subtype Test_Case is Util.XUnit.Test_Case;
   subtype Test_Suite is Util.XUnit.Test_Suite;
   subtype Access_Test_Suite is Util.XUnit.Access_Test_Suite;

   function Format (S : in String) return Message_String renames Util.XUnit.Format;

   type Test is new Util.XUnit.Test with null record;

   --  Get a path to access a test file.
   function Get_Path (File : String) return String;

   --  Get a path to create a test file.
   function Get_Test_Path (File : String) return String;

   --  Get the timeout for the test execution.
   function Get_Test_Timeout (Name : in String) return Duration;

   --  Get the testsuite harness prefix.  This prefix is added to the test class name.
   --  By default it is empty.  It is allows to execute the test harness on different
   --  environment (ex: MySQL or SQLlite) and be able to merge and collect the two result
   --  sets together.
   function Get_Harness_Prefix return String;

   --  Get a test configuration parameter.
   function Get_Parameter (Name    : String;
                           Default : String := "") return String;

   --  Get the test configuration properties.
   function Get_Properties return Util.Properties.Manager;

   --  Get a new unique string
   function Get_Uuid return String;

   --  Check that two files are equal.  This is intended to be used by
   --  tests that create files that are then checked against patterns.
   procedure Assert_Equal_Files (T       : in Test_Case'Class;
                                 Expect  : in String;
                                 Test    : in String;
                                 Message : in String := "Test failed";
                                 Source  : String := GNAT.Source_Info.File;
                                 Line    : Natural := GNAT.Source_Info.Line);

   --  Check that the value matches what we expect.
   procedure Assert_Equals is new Assertions.Assert_Equals_T (Value_Type => Integer);
   procedure Assert_Equals is new Assertions.Assert_Equals_T (Value_Type => Character);

   --  Check that the value matches what we expect.
--     procedure Assert (T         : in Test'Class;
--                       Condition : in Boolean;
--                       Message   : in String := "Test failed";
--                       Source    : String := GNAT.Source_Info.File;
--                       Line      : Natural := GNAT.Source_Info.Line);

   --  Check that the value matches what we expect.
   procedure Assert_Equals (T         : in Test'Class;
                            Expect, Value : in Ada.Calendar.Time;
                            Message   : in String := "Test failed";
                            Source    : String := GNAT.Source_Info.File;
                            Line      : Natural := GNAT.Source_Info.Line);

   --  Check that the value matches what we expect.
   procedure Assert_Equals (T         : in Test'Class;
                            Expect, Value : in String;
                            Message   : in String := "Test failed";
                            Source    : String := GNAT.Source_Info.File;
                            Line      : Natural := GNAT.Source_Info.Line);

   --  Check that the value matches what we expect.
   procedure Assert_Equals (T       : in Test'Class;
                            Expect  : in String;
                            Value   : in Unbounded_String;
                            Message : in String := "Test failed";
                            Source    : String := GNAT.Source_Info.File;
                            Line      : Natural := GNAT.Source_Info.Line);

   --  Check that the value matches the regular expression
   procedure Assert_Matches (T       : in Test'Class;
                             Pattern : in String;
                             Value   : in Unbounded_String;
                             Message : in String := "Test failed";
                             Source  : String := GNAT.Source_Info.File;
                             Line    : Natural := GNAT.Source_Info.Line);

   --  Check that the value matches the regular expression
   procedure Assert_Matches (T       : in Test'Class;
                             Pattern : in String;
                             Value   : in String;
                             Message : in String := "Test failed";
                             Source  : String := GNAT.Source_Info.File;
                             Line    : Natural := GNAT.Source_Info.Line);

   --  Default initialization procedure.
   procedure Initialize_Test (Props : in Util.Properties.Manager);

   --  The main testsuite program.  This launches the tests, collects the
   --  results, create performance logs and set the program exit status
   --  according to the testsuite execution status.
   generic
      with function Suite return Access_Test_Suite;
      with procedure Initialize (Props : in Util.Properties.Manager) is Initialize_Test;
   procedure Harness (Name : in String);

end Util.Tests;

-----------------------------------------------------------------------
--  AUnit utils - Helper for writing unit tests
--  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 Ada.Strings.Unbounded;
with Ada.Calendar;

with GNAT.Source_Info;

with Util.Properties;
with Util.Assertions;
with Util.XUnit;
package Util.Tests is

   use Ada.Strings.Unbounded;

   subtype Message_String is Util.XUnit.Message_String;
   subtype Test_Case is Util.XUnit.Test_Case;
   subtype Test_Suite is Util.XUnit.Test_Suite;
   subtype Access_Test_Suite is Util.XUnit.Access_Test_Suite;

   function Format (S : in String) return Message_String renames Util.XUnit.Format;

   type Test is new Util.XUnit.Test with null record;

   --  Get a path to access a test file.
   function Get_Path (File : String) return String;

   --  Get a path to create a test file.
   function Get_Test_Path (File : String) return String;

   --  Get the timeout for the test execution.
   function Get_Test_Timeout (Name : in String) return Duration;

   --  Get the testsuite harness prefix.  This prefix is added to the test class name.
   --  By default it is empty.  It is allows to execute the test harness on different
   --  environment (ex: MySQL or SQLlite) and be able to merge and collect the two result
   --  sets together.
   function Get_Harness_Prefix return String;

   --  Get a test configuration parameter.
   function Get_Parameter (Name    : String;
                           Default : String := "") return String;

   --  Get the test configuration properties.
   function Get_Properties return Util.Properties.Manager;

   --  Get a new unique string
   function Get_Uuid return String;

   --  Check that two files are equal.  This is intended to be used by
   --  tests that create files that are then checked against patterns.
   procedure Assert_Equal_Files (T       : in Test_Case'Class;
                                 Expect  : in String;
                                 Test    : in String;
                                 Message : in String := "Test failed";
                                 Source  : String := GNAT.Source_Info.File;
                                 Line    : Natural := GNAT.Source_Info.Line);

   --  Check that the value matches what we expect.
   procedure Assert_Equals is new Assertions.Assert_Equals_T (Value_Type => Integer);
   procedure Assert_Equals is new Assertions.Assert_Equals_T (Value_Type => Character);
   procedure Assert_Equals is new Assertions.Assert_Equals_T (Value_Type => Long_Long_Integer);

   --  Check that the value matches what we expect.
--     procedure Assert (T         : in Test'Class;
--                       Condition : in Boolean;
--                       Message   : in String := "Test failed";
--                       Source    : String := GNAT.Source_Info.File;
--                       Line      : Natural := GNAT.Source_Info.Line);

   --  Check that the value matches what we expect.
   procedure Assert_Equals (T         : in Test'Class;
                            Expect, Value : in Ada.Calendar.Time;
                            Message   : in String := "Test failed";
                            Source    : String := GNAT.Source_Info.File;
                            Line      : Natural := GNAT.Source_Info.Line);

   --  Check that the value matches what we expect.
   procedure Assert_Equals (T         : in Test'Class;
                            Expect, Value : in String;
                            Message   : in String := "Test failed";
                            Source    : String := GNAT.Source_Info.File;
                            Line      : Natural := GNAT.Source_Info.Line);

   --  Check that the value matches what we expect.
   procedure Assert_Equals (T       : in Test'Class;
                            Expect  : in String;
                            Value   : in Unbounded_String;
                            Message : in String := "Test failed";
                            Source    : String := GNAT.Source_Info.File;
                            Line      : Natural := GNAT.Source_Info.Line);

   --  Check that the value matches the regular expression
   procedure Assert_Matches (T       : in Test'Class;
                             Pattern : in String;
                             Value   : in Unbounded_String;
                             Message : in String := "Test failed";
                             Source  : String := GNAT.Source_Info.File;
                             Line    : Natural := GNAT.Source_Info.Line);

   --  Check that the value matches the regular expression
   procedure Assert_Matches (T       : in Test'Class;
                             Pattern : in String;
                             Value   : in String;
                             Message : in String := "Test failed";
                             Source  : String := GNAT.Source_Info.File;
                             Line    : Natural := GNAT.Source_Info.Line);

   --  Default initialization procedure.
   procedure Initialize_Test (Props : in Util.Properties.Manager);

   --  The main testsuite program.  This launches the tests, collects the
   --  results, create performance logs and set the program exit status
   --  according to the testsuite execution status.
   generic
      with function Suite return Access_Test_Suite;
      with procedure Initialize (Props : in Util.Properties.Manager) is Initialize_Test;
   procedure Harness (Name : in String);

end Util.Tests;

Add an Assert_Equals on Long_Long_Integer type


-----------------------------------------------------------------------
--  ADO Sqlite Database -- SQLite Database connections
--  Copyright (C) 2009, 2010, 2011, 2012, 2015, 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 Sqlite3_H;
with Interfaces.C.Strings;

with Util.Log;
with Util.Log.Loggers;
with ADO.C;
with ADO.Statements.Sqlite;
with ADO.Schemas.Sqlite;

package body ADO.Drivers.Connections.Sqlite is

   use ADO.Statements.Sqlite;
   use Interfaces.C;

   pragma Linker_Options ("-lsqlite3");

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ADO.Databases.Sqlite");

   Driver_Name : aliased constant String := "sqlite";
   Driver      : aliased Sqlite_Driver;

   No_Callback : constant Sqlite3_H.sqlite3_callback := null;

   --  ------------------------------
   --  Get the database driver which manages this connection.
   --  ------------------------------
   overriding
   function Get_Driver (Database : in Database_Connection)
                        return Driver_Access is
      pragma Unreferenced (Database);
   begin
      return Driver'Access;
   end Get_Driver;

   --  ------------------------------
   --  Check for an error after executing a sqlite statement.
   --  ------------------------------
   procedure Check_Error (Connection : in Sqlite_Access;
                          Result     : in int) is
   begin
      if Result /= Sqlite3_H.SQLITE_OK and Result /= Sqlite3_H.SQLITE_DONE then
         declare
            Error : constant Strings.chars_ptr := Sqlite3_H.sqlite3_errmsg (Connection);
            Msg   : constant String := Strings.Value (Error);
         begin
            Log.Error ("Error {0}: {1}", int'Image (Result), Msg);
         end;
      end if;
   end Check_Error;

   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   overriding
   function Create_Statement (Database : in Database_Connection;
                              Query    : in String)
                              return Query_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Query => Query);
   end Create_Statement;

   --  ------------------------------
   --  Create a delete statement.
   --  ------------------------------
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   --  ------------------------------
   --  Create an insert statement.
   --  ------------------------------
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   --  ------------------------------
   --  Create an update statement.
   --  ------------------------------
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   --  ------------------------------
   --  Start a transaction.
   --  ------------------------------
   procedure Begin_Transaction (Database : in out Database_Connection) is
   begin
--        Database.Execute ("begin transaction;");
      null;
   end Begin_Transaction;

   --  ------------------------------
   --  Commit the current transaction.
   --  ------------------------------
   procedure Commit (Database : in out Database_Connection) is
   begin
--        Database.Execute ("commit transaction;");
      null;
   end Commit;

   --  ------------------------------
   --  Rollback the current transaction.
   --  ------------------------------
   procedure Rollback (Database : in out Database_Connection) is
   begin
--        Database.Execute ("rollback transaction;");
      null;
   end Rollback;

   procedure Sqlite3_Free (Arg1 : Strings.chars_ptr);
   pragma Import (C, sqlite3_free, "sqlite3_free");

   procedure Execute (Database : in out Database_Connection;
                      SQL      : in Query_String) is
      use type Strings.chars_ptr;

      SQL_Stat  : constant ADO.C.String_Ptr := ADO.C.To_String_Ptr (SQL);
      Result    : int;
      Error_Msg : Strings.chars_ptr;
   begin
      Log.Debug ("Execute: {0}", SQL);

      for Retry in 1 .. 100 loop
         Result := Sqlite3_H.sqlite3_exec (Database.Server, ADO.C.To_C (SQL_Stat), No_Callback,
                                           System.Null_Address, Error_Msg'Address);

         exit when Result /= Sqlite3_H.SQLITE_BUSY;
         delay 0.01 * Retry;
      end loop;
      Check_Error (Database.Server, Result);
      if Error_Msg /= Strings.Null_Ptr then
         Log.Error ("Error: {0}", Strings.Value (Error_Msg));
         Sqlite3_Free (Error_Msg);
      end if;

      --  Free
      --  Strings.Free (SQL_Stat);
   end Execute;

   --  ------------------------------
   --  Closes the database connection
   --  ------------------------------
   overriding
   procedure Close (Database : in out Database_Connection) is
      pragma Unreferenced (Database);
      Result : int;
   begin
      Log.Info ("Close connection");

--        if Database.Count = 1 then
--           Result := Sqlite3_H.sqlite3_close (Database.Server);
--           Database.Server := System.Null_Address;
--        end if;
      pragma Unreferenced (Result);
   end Close;

   --  ------------------------------
   --  Releases the sqlite connection if it is open
   --  ------------------------------
   overriding
   procedure Finalize (Database : in out Database_Connection) is
      Result : int;
   begin
      Log.Debug ("Release connection");

      Result := Sqlite3_H.sqlite3_close (Database.Server);
      Database.Server := System.Null_Address;
      pragma Unreferenced (Result);
   end Finalize;

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

   DB : Ref.Ref;

   --  ------------------------------
   --  Initialize the database connection manager.
   --  ------------------------------
   procedure Create_Connection (D      : in out Sqlite_Driver;
                                Config : in Configuration'Class;
                                Result : in out Ref.Ref'Class) is
      pragma Unreferenced (D);
      use Strings;

      Name     : constant String := To_String (Config.Database);
      Filename : Strings.chars_ptr;
      Status   : int;
      Handle   : aliased System.Address;
      Flags    : constant int := Sqlite3_H.SQLITE_OPEN_FULLMUTEX + Sqlite3_H.SQLITE_OPEN_READWRITE;

   begin
      Log.Info ("Opening database {0}", Name);

      if not DB.Is_Null then
         Result := Ref.Create (DB.Value);
         return;
      end if;
      Filename := Strings.New_String (Name);
      Status := Sqlite3_H.sqlite3_open_v2 (Filename, Handle'Access,
                                           Flags,
                                           Strings.Null_Ptr);

      Strings.Free (Filename);
      if Status /= Sqlite3_H.SQLITE_OK then
         raise DB_Error;
      end if;

      declare
         Database : constant Database_Connection_Access := new Database_Connection;

         procedure Configure (Name : in String;
                              Item : in Util.Properties.Value);
         function Escape (Value : in Util.Properties.Value) return String;

         function Escape (Value : in Util.Properties.Value) return String is
            S : constant String := Util.Properties.To_String (Value);
         begin
            if S'Length > 0 and then S (S'First) >= '0' and then S (S'First) <= '9' then
               return S;
            elsif S'Length > 0 and then S (S'First) = ''' then
               return S;
            else
               return "'" & S & "'";
            end if;
         end Escape;

         procedure Configure (Name : in String;
                              Item : in Util.Properties.Value) is
            SQL : constant String := "PRAGMA " & Name & "=" & Escape (Item);
         begin
            if Util.Strings.Index (Name, '.') = 0 then
               Log.Info ("Configure database with {0}", SQL);
               Database.Execute (SQL);
            end if;
         end Configure;

      begin
         Database.Server := Handle;
         Database.Name   := Config.Database;
         DB := Ref.Create (Database.all'Access);

         --  Configure the connection by setting up the SQLite 'pragma X=Y' SQL commands.
         --  Typical configuration includes:
         --    synchronous=OFF
         --    temp_store=MEMORY
         --    encoding='UTF-8'
         Config.Properties.Iterate (Process => Configure'Access);

         Result := Ref.Create (Database.all'Access);
      end;
   end Create_Connection;

   --  ------------------------------
   --  Initialize the SQLite driver.
   --  ------------------------------
   procedure Initialize is
      use type Util.Strings.Name_Access;
   begin
      Log.Debug ("Initializing sqlite driver");

      if Driver.Name = null then
         Driver.Name := Driver_Name'Access;
         Register (Driver'Access);
      end if;
   end Initialize;

end ADO.Drivers.Connections.Sqlite;

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

with System;
with Interfaces.C.Strings;

with Util.Log;
with Util.Log.Loggers;
with ADO.C;
with ADO.Statements.Sqlite;
with ADO.Schemas.Sqlite;

package body ADO.Drivers.Connections.Sqlite is

   use ADO.Statements.Sqlite;
   use Interfaces.C;

   pragma Linker_Options ("-lsqlite3");

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ADO.Databases.Sqlite");

   Driver_Name : aliased constant String := "sqlite";
   Driver      : aliased Sqlite_Driver;

   No_Callback : constant Sqlite3_H.sqlite3_callback := null;

   --  ------------------------------
   --  Get the database driver which manages this connection.
   --  ------------------------------
   overriding
   function Get_Driver (Database : in Database_Connection)
                        return Driver_Access is
      pragma Unreferenced (Database);
   begin
      return Driver'Access;
   end Get_Driver;

   --  ------------------------------
   --  Check for an error after executing a sqlite statement.
   --  ------------------------------
   procedure Check_Error (Connection : access Sqlite3;
                          Result     : in int) is
   begin
      if Result /= Sqlite3_H.SQLITE_OK and Result /= Sqlite3_H.SQLITE_DONE then
         declare
            Error : constant Strings.chars_ptr := Sqlite3_H.sqlite3_errmsg (Connection);
            Msg   : constant String := Strings.Value (Error);
         begin
            Log.Error ("Error {0}: {1}", int'Image (Result), Msg);
         end;
      end if;
   end Check_Error;

   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   overriding
   function Create_Statement (Database : in Database_Connection;
                              Query    : in String)
                              return Query_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Query => Query);
   end Create_Statement;

   --  ------------------------------
   --  Create a delete statement.
   --  ------------------------------
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   --  ------------------------------
   --  Create an insert statement.
   --  ------------------------------
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   --  ------------------------------
   --  Create an update statement.
   --  ------------------------------
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   --  ------------------------------
   --  Start a transaction.
   --  ------------------------------
   procedure Begin_Transaction (Database : in out Database_Connection) is
   begin
--        Database.Execute ("begin transaction;");
      null;
   end Begin_Transaction;

   --  ------------------------------
   --  Commit the current transaction.
   --  ------------------------------
   procedure Commit (Database : in out Database_Connection) is
   begin
--        Database.Execute ("commit transaction;");
      null;
   end Commit;

   --  ------------------------------
   --  Rollback the current transaction.
   --  ------------------------------
   procedure Rollback (Database : in out Database_Connection) is
   begin
--        Database.Execute ("rollback transaction;");
      null;
   end Rollback;

   procedure Sqlite3_Free (Arg1 : Strings.chars_ptr);
   pragma Import (C, sqlite3_free, "sqlite3_free");

   procedure Execute (Database : in out Database_Connection;
                      SQL      : in Query_String) is
      use type Strings.chars_ptr;

      SQL_Stat  : constant ADO.C.String_Ptr := ADO.C.To_String_Ptr (SQL);
      Result    : int;
      Error_Msg : Strings.chars_ptr;
   begin
      Log.Debug ("Execute: {0}", SQL);

      for Retry in 1 .. 100 loop
         Result := Sqlite3_H.sqlite3_exec (Database.Server, ADO.C.To_C (SQL_Stat), No_Callback,
                                           System.Null_Address, Error_Msg'Address);

         exit when Result /= Sqlite3_H.SQLITE_BUSY;
         delay 0.01 * Retry;
      end loop;
      Check_Error (Database.Server, Result);
      if Error_Msg /= Strings.Null_Ptr then
         Log.Error ("Error: {0}", Strings.Value (Error_Msg));
         Sqlite3_Free (Error_Msg);
      end if;

      --  Free
      --  Strings.Free (SQL_Stat);
   end Execute;

   --  ------------------------------
   --  Closes the database connection
   --  ------------------------------
   overriding
   procedure Close (Database : in out Database_Connection) is
      pragma Unreferenced (Database);
      Result : int;
   begin
      Log.Info ("Close connection");

--        if Database.Count = 1 then
--           Result := Sqlite3_H.sqlite3_close (Database.Server);
--           Database.Server := System.Null_Address;
--        end if;
      pragma Unreferenced (Result);
   end Close;

   --  ------------------------------
   --  Releases the sqlite connection if it is open
   --  ------------------------------
   overriding
   procedure Finalize (Database : in out Database_Connection) is
      Result : int;
   begin
      Log.Debug ("Release connection");

      if Database.Server /= null then
         Result := Sqlite3_H.sqlite3_close (Database.Server);
         Database.Server := null;
      end if;
      pragma Unreferenced (Result);
   end Finalize;

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

   DB : Ref.Ref;

   --  ------------------------------
   --  Initialize the database connection manager.
   --  ------------------------------
   procedure Create_Connection (D      : in out Sqlite_Driver;
                                Config : in Configuration'Class;
                                Result : in out Ref.Ref'Class) is
      pragma Unreferenced (D);
      use Strings;

      Name     : constant String := To_String (Config.Database);
      Filename : Strings.chars_ptr;
      Status   : int;
      Handle   : aliased access Sqlite3;
      Flags    : constant int := Sqlite3_H.SQLITE_OPEN_FULLMUTEX + Sqlite3_H.SQLITE_OPEN_READWRITE;

   begin
      Log.Info ("Opening database {0}", Name);

      if not DB.Is_Null then
         Result := Ref.Create (DB.Value);
         return;
      end if;
      Filename := Strings.New_String (Name);
      Status := Sqlite3_H.sqlite3_open_v2 (Filename, Handle'Address,
                                           Flags,
                                           Strings.Null_Ptr);

      Strings.Free (Filename);
      if Status /= Sqlite3_H.SQLITE_OK then
--          declare
--              Error : constant Strings.chars_ptr := Sqlite3_H.sqlite3_errmsg (Connection);
--              Msg   : constant String := Strings.Value (Error);
--           begin
--              Log.Error ("Error {0}: {1}", int'Image (Result), Msg);
--           end;
         raise DB_Error;
      end if;

      declare
         Database : constant Database_Connection_Access := new Database_Connection;

         procedure Configure (Name : in String;
                              Item : in Util.Properties.Value);
         function Escape (Value : in Util.Properties.Value) return String;

         function Escape (Value : in Util.Properties.Value) return String is
            S : constant String := Util.Properties.To_String (Value);
         begin
            if S'Length > 0 and then S (S'First) >= '0' and then S (S'First) <= '9' then
               return S;
            elsif S'Length > 0 and then S (S'First) = ''' then
               return S;
            else
               return "'" & S & "'";
            end if;
         end Escape;

         procedure Configure (Name : in String;
                              Item : in Util.Properties.Value) is
            SQL : constant String := "PRAGMA " & Name & "=" & Escape (Item);
         begin
            if Util.Strings.Index (Name, '.') = 0 then
               Log.Info ("Configure database with {0}", SQL);
               Database.Execute (SQL);
            end if;
         end Configure;

      begin
         Database.Server := Handle;
         Database.Name   := Config.Database;
         DB := Ref.Create (Database.all'Access);

         --  Configure the connection by setting up the SQLite 'pragma X=Y' SQL commands.
         --  Typical configuration includes:
         --    synchronous=OFF
         --    temp_store=MEMORY
         --    encoding='UTF-8'
         Config.Properties.Iterate (Process => Configure'Access);

         Result := Ref.Create (Database.all'Access);
      end;
   end Create_Connection;

   --  ------------------------------
   --  Initialize the SQLite driver.
   --  ------------------------------
   procedure Initialize is
      use type Util.Strings.Name_Access;
   begin
      Log.Debug ("Initializing sqlite driver");

      if Driver.Name = null then
         Driver.Name := Driver_Name'Access;
         Register (Driver'Access);
      end if;
   end Initialize;

end ADO.Drivers.Connections.Sqlite;

Replace Sqlite_Access and System.Address with the access Sqlite3 type


-----------------------------------------------------------------------
--  html -- ASF HTML Components
--  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 EL.Objects;
package body ASF.Components.Html is

   use EL.Objects;

   procedure Render_Attributes (UI      : in UIHtmlComponent;
                                Context : in out Faces_Context'Class;
                                Writer  : in ResponseWriter_Access) is
      Style  : constant Object := UI.Get_Attribute (Context, "style");
      Class  : constant Object := UI.Get_Attribute (Context, "styleClass");
   begin
      Writer.Write_Attribute ("id", UI.Get_Client_Id);
      if not Is_Null (Class) then
         Writer.Write_Attribute ("class", Class);
      end if;
      if not Is_Null (Style) then
         Writer.Write_Attribute ("style", Style);
      end if;
   end Render_Attributes;

end ASF.Components.Html;

-----------------------------------------------------------------------
--  html -- ASF HTML Components
--  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 EL.Objects;
package body ASF.Components.Html is

   use EL.Objects;

   procedure Render_Attributes (UI      : in UIHtmlComponent;
                                Context : in out Faces_Context'Class;
                                Writer  : in ResponseWriter_Access) is
      Style  : constant Object := UI.Get_Attribute (Context, "style");
      Class  : constant Object := UI.Get_Attribute (Context, "styleClass");
      Title  : constant Object := UI.Get_Attribute (Context, "title");
   begin
      Writer.Write_Attribute ("id", UI.Get_Client_Id);
      if not Is_Null (Class) then
         Writer.Write_Attribute ("class", Class);
      end if;
      if not Is_Null (Style) then
         Writer.Write_Attribute ("style", Style);
      end if;
      if not Is_Null (Title) then
         Writer.Write_Attribute ("title", Title);
      end if;
   end Render_Attributes;

end ASF.Components.Html;

Add support for the title attribute

Add support for the title attribute


-----------------------------------------------------------------------
--  views.nodes.jsf -- JSF Core Tag Library
--  Copyright (C) 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 ASF.Converters;
with ASF.Validators.Texts;
with ASF.Validators.Numbers;
with ASF.Components.Holders;
with ASF.Components.Core.Views;
package body ASF.Views.Nodes.Jsf is

   use ASF;
   use EL.Objects;

   --  ------------------------------
   --  Converter Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Converter Tag
   --  ------------------------------
   function Create_Converter_Tag_Node (Binding    : in Binding_Access;
                                       Line       : in Views.Line_Info;
                                       Parent     : in Views.Nodes.Tag_Node_Access;
                                       Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                       return Views.Nodes.Tag_Node_Access is

      use ASF.Views.Nodes;

      Node : constant Converter_Tag_Node_Access := new Converter_Tag_Node;
      Conv : constant Tag_Attribute_Access := Find_Attribute (Attributes,
                                                              "converterId");
   begin
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      if Conv = null then
         Node.Error ("Missing 'converterId' attribute");
      else
         Node.Converter := EL.Objects.To_Object (Conv.Value);
      end if;
      return Node.all'Access;
   end Create_Converter_Tag_Node;

   --  ------------------------------
   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.  Get the specified converter and
   --  add it to the parent component.  This operation does not create any
   --  new UIComponent.
   --  ------------------------------
   overriding
   procedure Build_Components (Node    : access Converter_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class) is
      use ASF.Components.Holders;
      use type ASF.Converters.Converter_Access;

      Cvt : constant Converters.Converter_Access := Context.Get_Converter (Node.Converter);
   begin
      if not (Parent.all in Value_Holder'Class) then
         Node.Error ("Parent component is not an instance of Value_Holder");
         return;
      end if;

      if Cvt = null then
         Node.Error ("Converter was not found");
         return;
      end if;

      declare
         VH : constant access Value_Holder'Class := Value_Holder'Class (Parent.all)'Access;
      begin
         VH.Set_Converter (Converter => Cvt);
      end;
   end Build_Components;

   --  ------------------------------
   --  Validator Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Validator Tag
   --  ------------------------------
   function Create_Validator_Tag_Node (Binding    : in Binding_Access;
                                       Line       : in Views.Line_Info;
                                       Parent     : in Views.Nodes.Tag_Node_Access;
                                       Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                       return Views.Nodes.Tag_Node_Access is

      use ASF.Views.Nodes;

      Node : constant Validator_Tag_Node_Access := new Validator_Tag_Node;
      Vid  : constant Tag_Attribute_Access := Find_Attribute (Attributes,
                                                              "validatorId");
   begin
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      if Vid = null then
         Node.Error ("Missing 'validatorId' attribute");
      else
         Node.Validator := EL.Objects.To_Object (Vid.Value);
      end if;
      return Node.all'Access;
   end Create_Validator_Tag_Node;

   --  ------------------------------
   --  Get the specified validator and add it to the parent component.
   --  This operation does not create any new UIComponent.
   --  ------------------------------
   overriding
   procedure Build_Components (Node    : access Validator_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class) is
      use ASF.Components.Holders;
      use type ASF.Validators.Validator_Access;

      V      : Validators.Validator_Access;
      Shared : Boolean;
   begin
      if not (Parent.all in Editable_Value_Holder'Class) then
         Node.Error ("Parent component is not an instance of Editable_Value_Holder");
         return;
      end if;

      Validator_Tag_Node'Class (Node.all).Get_Validator (Context, V, Shared);
      if V = null then
         Node.Error ("Validator was not found");
         return;
      end if;

      declare
         VH : constant access Editable_Value_Holder'Class
           := Editable_Value_Holder'Class (Parent.all)'Access;
      begin
         VH.Add_Validator (Validator => V, Shared => Shared);
      end;
   end Build_Components;

   --  ------------------------------
   --  Get the validator instance that corresponds to the validator tag.
   --  Returns in Validator the instance if it exists and indicate
   --  in Shared whether it must be freed or not when the component is deleted.
   --  ------------------------------
   procedure Get_Validator (Node      : in Validator_Tag_Node;
                            Context   : in out Contexts.Facelets.Facelet_Context'Class;
                            Validator : out Validators.Validator_Access;
                            Shared    : out Boolean) is
   begin
      Validator := Context.Get_Validator (Node.Validator);
      Shared    := True;
   end Get_Validator;

   --  ------------------------------
   --  Range Validator Tag
   --  ------------------------------

   --  Create the Range_Validator Tag
   function Create_Range_Validator_Tag_Node (Binding    : in Binding_Access;
                                             Line       : in Views.Line_Info;
                                             Parent     : in Views.Nodes.Tag_Node_Access;
                                             Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                             return Views.Nodes.Tag_Node_Access is

      use ASF.Views.Nodes;

      Node : constant Range_Validator_Tag_Node_Access := new Range_Validator_Tag_Node;
   begin
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      Node.Minimum := Find_Attribute (Attributes, "minimum");
      Node.Maximum := Find_Attribute (Attributes, "maximum");
      if Node.Minimum = null and Node.Maximum = null then
         Node.Error ("Missing 'minimum' or 'maximum' attribute");
      end if;
      return Node.all'Access;
   end Create_Range_Validator_Tag_Node;

   --  Get the validator instance that corresponds to the range validator.
   --  Returns in Validator the validator instance if it exists and indicate
   --  in Shared whether it must be freed or not when the component is deleted.
   overriding
   procedure Get_Validator (Node      : in Range_Validator_Tag_Node;
                            Context   : in out Contexts.Facelets.Facelet_Context'Class;
                            Validator : out Validators.Validator_Access;
                            Shared    : out Boolean) is
      use type ASF.Validators.Validator_Access;

      Min : Long_Long_Integer := Long_Long_Integer'First;
      Max : Long_Long_Integer := Long_Long_Integer'Last;
   begin
      --  Get the minimum and maximum attributes.
      begin
         if Node.Minimum /= null then
            Min := EL.Objects.To_Long_Long_Integer (Get_Value (Node.Minimum.all, Context));
         end if;
         if Node.Maximum /= null then
            Max := EL.Objects.To_Long_Long_Integer (Get_Value (Node.Maximum.all, Context));
         end if;

      exception
         when Constraint_Error =>
            Node.Error ("Invalid minimum or maximum value");
      end;
      Shared := False;
      if Max < Min then
         Node.Error ("Minimum ({0}) should be less than maximum ({1})",
                     Long_Long_Integer'Image (Min), Long_Long_Integer'Image (Max));
         return;
      end if;

      Validator := Validators.Numbers.Create_Range_Validator (Minimum => Min,
                                                              Maximum => Max);
   end Get_Validator;

   --  ------------------------------
   --  Length Validator Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Length_Validator Tag.  Verifies that the XML node defines
   --  the minimum or the maximum or both attributes.
   --  ------------------------------
   function Create_Length_Validator_Tag_Node (Binding    : in Binding_Access;
                                              Line       : in Views.Line_Info;
                                              Parent     : in Views.Nodes.Tag_Node_Access;
                                              Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                              return Views.Nodes.Tag_Node_Access is

      use ASF.Views.Nodes;

      Node : constant Length_Validator_Tag_Node_Access := new Length_Validator_Tag_Node;
   begin
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      Node.Minimum := Find_Attribute (Attributes, "minimum");
      Node.Maximum := Find_Attribute (Attributes, "maximum");
      if Node.Minimum = null and Node.Maximum = null then
         Node.Error ("Missing 'minimum' or 'maximum' attribute");
      end if;
      return Node.all'Access;
   end Create_Length_Validator_Tag_Node;

   --  ------------------------------
   --  Get the validator instance that corresponds to the validator tag.
   --  Returns in Validator the instance if it exists and indicate
   --  in Shared whether it must be freed or not when the component is deleted.
   --  ------------------------------
   overriding
   procedure Get_Validator (Node      : in Length_Validator_Tag_Node;
                            Context   : in out Contexts.Facelets.Facelet_Context'Class;
                            Validator : out Validators.Validator_Access;
                            Shared    : out Boolean) is
      use type ASF.Validators.Validator_Access;

      Min : Natural := 0;
      Max : Natural := Natural'Last;
   begin
      --  Get the minimum and maximum attributes.
      begin
         if Node.Minimum /= null then
            Min := Natural (EL.Objects.To_Integer (Get_Value (Node.Minimum.all, Context)));
         end if;
         if Node.Maximum /= null then
            Max := Natural (EL.Objects.To_Integer (Get_Value (Node.Maximum.all, Context)));
         end if;

      exception
         when Constraint_Error =>
            Node.Error ("Invalid minimum or maximum value");
      end;
      Shared := False;
      if Max < Min then
         Node.Error ("Minimum ({0}) should be less than maximum ({1})",
                     Natural'Image (Min), Natural'Image (Max));
         return;
      end if;

      Validator := Validators.Texts.Create_Length_Validator (Minimum => Min,
                                                             Maximum => Max);
   end Get_Validator;

   --  ------------------------------
   --  Attribute Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Attribute Tag
   --  ------------------------------
   function Create_Attribute_Tag_Node (Binding    : in Binding_Access;
                                       Line       : in Views.Line_Info;
                                       Parent     : in Views.Nodes.Tag_Node_Access;
                                       Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                       return Views.Nodes.Tag_Node_Access is

      use ASF.Views.Nodes;

      Attr : constant Tag_Attribute_Access := Find_Attribute (Attributes, "name");
      Node : Attribute_Tag_Node_Access;
   begin
      Node := new Attribute_Tag_Node;
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      Node.Attr_Name := Attr;
      Node.Value     := Find_Attribute (Attributes, "value");
      if Node.Attr_Name = null then
         Node.Error ("Missing 'name' attribute");
      else
         Node.Attr.Name := Attr.Value;
      end if;
      if Node.Value = null then
         Node.Error ("Missing 'value' attribute");
      end if;
      return Node.all'Access;
   end Create_Attribute_Tag_Node;

   --  ------------------------------
   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.
   --  Adds the attribute to the component node.
   --  This operation does not create any new UIComponent.
   --  ------------------------------
   overriding
   procedure Build_Components (Node    : access Attribute_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class) is
      use EL.Expressions;
   begin
      if Node.Attr_Name /= null and Node.Value /= null then
         if Node.Value.Binding /= null then
            declare
               Expr : constant EL.Expressions.Expression
                 := ASF.Views.Nodes.Reduce_Expression (Node.Value.all, Context);
            begin
               Parent.Set_Attribute (Def => Node.Attr'Access, Value => Expr);
            end;
         else
            Parent.Set_Attribute (Def   => Node.Attr'Access,
                                  Value => Get_Value (Node.Value.all, Context));
         end if;
      end if;
   end Build_Components;

   --  ------------------------------
   --  Facet Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Facet Tag
   --  ------------------------------
   function Create_Facet_Tag_Node (Binding    : in Binding_Access;
                                   Line       : in Views.Line_Info;
                                   Parent     : in Views.Nodes.Tag_Node_Access;
                                   Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                   return Views.Nodes.Tag_Node_Access is
      use ASF.Views.Nodes;

      Node : constant Facet_Tag_Node_Access := new Facet_Tag_Node;
   begin
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      Node.Facet_Name := Find_Attribute (Attributes, "name");
      if Node.Facet_Name = null then
         Node.Error ("Missing 'name' attribute");
      end if;
      return Node.all'Access;
   end Create_Facet_Tag_Node;

   --  ------------------------------
   --  Build the component tree from the tag node and attach it as
   --  the facet component of the given parent.  Calls recursively the
   --  method to create children.
   --  ------------------------------
   overriding
   procedure Build_Components (Node    : access Facet_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class) is
   begin
      null;
   end Build_Components;

   --  ------------------------------
   --  Metadata Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Metadata Tag
   --  ------------------------------
   function Create_Metadata_Tag_Node (Binding    : in Binding_Access;
                                      Line       : in Views.Line_Info;
                                      Parent     : in Views.Nodes.Tag_Node_Access;
                                      Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                      return Views.Nodes.Tag_Node_Access is
      use ASF.Views.Nodes;

      Node : constant Metadata_Tag_Node_Access := new Metadata_Tag_Node;
   begin
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      return Node.all'Access;
   end Create_Metadata_Tag_Node;

   --  ------------------------------
   --  Build the component tree from the tag node and attach it as a metadata information
   --  facet for the UIView parent component.
   --  ------------------------------
   overriding
   procedure Build_Components (Node    : access Metadata_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class) is
      use ASF.Components.Core.Views;
   begin
      if not (Parent.all in UIView'Class) then
         Node.Error ("Parent component of <f:metadata> must be a <f:view>");
         return;
      end if;
      declare
         UI : constant UIViewMetaData_Access := new UIViewMetaData;
      begin
         UIView'Class (Parent.all).Set_Metadata (UI, Node);
         Build_Attributes (UI.all, Node.all, Context);
         UI.Initialize (UI.Get_Context.all);
         Node.Build_Children (UI.all'Access, Context);
      end;
   end Build_Components;

end ASF.Views.Nodes.Jsf;

-----------------------------------------------------------------------
--  views.nodes.jsf -- JSF Core Tag Library
--  Copyright (C) 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 ASF.Converters;
with ASF.Validators.Texts;
with ASF.Validators.Numbers;
with ASF.Components.Holders;
with ASF.Components.Core.Views;
package body ASF.Views.Nodes.Jsf is

   --  ------------------------------
   --  Converter Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Converter Tag
   --  ------------------------------
   function Create_Converter_Tag_Node (Binding    : in Binding_Access;
                                       Line       : in Views.Line_Info;
                                       Parent     : in Views.Nodes.Tag_Node_Access;
                                       Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                       return Views.Nodes.Tag_Node_Access is

      use ASF.Views.Nodes;

      Node : constant Converter_Tag_Node_Access := new Converter_Tag_Node;
      Conv : constant Tag_Attribute_Access := Find_Attribute (Attributes,
                                                              "converterId");
   begin
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      if Conv = null then
         Node.Error ("Missing 'converterId' attribute");
      else
         Node.Converter := EL.Objects.To_Object (Conv.Value);
      end if;
      return Node.all'Access;
   end Create_Converter_Tag_Node;

   --  ------------------------------
   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.  Get the specified converter and
   --  add it to the parent component.  This operation does not create any
   --  new UIComponent.
   --  ------------------------------
   overriding
   procedure Build_Components (Node    : access Converter_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class) is
      use ASF.Components.Holders;
      use type ASF.Converters.Converter_Access;

      Cvt : constant Converters.Converter_Access := Context.Get_Converter (Node.Converter);
   begin
      if not (Parent.all in Value_Holder'Class) then
         Node.Error ("Parent component is not an instance of Value_Holder");
         return;
      end if;

      if Cvt = null then
         Node.Error ("Converter was not found");
         return;
      end if;

      declare
         VH : constant access Value_Holder'Class := Value_Holder'Class (Parent.all)'Access;
      begin
         VH.Set_Converter (Converter => Cvt);
      end;
   end Build_Components;

   --  ------------------------------
   --  Validator Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Validator Tag
   --  ------------------------------
   function Create_Validator_Tag_Node (Binding    : in Binding_Access;
                                       Line       : in Views.Line_Info;
                                       Parent     : in Views.Nodes.Tag_Node_Access;
                                       Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                       return Views.Nodes.Tag_Node_Access is

      use ASF.Views.Nodes;

      Node : constant Validator_Tag_Node_Access := new Validator_Tag_Node;
      Vid  : constant Tag_Attribute_Access := Find_Attribute (Attributes,
                                                              "validatorId");
   begin
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      if Vid = null then
         Node.Error ("Missing 'validatorId' attribute");
      else
         Node.Validator := EL.Objects.To_Object (Vid.Value);
      end if;
      return Node.all'Access;
   end Create_Validator_Tag_Node;

   --  ------------------------------
   --  Get the specified validator and add it to the parent component.
   --  This operation does not create any new UIComponent.
   --  ------------------------------
   overriding
   procedure Build_Components (Node    : access Validator_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class) is
      use ASF.Components.Holders;
      use type ASF.Validators.Validator_Access;

      V      : Validators.Validator_Access;
      Shared : Boolean;
   begin
      if not (Parent.all in Editable_Value_Holder'Class) then
         Node.Error ("Parent component is not an instance of Editable_Value_Holder");
         return;
      end if;

      Validator_Tag_Node'Class (Node.all).Get_Validator (Context, V, Shared);
      if V = null then
         Node.Error ("Validator was not found");
         return;
      end if;

      declare
         VH : constant access Editable_Value_Holder'Class
           := Editable_Value_Holder'Class (Parent.all)'Access;
      begin
         VH.Add_Validator (Validator => V, Shared => Shared);
      end;
   end Build_Components;

   --  ------------------------------
   --  Get the validator instance that corresponds to the validator tag.
   --  Returns in Validator the instance if it exists and indicate
   --  in Shared whether it must be freed or not when the component is deleted.
   --  ------------------------------
   procedure Get_Validator (Node      : in Validator_Tag_Node;
                            Context   : in out Contexts.Facelets.Facelet_Context'Class;
                            Validator : out Validators.Validator_Access;
                            Shared    : out Boolean) is
   begin
      Validator := Context.Get_Validator (Node.Validator);
      Shared    := True;
   end Get_Validator;

   --  ------------------------------
   --  Range Validator Tag
   --  ------------------------------

   --  Create the Range_Validator Tag
   function Create_Range_Validator_Tag_Node (Binding    : in Binding_Access;
                                             Line       : in Views.Line_Info;
                                             Parent     : in Views.Nodes.Tag_Node_Access;
                                             Attributes : in Nodes.Tag_Attribute_Array_Access)
                                             return Views.Nodes.Tag_Node_Access is

      use ASF.Views.Nodes;

      Node : constant Range_Validator_Tag_Node_Access := new Range_Validator_Tag_Node;
   begin
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      Node.Minimum := Find_Attribute (Attributes, "minimum");
      Node.Maximum := Find_Attribute (Attributes, "maximum");
      if Node.Minimum = null and Node.Maximum = null then
         Node.Error ("Missing 'minimum' or 'maximum' attribute");
      end if;
      return Node.all'Access;
   end Create_Range_Validator_Tag_Node;

   --  Get the validator instance that corresponds to the range validator.
   --  Returns in Validator the validator instance if it exists and indicate
   --  in Shared whether it must be freed or not when the component is deleted.
   overriding
   procedure Get_Validator (Node      : in Range_Validator_Tag_Node;
                            Context   : in out Contexts.Facelets.Facelet_Context'Class;
                            Validator : out Validators.Validator_Access;
                            Shared    : out Boolean) is
      use type ASF.Validators.Validator_Access;

      Min : Long_Long_Integer := Long_Long_Integer'First;
      Max : Long_Long_Integer := Long_Long_Integer'Last;
   begin
      --  Get the minimum and maximum attributes.
      begin
         if Node.Minimum /= null then
            Min := EL.Objects.To_Long_Long_Integer (Get_Value (Node.Minimum.all, Context));
         end if;
         if Node.Maximum /= null then
            Max := EL.Objects.To_Long_Long_Integer (Get_Value (Node.Maximum.all, Context));
         end if;

      exception
         when Constraint_Error =>
            Node.Error ("Invalid minimum or maximum value");
      end;
      Shared := False;
      if Max < Min then
         Node.Error ("Minimum ({0}) should be less than maximum ({1})",
                     Long_Long_Integer'Image (Min), Long_Long_Integer'Image (Max));
         return;
      end if;

      Validator := Validators.Numbers.Create_Range_Validator (Minimum => Min,
                                                              Maximum => Max);
   end Get_Validator;

   --  ------------------------------
   --  Length Validator Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Length_Validator Tag.  Verifies that the XML node defines
   --  the minimum or the maximum or both attributes.
   --  ------------------------------
   function Create_Length_Validator_Tag_Node (Binding    : in Binding_Access;
                                              Line       : in Views.Line_Info;
                                              Parent     : in Views.Nodes.Tag_Node_Access;
                                              Attributes : in Nodes.Tag_Attribute_Array_Access)
                                              return Views.Nodes.Tag_Node_Access is

      use ASF.Views.Nodes;

      Node : constant Length_Validator_Tag_Node_Access := new Length_Validator_Tag_Node;
   begin
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      Node.Minimum := Find_Attribute (Attributes, "minimum");
      Node.Maximum := Find_Attribute (Attributes, "maximum");
      if Node.Minimum = null and Node.Maximum = null then
         Node.Error ("Missing 'minimum' or 'maximum' attribute");
      end if;
      return Node.all'Access;
   end Create_Length_Validator_Tag_Node;

   --  ------------------------------
   --  Get the validator instance that corresponds to the validator tag.
   --  Returns in Validator the instance if it exists and indicate
   --  in Shared whether it must be freed or not when the component is deleted.
   --  ------------------------------
   overriding
   procedure Get_Validator (Node      : in Length_Validator_Tag_Node;
                            Context   : in out Contexts.Facelets.Facelet_Context'Class;
                            Validator : out Validators.Validator_Access;
                            Shared    : out Boolean) is
      use type ASF.Validators.Validator_Access;

      Min : Natural := 0;
      Max : Natural := Natural'Last;
   begin
      --  Get the minimum and maximum attributes.
      begin
         if Node.Minimum /= null then
            Min := Natural (EL.Objects.To_Integer (Get_Value (Node.Minimum.all, Context)));
         end if;
         if Node.Maximum /= null then
            Max := Natural (EL.Objects.To_Integer (Get_Value (Node.Maximum.all, Context)));
         end if;

      exception
         when Constraint_Error =>
            Node.Error ("Invalid minimum or maximum value");
      end;
      Shared := False;
      if Max < Min then
         Node.Error ("Minimum ({0}) should be less than maximum ({1})",
                     Natural'Image (Min), Natural'Image (Max));
         return;
      end if;

      Validator := Validators.Texts.Create_Length_Validator (Minimum => Min,
                                                             Maximum => Max);
   end Get_Validator;

   --  ------------------------------
   --  Attribute Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Attribute Tag
   --  ------------------------------
   function Create_Attribute_Tag_Node (Binding    : in Binding_Access;
                                       Line       : in Views.Line_Info;
                                       Parent     : in Views.Nodes.Tag_Node_Access;
                                       Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                       return Views.Nodes.Tag_Node_Access is

      use ASF.Views.Nodes;

      Attr : constant Tag_Attribute_Access := Find_Attribute (Attributes, "name");
      Node : Attribute_Tag_Node_Access;
   begin
      Node := new Attribute_Tag_Node;
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      Node.Attr_Name := Attr;
      Node.Value     := Find_Attribute (Attributes, "value");
      if Node.Attr_Name = null then
         Node.Error ("Missing 'name' attribute");
      else
         Node.Attr.Name := Attr.Value;
      end if;
      if Node.Value = null then
         Node.Error ("Missing 'value' attribute");
      end if;
      return Node.all'Access;
   end Create_Attribute_Tag_Node;

   --  ------------------------------
   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.
   --  Adds the attribute to the component node.
   --  This operation does not create any new UIComponent.
   --  ------------------------------
   overriding
   procedure Build_Components (Node    : access Attribute_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class) is
      use EL.Expressions;
   begin
      if Node.Attr_Name /= null and Node.Value /= null then
         if Node.Value.Binding /= null then
            declare
               Expr : constant EL.Expressions.Expression
                 := ASF.Views.Nodes.Reduce_Expression (Node.Value.all, Context);
            begin
               Parent.Set_Attribute (Def => Node.Attr'Access, Value => Expr);
            end;
         else
            Parent.Set_Attribute (Def   => Node.Attr'Access,
                                  Value => Get_Value (Node.Value.all, Context));
         end if;
      end if;
   end Build_Components;

   --  ------------------------------
   --  Facet Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Facet Tag
   --  ------------------------------
   function Create_Facet_Tag_Node (Binding    : in Binding_Access;
                                   Line       : in Views.Line_Info;
                                   Parent     : in Views.Nodes.Tag_Node_Access;
                                   Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                   return Views.Nodes.Tag_Node_Access is
      use ASF.Views.Nodes;

      Node : constant Facet_Tag_Node_Access := new Facet_Tag_Node;
   begin
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      Node.Facet_Name := Find_Attribute (Attributes, "name");
      if Node.Facet_Name = null then
         Node.Error ("Missing 'name' attribute");
      end if;
      return Node.all'Access;
   end Create_Facet_Tag_Node;

   --  ------------------------------
   --  Build the component tree from the tag node and attach it as
   --  the facet component of the given parent.  Calls recursively the
   --  method to create children.
   --  ------------------------------
   overriding
   procedure Build_Components (Node    : access Facet_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class) is
   begin
      null;
   end Build_Components;

   --  ------------------------------
   --  Metadata Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Metadata Tag
   --  ------------------------------
   function Create_Metadata_Tag_Node (Binding    : in Binding_Access;
                                      Line       : in Views.Line_Info;
                                      Parent     : in Views.Nodes.Tag_Node_Access;
                                      Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                      return Views.Nodes.Tag_Node_Access is
      use ASF.Views.Nodes;

      Node : constant Metadata_Tag_Node_Access := new Metadata_Tag_Node;
   begin
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      return Node.all'Access;
   end Create_Metadata_Tag_Node;

   --  ------------------------------
   --  Build the component tree from the tag node and attach it as a metadata information
   --  facet for the UIView parent component.
   --  ------------------------------
   overriding
   procedure Build_Components (Node    : access Metadata_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class) is
      use ASF.Components.Core.Views;
   begin
      if not (Parent.all in UIView'Class) then
         Node.Error ("Parent component of <f:metadata> must be a <f:view>");
         return;
      end if;
      declare
         UI : constant UIViewMetaData_Access := new UIViewMetaData;
      begin
         UIView'Class (Parent.all).Set_Metadata (UI, Node);
         Build_Attributes (UI.all, Node.all, Context);
         UI.Initialize (UI.Get_Context.all);
         Node.Build_Children (UI.all'Access, Context);
      end;
   end Build_Components;

end ASF.Views.Nodes.Jsf;

Fix some compilation warnings

Fix some compilation warnings