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

with Util.Strings;
with Util.Events;
with Util.Beans.Objects;
with Util.Beans.Basic;
with Util.Beans.Objects.Maps;

with ADO;

with AWA.Index_Arrays;

--  == Introduction ==
--  The AWA.Events package defines an event framework for modules to post events
--  and have Ada bean methods be invoked when these events are dispatched.  Subscription to
--  events is done through configuration files.  This allows to configure the modules and
--  integrate them together easily at configuration time.
--
--  === Declaration ===
--  Modules define the events that they can generate by instantiating the Definition
--  package. This is a static definition of the event.  Each event is given a unique name.
--
--    package Event_New_User is new AWA.Events.Definition ("new-user");
--
--  === Posting an event ===
--  The module can post an event to inform other modules or the system that a particular
--  action occurred.  The module creates the event instance of type Module_Event and
--  populates that event with useful properties for event receivers.
--
--    Event : AWA.Events.Module_Event;
--
--    Event.Set_Event_Kind (Event_New_User.Kind);
--    Event.Set_Parameter ("email", "harry.potter@hogwarts.org");
--
--  The module will post the event by using the Send_Event operation.
--
--    Manager.Send_Event (Event);
--
--  === Receiving an event ===
--  Modules or applications interested by a particular event will configure the event manager
--  to dispatch the event to an Ada bean event action.  The Ada bean is an object that must
--  implement a procedure that matches the prototype:
--
--    type Action_Bean is new Util.Beans.Basic.Readonly_Bean ...;
--    procedure Action (Bean : in out Action_Bean; Event : in AWA.Events.Module_Event'Class);
--
--  The Ada bean method and object are registered as other Ada beans.
--
--  The configuration file indicates how to bind the Ada bean action and the event together.
--  The action is specified using an EL Method Expression (See Ada EL or JSR 245).
--
--    <on-event name="new_user">
--        <action>#{ada_bean.action}</action>
--    </on-event>
--
--  === Event queues and dispatchers ===
--  The *AWA.Events* framework posts events on queues and it uses a dispatcher to process them.
--  There are two kinds of dispatchers:
--
--    * Synchronous dispatcher process the event when it is posted.  The task which posts
--      the event invokes the Ada bean action.  In this dispatching mode, there is no event queue.
--      If the action method raises an exception, it will however be blocked.
--
--    * Asynchronous dispatcher are executed by dedicated tasks.  The event is put in an event
--      queue.  A dispatcher task processes the event and invokes the action method at a later
--      time.
--
--  When the event is queued, there are two types of event queues:
--
--    * A Fifo memory queue manages the event and dispatches them in FIFO order.
--      If the application is stopped, the events present in the Fifo queue are lost.
--
--    * A persistent event queue manages the event in a similar way as the FIFO queue but
--      saves them in the database.  If the application is stopped, events that have not yet
--      been processed will be dispatched when the application is started again.
--
--  == Data Model ==
--  @include Queues.hbm.xml
--
package AWA.Events is

   type Queue_Index is new Natural;
   type Event_Index is new Natural;

   package Event_Arrays is new AWA.Index_Arrays (Event_Index);

   generic
   package Definition renames Event_Arrays.Definition;

   --  Exception raised if an event name is not found.
   Not_Found : exception renames Event_Arrays.Not_Found;

   --  Identifies an invalid event.
   -- Invalid_Event : constant Event_Index := 0;

   --  Find the event runtime index given the event name.
   --  Raises Not_Found exception if the event name is not recognized.
   function Find_Event_Index (Name : in String) return Event_Index renames Event_Arrays.Find;

   --  ------------------------------
   --  Module event
   --  ------------------------------
   type Module_Event is new Util.Events.Event and Util.Beans.Basic.Readonly_Bean with private;
   type Module_Event_Access is access all Module_Event'Class;

   --  Set the event type which identifies the event.
   procedure Set_Event_Kind (Event : in out Module_Event;
                             Kind  : in Event_Index);

   --  Get the event type which identifies the event.
   function Get_Event_Kind (Event : in Module_Event) return Event_Index;

   --  Set a parameter on the message.
   procedure Set_Parameter (Event  : in out Module_Event;
                            Name   : in String;
                            Value  : in String);

   --  Get the parameter with the given name.
   function Get_Parameter (Event : in Module_Event;
                           Name  : in String) return String;

   --  Get the value that corresponds to the parameter with the given name.
   overriding
   function Get_Value (Event : in Module_Event;
                       Name  : in String) return Util.Beans.Objects.Object;

   --  Get the entity identifier associated with the event.
   function Get_Entity_Identifier (Event : in Module_Event) return ADO.Identifier;

   --  Set the entity identifier associated with the event.
   procedure Set_Entity_Identifier (Event : in out Module_Event;
                                    Id    : in ADO.Identifier);

   --  Copy the event properties to the map passed in <tt>Into</tt>.
   procedure Copy (Event : in Module_Event;
                   Into  : in out Util.Beans.Objects.Maps.Map);

private

   type Module_Event is new Util.Events.Event and Util.Beans.Basic.Readonly_Bean with record
      Kind        : Event_Index := Event_Arrays.Invalid_Index;
      Props       : Util.Beans.Objects.Maps.Map;
      Entity      : ADO.Identifier  := ADO.NO_IDENTIFIER;
      Entity_Type : ADO.Entity_Type := ADO.NO_ENTITY_TYPE;
   end record;

   --  The index of the last event definition.
   --  Last_Event : Event_Index := 0;

   --  Get the event type name.
   function Get_Event_Type_Name (Index : in Event_Index) return Util.Strings.Name_Access
                                 renames Event_Arrays.Get_Name;

   --  Make and return a copy of the event.
   function Copy (Event : in Module_Event) return Module_Event_Access;

end AWA.Events;

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

with Util.Strings;
with Util.Events;
with Util.Beans.Objects;
with Util.Beans.Basic;
with Util.Beans.Objects.Maps;

with ADO;

with AWA.Index_Arrays;

--  == Introduction ==
--  The AWA.Events package defines an event framework for modules to post events
--  and have Ada bean methods be invoked when these events are dispatched.  Subscription to
--  events is done through configuration files.  This allows to configure the modules and
--  integrate them together easily at configuration time.
--
--  === Declaration ===
--  Modules define the events that they can generate by instantiating the Definition
--  package. This is a static definition of the event.  Each event is given a unique name.
--
--    package Event_New_User is new AWA.Events.Definition ("new-user");
--
--  === Posting an event ===
--  The module can post an event to inform other modules or the system that a particular
--  action occurred.  The module creates the event instance of type Module_Event and
--  populates that event with useful properties for event receivers.
--
--    Event : AWA.Events.Module_Event;
--
--    Event.Set_Event_Kind (Event_New_User.Kind);
--    Event.Set_Parameter ("email", "harry.potter@hogwarts.org");
--
--  The module will post the event by using the Send_Event operation.
--
--    Manager.Send_Event (Event);
--
--  === Receiving an event ===
--  Modules or applications interested by a particular event will configure the event manager
--  to dispatch the event to an Ada bean event action.  The Ada bean is an object that must
--  implement a procedure that matches the prototype:
--
--    type Action_Bean is new Util.Beans.Basic.Readonly_Bean ...;
--    procedure Action (Bean : in out Action_Bean; Event : in AWA.Events.Module_Event'Class);
--
--  The Ada bean method and object are registered as other Ada beans.
--
--  The configuration file indicates how to bind the Ada bean action and the event together.
--  The action is specified using an EL Method Expression (See Ada EL or JSR 245).
--
--    <on-event name="new_user">
--        <action>#{ada_bean.action}</action>
--    </on-event>
--
--  === Event queues and dispatchers ===
--  The *AWA.Events* framework posts events on queues and it uses a dispatcher to process them.
--  There are two kinds of dispatchers:
--
--    * Synchronous dispatcher process the event when it is posted.  The task which posts
--      the event invokes the Ada bean action.  In this dispatching mode, there is no event queue.
--      If the action method raises an exception, it will however be blocked.
--
--    * Asynchronous dispatcher are executed by dedicated tasks.  The event is put in an event
--      queue.  A dispatcher task processes the event and invokes the action method at a later
--      time.
--
--  When the event is queued, there are two types of event queues:
--
--    * A Fifo memory queue manages the event and dispatches them in FIFO order.
--      If the application is stopped, the events present in the Fifo queue are lost.
--
--    * A persistent event queue manages the event in a similar way as the FIFO queue but
--      saves them in the database.  If the application is stopped, events that have not yet
--      been processed will be dispatched when the application is started again.
--
--  == Data Model ==
--  @include Queues.hbm.xml
--
package AWA.Events is

   type Queue_Index is new Natural;
   type Event_Index is new Natural;

   package Event_Arrays is new AWA.Index_Arrays (Event_Index, String);

   use type Event_Arrays.Element_Type_Access;
   subtype Name_Access is Event_Arrays.Element_Type_Access;

   generic
   package Definition renames Event_Arrays.Definition;

   --  Exception raised if an event name is not found.
   Not_Found : exception renames Event_Arrays.Not_Found;

   --  Identifies an invalid event.
   -- Invalid_Event : constant Event_Index := 0;

   --  Find the event runtime index given the event name.
   --  Raises Not_Found exception if the event name is not recognized.
   function Find_Event_Index (Name : in String) return Event_Index renames Event_Arrays.Find;

   --  ------------------------------
   --  Module event
   --  ------------------------------
   type Module_Event is new Util.Events.Event and Util.Beans.Basic.Readonly_Bean with private;
   type Module_Event_Access is access all Module_Event'Class;

   --  Set the event type which identifies the event.
   procedure Set_Event_Kind (Event : in out Module_Event;
                             Kind  : in Event_Index);

   --  Get the event type which identifies the event.
   function Get_Event_Kind (Event : in Module_Event) return Event_Index;

   --  Set a parameter on the message.
   procedure Set_Parameter (Event  : in out Module_Event;
                            Name   : in String;
                            Value  : in String);

   --  Get the parameter with the given name.
   function Get_Parameter (Event : in Module_Event;
                           Name  : in String) return String;

   --  Get the value that corresponds to the parameter with the given name.
   overriding
   function Get_Value (Event : in Module_Event;
                       Name  : in String) return Util.Beans.Objects.Object;

   --  Get the entity identifier associated with the event.
   function Get_Entity_Identifier (Event : in Module_Event) return ADO.Identifier;

   --  Set the entity identifier associated with the event.
   procedure Set_Entity_Identifier (Event : in out Module_Event;
                                    Id    : in ADO.Identifier);

   --  Copy the event properties to the map passed in <tt>Into</tt>.
   procedure Copy (Event : in Module_Event;
                   Into  : in out Util.Beans.Objects.Maps.Map);

private

   type Module_Event is new Util.Events.Event and Util.Beans.Basic.Readonly_Bean with record
      Kind        : Event_Index := Event_Arrays.Invalid_Index;
      Props       : Util.Beans.Objects.Maps.Map;
      Entity      : ADO.Identifier  := ADO.NO_IDENTIFIER;
      Entity_Type : ADO.Entity_Type := ADO.NO_ENTITY_TYPE;
   end record;

   --  The index of the last event definition.
   --  Last_Event : Event_Index := 0;

   --  Get the event type name.
   function Get_Event_Type_Name (Index : in Event_Index) return Name_Access
                                 renames Event_Arrays.Get_Element;

   --  Make and return a copy of the event.
   function Copy (Event : in Module_Event) return Module_Event_Access;

end AWA.Events;

Update the Event_Arrays instantiation to indicate that each event definition is represented by a String


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

with Ada.Finalization;

with ADO.Statements;
with ADO.Schemas;
with Util.Properties;
with Util.Strings;

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

   use ADO.Statements;

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

   --  ------------------------------
   --  Database connection implementation
   --  ------------------------------
   --
   type Database_Connection is abstract new Ada.Finalization.Limited_Controlled with record
      Count : Natural := 0;
      Ident : String (1 .. 8) := (others => ' ');
   end record;
   type Database_Connection_Access is access all Database_Connection'Class;

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

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

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

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

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

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

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

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

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

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

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

   --  ------------------------------
   --  The database configuration properties
   --  ------------------------------
   type Configuration is new Ada.Finalization.Controlled with private;
   type Configuration_Access is access all Configuration'Class;

   --  Set the connection URL to connect to the database.
   --  The driver connection is a string of the form:
   --
   --   driver://[host][:port]/[database][?property1][=value1]...
   --
   --  If the string is invalid or if the driver cannot be found,
   --  the Connection_Error exception is raised.
   procedure Set_Connection (Controller : in out Configuration;
                             URI        : in String);

   --  Set a property on the datasource for the driver.
   --  The driver can retrieve the property to configure and open
   --  the database connection.
   procedure Set_Property (Controller : in out Configuration;
                           Name       : in String;
                           Value      : in String);

   --  Get a property from the data source configuration.
   --  If the property does not exist, an empty string is returned.
   function Get_Property (Controller : in Configuration;
                          Name       : in String) return String;

   --  Set the server hostname.
   procedure Set_Server (Controller : in out Configuration;
                         Server     : in String);

   --  Get the server hostname.
   function Get_Server (Controller : in Configuration) return String;

   --  Set the server port.
   procedure Set_Port (Controller : in out Configuration;
                       Port       : in Natural);

   --  Get the server port.
   function Get_Port (Controller : in Configuration) return Natural;

   --  Set the database name.
   procedure Set_Database (Controller : in out Configuration;
                           Database   : in String);

   --  Get the database name.
   function Get_Database (Controller : in Configuration) return String;

   --  Get the database driver name.
   function Get_Driver (Controller : in Configuration) return String;

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

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

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

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

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

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

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

private

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

   type Configuration is new Ada.Finalization.Controlled with record
      URI        : Unbounded_String := Null_Unbounded_String;
      Server     : Unbounded_String := Null_Unbounded_String;
      Port       : Natural := 0;
      Database   : Unbounded_String := Null_Unbounded_String;
      Properties : Util.Properties.Manager;
      Driver     : Driver_Access;
   end record;

end ADO.Drivers.Connections;

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

with ADO.Statements;
with ADO.Schemas;
with Util.Properties;
with Util.Strings;
with Util.Refs;

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

   use ADO.Statements;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

   --  ------------------------------
   --  The database configuration properties
   --  ------------------------------
   type Configuration is new Ada.Finalization.Controlled with private;
   type Configuration_Access is access all Configuration'Class;

   --  Set the connection URL to connect to the database.
   --  The driver connection is a string of the form:
   --
   --   driver://[host][:port]/[database][?property1][=value1]...
   --
   --  If the string is invalid or if the driver cannot be found,
   --  the Connection_Error exception is raised.
   procedure Set_Connection (Controller : in out Configuration;
                             URI        : in String);

   --  Set a property on the datasource for the driver.
   --  The driver can retrieve the property to configure and open
   --  the database connection.
   procedure Set_Property (Controller : in out Configuration;
                           Name       : in String;
                           Value      : in String);

   --  Get a property from the data source configuration.
   --  If the property does not exist, an empty string is returned.
   function Get_Property (Controller : in Configuration;
                          Name       : in String) return String;

   --  Set the server hostname.
   procedure Set_Server (Controller : in out Configuration;
                         Server     : in String);

   --  Get the server hostname.
   function Get_Server (Controller : in Configuration) return String;

   --  Set the server port.
   procedure Set_Port (Controller : in out Configuration;
                       Port       : in Natural);

   --  Get the server port.
   function Get_Port (Controller : in Configuration) return Natural;

   --  Set the database name.
   procedure Set_Database (Controller : in out Configuration;
                           Database   : in String);

   --  Get the database name.
   function Get_Database (Controller : in Configuration) return String;

   --  Get the database driver name.
   function Get_Driver (Controller : in Configuration) return String;

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

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

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

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

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

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

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

private

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

   type Configuration is new Ada.Finalization.Controlled with record
      URI        : Unbounded_String := Null_Unbounded_String;
      Server     : Unbounded_String := Null_Unbounded_String;
      Port       : Natural := 0;
      Database   : Unbounded_String := Null_Unbounded_String;
      Properties : Util.Properties.Manager;
      Driver     : Driver_Access;
   end record;

end ADO.Drivers.Connections;

Change the implementation to use the Util.Refs generic package for reference counting Update the driver API accordingly


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

package body Util.Mail is

   use Ada.Strings.Unbounded;
   use Ada.Strings.Fixed;
   use Ada.Strings;

   --  ------------------------------
   --  Parse the email address and separate the name from the address.
   --  ------------------------------
   function Parse_Address (E_Mail : in String) return Email_Address is
      Result    : Email_Address;
      First_Pos : constant Natural := Index (E_Mail, "<");
      Last_Pos  : constant Natural := Index (E_Mail, ">");
      At_Pos    : constant Natural := Index (E_Mail, "@");
   begin
      if First_Pos > 0 and Last_Pos > 0 then
         Result.Name := To_Unbounded_String (Trim (E_Mail (E_Mail'First .. First_Pos - 1),
                                             Both));
         Result.Address := To_Unbounded_String (Trim (E_Mail (First_Pos + 1 .. Last_Pos - 1),
                                                Both));
         if Length (Result.Name) = 0 and At_Pos < Last_Pos then
            Result.Name := To_Unbounded_String (Trim (E_Mail (First_Pos + 1 .. At_Pos - 1), Both));
         end if;
      else
         Result.Address := To_Unbounded_String (Trim (E_Mail, Both));
         Result.Name := To_Unbounded_String (Trim (E_Mail (E_Mail'First .. At_Pos - 1), Both));
      end if;
      return Result;
   end Parse_Address;

   --  ------------------------------
   --  Extract a first name from the email address.
   --  ------------------------------
   function Get_First_Name (From : in Email_Address) return String is
      Name : constant String := To_String (From.Name);
      Pos  : Natural := Index (Name, " ");
   begin
      if Pos > 0 then
         return Name (Name'First .. Pos - 1);
      end if;
      Pos := Index (Name, ".");
      if Pos > 0 then
         return Name (Name'First .. Pos - 1);
      else
         return "";
      end if;
   end Get_First_Name;

end Util.Mail;

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

package body Util.Mail is

   use Ada.Strings.Unbounded;
   use Ada.Strings.Fixed;
   use Ada.Strings;

   --  ------------------------------
   --  Parse the email address and separate the name from the address.
   --  ------------------------------
   function Parse_Address (E_Mail : in String) return Email_Address is
      Result    : Email_Address;
      First_Pos : constant Natural := Index (E_Mail, "<");
      Last_Pos  : constant Natural := Index (E_Mail, ">");
      At_Pos    : constant Natural := Index (E_Mail, "@");
   begin
      if First_Pos > 0 and Last_Pos > 0 then
         Result.Name := To_Unbounded_String (Trim (E_Mail (E_Mail'First .. First_Pos - 1),
                                             Both));
         Result.Address := To_Unbounded_String (Trim (E_Mail (First_Pos + 1 .. Last_Pos - 1),
                                                Both));
         if Length (Result.Name) = 0 and At_Pos < Last_Pos then
            Result.Name := To_Unbounded_String (Trim (E_Mail (First_Pos + 1 .. At_Pos - 1), Both));
         end if;
      else
         Result.Address := To_Unbounded_String (Trim (E_Mail, Both));
         Result.Name := To_Unbounded_String (Trim (E_Mail (E_Mail'First .. At_Pos - 1), Both));
      end if;
      return Result;
   end Parse_Address;

   --  ------------------------------
   --  Extract a first name from the email address.
   --  ------------------------------
   function Get_First_Name (From : in Email_Address) return String is
      Name : constant String := To_String (From.Name);
      Pos  : Natural := Index (Name, " ");
   begin
      if Pos > 0 then
         return Name (Name'First .. Pos - 1);
      end if;
      Pos := Index (Name, ".");
      if Pos > 0 then
         return Name (Name'First .. Pos - 1);
      else
         return "";
      end if;
   end Get_First_Name;

   --  ------------------------------
   --  Extract a last name from the email address.
   --  ------------------------------
   function Get_Last_Name (From : in Email_Address) return String is
      Name : constant String := To_String (From.Name);
      Pos  : Natural := Index (Name, " ");
   begin
      if Pos > 0 then
         return Trim (Name (Pos + 1 .. Name'Last), Both);
      end if;
      Pos := Index (Name, ".");
      if Pos > 0 then
         return Name (Pos + 1 .. Name'Last);
      else
         return Name;
      end if;
   end Get_Last_Name;

end Util.Mail;

Implement the Get_Last_Name function to extract a possible last name for the user


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

   --  ------------------------------
   --  Render the wiki text according to the wiki syntax in HTML into a string.
   --  ------------------------------
   function To_Html (Text   : in Wide_Wide_String;
                     Syntax : in Wiki.Parsers.Wiki_Syntax_Type) return String is
      Writer   : aliased Wiki.Writers.Builders.Html_Writer_Type;
      Renderer : aliased Wiki.Render.Html.Html_Renderer;
      Filter   : aliased Wiki.Filters.Html.Html_Filter_Type;
   begin
      Renderer.Set_Writer (Writer'Unchecked_Access);
      Filter.Set_Document (Renderer'Unchecked_Access);
      Wiki.Parsers.Parse (Filter'Unchecked_Access, Text, Syntax);
      return Writer.To_String;
   end To_Html;

   --  ------------------------------
   --  Render the wiki text according to the wiki syntax in text into a string.
   --  Wiki formatting and decoration are removed.
   --  ------------------------------
   function To_Text (Text   : in Wide_Wide_String;
                     Syntax : in Wiki.Parsers.Wiki_Syntax_Type) return String is
      Writer   : aliased Wiki.Writers.Builders.Writer_Builder_Type;
      Renderer : aliased Wiki.Render.Text.Text_Renderer;
   begin
      Renderer.Set_Writer (Writer'Unchecked_Access);
      Wiki.Parsers.Parse (Renderer'Unchecked_Access, Text, Syntax);
      return Writer.To_String;
   end To_Text;

end Wiki.Utils;

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

   --  ------------------------------
   --  Render the wiki text according to the wiki syntax in HTML into a string.
   --  ------------------------------
   function To_Html (Text   : in Wide_Wide_String;
                     Syntax : in Wiki.Parsers.Wiki_Syntax_Type) return String is
      Stream   : aliased Wiki.Streams.Html.Builders.Html_Output_Builder_Stream;
      Renderer : aliased Wiki.Render.Html.Html_Renderer;
      Filter   : aliased Wiki.Filters.Html.Html_Filter_Type;
      Engine   : Wiki.Parsers.Parser;
   begin
      Renderer.Set_Output_Stream (Stream'Unchecked_Access);
      Engine.Add_Filter (Filter'Unchecked_Access);
      Engine.Set_Syntax (Syntax);
      Engine.Parse (Text, Renderer'Unchecked_Access);
      return Stream.To_String;
   end To_Html;

   --  ------------------------------
   --  Render the wiki text according to the wiki syntax in text into a string.
   --  Wiki formatting and decoration are removed.
   --  ------------------------------
   function To_Text (Text   : in Wide_Wide_String;
                     Syntax : in Wiki.Parsers.Wiki_Syntax_Type) return String is
      Stream   : aliased Wiki.Streams.Builders.Output_Builder_Stream;
      Renderer : aliased Wiki.Render.Text.Text_Renderer;
      Engine   : Wiki.Parsers.Parser;
   begin
      Renderer.Set_Output_Stream (Stream'Unchecked_Access);
      Engine.Set_Syntax (Syntax);
      Engine.Parse (Text, Renderer'Unchecked_Access);
      return Stream.To_String;
   end To_Text;

end Wiki.Utils;

Update the To_Html and To_Text function to use the new wiki engine implementation


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

   type Stream_Reader_Type is new Manager_Base with private;

   --  Read the events from the stream and stop when the end of the stream is reached.
   procedure Read_All (Reader : in out Stream_Reader_Type);

   --  Read a message from the stream.
   overriding
   procedure Read_Message (Reader : in out Stream_Reader_Type;
                           Msg    : in out Message);

private

   type Stream_Reader_Type is new Manager_Base with record
      Stream : Util.Streams.Buffered.Buffered_Stream;
      Data   : Util.Streams.Buffered.Buffer_Access;
   end record;

end MAT.Readers.Streams;

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

   type Stream_Reader_Type is new MAT.Events.Probes.Probe_Manager_Type with private;

   --  Read the events from the stream and stop when the end of the stream is reached.
   procedure Read_All (Reader : in out Stream_Reader_Type);

   --  Read a message from the stream.
   overriding
   procedure Read_Message (Reader : in out Stream_Reader_Type;
                           Msg    : in out Message_Type);

private

   type Stream_Reader_Type is new MAT.Events.Probes.Probe_Manager_Type with record
      Stream : Util.Streams.Buffered.Buffered_Stream;
      Data   : Util.Streams.Buffered.Buffer_Access;
   end record;

end MAT.Readers.Streams;

Use the Message_Type and MAT.Events.Probes.Probe_Manager_Type types


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

with Util.Test_Caller;

with Util.Beans.Objects;

with Ada.Unchecked_Deallocation;

with EL.Contexts.Default;

with ASF.Applications.Tests;
with ASF.Applications.Main.Configs;
with ASF.Requests.Mockup;
package body ASF.Applications.Main.Tests is

   use Util.Tests;

   function Create_Form_Bean return Util.Beans.Basic.Readonly_Bean_Access;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ASF.Applications.Main.Read_Configuration",
                       Test_Read_Configuration'Access);
      Caller.Add_Test (Suite, "Test ASF.Applications.Main.Create",
                       Test_Create_Bean'Access);
      Caller.Add_Test (Suite, "Test ASF.Applications.Main.Load_Bundle",
                       Test_Load_Bundle'Access);
      Caller.Add_Test (Suite, "Test ASF.Applications.Main.Register,Load_Bundle",
                       Test_Bundle_Configuration'Access);
      Caller.Add_Test (Suite, "Test ASF.Applications.Main.Get_Supported_Locales",
                       Test_Locales'Access);
   end Add_Tests;

   --  ------------------------------
   --  Initialize the test application
   --  ------------------------------
   procedure Set_Up (T : in out Test) is
      Fact : ASF.Applications.Main.Application_Factory;
      C    : ASF.Applications.Config;
   begin
      T.App := new ASF.Applications.Main.Application;
      C.Copy (Util.Tests.Get_Properties);
      T.App.Initialize (C, Fact);
      T.App.Register ("layoutMsg", "layout");
   end Set_Up;

   --  ------------------------------
   --  Deletes the application object
   --  ------------------------------
   overriding
   procedure Tear_Down (T : in out Test) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => ASF.Applications.Main.Application'Class,
                                        Name   => ASF.Applications.Main.Application_Access);
   begin
      Free (T.App);
   end Tear_Down;

   function Create_Form_Bean return Util.Beans.Basic.Readonly_Bean_Access is
      Result : constant Applications.Tests.Form_Bean_Access := new Applications.Tests.Form_Bean;
   begin
      return Result.all'Access;
   end Create_Form_Bean;

   --  ------------------------------
   --  Test creation of module
   --  ------------------------------
   procedure Test_Read_Configuration (T : in out Test) is
      Path : constant String := Util.Tests.Get_Test_Path ("config/empty.xml");
   begin
      ASF.Applications.Main.Configs.Read_Configuration (T.App.all, Path);

   end Test_Read_Configuration;

   --  ------------------------------
   --  Test creation of a module and registration in an application.
   --  ------------------------------
   procedure Test_Create_Bean (T : in out Test) is
      use type Util.Beans.Basic.Readonly_Bean_Access;

      procedure Check (Name : in String;
                       Kind : in ASF.Beans.Scope_Type);

      procedure Check (Name : in String;
                       Kind : in ASF.Beans.Scope_Type) is
         Value : Util.Beans.Objects.Object;
         Bean  : Util.Beans.Basic.Readonly_Bean_Access;
         Scope : ASF.Beans.Scope_Type;
         Context : EL.Contexts.Default.Default_Context;
      begin
         T.App.Create (Name    => Ada.Strings.Unbounded.To_Unbounded_String (Name),
                       Context => Context,
                       Result  => Bean,
                       Scope   => Scope);
         T.Assert (Kind = Scope, "Invalid scope for " & Name);
         T.Assert (Bean /= null, "Invalid bean object");
         Value := Util.Beans.Objects.To_Object (Bean);
         T.Assert (not Util.Beans.Objects.Is_Null (Value), "Invalid bean");

         --  Special test for the sessionForm bean which is initialized by configuration properties
         if Name = "sessionForm" then
            T.Assert_Equals ("John.Rambo@gmail.com",
                             Util.Beans.Objects.To_String (Bean.Get_Value ("email")),
                             "Session form not initialized");
         end if;
      end Check;

      Path : constant String := Util.Tests.Get_Test_Path ("regtests/config/test-module.xml");

   begin
      T.App.Register_Class ("ASF.Applications.Tests.Form_Bean", Create_Form_Bean'Access);
      ASF.Applications.Main.Configs.Read_Configuration (T.App.all, Path);

      --  Check the 'regtests/config/test-module.xml' managed bean configuration.
      Check ("applicationForm", ASF.Beans.APPLICATION_SCOPE);
      Check ("sessionForm", ASF.Beans.SESSION_SCOPE);
      Check ("requestForm", ASF.Beans.REQUEST_SCOPE);
   end Test_Create_Bean;

   --  ------------------------------
   --  Test loading a resource bundle through the application.
   --  ------------------------------
   procedure Test_Load_Bundle (T : in out Test) is
      use type Util.Beans.Basic.Readonly_Bean_Access;

      Path   : constant String := Util.Tests.Get_Test_Path ("regtests/config/test-bundle.xml");
      Bundle : ASF.Locales.Bundle;
   begin
      ASF.Applications.Main.Configs.Read_Configuration (T.App.all, Path);

      T.App.Load_Bundle (Name   => "samples",
                         Locale => "en",
                         Bundle => Bundle);
      Util.Tests.Assert_Equals (T, "Help", String '(Bundle.Get ("layout_help_label")),
                                "Invalid bundle value");

      T.App.Load_Bundle (Name   => "asf",
                         Locale => "en",
                         Bundle => Bundle);
      Util.Tests.Assert_Matches (T, ".*greater than.*",
                                 String '(Bundle.Get ("validators.length.maximum")),
                                "Invalid bundle value");
   end Test_Load_Bundle;

   --  ------------------------------
   --  Test application configuration and registration of resource bundles.
   --  ------------------------------
   procedure Test_Bundle_Configuration (T : in out Test) is
      use type Util.Beans.Basic.Readonly_Bean_Access;

      Path   : constant String := Util.Tests.Get_Test_Path ("regtests/config/test-bundle.xml");
      Result : Util.Beans.Basic.Readonly_Bean_Access;
      Ctx    : EL.Contexts.Default.Default_Context;
      Scope  : Scope_Type;
   begin
      ASF.Applications.Main.Configs.Read_Configuration (T.App.all, Path);

      T.App.Create (Name    => Ada.Strings.Unbounded.To_Unbounded_String ("samplesMsg"),
                    Context => Ctx,
                    Result  => Result,
                    Scope   => Scope);
      T.Assert (Result /= null, "The samplesMsg bundle was not created");

      T.App.Create (Name    => Ada.Strings.Unbounded.To_Unbounded_String ("defaultMsg"),
                    Context => Ctx,
                    Result  => Result,
                    Scope   => Scope);
      T.Assert (Result /= null, "The defaultMsg bundle was not created");
   end Test_Bundle_Configuration;

   --  ------------------------------
   --  Test locales.
   --  ------------------------------
   procedure Test_Locales (T : in out Test) is
      use Util.Locales;

      Path      : constant String := Util.Tests.Get_Test_Path ("regtests/config/test-locales.xml");
      Req       : aliased ASF.Requests.Mockup.Request;
      View      : constant access Applications.Views.View_Handler'Class := T.App.Get_View_Handler;
      Context   : aliased ASF.Contexts.Faces.Faces_Context;
      ELContext : aliased EL.Contexts.Default.Default_Context;
      Locale    : Util.Locales.Locale;
   begin
      ASF.Applications.Main.Configs.Read_Configuration (T.App.all, Path);

      Util.Tests.Assert_Equals (T, To_String (Util.Locales.FRENCH),
                                To_String (T.App.Get_Default_Locale),
                                "Invalid default locale");

      Context.Set_ELContext (ELContext'Unchecked_Access);
      Context.Set_Request (Req'Unchecked_Access);
      Req.Set_Header ("Accept-Language", "da, en-gb;q=0.3, fr;q=0.7");
      T.App.Set_Context (Context'Unchecked_Access);
      Locale := View.Calculate_Locale (Context);

      Util.Tests.Assert_Equals (T, To_String (Util.Locales.FRENCH),
                                To_String (Locale),
                                "Invalid calculated locale");

      Req.Set_Header ("Accept-Language", "da, en-gb, en;q=0.8, fr;q=0.7");
      T.App.Set_Context (Context'Unchecked_Access);
      Locale := View.Calculate_Locale (Context);

      Util.Tests.Assert_Equals (T, To_String (Util.Locales.ENGLISH),
                                To_String (Locale),
                                "Invalid calculated locale");

      Req.Set_Header ("Accept-Language", "da, ru, it;q=0.8, de;q=0.7");
      T.App.Set_Context (Context'Unchecked_Access);
      Locale := View.Calculate_Locale (Context);

      Util.Tests.Assert_Equals (T, To_String (Util.Locales.FRENCH),
                                To_String (Locale),
                                "Invalid calculated locale");
   end Test_Locales;

end ASF.Applications.Main.Tests;

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

with Util.Test_Caller;

with Util.Beans.Objects;

with Ada.Unchecked_Deallocation;

with EL.Contexts.Default;

with ASF.Applications.Tests;
with ASF.Applications.Main.Configs;
with ASF.Requests.Mockup;
package body ASF.Applications.Main.Tests is

   use Util.Tests;

   function Create_Form_Bean return Util.Beans.Basic.Readonly_Bean_Access;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ASF.Applications.Main.Read_Configuration",
                       Test_Read_Configuration'Access);
      Caller.Add_Test (Suite, "Test ASF.Applications.Main.Create",
                       Test_Create_Bean'Access);
      Caller.Add_Test (Suite, "Test ASF.Applications.Main.Load_Bundle",
                       Test_Load_Bundle'Access);
      Caller.Add_Test (Suite, "Test ASF.Applications.Main.Register,Load_Bundle",
                       Test_Bundle_Configuration'Access);
      Caller.Add_Test (Suite, "Test ASF.Applications.Main.Get_Supported_Locales",
                       Test_Locales'Access);
   end Add_Tests;

   --  ------------------------------
   --  Initialize the test application
   --  ------------------------------
   procedure Set_Up (T : in out Test) is
      Fact : ASF.Applications.Main.Application_Factory;
      C    : ASF.Applications.Config;
   begin
      T.App := new ASF.Applications.Main.Application;
      C.Copy (Util.Tests.Get_Properties);
      T.App.Initialize (C, Fact);
      T.App.Register ("layoutMsg", "layout");
   end Set_Up;

   --  ------------------------------
   --  Deletes the application object
   --  ------------------------------
   overriding
   procedure Tear_Down (T : in out Test) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => ASF.Applications.Main.Application'Class,
                                        Name   => ASF.Applications.Main.Application_Access);
   begin
      Free (T.App);
   end Tear_Down;

   function Create_Form_Bean return Util.Beans.Basic.Readonly_Bean_Access is
      Result : constant Applications.Tests.Form_Bean_Access := new Applications.Tests.Form_Bean;
   begin
      return Result.all'Access;
   end Create_Form_Bean;

   --  ------------------------------
   --  Test creation of module
   --  ------------------------------
   procedure Test_Read_Configuration (T : in out Test) is
      Path : constant String := Util.Tests.Get_Test_Path ("config/empty.xml");
   begin
      ASF.Applications.Main.Configs.Read_Configuration (T.App.all, Path);

   end Test_Read_Configuration;

   --  ------------------------------
   --  Test creation of a module and registration in an application.
   --  ------------------------------
   procedure Test_Create_Bean (T : in out Test) is
      use type Util.Beans.Basic.Readonly_Bean_Access;

      procedure Check (Name : in String;
                       Kind : in ASF.Beans.Scope_Type);

      procedure Check (Name : in String;
                       Kind : in ASF.Beans.Scope_Type) is
         Value : Util.Beans.Objects.Object;
         Bean  : Util.Beans.Basic.Readonly_Bean_Access;
         Scope : ASF.Beans.Scope_Type;
         Context : EL.Contexts.Default.Default_Context;
      begin
         T.App.Create (Name    => Ada.Strings.Unbounded.To_Unbounded_String (Name),
                       Context => Context,
                       Result  => Bean,
                       Scope   => Scope);
         T.Assert (Kind = Scope, "Invalid scope for " & Name);
         T.Assert (Bean /= null, "Invalid bean object");
         Value := Util.Beans.Objects.To_Object (Bean);
         T.Assert (not Util.Beans.Objects.Is_Null (Value), "Invalid bean");

         --  Special test for the sessionForm bean which is initialized by configuration properties
         if Name = "sessionForm" then
            T.Assert_Equals ("John.Rambo@gmail.com",
                             Util.Beans.Objects.To_String (Bean.Get_Value ("email")),
                             "Session form not initialized");
         end if;
      end Check;

      Path : constant String := Util.Tests.Get_Test_Path ("regtests/config/test-module.xml");

   begin
      T.App.Register_Class ("ASF.Applications.Tests.Form_Bean", Create_Form_Bean'Access);
      ASF.Applications.Main.Configs.Read_Configuration (T.App.all, Path);

      --  Check the 'regtests/config/test-module.xml' managed bean configuration.
      Check ("applicationForm", ASF.Beans.APPLICATION_SCOPE);
      Check ("sessionForm", ASF.Beans.SESSION_SCOPE);
      Check ("requestForm", ASF.Beans.REQUEST_SCOPE);
   end Test_Create_Bean;

   --  ------------------------------
   --  Test loading a resource bundle through the application.
   --  ------------------------------
   procedure Test_Load_Bundle (T : in out Test) is
      use type Util.Beans.Basic.Readonly_Bean_Access;

      Path   : constant String := Util.Tests.Get_Test_Path ("regtests/config/test-bundle.xml");
      Bundle : ASF.Locales.Bundle;
   begin
      ASF.Applications.Main.Configs.Read_Configuration (T.App.all, Path);

      T.App.Load_Bundle (Name   => "samples",
                         Locale => "en",
                         Bundle => Bundle);
      Util.Tests.Assert_Equals (T, "Help", String '(Bundle.Get ("layout_help_label")),
                                "Invalid bundle value");

      T.App.Load_Bundle (Name   => "asf",
                         Locale => "en",
                         Bundle => Bundle);
      Util.Tests.Assert_Matches (T, ".*greater than.*",
                                 String '(Bundle.Get ("validators.length.maximum")),
                                "Invalid bundle value");
   end Test_Load_Bundle;

   --  ------------------------------
   --  Test application configuration and registration of resource bundles.
   --  ------------------------------
   procedure Test_Bundle_Configuration (T : in out Test) is
      use type Util.Beans.Basic.Readonly_Bean_Access;

      Path   : constant String := Util.Tests.Get_Test_Path ("regtests/config/test-bundle.xml");
      Result : Util.Beans.Basic.Readonly_Bean_Access;
      Ctx    : EL.Contexts.Default.Default_Context;
      Scope  : Scope_Type;
   begin
      ASF.Applications.Main.Configs.Read_Configuration (T.App.all, Path);

      T.App.Create (Name    => Ada.Strings.Unbounded.To_Unbounded_String ("samplesMsg"),
                    Context => Ctx,
                    Result  => Result,
                    Scope   => Scope);
      T.Assert (Result /= null, "The samplesMsg bundle was not created");

      T.App.Create (Name    => Ada.Strings.Unbounded.To_Unbounded_String ("defaultMsg"),
                    Context => Ctx,
                    Result  => Result,
                    Scope   => Scope);
      T.Assert (Result /= null, "The defaultMsg bundle was not created");
   end Test_Bundle_Configuration;

   --  ------------------------------
   --  Test locales.
   --  ------------------------------
   procedure Test_Locales (T : in out Test) is
      use Util.Locales;

      Path      : constant String := Util.Tests.Get_Test_Path ("regtests/config/test-locales.xml");
      Req       : aliased ASF.Requests.Mockup.Request;
      View      : constant access Applications.Views.View_Handler'Class := T.App.Get_View_Handler;
      Context   : aliased ASF.Contexts.Faces.Faces_Context;
      ELContext : aliased EL.Contexts.Default.Default_Context;
      Locale    : Util.Locales.Locale;
   begin
      ASF.Applications.Main.Configs.Read_Configuration (T.App.all, Path);

      Util.Tests.Assert_Equals (T, To_String (Util.Locales.FRENCH),
                                To_String (T.App.Get_Default_Locale),
                                "Invalid default locale");

      Context.Set_ELContext (ELContext'Unchecked_Access);
      Context.Set_Request (Req'Unchecked_Access);
      Req.Set_Header ("Accept-Language", "da, en-gb;q=0.3, fr;q=0.7");
      T.App.Set_Context (Context'Unchecked_Access);
      Locale := View.Calculate_Locale (Context);

      Util.Tests.Assert_Equals (T, To_String (Util.Locales.FRENCH),
                                To_String (Locale),
                                "Invalid calculated locale");

      Req.Set_Header ("Accept-Language", "da, en-gb, en;q=0.8, fr;q=0.7");
      T.App.Set_Context (Context'Unchecked_Access);
      Locale := View.Calculate_Locale (Context);

      Util.Tests.Assert_Equals (T, "en_GB",
                                To_String (Locale),
                                "Invalid calculated locale");

      Req.Set_Header ("Accept-Language", "da, fr;q=0.7, fr-fr;q=0.8");
      T.App.Set_Context (Context'Unchecked_Access);
      Locale := View.Calculate_Locale (Context);

      Util.Tests.Assert_Equals (T, "fr_FR",
                                To_String (Locale),
                                "Invalid calculated locale");

      Req.Set_Header ("Accept-Language", "da, ru, it;q=0.8, de;q=0.7");
      T.App.Set_Context (Context'Unchecked_Access);
      Locale := View.Calculate_Locale (Context);

      Util.Tests.Assert_Equals (T, To_String (Util.Locales.FRENCH),
                                To_String (Locale),
                                "Invalid calculated locale");
   end Test_Locales;

end ASF.Applications.Main.Tests;

Update and add some locale test

Update and add some locale test


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

with Util.Encoders.Base16;
with Util.Encoders.Base64;

--  The Util.Encodes.HMAC.SHA1 package generates HMAC-SHA1 authentication
--  (See RFC 2104 - HMAC: Keyed-Hashing for Message Authentication).
package body Util.Encoders.HMAC.SHA1 is

   --  ------------------------------
   --  Sign the data string with the key and return the HMAC-SHA1 code in binary.
   --  ------------------------------
   function Sign (Key  : in String;
                  Data : in String) return Util.Encoders.SHA1.Hash_Array is
      Ctx    : Context;
      Result : Util.Encoders.SHA1.Hash_Array;
   begin
      Set_Key (Ctx, Key);
      Update (Ctx, Data);
      Finish (Ctx, Result);
      return Result;
   end Sign;

   --  ------------------------------
   --  Sign the data string with the key and return the HMAC-SHA1 code as hexadecimal string.
   --  ------------------------------
   function Sign (Key  : in String;
                  Data : in String) return Util.Encoders.SHA1.Digest is
      Ctx    : Context;
      Result : Util.Encoders.SHA1.Digest;
   begin
      Set_Key (Ctx, Key);
      Update (Ctx, Data);
      Finish (Ctx, Result);
      return Result;
   end Sign;

   --  ------------------------------
   --  Sign the data string with the key and return the HMAC-SHA1 code as base64 string.
   --  When URL is True, use the base64 URL alphabet to encode in base64.
   --  ------------------------------
   function Sign_Base64 (Key  : in String;
                         Data : in String;
                         URL  : in Boolean := False) return Util.Encoders.SHA1.Base64_Digest is
      Ctx    : Context;
      Result : Util.Encoders.SHA1.Base64_Digest;
   begin
      Set_Key (Ctx, Key);
      Update (Ctx, Data);
      Finish_Base64 (Ctx, Result, URL);
      return Result;
   end Sign_Base64;

   --  ------------------------------
   --  Set the hmac private key.  The key must be set before calling any Update
   --  procedure.
   --  ------------------------------
   procedure Set_Key (E   : in out Context;
                      Key : in String) is
      Buf : Ada.Streams.Stream_Element_Array (1 .. Key'Length);
      for Buf'Address use Key'Address;
      pragma Import (Ada, Buf);

   begin
      Set_Key (E, Buf);
   end Set_Key;

   IPAD : constant Ada.Streams.Stream_Element := 16#36#;
   OPAD : constant Ada.Streams.Stream_Element := 16#5c#;

   --  ------------------------------
   --  Set the hmac private key.  The key must be set before calling any Update
   --  procedure.
   --  ------------------------------
   procedure Set_Key (E   : in out Context;
                      Key : in Ada.Streams.Stream_Element_Array) is
      use type Ada.Streams.Stream_Element_Offset;
      use type Ada.Streams.Stream_Element;
   begin
      --  Reduce the key
      if Key'Length > 64 then
         Util.Encoders.SHA1.Update (E.SHA, Key);
         Util.Encoders.SHA1.Finish (E.SHA, E.Key (0 .. 19));
         E.Key_Len := 19;
      else
         E.Key_Len := Key'Length - 1;
         E.Key (0 .. E.Key_Len) := Key;
      end if;

      --  Hash the key in the SHA1 context.
      declare
         Block : Ada.Streams.Stream_Element_Array (0 .. 63);
      begin
         for I in 0 .. E.Key_Len loop
            Block (I) := IPAD xor E.Key (I);
         end loop;
         for I in E.Key_Len + 1 .. 63 loop
            Block (I) := IPAD;
         end loop;
         Util.Encoders.SHA1.Update (E.SHA, Block);
      end;
   end Set_Key;

   --  ------------------------------
   --  Update the hash with the string.
   --  ------------------------------
   procedure Update (E : in out Context;
                     S : in String) is
   begin
      Util.Encoders.SHA1.Update (E.SHA, S);
   end Update;

   --  ------------------------------
   --  Update the hash with the string.
   --  ------------------------------
   procedure Update (E : in out Context;
                     S : in Ada.Streams.Stream_Element_Array) is
   begin
      Util.Encoders.SHA1.Update (E.SHA, S);
   end Update;

   --  ------------------------------
   --  Computes the HMAC-SHA1 with the private key and the data collected by
   --  the Update procedures.  Returns the raw binary hash in Hash.
   --  ------------------------------
   procedure Finish (E    : in out Context;
                     Hash : out Util.Encoders.SHA1.Hash_Array) is
      use type Ada.Streams.Stream_Element;
      use type Ada.Streams.Stream_Element_Offset;
   begin
      Util.Encoders.SHA1.Finish (E.SHA, Hash);

      --  Hash the key in the SHA1 context.
      declare
         Block : Ada.Streams.Stream_Element_Array (0 .. 63);
      begin
         for I in 0 .. E.Key_Len loop
            Block (I) := OPAD xor E.Key (I);
         end loop;
         if E.Key_Len < 63 then
            for I in E.Key_Len + 1 .. 63 loop
               Block (I) := OPAD;
            end loop;
         end if;
         Util.Encoders.SHA1.Update (E.SHA, Block);
      end;
      Util.Encoders.SHA1.Update (E.SHA, Hash);
      Util.Encoders.SHA1.Finish (E.SHA, Hash);
   end Finish;

   --  ------------------------------
   --  Computes the HMAC-SHA1 with the private key and the data collected by
   --  the Update procedures.  Returns the hexadecimal hash in Hash.
   --  ------------------------------
   procedure Finish (E    : in out Context;
                     Hash : out Util.Encoders.SHA1.Digest) is
      Buf : Ada.Streams.Stream_Element_Array (1 .. Hash'Length);
      for Buf'Address use Hash'Address;
      pragma Import (Ada, Buf);

      H       : Util.Encoders.SHA1.Hash_Array;
      B       : Util.Encoders.Base16.Encoder;
      Last    : Ada.Streams.Stream_Element_Offset;
      Encoded : Ada.Streams.Stream_Element_Offset;
   begin
      Finish (E, H);
      B.Transform (Data => H, Into => Buf, Last => Last, Encoded => Encoded);
   end Finish;

   --  ------------------------------
   --  Computes the HMAC-SHA1 with the private key and the data collected by
   --  the Update procedures.  Returns the base64 hash in Hash.
   --  When URL is True, use the base64 URL alphabet to encode in base64.
   --  ------------------------------
   procedure Finish_Base64 (E    : in out Context;
                            Hash : out Util.Encoders.SHA1.Base64_Digest;
                            URL  : in Boolean := False) is
      Buf : Ada.Streams.Stream_Element_Array (1 .. Hash'Length);
      for Buf'Address use Hash'Address;
      pragma Import (Ada, Buf);

      H       : Util.Encoders.SHA1.Hash_Array;
      B       : Util.Encoders.Base64.Encoder;
      Last    : Ada.Streams.Stream_Element_Offset;
      Encoded : Ada.Streams.Stream_Element_Offset;
   begin
      Finish (E, H);
      B.Set_URL_Mode (URL);
      B.Transform (Data => H, Into => Buf, Last => Last, Encoded => Encoded);
   end Finish_Base64;

   --  Encodes the binary input stream represented by Data into
   --  an SHA-1 hash output stream Into.
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   overriding
   procedure Transform (E       : in Encoder;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset) is
   begin
      null;
   end Transform;

   --  Initialize the SHA-1 context.
   overriding
   procedure Initialize (E : in out Context) is
   begin
      null;
   end Initialize;

end Util.Encoders.HMAC.SHA1;

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

with Util.Encoders.Base16;
with Util.Encoders.Base64;

--  The Util.Encodes.HMAC.SHA1 package generates HMAC-SHA1 authentication
--  (See RFC 2104 - HMAC: Keyed-Hashing for Message Authentication).
package body Util.Encoders.HMAC.SHA1 is

   --  ------------------------------
   --  Sign the data string with the key and return the HMAC-SHA1 code in binary.
   --  ------------------------------
   function Sign (Key  : in String;
                  Data : in String) return Util.Encoders.SHA1.Hash_Array is
      Ctx    : Context;
      Result : Util.Encoders.SHA1.Hash_Array;
   begin
      Set_Key (Ctx, Key);
      Update (Ctx, Data);
      Finish (Ctx, Result);
      return Result;
   end Sign;

   --  ------------------------------
   --  Sign the data string with the key and return the HMAC-SHA1 code as hexadecimal string.
   --  ------------------------------
   function Sign (Key  : in String;
                  Data : in String) return Util.Encoders.SHA1.Digest is
      Ctx    : Context;
      Result : Util.Encoders.SHA1.Digest;
   begin
      Set_Key (Ctx, Key);
      Update (Ctx, Data);
      Finish (Ctx, Result);
      return Result;
   end Sign;

   --  ------------------------------
   --  Sign the data string with the key and return the HMAC-SHA1 code as base64 string.
   --  When URL is True, use the base64 URL alphabet to encode in base64.
   --  ------------------------------
   function Sign_Base64 (Key  : in String;
                         Data : in String;
                         URL  : in Boolean := False) return Util.Encoders.SHA1.Base64_Digest is
      Ctx    : Context;
      Result : Util.Encoders.SHA1.Base64_Digest;
   begin
      Set_Key (Ctx, Key);
      Update (Ctx, Data);
      Finish_Base64 (Ctx, Result, URL);
      return Result;
   end Sign_Base64;

   --  ------------------------------
   --  Set the hmac private key.  The key must be set before calling any Update
   --  procedure.
   --  ------------------------------
   procedure Set_Key (E   : in out Context;
                      Key : in String) is
      Buf : Ada.Streams.Stream_Element_Array (1 .. Key'Length);
      for Buf'Address use Key'Address;
      pragma Import (Ada, Buf);

   begin
      Set_Key (E, Buf);
   end Set_Key;

   IPAD : constant Ada.Streams.Stream_Element := 16#36#;
   OPAD : constant Ada.Streams.Stream_Element := 16#5c#;

   --  ------------------------------
   --  Set the hmac private key.  The key must be set before calling any Update
   --  procedure.
   --  ------------------------------
   procedure Set_Key (E   : in out Context;
                      Key : in Ada.Streams.Stream_Element_Array) is
      use type Ada.Streams.Stream_Element_Offset;
      use type Ada.Streams.Stream_Element;
   begin
      --  Reduce the key
      if Key'Length > 64 then
         Util.Encoders.SHA1.Update (E.SHA, Key);
         Util.Encoders.SHA1.Finish (E.SHA, E.Key (0 .. 19));
         E.Key_Len := 19;
      else
         E.Key_Len := Key'Length - 1;
         E.Key (0 .. E.Key_Len) := Key;
      end if;

      --  Hash the key in the SHA1 context.
      declare
         Block : Ada.Streams.Stream_Element_Array (0 .. 63);
      begin
         for I in 0 .. E.Key_Len loop
            Block (I) := IPAD xor E.Key (I);
         end loop;
         for I in E.Key_Len + 1 .. 63 loop
            Block (I) := IPAD;
         end loop;
         Util.Encoders.SHA1.Update (E.SHA, Block);
      end;
   end Set_Key;

   --  ------------------------------
   --  Update the hash with the string.
   --  ------------------------------
   procedure Update (E : in out Context;
                     S : in String) is
   begin
      Util.Encoders.SHA1.Update (E.SHA, S);
   end Update;

   --  ------------------------------
   --  Update the hash with the string.
   --  ------------------------------
   procedure Update (E : in out Context;
                     S : in Ada.Streams.Stream_Element_Array) is
   begin
      Util.Encoders.SHA1.Update (E.SHA, S);
   end Update;

   --  ------------------------------
   --  Computes the HMAC-SHA1 with the private key and the data collected by
   --  the Update procedures.  Returns the raw binary hash in Hash.
   --  ------------------------------
   procedure Finish (E    : in out Context;
                     Hash : out Util.Encoders.SHA1.Hash_Array) is
      use type Ada.Streams.Stream_Element;
      use type Ada.Streams.Stream_Element_Offset;
   begin
      Util.Encoders.SHA1.Finish (E.SHA, Hash);

      --  Hash the key in the SHA1 context.
      declare
         Block : Ada.Streams.Stream_Element_Array (0 .. 63);
      begin
         for I in 0 .. E.Key_Len loop
            Block (I) := OPAD xor E.Key (I);
         end loop;
         if E.Key_Len < 63 then
            for I in E.Key_Len + 1 .. 63 loop
               Block (I) := OPAD;
            end loop;
         end if;
         Util.Encoders.SHA1.Update (E.SHA, Block);
      end;
      Util.Encoders.SHA1.Update (E.SHA, Hash);
      Util.Encoders.SHA1.Finish (E.SHA, Hash);
   end Finish;

   --  ------------------------------
   --  Computes the HMAC-SHA1 with the private key and the data collected by
   --  the Update procedures.  Returns the hexadecimal hash in Hash.
   --  ------------------------------
   procedure Finish (E    : in out Context;
                     Hash : out Util.Encoders.SHA1.Digest) is
      Buf : Ada.Streams.Stream_Element_Array (1 .. Hash'Length);
      for Buf'Address use Hash'Address;
      pragma Import (Ada, Buf);

      H       : Util.Encoders.SHA1.Hash_Array;
      B       : Util.Encoders.Base16.Encoder;
      Last    : Ada.Streams.Stream_Element_Offset;
      Encoded : Ada.Streams.Stream_Element_Offset;
   begin
      Finish (E, H);
      B.Transform (Data => H, Into => Buf, Last => Last, Encoded => Encoded);
   end Finish;

   --  ------------------------------
   --  Computes the HMAC-SHA1 with the private key and the data collected by
   --  the Update procedures.  Returns the base64 hash in Hash.
   --  When URL is True, use the base64 URL alphabet to encode in base64.
   --  ------------------------------
   procedure Finish_Base64 (E    : in out Context;
                            Hash : out Util.Encoders.SHA1.Base64_Digest;
                            URL  : in Boolean := False) is
      Buf : Ada.Streams.Stream_Element_Array (1 .. Hash'Length);
      for Buf'Address use Hash'Address;
      pragma Import (Ada, Buf);

      H       : Util.Encoders.SHA1.Hash_Array;
      B       : Util.Encoders.Base64.Encoder;
      Last    : Ada.Streams.Stream_Element_Offset;
      Encoded : Ada.Streams.Stream_Element_Offset;
   begin
      Finish (E, H);
      B.Set_URL_Mode (URL);
      B.Transform (Data => H, Into => Buf, Last => Last, Encoded => Encoded);
   end Finish_Base64;

   --  Encodes the binary input stream represented by Data into
   --  an SHA-1 hash output stream Into.
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   overriding
   procedure Transform (E       : in out Encoder;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset) is
   begin
      null;
   end Transform;

   --  Initialize the SHA-1 context.
   overriding
   procedure Initialize (E : in out Context) is
   begin
      null;
   end Initialize;

end Util.Encoders.HMAC.SHA1;

Change the Transformer interface to accept in out parameter for the Transformer


-----------------------------------------------------------------------
--  Memory clients - Client info related to its memory
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with MAT.Frames;
with Util.Events;
with MAT.Memory.Events;
with MAT.Readers;
with Ada.Containers.Ordered_Maps;
package MAT.Memory.Targets is

   type Target_Memory is record
      Reader        : MAT.Readers.Reader_Access;
      Memory_Slots  : Allocation_Map;
      Frames        : MAT.Frames.Frame_Type;
--        Event_Channel : MAT.Memory.Events.Memory_Event_Channel.Channel;
   end record;
   type Client_Memory_Ref is access all Target_Memory;

   --  Initialize the target memory object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory events.
   procedure Initialize (Memory : in out Target_Memory;
                         Reader : in out MAT.Readers.Manager_Base'Class);

   type Size_Info_Type is record
      Count : Natural;
   end record;

   use type MAT.Types.Target_Size;

   package Size_Info_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type => MAT.Types.Target_Size,
                                      Element_Type => Size_Info_Type);
   subtype Size_Info_Map is Size_Info_Maps.Map;
   subtype Size_Info_Cursor is Size_Info_Maps.Cursor;

   --  Collect the information about memory slot sizes allocated by the application.
   procedure Size_Information (Memory : in Target_Memory;
                               Sizes  : in out Size_Info_Map);

end MAT.Memory.Targets;

-----------------------------------------------------------------------
--  Memory clients - Client info related to its memory
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with MAT.Frames;
with Util.Events;
with MAT.Memory.Events;
with MAT.Readers;
with Ada.Containers.Ordered_Maps;
package MAT.Memory.Targets is

   type Target_Memory is limited record
      Reader        : MAT.Readers.Reader_Access;
      Memory_Slots  : Allocation_Map;
      Frames        : MAT.Frames.Frame_Type;
--        Event_Channel : MAT.Memory.Events.Memory_Event_Channel.Channel;
   end record;
   type Client_Memory_Ref is access all Target_Memory;

   --  Initialize the target memory object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory events.
   procedure Initialize (Memory : in out Target_Memory;
                         Reader : in out MAT.Readers.Manager_Base'Class);

   type Size_Info_Type is record
      Count : Natural;
   end record;

   use type MAT.Types.Target_Size;

   package Size_Info_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type => MAT.Types.Target_Size,
                                      Element_Type => Size_Info_Type);
   subtype Size_Info_Map is Size_Info_Maps.Map;
   subtype Size_Info_Cursor is Size_Info_Maps.Cursor;

   --  Collect the information about memory slot sizes allocated by the application.
   procedure Size_Information (Memory : in Target_Memory;
                               Sizes  : in out Size_Info_Map);

private

   protected type Memory_Allocator is

      --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
      --  in the used slots map.  The freed slots that intersect the malloc'ed region are
      --  removed from the freed map.
      procedure Probe_Malloc (Addr   : in MAT.Types.Target_Addr;
                              Slot   : in Allocation);

   private
      Used_Slots    : Allocation_Map;
      Freed_Slots   : Allocation_Map;
      Frames        : MAT.Frames.Frame_Type;
   end Memory_Allocator;

end MAT.Memory.Targets;

Define the Memory_Allocator protected and private type. Define the Probe_Malloc operation for the protected type.


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

with Util.Tests;

package Util.Streams.Texts.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

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

   --  Test reading a text stream.
   procedure Test_Read_Line (T : in out Test);

end Util.Streams.Texts.Tests;

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

with Util.Tests;

package Util.Streams.Texts.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

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

   --  Test reading a text stream.
   procedure Test_Read_Line (T : in out Test);

   --  Write on a text stream converting an integer and writing it.
   procedure Test_Write_Integer (T : in out Test);

end Util.Streams.Texts.Tests;

Add Test_Write_Integer procedure

Add Test_Write_Integer procedure