-----------------------------------------------------------------------
--  serialize-io-json-tests -- Unit tests for JSON parser
--  Copyright (C) 2011, 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.Streams.Stream_IO;
with Ada.Characters.Wide_Wide_Latin_1;
with Ada.Calendar.Formatting;

with Util.Test_Caller;
with Util.Log.Loggers;
with Util.Streams.Files;
with Util.Beans.Objects.Readers;

package body Util.Serialize.IO.JSON.Tests is

   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("Util.Serialize.IO.JSON");

   package Caller is new Util.Test_Caller (Test, "Serialize.IO.JSON");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.JSON.Parse (parse errors)",
                       Test_Parse_Error'Access);
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.JSON.Parse (parse Ok)",
                       Test_Parser'Access);
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.JSON.Write",
                       Test_Output'Access);
   end Add_Tests;

   --  ------------------------------
   --  Check various JSON parsing errors.
   --  ------------------------------
   procedure Test_Parse_Error (T : in out Test) is
      pragma Unreferenced (T);
      procedure Check_Parse_Error (Content : in String);

      procedure Check_Parse_Error (Content : in String) is
         P : Parser;
         R : Util.Beans.Objects.Readers.Reader;
      begin
         P.Parse_String (Content, R);
         Log.Error ("No exception raised for: {0}", Content);

      exception
         when Parse_Error =>
            null;
      end Check_Parse_Error;

   begin
      Check_Parse_Error ("{ ""person"":23");
      Check_Parse_Error ("{ person: 23]");
      Check_Parse_Error ("[ }");
      Check_Parse_Error ("{[]}");
      Check_Parse_Error ("{");
      Check_Parse_Error ("{[");
      Check_Parse_Error ("{ ""person");
      Check_Parse_Error ("{ ""person"":");
      Check_Parse_Error ("{ ""person"":""asf");
      Check_Parse_Error ("{ ""person"":""asf""");
      Check_Parse_Error ("{ ""person"":""asf"",");
      Check_Parse_Error ("{ ""person"":""\uze""}");
      Check_Parse_Error ("{ ""person"":""\u012-""}");
      Check_Parse_Error ("{ ""person"":""\u012G""}");
   end Test_Parse_Error;

   --  ------------------------------
   --  Check various (basic) JSON valid strings (no mapper).
   --  ------------------------------
   procedure Test_Parser (T : in out Test) is
      pragma Unreferenced (T);
      procedure Check_Parse (Content : in String);

      procedure Check_Parse (Content : in String) is
         P : Parser;
         R : Util.Beans.Objects.Readers.Reader;
      begin
         P.Parse_String (Content, R);

      exception
         when Parse_Error =>
            Log.Error ("Parse error for: " & Content);
            raise;
      end Check_Parse;

   begin
      Check_Parse ("{ ""person"":23}");
      Check_Parse ("{ }");
      Check_Parse ("{""person"":""asf""}");
      Check_Parse ("{""person"":""asf"",""age"":""2""}");
      Check_Parse ("{ ""person"":""\u0123""}");
      Check_Parse ("{ ""person"":""\u4567""}");
      Check_Parse ("{ ""person"":""\u89ab""}");
      Check_Parse ("{ ""person"":""\ucdef""}");
      Check_Parse ("{ ""person"":""\u1CDE""}");
      Check_Parse ("{ ""person"":""\u2ABF""}");
      Check_Parse ("[{ ""person"":""\u2ABF""}]");
   end Test_Parser;

   --  ------------------------------
   --  Generate some output stream for the test.
   --  ------------------------------
   procedure Write_Stream (Stream : in out Util.Serialize.IO.Output_Stream'Class) is
      Name : Ada.Strings.Unbounded.Unbounded_String;
      Wide : constant Wide_Wide_String :=
        Ada.Characters.Wide_Wide_Latin_1.CR &
        Ada.Characters.Wide_Wide_Latin_1.LF &
        Ada.Characters.Wide_Wide_Latin_1.HT &
        Wide_Wide_Character'Val (16#080#) &
        Wide_Wide_Character'Val (16#1fC#) &
        Wide_Wide_Character'Val (16#20AC#) & -- Euro sign
        Wide_Wide_Character'Val (16#2acbf#);
      T : constant Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (2011, 11, 19, 23, 0, 0);
   begin
      Ada.Strings.Unbounded.Append (Name, "Katniss Everdeen");
      Stream.Start_Document;
      Stream.Start_Entity ("root");
      Stream.Start_Entity ("person");
      Stream.Write_Attribute ("id", 1);
      Stream.Write_Attribute ("name", Name);
      Stream.Write_Entity ("name", Name);
      Stream.Write_Entity ("gender", "female");
      Stream.Write_Entity ("volunteer", True);
      Stream.Write_Entity ("age", 17);
      Stream.Write_Entity ("date", T);
      Stream.Write_Wide_Entity ("skin", "olive skin");
      Stream.Start_Array ("badges");

      Stream.Start_Entity ("badge");
      Stream.Write_Entity ("level", "gold");
      Stream.Write_Entity ("name", "hunter");
      Stream.End_Entity ("badge");

      Stream.Start_Entity ("badge");
      Stream.Write_Entity ("level", "gold");
      Stream.Write_Entity ("name", "archery");
      Stream.End_Entity ("badge");
      Stream.End_Array ("badges");

      Stream.Start_Entity ("district");
      Stream.Write_Attribute ("id", 12);
      Stream.Write_Wide_Attribute ("industry", "Coal mining");
      Stream.Write_Attribute ("state", "<destroyed>");
      Stream.Write_Long_Entity ("members", 10_000);
      Stream.Write_Entity ("description", "<TBW>&""");
      Stream.Write_Wide_Entity ("wescape", "'""<>&;,@!`~[]{}^%*()-+=");
      Stream.Write_Entity ("escape", "'""<>&;,@!`~\[]{}^%*()-+=");
      Stream.Write_Wide_Entity ("wide", Wide);
      Stream.End_Entity ("district");

      Stream.End_Entity ("person");
      Stream.End_Entity ("root");
      Stream.End_Document;
   end Write_Stream;

   --  ------------------------------
   --  Test the JSON output stream generation.
   --  ------------------------------
   procedure Test_Output (T : in out Test) is
      File   : aliased Util.Streams.Files.File_Stream;
      Buffer : aliased Util.Streams.Texts.Print_Stream;
      Stream : Util.Serialize.IO.JSON.Output_Stream;
      Expect : constant String := Util.Tests.Get_Path ("regtests/expect/test-stream.json");
      Path   : constant String := Util.Tests.Get_Test_Path ("regtests/result/test-stream.json");
   begin
      File.Create (Mode => Ada.Streams.Stream_IO.Out_File, Name => Path);
      Buffer.Initialize (Output => File'Unchecked_Access, Input => null, Size => 10000);
      Stream.Initialize (Output => Buffer'Unchecked_Access);
      Write_Stream (Stream);
      Stream.Close;
      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => Expect,
                                     Test    => Path,
                                     Message => "JSON output serialization");
   end Test_Output;

end Util.Serialize.IO.JSON.Tests;

-----------------------------------------------------------------------
--  serialize-io-json-tests -- Unit tests for JSON parser
--  Copyright (C) 2011, 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.Streams.Stream_IO;
with Ada.Characters.Wide_Wide_Latin_1;
with Ada.Calendar.Formatting;

with Util.Test_Caller;
with Util.Log.Loggers;
with Util.Streams.Files;
with Util.Beans.Objects.Readers;

package body Util.Serialize.IO.JSON.Tests is

   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("Util.Serialize.IO.JSON");

   package Caller is new Util.Test_Caller (Test, "Serialize.IO.JSON");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.JSON.Parse (parse errors)",
                       Test_Parse_Error'Access);
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.JSON.Parse (parse Ok)",
                       Test_Parser'Access);
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.JSON.Write",
                       Test_Output'Access);
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.JSON.Read",
                       Test_Read'Access);
   end Add_Tests;

   --  ------------------------------
   --  Check various JSON parsing errors.
   --  ------------------------------
   procedure Test_Parse_Error (T : in out Test) is
      pragma Unreferenced (T);
      procedure Check_Parse_Error (Content : in String);

      procedure Check_Parse_Error (Content : in String) is
         P : Parser;
         R : Util.Beans.Objects.Readers.Reader;
      begin
         P.Parse_String (Content, R);
         Log.Error ("No exception raised for: {0}", Content);

      exception
         when Parse_Error =>
            null;
      end Check_Parse_Error;

   begin
      Check_Parse_Error ("{ ""person"":23");
      Check_Parse_Error ("{ person: 23]");
      Check_Parse_Error ("[ }");
      Check_Parse_Error ("{[]}");
      Check_Parse_Error ("{");
      Check_Parse_Error ("{[");
      Check_Parse_Error ("{ ""person");
      Check_Parse_Error ("{ ""person"":");
      Check_Parse_Error ("{ ""person"":""asf");
      Check_Parse_Error ("{ ""person"":""asf""");
      Check_Parse_Error ("{ ""person"":""asf"",");
      Check_Parse_Error ("{ ""person"":""\uze""}");
      Check_Parse_Error ("{ ""person"":""\u012-""}");
      Check_Parse_Error ("{ ""person"":""\u012G""}");
   end Test_Parse_Error;

   --  ------------------------------
   --  Check various (basic) JSON valid strings (no mapper).
   --  ------------------------------
   procedure Test_Parser (T : in out Test) is
      pragma Unreferenced (T);
      procedure Check_Parse (Content : in String);

      procedure Check_Parse (Content : in String) is
         P : Parser;
         R : Util.Beans.Objects.Readers.Reader;
      begin
         P.Parse_String (Content, R);

      exception
         when Parse_Error =>
            Log.Error ("Parse error for: " & Content);
            raise;
      end Check_Parse;

   begin
      Check_Parse ("{ ""person"":23}");
      Check_Parse ("{ }");
      Check_Parse ("{""person"":""asf""}");
      Check_Parse ("{""person"":""asf"",""age"":""2""}");
      Check_Parse ("{ ""person"":""\u0123""}");
      Check_Parse ("{ ""person"":""\u4567""}");
      Check_Parse ("{ ""person"":""\u89ab""}");
      Check_Parse ("{ ""person"":""\ucdef""}");
      Check_Parse ("{ ""person"":""\u1CDE""}");
      Check_Parse ("{ ""person"":""\u2ABF""}");
      Check_Parse ("[{ ""person"":""\u2ABF""}]");
   end Test_Parser;

   --  ------------------------------
   --  Generate some output stream for the test.
   --  ------------------------------
   procedure Write_Stream (Stream : in out Util.Serialize.IO.Output_Stream'Class) is
      Name : Ada.Strings.Unbounded.Unbounded_String;
      Wide : constant Wide_Wide_String :=
        Ada.Characters.Wide_Wide_Latin_1.CR &
        Ada.Characters.Wide_Wide_Latin_1.LF &
        Ada.Characters.Wide_Wide_Latin_1.HT &
        Wide_Wide_Character'Val (16#080#) &
        Wide_Wide_Character'Val (16#1fC#) &
        Wide_Wide_Character'Val (16#20AC#) & -- Euro sign
        Wide_Wide_Character'Val (16#2acbf#);
      T : constant Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (2011, 11, 19, 23, 0, 0);
   begin
      Ada.Strings.Unbounded.Append (Name, "Katniss Everdeen");
      Stream.Start_Document;
      Stream.Start_Entity ("root");
      Stream.Start_Entity ("person");
      Stream.Write_Attribute ("id", 1);
      Stream.Write_Attribute ("name", Name);
      Stream.Write_Entity ("name", Name);
      Stream.Write_Entity ("gender", "female");
      Stream.Write_Entity ("volunteer", True);
      Stream.Write_Entity ("age", 17);
      Stream.Write_Entity ("date", T);
      Stream.Write_Wide_Entity ("skin", "olive skin");
      Stream.Start_Array ("badges");

      Stream.Start_Entity ("badge");
      Stream.Write_Entity ("level", "gold");
      Stream.Write_Entity ("name", "hunter");
      Stream.End_Entity ("badge");

      Stream.Start_Entity ("badge");
      Stream.Write_Entity ("level", "gold");
      Stream.Write_Entity ("name", "archery");
      Stream.End_Entity ("badge");
      Stream.End_Array ("badges");

      Stream.Start_Entity ("district");
      Stream.Write_Attribute ("id", 12);
      Stream.Write_Wide_Attribute ("industry", "Coal mining");
      Stream.Write_Attribute ("state", "<destroyed>");
      Stream.Write_Long_Entity ("members", 10_000);
      Stream.Write_Entity ("description", "<TBW>&""");
      Stream.Write_Wide_Entity ("wescape", "'""<>&;,@!`~[]{}^%*()-+=");
      Stream.Write_Entity ("escape", "'""<>&;,@!`~\[]{}^%*()-+=");
      Stream.Write_Wide_Entity ("wide", Wide);
      Stream.End_Entity ("district");

      Stream.End_Entity ("person");
      Stream.End_Entity ("root");
      Stream.End_Document;
   end Write_Stream;

   --  ------------------------------
   --  Test the JSON output stream generation.
   --  ------------------------------
   procedure Test_Output (T : in out Test) is
      File   : aliased Util.Streams.Files.File_Stream;
      Buffer : aliased Util.Streams.Texts.Print_Stream;
      Stream : Util.Serialize.IO.JSON.Output_Stream;
      Expect : constant String := Util.Tests.Get_Path ("regtests/expect/test-stream.json");
      Path   : constant String := Util.Tests.Get_Test_Path ("regtests/result/test-stream.json");
   begin
      File.Create (Mode => Ada.Streams.Stream_IO.Out_File, Name => Path);
      Buffer.Initialize (Output => File'Unchecked_Access, Input => null, Size => 10000);
      Stream.Initialize (Output => Buffer'Unchecked_Access);
      Write_Stream (Stream);
      Stream.Close;
      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => Expect,
                                     Test    => Path,
                                     Message => "JSON output serialization");
   end Test_Output;

   --  ------------------------------
   --  Test reading a JSON content into an Object tree.
   --  ------------------------------
   procedure Test_Read (T : in out Test) is
      use Util.Beans.Objects;
      Path  : constant String := Util.Tests.Get_Test_Path ("regtests/files/pass01.json");
      Root  : Util.Beans.Objects.Object;
      Value : Util.Beans.Objects.Object;
      Item  : Util.Beans.Objects.Object;
   begin
      Root := Read (Path);
      T.Assert (not Util.Beans.Objects.Is_Null (Root), "Read should not return null object");
      T.Assert (Util.Beans.Objects.Is_Array (Root), "Root object is an array");

      Value := Util.Beans.Objects.Get_Value (Root, 1);
      Util.Tests.Assert_Equals (T, "JSON Test Pattern pass1",
                                Util.Beans.Objects.To_String (Value), "Invalid first element");
      Value := Util.Beans.Objects.Get_Value (Root, 4);
      T.Assert (Util.Beans.Objects.Is_Array (Value), "Element 4 should be an empty array");
      Util.Tests.Assert_Equals (T, 0, Util.Beans.Objects.Get_Count (Value), "Invalid array");

      Value := Util.Beans.Objects.Get_Value (Root, 8);
      T.Assert (Util.Beans.Objects.Is_Null (Value), "Element 8 should be null");

      Value := Util.Beans.Objects.Get_Value (Root, 9);
      T.Assert (not Util.Beans.Objects.Is_Null (Value), "Element 9 should not be null");

      Item := Util.Beans.Objects.Get_Value (Value, "integer");
      Util.Tests.Assert_Equals (T, 1234567890, Util.Beans.Objects.To_Integer (Item),
                                "Invalid integer value");

      Item := Util.Beans.Objects.Get_Value (Value, "zero");
      Util.Tests.Assert_Equals (T, 0, Util.Beans.Objects.To_Integer (Item),
                                "Invalid integer value (0)");

      Item := Util.Beans.Objects.Get_Value (Value, "one");
      Util.Tests.Assert_Equals (T, 1, Util.Beans.Objects.To_Integer (Item),
                                "Invalid integer value (1)");

      Item := Util.Beans.Objects.Get_Value (Value, "true");
      T.Assert (Util.Beans.Objects.Get_Type (Item) = TYPE_BOOLEAN,
                "The value true should be a boolean");
      T.Assert (Util.Beans.Objects.To_Boolean (Item),
                "The value true should be... true!");

      Item := Util.Beans.Objects.Get_Value (Value, "false");
      T.Assert (Util.Beans.Objects.Get_Type (Item) = TYPE_BOOLEAN,
                "The value false should be a boolean");
      T.Assert (not Util.Beans.Objects.To_Boolean (Item),
                "The value false should be... false!");

      Item := Util.Beans.Objects.Get_Value (Value, " s p a c e d ");
      T.Assert (Is_Array (Item), "The value should be an array");
      for I in 1 .. 7 loop
         Util.Tests.Assert_Equals (T, I, To_Integer (Get_Value (Item, I)),
                                   "Invalid array value at " & Integer'Image (I));
      end loop;
   end Test_Read;

end Util.Serialize.IO.JSON.Tests;

Add a new unit test to verify the Read procedure that parses a JSON file and return an object tree Verify that the object tree contains the expected objects


-----------------------------------------------------------------------
--  Wiki testsuite - Ada Wiki Test suite
--  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.Parsers.Tests;
with Wiki.Writers.Tests;
with Wiki.Filters.Html.Tests;
package body Wiki.Testsuite is

   Tests : aliased Util.Tests.Test_Suite;

   function Suite return Util.Tests.Access_Test_Suite is
      Ret : constant Util.Tests.Access_Test_Suite := Tests'Access;
   begin
      Wiki.Filters.Html.Tests.Add_Tests (Ret);
      Wiki.Parsers.Tests.Add_Tests (Ret);
      Wiki.Writers.Tests.Add_Tests (Ret);
      return Ret;
   end Suite;

end Wiki.Testsuite;

-----------------------------------------------------------------------
--  Wiki testsuite - Ada Wiki Test suite
--  Copyright (C) 2015, 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 Wiki.Parsers.Tests;
with Wiki.Tests;
with Wiki.Filters.Html.Tests;
package body Wiki.Testsuite is

   Tests : aliased Util.Tests.Test_Suite;

   function Suite return Util.Tests.Access_Test_Suite is
      Ret : constant Util.Tests.Access_Test_Suite := Tests'Access;
   begin
      Wiki.Filters.Html.Tests.Add_Tests (Ret);
      Wiki.Parsers.Tests.Add_Tests (Ret);
      Wiki.Tests.Add_Tests (Ret);
      return Ret;
   end Suite;

end Wiki.Testsuite;

Update the testsuite

Update the testsuite


-----------------------------------------------------------------------
--  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 ASF.Requests;
with ASF.Responses;
with ASF.Server;
with Ada.IO_Exceptions;
with Ada.Unchecked_Deallocation;

with Util.Files;
with Util.Strings;

with EL.Contexts.Default;

with AWA.Modules.Reader;
with AWA.Applications;
package body AWA.Modules is

   --  ------------------------------
   --  Receive an event from the event channel
   --  ------------------------------
   procedure Receive_Event (Sub  : in out Module_Subscriber;
                            Item : in Util.Events.Event'Class) is
   begin
      Sub.Module.Receive_Event (ASF.Events.Modules.Module_Event'Class (Item));
   end Receive_Event;

   --  ------------------------------
   --  Get the module name
   --  ------------------------------
   function Get_Name (Plugin : Module) return String is
   begin
      return To_String (Plugin.Name);
   end Get_Name;

   --  ------------------------------
   --  Get the base URI for this module
   --  ------------------------------
   function Get_URI (Plugin : Module) return String is
   begin
      return To_String (Plugin.URI);
   end Get_URI;

   --  ------------------------------
   --  Get the application in which this module is registered.
   --  ------------------------------
   function Get_Application (Plugin : in Module) return Application_Access is
   begin
      return Plugin.App;
   end Get_Application;

   --  ------------------------------
   --  Get the module configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   --  ------------------------------
   function Get_Config (Plugin  : Module;
                        Name    : String;
                        Default : String := "") return String is
   begin
      return Plugin.Config.Get (Name, Default);
   end Get_Config;

   --  ------------------------------
   --  Get the event subscribers for a given event name.
   --  ------------------------------
   function Get_Subscribers (Plugin : in Module;
                             Event  : in String) return String is
      Subscribers : constant String := Plugin.Get_Config ("event.publish." & Event, "");
   begin
      if Subscribers'Length > 0 then
         return Subscribers;
      else
         return Plugin.Get_Config ("event.publish", "");
      end if;
   end Get_Subscribers;

   --  ------------------------------
   --  Send the event to the module
   --  ------------------------------
   procedure Send_Event (Plugin  : in Module;
                         To      : in String;
                         Content : in ASF.Events.Modules.Module_Event'Class) is
      Subscribers : constant String := Plugin.Get_Subscribers (To);
      Target      : Module_Access;
      Last_Pos    : Natural := Subscribers'First;
      Pos         : Natural;
   begin
      while Last_Pos < Subscribers'Last loop
         Pos := Util.Strings.Index (Source => Subscribers,
                                    Char   => ',',
                                    From   => Last_Pos);
         if Pos = 0 then
            Pos := Subscribers'Last + 1;
         end if;
         exit when Last_Pos = Pos;
         Target := Plugin.Find_Module (Subscribers (Last_Pos .. Pos - 1));
         if Target = null then
            Log.Warn ("Event {0} cannot be sent to missing module {1}",
                      To, Subscribers (Last_Pos .. Pos - 1));
            return;
         end if;
         Target.Channel.Post (Content);
         Last_Pos := Pos + 1;
      end loop;
   end Send_Event;

   --  ------------------------------
   --  Receive an event sent by another module with Send_Event method.
   --  ------------------------------
   procedure Receive_Event (Plugin  : in out Module;
                            Content : in ASF.Events.Modules.Module_Event'Class) is
   begin
      null;
   end Receive_Event;

   --  ------------------------------
   --  Find the module with the given name
   --  ------------------------------
   function Find_Module (Plugin : Module;
                         Name   : String) return Module_Access is
   begin
      if Plugin.Registry = null then
         return null;
      end if;
      return Find_By_Name (Plugin.Registry.all, Name);
   end Find_Module;

   --  ------------------------------
   --  Register under the given name a function to create the bean instance when
   --  it is accessed for a first time.  The scope defines the scope of the bean.
   --  bean
   --  ------------------------------
   procedure Register (Plugin : in out Module;
                       Name    : in String;
                       Bind    : in ASF.Beans.Class_Binding_Access) is
   begin
      --        ASF.Beans.Register_Class (Plugin.Factory, Name, Bind);
      Plugin.App.Register_Class (Name, Bind);
   end Register;

   --  ------------------------------
   --  Finalize the module.
   --  ------------------------------
   overriding
   procedure Finalize (Plugin : in out Module) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => Util.Events.Channels.Channel'Class,
                                        Name   => Util.Events.Channels.Channel_Access);
   begin
      Free (Plugin.Channel);
   end Finalize;

   procedure Initialize (Manager : in out Module_Manager;
                         Module  : in AWA.Modules.Module'Class) is
   begin
      Manager.Module := Module.Self;
   end Initialize;

   function Get_Value (Manager : in Module_Manager;
                       Name    : in String) return Util.Beans.Objects.Object is
      pragma Unreferenced (Manager, Name);
   begin
      return Util.Beans.Objects.Null_Object;
   end Get_Value;

   --  Module manager
   --
   --  ------------------------------
   --  Get the database connection for reading
   --  ------------------------------
   function Get_Session (Manager : Module_Manager)
                            return ADO.Sessions.Session is
   begin
      return Manager.Module.Get_Session;
   end Get_Session;

   --  ------------------------------
   --  Get the database connection for writing
   --  ------------------------------
   function Get_Master_Session (Manager : Module_Manager)
                                   return ADO.Sessions.Master_Session is
   begin
      return Manager.Module.Get_Master_Session;
   end Get_Master_Session;

   --  ------------------------------
   --  Send the event to the module.  The module identified by To is
   --  found and the event is posted on its event channel.
   --  ------------------------------
   procedure Send_Event (Manager : in Module_Manager;
                         To      : in String;
                         Content : in ASF.Events.Modules.Module_Event'Class) is
   begin
      Manager.Module.Send_Event (To, Content);
   end Send_Event;

   procedure Initialize (Plugin : in out Module;
                         App    : in Application_Access) is
   begin
      Plugin.Self := Plugin'Unchecked_Access;
      --        ASF.Modules.Module (Plugin).Initialize (App);
      Plugin.App := App;
   end Initialize;

   --  ------------------------------
   --  Initialize the registry
   --  ------------------------------
   procedure Initialize (Registry : in out Module_Registry;
                         Config   : in ASF.Applications.Config) is
   begin
      Registry.Config := Config;
   end Initialize;

   --  ------------------------------
   --  Register the module in the registry.
   --  ------------------------------
   procedure Register (Registry : in Module_Registry_Access;
                       App      : in Application_Access;
                       Plugin   : in Module_Access;
                       Name     : in String;
                       URI      : in String) is
      Paths : constant String := Registry.Config.Get ("app.modules.dir", "./config");
   begin
      Log.Info ("Register module '{0}' under URI '{1}'", Name, URI);

      if Plugin.Registry /= null then
         Log.Error ("Module '{0}' is already attached to a registry", Name);

         raise Program_Error with "Module '" & Name & "' already registered";
      end if;
      Plugin.App      := App;
      Plugin.Registry := Registry;
      Plugin.Name     := To_Unbounded_String (Name);
      Plugin.URI      := To_Unbounded_String (URI);
      Plugin.Subscriber.Module := Plugin;
      Plugin.Registry.Name_Map.Insert (Name, Plugin);
      if URI /= "" then
         Plugin.Registry.URI_Map.Insert (URI, Plugin);
      end if;

      --  Load the module configuration file
      Log.Debug ("Module search path: {0}", Paths);
      declare
         Base  : constant String := Name & ".properties";
         Path  : constant String := Util.Files.Find_File_Path (Base, Paths);
      begin
         Plugin.Config.Load_Properties (Path => Path, Prefix => Name & ".", Strip => True);

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

      --  Override the module configuration with the application configuration
      Plugin.Config.Copy (From => Registry.Config, Prefix => Name & ".", Strip => True);

      --  Configure the event channels for this module
      declare
         Kind : constant String := Plugin.Config.Get ("channel.type", "direct");
      begin
         Plugin.Channel := Util.Events.Channels.Create (Name, Kind);
         Plugin.Channel.Subscribe (Plugin.Subscriber'Access);
      end;

      Plugin.Initialize (App);

      --  Read the module XML configuration file if there is one.
      declare
         Base : constant String := Plugin.Config.Get ("config", Name & ".xml");
         Path : constant String := Util.Files.Find_File_Path (Base, Paths);
         Ctx  : aliased EL.Contexts.Default.Default_Context;
      begin
         AWA.Modules.Reader.Read_Configuration (Plugin.all, Path, Ctx'Unchecked_Access);

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

   exception
      when Constraint_Error =>
         Log.Error ("Another module is already registered "
                    & "under name '{0}' or URI '{1}'", Name, URI);
         raise;
   end Register;

   --  ------------------------------
   --  Find the module with the given name
   --  ------------------------------
   function Find_By_Name (Registry : Module_Registry;
                          Name     : String) return Module_Access is
      Pos : constant Module_Maps.Cursor := Module_Maps.Find (Registry.Name_Map, Name);
   begin
      if Module_Maps.Has_Element (Pos) then
         return Module_Maps.Element (Pos);
      end if;
      return null;
   end Find_By_Name;

   --  ------------------------------
   --  Find the module mapped to a given URI
   --  ------------------------------
   function Find_By_URI (Registry : Module_Registry;
                         URI      : String) return Module_Access is
      Pos : constant Module_Maps.Cursor := Module_Maps.Find (Registry.URI_Map, URI);
   begin
      if Module_Maps.Has_Element (Pos) then
         return Module_Maps.Element (Pos);
      end if;
      return null;
   end Find_By_URI;

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

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

   --  Get per request manager => look in Request
   --  Get per session manager => look in Request.Get_Session
   --  Get per application manager => look in Application
   --  Get per pool manager => look in pool attached to Application
   function Get_Manager return Manager_Type_Access is

      Value : Util.Beans.Objects.Object;

      procedure Process (Request  : in out ASF.Requests.Request'Class;
                         Response : in out ASF.Responses.Response'Class) is
         pragma Unreferenced (Response);
      begin
         Value := Request.Get_Attribute (Name);
         if Util.Beans.Objects.Is_Null (Value) then
            declare
               M : constant Manager_Type_Access := new Manager_Type;
            begin
               Value := Util.Beans.Objects.To_Object (M.all'Access);
               Request.Set_Attribute (Name, Value);
            end;
         end if;
      end Process;

   begin
      ASF.Server.Update_Context (Process'Access);
      if Util.Beans.Objects.Is_Null (Value) then
         return null;
      end if;
      declare
         B : constant access Util.Beans.Basic.Readonly_Bean'Class
           := Util.Beans.Objects.To_Bean (Value);
      begin
         if not (B.all in Manager_Type'Class) then
            return null;
         end if;
         return Manager_Type'Class (B.all)'Unchecked_Access;
      end;
   end Get_Manager;

end AWA.Modules;

-----------------------------------------------------------------------
--  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 ASF.Requests;
with ASF.Responses;
with ASF.Server;
with Ada.IO_Exceptions;
with Ada.Unchecked_Deallocation;

with Util.Files;
with Util.Strings;

with EL.Contexts.Default;

with AWA.Modules.Reader;
with AWA.Applications;
package body AWA.Modules is

   --  ------------------------------
   --  Receive an event from the event channel
   --  ------------------------------
   procedure Receive_Event (Sub  : in out Module_Subscriber;
                            Item : in Util.Events.Event'Class) is
   begin
      Sub.Module.Receive_Event (ASF.Events.Modules.Module_Event'Class (Item));
   end Receive_Event;

   --  ------------------------------
   --  Get the module name
   --  ------------------------------
   function Get_Name (Plugin : Module) return String is
   begin
      return To_String (Plugin.Name);
   end Get_Name;

   --  ------------------------------
   --  Get the base URI for this module
   --  ------------------------------
   function Get_URI (Plugin : Module) return String is
   begin
      return To_String (Plugin.URI);
   end Get_URI;

   --  ------------------------------
   --  Get the application in which this module is registered.
   --  ------------------------------
   function Get_Application (Plugin : in Module) return Application_Access is
   begin
      return Plugin.App;
   end Get_Application;

   --  ------------------------------
   --  Get the module configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   --  ------------------------------
   function Get_Config (Plugin  : Module;
                        Name    : String;
                        Default : String := "") return String is
   begin
      return Plugin.Config.Get (Name, Default);
   end Get_Config;

   --  ------------------------------
   --  Get the event subscribers for a given event name.
   --  ------------------------------
   function Get_Subscribers (Plugin : in Module;
                             Event  : in String) return String is
      Subscribers : constant String := Plugin.Get_Config ("event.publish." & Event, "");
   begin
      if Subscribers'Length > 0 then
         return Subscribers;
      else
         return Plugin.Get_Config ("event.publish", "");
      end if;
   end Get_Subscribers;

   --  ------------------------------
   --  Send the event to the module
   --  ------------------------------
   procedure Send_Event (Plugin  : in Module;
                         To      : in String;
                         Content : in ASF.Events.Modules.Module_Event'Class) is
      Subscribers : constant String := Plugin.Get_Subscribers (To);
      Target      : Module_Access;
      Last_Pos    : Natural := Subscribers'First;
      Pos         : Natural;
   begin
      while Last_Pos < Subscribers'Last loop
         Pos := Util.Strings.Index (Source => Subscribers,
                                    Char   => ',',
                                    From   => Last_Pos);
         if Pos = 0 then
            Pos := Subscribers'Last + 1;
         end if;
         exit when Last_Pos = Pos;
         Target := Plugin.Find_Module (Subscribers (Last_Pos .. Pos - 1));
         if Target = null then
            Log.Warn ("Event {0} cannot be sent to missing module {1}",
                      To, Subscribers (Last_Pos .. Pos - 1));
            return;
         end if;
         Target.Channel.Post (Content);
         Last_Pos := Pos + 1;
      end loop;
   end Send_Event;

   --  ------------------------------
   --  Receive an event sent by another module with Send_Event method.
   --  ------------------------------
   procedure Receive_Event (Plugin  : in out Module;
                            Content : in ASF.Events.Modules.Module_Event'Class) is
   begin
      null;
   end Receive_Event;

   --  ------------------------------
   --  Find the module with the given name
   --  ------------------------------
   function Find_Module (Plugin : Module;
                         Name   : String) return Module_Access is
   begin
      if Plugin.Registry = null then
         return null;
      end if;
      return Find_By_Name (Plugin.Registry.all, Name);
   end Find_Module;

   --  ------------------------------
   --  Register under the given name a function to create the bean instance when
   --  it is accessed for a first time.  The scope defines the scope of the bean.
   --  bean
   --  ------------------------------
   procedure Register (Plugin : in out Module;
                       Name    : in String;
                       Bind    : in ASF.Beans.Class_Binding_Access) is
   begin
      Plugin.App.Register_Class (Name, Bind);
   end Register;

   --  ------------------------------
   --  Finalize the module.
   --  ------------------------------
   overriding
   procedure Finalize (Plugin : in out Module) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => Util.Events.Channels.Channel'Class,
                                        Name   => Util.Events.Channels.Channel_Access);
   begin
      Free (Plugin.Channel);
   end Finalize;

   procedure Initialize (Manager : in out Module_Manager;
                         Module  : in AWA.Modules.Module'Class) is
   begin
      Manager.Module := Module.Self;
   end Initialize;

   function Get_Value (Manager : in Module_Manager;
                       Name    : in String) return Util.Beans.Objects.Object is
      pragma Unreferenced (Manager, Name);
   begin
      return Util.Beans.Objects.Null_Object;
   end Get_Value;

   --  Module manager
   --
   --  ------------------------------
   --  Get the database connection for reading
   --  ------------------------------
   function Get_Session (Manager : Module_Manager)
                            return ADO.Sessions.Session is
   begin
      return Manager.Module.Get_Session;
   end Get_Session;

   --  ------------------------------
   --  Get the database connection for writing
   --  ------------------------------
   function Get_Master_Session (Manager : Module_Manager)
                                   return ADO.Sessions.Master_Session is
   begin
      return Manager.Module.Get_Master_Session;
   end Get_Master_Session;

   --  ------------------------------
   --  Send the event to the module.  The module identified by To is
   --  found and the event is posted on its event channel.
   --  ------------------------------
   procedure Send_Event (Manager : in Module_Manager;
                         To      : in String;
                         Content : in ASF.Events.Modules.Module_Event'Class) is
   begin
      Manager.Module.Send_Event (To, Content);
   end Send_Event;

   procedure Initialize (Plugin : in out Module;
                         App    : in Application_Access) is
   begin
      Plugin.Self := Plugin'Unchecked_Access;
      Plugin.App := App;
   end Initialize;

   --  ------------------------------
   --  Initialize the registry
   --  ------------------------------
   procedure Initialize (Registry : in out Module_Registry;
                         Config   : in ASF.Applications.Config) is
   begin
      Registry.Config := Config;
   end Initialize;

   --  ------------------------------
   --  Register the module in the registry.
   --  ------------------------------
   procedure Register (Registry : in Module_Registry_Access;
                       App      : in Application_Access;
                       Plugin   : in Module_Access;
                       Name     : in String;
                       URI      : in String) is
      Paths : constant String := Registry.Config.Get ("app.modules.dir", "./config");
   begin
      Log.Info ("Register module '{0}' under URI '{1}'", Name, URI);

      if Plugin.Registry /= null then
         Log.Error ("Module '{0}' is already attached to a registry", Name);

         raise Program_Error with "Module '" & Name & "' already registered";
      end if;
      Plugin.App      := App;
      Plugin.Registry := Registry;
      Plugin.Name     := To_Unbounded_String (Name);
      Plugin.URI      := To_Unbounded_String (URI);
      Plugin.Subscriber.Module := Plugin;
      Plugin.Registry.Name_Map.Insert (Name, Plugin);
      if URI /= "" then
         Plugin.Registry.URI_Map.Insert (URI, Plugin);
      end if;

      --  Load the module configuration file
      Log.Debug ("Module search path: {0}", Paths);
      declare
         Base  : constant String := Name & ".properties";
         Path  : constant String := Util.Files.Find_File_Path (Base, Paths);
      begin
         Plugin.Config.Load_Properties (Path => Path, Prefix => Name & ".", Strip => True);

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

      --  Override the module configuration with the application configuration
      Plugin.Config.Copy (From => Registry.Config, Prefix => Name & ".", Strip => True);

      --  Configure the event channels for this module
      declare
         Kind : constant String := Plugin.Config.Get ("channel.type", "direct");
      begin
         Plugin.Channel := Util.Events.Channels.Create (Name, Kind);
         Plugin.Channel.Subscribe (Plugin.Subscriber'Access);
      end;

      Plugin.Initialize (App);

      --  Read the module XML configuration file if there is one.
      declare
         Base : constant String := Plugin.Config.Get ("config", Name & ".xml");
         Path : constant String := Util.Files.Find_File_Path (Base, Paths);
         Ctx  : aliased EL.Contexts.Default.Default_Context;
      begin
         AWA.Modules.Reader.Read_Configuration (Plugin.all, Path, Ctx'Unchecked_Access);

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

   exception
      when Constraint_Error =>
         Log.Error ("Another module is already registered "
                    & "under name '{0}' or URI '{1}'", Name, URI);
         raise;
   end Register;

   --  ------------------------------
   --  Find the module with the given name
   --  ------------------------------
   function Find_By_Name (Registry : Module_Registry;
                          Name     : String) return Module_Access is
      Pos : constant Module_Maps.Cursor := Module_Maps.Find (Registry.Name_Map, Name);
   begin
      if Module_Maps.Has_Element (Pos) then
         return Module_Maps.Element (Pos);
      end if;
      return null;
   end Find_By_Name;

   --  ------------------------------
   --  Find the module mapped to a given URI
   --  ------------------------------
   function Find_By_URI (Registry : Module_Registry;
                         URI      : String) return Module_Access is
      Pos : constant Module_Maps.Cursor := Module_Maps.Find (Registry.URI_Map, URI);
   begin
      if Module_Maps.Has_Element (Pos) then
         return Module_Maps.Element (Pos);
      end if;
      return null;
   end Find_By_URI;

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

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

   --  Get per request manager => look in Request
   --  Get per session manager => look in Request.Get_Session
   --  Get per application manager => look in Application
   --  Get per pool manager => look in pool attached to Application
   function Get_Manager return Manager_Type_Access is

      Value : Util.Beans.Objects.Object;

      procedure Process (Request  : in out ASF.Requests.Request'Class;
                         Response : in out ASF.Responses.Response'Class) is
         pragma Unreferenced (Response);
      begin
         Value := Request.Get_Attribute (Name);
         if Util.Beans.Objects.Is_Null (Value) then
            declare
               M : constant Manager_Type_Access := new Manager_Type;
            begin
               Value := Util.Beans.Objects.To_Object (M.all'Access);
               Request.Set_Attribute (Name, Value);
            end;
         end if;
      end Process;

   begin
      ASF.Server.Update_Context (Process'Access);
      if Util.Beans.Objects.Is_Null (Value) then
         return null;
      end if;
      declare
         B : constant access Util.Beans.Basic.Readonly_Bean'Class
           := Util.Beans.Objects.To_Bean (Value);
      begin
         if not (B.all in Manager_Type'Class) then
            return null;
         end if;
         return Manager_Type'Class (B.all)'Unchecked_Access;
      end;
   end Get_Manager;

end AWA.Modules;

Update svn:ignore

Update svn:ignore


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

with Ada.Finalization;
with Ada.Strings.Hash;
with Ada.Strings.Unbounded;
with Ada.Containers.Indefinite_Hashed_Maps;

with Util.Log.Loggers;
with Util.Beans.Basic;
with Util.Beans.Objects;
with Util.Serialize.IO;
with Util.Listeners;

with EL.Expressions;

with ASF.Beans;
with ASF.Applications;
with ADO.Sessions;

with AWA.Events;
limited with AWA.Applications;

--  == AWA Modules ==
--  A module is a software component that can be integrated in the
--  web application.  The module can bring a set of service APIs,
--  some Ada beans and some presentation files.  The AWA framework
--  allows to configure various parts of a module when it is integrated
--  in an application.  Some modules are designed to be re-used by
--  several applications (for example a _mail_ module, a _users_
--  module, ...).  Other modules could be specific to an application.
--  An application will be made of several modules, some will be
--  generic some others specific to the application.
--
--  === Registration ===
--  The module should have only one instance per application and it must
--  be registered when the application is initialized.  The module
--  instance should be added to the application record as follows:
--
--    type Application is new AWA.Applications.Application with record
--       Xxx       : aliased Xxx_Module;
--    end record;
--
--  The application record must override the `Initialize_Module` procedure
--  and it must register the module instance.  This is done as follows:
--
--    overriding
--    procedure Initialize_Modules (App : in out Application) is
--    begin
--       Register (App    => App.Self.all'Access,
--                 Name   => Xxx.Module.NAME,
--                 URI    => "xxx",
--                 Module => App.User_Module'Access);
--    end Initialize_Modules;
--
--  The module is registered under a unique name.  That name is used
--  to load the module configuration.
--
--  === Configuration ===
--  The module is configured by using an XML or a properties file.
--  The configuration file is used to define:
--
--    * the Ada beans that the module defines and uses,
--    * the events that the module wants to receive and the action
--      that must be performed when the event is posted,
--    * the permissions that the module needs and how to check them,
--    * the navigation rules which are used for the module web interface,
--    * the servlet and filter mappings used by the module
--
--  The module configuration is located in the *config* directory
--  and must be the name of the module followed by the file extension
--  (example: `module-name`.xml or `module-name`.properties).
--
--
package AWA.Modules is

   type Application_Access is access all AWA.Applications.Application'Class;

   --  ------------------------------
   --  Module manager
   --  ------------------------------
   --
   --  The Module_Manager represents the root of the logic manager
   type Module_Manager is new Ada.Finalization.Limited_Controlled
     and Util.Beans.Basic.Readonly_Bean with private;

   function Get_Value (Manager : in Module_Manager;
                       Name    : in String) return Util.Beans.Objects.Object;

   --  Get the module configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Plugin  : Module_Manager;
                        Name    : String;
                        Default : String := "") return String;

   --  Get the module configuration property identified by the <tt>Config</tt> parameter.
   --  If the property does not exist, the default configuration value is returned.
   function Get_Config (Plugin : in Module_Manager;
                        Config : in ASF.Applications.Config_Param) return String;

   --  ------------------------------
   --  Module
   --  ------------------------------
   type Module is abstract new Ada.Finalization.Limited_Controlled with private;
   type Module_Access is access all Module'Class;

   --  Get the module name
   function Get_Name (Plugin : Module) return String;

   --  Get the base URI for this module
   function Get_URI (Plugin : Module) return String;

   --  Get the application in which this module is registered.
   function Get_Application (Plugin : in Module) return Application_Access;

   --  Find the module with the given name
   function Find_Module (Plugin : Module;
                         Name   : String) return Module_Access;

   --  Get the module configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Plugin  : Module;
                        Name    : String;
                        Default : String := "") return String;

   --  Get the module configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Plugin  : Module;
                        Name    : String;
                        Default : Integer := -1) return Integer;

   --  Get the module configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Plugin  : Module;
                        Name    : String;
                        Default : Boolean := False) return Boolean;

   --  Get the module configuration property identified by the <tt>Config</tt> parameter.
   --  If the property does not exist, the default configuration value is returned.
   function Get_Config (Plugin : in Module;
                        Config : in ASF.Applications.Config_Param) return String;

   --  Get the module configuration property identified by the <tt>Config</tt> parameter.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Plugin  : in Module;
                        Name    : in String;
                        Default : in String := "")
                        return EL.Expressions.Expression;

   procedure Initialize (Manager : in out Module_Manager;
                         Module  : in AWA.Modules.Module'Class);

   procedure Initialize (Plugin : in out Module;
                         App    : in Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Initialize the configuration file parser represented by Parser to recognize
   --  the specific configuration recognized by the module.
   procedure Initialize_Parser (Plugin : in out Module;
                                Parser : in out Util.Serialize.IO.Parser'Class) is null;

   --  Configures the module after its initialization and after having read its XML configuration.
   procedure Configure (Plugin : in out Module;
                        Props  : in ASF.Applications.Config) is null;

   --  Send the event to the module.  The module identified by To is
   --  found and the event is posted on its event channel.
   procedure Send_Event (Plugin  : in Module;
                         Content : in AWA.Events.Module_Event'Class);

   --  Get the database connection for reading
   function Get_Session (Manager : Module)
                         return ADO.Sessions.Session;

   --  Get the database connection for writing
   function Get_Master_Session (Manager : Module)
                                return ADO.Sessions.Master_Session;

   --  Register under the given name a function to create the bean instance when
   --  it is accessed for a first time.  The scope defines the scope of the bean.
   --  bean
   procedure Register (Plugin : in out Module;
                       Name    : in String;
                       Bind    : in ASF.Beans.Class_Binding_Access);

   --  Add a listener to the module listner list.  The module will invoke the listner
   --  depending on events or actions that occur in the module.
   procedure Add_Listener (Into : in out Module;
                           Item : in Util.Listeners.Listener_Access);

   --  Find the module with the given name in the application and add the listener to the
   --  module listener list.
   procedure Add_Listener (Plugin : in Module;
                           Name   : in String;
                           Item   : in Util.Listeners.Listener_Access);

   --  Remove a listener from the module listener list.
   procedure Remove_Listener (Into : in out Module;
                              Item : in Util.Listeners.Listener_Access);

   --  Finalize the module.
   overriding
   procedure Finalize (Plugin : in out Module);

   type Pool_Module is abstract new Module with private;

   type Session_Module is abstract new Module with private;

   generic
      type Manager_Type is new Module_Manager with private;
      type Manager_Type_Access is access all Manager_Type'Class;
      Name : String;
   function Get_Manager return Manager_Type_Access;

   --  Get the database connection for reading
   function Get_Session (Manager : Module_Manager)
                         return ADO.Sessions.Session;

   --  Get the database connection for writing
   function Get_Master_Session (Manager : Module_Manager)
                                return ADO.Sessions.Master_Session;

   --  Send the event to the module.  The module identified by To is
   --  found and the event is posted on its event channel.
   procedure Send_Event (Manager : in Module_Manager;
                         Content : in AWA.Events.Module_Event'Class);

   --  ------------------------------
   --  Module Registry
   --  ------------------------------
   --  The module registry maintains the list of available modules with
   --  operations to retrieve them either from a name or from the base URI.
   type Module_Registry is limited private;
   type Module_Registry_Access is access all Module_Registry;

   --  Initialize the registry
   procedure Initialize (Registry : in out Module_Registry;
                         Config   : in ASF.Applications.Config);

   --  Register the module in the registry.
   procedure Register (Registry : in Module_Registry_Access;
                       App      : in Application_Access;
                       Plugin   : in Module_Access;
                       Name     : in String;
                       URI      : in String);

   --  Find the module with the given name
   function Find_By_Name (Registry : Module_Registry;
                          Name     : String) return Module_Access;

   --  Find the module mapped to a given URI
   function Find_By_URI (Registry : Module_Registry;
                         URI      : String) return Module_Access;

   --  Iterate over the modules that have been registered and execute the Process
   --  procedure on each of the module instance.
   procedure Iterate (Registry : in Module_Registry;
                      Process  : access procedure (Plugin : in out Module'Class));

private

   use Ada.Strings.Unbounded;

   type Module is abstract new Ada.Finalization.Limited_Controlled with record
      Registry   : Module_Registry_Access;
      App        : Application_Access := null;
      Name       : Unbounded_String;
      URI        : Unbounded_String;
      Config     : ASF.Applications.Config;
      Self       : Module_Access := null;
      Listeners  : Util.Listeners.List;
   end record;

   --  Map to find a module from its name or its URI
   package Module_Maps is new
     Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                            Element_Type    => Module_Access,
                                            Hash            => Ada.Strings.Hash,
                                            Equivalent_Keys => "=");

   type Module_Registry is limited record
      Config   : ASF.Applications.Config;
      Name_Map : Module_Maps.Map;
      URI_Map  : Module_Maps.Map;
   end record;

   type Module_Manager is new Ada.Finalization.Limited_Controlled
     and Util.Beans.Basic.Readonly_Bean with record
      Module : Module_Access := null;
   end record;

   type Pool_Module is new Module with record
      D : Natural;
   end record;

   type Session_Module is new Module with record
      P : Natural;
   end record;

   use Util.Log;

   --  The logger (used by the generic Get function).
   Log : constant Loggers.Logger := Loggers.Create ("AWA.Modules");

end AWA.Modules;

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

with Ada.Finalization;
with Ada.Strings.Hash;
with Ada.Strings.Unbounded;
with Ada.Containers.Indefinite_Hashed_Maps;

with Util.Log.Loggers;
with Util.Beans.Basic;
with Util.Beans.Objects;
with Util.Serialize.IO;
with Util.Listeners;

with EL.Expressions;

with ASF.Beans;
with ASF.Applications;
with ADO.Sessions;

with AWA.Events;
limited with AWA.Applications;

--  == AWA Modules ==
--  A module is a software component that can be integrated in the
--  web application.  The module can bring a set of service APIs,
--  some Ada beans and some presentation files.  The AWA framework
--  allows to configure various parts of a module when it is integrated
--  in an application.  Some modules are designed to be re-used by
--  several applications (for example a _mail_ module, a _users_
--  module, ...).  Other modules could be specific to an application.
--  An application will be made of several modules, some will be
--  generic some others specific to the application.
--
--  === Registration ===
--  The module should have only one instance per application and it must
--  be registered when the application is initialized.  The module
--  instance should be added to the application record as follows:
--
--    type Application is new AWA.Applications.Application with record
--       Xxx       : aliased Xxx_Module;
--    end record;
--
--  The application record must override the `Initialize_Module` procedure
--  and it must register the module instance.  This is done as follows:
--
--    overriding
--    procedure Initialize_Modules (App : in out Application) is
--    begin
--       Register (App    => App.Self.all'Access,
--                 Name   => Xxx.Module.NAME,
--                 URI    => "xxx",
--                 Module => App.User_Module'Access);
--    end Initialize_Modules;
--
--  The module is registered under a unique name.  That name is used
--  to load the module configuration.
--
--  === Configuration ===
--  The module is configured by using an XML or a properties file.
--  The configuration file is used to define:
--
--    * the Ada beans that the module defines and uses,
--    * the events that the module wants to receive and the action
--      that must be performed when the event is posted,
--    * the permissions that the module needs and how to check them,
--    * the navigation rules which are used for the module web interface,
--    * the servlet and filter mappings used by the module
--
--  The module configuration is located in the *config* directory
--  and must be the name of the module followed by the file extension
--  (example: `module-name`.xml or `module-name`.properties).
--
--
package AWA.Modules is

   type Application_Access is access all AWA.Applications.Application'Class;

   --  ------------------------------
   --  Module manager
   --  ------------------------------
   --
   --  The `Module_Manager` represents the root of the logic manager
   type Module_Manager is new Ada.Finalization.Limited_Controlled
     and Util.Beans.Basic.Readonly_Bean with private;

   function Get_Value (Manager : in Module_Manager;
                       Name    : in String) return Util.Beans.Objects.Object;

   --  Get the module configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Plugin  : Module_Manager;
                        Name    : String;
                        Default : String := "") return String;

   --  Get the module configuration property identified by the `Config` parameter.
   --  If the property does not exist, the default configuration value is returned.
   function Get_Config (Plugin : in Module_Manager;
                        Config : in ASF.Applications.Config_Param) return String;
   function Get_Config (Plugin : in Module_Manager;
                        Config : in ASF.Applications.Config_Param) return Integer;
   function Get_Config (Plugin : in Module_Manager;
                        Config : in ASF.Applications.Config_Param) return Boolean;

   --  ------------------------------
   --  Module
   --  ------------------------------
   type Module is abstract new Ada.Finalization.Limited_Controlled with private;
   type Module_Access is access all Module'Class;

   --  Get the module name
   function Get_Name (Plugin : Module) return String;

   --  Get the base URI for this module
   function Get_URI (Plugin : Module) return String;

   --  Get the application in which this module is registered.
   function Get_Application (Plugin : in Module) return Application_Access;

   --  Find the module with the given name
   function Find_Module (Plugin : Module;
                         Name   : String) return Module_Access;

   --  Get the module configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Plugin  : Module;
                        Name    : String;
                        Default : String := "") return String;

   --  Get the module configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Plugin  : Module;
                        Name    : String;
                        Default : Integer := -1) return Integer;

   --  Get the module configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Plugin  : Module;
                        Name    : String;
                        Default : Boolean := False) return Boolean;

   --  Get the module configuration property identified by the `Config` parameter.
   --  If the property does not exist, the default configuration value is returned.
   function Get_Config (Plugin : in Module;
                        Config : in ASF.Applications.Config_Param) return String;
   function Get_Config (Plugin : in Module;
                        Config : in ASF.Applications.Config_Param) return Integer;
   function Get_Config (Plugin : in Module;
                        Config : in ASF.Applications.Config_Param) return Boolean;

   --  Get the module configuration property identified by the `Config` parameter.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Plugin  : in Module;
                        Name    : in String;
                        Default : in String := "")
                        return EL.Expressions.Expression;

   procedure Initialize (Manager : in out Module_Manager;
                         Module  : in AWA.Modules.Module'Class);

   procedure Initialize (Plugin : in out Module;
                         App    : in Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Initialize the configuration file parser represented by `Parser` to recognize
   --  the specific configuration recognized by the module.
   procedure Initialize_Parser (Plugin : in out Module;
                                Parser : in out Util.Serialize.IO.Parser'Class) is null;

   --  Configures the module after its initialization and after having read its XML configuration.
   procedure Configure (Plugin : in out Module;
                        Props  : in ASF.Applications.Config) is null;

   --  Send the event to the module.  The module identified by `To` is
   --  found and the event is posted on its event channel.
   procedure Send_Event (Plugin  : in Module;
                         Content : in AWA.Events.Module_Event'Class);

   --  Get the database connection for reading
   function Get_Session (Manager : Module)
                         return ADO.Sessions.Session;

   --  Get the database connection for writing
   function Get_Master_Session (Manager : Module)
                                return ADO.Sessions.Master_Session;

   --  Register under the given name a function to create the bean instance when
   --  it is accessed for a first time.  The scope defines the scope of the bean.
   --  bean
   procedure Register (Plugin : in out Module;
                       Name    : in String;
                       Bind    : in ASF.Beans.Class_Binding_Access);

   --  Add a listener to the module listner list.  The module will invoke the listner
   --  depending on events or actions that occur in the module.
   procedure Add_Listener (Into : in out Module;
                           Item : in Util.Listeners.Listener_Access);

   --  Find the module with the given name in the application and add the listener to the
   --  module listener list.
   procedure Add_Listener (Plugin : in Module;
                           Name   : in String;
                           Item   : in Util.Listeners.Listener_Access);

   --  Remove a listener from the module listener list.
   procedure Remove_Listener (Into : in out Module;
                              Item : in Util.Listeners.Listener_Access);

   --  Finalize the module.
   overriding
   procedure Finalize (Plugin : in out Module);

   type Pool_Module is abstract new Module with private;

   type Session_Module is abstract new Module with private;

   generic
      type Manager_Type is new Module_Manager with private;
      type Manager_Type_Access is access all Manager_Type'Class;
      Name : String;
   function Get_Manager return Manager_Type_Access;

   --  Get the database connection for reading
   function Get_Session (Manager : Module_Manager)
                         return ADO.Sessions.Session;

   --  Get the database connection for writing
   function Get_Master_Session (Manager : Module_Manager)
                                return ADO.Sessions.Master_Session;

   --  Send the event to the module.  The module identified by `To` is
   --  found and the event is posted on its event channel.
   procedure Send_Event (Manager : in Module_Manager;
                         Content : in AWA.Events.Module_Event'Class);

   --  ------------------------------
   --  Module Registry
   --  ------------------------------
   --  The module registry maintains the list of available modules with
   --  operations to retrieve them either from a name or from the base URI.
   type Module_Registry is limited private;
   type Module_Registry_Access is access all Module_Registry;

   --  Initialize the registry
   procedure Initialize (Registry : in out Module_Registry;
                         Config   : in ASF.Applications.Config);

   --  Register the module in the registry.
   procedure Register (Registry : in Module_Registry_Access;
                       App      : in Application_Access;
                       Plugin   : in Module_Access;
                       Name     : in String;
                       URI      : in String);

   --  Find the module with the given name
   function Find_By_Name (Registry : Module_Registry;
                          Name     : String) return Module_Access;

   --  Find the module mapped to a given URI
   function Find_By_URI (Registry : Module_Registry;
                         URI      : String) return Module_Access;

   --  Iterate over the modules that have been registered and execute the `Process`
   --  procedure on each of the module instance.
   procedure Iterate (Registry : in Module_Registry;
                      Process  : access procedure (Plugin : in out Module'Class));

private

   use Ada.Strings.Unbounded;

   type Module is abstract new Ada.Finalization.Limited_Controlled with record
      Registry   : Module_Registry_Access;
      App        : Application_Access := null;
      Name       : Unbounded_String;
      URI        : Unbounded_String;
      Config     : ASF.Applications.Config;
      Self       : Module_Access := null;
      Listeners  : Util.Listeners.List;
   end record;

   --  Map to find a module from its name or its URI
   package Module_Maps is new
     Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                            Element_Type    => Module_Access,
                                            Hash            => Ada.Strings.Hash,
                                            Equivalent_Keys => "=");

   type Module_Registry is limited record
      Config   : ASF.Applications.Config;
      Name_Map : Module_Maps.Map;
      URI_Map  : Module_Maps.Map;
   end record;

   type Module_Manager is new Ada.Finalization.Limited_Controlled
     and Util.Beans.Basic.Readonly_Bean with record
      Module : Module_Access := null;
   end record;

   type Pool_Module is new Module with record
      D : Natural;
   end record;

   type Session_Module is new Module with record
      P : Natural;
   end record;

   use Util.Log;

   --  The logger (used by the generic Get function).
   Log : constant Loggers.Logger := Loggers.Create ("AWA.Modules");

end AWA.Modules;

Add new Get_Config function that return boolean and integer