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

with Util.Beans.Objects;
with Util.Beans.Objects.Time;
with Util.Serialize.Mappers.Record_Mapper;
with Util.Http.Rest;
package body Security.Auth.OAuth.Facebook is

   --
   TIME_SHIFT : constant Duration := 12 * 3600.0;

   type Token_Info_Field_Type is (FIELD_APP_ID, FIELD_IS_VALID,
                                  FIELD_EXPIRES, FIELD_ISSUED_AT,
                                  FIELD_USER_ID, FIELD_EMAIL, FIELD_FIRST_NAME,
                                  FIELD_LAST_NAME, FIELD_NAME, FIELD_LOCALE, FIELD_GENDER);

   type Token_Info is record
      App_Id     : Ada.Strings.Unbounded.Unbounded_String;
      Is_Valid   : Boolean := False;
      Expires    : Ada.Calendar.Time;
      Issued     : Ada.Calendar.Time;
      User_Id    : Ada.Strings.Unbounded.Unbounded_String;
      Email      : Ada.Strings.Unbounded.Unbounded_String;
      Name       : Ada.Strings.Unbounded.Unbounded_String;
      First_Name : Ada.Strings.Unbounded.Unbounded_String;
      Last_Name  : Ada.Strings.Unbounded.Unbounded_String;
      Locale     : Ada.Strings.Unbounded.Unbounded_String;
      Gender     : Ada.Strings.Unbounded.Unbounded_String;
   end record;
   type Token_Info_Access is access all Token_Info;

   procedure Set_Member (Into  : in out Token_Info;
                         Field : in Token_Info_Field_Type;
                         Value : in Util.Beans.Objects.Object);

   procedure Set_Member (Into  : in out Token_Info;
                         Field : in Token_Info_Field_Type;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when FIELD_APP_ID =>
            Into.App_Id := Util.Beans.Objects.To_Unbounded_String (Value);

         when FIELD_IS_VALID =>
            Into.Is_Valid := Util.Beans.Objects.To_Boolean (Value);

         when FIELD_EXPIRES =>
            Into.Expires := Util.Beans.Objects.Time.To_Time (Value);

         when FIELD_ISSUED_AT =>
            Into.Issued := Util.Beans.Objects.Time.To_Time (Value);

         when FIELD_USER_ID =>
            Into.User_Id := Util.Beans.Objects.To_Unbounded_String (Value);

         when FIELD_EMAIL =>
            Into.Email := Util.Beans.Objects.To_Unbounded_String (Value);

         when FIELD_NAME =>
            Into.Name := Util.Beans.Objects.To_Unbounded_String (Value);

         when FIELD_FIRST_NAME =>
            Into.First_Name := Util.Beans.Objects.To_Unbounded_String (Value);

         when FIELD_LAST_NAME =>
            Into.Last_Name := Util.Beans.Objects.To_Unbounded_String (Value);

         when FIELD_LOCALE =>
            Into.Locale := Util.Beans.Objects.To_Unbounded_String (Value);

         when FIELD_GENDER =>
            Into.Gender := Util.Beans.Objects.To_Unbounded_String (Value);

      end case;
   end Set_Member;

   package Token_Info_Mapper is
      new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Token_Info,
                                                Element_Type_Access => Token_Info_Access,
                                                Fields              => Token_Info_Field_Type,
                                                Set_Member          => Set_Member);

   procedure Get_Token_Info is
     new Util.Http.Rest.Rest_Get (Element_Mapper => Token_Info_Mapper);

   Token_Info_Map : aliased Token_Info_Mapper.Mapper;

   --  ------------------------------
   --  Verify the OAuth access token and retrieve information about the user.
   --  ------------------------------
   overriding
   procedure Verify_Access_Token (Realm   : in Manager;
                                  Assoc   : in Association;
                                  Request : in Parameters'Class;
                                  Token   : in Security.OAuth.Clients.Access_Token_Access;
                                  Result  : in out Authentication) is
      use type Ada.Calendar.Time;

      T    : constant String := Token.Get_Name;
      Info : aliased Token_Info;
      Now  : constant Ada.Calendar.Time := Ada.Calendar.Clock;
   begin
      Get_Token_Info ("https://graph.facebook.com/debug_token?access_token=" & T
                      & "&input_token=" & T,
                      Token_Info_Map'Access,
                      "/data",
                      Info'Unchecked_Access);
      if not Info.Is_Valid then
         Set_Result (Result, INVALID_SIGNATURE, "invalid access token returned");

      elsif Info.Issued + TIME_SHIFT < Now then
         Set_Result (Result, INVALID_SIGNATURE, "the access token issued more than 1 hour ago");

      elsif Info.Expires + TIME_SHIFT < Now then
         Set_Result (Result, INVALID_SIGNATURE, "the access token has expored");

      elsif Length (Info.User_Id) = 0 then
         Set_Result (Result, INVALID_SIGNATURE, "the access token refers to an empty user_id");

      elsif Info.App_Id /= Realm.App.Get_Application_Identifier then
         Set_Result (Result, INVALID_SIGNATURE,
                     "the access token was granted for another application");

      else
         Result.Identity := To_Unbounded_String ("https://graph.facebook.com/");
         Append (Result.Identity, Info.User_Id);
         Result.Claimed_Id := Result.Identity;

         Get_Token_Info ("https://graph.facebook.com/" & To_String (Info.User_Id)
                           & "?access_token=" & T,
                         Token_Info_Map'Access,
                         "",
                         Info'Unchecked_Access);

         Result.Email      := Info.Email;
         Result.Full_Name  := Info.Name;
         Result.First_Name := Info.First_Name;
         Result.Last_Name  := Info.Last_Name;
         Result.Language   := Info.Locale;
         Result.Gender     := Info.Gender;
         Set_Result (Result, AUTHENTICATED, "authenticated");
      end if;
   end Verify_Access_Token;

begin
   Token_Info_Map.Add_Mapping ("app_id", FIELD_APP_ID);
   Token_Info_Map.Add_Mapping ("expires_at", FIELD_EXPIRES);
   Token_Info_Map.Add_Mapping ("issued_at", FIELD_ISSUED_AT);
   Token_Info_Map.Add_Mapping ("is_valid", FIELD_IS_VALID);
   Token_Info_Map.Add_Mapping ("user_id", FIELD_USER_ID);
   Token_Info_Map.Add_Mapping ("email", FIELD_EMAIL);
   Token_Info_Map.Add_Mapping ("name", FIELD_NAME);
   Token_Info_Map.Add_Mapping ("first_name", FIELD_FIRST_NAME);
   Token_Info_Map.Add_Mapping ("last_name", FIELD_LAST_NAME);
   Token_Info_Map.Add_Mapping ("locale", FIELD_LOCALE);
   Token_Info_Map.Add_Mapping ("gender", FIELD_GENDER);
end Security.Auth.OAuth.Facebook;

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

with Util.Beans.Objects;
with Util.Beans.Objects.Time;
with Util.Serialize.Mappers.Record_Mapper;
with Util.Http.Rest;
package body Security.Auth.OAuth.Facebook is

   --
   TIME_SHIFT : constant Duration := 12 * 3600.0;

   type Token_Info_Field_Type is (FIELD_APP_ID, FIELD_IS_VALID,
                                  FIELD_EXPIRES, FIELD_ISSUED_AT,
                                  FIELD_USER_ID, FIELD_EMAIL, FIELD_FIRST_NAME,
                                  FIELD_LAST_NAME, FIELD_NAME, FIELD_LOCALE, FIELD_GENDER);

   type Token_Info is record
      App_Id     : Ada.Strings.Unbounded.Unbounded_String;
      Is_Valid   : Boolean := False;
      Expires    : Ada.Calendar.Time;
      Issued     : Ada.Calendar.Time;
      User_Id    : Ada.Strings.Unbounded.Unbounded_String;
      Email      : Ada.Strings.Unbounded.Unbounded_String;
      Name       : Ada.Strings.Unbounded.Unbounded_String;
      First_Name : Ada.Strings.Unbounded.Unbounded_String;
      Last_Name  : Ada.Strings.Unbounded.Unbounded_String;
      Locale     : Ada.Strings.Unbounded.Unbounded_String;
      Gender     : Ada.Strings.Unbounded.Unbounded_String;
   end record;
   type Token_Info_Access is access all Token_Info;

   procedure Set_Member (Into  : in out Token_Info;
                         Field : in Token_Info_Field_Type;
                         Value : in Util.Beans.Objects.Object);

   procedure Set_Member (Into  : in out Token_Info;
                         Field : in Token_Info_Field_Type;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when FIELD_APP_ID =>
            Into.App_Id := Util.Beans.Objects.To_Unbounded_String (Value);

         when FIELD_IS_VALID =>
            Into.Is_Valid := Util.Beans.Objects.To_Boolean (Value);

         when FIELD_EXPIRES =>
            Into.Expires := Util.Beans.Objects.Time.To_Time (Value);

         when FIELD_ISSUED_AT =>
            Into.Issued := Util.Beans.Objects.Time.To_Time (Value);

         when FIELD_USER_ID =>
            Into.User_Id := Util.Beans.Objects.To_Unbounded_String (Value);

         when FIELD_EMAIL =>
            Into.Email := Util.Beans.Objects.To_Unbounded_String (Value);

         when FIELD_NAME =>
            Into.Name := Util.Beans.Objects.To_Unbounded_String (Value);

         when FIELD_FIRST_NAME =>
            Into.First_Name := Util.Beans.Objects.To_Unbounded_String (Value);

         when FIELD_LAST_NAME =>
            Into.Last_Name := Util.Beans.Objects.To_Unbounded_String (Value);

         when FIELD_LOCALE =>
            Into.Locale := Util.Beans.Objects.To_Unbounded_String (Value);

         when FIELD_GENDER =>
            Into.Gender := Util.Beans.Objects.To_Unbounded_String (Value);

      end case;
   end Set_Member;

   package Token_Info_Mapper is
      new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Token_Info,
                                                Element_Type_Access => Token_Info_Access,
                                                Fields              => Token_Info_Field_Type,
                                                Set_Member          => Set_Member);

   procedure Get_Token_Info is
     new Util.Http.Rest.Rest_Get (Element_Mapper => Token_Info_Mapper);

   Token_Info_Map : aliased Token_Info_Mapper.Mapper;

   --  ------------------------------
   --  Verify the OAuth access token and retrieve information about the user.
   --  ------------------------------
   overriding
   procedure Verify_Access_Token (Realm   : in Manager;
                                  Assoc   : in Association;
                                  Request : in Parameters'Class;
                                  Token   : in Security.OAuth.Clients.Access_Token_Access;
                                  Result  : in out Authentication) is
      pragma Unreferenced (Assoc, Request);
      use type Ada.Calendar.Time;

      T    : constant String := Token.Get_Name;
      Info : aliased Token_Info;
      Now  : constant Ada.Calendar.Time := Ada.Calendar.Clock;
   begin
      Get_Token_Info ("https://graph.facebook.com/debug_token?access_token=" & T
                      & "&input_token=" & T,
                      Token_Info_Map'Access,
                      "/data",
                      Info'Unchecked_Access);
      if not Info.Is_Valid then
         Set_Result (Result, INVALID_SIGNATURE, "invalid access token returned");

      elsif Info.Issued + TIME_SHIFT < Now then
         Set_Result (Result, INVALID_SIGNATURE, "the access token issued more than 1 hour ago");

      elsif Info.Expires + TIME_SHIFT < Now then
         Set_Result (Result, INVALID_SIGNATURE, "the access token has expored");

      elsif Length (Info.User_Id) = 0 then
         Set_Result (Result, INVALID_SIGNATURE, "the access token refers to an empty user_id");

      elsif Info.App_Id /= Realm.App.Get_Application_Identifier then
         Set_Result (Result, INVALID_SIGNATURE,
                     "the access token was granted for another application");

      else
         Result.Identity := To_Unbounded_String ("https://graph.facebook.com/");
         Append (Result.Identity, Info.User_Id);
         Result.Claimed_Id := Result.Identity;

         Get_Token_Info ("https://graph.facebook.com/" & To_String (Info.User_Id)
                           & "?access_token=" & T,
                         Token_Info_Map'Access,
                         "",
                         Info'Unchecked_Access);

         Result.Email      := Info.Email;
         Result.Full_Name  := Info.Name;
         Result.First_Name := Info.First_Name;
         Result.Last_Name  := Info.Last_Name;
         Result.Language   := Info.Locale;
         Result.Gender     := Info.Gender;
         Set_Result (Result, AUTHENTICATED, "authenticated");
      end if;
   end Verify_Access_Token;

begin
   Token_Info_Map.Add_Mapping ("app_id", FIELD_APP_ID);
   Token_Info_Map.Add_Mapping ("expires_at", FIELD_EXPIRES);
   Token_Info_Map.Add_Mapping ("issued_at", FIELD_ISSUED_AT);
   Token_Info_Map.Add_Mapping ("is_valid", FIELD_IS_VALID);
   Token_Info_Map.Add_Mapping ("user_id", FIELD_USER_ID);
   Token_Info_Map.Add_Mapping ("email", FIELD_EMAIL);
   Token_Info_Map.Add_Mapping ("name", FIELD_NAME);
   Token_Info_Map.Add_Mapping ("first_name", FIELD_FIRST_NAME);
   Token_Info_Map.Add_Mapping ("last_name", FIELD_LAST_NAME);
   Token_Info_Map.Add_Mapping ("locale", FIELD_LOCALE);
   Token_Info_Map.Add_Mapping ("gender", FIELD_GENDER);
end Security.Auth.OAuth.Facebook;

Fix compilation warning

Fix compilation warning


-----------------------------------------------------------------------
--  awa -- Ada Web Application
--  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.IO_Exceptions;

with ASF.Beans;

with EL.Contexts.Default;
with Util.Files;
with Util.Log.Loggers;

with AWA.Components.Factory;
with AWA.Applications.Factory;
with AWA.Applications.Configs;
package body AWA.Applications is

   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("AWA.Applications.Configs");

   --  ------------------------------
   --  Initialize the application
   --  ------------------------------
   overriding
   procedure Initialize (App     : in out Application;
                         Conf    : in ASF.Applications.Config;
                         Factory : in out ASF.Applications.Main.Application_Factory'Class) is
      URI     : constant String := Conf.Get ("database");
   begin
      AWA.Applications.Factory.Set_Application (Factory, App'Unchecked_Access);
      App.DB_Factory.Create (URI);
      ASF.Applications.Main.Application (App).Initialize (Conf, Factory);

      Application'Class (App).Initialize_Modules;
      App.Load_Configuration;
   end Initialize;

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

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

   --  ------------------------------
   --  Initialize the ASF components provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the component factories used by the application.
   --  ------------------------------
   overriding
   procedure Initialize_Components (App : in out Application) is
   begin
      ASF.Applications.Main.Application (App).Initialize_Components;
      App.Add_Components (AWA.Components.Factory.Definition);
   end Initialize_Components;

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

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

   --  ------------------------------
   --  Register the module in the registry.
   --  ------------------------------
   procedure Load_Configuration (App : in out Application) is
      Paths : constant String := App.Get_Config (P_Module_Dir.P);
      Base  : constant String := App.Get_Config (P_Config_File.P);
      Path  : constant String := Util.Files.Find_File_Path (Base, Paths);
      Ctx   : aliased EL.Contexts.Default.Default_Context;
   begin
      AWA.Applications.Configs.Read_Configuration (App, Path, Ctx'Unchecked_Access);

   exception
      when Ada.IO_Exceptions.Name_Error =>
         Log.Warn ("Application configuration file '{0}' does not exist", Path);
   end Load_Configuration;

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

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

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

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

   --  ------------------------------
   --  Register the module in the application
   --  ------------------------------
   procedure Register (App     : in out Application;
                       Module  : in AWA.Modules.Module_Access;
                       Name    : in String;
                       URI     : in String := "") is
--        procedure Set_Beans (Factory : in out ASF.Beans.Bean_Factory);
--        procedure Set_Beans (Factory : in out ASF.Beans.Bean_Factory) is
--        begin
--           Module.Register_Factory (Factory);
--        end Set_Beans;
--
--        procedure Register_Beans is
--           new ASF.Applications.Main.Register_Beans (Set_Beans);
   begin
      --  Module.Initialize ();
      AWA.Modules.Register (App.Modules'Unchecked_Access, App'Unchecked_Access, Module, Name, URI);

--        Register_Beans (App);
--        App.View.Register_Module (Module);  SCz: 2011-08-10: must check if necessary
   end Register;

end AWA.Applications;

-----------------------------------------------------------------------
--  awa -- Ada Web Application
--  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.IO_Exceptions;

with ASF.Beans;

with ADO.Drivers;

with EL.Contexts.Default;
with Util.Files;
with Util.Log.Loggers;

with AWA.Components.Factory;
with AWA.Applications.Factory;
with AWA.Applications.Configs;
package body AWA.Applications is

   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("AWA.Applications.Configs");

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

      Application'Class (App).Initialize_Modules;
      App.Load_Configuration;
   end Initialize;

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

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

   --  ------------------------------
   --  Initialize the ASF components provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the component factories used by the application.
   --  ------------------------------
   overriding
   procedure Initialize_Components (App : in out Application) is
   begin
      ASF.Applications.Main.Application (App).Initialize_Components;
      App.Add_Components (AWA.Components.Factory.Definition);
   end Initialize_Components;

   --  ------------------------------
   --  Initialize the application configuration properties.  Properties defined in Conf
   --  are expanded by using the EL expression resolver.
   --  ------------------------------
   overriding
   procedure Initialize_Config (App  : in out Application;
                                Conf : in out ASF.Applications.Config) is
   begin
      ASF.Applications.Main.Application (App).Initialize_Config (Conf);
      ADO.Drivers.Initialize (Conf);
      App.DB_Factory.Create (Conf.Get ("database"));
      AWA.Modules.Initialize (App.Modules, Conf);
   end Initialize_Config;

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

   --  ------------------------------
   --  Register the module in the registry.
   --  ------------------------------
   procedure Load_Configuration (App : in out Application) is
      Paths : constant String := App.Get_Config (P_Module_Dir.P);
      Base  : constant String := App.Get_Config (P_Config_File.P);
      Path  : constant String := Util.Files.Find_File_Path (Base, Paths);
      Ctx   : aliased EL.Contexts.Default.Default_Context;
   begin
      AWA.Applications.Configs.Read_Configuration (App, Path, Ctx'Unchecked_Access);

   exception
      when Ada.IO_Exceptions.Name_Error =>
         Log.Warn ("Application configuration file '{0}' does not exist", Path);
   end Load_Configuration;

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

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

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

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

   --  ------------------------------
   --  Register the module in the application
   --  ------------------------------
   procedure Register (App     : in out Application;
                       Module  : in AWA.Modules.Module_Access;
                       Name    : in String;
                       URI     : in String := "") is
--        procedure Set_Beans (Factory : in out ASF.Beans.Bean_Factory);
--        procedure Set_Beans (Factory : in out ASF.Beans.Bean_Factory) is
--        begin
--           Module.Register_Factory (Factory);
--        end Set_Beans;
--
--        procedure Register_Beans is
--           new ASF.Applications.Main.Register_Beans (Set_Beans);
   begin
      --  Module.Initialize ();
      AWA.Modules.Register (App.Modules'Unchecked_Access, App'Unchecked_Access, Module, Name, URI);

--        Register_Beans (App);
--        App.View.Register_Module (Module);  SCz: 2011-08-10: must check if necessary
   end Register;

end AWA.Applications;

Initialize the database connection in Initialize_Config so that the EL expressions in configuration properties gets evaluated


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

with Util.Test_Caller;
with Util.Assertions;
with Util.Strings;
with Util.Log.Loggers;
with GNAT.Source_Info;

package body Wiki.Html_Parser.Tests is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Wiki.Html_Parser");

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

   procedure Assert_Equals is
      new Util.Assertions.Assert_Equals_T (State_Type);

   procedure Assert_Equals is
      new Util.Assertions.Assert_Equals_T (Html_Parser_State);

   procedure Assert_Equals is
      new Util.Assertions.Assert_Equals_T (Wiki.Strings.WChar);

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Wiki.Html_Parsers.Parse_Element",
                       Test_Parse_Element'Access);
      Caller.Add_Test (Suite, "Test Wiki.Html_Parsers.Parse_Element (Attributes)",
                       Test_Parse_Element_Attributes'Access);
      Caller.Add_Test (Suite, "Test Wiki.Html_Parsers.Parse_Element (Errors)",
                       Test_Parse_Error'Access);
      Caller.Add_Test (Suite, "Test Wiki.Html_Parsers.Parse_Element (Doctype)",
                       Test_Parse_Doctype'Access);
      Caller.Add_Test (Suite, "Test Wiki.Html_Parsers.Parse_Entity",
                       Test_Parse_Entity'Access);
   end Add_Tests;

   procedure Check_Parser (T           : in out Test;
                           Expect      : in Wiki.Strings.WString;
                           Expect_Kind : in State_Type;
                           Content     : in Wiki.Strings.WString;
                           Source      : in String := GNAT.Source_Info.File;
                           Line        : in Natural := GNAT.Source_Info.Line) is
      P    : Parser_Type;
      Last : Natural;

      procedure Process (Kind       : in State_Type;
                         Name       : in Wiki.Strings.WString;
                         Attributes : in out Wiki.Attributes.Attribute_List) is
      begin
         Assert_Equals (T, Expect_Kind, Kind, "Invalid state type", Source, Line);
         if Kind /= HTML_ERROR then
            T.Assert (Name = Expect, "Invalid name", Source, Line);
         end if;
         T.Attributes := Attributes;
      end Process;

   begin
      Parse_Element (P, Content, Content'First, Process'Access, Last);
      Util.Tests.Assert_Equals (T, Content'Last + 1, Last, "Invalid last index", Source, Line);
      Assert_Equals (T, P.State, State_None, "Invalid parser state", Source, Line);

      Parse_Element (P, Content, Content'First, Process'Access, Last);
      Util.Tests.Assert_Equals (T, Content'Last + 1, Last, "Invalid last index", Source, Line);
      Assert_Equals (T, P.State, State_None, "Invalid parser state", Source, Line);

      for I in 1 .. Content'Length loop
         declare
            First   : Natural := Content'First;
            End_Pos : Natural := Content'First;
            Retry   : Natural := 0;
         begin
            loop
               Parse_Element (P, Content (Content'First .. End_Pos), First, Process'Access, Last);
               exit when Last = Content'Last + 1;
               Retry := Retry + 1;
               First := Last;
               End_Pos := End_Pos + I;
               if End_Pos > Content'Last then
                  End_Pos := Content'Last;
               end if;
               T.Assert (Retry <= Content'Length, "Too many retries", Source, Line);
            end loop;
            Assert_Equals (T, P.State, State_None, "Invalid parser state", Source, Line);
         end;
      end loop;
   end Check_Parser;

   procedure Check_Error (T           : in out Test;
                          Last_Pos    : in Natural;
                          Content     : in Wiki.Strings.WString;
                          Source      : in String := GNAT.Source_Info.File;
                          Line        : in Natural := GNAT.Source_Info.Line) is
      P    : Parser_Type;
      Last : Natural;

      procedure Process (Kind       : in State_Type;
                         Name       : in Wiki.Strings.WString;
                         Attributes : in out Wiki.Attributes.Attribute_List) is
      begin
         Assert_Equals (T, HTML_ERROR, Kind, "Invalid state type", Source, Line);
      end Process;

   begin
      Parse_Element (P, Content, Content'First, Process'Access, Last);
      Util.Tests.Assert_Equals (T, Last_Pos, Last, "Invalid last index", Source, Line);
   end Check_Error;

   --  ------------------------------
   --  Test Parse_Element operation.
   --  ------------------------------
   procedure Test_Parse_Element (T : in out Test) is
   begin
      Check_Parser (T, "a", HTML_START, "a>");
      Check_Parser (T, "a", HTML_START, "   a   >");
      Check_Parser (T, "input", HTML_START, "input>");
      Check_Parser (T, "a", HTML_END, "/a>");
      Check_Parser (T, "input", HTML_START_END, "  input  />");
      Check_Parser (T, "br", HTML_START_END, "br/>");
      Check_Parser (T, "img", HTML_END, "/img   >");
   end Test_Parse_Element;

   --  ------------------------------
   --  Test parsing HTML with errors.
   --  ------------------------------
   procedure Test_Parse_Error (T : in out Test) is
   begin
      Check_Error (T, 2, "a'");
      Check_Error (T, 9, "input   """);
      Check_Error (T, 7, "input =");
      Check_Error (T, 17, "input abcd efgh =");
   end Test_Parse_Error;

   procedure Check_Attribute (T     : in out Test;
                              Name  : in String;
                              Value : in Wiki.Strings.WString) is
      V : constant Wiki.Strings.WString := Wiki.Attributes.Get_Attribute (T.Attributes, Name);
   begin
      T.Assert (Value = V, "Invalid attribute " & Name);
   end Check_Attribute;

   --  ------------------------------
   --  Test Parse_Element with attributes
   --  ------------------------------
   procedure Test_Parse_Element_Attributes (T : in out Test) is
   begin
      Check_Parser (T, "a", HTML_START, "a href='toto' title=' bla bla '>");

      Util.Tests.Assert_Equals (T, 2, Wiki.Attributes.Length (T.Attributes),
                                "invalid number of attributes");
      Check_Attribute (T, "href", "toto");
      Check_Attribute (T, "title", " bla bla ");

      Check_Parser (T, "img", HTML_START_END, "img src=""plop"" width=4 height=5/>");

      Util.Tests.Assert_Equals (T, 3, Wiki.Attributes.Length (T.Attributes),
                                "invalid number of attributes");
      Check_Attribute (T, "src", "plop");
      Check_Attribute (T, "width", "4");
      Check_Attribute (T, "height", "5");

      Check_Parser (T, "select", HTML_START, "select id=a name=test >");

      Util.Tests.Assert_Equals (T, 2, Wiki.Attributes.Length (T.Attributes),
                                "invalid number of attributes");
      Check_Attribute (T, "id", "a");
      Check_Attribute (T, "name", "test");

   end Test_Parse_Element_Attributes;

   --  ------------------------------
   --  Test Parse_Doctype
   --  ------------------------------
   procedure Test_Parse_Doctype (T : in out Test) is
      P    : Parser_Type;
      Last : Natural;

      procedure Process (Kind       : in State_Type;
                         Name       : in Wiki.Strings.WString;
                         Attributes : in out Wiki.Attributes.Attribute_List) is
      begin
         T.Fail ("Should not be called");
      end Process;
   begin
      Parse_Element (P, "!doctype html>", 1, Process'Access, Last);
      Util.Tests.Assert_Equals (T, 15, Last, "Invalid last index");

      Parse_Element (P, "!doctype html>  ", 1, Process'Access, Last);
      Util.Tests.Assert_Equals (T, 15, Last, "Invalid last index");

      Parse_Element (P, "!-- blq blq < > -->", 1, Process'Access, Last);
      Util.Tests.Assert_Equals (T, 20, Last, "Invalid last index");

      Parse_Element (P, "!-- blq blq < > --", 1, Process'Access, Last);
      Util.Tests.Assert_Equals (T, 19, Last, "Invalid last index");
      Assert_Equals (T, P.State, State_Comment, "Invalid parser state");

      Parse_Element (P, "bla -- blq blq < > -->", 1, Process'Access, Last);
      Util.Tests.Assert_Equals (T, 23, Last, "Invalid last index");
      Assert_Equals (T, P.State, State_None, "Invalid parser state");

      Parse_Element (P, "!doctype html  ", 1, Process'Access, Last);
      Util.Tests.Assert_Equals (T, 16, Last, "Invalid last index");
      Assert_Equals (T, P.State, State_Doctype, "Invalid parser state");

      Parse_Element (P, "bla -- blq blq < > --x", 1, Process'Access, Last);
      Util.Tests.Assert_Equals (T, 19, Last, "Invalid last index");
      Assert_Equals (T, P.State, State_None, "Invalid parser state");

   end Test_Parse_Doctype;

   --  ------------------------------
   --  Test Parse_Entity.
   --  ------------------------------
   procedure Test_Parse_Entity (T : in out Test) is
      P      : Parser_Type;
      Last   : Natural;
      Entity : Wiki.Strings.WChar;
   begin
      Parse_Entity (P, "amp; ", 1, Entity, Last);
      Util.Tests.Assert_Equals (T, 5, Last, "Invalid last index");
      Assert_Equals (T, '&', Entity, "Invalid parsed entity");

      Parse_Entity (P, "dagger;", 1, Entity, Last);
      Util.Tests.Assert_Equals (T, 8, Last, "Invalid last index");
      Assert_Equals (T, Wiki.Strings.WChar'Val (8224), Entity, "Invalid parsed entity");

      Parse_Entity (P, "Dagger;", 1, Entity, Last);
      Util.Tests.Assert_Equals (T, 8, Last, "Invalid last index");
      Assert_Equals (T, Wiki.Strings.WChar'Val (8225), Entity, "Invalid parsed entity");

      Parse_Entity (P, "#1234;", 1, Entity, Last);
      Util.Tests.Assert_Equals (T, 7, Last, "Invalid last index");
      Assert_Equals (T, Wiki.Strings.WChar'Val (1234), Entity, "Invalid parsed entity");

      Parse_Entity (P, "#x1234;", 1, Entity, Last);
      Util.Tests.Assert_Equals (T, 8, Last, "Invalid last index");
      Assert_Equals (T, Wiki.Strings.WChar'Val (16#1234#), Entity, "Invalid parsed entity");

      Parse_Entity (P, "#xabCD;", 1, Entity, Last);
      Util.Tests.Assert_Equals (T, 8, Last, "Invalid last index");
      Assert_Equals (T, Wiki.Strings.WChar'Val (16#abcd#), Entity, "Invalid parsed entity");

      Parse_Entity (P, "dagobert;", 1, Entity, Last);
      Util.Tests.Assert_Equals (T, 10, Last, "Invalid last index");
      Assert_Equals (T, NUL, Entity, "Invalid parsed entity");

      Parse_Entity (P, "#x000000;", 1, Entity, Last);
      Util.Tests.Assert_Equals (T, 10, Last, "Invalid last index");
      Assert_Equals (T, Wiki.Strings.WChar'Val (16#0FFFD#), Entity, "Invalid parsed entity");

      Parse_Entity (P, "#000000;", 1, Entity, Last);
      Util.Tests.Assert_Equals (T, 9, Last, "Invalid last index");
      Assert_Equals (T, Wiki.Strings.WChar'Val (16#0FFFD#), Entity, "Invalid parsed entity");

      Parse_Entity (P, "#00000b;", 1, Entity, Last);
      Util.Tests.Assert_Equals (T, 9, Last, "Invalid last index");
      Assert_Equals (T, NUL, Entity, "Invalid parsed entity");

      Parse_Entity (P, "#x0000g0;", 1, Entity, Last);
      Util.Tests.Assert_Equals (T, 10, Last, "Invalid last index");
      Assert_Equals (T, NUL, Entity, "Invalid parsed entity");

      Parse_Entity (P, "bla bla bla bla bla ;", 1, Entity, Last);
      Util.Tests.Assert_Equals (T, 11, Last, "Invalid last index");
      Assert_Equals (T, NUL, Entity, "Invalid parsed entity");

   end Test_Parse_Entity;

end Wiki.Html_Parser.Tests;

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

with Util.Test_Caller;
with Util.Assertions;
with GNAT.Source_Info;

package body Wiki.Html_Parser.Tests is

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

   procedure Assert_Equals is
      new Util.Assertions.Assert_Equals_T (State_Type);

   procedure Assert_Equals is
      new Util.Assertions.Assert_Equals_T (Html_Parser_State);

   procedure Assert_Equals is
      new Util.Assertions.Assert_Equals_T (Entity_State_Type);

   procedure Assert_Equals is
      new Util.Assertions.Assert_Equals_T (Wiki.Strings.WChar);

   procedure Check_Parser (T           : in out Test;
                           Expect      : in Wiki.Strings.WString;
                           Expect_Kind : in State_Type;
                           Content     : in Wiki.Strings.WString;
                           Source      : in String := GNAT.Source_Info.File;
                           Line        : in Natural := GNAT.Source_Info.Line);

   procedure Check_Error (T           : in out Test;
                          Last_Pos    : in Natural;
                          Content     : in Wiki.Strings.WString;
                          Source      : in String := GNAT.Source_Info.File;
                          Line        : in Natural := GNAT.Source_Info.Line);

   procedure Check_Attribute (T     : in out Test;
                              Name  : in String;
                              Value : in Wiki.Strings.WString);

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Wiki.Html_Parsers.Parse_Element",
                       Test_Parse_Element'Access);
      Caller.Add_Test (Suite, "Test Wiki.Html_Parsers.Parse_Element (Attributes)",
                       Test_Parse_Element_Attributes'Access);
      Caller.Add_Test (Suite, "Test Wiki.Html_Parsers.Parse_Element (Errors)",
                       Test_Parse_Error'Access);
      Caller.Add_Test (Suite, "Test Wiki.Html_Parsers.Parse_Element (Doctype)",
                       Test_Parse_Doctype'Access);
      Caller.Add_Test (Suite, "Test Wiki.Html_Parsers.Parse_Entity",
                       Test_Parse_Entity'Access);
   end Add_Tests;

   procedure Check_Parser (T           : in out Test;
                           Expect      : in Wiki.Strings.WString;
                           Expect_Kind : in State_Type;
                           Content     : in Wiki.Strings.WString;
                           Source      : in String := GNAT.Source_Info.File;
                           Line        : in Natural := GNAT.Source_Info.Line) is
      procedure Process (Kind       : in State_Type;
                         Name       : in Wiki.Strings.WString;
                         Attributes : in out Wiki.Attributes.Attribute_List);

      P    : Parser_Type;
      Last : Natural;

      procedure Process (Kind       : in State_Type;
                         Name       : in Wiki.Strings.WString;
                         Attributes : in out Wiki.Attributes.Attribute_List) is
      begin
         Assert_Equals (T, Expect_Kind, Kind, "Invalid state type", Source, Line);
         if Kind /= HTML_ERROR then
            T.Assert (Name = Expect, "Invalid name", Source, Line);
         end if;
         T.Attributes := Attributes;
      end Process;

   begin
      Parse_Element (P, Content, Content'First, Process'Access, Last);
      Util.Tests.Assert_Equals (T, Content'Last + 1, Last, "Invalid last index", Source, Line);
      Assert_Equals (T, P.State, State_None, "Invalid parser state", Source, Line);

      Parse_Element (P, Content, Content'First, Process'Access, Last);
      Util.Tests.Assert_Equals (T, Content'Last + 1, Last, "Invalid last index", Source, Line);
      Assert_Equals (T, P.State, State_None, "Invalid parser state", Source, Line);

      for I in 1 .. Content'Length loop
         declare
            First   : Natural := Content'First;
            End_Pos : Natural := Content'First;
            Retry   : Natural := 0;
         begin
            loop
               Parse_Element (P, Content (Content'First .. End_Pos), First, Process'Access, Last);
               exit when Last = Content'Last + 1;
               Retry := Retry + 1;
               First := Last;
               End_Pos := End_Pos + I;
               if End_Pos > Content'Last then
                  End_Pos := Content'Last;
               end if;
               T.Assert (Retry <= Content'Length, "Too many retries", Source, Line);
            end loop;
            Assert_Equals (T, P.State, State_None, "Invalid parser state", Source, Line);
         end;
      end loop;
   end Check_Parser;

   procedure Check_Error (T           : in out Test;
                          Last_Pos    : in Natural;
                          Content     : in Wiki.Strings.WString;
                          Source      : in String := GNAT.Source_Info.File;
                          Line        : in Natural := GNAT.Source_Info.Line) is
      procedure Process (Kind       : in State_Type;
                         Name       : in Wiki.Strings.WString;
                         Attributes : in out Wiki.Attributes.Attribute_List);

      P    : Parser_Type;
      Last : Natural;

      procedure Process (Kind       : in State_Type;
                         Name       : in Wiki.Strings.WString;
                         Attributes : in out Wiki.Attributes.Attribute_List) is
         pragma Unreferenced (Name, Attributes);
      begin
         Assert_Equals (T, HTML_ERROR, Kind, "Invalid state type", Source, Line);
      end Process;

   begin
      Parse_Element (P, Content, Content'First, Process'Access, Last);
      Util.Tests.Assert_Equals (T, Last_Pos, Last, "Invalid last index", Source, Line);
   end Check_Error;

   --  ------------------------------
   --  Test Parse_Element operation.
   --  ------------------------------
   procedure Test_Parse_Element (T : in out Test) is
   begin
      Check_Parser (T, "a", HTML_START, "a>");
      Check_Parser (T, "a", HTML_START, "   a   >");
      Check_Parser (T, "input", HTML_START, "input>");
      Check_Parser (T, "a", HTML_END, "/a>");
      Check_Parser (T, "input", HTML_START_END, "  input  />");
      Check_Parser (T, "br", HTML_START_END, "br/>");
      Check_Parser (T, "img", HTML_END, "/img   >");
   end Test_Parse_Element;

   --  ------------------------------
   --  Test parsing HTML with errors.
   --  ------------------------------
   procedure Test_Parse_Error (T : in out Test) is
   begin
      Check_Error (T, 2, "a'");
      Check_Error (T, 9, "input   """);
      Check_Error (T, 7, "input =");
      Check_Error (T, 17, "input abcd efgh =");
   end Test_Parse_Error;

   procedure Check_Attribute (T     : in out Test;
                              Name  : in String;
                              Value : in Wiki.Strings.WString) is
      V : constant Wiki.Strings.WString := Wiki.Attributes.Get_Attribute (T.Attributes, Name);
   begin
      T.Assert (Value = V, "Invalid attribute " & Name);
   end Check_Attribute;

   --  ------------------------------
   --  Test Parse_Element with attributes
   --  ------------------------------
   procedure Test_Parse_Element_Attributes (T : in out Test) is
   begin
      Check_Parser (T, "a", HTML_START, "a href='toto' title=' bla bla '>");

      Util.Tests.Assert_Equals (T, 2, Wiki.Attributes.Length (T.Attributes),
                                "invalid number of attributes");
      Check_Attribute (T, "href", "toto");
      Check_Attribute (T, "title", " bla bla ");

      Check_Parser (T, "img", HTML_START_END, "img src=""plop"" width=4 height=5/>");

      Util.Tests.Assert_Equals (T, 3, Wiki.Attributes.Length (T.Attributes),
                                "invalid number of attributes");
      Check_Attribute (T, "src", "plop");
      Check_Attribute (T, "width", "4");
      Check_Attribute (T, "height", "5");

      Check_Parser (T, "select", HTML_START, "select id=a name=test >");

      Util.Tests.Assert_Equals (T, 2, Wiki.Attributes.Length (T.Attributes),
                                "invalid number of attributes");
      Check_Attribute (T, "id", "a");
      Check_Attribute (T, "name", "test");

   end Test_Parse_Element_Attributes;

   --  ------------------------------
   --  Test Parse_Doctype
   --  ------------------------------
   procedure Test_Parse_Doctype (T : in out Test) is
      procedure Process (Kind       : in State_Type;
                         Name       : in Wiki.Strings.WString;
                         Attributes : in out Wiki.Attributes.Attribute_List);

      P    : Parser_Type;
      Last : Natural;

      procedure Process (Kind       : in State_Type;
                         Name       : in Wiki.Strings.WString;
                         Attributes : in out Wiki.Attributes.Attribute_List) is
         pragma Unreferenced (Kind, Name, Attributes);
      begin
         T.Fail ("Should not be called");
      end Process;
   begin
      Parse_Element (P, "!doctype html>", 1, Process'Access, Last);
      Util.Tests.Assert_Equals (T, 15, Last, "Invalid last index");

      Parse_Element (P, "!doctype html>  ", 1, Process'Access, Last);
      Util.Tests.Assert_Equals (T, 15, Last, "Invalid last index");

      Parse_Element (P, "!-- blq blq < > -->", 1, Process'Access, Last);
      Util.Tests.Assert_Equals (T, 20, Last, "Invalid last index");

      Parse_Element (P, "!-- blq blq < > --", 1, Process'Access, Last);
      Util.Tests.Assert_Equals (T, 19, Last, "Invalid last index");
      Assert_Equals (T, P.State, State_Comment, "Invalid parser state");

      Parse_Element (P, "bla -- blq blq < > -->", 1, Process'Access, Last);
      Util.Tests.Assert_Equals (T, 23, Last, "Invalid last index");
      Assert_Equals (T, P.State, State_None, "Invalid parser state");

      Parse_Element (P, "!doctype html  ", 1, Process'Access, Last);
      Util.Tests.Assert_Equals (T, 16, Last, "Invalid last index");
      Assert_Equals (T, P.State, State_Doctype, "Invalid parser state");

      Parse_Element (P, "bla -- blq blq < > --x", 1, Process'Access, Last);
      Util.Tests.Assert_Equals (T, 19, Last, "Invalid last index");
      Assert_Equals (T, P.State, State_None, "Invalid parser state");

   end Test_Parse_Doctype;

   --  ------------------------------
   --  Test Parse_Entity.
   --  ------------------------------
   procedure Test_Parse_Entity (T : in out Test) is
      P      : Parser_Type;
      Last   : Natural;
      Entity : Wiki.Strings.WChar;
      Status : Entity_State_Type := ENTITY_NONE;
   begin
      Parse_Entity (P, "amp; ", 1, Status, Entity, Last);
      Util.Tests.Assert_Equals (T, 5, Last, "Invalid last index");
      Assert_Equals (T, '&', Entity, "Invalid parsed entity");

      Parse_Entity (P, "dagger;", 1, Status, Entity, Last);
      Util.Tests.Assert_Equals (T, 8, Last, "Invalid last index");
      Assert_Equals (T, Wiki.Strings.WChar'Val (8224), Entity, "Invalid parsed entity");

      Parse_Entity (P, "Dagger;", 1, Status, Entity, Last);
      Util.Tests.Assert_Equals (T, 8, Last, "Invalid last index");
      Assert_Equals (T, Wiki.Strings.WChar'Val (8225), Entity, "Invalid parsed entity");

      Parse_Entity (P, "#1234;", 1, Status, Entity, Last);
      Util.Tests.Assert_Equals (T, 7, Last, "Invalid last index");
      Assert_Equals (T, Wiki.Strings.WChar'Val (1234), Entity, "Invalid parsed entity");

      Parse_Entity (P, "#x1234;", 1, Status, Entity, Last);
      Util.Tests.Assert_Equals (T, 8, Last, "Invalid last index");
      Assert_Equals (T, Wiki.Strings.WChar'Val (16#1234#), Entity, "Invalid parsed entity");

      Parse_Entity (P, "#xabCD;", 1, Status, Entity, Last);
      Util.Tests.Assert_Equals (T, 8, Last, "Invalid last index");
      Assert_Equals (T, Wiki.Strings.WChar'Val (16#abcd#), Entity, "Invalid parsed entity");
      Assert_Equals (T, ENTITY_VALID, Status, "Invalid status");

      Parse_Entity (P, "dagobert;", 1, Status, Entity, Last);
      Util.Tests.Assert_Equals (T, 1, Last, "Invalid last index");
      Assert_Equals (T, NUL, Entity, "Invalid parsed entity");
      Assert_Equals (T, ENTITY_NONE, Status, "Invalid status");

      Parse_Entity (P, "#x000000;", 1, Status, Entity, Last);
      Util.Tests.Assert_Equals (T, 10, Last, "Invalid last index");
      Assert_Equals (T, Wiki.Strings.WChar'Val (16#0FFFD#), Entity, "Invalid parsed entity");

      Parse_Entity (P, "#000000;", 1, Status, Entity, Last);
      Util.Tests.Assert_Equals (T, 9, Last, "Invalid last index");
      Assert_Equals (T, Wiki.Strings.WChar'Val (16#0FFFD#), Entity, "Invalid parsed entity");

      Parse_Entity (P, "#00000b;", 1, Status, Entity, Last);
      Assert_Equals (T, ENTITY_NONE, Status, "Invalid status");
      Util.Tests.Assert_Equals (T, 1, Last, "Invalid last index");
      Assert_Equals (T, NUL, Entity, "Invalid parsed entity");

      Parse_Entity (P, "#x0000g0;", 1, Status, Entity, Last);
      Assert_Equals (T, ENTITY_NONE, Status, "Invalid status");
      Util.Tests.Assert_Equals (T, 1, Last, "Invalid last index");
      Assert_Equals (T, NUL, Entity, "Invalid parsed entity");

      Parse_Entity (P, "bla bla bla bla bla ;", 1, Status, Entity, Last);
      Assert_Equals (T, ENTITY_NONE, Status, "Invalid status");
      Util.Tests.Assert_Equals (T, 1, Last, "Invalid last index");
      Assert_Equals (T, NUL, Entity, "Invalid parsed entity");

   end Test_Parse_Entity;

end Wiki.Html_Parser.Tests;

Update the unit test to check the status result


------------------------------------------------------------------------------
-- Copyright (c) 2016, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Ada.Streams;

generic
   type Dictionary_Code is (<>);

   with procedure Read_Code
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Code : out Dictionary_Code;
      Verbatim_Length : out Natural;
      Last_Code : in Dictionary_Code;
      Variable_Length_Verbatim : in Boolean);

   with procedure Read_Verbatim
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Output : out String);

   with procedure Skip_Verbatim
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Verbatim_Length : in Positive);

   with function Verbatim_Size
     (Input_Length : in Positive;
      Last_Code : in Dictionary_Code;
      Variable_Length_Verbatim : in Boolean)
     return Ada.Streams.Stream_Element_Count;

   with procedure Write_Code
     (Output : in out Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Code : in Dictionary_Code);

   with procedure Write_Verbatim
     (Output : in out Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Input : in String;
      Last_Code : in Dictionary_Code;
      Variable_Length_Verbatim : in Boolean);

package Natools.Smaz_Generic is
   pragma Pure;

   type Offset_Array is array (Dictionary_Code range <>) of Positive;

   type Dictionary
     (Last_Code : Dictionary_Code;
      Values_Last : Natural)
   is record
      Variable_Length_Verbatim : Boolean;
      Max_Word_Length : Positive;
      Offsets : Offset_Array
        (Dictionary_Code'Succ (Dictionary_Code'First) .. Last_Code);
      Values : String (1 .. Values_Last);
      Hash : not null access function (Value : String) return Natural;
   end record
     with Dynamic_Predicate =>
           (for all Code in Dictionary.Offsets'Range
            => Dictionary.Offsets (Code) in Dictionary.Values'Range)
        and then (for all Code in Dictionary_Code'First .. Dictionary.Last_Code
            => Code_Last (Dictionary.Offsets, Code, Dictionary.Values'Last) + 1
               - Code_First (Dictionary.Offsets, Code, Dictionary.Values'First)
               in 1 .. Dictionary.Max_Word_Length);

   function Code_First
     (Offsets : in Offset_Array;
      Code : in Dictionary_Code;
      Fallback : in Positive)
     return Positive
     is (if Code in Offsets'Range then Offsets (Code) else Fallback);
      --  Return the first index of the value for Code in Dictionary.Values

   function Code_Last
     (Offsets : in Offset_Array;
      Code : in Dictionary_Code;
      Fallback : in Natural)
     return Natural
     is (if Dictionary_Code'Succ (Code) in Offsets'Range
         then Offsets (Dictionary_Code'Succ (Code)) - 1
         else Fallback);
      --  Return the value index of the value for Code in Dictionary.Values

   function Is_Valid_Code
     (Dict : in Dictionary;
      Code : in Dictionary_Code)
     return Boolean
     is (Code in Dictionary_Code'First .. Dict.Last_Code);
      --  Return whether Code exists in Dict

   function Dict_Entry
     (Dict : in Dictionary;
      Code : in Dictionary_Code)
     return String
     is (Dict.Values (Code_First (Dict.Offsets, Code, Dict.Values'First)
                    .. Code_Last (Dict.Offsets, Code, Dict.Values'Last)))
     with Pre => Is_Valid_Code (Dict, Code);
      --  Return the string for at the given Index in Dict

   function Dict_Entry_Length
     (Dict : in Dictionary;
      Code : in Dictionary_Code)
     return Positive
     is (1 + Code_Last (Dict.Offsets, Code, Dict.Values'Last)
           - Code_First (Dict.Offsets, Code, Dict.Values'First))
     with Pre => Is_Valid_Code (Dict, Code);
      --  Return the length of the string for at the given Index in Dict

   function Compressed_Upper_Bound
     (Dict : in Dictionary;
      Input : in String)
     return Ada.Streams.Stream_Element_Count;
      --  Return the maximum number of bytes needed to encode Input

   procedure Compress
     (Dict : in Dictionary;
      Input : in String;
      Output_Buffer : out Ada.Streams.Stream_Element_Array;
      Output_Last : out Ada.Streams.Stream_Element_Offset);
      --  Encode Input into Output_Buffer

   function Compress (Dict : in Dictionary; Input : in String)
     return Ada.Streams.Stream_Element_Array;
      --  Return an encoded buffer for Input

   function Decompressed_Length
     (Dict : in Dictionary;
      Input : in Ada.Streams.Stream_Element_Array)
     return Natural;
      --  Return the exact length when Input is decoded

   procedure Decompress
     (Dict : in Dictionary;
      Input : in Ada.Streams.Stream_Element_Array;
      Output_Buffer : out String;
      Output_Last : out Natural);
      --  Decode Input into Output_Buffer

   function Decompress
     (Dict : in Dictionary; Input : in Ada.Streams.Stream_Element_Array)
     return String;
      --  Return a decoded buffer for Input

end Natools.Smaz_Generic;

------------------------------------------------------------------------------
-- Copyright (c) 2016, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Ada.Streams;

generic
   type Dictionary_Code is (<>);

   with procedure Read_Code
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Code : out Dictionary_Code;
      Verbatim_Length : out Natural;
      Last_Code : in Dictionary_Code;
      Variable_Length_Verbatim : in Boolean);

   with procedure Read_Verbatim
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Output : out String);

   with procedure Skip_Verbatim
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Verbatim_Length : in Positive);

   with function Verbatim_Size
     (Input_Length : in Positive;
      Last_Code : in Dictionary_Code;
      Variable_Length_Verbatim : in Boolean)
     return Ada.Streams.Stream_Element_Count;

   with procedure Write_Code
     (Output : in out Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Code : in Dictionary_Code);

   with procedure Write_Verbatim
     (Output : in out Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Input : in String;
      Last_Code : in Dictionary_Code;
      Variable_Length_Verbatim : in Boolean);

package Natools.Smaz_Generic is
   pragma Pure;

   type Offset_Array is array (Dictionary_Code range <>) of Positive;

   type Dictionary
     (Last_Code : Dictionary_Code;
      Values_Last : Natural)
   is record
      Variable_Length_Verbatim : Boolean;
      Max_Word_Length : Positive;
      Offsets : Offset_Array
        (Dictionary_Code'Succ (Dictionary_Code'First) .. Last_Code);
      Values : String (1 .. Values_Last);
      Hash : not null access function (Value : String) return Natural;
   end record;

   function Code_First
     (Offsets : in Offset_Array;
      Code : in Dictionary_Code;
      Fallback : in Positive)
     return Positive
     is (if Code in Offsets'Range then Offsets (Code) else Fallback);
      --  Return the first index of the value for Code in Dictionary.Values

   function Code_Last
     (Offsets : in Offset_Array;
      Code : in Dictionary_Code;
      Fallback : in Natural)
     return Natural
     is (if Dictionary_Code'Succ (Code) in Offsets'Range
         then Offsets (Dictionary_Code'Succ (Code)) - 1
         else Fallback);
      --  Return the value index of the value for Code in Dictionary.Values

   function Is_Valid_Code
     (Dict : in Dictionary;
      Code : in Dictionary_Code)
     return Boolean
     is (Code in Dictionary_Code'First .. Dict.Last_Code);
      --  Return whether Code exists in Dict

   function Dict_Entry
     (Dict : in Dictionary;
      Code : in Dictionary_Code)
     return String
     is (Dict.Values (Code_First (Dict.Offsets, Code, Dict.Values'First)
                    .. Code_Last (Dict.Offsets, Code, Dict.Values'Last)))
     with Pre => Is_Valid_Code (Dict, Code);
      --  Return the string for at the given Index in Dict

   function Dict_Entry_Length
     (Dict : in Dictionary;
      Code : in Dictionary_Code)
     return Positive
     is (1 + Code_Last (Dict.Offsets, Code, Dict.Values'Last)
           - Code_First (Dict.Offsets, Code, Dict.Values'First))
     with Pre => Is_Valid_Code (Dict, Code);
      --  Return the length of the string for at the given Index in Dict

   function Compressed_Upper_Bound
     (Dict : in Dictionary;
      Input : in String)
     return Ada.Streams.Stream_Element_Count;
      --  Return the maximum number of bytes needed to encode Input

   procedure Compress
     (Dict : in Dictionary;
      Input : in String;
      Output_Buffer : out Ada.Streams.Stream_Element_Array;
      Output_Last : out Ada.Streams.Stream_Element_Offset);
      --  Encode Input into Output_Buffer

   function Compress (Dict : in Dictionary; Input : in String)
     return Ada.Streams.Stream_Element_Array;
      --  Return an encoded buffer for Input

   function Decompressed_Length
     (Dict : in Dictionary;
      Input : in Ada.Streams.Stream_Element_Array)
     return Natural;
      --  Return the exact length when Input is decoded

   procedure Decompress
     (Dict : in Dictionary;
      Input : in Ada.Streams.Stream_Element_Array;
      Output_Buffer : out String;
      Output_Last : out Natural);
      --  Decode Input into Output_Buffer

   function Decompress
     (Dict : in Dictionary; Input : in Ada.Streams.Stream_Element_Array)
     return String;
      --  Return a decoded buffer for Input

end Natools.Smaz_Generic;

remove the too-costly dynamic predicate

smaz_generic: remove the too-costly dynamic predicate


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

package body Orka.OS is

   procedure Set_Task_Name (Name : in String) is
   begin
      null;
   end Set_Task_Name;

   function Monotonic_Clock return Duration is
   begin
      raise Program_Error with "BUG: Monotonic_Clock not implemented yet on Windows";
      return 0.0;
   end Monotonic_Clock;

   ----------------------------------------------------------------------------

   subtype Size_Type is Interfaces.C.unsigned_long;

   procedure C_Fwrite
     (Value : String;
      Size  : Size_Type;
      Count : Size_Type;
      File  : System.Address)
   with Import, Convention => C, External_Name => "fwrite";

   File_Standard_Output : constant System.Address
     with Import, Convention => C, External_Name => "stdout";

   File_Standard_Error : constant System.Address
     with Import, Convention => C, External_Name => "stderr";

   procedure Put_Line (Value : String; Kind : File_Kind := Standard_Output) is
      package L1 renames Ada.Characters.Latin_1;

      C_Value : constant String := Value & L1.LF;
   begin
      C_Fwrite (C_Value, 1, C_Value'Length,
        (case Kind is
           when Standard_Output => File_Standard_Output,
           when Standard_Error  => File_Standard_Error));
   end Put_Line;

end Orka.OS;

--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2017 onox <denkpadje@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 Ada.Characters.Latin_1;

package body Orka.OS is

   procedure Set_Task_Name (Name : in String) is
   begin
      null;
   end Set_Task_Name;

   function Monotonic_Clock return Duration is
   begin
      raise Program_Error with "BUG: Monotonic_Clock not implemented yet on Windows";
      return 0.0;
   end Monotonic_Clock;

   ----------------------------------------------------------------------------

   subtype Size_Type is Interfaces.C.unsigned_long;

   procedure C_Fwrite
     (Value : String;
      Size  : Size_Type;
      Count : Size_Type;
      File  : System.Address)
   with Import, Convention => C, External_Name => "fwrite";

   File_Standard_Output : constant System.Address
     with Import, Convention => C, External_Name => "stdout";

   File_Standard_Error : constant System.Address
     with Import, Convention => C, External_Name => "stderr";

   procedure Put_Line (Value : String; Kind : File_Kind := Standard_Output) is
      package L1 renames Ada.Characters.Latin_1;

      C_Value : constant String := Value & L1.LF;
   begin
      C_Fwrite (C_Value, 1, C_Value'Length,
        (case Kind is
           when Standard_Output => File_Standard_Output,
           when Standard_Error  => File_Standard_Error));
   end Put_Line;

end Orka.OS;

Fix missing importing used packages in package Orka.OS on Windows

Signed-off-by: onox <34c1d3d2d1347bea60a26f46574de21a7a79b6d5@gmail.com>


-----------------------------------------------------------------------
--  applications-main-configs -- Configuration support for ASF Applications
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 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 Util.Log.Loggers;
with EL.Functions.Namespaces;

with ASF.Navigations;
with ASF.Navigations.Mappers;
with Servlet.Core.Mappers;
with ASF.Servlets.Faces.Mappers;
with ASF.Beans.Mappers;
with ASF.Views.Nodes.Core;

package body ASF.Applications.Main.Configs is

   use Util.Log;

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

   function Get_Locale (Value : in Util.Beans.Objects.Object) return Util.Locales.Locale;

   function Get_Locale (Value : in Util.Beans.Objects.Object) return Util.Locales.Locale is
      Name   : constant String := Util.Beans.Objects.To_String (Value);
      Locale : constant Util.Locales.Locale := Util.Locales.Get_Locale (Name);
   begin
      return Locale;
   end Get_Locale;

   --  ------------------------------
   --  Save in the application config object the value associated with the given field.
   --  When the TAG_MESSAGE_BUNDLE field is reached, insert the new bundle definition
   --  in the application.
   --  ------------------------------
   procedure Set_Member (N     : in out Application_Config;
                         Field : in Application_Fields;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when TAG_MESSAGE_VAR =>
            N.Name := Value;

         when TAG_MESSAGE_BUNDLE =>
            declare
               Bundle : constant String := Util.Beans.Objects.To_String (Value);
            begin
               if Util.Beans.Objects.Is_Null (N.Name) then
                  N.App.Register (Name   => Bundle & "Msg",
                                  Bundle => Bundle);
               else
                  N.App.Register (Name   => Util.Beans.Objects.To_String (N.Name),
                                  Bundle => Bundle);
               end if;
               N.Name := Util.Beans.Objects.Null_Object;
            end;

         when TAG_DEFAULT_LOCALE =>
            N.App.Set_Default_Locale (Get_Locale (Value));

         when TAG_SUPPORTED_LOCALE =>
            N.App.Add_Supported_Locale (Get_Locale (Value));

      end case;
   end Set_Member;

   AMapper : aliased Application_Mapper.Mapper;

   --  ------------------------------
   --  Setup the XML parser to read the managed bean definitions.
   --  By instantiating this package, the Reader gets populated with the XML mappings
   --  to read the servlet, managed beans and navigation rules.
   --  ------------------------------
   package body Reader_Config is
      procedure Set_Property_Context (Params : in Util.Properties.Manager'Class);

      --  Get the navigation handler for the Navigation_Config instantiation
      --  GNAT crashes if the call is made in the instantiation part.
      Nav     : constant ASF.Navigations.Navigation_Handler_Access := App.Get_Navigation_Handler;

      package Bean_Config is
        new ASF.Beans.Mappers.Reader_Config (Mapper, App.Factory'Access,
                                             Context.all'Access);
      package Navigation_Config is
        new ASF.Navigations.Mappers.Reader_Config (Mapper, Nav, Context.all'Access);

      package Servlet_Config is
        new Servlet.Core.Mappers.Reader_Config (Mapper, App.all'Access,
                                                Context.all'Access);
      package Faces_Config is
        new ASF.Servlets.Faces.Mappers.Reader_Config (Mapper, App.all'Access,
                                                      Context.all'Access);
      pragma Warnings (Off, Bean_Config);
      pragma Warnings (Off, Navigation_Config);
      pragma Warnings (Off, Faces_Config);

      Config    : aliased Application_Config;
      NS_Mapper : aliased EL.Functions.Namespaces.NS_Function_Mapper;

      procedure Set_Property_Context (Params : in Util.Properties.Manager'Class) is
      begin
         Prop_Context.Set_Properties (Params);
      end Set_Property_Context;

   begin
      --  Install the property context that gives access
      --  to the application configuration properties
      App.Get_Init_Parameters (Set_Property_Context'Access);
      Context.Set_Resolver (Prop_Context'Unchecked_Access);

      --  Setup the function mapper to resolve uses of functions within EL expressions.
      NS_Mapper.Set_Namespace (Prefix => "fn",
                               URI    => ASF.Views.Nodes.Core.FN_URI);
      NS_Mapper.Set_Function_Mapper (App.Functions'Unchecked_Access);
      Context.Set_Function_Mapper (NS_Mapper'Unchecked_Access);

      Mapper.Add_Mapping ("faces-config", AMapper'Access);
      Mapper.Add_Mapping ("module", AMapper'Access);
      Mapper.Add_Mapping ("web-app", AMapper'Access);
      Config.App := App;
      Servlet_Config.Config.Override_Context := Override_Context;
      Application_Mapper.Set_Context (Mapper, Config'Unchecked_Access);
   end Reader_Config;

   --  ------------------------------
   --  Read the configuration file associated with the application.  This includes:
   --

   --
The servlet and filter mappings

   --
The managed bean definitions

   --
The navigation rules

   --

   --  ------------------------------
   procedure Read_Configuration (App  : in out Application'Class;
                                 File : in String) is

      Reader  : Util.Serialize.IO.XML.Parser;
      Mapper  : Util.Serialize.Mappers.Processing;
      Context : aliased EL.Contexts.Default.Default_Context;

      --  Setup the Reader to parse and build the configuration for managed beans,
      --  navigation rules, servlet rules.  Each package instantiation creates a local variable
      --  used while parsing the XML file.
      package Config is
        new Reader_Config (Mapper, App'Unchecked_Access, Context'Unchecked_Access);

      pragma Warnings (Off, Config);
   begin
      Log.Info ("Reading module configuration file {0}", File);

      --        Util.Serialize.IO.Dump (Reader, AWA.Modules.Log);

      --  Read the configuration file and record managed beans, navigation rules.
      Reader.Parse (File, Mapper);
   end Read_Configuration;

   --  ------------------------------
   --  Create the configuration parameter definition instance.
   --  ------------------------------
   package body Parameter is
      PARAM_NAME  : aliased constant String := Name;
      PARAM_VALUE : aliased constant String := Default;
      Param       : constant Config_Param := ASF.Applications.P '(Name => PARAM_NAME'Access,
                                                                  Default => PARAM_VALUE'Access);

      --  ------------------------------
      --  Returns the configuration parameter.
      --  ------------------------------
      function P return Config_Param is
      begin
         return Param;
      end P;

   end Parameter;

begin
   AMapper.Add_Mapping ("application/message-bundle/@var", TAG_MESSAGE_VAR);
   AMapper.Add_Mapping ("application/message-bundle", TAG_MESSAGE_BUNDLE);
   AMapper.Add_Mapping ("application/locale-config/default-locale", TAG_DEFAULT_LOCALE);
   AMapper.Add_Mapping ("application/locale-config/supported-locale", TAG_SUPPORTED_LOCALE);
end ASF.Applications.Main.Configs;

-----------------------------------------------------------------------
--  applications-main-configs -- Configuration support for ASF Applications
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 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 Util.Log.Loggers;
with Util.Serialize.IO.XML;

with EL.Functions.Namespaces;

with ASF.Navigations;
with ASF.Navigations.Mappers;
with Servlet.Core.Mappers;
with ASF.Servlets.Faces.Mappers;
with ASF.Beans.Mappers;
with ASF.Views.Nodes.Core;

package body ASF.Applications.Main.Configs is

   use Util.Log;

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

   function Get_Locale (Value : in Util.Beans.Objects.Object) return Util.Locales.Locale;

   function Get_Locale (Value : in Util.Beans.Objects.Object) return Util.Locales.Locale is
      Name   : constant String := Util.Beans.Objects.To_String (Value);
      Locale : constant Util.Locales.Locale := Util.Locales.Get_Locale (Name);
   begin
      return Locale;
   end Get_Locale;

   --  ------------------------------
   --  Save in the application config object the value associated with the given field.
   --  When the TAG_MESSAGE_BUNDLE field is reached, insert the new bundle definition
   --  in the application.
   --  ------------------------------
   procedure Set_Member (N     : in out Application_Config;
                         Field : in Application_Fields;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when TAG_MESSAGE_VAR =>
            N.Name := Value;

         when TAG_MESSAGE_BUNDLE =>
            declare
               Bundle : constant String := Util.Beans.Objects.To_String (Value);
            begin
               if Util.Beans.Objects.Is_Null (N.Name) then
                  N.App.Register (Name   => Bundle & "Msg",
                                  Bundle => Bundle);
               else
                  N.App.Register (Name   => Util.Beans.Objects.To_String (N.Name),
                                  Bundle => Bundle);
               end if;
               N.Name := Util.Beans.Objects.Null_Object;
            end;

         when TAG_DEFAULT_LOCALE =>
            N.App.Set_Default_Locale (Get_Locale (Value));

         when TAG_SUPPORTED_LOCALE =>
            N.App.Add_Supported_Locale (Get_Locale (Value));

      end case;
   end Set_Member;

   AMapper : aliased Application_Mapper.Mapper;

   --  ------------------------------
   --  Setup the XML parser to read the managed bean definitions.
   --  By instantiating this package, the Reader gets populated with the XML mappings
   --  to read the servlet, managed beans and navigation rules.
   --  ------------------------------
   package body Reader_Config is
      procedure Set_Property_Context (Params : in Util.Properties.Manager'Class);

      --  Get the navigation handler for the Navigation_Config instantiation
      --  GNAT crashes if the call is made in the instantiation part.
      Nav     : constant ASF.Navigations.Navigation_Handler_Access := App.Get_Navigation_Handler;

      package Bean_Config is
        new ASF.Beans.Mappers.Reader_Config (Mapper, App.Factory'Access,
                                             Context.all'Access);
      package Navigation_Config is
        new ASF.Navigations.Mappers.Reader_Config (Mapper, Nav, Context.all'Access);

      package Servlet_Config is
        new Servlet.Core.Mappers.Reader_Config (Mapper, App.all'Access,
                                                Context.all'Access);
      package Faces_Config is
        new ASF.Servlets.Faces.Mappers.Reader_Config (Mapper, App.all'Access,
                                                      Context.all'Access);
      pragma Warnings (Off, Bean_Config);
      pragma Warnings (Off, Navigation_Config);
      pragma Warnings (Off, Faces_Config);

      Config    : aliased Application_Config;
      NS_Mapper : aliased EL.Functions.Namespaces.NS_Function_Mapper;

      procedure Set_Property_Context (Params : in Util.Properties.Manager'Class) is
      begin
         Prop_Context.Set_Properties (Params);
      end Set_Property_Context;

   begin
      --  Install the property context that gives access
      --  to the application configuration properties
      App.Get_Init_Parameters (Set_Property_Context'Access);
      Context.Set_Resolver (Prop_Context'Unchecked_Access);

      --  Setup the function mapper to resolve uses of functions within EL expressions.
      NS_Mapper.Set_Namespace (Prefix => "fn",
                               URI    => ASF.Views.Nodes.Core.FN_URI);
      NS_Mapper.Set_Function_Mapper (App.Functions'Unchecked_Access);
      Context.Set_Function_Mapper (NS_Mapper'Unchecked_Access);

      Mapper.Add_Mapping ("faces-config", AMapper'Access);
      Mapper.Add_Mapping ("module", AMapper'Access);
      Mapper.Add_Mapping ("web-app", AMapper'Access);
      Config.App := App;
      Servlet_Config.Config.Override_Context := Override_Context;
      Application_Mapper.Set_Context (Mapper, Config'Unchecked_Access);
   end Reader_Config;

   --  ------------------------------
   --  Read the configuration file associated with the application.  This includes:
   --

   --
The servlet and filter mappings

   --
The managed bean definitions

   --
The navigation rules

   --

   --  ------------------------------
   procedure Read_Configuration (App  : in out Application'Class;
                                 File : in String) is

      Reader  : Util.Serialize.IO.XML.Parser;
      Mapper  : Util.Serialize.Mappers.Processing;
      Context : aliased EL.Contexts.Default.Default_Context;

      --  Setup the Reader to parse and build the configuration for managed beans,
      --  navigation rules, servlet rules.  Each package instantiation creates a local variable
      --  used while parsing the XML file.
      package Config is
        new Reader_Config (Mapper, App'Unchecked_Access, Context'Unchecked_Access);

      pragma Warnings (Off, Config);
   begin
      Log.Info ("Reading module configuration file {0}", File);

      --        Util.Serialize.IO.Dump (Reader, AWA.Modules.Log);

      --  Read the configuration file and record managed beans, navigation rules.
      Reader.Parse (File, Mapper);
   end Read_Configuration;

   --  ------------------------------
   --  Create the configuration parameter definition instance.
   --  ------------------------------
   package body Parameter is
      PARAM_NAME  : aliased constant String := Name;
      PARAM_VALUE : aliased constant String := Default;
      Param       : constant Config_Param := ASF.Applications.P '(Name => PARAM_NAME'Access,
                                                                  Default => PARAM_VALUE'Access);

      --  ------------------------------
      --  Returns the configuration parameter.
      --  ------------------------------
      function P return Config_Param is
      begin
         return Param;
      end P;

   end Parameter;

begin
   AMapper.Add_Mapping ("application/message-bundle/@var", TAG_MESSAGE_VAR);
   AMapper.Add_Mapping ("application/message-bundle", TAG_MESSAGE_BUNDLE);
   AMapper.Add_Mapping ("application/locale-config/default-locale", TAG_DEFAULT_LOCALE);
   AMapper.Add_Mapping ("application/locale-config/supported-locale", TAG_SUPPORTED_LOCALE);
end ASF.Applications.Main.Configs;

Fix compilation warnings

Fix compilation warnings