-----------------------------------------------------------------------
--  log.tests -- Unit tests for loggers
--  Copyright (C) 2009, 2010, 2011, 2013, 2015, 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;
with Ada.Directories;

with Util.Test_Caller;

with Util.Log;
with Util.Log.Loggers;
with Util.Properties;
with Util.Measures;
package body Util.Log.Tests is

   Log : constant Loggers.Logger := Loggers.Create ("util.log.test");

   procedure Test_Log (T : in out Test) is
      pragma Unreferenced (T);

      L : Loggers.Logger := Loggers.Create ("util.log.test.debug");
   begin
      L.Set_Level (DEBUG_LEVEL);
      Log.Info ("My log message");
      Log.Error ("My error message");
      Log.Debug ("A debug message Not printed");

      L.Info ("An info message");
      L.Debug ("A debug message on logger 'L'");
   end Test_Log;

   --  Test configuration and creation of file
   procedure Test_File_Appender (T : in out Test) is
      pragma Unreferenced (T);

      Props : Util.Properties.Manager;
   begin
      Props.Set ("log4j.appender.test", "File");
      Props.Set ("log4j.appender.test.File", "test.log");
      Props.Set ("log4j.logger.util.log.test.file", "DEBUG,test");
      Util.Log.Loggers.Initialize (Props);

      declare
         L : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
      begin
         L.Debug ("Writing a debug message");
         L.Debug ("{0}: {1}", "Parameter", "Value");
      end;
   end Test_File_Appender;

   procedure Test_Log_Perf (T : in out Test) is
      pragma Unreferenced (T);

      Props : Util.Properties.Manager;
   begin
      Props.Set ("log4j.appender.test", "File");
      Props.Set ("log4j.appender.test.File", "test.log");
      Props.Set ("log4j.logger.util.log.test.perf", "DEBUG,test");
      Util.Log.Loggers.Initialize (Props);

      for I in 1 .. 1000 loop
         declare
            S : Util.Measures.Stamp;
         begin
            Util.Measures.Report (S, "Util.Measures.Report", 1000);
         end;
      end loop;

      declare
         L : Loggers.Logger := Loggers.Create ("util.log.test.perf");
         S : Util.Measures.Stamp;
      begin
         L.Set_Level (DEBUG_LEVEL);
         for I in 1 .. 1000 loop
            L.Info ("My log message: {0}: {1}", "A message",
                    "A second parameter");
         end loop;
         Util.Measures.Report (S, "Log.Info message (output)", 1000);

         L.Set_Level (INFO_LEVEL);
         for I in 1 .. 10_000 loop
            L.Debug ("My log message: {0}: {1}", "A message",
                     "A second parameter");
         end loop;
         Util.Measures.Report (S, "Log.Debug message (no output)", 10_000);
      end;
   end Test_Log_Perf;

   --  ------------------------------
   --  Test appending the log on several log files
   --  ------------------------------
   procedure Test_List_Appender (T : in out Test) is
      use Ada.Strings;
      use Ada.Directories;
      Props : Util.Properties.Manager;
   begin
      for I in 1 .. 10 loop
         declare
            Id   : constant String := Fixed.Trim (Integer'Image (I), Both);
            Name : constant String := "log4j.appender.test" & Id;
         begin
            Props.Set (Name, "File");
            Props.Set (Name & ".File", "test" & Id & ".log");
            Props.Set (Name & ".layout", "date-level-message");
            if I > 5 then
               Props.Set (Name & ".level", "INFO");
            end if;
         end;
      end loop;
      Props.Set ("log4j.rootCategory", "DEBUG, test.log");
      Props.Set ("log4j.logger.util.log.test.file",
                 "DEBUG,test4,test1 , test2,test3, test4, test5 ,  test6 , test7,test8,");
      Util.Log.Loggers.Initialize (Props);

      declare
         L : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
      begin
         L.Debug ("Writing a debug message");
         L.Debug ("{0}: {1}", "Parameter", "Value");
         L.Debug ("Done");
      end;

      --  Check that we have non empty log files (up to test8.log).
      for I in 1 .. 8 loop
         declare
            Id   : constant String := Fixed.Trim (Integer'Image (I), Both);
            Path : constant String := "test" & Id & ".log";
         begin
            T.Assert (Ada.Directories.Exists (Path), "Log file " & Path & " not found");
            if I > 5 then
               T.Assert (Ada.Directories.Size (Path) < 100, "Log file "
                         & Path & " should be empty");
            else
               T.Assert (Ada.Directories.Size (Path) > 100, "Log file " & Path & " is empty");
            end if;
         end;
      end loop;
   end Test_List_Appender;

   --  ------------------------------
   --  Test file appender with different modes.
   --  ------------------------------
   procedure Test_File_Appender_Modes (T : in out Test) is
      use Ada.Directories;

      Props : Util.Properties.Manager;
   begin
      Props.Set ("log4j.appender.test", "File");
      Props.Set ("log4j.appender.test.File", "test-append.log");
      Props.Set ("log4j.appender.test.append", "true");
      Props.Set ("log4j.appender.test.immediateFlush", "true");
      Props.Set ("log4j.appender.test_global", "File");
      Props.Set ("log4j.appender.test_global.File", "test-append-global.log");
      Props.Set ("log4j.appender.test_global.append", "false");
      Props.Set ("log4j.appender.test_global.immediateFlush", "false");
      Props.Set ("log4j.logger.util.log.test.file", "DEBUG");
      Props.Set ("log4j.rootCategory", "DEBUG,test_global,test");
      Util.Log.Loggers.Initialize (Props);

      declare
         L : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
      begin
         L.Debug ("Writing a debug message");
         L.Debug ("{0}: {1}", "Parameter", "Value");
         L.Debug ("Done");
         L.Error ("This is the error test message");
      end;

      Props.Set ("log4j.appender.test_append", "File");
      Props.Set ("log4j.appender.test_append.File", "test-append2.log");
      Props.Set ("log4j.appender.test_append.append", "true");
      Props.Set ("log4j.appender.test_append.immediateFlush", "true");
      Props.Set ("log4j.logger.util.log.test2.file", "DEBUG,test_append,test_global");
      Util.Log.Loggers.Initialize (Props);

      declare
         L1 : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
         L2 : constant Loggers.Logger := Loggers.Create ("util.log.test2.file");
      begin
         L1.Info ("L1-1 Writing a info message");
         L2.Info ("L2-2 {0}: {1}", "Parameter", "Value");
         L1.Info ("L1-3 Done");
         L2.Error ("L2-4 This is the error test2 message");
      end;

      Props.Set ("log4j.appender.test_append.append", "plop");
      Props.Set ("log4j.appender.test_append.immediateFlush", "falsex");
      Props.Set ("log4j.rootCategory", "DEBUG, test.log");
      Util.Log.Loggers.Initialize (Props);

      T.Assert (Ada.Directories.Size ("test-append.log") > 100,
                "Log file test-append.log is empty");
      T.Assert (Ada.Directories.Size ("test-append2.log") > 100,
                "Log file test-append2.log is empty");
      T.Assert (Ada.Directories.Size ("test-append-global.log") > 100,
                "Log file test-append.log is empty");
   end Test_File_Appender_Modes;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Info",
                       Test_Log'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Debug",
                       Test_Log'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Set_Level",
                       Test_Log'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Appenders.File_Appender",
                       Test_File_Appender'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Appenders.File_Appender (append)",
                       Test_File_Appender_Modes'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Appenders.List_Appender",
                       Test_List_Appender'Access);

      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Log (Perf)",
                       Test_Log_Perf'Access);
   end Add_Tests;

end Util.Log.Tests;

-----------------------------------------------------------------------
--  log.tests -- Unit tests for loggers
--  Copyright (C) 2009, 2010, 2011, 2013, 2015, 2018, 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 Ada.Strings.Fixed;
with Ada.Directories;
with Ada.Text_IO;
with Ada.Strings.Unbounded;

with Util.Test_Caller;

with Util.Log;
with Util.Log.Loggers;
with Util.Files;
with Util.Properties;
with Util.Measures;
package body Util.Log.Tests is

   Log : constant Loggers.Logger := Loggers.Create ("util.log.test");

   procedure Test_Log (T : in out Test) is
      pragma Unreferenced (T);

      L : Loggers.Logger := Loggers.Create ("util.log.test.debug");
   begin
      L.Set_Level (DEBUG_LEVEL);
      Log.Info ("My log message");
      Log.Error ("My error message");
      Log.Debug ("A debug message Not printed");

      L.Info ("An info message");
      L.Debug ("A debug message on logger 'L'");
   end Test_Log;

   --  Test configuration and creation of file
   procedure Test_File_Appender (T : in out Test) is
      pragma Unreferenced (T);

      Props : Util.Properties.Manager;
   begin
      Props.Set ("log4j.appender.test", "File");
      Props.Set ("log4j.appender.test.File", "test.log");
      Props.Set ("log4j.logger.util.log.test.file", "DEBUG,test");
      Util.Log.Loggers.Initialize (Props);

      declare
         L : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
      begin
         L.Debug ("Writing a debug message");
         L.Debug ("{0}: {1}", "Parameter", "Value");
      end;
   end Test_File_Appender;

   procedure Test_Log_Perf (T : in out Test) is
      pragma Unreferenced (T);

      Props : Util.Properties.Manager;
   begin
      Props.Set ("log4j.appender.test", "File");
      Props.Set ("log4j.appender.test.File", "test.log");
      Props.Set ("log4j.logger.util.log.test.perf", "DEBUG,test");
      Util.Log.Loggers.Initialize (Props);

      for I in 1 .. 1000 loop
         declare
            S : Util.Measures.Stamp;
         begin
            Util.Measures.Report (S, "Util.Measures.Report", 1000);
         end;
      end loop;

      declare
         L : Loggers.Logger := Loggers.Create ("util.log.test.perf");
         S : Util.Measures.Stamp;
      begin
         L.Set_Level (DEBUG_LEVEL);
         for I in 1 .. 1000 loop
            L.Info ("My log message: {0}: {1}", "A message",
                    "A second parameter");
         end loop;
         Util.Measures.Report (S, "Log.Info message (output)", 1000);

         L.Set_Level (INFO_LEVEL);
         for I in 1 .. 10_000 loop
            L.Debug ("My log message: {0}: {1}", "A message",
                     "A second parameter");
         end loop;
         Util.Measures.Report (S, "Log.Debug message (no output)", 10_000);
      end;
   end Test_Log_Perf;

   --  ------------------------------
   --  Test appending the log on several log files
   --  ------------------------------
   procedure Test_List_Appender (T : in out Test) is
      use Ada.Strings;
      use Ada.Directories;
      Props : Util.Properties.Manager;
   begin
      for I in 1 .. 10 loop
         declare
            Id   : constant String := Fixed.Trim (Integer'Image (I), Both);
            Name : constant String := "log4j.appender.test" & Id;
         begin
            Props.Set (Name, "File");
            Props.Set (Name & ".File", "test" & Id & ".log");
            Props.Set (Name & ".layout", "date-level-message");
            if I > 5 then
               Props.Set (Name & ".level", "INFO");
            end if;
         end;
      end loop;
      Props.Set ("log4j.rootCategory", "DEBUG, test.log");
      Props.Set ("log4j.logger.util.log.test.file",
                 "DEBUG,test4,test1 , test2,test3, test4, test5 ,  test6 , test7,test8,");
      Util.Log.Loggers.Initialize (Props);

      declare
         L : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
      begin
         L.Debug ("Writing a debug message");
         L.Debug ("{0}: {1}", "Parameter", "Value");
         L.Debug ("Done");
      end;

      --  Check that we have non empty log files (up to test8.log).
      for I in 1 .. 8 loop
         declare
            Id   : constant String := Fixed.Trim (Integer'Image (I), Both);
            Path : constant String := "test" & Id & ".log";
         begin
            T.Assert (Ada.Directories.Exists (Path), "Log file " & Path & " not found");
            if I > 5 then
               T.Assert (Ada.Directories.Size (Path) < 100, "Log file "
                         & Path & " should be empty");
            else
               T.Assert (Ada.Directories.Size (Path) > 100, "Log file " & Path & " is empty");
            end if;
         end;
      end loop;
   end Test_List_Appender;

   --  ------------------------------
   --  Test file appender with different modes.
   --  ------------------------------
   procedure Test_File_Appender_Modes (T : in out Test) is
      use Ada.Directories;

      Props : Util.Properties.Manager;
   begin
      Props.Set ("log4j.appender.test", "File");
      Props.Set ("log4j.appender.test.File", "test-append.log");
      Props.Set ("log4j.appender.test.append", "true");
      Props.Set ("log4j.appender.test.immediateFlush", "true");
      Props.Set ("log4j.appender.test_global", "File");
      Props.Set ("log4j.appender.test_global.File", "test-append-global.log");
      Props.Set ("log4j.appender.test_global.append", "false");
      Props.Set ("log4j.appender.test_global.immediateFlush", "false");
      Props.Set ("log4j.logger.util.log.test.file", "DEBUG");
      Props.Set ("log4j.rootCategory", "DEBUG,test_global,test");
      Util.Log.Loggers.Initialize (Props);

      declare
         L : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
      begin
         L.Debug ("Writing a debug message");
         L.Debug ("{0}: {1}", "Parameter", "Value");
         L.Debug ("Done");
         L.Error ("This is the error test message");
      end;

      Props.Set ("log4j.appender.test_append", "File");
      Props.Set ("log4j.appender.test_append.File", "test-append2.log");
      Props.Set ("log4j.appender.test_append.append", "true");
      Props.Set ("log4j.appender.test_append.immediateFlush", "true");
      Props.Set ("log4j.logger.util.log.test2.file", "DEBUG,test_append,test_global");
      Util.Log.Loggers.Initialize (Props);

      declare
         L1 : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
         L2 : constant Loggers.Logger := Loggers.Create ("util.log.test2.file");
      begin
         L1.Info ("L1-1 Writing a info message");
         L2.Info ("L2-2 {0}: {1}", "Parameter", "Value");
         L1.Info ("L1-3 Done");
         L2.Error ("L2-4 This is the error test2 message");
      end;

      Props.Set ("log4j.appender.test_append.append", "plop");
      Props.Set ("log4j.appender.test_append.immediateFlush", "falsex");
      Props.Set ("log4j.rootCategory", "DEBUG, test.log");
      Util.Log.Loggers.Initialize (Props);

      T.Assert (Ada.Directories.Size ("test-append.log") > 100,
                "Log file test-append.log is empty");
      T.Assert (Ada.Directories.Size ("test-append2.log") > 100,
                "Log file test-append2.log is empty");
      T.Assert (Ada.Directories.Size ("test-append-global.log") > 100,
                "Log file test-append.log is empty");
   end Test_File_Appender_Modes;

   --  ------------------------------
   --  Test file appender with different modes.
   --  ------------------------------
   procedure Test_Console_Appender (T : in out Test) is
      use Ada.Directories;

      Props   : Util.Properties.Manager;
      File    : Ada.Text_IO.File_Type;
      Content : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Ada.Text_IO.Create (File, Ada.Text_IO.Out_File, "test_err.log");
      Ada.Text_IO.Set_Error (File);

      Props.Set ("log4j.appender.test_console", "Console");
      Props.Set ("log4j.appender.test_console.stderr", "true");
      Props.Set ("log4j.appender.test_console.level", "WARN");
      Props.Set ("log4j.rootCategory", "INFO,test_console");
      Util.Log.Loggers.Initialize (Props);

      declare
         L : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
      begin
         L.Debug ("Writing a debug message");
         L.Debug ("{0}: {1}", "Parameter", "Value");
         L.Debug ("Done");
         L.Info ("INFO MESSAGE!");
         L.Warn ("WARN MESSAGE!");
         L.Error ("This {0} {1} {2} test message", "is", "the", "error");
      end;
      Ada.Text_IO.Flush (Ada.Text_IO.Current_Error);
      Ada.Text_IO.Set_Error (Ada.Text_IO.Standard_Error);
      Ada.Text_IO.Close (File);

      Util.Files.Read_File ("test_err.log", Content);
      Util.Tests.Assert_Matches (T, ".*WARN MESSAGE!", Content,
                                 "Invalid console log (WARN)");
      Util.Tests.Assert_Matches (T, ".*This is the error test message", Content,
                                 "Invalid console log (ERROR)");
   exception
      when others =>
         Ada.Text_IO.Set_Error (Ada.Text_IO.Standard_Error);
         raise;

   end Test_Console_Appender;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Info",
                       Test_Log'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Debug",
                       Test_Log'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Set_Level",
                       Test_Log'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Appenders.File_Appender",
                       Test_File_Appender'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Appenders.File_Appender (append)",
                       Test_File_Appender_Modes'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Appenders.List_Appender",
                       Test_List_Appender'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Appenders.Console",
                       Test_Console_Appender'Access);

      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Log (Perf)",
                       Test_Log_Perf'Access);
   end Add_Tests;

end Util.Log.Tests;

Add Test_Console_Appender procedure to check console on stderr and register it for execution


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

with Ada.Calendar;

with AWA.Users.Models;
with AWA.Modules.Beans;
with AWA.Permissions.Services;

with ADO.SQL;
with Util.Log.Loggers;
with AWA.Users.Modules;
with AWA.Workspaces.Beans;
package body AWA.Workspaces.Modules is

   package ASC renames AWA.Services.Contexts;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Awa.Workspaces.Module");

   package Register is new AWA.Modules.Beans (Module => Workspace_Module,
                                              Module_Access => Workspace_Module_Access);

   --  ------------------------------
   --  Initialize the workspaces module.
   --  ------------------------------
   overriding
   procedure Initialize (Plugin : in out Workspace_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config) is
   begin
      Log.Info ("Initializing the workspaces module");

      --  Register here any bean class, servlet, filter.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Workspaces.Beans.Workspaces_Bean",
                         Handler => AWA.Workspaces.Beans.Create_Workspaces_Bean'Access);
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Workspaces.Beans.Member_List_Bean",
                         Handler => AWA.Workspaces.Beans.Create_Member_List_Bean'Access);
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Workspaces.Beans.Invitation_Bean",
                         Handler => AWA.Workspaces.Beans.Create_Invitation_Bean'Access);

      AWA.Modules.Module (Plugin).Initialize (App, Props);

      Plugin.User_Manager := AWA.Users.Modules.Get_User_Manager;
      --  Add here the creation of manager instances.
   end Initialize;

   --  ------------------------------
   --  Get the current workspace associated with the current user.
   --  If the user has not workspace, create one.
   --  ------------------------------
   procedure Get_Workspace (Session   : in out ADO.Sessions.Master_Session;
                            Context   : in AWA.Services.Contexts.Service_Context_Access;
                            Workspace : out AWA.Workspaces.Models.Workspace_Ref) is
      User    : constant AWA.Users.Models.User_Ref := Context.Get_User;
      WS      : AWA.Workspaces.Models.Workspace_Ref;
      Query   : ADO.SQL.Query;
      Found   : Boolean;
   begin
      if User.Is_Null then
         Log.Error ("There is no current user.  The workspace cannot be identified");
         Workspace := AWA.Workspaces.Models.Null_Workspace;
         return;
      end if;

      --  Find the workspace associated with the current user.
      Query.Add_Param (User.Get_Id);
      Query.Set_Filter ("o.owner_id = ?");
      WS.Find (Session, Query, Found);
      if Found then
         Workspace := WS;
         return;
      end if;

      --  Create a workspace for this user.
      WS.Set_Owner (User);
      WS.Set_Create_Date (Ada.Calendar.Clock);
      WS.Save (Session);

      --  And give full control of the workspace for this user
      AWA.Permissions.Services.Add_Permission (Session => Session,
                                               User    => User.Get_Id,
                                               Entity  => WS);

      Workspace := WS;
   end Get_Workspace;

   --  ------------------------------
   --  Load the invitation from the access key and verify that the key is still valid.
   --  ------------------------------
   procedure Load_Invitation (Module     : in Workspace_Module;
                              Key        : in String;
                              Invitation : in out AWA.Workspaces.Models.Invitation_Ref'Class) is
      use type Ada.Calendar.Time;

      Ctx    : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB     : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Query  : ADO.SQL.Query;
      DB_Key : AWA.Users.Models.Access_Key_Ref;
      Found  : Boolean;
   begin
      Log.Debug ("Loading invitation from key {0}", Key);

      Query.Set_Filter ("o.access_key = :key");
      Query.Bind_Param ("key", Key);
      DB_Key.Find (DB, Query, Found);
      if not Found then
         Log.Info ("Invitation key {0} does not exist");
         raise Not_Found;
      end if;
      if DB_Key.Get_Expire_Date < Ada.Calendar.Clock then
         Log.Info ("Invitation key {0} has expired");
         raise Not_Found;
      end if;
      Query.Set_Filter ("o.invitee_id = :user");
      Query.Bind_Param ("user", DB_Key.Get_User.Get_Id);
      Invitation.Find (DB, Query, Found);
      if not Found then
         Log.Warn ("Invitation key {0} has been withdawn");
         raise Not_Found;
      end if;
   end Load_Invitation;

   --  ------------------------------
   --  Send the invitation to the user.
   --  ------------------------------
   procedure Send_Invitation (Module     : in Workspace_Module;
                              Invitation : in out AWA.Workspaces.Models.Invitation_Ref'Class) is
      Ctx     : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB      : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      User    : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      WS      : AWA.Workspaces.Models.Workspace_Ref;
      Query   : ADO.SQL.Query;
      Found   : Boolean;
      Key     : AWA.Users.Models.Access_Key_Ref;
      Email   : AWA.Users.Models.Email_Ref;
      Invitee : AWA.Users.Models.User_Ref;
   begin
      Log.Info ("Sending invitation to {0}", String '(Invitation.Get_Email));

      Ctx.Start;
      if User.Is_Null then
         Log.Error ("There is no current user.  The workspace cannot be identified");
         return;
      end if;

      --  Find the workspace associated with the current user.
      Query.Add_Param (User.Get_Id);
      Query.Set_Filter ("o.owner_id = ?");
      WS.Find (DB, Query, Found);
      if not Found then
         return;
      end if;

      Query.Clear;
      Query.Set_Filter ("o.email = ?");
      Query.Add_Param (String '(Invitation.Get_Email));
      Email.Find (DB, Query, Found);
      if not Found then
         Email.Set_User_Id (0);
         Email.Set_Email (String '(Invitation.Get_Email));
         Email.Save (DB);
         Invitee.Set_Email (Email);
         Invitee.Set_Name (String '(Invitation.Get_Email));
         Invitee.Save (DB);
         Email.Set_User_Id (Invitee.Get_Id);
         Email.Save (DB);
      else
         Invitee.Load (DB, Email.Get_User_Id);
      end if;
      Key := AWA.Users.Models.Access_Key_Ref (Invitation.Get_Access_Key);
      Module.User_Manager.Create_Access_Key (Invitee, Key, 365 * 86400.0, DB);
      Key.Save (DB);
      Invitation.Set_Access_Key (Key);
      Invitation.Set_Inviter (User);
      Invitation.Set_Invitee (Invitee);
      Invitation.Set_Workspace (WS);
      Invitation.Set_Create_Date (Ada.Calendar.Clock);
      Invitation.Save (DB);
      Ctx.Commit;
   end Send_Invitation;

end AWA.Workspaces.Modules;

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

with Ada.Calendar;

with AWA.Users.Models;
with AWA.Modules.Beans;
with AWA.Permissions.Services;

with ADO.SQL;
with Util.Log.Loggers;
with AWA.Users.Modules;
with AWA.Workspaces.Beans;
package body AWA.Workspaces.Modules is

   package ASC renames AWA.Services.Contexts;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Awa.Workspaces.Module");

   package Register is new AWA.Modules.Beans (Module => Workspace_Module,
                                              Module_Access => Workspace_Module_Access);

   --  ------------------------------
   --  Initialize the workspaces module.
   --  ------------------------------
   overriding
   procedure Initialize (Plugin : in out Workspace_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config) is
   begin
      Log.Info ("Initializing the workspaces module");

      --  Register here any bean class, servlet, filter.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Workspaces.Beans.Workspaces_Bean",
                         Handler => AWA.Workspaces.Beans.Create_Workspaces_Bean'Access);
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Workspaces.Beans.Member_List_Bean",
                         Handler => AWA.Workspaces.Beans.Create_Member_List_Bean'Access);
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Workspaces.Beans.Invitation_Bean",
                         Handler => AWA.Workspaces.Beans.Create_Invitation_Bean'Access);

      AWA.Modules.Module (Plugin).Initialize (App, Props);

      Plugin.User_Manager := AWA.Users.Modules.Get_User_Manager;
      --  Add here the creation of manager instances.
   end Initialize;

   --  ------------------------------
   --  Get the current workspace associated with the current user.
   --  If the user has not workspace, create one.
   --  ------------------------------
   procedure Get_Workspace (Session   : in out ADO.Sessions.Master_Session;
                            Context   : in AWA.Services.Contexts.Service_Context_Access;
                            Workspace : out AWA.Workspaces.Models.Workspace_Ref) is
      User    : constant AWA.Users.Models.User_Ref := Context.Get_User;
      WS      : AWA.Workspaces.Models.Workspace_Ref;
      Query   : ADO.SQL.Query;
      Found   : Boolean;
   begin
      if User.Is_Null then
         Log.Error ("There is no current user.  The workspace cannot be identified");
         Workspace := AWA.Workspaces.Models.Null_Workspace;
         return;
      end if;

      --  Find the workspace associated with the current user.
      Query.Add_Param (User.Get_Id);
      Query.Set_Filter ("o.owner_id = ?");
      WS.Find (Session, Query, Found);
      if Found then
         Workspace := WS;
         return;
      end if;

      --  Create a workspace for this user.
      WS.Set_Owner (User);
      WS.Set_Create_Date (Ada.Calendar.Clock);
      WS.Save (Session);

      --  And give full control of the workspace for this user
      AWA.Permissions.Services.Add_Permission (Session => Session,
                                               User    => User.Get_Id,
                                               Entity  => WS);

      Workspace := WS;
   end Get_Workspace;

   --  ------------------------------
   --  Load the invitation from the access key and verify that the key is still valid.
   --  ------------------------------
   procedure Load_Invitation (Module     : in Workspace_Module;
                              Key        : in String;
                              Invitation : in out AWA.Workspaces.Models.Invitation_Ref'Class) is
      use type Ada.Calendar.Time;

      Ctx    : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB     : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Query  : ADO.SQL.Query;
      DB_Key : AWA.Users.Models.Access_Key_Ref;
      Found  : Boolean;
   begin
      Log.Debug ("Loading invitation from key {0}", Key);

      Query.Set_Filter ("o.access_key = :key");
      Query.Bind_Param ("key", Key);
      DB_Key.Find (DB, Query, Found);
      if not Found then
         Log.Info ("Invitation key {0} does not exist");
         raise Not_Found;
      end if;
      if DB_Key.Get_Expire_Date < Ada.Calendar.Clock then
         Log.Info ("Invitation key {0} has expired");
         raise Not_Found;
      end if;
      Query.Set_Filter ("o.invitee_id = :user");
      Query.Bind_Param ("user", DB_Key.Get_User.Get_Id);
      Invitation.Find (DB, Query, Found);
      if not Found then
         Log.Warn ("Invitation key {0} has been withdawn");
         raise Not_Found;
      end if;
   end Load_Invitation;

   --  ------------------------------
   --  Accept the invitation identified by the access key.
   --  ------------------------------
   procedure Accept_Invitation (Module     : in Workspace_Module;
                                Key        : in String) is
      use type Ada.Calendar.Time;

      Ctx     : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB      : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Query   : ADO.SQL.Query;
      DB_Key  : AWA.Users.Models.Access_Key_Ref;
      Found   : Boolean;
      Invitation : AWA.Workspaces.Models.Invitation_Ref;
   begin
      Log.Debug ("Accept invitation with key {0}", Key);
      Ctx.Start;
      Query.Set_Filter ("o.access_key = :key");
      Query.Bind_Param ("key", Key);
      DB_Key.Find (DB, Query, Found);
      if not Found then
         Log.Info ("Invitation key {0} does not exist");
         raise Not_Found;
      end if;
      if DB_Key.Get_Expire_Date < Ada.Calendar.Clock then
         Log.Info ("Invitation key {0} has expired");
         raise Not_Found;
      end if;
      Query.Set_Filter ("o.invitee_id = :user");
      Query.Bind_Param ("user", DB_Key.Get_User.Get_Id);
      Invitation.Find (DB, Query, Found);
      if not Found then
         Log.Warn ("Invitation key {0} has been withdawn");
         raise Not_Found;
      end if;
      DB_Key.Delete (DB);
      Invitation.Set_Acceptance_Date (ADO.Nullable_Time '(Is_Null => False,
                                                          Value => Ada.Calendar.Clock));
      Invitation.Save (DB);
      Ctx.Commit;
   end Accept_Invitation;

   --  ------------------------------
   --  Send the invitation to the user.
   --  ------------------------------
   procedure Send_Invitation (Module     : in Workspace_Module;
                              Invitation : in out AWA.Workspaces.Models.Invitation_Ref'Class) is
      Ctx     : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB      : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      User    : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      WS      : AWA.Workspaces.Models.Workspace_Ref;
      Query   : ADO.SQL.Query;
      Found   : Boolean;
      Key     : AWA.Users.Models.Access_Key_Ref;
      Email   : AWA.Users.Models.Email_Ref;
      Invitee : AWA.Users.Models.User_Ref;
   begin
      Log.Info ("Sending invitation to {0}", String '(Invitation.Get_Email));

      Ctx.Start;
      if User.Is_Null then
         Log.Error ("There is no current user.  The workspace cannot be identified");
         return;
      end if;

      --  Find the workspace associated with the current user.
      Query.Add_Param (User.Get_Id);
      Query.Set_Filter ("o.owner_id = ?");
      WS.Find (DB, Query, Found);
      if not Found then
         return;
      end if;

      Query.Clear;
      Query.Set_Filter ("o.email = ?");
      Query.Add_Param (String '(Invitation.Get_Email));
      Email.Find (DB, Query, Found);
      if not Found then
         Email.Set_User_Id (0);
         Email.Set_Email (String '(Invitation.Get_Email));
         Email.Save (DB);
         Invitee.Set_Email (Email);
         Invitee.Set_Name (String '(Invitation.Get_Email));
         Invitee.Save (DB);
         Email.Set_User_Id (Invitee.Get_Id);
         Email.Save (DB);
      else
         Invitee.Load (DB, Email.Get_User_Id);
      end if;
      Key := AWA.Users.Models.Access_Key_Ref (Invitation.Get_Access_Key);
      Module.User_Manager.Create_Access_Key (Invitee, Key, 365 * 86400.0, DB);
      Key.Save (DB);
      Invitation.Set_Access_Key (Key);
      Invitation.Set_Inviter (User);
      Invitation.Set_Invitee (Invitee);
      Invitation.Set_Workspace (WS);
      Invitation.Set_Create_Date (Ada.Calendar.Clock);
      Invitation.Save (DB);
      Ctx.Commit;
   end Send_Invitation;

end AWA.Workspaces.Modules;

Implement the Accept_Invitation procedure


-----------------------------------------------------------------------
--  Util.Serialize.Mappers.Vector_Mapper -- Mapper for vector types
--  Copyright (C) 2010, 2011, 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.Log.Loggers;

package body Util.Serialize.Mappers.Vector_Mapper is

   use Vectors;
   use Util.Log;

   --  The logger
   Log : constant Loggers.Logger := Loggers.Create ("Util.Serialize.Mappers.Vector_Mapper",
                                                    Util.Log.WARN_LEVEL);

   Key : Util.Serialize.Contexts.Data_Key;

   --  -----------------------
   --  Data context
   --  -----------------------
   --  Data context to get access to the target element.

   --  -----------------------
   --  Get the vector object.
   --  -----------------------
   function Get_Vector (Data : in Vector_Data) return Vector_Type_Access is
   begin
      return Data.Vector;
   end Get_Vector;

   --  -----------------------
   --  Set the vector object.
   --  -----------------------
   procedure Set_Vector (Data   : in out Vector_Data;
                         Vector : in Vector_Type_Access) is
   begin
      Data.Vector := Vector;
   end Set_Vector;

   --  -----------------------
   --  Record mapper
   --  -----------------------

   --  -----------------------
   --  Set the Data vector in the context.
   --  -----------------------
   procedure Set_Context (Ctx  : in out Util.Serialize.Contexts.Context'Class;
                          Data : in Vector_Type_Access) is
      Data_Context : constant Vector_Data_Access := new Vector_Data;
   begin
      Data_Context.Vector   := Data;
      Data_Context.Position := Index_Type'First;
      Ctx.Set_Data (Key => Key, Content => Data_Context.all'Unchecked_Access);
   end Set_Context;

   --  -----------------------
   --  Execute the mapping operation on the object associated with the current context.
   --  The object is extracted from the context and the Execute operation is called.
   --  -----------------------
   procedure Execute (Handler : in Mapper;
                      Map     : in Mapping'Class;
                      Ctx     : in out Util.Serialize.Contexts.Context'Class;
                      Value   : in Util.Beans.Objects.Object) is
      pragma Unreferenced (Handler);

      procedure Process (Element : in out Element_Type);

      procedure Process (Element : in out Element_Type) is
      begin
         Element_Mapper.Set_Member (Map, Element, Value);
      end Process;

      D : constant Contexts.Data_Access := Ctx.Get_Data (Key);
   begin
      Log.Debug ("Updating vector element");

      if not (D.all in Vector_Data'Class) then
         raise Util.Serialize.Contexts.No_Data;
      end if;
      declare
         DE : constant Vector_Data_Access := Vector_Data'Class (D.all)'Access;
      begin
         if DE.Vector = null then
            raise Util.Serialize.Contexts.No_Data;
         end if;
         --  Update the element through the generic procedure
         Update_Element (DE.Vector.all, DE.Position - 1, Process'Access);
      end;
   end Execute;

   procedure Set_Mapping (Into  : in out Mapper;
                          Inner : in Element_Mapper.Mapper_Access) is
   begin
      Into.Mapper := Inner.all'Unchecked_Access;
      Into.Map.Bind (Inner);
   end Set_Mapping;

   --  -----------------------
   --  Find the mapper associated with the given name.
   --  Returns null if there is no mapper.
   --  -----------------------
   function Find_Mapper (Controller : in Mapper;
                         Name       : in String) return Util.Serialize.Mappers.Mapper_Access is
   begin
      return Controller.Mapper.Find_Mapper (Name);
   end Find_Mapper;

   overriding
   procedure Initialize (Controller : in out Mapper) is
   begin
      Controller.Mapper := Controller.Map'Unchecked_Access;
   end Initialize;

   procedure Start_Object (Handler : in Mapper;
                           Context : in out Util.Serialize.Contexts.Context'Class;
                           Name    : in String) is
      pragma Unreferenced (Handler);

      procedure Set_Context (Item : in out Element_Type);

      D : constant Contexts.Data_Access := Context.Get_Data (Key);

      procedure Set_Context (Item : in out Element_Type) is
      begin
         Element_Mapper.Set_Context (Ctx => Context, Element => Item'Unrestricted_Access);
      end Set_Context;

   begin
      Log.Debug ("Creating vector element {0}", Name);

      if not (D.all in Vector_Data'Class) then
         raise Util.Serialize.Contexts.No_Data;
      end if;
      declare
         DE : constant Vector_Data_Access := Vector_Data'Class (D.all)'Access;
      begin
         if DE.Vector = null then
            raise Util.Serialize.Contexts.No_Data;
         end if;
         Insert_Space (DE.Vector.all, DE.Position);
         DE.Vector.Update_Element (Index => DE.Position, Process => Set_Context'Access);
         DE.Position := DE.Position + 1;
      end;
   end Start_Object;

   procedure Finish_Object (Handler : in Mapper;
                            Context : in out Util.Serialize.Contexts.Context'Class;
                            Name    : in String) is
   begin
      null;
   end Finish_Object;

   --  -----------------------
   --  Write the element on the stream using the mapper description.
   --  -----------------------
   procedure Write (Handler : in Mapper;
                    Stream  : in out Util.Serialize.IO.Output_Stream'Class;
                    Element : in Vectors.Vector) is
      Pos : Vectors.Cursor := Element.First;
   begin
      Stream.Start_Array (Element.Length);
      while Vectors.Has_Element (Pos) loop
         Element_Mapper.Write (Handler.Mapper.all, Handler.Map.Get_Getter,
                               Stream, Vectors.Element (Pos));
         Vectors.Next (Pos);
      end loop;
      Stream.End_Array;
   end Write;

begin
   --  Allocate the unique data key.
   Util.Serialize.Contexts.Allocate (Key);
end Util.Serialize.Mappers.Vector_Mapper;

-----------------------------------------------------------------------
--  Util.Serialize.Mappers.Vector_Mapper -- Mapper for vector types
--  Copyright (C) 2010, 2011, 2014, 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 Util.Log.Loggers;

package body Util.Serialize.Mappers.Vector_Mapper is

   use Vectors;
   use Util.Log;

   --  The logger
   Log : constant Loggers.Logger := Loggers.Create ("Util.Serialize.Mappers.Vector_Mapper",
                                                    Util.Log.WARN_LEVEL);

   Key : Util.Serialize.Contexts.Data_Key;

   --  -----------------------
   --  Data context
   --  -----------------------
   --  Data context to get access to the target element.

   --  -----------------------
   --  Get the vector object.
   --  -----------------------
   function Get_Vector (Data : in Vector_Data) return Vector_Type_Access is
   begin
      return Data.Vector;
   end Get_Vector;

   --  -----------------------
   --  Set the vector object.
   --  -----------------------
   procedure Set_Vector (Data   : in out Vector_Data;
                         Vector : in Vector_Type_Access) is
   begin
      Data.Vector := Vector;
   end Set_Vector;

   --  -----------------------
   --  Record mapper
   --  -----------------------

   --  -----------------------
   --  Set the Data vector in the context.
   --  -----------------------
   procedure Set_Context (Ctx  : in out Util.Serialize.Contexts.Context'Class;
                          Data : in Vector_Type_Access) is
      Data_Context : constant Vector_Data_Access := new Vector_Data;
   begin
      Data_Context.Vector   := Data;
      Data_Context.Position := Index_Type'First;
      Ctx.Set_Data (Key => Key, Content => Data_Context.all'Unchecked_Access);
   end Set_Context;

   --  -----------------------
   --  Execute the mapping operation on the object associated with the current context.
   --  The object is extracted from the context and the Execute operation is called.
   --  -----------------------
   procedure Execute (Handler : in Mapper;
                      Map     : in Mapping'Class;
                      Ctx     : in out Util.Serialize.Contexts.Context'Class;
                      Value   : in Util.Beans.Objects.Object) is
      pragma Unreferenced (Handler);

      procedure Process (Element : in out Element_Type);

      procedure Process (Element : in out Element_Type) is
      begin
         Element_Mapper.Set_Member (Map, Element, Value);
      end Process;

      D : constant Contexts.Data_Access := Ctx.Get_Data (Key);
   begin
      Log.Debug ("Updating vector element");

      if not (D.all in Vector_Data'Class) then
         raise Util.Serialize.Contexts.No_Data;
      end if;
      declare
         DE : constant Vector_Data_Access := Vector_Data'Class (D.all)'Access;
      begin
         if DE.Vector = null then
            raise Util.Serialize.Contexts.No_Data;
         end if;
         --  Update the element through the generic procedure
         Update_Element (DE.Vector.all, DE.Position - 1, Process'Access);
      end;
   end Execute;

   procedure Set_Mapping (Into  : in out Mapper;
                          Inner : in Element_Mapper.Mapper_Access) is
   begin
      Into.Mapper := Inner.all'Unchecked_Access;
      Into.Map.Bind (Inner);
   end Set_Mapping;

   --  -----------------------
   --  Find the mapper associated with the given name.
   --  Returns null if there is no mapper.
   --  -----------------------
   function Find_Mapper (Controller : in Mapper;
                         Name       : in String) return Util.Serialize.Mappers.Mapper_Access is
   begin
      return Controller.Mapper.Find_Mapper (Name);
   end Find_Mapper;

   overriding
   procedure Initialize (Controller : in out Mapper) is
   begin
      Controller.Mapper := Controller.Map'Unchecked_Access;
   end Initialize;

   procedure Start_Object (Handler : in Mapper;
                           Context : in out Util.Serialize.Contexts.Context'Class;
                           Name    : in String) is
      pragma Unreferenced (Handler);

      procedure Set_Context (Item : in out Element_Type);

      D : constant Contexts.Data_Access := Context.Get_Data (Key);

      procedure Set_Context (Item : in out Element_Type) is
      begin
         Element_Mapper.Set_Context (Ctx => Context, Element => Item'Unrestricted_Access);
      end Set_Context;

   begin
      Log.Debug ("Creating vector element {0}", Name);

      if not (D.all in Vector_Data'Class) then
         raise Util.Serialize.Contexts.No_Data;
      end if;
      declare
         DE : constant Vector_Data_Access := Vector_Data'Class (D.all)'Access;
      begin
         if DE.Vector = null then
            raise Util.Serialize.Contexts.No_Data;
         end if;
         Insert_Space (DE.Vector.all, DE.Position);
         DE.Vector.Update_Element (Index => DE.Position, Process => Set_Context'Access);
         DE.Position := DE.Position + 1;
      end;
   end Start_Object;

   procedure Finish_Object (Handler : in Mapper;
                            Context : in out Util.Serialize.Contexts.Context'Class;
                            Name    : in String) is
   begin
      null;
   end Finish_Object;

   --  -----------------------
   --  Write the element on the stream using the mapper description.
   --  -----------------------
   procedure Write (Handler : in Mapper;
                    Stream  : in out Util.Serialize.IO.Output_Stream'Class;
                    Element : in Vectors.Vector) is
      Pos : Vectors.Cursor := Element.First;
   begin
      Stream.Start_Array (Ada.Strings.Unbounded.To_String (Handler.Name));
      while Vectors.Has_Element (Pos) loop
         Element_Mapper.Write (Handler.Mapper.all, Handler.Map.Get_Getter,
                               Stream, Vectors.Element (Pos));
         Vectors.Next (Pos);
      end loop;
      Stream.End_Array (Ada.Strings.Unbounded.To_String (Handler.Name));
   end Write;

begin
   --  Allocate the unique data key.
   Util.Serialize.Contexts.Allocate (Key);
end Util.Serialize.Mappers.Vector_Mapper;

Update Write procedure after changes in the Start_Array/End_Array procedures


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

with Util.Files;
with Util.Streams;
with Util.Streams.Files;
with Ada.Streams;
with Ada.Streams.Stream_IO;

with Ada.Directories;

with ASF.Streams;
package body ASF.Servlets.Files is

   use Ada.Streams;
   use Ada.Streams.Stream_IO;
   use Ada.Directories;

   --  ------------------------------
   --  Called by the servlet container to indicate to a servlet that the servlet
   --  is being placed into service.
   --  ------------------------------
   procedure Initialize (Server  : in out File_Servlet;
                         Context : in Servlet_Registry'Class) is
      Dir : constant String := Context.Get_Init_Parameter ("web.dir");
   begin
      Server.Dir := new String '(Dir);
   end Initialize;

   --  ------------------------------
   --  Returns the time the Request object was last modified, in milliseconds since
   --  midnight January 1, 1970 GMT.  If the time is unknown, this method returns
   --  a negative number (the default).
   --
   --  Servlets that support HTTP GET requests and can quickly determine their
   --  last modification time should override this method. This makes browser and
   --  proxy caches work more effectively, reducing the load on server and network
   --  resources.
   --  ------------------------------
   function Get_Last_Modified (Server : in File_Servlet;
                               Requet : in Requests.Request'Class)
                               return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Clock;
   end Get_Last_Modified;

   --  ------------------------------
   --  Called by the server (via the service method) to allow a servlet to handle
   --  a GET request.
   --
   --  Overriding this method to support a GET request also automatically supports
   --  an HTTP HEAD request. A HEAD request is a GET request that returns no body
   --  in the response, only the request header fields.
   --
   --  When overriding this method, read the request data, write the response headers,
   --  get the response's writer or output stream object, and finally, write the
   --  response data. It's best to include content type and encoding.
   --  When using a PrintWriter object to return the response, set the content type
   --  before accessing the PrintWriter object.
   --
   --  The servlet container must write the headers before committing the response,
   --  because in HTTP the headers must be sent before the response body.
   --
   --  Where possible, set the Content-Length header (with the
   --  Response.Set_Content_Length method), to allow the servlet container
   --  to use a persistent connection to return its response to the client,
   --  improving performance. The content length is automatically set if the entire
   --  response fits inside the response buffer.
   --
   --  When using HTTP 1.1 chunked encoding (which means that the response has a
   --  Transfer-Encoding header), do not set the Content-Length header.
   --
   --  The GET method should be safe, that is, without any side effects for which
   --  users are held responsible. For example, most form queries have no side effects.
   --  If a client request is intended to change stored data, the request should use
   --  some other HTTP method.
   --
   --  The GET method should also be idempotent, meaning that it can be safely repeated.
   --  Sometimes making a method safe also makes it idempotent. For example, repeating
   --  queries is both safe and idempotent, but buying a product online or modifying
   --  data is neither safe nor idempotent.
   --
   --  If the request is incorrectly formatted, Do_Get  returns an HTTP "Bad Request"
   --  ------------------------------
   procedure Do_Get (Server   : in File_Servlet;
                     Request  : in out Requests.Request'Class;
                     Response : in out Responses.Response'Class) is

      use Util.Files;

      URI  : constant String := Request.Get_Request_URI;
      Path : constant String := Find_File_Path (Name => URI, Paths => Server.Dir.all);
   begin
      if not Ada.Directories.Exists (Path)
        or else Ada.Directories.Kind (Path) /= Ada.Directories.Ordinary_File then
         Response.Send_Error (Responses.SC_NOT_FOUND);
         return;
      end if;

      declare
         Output : ASF.Streams.Print_Stream := Response.Get_Output_Stream;
         Input  : Util.Streams.Files.File_Stream;
      begin
         Input.Open (Name => Path, Mode => In_File);
         Util.Streams.Copy (From => Input, Into => Output);
      end;
   end Do_Get;

end ASF.Servlets.Files;

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

with Util.Files;
with Util.Streams;
with Util.Streams.Files;
with Ada.Streams;
with Ada.Streams.Stream_IO;

with Ada.Directories;

with ASF.Streams;
package body ASF.Servlets.Files is

   use Ada.Streams;
   use Ada.Streams.Stream_IO;
   use Ada.Directories;

   --  ------------------------------
   --  Called by the servlet container to indicate to a servlet that the servlet
   --  is being placed into service.
   --  ------------------------------
   procedure Initialize (Server  : in out File_Servlet;
                         Context : in Servlet_Registry'Class) is
      Dir : constant String := Context.Get_Init_Parameter ("web.dir");
   begin
      Server.Dir := new String '(Dir);
   end Initialize;

   --  ------------------------------
   --  Returns the time the Request object was last modified, in milliseconds since
   --  midnight January 1, 1970 GMT.  If the time is unknown, this method returns
   --  a negative number (the default).
   --
   --  Servlets that support HTTP GET requests and can quickly determine their
   --  last modification time should override this method. This makes browser and
   --  proxy caches work more effectively, reducing the load on server and network
   --  resources.
   --  ------------------------------
   function Get_Last_Modified (Server : in File_Servlet;
                               Requet : in Requests.Request'Class)
                               return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Clock;
   end Get_Last_Modified;

   --  ------------------------------
   --  Called by the server (via the service method) to allow a servlet to handle
   --  a GET request.
   --
   --  Overriding this method to support a GET request also automatically supports
   --  an HTTP HEAD request. A HEAD request is a GET request that returns no body
   --  in the response, only the request header fields.
   --
   --  When overriding this method, read the request data, write the response headers,
   --  get the response's writer or output stream object, and finally, write the
   --  response data. It's best to include content type and encoding.
   --  When using a PrintWriter object to return the response, set the content type
   --  before accessing the PrintWriter object.
   --
   --  The servlet container must write the headers before committing the response,
   --  because in HTTP the headers must be sent before the response body.
   --
   --  Where possible, set the Content-Length header (with the
   --  Response.Set_Content_Length method), to allow the servlet container
   --  to use a persistent connection to return its response to the client,
   --  improving performance. The content length is automatically set if the entire
   --  response fits inside the response buffer.
   --
   --  When using HTTP 1.1 chunked encoding (which means that the response has a
   --  Transfer-Encoding header), do not set the Content-Length header.
   --
   --  The GET method should be safe, that is, without any side effects for which
   --  users are held responsible. For example, most form queries have no side effects.
   --  If a client request is intended to change stored data, the request should use
   --  some other HTTP method.
   --
   --  The GET method should also be idempotent, meaning that it can be safely repeated.
   --  Sometimes making a method safe also makes it idempotent. For example, repeating
   --  queries is both safe and idempotent, but buying a product online or modifying
   --  data is neither safe nor idempotent.
   --
   --  If the request is incorrectly formatted, Do_Get  returns an HTTP "Bad Request"
   --  ------------------------------
   procedure Do_Get (Server   : in File_Servlet;
                     Request  : in out Requests.Request'Class;
                     Response : in out Responses.Response'Class) is

      use Util.Files;

      URI  : constant String := Request.Get_Path_Info;
      Path : constant String := Find_File_Path (Name => URI, Paths => Server.Dir.all);
   begin
      if not Ada.Directories.Exists (Path)
        or else Ada.Directories.Kind (Path) /= Ada.Directories.Ordinary_File then
         Response.Send_Error (Responses.SC_NOT_FOUND);
         return;
      end if;

      declare
         Output : ASF.Streams.Print_Stream := Response.Get_Output_Stream;
         Input  : Util.Streams.Files.File_Stream;
      begin
         Input.Open (Name => Path, Mode => In_File);
         Util.Streams.Copy (From => Input, Into => Output);
      end;
   end Do_Get;

end ASF.Servlets.Files;

Use Get_Path_Info instead of the Get_Request_URI to get only the relative part of the Path and drop the servlet prefix. This path is then used to find the file path.


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

private with Orka.Rendering.Buffers.Pointers;

generic
   type Index_Type is mod <>;
package Orka.Rendering.Buffers.Persistent_Mapped is
   pragma Preelaborate;

   type IO_Mode is (Read, Write);

   type Persistent_Mapped_Buffer
     (Kind : Orka.Types.Composite_Type; Mode : IO_Mode) is tagged private;

   function Create_Buffer
     (Kind   : Orka.Types.Composite_Type;
      Length : Natural;
      Mode   : IO_Mode) return Persistent_Mapped_Buffer
   with Post => Create_Buffer'Result.Length = Length;
   --  Create a persistent mapped buffer for only writes or only reads
   --
   --  The actual size of the buffer is n * Length where n is the number
   --  of regions. Each region has an index (>= 0).
   --
   --  After writing or reading, you must call Advance_Index (once per frame).

   function GL_Buffer (Object : Persistent_Mapped_Buffer) return GL.Objects.Buffers.Buffer
     with Inline;

   function Length (Object : Persistent_Mapped_Buffer) return Natural
     with Inline;
   --  Number of elements in the buffer
   --
   --  Will be less than the actual size of the buffer due to triple
   --  buffering.

   function Index_Offset (Object : Persistent_Mapped_Buffer) return Natural
     with Inline;
   --  Offset in number of elements to the start of the buffer
   --
   --  Initially zero and incremented by Length whenever the index is
   --  advanced.

   procedure Advance_Index (Object : in out Persistent_Mapped_Buffer);

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

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Data   : Orka.Types.Singles.Vector4_Array;
      Offset : Natural := 0)
   with Pre => Object.Mode = Write and Offset + Data'Length <= Object.Length;

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Data   : Orka.Types.Singles.Matrix4_Array;
      Offset : Natural := 0)
   with Pre => Object.Mode = Write and Offset + Data'Length <= Object.Length;

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Data   : Orka.Types.Doubles.Vector4_Array;
      Offset : Natural := 0)
   with Pre => Object.Mode = Write and Offset + Data'Length <= Object.Length;

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Data   : Orka.Types.Doubles.Matrix4_Array;
      Offset : Natural := 0)
   with Pre => Object.Mode = Write and Offset + Data'Length <= Object.Length;

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Data   : Indirect.Arrays_Indirect_Command_Array;
      Offset : Natural := 0)
   with Pre => Object.Mode = Write and Offset + Data'Length <= Object.Length;

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Data   : Indirect.Elements_Indirect_Command_Array;
      Offset : Natural := 0)
   with Pre => Object.Mode = Write and Offset + Data'Length <= Object.Length;

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Data   : Indirect.Dispatch_Indirect_Command_Array;
      Offset : Natural := 0)
   with Pre => Object.Mode = Write and Offset + Data'Length <= Object.Length;

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

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Value  : Orka.Types.Singles.Vector4;
      Offset : Natural)
   with Pre => Object.Mode = Write and Offset < Object.Length;

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Value  : Orka.Types.Singles.Matrix4;
      Offset : Natural)
   with Pre => Object.Mode = Write and Offset < Object.Length;

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Value  : Orka.Types.Doubles.Vector4;
      Offset : Natural)
   with Pre => Object.Mode = Write and Offset < Object.Length;

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Value  : Orka.Types.Doubles.Matrix4;
      Offset : Natural)
   with Pre => Object.Mode = Write and Offset < Object.Length;

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Value  : Indirect.Arrays_Indirect_Command;
      Offset : Natural)
   with Pre => Object.Mode = Write and Offset < Object.Length;

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Value  : Indirect.Elements_Indirect_Command;
      Offset : Natural)
   with Pre => Object.Mode = Write and Offset < Object.Length;

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Value  : Indirect.Dispatch_Indirect_Command;
      Offset : Natural)
   with Pre => Object.Mode = Write and Offset < Object.Length;

private

   use Orka.Types;

   type Persistent_Mapped_Buffer
     (Kind : Orka.Types.Composite_Type; Mode : IO_Mode)
   is tagged record
      Buffer : Buffers.Buffer;
      Index  : Index_Type;
      case Kind is
         when Single_Vector_Type =>
            Pointer_SV : Pointers.Single_Vector4.Pointer;
         when Double_Vector_Type =>
            Pointer_DV : Pointers.Double_Vector4.Pointer;
         when Single_Matrix_Type =>
            Pointer_SM : Pointers.Single_Matrix4.Pointer;
         when Double_Matrix_Type =>
            Pointer_DM : Pointers.Double_Matrix4.Pointer;
         when Arrays_Command_Type =>
            Pointer_AC : Pointers.Arrays_Command.Pointer;
         when Elements_Command_Type =>
            Pointer_EC : Pointers.Elements_Command.Pointer;
         when Dispatch_Command_Type =>
            Pointer_DC : Pointers.Dispatch_Command.Pointer;
      end case;
   end record;

end Orka.Rendering.Buffers.Persistent_Mapped;

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

private with Orka.Rendering.Buffers.Pointers;

generic
   type Index_Type is mod <>;
package Orka.Rendering.Buffers.Persistent_Mapped is
   pragma Preelaborate;

   type IO_Mode is (Read, Write);

   type Persistent_Mapped_Buffer
     (Kind : Orka.Types.Composite_Type; Mode : IO_Mode) is tagged private;

   function Create_Buffer
     (Kind   : Orka.Types.Composite_Type;
      Length : Natural;
      Mode   : IO_Mode) return Persistent_Mapped_Buffer
   with Post => Create_Buffer'Result.Length = Length;
   --  Create a persistent mapped buffer for only writes or only reads
   --
   --  The actual size of the buffer is n * Length where n is the number
   --  of regions. Each region has an index (>= 0).
   --
   --  After writing or reading, you must call Advance_Index (once per frame).
   --
   --  If Mode = Write, then you must wait for a fence to complete before
   --  writing and then set the fence after the drawing or dispatch commands
   --  which uses the mapped buffer.
   --
   --  If Mode = Read, then you must set a fence after the drawing or
   --  dispatch commands that write to the buffer and then wait for the
   --  fence to complete before reading the data.

   function GL_Buffer (Object : Persistent_Mapped_Buffer) return GL.Objects.Buffers.Buffer
     with Inline;

   function Length (Object : Persistent_Mapped_Buffer) return Natural
     with Inline;
   --  Number of elements in the buffer
   --
   --  Will be less than the actual size of the buffer due to triple
   --  buffering.

   function Index_Offset (Object : Persistent_Mapped_Buffer) return Natural
     with Inline;
   --  Offset in number of elements to the start of the buffer
   --
   --  Initially zero and incremented by Length whenever the index is
   --  advanced.

   procedure Advance_Index (Object : in out Persistent_Mapped_Buffer);

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

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Data   : Orka.Types.Singles.Vector4_Array;
      Offset : Natural := 0)
   with Pre => Object.Mode = Write and Offset + Data'Length <= Object.Length;

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Data   : Orka.Types.Singles.Matrix4_Array;
      Offset : Natural := 0)
   with Pre => Object.Mode = Write and Offset + Data'Length <= Object.Length;

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Data   : Orka.Types.Doubles.Vector4_Array;
      Offset : Natural := 0)
   with Pre => Object.Mode = Write and Offset + Data'Length <= Object.Length;

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Data   : Orka.Types.Doubles.Matrix4_Array;
      Offset : Natural := 0)
   with Pre => Object.Mode = Write and Offset + Data'Length <= Object.Length;

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Data   : Indirect.Arrays_Indirect_Command_Array;
      Offset : Natural := 0)
   with Pre => Object.Mode = Write and Offset + Data'Length <= Object.Length;

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Data   : Indirect.Elements_Indirect_Command_Array;
      Offset : Natural := 0)
   with Pre => Object.Mode = Write and Offset + Data'Length <= Object.Length;

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Data   : Indirect.Dispatch_Indirect_Command_Array;
      Offset : Natural := 0)
   with Pre => Object.Mode = Write and Offset + Data'Length <= Object.Length;

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

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Value  : Orka.Types.Singles.Vector4;
      Offset : Natural)
   with Pre => Object.Mode = Write and Offset < Object.Length;

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Value  : Orka.Types.Singles.Matrix4;
      Offset : Natural)
   with Pre => Object.Mode = Write and Offset < Object.Length;

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Value  : Orka.Types.Doubles.Vector4;
      Offset : Natural)
   with Pre => Object.Mode = Write and Offset < Object.Length;

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Value  : Orka.Types.Doubles.Matrix4;
      Offset : Natural)
   with Pre => Object.Mode = Write and Offset < Object.Length;

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Value  : Indirect.Arrays_Indirect_Command;
      Offset : Natural)
   with Pre => Object.Mode = Write and Offset < Object.Length;

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Value  : Indirect.Elements_Indirect_Command;
      Offset : Natural)
   with Pre => Object.Mode = Write and Offset < Object.Length;

   procedure Write_Data
     (Object : Persistent_Mapped_Buffer;
      Value  : Indirect.Dispatch_Indirect_Command;
      Offset : Natural)
   with Pre => Object.Mode = Write and Offset < Object.Length;

private

   use Orka.Types;

   type Persistent_Mapped_Buffer
     (Kind : Orka.Types.Composite_Type; Mode : IO_Mode)
   is tagged record
      Buffer : Buffers.Buffer;
      Index  : Index_Type;
      case Kind is
         when Single_Vector_Type =>
            Pointer_SV : Pointers.Single_Vector4.Pointer;
         when Double_Vector_Type =>
            Pointer_DV : Pointers.Double_Vector4.Pointer;
         when Single_Matrix_Type =>
            Pointer_SM : Pointers.Single_Matrix4.Pointer;
         when Double_Matrix_Type =>
            Pointer_DM : Pointers.Double_Matrix4.Pointer;
         when Arrays_Command_Type =>
            Pointer_AC : Pointers.Arrays_Command.Pointer;
         when Elements_Command_Type =>
            Pointer_EC : Pointers.Elements_Command.Pointer;
         when Dispatch_Command_Type =>
            Pointer_DC : Pointers.Dispatch_Command.Pointer;
      end case;
   end record;

end Orka.Rendering.Buffers.Persistent_Mapped;

orka: Document use of fences in package Buffers.Persistent_Mapped

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


-----------------------------------------------------------------------
--  gen-artifacts -- Artifacts for Code Generator
--  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 Ada.Finalization;

with DOM.Core;
with Gen.Model;
with Gen.Model.Packages;
with Gen.Model.Projects;

--  The Gen.Artifacts package represents the methods and process to prepare,
--  control and realize the code generation.
package Gen.Artifacts is

   type Iteration_Mode is (ITERATION_PACKAGE, ITERATION_TABLE);

   type Generator is limited interface;

   --  Report an error and set the exit status accordingly
   procedure Error (Handler : in out Generator;
                    Message : in String;
                    Arg1    : in String := "";
                    Arg2    : in String := "") is abstract;

   --  Get the config directory path.
   function Get_Config_Directory (Handler : in Generator) return String is abstract;

   --  Get the result directory path.
   function Get_Result_Directory (Handler : in Generator) return String is abstract;

   --  Get the configuration parameter.
   function Get_Parameter (Handler : in Generator;
                           Name    : in String;
                           Default : in String := "") return String is abstract;

   --  Get the configuration parameter.
   function Get_Parameter (Handler : in Generator;
                           Name    : in String;
                           Default : in Boolean := False) return Boolean is abstract;

   --  Tell the generator to activate the generation of the given template name.
   --  The name is a property name that must be defined in generator.properties to
   --  indicate the template file.  Several artifacts can trigger the generation
   --  of a given template.  The template is generated only once.
   procedure Add_Generation (Handler : in out Generator;
                             Name    : in String;
                             Mode    : in Iteration_Mode;
                             Mapping : in String) is abstract;

   --  Scan the dynamo directories and execute the Process procedure with the
   --  directory path.
   procedure Scan_Directories (Handler : in Generator;
                               Process : not null access
                                 procedure (Dir : in String)) is abstract;

   --  ------------------------------
   --  Model Definition
   --  ------------------------------
   type Artifact is abstract new Ada.Finalization.Limited_Controlled with private;

   --  After the configuration file is read, processes the node whose root
   --  is passed in Node and initializes the Model with the information.
   procedure Initialize (Handler : in out Artifact;
                         Path    : in String;
                         Node    : in DOM.Core.Node;
                         Model   : in out Gen.Model.Packages.Model_Definition'Class;
                         Context : in out Generator'Class);

   --  Prepare the model after all the configuration files have been read and before
   --  actually invoking the generation.
   procedure Prepare (Handler : in out Artifact;
                      Model   : in out Gen.Model.Packages.Model_Definition'Class;
                      Context : in out Generator'Class) is null;

   --  After the generation, perform a finalization step for the generation process.
   procedure Finish (Handler : in out Artifact;
                     Model   : in out Gen.Model.Packages.Model_Definition'Class;
                     Project : in out Gen.Model.Projects.Project_Definition'Class;
                     Context : in out Generator'Class) is null;

   --  Check whether this artifact has been initialized.
   function Is_Initialized (Handler : in Artifact) return Boolean;

private

   type Artifact is abstract new Ada.Finalization.Limited_Controlled with record
      Initialized : Boolean := False;
   end record;

end Gen.Artifacts;

-----------------------------------------------------------------------
--  gen-artifacts -- Artifacts for Code Generator
--  Copyright (C) 2011, 2012, 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 DOM.Core;
with Util.Log;
with Gen.Model;
with Gen.Model.Packages;
with Gen.Model.Projects;

--  The Gen.Artifacts package represents the methods and process to prepare,
--  control and realize the code generation.
package Gen.Artifacts is

   type Iteration_Mode is (ITERATION_PACKAGE, ITERATION_TABLE);

   type Generator is limited interface and Util.Log.Logging;

   --  Report an error and set the exit status accordingly
   procedure Error (Handler : in out Generator;
                    Message : in String;
                    Arg1    : in String;
                    Arg2    : in String := "") is abstract;

   --  Get the config directory path.
   function Get_Config_Directory (Handler : in Generator) return String is abstract;

   --  Get the result directory path.
   function Get_Result_Directory (Handler : in Generator) return String is abstract;

   --  Get the configuration parameter.
   function Get_Parameter (Handler : in Generator;
                           Name    : in String;
                           Default : in String := "") return String is abstract;

   --  Get the configuration parameter.
   function Get_Parameter (Handler : in Generator;
                           Name    : in String;
                           Default : in Boolean := False) return Boolean is abstract;

   --  Tell the generator to activate the generation of the given template name.
   --  The name is a property name that must be defined in generator.properties to
   --  indicate the template file.  Several artifacts can trigger the generation
   --  of a given template.  The template is generated only once.
   procedure Add_Generation (Handler : in out Generator;
                             Name    : in String;
                             Mode    : in Iteration_Mode;
                             Mapping : in String) is abstract;

   --  Scan the dynamo directories and execute the Process procedure with the
   --  directory path.
   procedure Scan_Directories (Handler : in Generator;
                               Process : not null access
                                 procedure (Dir : in String)) is abstract;

   --  ------------------------------
   --  Model Definition
   --  ------------------------------
   type Artifact is abstract new Ada.Finalization.Limited_Controlled with private;

   --  After the configuration file is read, processes the node whose root
   --  is passed in Node and initializes the Model with the information.
   procedure Initialize (Handler : in out Artifact;
                         Path    : in String;
                         Node    : in DOM.Core.Node;
                         Model   : in out Gen.Model.Packages.Model_Definition'Class;
                         Context : in out Generator'Class);

   --  Prepare the model after all the configuration files have been read and before
   --  actually invoking the generation.
   procedure Prepare (Handler : in out Artifact;
                      Model   : in out Gen.Model.Packages.Model_Definition'Class;
                      Context : in out Generator'Class) is null;

   --  After the generation, perform a finalization step for the generation process.
   procedure Finish (Handler : in out Artifact;
                     Model   : in out Gen.Model.Packages.Model_Definition'Class;
                     Project : in out Gen.Model.Projects.Project_Definition'Class;
                     Context : in out Generator'Class) is null;

   --  Check whether this artifact has been initialized.
   function Is_Initialized (Handler : in Artifact) return Boolean;

private

   type Artifact is abstract new Ada.Finalization.Limited_Controlled with record
      Initialized : Boolean := False;
   end record;

end Gen.Artifacts;

Implement the Util.Log.Logging interface for the Generator interface


-----------------------------------------------------------------------
--  mat-expressions -- Expressions for memory slot selection
--  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.Types;
with MAT.Memory;
package body MAT.Expressions is

   --  ------------------------------
   --  Create a NOT expression node.
   --  ------------------------------
   function Create_Not (Expr : in Expression_Type) return Expression_Type is
      Result : Expression_Type;
   begin
      Result.Node := new Node_Type'(Ref_Counter => Util.Concurrent.Counters.ONE,
                                    Kind => N_NOT, Expr => Expr.Node);
      return Result;
   end Create_Not;

end MAT.Expressions;

-----------------------------------------------------------------------
--  mat-expressions -- Expressions for memory slot selection
--  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.Types;
with MAT.Memory;
package body MAT.Expressions is

   --  ------------------------------
   --  Create a NOT expression node.
   --  ------------------------------
   function Create_Not (Expr : in Expression_Type) return Expression_Type is
      Result : Expression_Type;
   begin
      Result.Node := new Node_Type'(Ref_Counter => Util.Concurrent.Counters.ONE,
                                    Kind        => N_NOT,
                                    Expr        => Expr.Node);
      Util.Concurrent.Counters.Increment (Expr.Node.Ref_Counter);
      return Result;
   end Create_Not;

   --  ------------------------------
   --  Create a AND expression node.
   --  ------------------------------
   function Create_And (Left  : in Expression_Type;
                        Right : in Expression_Type) return Expression_Type is
      Result : Expression_Type;
   begin
      Result.Node := new Node_Type'(Ref_Counter => Util.Concurrent.Counters.ONE,
                                    Kind        => N_AND,
                                    Left        => Left.Node,
                                    Right       => Right.Node);
      Util.Concurrent.Counters.Increment (Left.Node.Ref_Counter);
      Util.Concurrent.Counters.Increment (Right.Node.Ref_Counter);
      return Result;
   end Create_And;

end MAT.Expressions;

Implement the Create_And operation

Implement the Create_And operation


-----------------------------------------------------------------------
--  mat-expressions -- Expressions for memory slot selection
--  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 Ada.Strings.Unbounded;

private with Util.Concurrent.Counters;

with MAT.Types;
with MAT.Memory;
package MAT.Expressions is

   type Context_Type is record
      Addr       : MAT.Types.Target_Addr;
      Allocation : MAT.Memory.Allocation;
   end record;

   type Inside_Type is (INSIDE_FILE, INSIDE_FUNCTION);

   type Expression_Type is tagged private;

   --  Create a NOT expression node.
   function Create_Not (Expr : in Expression_Type) return Expression_Type;

   --  Create a AND expression node.
   function Create_And (Left  : in Expression_Type;
                        Right : in Expression_Type) return Expression_Type;

   --  Create a OR expression node.
   function Create_Or (Left  : in Expression_Type;
                       Right : in Expression_Type) return Expression_Type;

   --  Create an INSIDE expression node.
   function Create_Inside (Name : in Ada.Strings.Unbounded.Unbounded_String;
                           Kind : in Inside_Type) return Expression_Type;

   --  Create an size range expression node.
   function Create_Size (Min : in MAT.Types.Target_Size;
                         Max : in MAT.Types.Target_Size) return Expression_Type;

   --  Create an addr range expression node.
   function Create_Addr (Min : in MAT.Types.Target_Addr;
                         Max : in MAT.Types.Target_Addr) return Expression_Type;

   --  Create an time range expression node.
   function Create_Time (Min : in MAT.Types.Target_Tick_Ref;
                         Max : in MAT.Types.Target_Tick_Ref) return Expression_Type;

   --  Evaluate the expression to check if the memory slot described by the
   --  context is selected.  Returns True if the memory slot is selected.
   function Is_Selected (Node       : in Expression_Type;
                         Addr       : in MAT.Types.Target_Addr;
                         Allocation : in MAT.Memory.Allocation) return Boolean;

private

   type Kind_Type is (N_NOT, N_OR, N_AND, N_TRUE, N_FALSE,
                      N_IN_FILE, N_IN_FILE_DIRECT, N_INSIDE,
                      N_CALL_ADDR, N_CALL_ADDR_DIRECT,
                      N_IN_FUNC, N_IN_FUNC_DIRECT,
                      N_RANGE_SIZE, N_RANGE_ADDR,
                      N_RANGE_TIME,
                      N_CONDITION, N_THREAD);

   type Node_Type;
   type Node_Type_Access is access all Node_Type;

   type Node_Type (Kind : Kind_Type) is record
      Ref_Counter : Util.Concurrent.Counters.Counter;
      case Kind is
         when N_NOT =>
            Expr : Node_Type_Access;

         when N_OR | N_AND =>
            Left, Right : Node_Type_Access;

         when N_INSIDE | N_IN_FILE | N_IN_FILE_DIRECT | N_IN_FUNC | N_IN_FUNC_DIRECT =>
            Name   : Ada.Strings.Unbounded.Unbounded_String;
            Inside : Inside_Type;

         when N_RANGE_SIZE =>
            Min_Size : MAT.Types.Target_Size;
            Max_Size : MAT.Types.Target_Size;

         when N_RANGE_ADDR | N_CALL_ADDR | N_CALL_ADDR_DIRECT =>
            Min_Addr : MAT.Types.Target_Addr;
            Max_Addr : MAT.Types.Target_Addr;

         when N_RANGE_TIME =>
            Min_Time : MAT.Types.Target_Tick_Ref;
            Max_Time : MAT.Types.Target_Tick_Ref;

         when N_THREAD =>
            Thread : MAT.Types.Target_Thread_Ref;

         when others =>
            null;
      end case;
   end record;

   --  Evaluate the node against the context.  Returns True if the node expression
   --  selects the memory slot defined by the context.
   function Is_Selected (Node       : in Node_Type;
                         Addr       : in MAT.Types.Target_Addr;
                         Allocation : in MAT.Memory.Allocation) return Boolean;

   type Expression_Type is tagged record
      Node : Node_Type_Access;
   end record;

end MAT.Expressions;

-----------------------------------------------------------------------
--  mat-expressions -- Expressions for memory slot selection
--  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 Ada.Strings.Unbounded;

private with Util.Concurrent.Counters;

with MAT.Types;
with MAT.Memory;
package MAT.Expressions is

   type Context_Type is record
      Addr       : MAT.Types.Target_Addr;
      Allocation : MAT.Memory.Allocation;
   end record;

   type Inside_Type is (INSIDE_FILE,
                        INSIDE_DIRECT_FILE,
                        INSIDE_FUNCTION,
                        INSIDE_DIRECT_FUNCTION);

   type Expression_Type is tagged private;

   --  Create a NOT expression node.
   function Create_Not (Expr : in Expression_Type) return Expression_Type;

   --  Create a AND expression node.
   function Create_And (Left  : in Expression_Type;
                        Right : in Expression_Type) return Expression_Type;

   --  Create a OR expression node.
   function Create_Or (Left  : in Expression_Type;
                       Right : in Expression_Type) return Expression_Type;

   --  Create an INSIDE expression node.
   function Create_Inside (Name : in Ada.Strings.Unbounded.Unbounded_String;
                           Kind : in Inside_Type) return Expression_Type;

   --  Create an size range expression node.
   function Create_Size (Min : in MAT.Types.Target_Size;
                         Max : in MAT.Types.Target_Size) return Expression_Type;

   --  Create an addr range expression node.
   function Create_Addr (Min : in MAT.Types.Target_Addr;
                         Max : in MAT.Types.Target_Addr) return Expression_Type;

   --  Create an time range expression node.
   function Create_Time (Min : in MAT.Types.Target_Tick_Ref;
                         Max : in MAT.Types.Target_Tick_Ref) return Expression_Type;

   --  Evaluate the expression to check if the memory slot described by the
   --  context is selected.  Returns True if the memory slot is selected.
   function Is_Selected (Node       : in Expression_Type;
                         Addr       : in MAT.Types.Target_Addr;
                         Allocation : in MAT.Memory.Allocation) return Boolean;

private

   type Kind_Type is (N_NOT, N_OR, N_AND, N_TRUE, N_FALSE,
                      N_IN_FILE, N_IN_FILE_DIRECT, N_INSIDE,
                      N_CALL_ADDR, N_CALL_ADDR_DIRECT,
                      N_IN_FUNC, N_IN_FUNC_DIRECT,
                      N_RANGE_SIZE, N_RANGE_ADDR,
                      N_RANGE_TIME,
                      N_CONDITION, N_THREAD);

   type Node_Type;
   type Node_Type_Access is access all Node_Type;

   type Node_Type (Kind : Kind_Type) is record
      Ref_Counter : Util.Concurrent.Counters.Counter;
      case Kind is
         when N_NOT =>
            Expr : Node_Type_Access;

         when N_OR | N_AND =>
            Left, Right : Node_Type_Access;

         when N_INSIDE | N_IN_FILE | N_IN_FILE_DIRECT | N_IN_FUNC | N_IN_FUNC_DIRECT =>
            Name   : Ada.Strings.Unbounded.Unbounded_String;
            Inside : Inside_Type;

         when N_RANGE_SIZE =>
            Min_Size : MAT.Types.Target_Size;
            Max_Size : MAT.Types.Target_Size;

         when N_RANGE_ADDR | N_CALL_ADDR | N_CALL_ADDR_DIRECT =>
            Min_Addr : MAT.Types.Target_Addr;
            Max_Addr : MAT.Types.Target_Addr;

         when N_RANGE_TIME =>
            Min_Time : MAT.Types.Target_Tick_Ref;
            Max_Time : MAT.Types.Target_Tick_Ref;

         when N_THREAD =>
            Thread : MAT.Types.Target_Thread_Ref;

         when others =>
            null;
      end case;
   end record;

   --  Evaluate the node against the context.  Returns True if the node expression
   --  selects the memory slot defined by the context.
   function Is_Selected (Node       : in Node_Type;
                         Addr       : in MAT.Types.Target_Addr;
                         Allocation : in MAT.Memory.Allocation) return Boolean;

   type Expression_Type is tagged record
      Node : Node_Type_Access;
   end record;

end MAT.Expressions;

Add INSIDE_DIRECT_FILE and INSIDE_DIRECT_FUNCTION