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

with Ada.IO_Exceptions;

with ADO.Drivers;

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

with ASF.Server;
with ASF.Servlets;

with AWA.Services.Contexts;
with AWA.Components.Factory;
with AWA.Applications.Factory;
with AWA.Applications.Configs;
with AWA.Helpers.Selectors;
with AWA.Permissions.Services;
with AWA.Permissions.Beans;
package body AWA.Applications is

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

   --  ------------------------------
   --  Initialize the application
   --  ------------------------------
   overriding
   procedure Initialize (App     : in out Application;
                         Conf    : in ASF.Applications.Config;
                         Factory : in out ASF.Applications.Main.Application_Factory'Class) is
      Ctx    : AWA.Services.Contexts.Service_Context;
   begin
      Log.Info ("Initializing application");

      Ctx.Set_Context (App'Unchecked_Access, null);
      AWA.Applications.Factory.Set_Application (Factory, App'Unchecked_Access);
      ASF.Applications.Main.Application (App).Initialize (Conf, Factory);

      --  Load the application configuration before any module.
      Application'Class (App).Load_Configuration (App.Get_Config (P_Config_File.P));

      --  Register the application modules and load their configuration.
      Application'Class (App).Initialize_Modules;

      --  Load the plugin application configuration after the module are configured.
      Application'Class (App).Load_Configuration (App.Get_Config (P_Plugin_Config_File.P));
   end Initialize;

   --  ------------------------------
   --  Initialize the application configuration properties.  Properties defined in Conf
   --  are expanded by using the EL expression resolver.
   --  ------------------------------
   overriding
   procedure Initialize_Config (App  : in out Application;
                                Conf : in out ASF.Applications.Config) is
   begin
      Log.Info ("Initializing configuration");

      if Conf.Get ("app.modules.dir", "") = "" then
         Conf.Set ("app.modules.dir", "#{fn:composePath(app_search_dirs,'config')}");
      end if;
      if Conf.Get ("bundle.dir", "") = "" then
         Conf.Set ("bundle.dir", "#{fn:composePath(app_search_dirs,'bundles')}");
      end if;
      if Conf.Get ("ado.queries.paths", "") = "" then
         Conf.Set ("ado.queries.paths", "#{fn:composePath(app_search_dirs,'db')}");
      end if;
      ASF.Applications.Main.Application (App).Initialize_Config (Conf);
      ADO.Drivers.Initialize (Conf);
      App.DB_Factory.Create (Conf.Get ("database"));
      App.Events.Initialize (App'Unchecked_Access);
      AWA.Modules.Initialize (App.Modules, Conf);

      App.Register_Class ("AWA.Helpers.Selectors.Select_List_Bean",
                          AWA.Helpers.Selectors.Create_Select_List_Bean'Access);

      App.Register_Class ("AWA.Permissions.Beans.Permission_Bean",
                          AWA.Permissions.Beans.Create_Permission_Bean'Access);
   end Initialize_Config;

   --  ------------------------------
   --  Initialize the servlets provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application servlets.
   --  ------------------------------
   overriding
   procedure Initialize_Servlets (App : in out Application) is
   begin
      Log.Info ("Initializing application servlets");

      ASF.Applications.Main.Application (App).Initialize_Servlets;
   end Initialize_Servlets;

   --  ------------------------------
   --  Initialize the filters provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application filters.
   --  ------------------------------
   overriding
   procedure Initialize_Filters (App : in out Application) is
   begin
      Log.Info ("Initializing application filters");

      ASF.Applications.Main.Application (App).Initialize_Filters;
   end Initialize_Filters;

   --  ------------------------------
   --  Initialize the ASF components provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the component factories used by the application.
   --  ------------------------------
   overriding
   procedure Initialize_Components (App : in out Application) is
      procedure Register_Functions is
         new ASF.Applications.Main.Register_Functions (AWA.Permissions.Services.Set_Functions);
   begin
      Log.Info ("Initializing application components");

      ASF.Applications.Main.Application (App).Initialize_Components;
      App.Add_Components (AWA.Components.Factory.Definition);
      Register_Functions (App);
   end Initialize_Components;

   --  ------------------------------
   --  Read the application configuration file awa.xml.  This is called after the servlets
   --  and filters have been registered in the application but before the module registration.
   --  ------------------------------
   procedure Load_Configuration (App   : in out Application;
                                 Files : in String) is
      procedure Load_Config (File : in String;
                             Done : out Boolean);

      Paths     : constant String := App.Get_Config (P_Module_Dir.P);
      Ctx       : aliased EL.Contexts.Default.Default_Context;

      procedure Load_Config (File : in String;
                             Done : out Boolean) is
         Path  : constant String := Util.Files.Find_File_Path (File, Paths);
      begin
         Done := False;
         AWA.Applications.Configs.Read_Configuration (App, Path, Ctx'Unchecked_Access, True);

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

      end Load_Config;

   begin
      Util.Files.Iterate_Path (Files, Load_Config'Access);
   end Load_Configuration;

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

   --  ------------------------------
   --  Start the application.  This is called by the server container when the server is started.
   --  ------------------------------
   overriding
   procedure Start (App : in out Application) is
   begin
      --  Start the event service.
      App.Events.Start;

      --  Start the application.
      ASF.Applications.Main.Application (App).Start;

      --  Dump the route and filters to help in configuration issues.
      App.Dump_Routes (Util.Log.INFO_LEVEL);
   end Start;

   --  ------------------------------
   --  Close the application.
   --  ------------------------------
   overriding
   procedure Close (App : in out Application) is
   begin
      App.Events.Stop;
      ASF.Applications.Main.Application (App).Close;
   end Close;

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

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

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

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

   --  ------------------------------
   --  Register the module in the application
   --  ------------------------------
   procedure Register (App     : in out Application;
                       Module  : in AWA.Modules.Module_Access;
                       Name    : in String;
                       URI     : in String := "") is
   begin
      AWA.Modules.Register (App.Modules'Unchecked_Access, App'Unchecked_Access, Module, Name, URI);
   end Register;

   --  ------------------------------
   --  Send the event in the application event queues.
   --  ------------------------------
   procedure Send_Event (App   : in Application;
                         Event : in AWA.Events.Module_Event'Class) is
   begin
      App.Events.Send (Event);
   end Send_Event;

   --  ------------------------------
   --  Execute the <tt>Process</tt> procedure with the event manager used by the application.
   --  ------------------------------
   procedure Do_Event_Manager (App : in out Application;
                               Process : access procedure
                                 (Events : in out AWA.Events.Services.Event_Manager)) is
   begin
      Process (App.Events);
   end Do_Event_Manager;

   --  ------------------------------
   --  Initialize the parser represented by Parser to recognize the configuration
   --  that are specific to the plugins that have been registered so far.
   --  ------------------------------
   procedure Initialize_Parser (App : in out Application'Class;
                                Parser : in out Util.Serialize.IO.Parser'Class) is
      procedure Process (Module : in out AWA.Modules.Module'Class);

      procedure Process (Module : in out AWA.Modules.Module'Class) is
      begin
         Module.Initialize_Parser (Parser);
      end Process;
   begin
      AWA.Modules.Iterate (App.Modules, Process'Access);
   end Initialize_Parser;

   --  ------------------------------
   --  Get the current application from the servlet context or service context.
   --  ------------------------------
   function Current return Application_Access is
      use type AWA.Services.Contexts.Service_Context_Access;

      Ctx : constant AWA.Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
   begin
      if Ctx /= null then
         return Ctx.Get_Application;
      end if;

      --  If there is no service context, look in the servlet current context.
      declare
         use type ASF.Servlets.Servlet_Registry_Access;

         Ctx : constant ASF.Servlets.Servlet_Registry_Access := ASF.Server.Current;
      begin
         if Ctx = null then
            Log.Warn ("There is no service context");
            return null;
         end if;
         if not (Ctx.all in AWA.Applications.Application'Class) then
            Log.Warn ("The servlet context is not an application");
            return null;
         end if;
         return AWA.Applications.Application'Class (Ctx.all)'Access;
      end;
   end Current;

end AWA.Applications;

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

with Ada.IO_Exceptions;

with ADO.Drivers;

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

with ASF.Server;
with ASF.Servlets;

with AWA.Services.Contexts;
with AWA.Components.Factory;
with AWA.Applications.Factory;
with AWA.Applications.Configs;
with AWA.Helpers.Selectors;
with AWA.Permissions.Services;
with AWA.Permissions.Beans;
package body AWA.Applications is

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

   --  ------------------------------
   --  Initialize the application
   --  ------------------------------
   overriding
   procedure Initialize (App     : in out Application;
                         Conf    : in ASF.Applications.Config;
                         Factory : in out ASF.Applications.Main.Application_Factory'Class) is
      Ctx    : AWA.Services.Contexts.Service_Context;
   begin
      Log.Info ("Initializing application");

      Ctx.Set_Context (App'Unchecked_Access, null);
      AWA.Applications.Factory.Set_Application (Factory, App'Unchecked_Access);
      ASF.Applications.Main.Application (App).Initialize (Conf, Factory);

      --  Load the application configuration before any module.
      Application'Class (App).Load_Configuration (App.Get_Config (P_Config_File.P));

      --  Register the application modules and load their configuration.
      Application'Class (App).Initialize_Modules;

      --  Load the plugin application configuration after the module are configured.
      Application'Class (App).Load_Configuration (App.Get_Config (P_Plugin_Config_File.P));
   end Initialize;

   --  ------------------------------
   --  Initialize the application configuration properties.  Properties defined in Conf
   --  are expanded by using the EL expression resolver.
   --  ------------------------------
   overriding
   procedure Initialize_Config (App  : in out Application;
                                Conf : in out ASF.Applications.Config) is
   begin
      Log.Info ("Initializing configuration");

      if Conf.Get ("app.modules.dir", "") = "" then
         Conf.Set ("app.modules.dir", "#{fn:composePath(app_search_dirs,'config')}");
      end if;
      if Conf.Get ("bundle.dir", "") = "" then
         Conf.Set ("bundle.dir", "#{fn:composePath(app_search_dirs,'bundles')}");
      end if;
      if Conf.Get ("ado.queries.paths", "") = "" then
         Conf.Set ("ado.queries.paths", "#{fn:composePath(app_search_dirs,'db')}");
      end if;
      ASF.Applications.Main.Application (App).Initialize_Config (Conf);
      ADO.Drivers.Initialize (Conf);
      App.DB_Factory.Create (Conf.Get (P_Database.P));
      App.Events.Initialize (App'Unchecked_Access);
      AWA.Modules.Initialize (App.Modules, Conf);

      App.Register_Class ("AWA.Helpers.Selectors.Select_List_Bean",
                          AWA.Helpers.Selectors.Create_Select_List_Bean'Access);

      App.Register_Class ("AWA.Permissions.Beans.Permission_Bean",
                          AWA.Permissions.Beans.Create_Permission_Bean'Access);
   end Initialize_Config;

   --  ------------------------------
   --  Initialize the servlets provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application servlets.
   --  ------------------------------
   overriding
   procedure Initialize_Servlets (App : in out Application) is
   begin
      Log.Info ("Initializing application servlets");

      ASF.Applications.Main.Application (App).Initialize_Servlets;
   end Initialize_Servlets;

   --  ------------------------------
   --  Initialize the filters provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application filters.
   --  ------------------------------
   overriding
   procedure Initialize_Filters (App : in out Application) is
   begin
      Log.Info ("Initializing application filters");

      ASF.Applications.Main.Application (App).Initialize_Filters;
   end Initialize_Filters;

   --  ------------------------------
   --  Initialize the ASF components provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the component factories used by the application.
   --  ------------------------------
   overriding
   procedure Initialize_Components (App : in out Application) is
      procedure Register_Functions is
         new ASF.Applications.Main.Register_Functions (AWA.Permissions.Services.Set_Functions);
   begin
      Log.Info ("Initializing application components");

      ASF.Applications.Main.Application (App).Initialize_Components;
      App.Add_Components (AWA.Components.Factory.Definition);
      Register_Functions (App);
   end Initialize_Components;

   --  ------------------------------
   --  Read the application configuration file awa.xml.  This is called after the servlets
   --  and filters have been registered in the application but before the module registration.
   --  ------------------------------
   procedure Load_Configuration (App   : in out Application;
                                 Files : in String) is
      procedure Load_Config (File : in String;
                             Done : out Boolean);

      Paths     : constant String := App.Get_Config (P_Module_Dir.P);
      Ctx       : aliased EL.Contexts.Default.Default_Context;

      procedure Load_Config (File : in String;
                             Done : out Boolean) is
         Path  : constant String := Util.Files.Find_File_Path (File, Paths);
      begin
         Done := False;
         AWA.Applications.Configs.Read_Configuration (App, Path, Ctx'Unchecked_Access, True);

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

      end Load_Config;

   begin
      Util.Files.Iterate_Path (Files, Load_Config'Access);
   end Load_Configuration;

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

   --  ------------------------------
   --  Start the application.  This is called by the server container when the server is started.
   --  ------------------------------
   overriding
   procedure Start (App : in out Application) is
   begin
      --  Start the event service.
      App.Events.Start;

      --  Start the application.
      ASF.Applications.Main.Application (App).Start;

      --  Dump the route and filters to help in configuration issues.
      App.Dump_Routes (Util.Log.INFO_LEVEL);
   end Start;

   --  ------------------------------
   --  Close the application.
   --  ------------------------------
   overriding
   procedure Close (App : in out Application) is
   begin
      App.Events.Stop;
      ASF.Applications.Main.Application (App).Close;
   end Close;

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

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

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

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

   --  ------------------------------
   --  Register the module in the application
   --  ------------------------------
   procedure Register (App     : in out Application;
                       Module  : in AWA.Modules.Module_Access;
                       Name    : in String;
                       URI     : in String := "") is
   begin
      AWA.Modules.Register (App.Modules'Unchecked_Access, App'Unchecked_Access, Module, Name, URI);
   end Register;

   --  ------------------------------
   --  Send the event in the application event queues.
   --  ------------------------------
   procedure Send_Event (App   : in Application;
                         Event : in AWA.Events.Module_Event'Class) is
   begin
      App.Events.Send (Event);
   end Send_Event;

   --  ------------------------------
   --  Execute the <tt>Process</tt> procedure with the event manager used by the application.
   --  ------------------------------
   procedure Do_Event_Manager (App : in out Application;
                               Process : access procedure
                                 (Events : in out AWA.Events.Services.Event_Manager)) is
   begin
      Process (App.Events);
   end Do_Event_Manager;

   --  ------------------------------
   --  Initialize the parser represented by Parser to recognize the configuration
   --  that are specific to the plugins that have been registered so far.
   --  ------------------------------
   procedure Initialize_Parser (App : in out Application'Class;
                                Parser : in out Util.Serialize.IO.Parser'Class) is
      procedure Process (Module : in out AWA.Modules.Module'Class);

      procedure Process (Module : in out AWA.Modules.Module'Class) is
      begin
         Module.Initialize_Parser (Parser);
      end Process;
   begin
      AWA.Modules.Iterate (App.Modules, Process'Access);
   end Initialize_Parser;

   --  ------------------------------
   --  Get the current application from the servlet context or service context.
   --  ------------------------------
   function Current return Application_Access is
      use type AWA.Services.Contexts.Service_Context_Access;

      Ctx : constant AWA.Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
   begin
      if Ctx /= null then
         return Ctx.Get_Application;
      end if;

      --  If there is no service context, look in the servlet current context.
      declare
         use type ASF.Servlets.Servlet_Registry_Access;

         Ctx : constant ASF.Servlets.Servlet_Registry_Access := ASF.Server.Current;
      begin
         if Ctx = null then
            Log.Warn ("There is no service context");
            return null;
         end if;
         if not (Ctx.all in AWA.Applications.Application'Class) then
            Log.Warn ("The servlet context is not an application");
            return null;
         end if;
         return AWA.Applications.Application'Class (Ctx.all)'Access;
      end;
   end Current;

end AWA.Applications;

Use the P_Database configuration parameter to configure the database


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

with Sqlite3_H;
with Interfaces.C.Strings;

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

package body ADO.Drivers.Connections.Sqlite is

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

   pragma Linker_Options ("-lsqlite3");

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

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

   No_Callback : constant Sqlite3_H.sqlite3_callback := null;

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

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

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

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

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

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

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

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

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

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

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

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

      SQL_Stat  : Strings.chars_ptr := Strings.New_String (SQL);
      Result    : int;
      Error_Msg : Strings.chars_ptr;
   begin
      Log.Debug ("Execute: {0}", SQL);

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

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

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

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

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

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

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

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

   DB : Ref.Ref;

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

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

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

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

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

      declare
         Database : constant Database_Connection_Access := new Database_Connection;

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

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

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

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

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

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

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

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

end ADO.Drivers.Connections.Sqlite;

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

with Sqlite3_H;
with Interfaces.C.Strings;

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

package body ADO.Drivers.Connections.Sqlite is

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

   pragma Linker_Options ("-lsqlite3");

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

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

   No_Callback : constant Sqlite3_H.sqlite3_callback := null;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

   DB : Ref.Ref;

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

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

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

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

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

      declare
         Database : constant Database_Connection_Access := new Database_Connection;

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

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

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

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

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

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

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

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

end ADO.Drivers.Connections.Sqlite;

Use ADO.C.String_Ptr type for string->C string management


-----------------------------------------------------------------------
--  awa-comments-module -- Comments module
--  Copyright (C) 2011, 2012, 2013, 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.Calendar;

with Util.Log.Loggers;

with ADO.Sessions;
with ADO.Sessions.Entities;
with Security.Permissions;

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

package body AWA.Comments.Modules is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Comments.Module");

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

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

      --  Register the comment list bean.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Comments.Beans.Comment_List_Bean",
                         Handler => AWA.Comments.Beans.Create_Comment_List_Bean'Access);

      --  Register the comment bean.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Comments.Beans.Comment_Bean",
                         Handler => AWA.Comments.Beans.Create_Comment_Bean'Access);

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

   --  ------------------------------
   --  Load the comment identified by the given identifier.
   --  ------------------------------
   procedure Load_Comment (Model   : in Comment_Module;
                           Comment : in out AWA.Comments.Models.Comment_Ref'Class;
                           Id      : in ADO.Identifier) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Found : Boolean;
   begin
      Comment.Load (DB, Id, Found);
   end Load_Comment;

   --  ------------------------------
   --  Create a new comment for the associated database entity.
   --  ------------------------------
   procedure Create_Comment (Model       : in Comment_Module;
                             Permission  : in String;
                             Entity_Type : in String;
                             Comment     : in out AWA.Comments.Models.Comment_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;
      Log.Info ("Creating new comment for {0}", ADO.Identifier'Image (Comment.Get_Entity_Id));

      --  Check that the user has the create permission on the given workspace.
      AWA.Permissions.Check (Permission => Security.Permissions.Get_Permission_Index (Permission),
                             Entity     => Comment.Get_Entity_Id);

      Comment.Set_Entity_Type (ADO.Sessions.Entities.Find_Entity_Type (DB, Entity_Type));
      Comment.Set_Author (User);
      Comment.Set_Create_Date (Ada.Calendar.Clock);
      Comment.Save (DB);
      Ctx.Commit;
   end Create_Comment;

end AWA.Comments.Modules;

-----------------------------------------------------------------------
--  awa-comments-module -- Comments module
--  Copyright (C) 2011, 2012, 2013, 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.Calendar;

with Util.Log.Loggers;

with ADO.Sessions;
with ADO.Sessions.Entities;
with Security.Permissions;

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

package body AWA.Comments.Modules is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Comments.Module");

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

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

      --  Register the comment list bean.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Comments.Beans.Comment_List_Bean",
                         Handler => AWA.Comments.Beans.Create_Comment_List_Bean'Access);

      --  Register the comment bean.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Comments.Beans.Comment_Bean",
                         Handler => AWA.Comments.Beans.Create_Comment_Bean'Access);

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

   --  ------------------------------
   --  Load the comment identified by the given identifier.
   --  ------------------------------
   procedure Load_Comment (Model   : in Comment_Module;
                           Comment : in out AWA.Comments.Models.Comment_Ref'Class;
                           Id      : in ADO.Identifier) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Found : Boolean;
   begin
      Comment.Load (DB, Id, Found);
   end Load_Comment;

   --  ------------------------------
   --  Create a new comment for the associated database entity.
   --  ------------------------------
   procedure Create_Comment (Model       : in Comment_Module;
                             Permission  : in String;
                             Entity_Type : in String;
                             Comment     : in out AWA.Comments.Models.Comment_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;
      Log.Info ("Creating new comment for {0}", ADO.Identifier'Image (Comment.Get_Entity_Id));

      --  Check that the user has the create permission on the given workspace.
      AWA.Permissions.Check (Permission => Security.Permissions.Get_Permission_Index (Permission),
                             Entity     => Comment.Get_Entity_Id);

      Comment.Set_Entity_Type (ADO.Sessions.Entities.Find_Entity_Type (DB, Entity_Type));
      Comment.Set_Author (User);
      Comment.Set_Create_Date (Ada.Calendar.Clock);
      Comment.Save (DB);
      Ctx.Commit;
   end Create_Comment;

   --  ------------------------------
   --  Update the comment represented by <tt>Comment</tt> if the current user has the
   --  permission identified by <tt>Permission</tt>.
   --  ------------------------------
   procedure Update_Comment (Model       : in Comment_Module;
                             Permission  : in String;
                             Comment     : in out AWA.Comments.Models.Comment_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      if not Comment.Is_Inserted then
         Log.Error ("The comment was not created");
         raise Not_Found with "The comment was not inserted";
      end if;
      Ctx.Start;
      Log.Info ("Updating the comment {0}", ADO.Identifier'Image (Comment.Get_Id));

      --  Check that the user has the update permission on the given comment.
      AWA.Permissions.Check (Permission => Security.Permissions.Get_Permission_Index (Permission),
                             Entity     => Comment);
      Comment.Save (DB);
      Ctx.Commit;
   end Update_Comment;

   --  ------------------------------
   --  Delete the comment represented by <tt>Comment</tt> if the current user has the
   --  permission identified by <tt>Permission</tt>.
   --  ------------------------------
   procedure Delete_Comment (Model       : in Comment_Module;
                             Permission  : in String;
                             Comment     : in out AWA.Comments.Models.Comment_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;

      --  Check that the user has the delete permission on the given answer.
      AWA.Permissions.Check (Permission => Security.Permissions.Get_Permission_Index (Permission),
                             Entity     => Comment);

      Comment.Delete (DB);
      Ctx.Commit;
   end Delete_Comment;

end AWA.Comments.Modules;

Implement the new operation Delete_Comment and Update_Comment


-----------------------------------------------------------------------
--  el-utils -- Utilities around EL
--  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.Strings.Unbounded;

with Util.Strings;
with Util.Beans.Basic;
with Util.Log.Loggers;

with EL.Objects;
with EL.Expressions;
with EL.Contexts.Default;
with EL.Contexts.Properties;
package body EL.Utils is

   use Util.Log;
   use Ada.Strings.Unbounded;
   use Util.Beans.Objects;

   --  The logger
   Log : constant Loggers.Logger := Loggers.Create ("EL.Utils");

   --  ------------------------------
   --  Expand the properties stored in Source by evaluating the EL expressions
   --  used in the property values.  The EL context passed in Context can be used
   --  to specify the EL functions or some pre-defined beans that could be used.
   --  The EL context will integrate the source properties as well as properties stored
   --  in Into (only the Source properties will be evaluated).
   --  ------------------------------
   procedure Expand (Source  : in Util.Properties.Manager'Class;
                     Into    : in out Util.Properties.Manager'Class;
                     Context : in EL.Contexts.ELContext'Class) is

      function Expand (Value   : in String;
                       Context : in EL.Contexts.ELContext'Class) return EL.Objects.Object;

      --  Copy the property identified by Name into the application config properties.
      --  The value passed in Item is expanded if it contains an EL expression.
      procedure Process (Name, Item : in Util.Properties.Value);

      type Local_Resolver is new EL.Contexts.Properties.Property_Resolver with null record;

      --  Get the value associated with a base object and a given property.
      overriding
      function Get_Value (Resolver : in Local_Resolver;
                          Context  : in EL.Contexts.ELContext'Class;
                          Base     : access Util.Beans.Basic.Readonly_Bean'Class;
                          Name     : in Unbounded_String) return EL.Objects.Object;

      --  ------------------------------
      --  Get the value associated with a base object and a given property.
      --  ------------------------------
      overriding
      function Get_Value (Resolver : in Local_Resolver;
                          Context  : in EL.Contexts.ELContext'Class;
                          Base     : access Util.Beans.Basic.Readonly_Bean'Class;
                          Name     : in Unbounded_String) return EL.Objects.Object is
         pragma Unreferenced (Resolver);
      begin
         if Base /= null then
            return Base.Get_Value (To_String (Name));

         elsif Into.Exists (Name) then
            declare
               Value  : constant String := Into.Get (Name);
            begin
               if Util.Strings.Index (Value, '{') = 0 or Util.Strings.Index (Value, '}') = 0 then
                  return Util.Beans.Objects.To_Object (Value);
               end if;

               return Expand (Value, Context);
            end;

         elsif Source.Exists (Name) then
            declare
               Value  : constant String := Source.Get (Name);
            begin
               if Util.Strings.Index (Value, '{') = 0 or Util.Strings.Index (Value, '}') = 0 then
                  return Util.Beans.Objects.To_Object (Value);
               end if;

               return Expand (Value, Context);
            end;

         else
            return Util.Beans.Objects.Null_Object;
         end if;
      end Get_Value;

      Recursion : Natural := 10;

      --  ------------------------------
      --  Expand (recursively) the EL expression defined in Value by using
      --  the context.  The recursion is provided by the above context resolver which
      --  invokes Expand if it detects that a value is a possible EL expression.
      --  ------------------------------
      function Expand (Value   : in String;
                       Context : in EL.Contexts.ELContext'Class) return EL.Objects.Object is
         Expr   : EL.Expressions.Expression;
         Result : Util.Beans.Objects.Object;
      begin
         if Recursion = 0 then
            Log.Error ("Too many level of recursion when evaluating expression: {0}", Value);
            return Util.Beans.Objects.Null_Object;
         end if;

         Recursion := Recursion - 1;
         Expr := EL.Expressions.Create_Expression (Value, Context);
         Result := Expr.Get_Value (Context);
         Recursion := Recursion + 1;
         return Result;

         --  Ignore any exception and copy the value verbatim.
      exception
         when others =>
            Recursion := Recursion + 1;
            return Util.Beans.Objects.To_Object (Value);
      end Expand;

      Resolver       : aliased Local_Resolver;
      Local_Context  : aliased EL.Contexts.Default.Default_Context;

      --  ------------------------------
      --  Copy the property identified by Name into the application config properties.
      --  The value passed in Item is expanded if it contains an EL expression.
      --  ------------------------------
      procedure Process (Name, Item : in Util.Properties.Value) is
         use Ada.Strings;
      begin
         if Unbounded.Index (Item, "{") = 0 or Unbounded.Index (Item, "{") = 0 then
            Log.Debug ("Adding config {0} = {1}", Name, Item);

            Into.Set (Name, Item);
         else
            declare
               Value : constant Object := Expand (To_String (Item), Local_Context);
               Val   : Unbounded_String;
            begin
               if not Util.Beans.Objects.Is_Null (Value) then
                  Val := Util.Beans.Objects.To_Unbounded_String (Value);
               end if;
               Log.Debug ("Adding config {0} = {1}", Name, Val);
               Into.Set (Name, Val);
            end;
         end if;
      end Process;

   begin
      Resolver.Set_Properties (Source);
      Local_Context.Set_Function_Mapper (Context.Get_Function_Mapper);
      Local_Context.Set_Resolver (Resolver'Unchecked_Access);

      Source.Iterate (Process'Access);
   end Expand;

   --  ------------------------------
   --  Evaluate the possible EL expressions used in Value and return the
   --  string that correspond to that evaluation.
   --  ------------------------------
   function Eval (Value   : in String;
                  Context : in EL.Contexts.ELContext'Class) return String is
      Expr   : EL.Expressions.Expression;
      Result : Util.Beans.Objects.Object;
   begin
      Expr := EL.Expressions.Create_Expression (Value, Context);
      Result := Expr.Get_Value (Context);
      return Util.Beans.Objects.To_String (Result);

      --  Ignore any exception and copy the value verbatim.
   exception
      when others =>
         return Value;
   end Eval;

   --  ------------------------------
   --  Evaluate the possible EL expressions used in Value and return an
   --  object that correspond to that evaluation.
   --  ------------------------------
   function Eval (Value   : in String;
                  Context : in EL.Contexts.ELContext'Class) return Util.Beans.Objects.Object is
      Expr   : EL.Expressions.Expression;
   begin
      Expr := EL.Expressions.Create_Expression (Value, Context);
      return Expr.Get_Value (Context);

      --  Ignore any exception and copy the value verbatim.
   exception
      when others =>
         return Util.Beans.Objects.To_Object (Value);
   end Eval;

   --  ------------------------------
   --  Evaluate the possible EL expressions used in Value and return an
   --  object that correspond to that evaluation.
   --  ------------------------------
   function Eval (Value   : in Util.Beans.Objects.Object;
                  Context : in EL.Contexts.ELContext'Class) return Util.Beans.Objects.Object is
   begin
      case Util.Beans.Objects.Get_Type (Value) is
         when Util.Beans.Objects.TYPE_STRING | Util.Beans.Objects.TYPE_WIDE_STRING =>
            declare
               S    : constant String := Util.Beans.Objects.To_String (Value);
               Expr : EL.Expressions.Expression;
            begin
               Expr := EL.Expressions.Create_Expression (S, Context);
               return Expr.Get_Value (Context);
            end;

         when others =>
            return Value;
      end case;

      --  Ignore any exception and copy the value verbatim.
   exception
      when others =>
         return Value;
   end Eval;

end EL.Utils;

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

with Ada.Strings.Unbounded;

with Util.Strings;
with Util.Beans.Basic;
with Util.Log.Loggers;

with EL.Objects;
with EL.Expressions;
with EL.Contexts.Default;
with EL.Contexts.Properties;
package body EL.Utils is

   use Ada.Strings.Unbounded;
   use Util.Beans.Objects;

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("EL.Utils");

   --  ------------------------------
   --  Expand the properties stored in Source by evaluating the EL expressions
   --  used in the property values.  The EL context passed in Context can be used
   --  to specify the EL functions or some pre-defined beans that could be used.
   --  The EL context will integrate the source properties as well as properties stored
   --  in Into (only the Source properties will be evaluated).
   --  ------------------------------
   procedure Expand (Source  : in Util.Properties.Manager'Class;
                     Into    : in out Util.Properties.Manager'Class;
                     Context : in EL.Contexts.ELContext'Class) is

      function Expand (Value   : in String;
                       Context : in EL.Contexts.ELContext'Class) return EL.Objects.Object;

      --  Copy the property identified by Name into the application config properties.
      --  The value passed in Item is expanded if it contains an EL expression.
      procedure Process (Name : in String;
                         Item : in Util.Beans.Objects.Object);

      type Local_Resolver is new EL.Contexts.Properties.Property_Resolver with null record;

      --  Get the value associated with a base object and a given property.
      overriding
      function Get_Value (Resolver : in Local_Resolver;
                          Context  : in EL.Contexts.ELContext'Class;
                          Base     : access Util.Beans.Basic.Readonly_Bean'Class;
                          Name     : in Unbounded_String) return EL.Objects.Object;

      --  ------------------------------
      --  Get the value associated with a base object and a given property.
      --  ------------------------------
      overriding
      function Get_Value (Resolver : in Local_Resolver;
                          Context  : in EL.Contexts.ELContext'Class;
                          Base     : access Util.Beans.Basic.Readonly_Bean'Class;
                          Name     : in Unbounded_String) return EL.Objects.Object is
         pragma Unreferenced (Resolver);
      begin
         if Base /= null then
            return Base.Get_Value (To_String (Name));

         elsif Into.Exists (Name) then
            declare
               Value  : constant String := Into.Get (Name);
            begin
               if Util.Strings.Index (Value, '{') = 0 or Util.Strings.Index (Value, '}') = 0 then
                  return Util.Beans.Objects.To_Object (Value);
               end if;

               return Expand (Value, Context);
            end;

         elsif Source.Exists (Name) then
            declare
               Value  : constant String := Source.Get (Name);
            begin
               if Util.Strings.Index (Value, '{') = 0 or Util.Strings.Index (Value, '}') = 0 then
                  return Util.Beans.Objects.To_Object (Value);
               end if;

               return Expand (Value, Context);
            end;

         else
            return Util.Beans.Objects.Null_Object;
         end if;
      end Get_Value;

      Recursion : Natural := 10;

      --  ------------------------------
      --  Expand (recursively) the EL expression defined in Value by using
      --  the context.  The recursion is provided by the above context resolver which
      --  invokes Expand if it detects that a value is a possible EL expression.
      --  ------------------------------
      function Expand (Value   : in String;
                       Context : in EL.Contexts.ELContext'Class) return EL.Objects.Object is
         Expr   : EL.Expressions.Expression;
         Result : Util.Beans.Objects.Object;
      begin
         if Recursion = 0 then
            Log.Error ("Too many level of recursion when evaluating expression: {0}", Value);
            return Util.Beans.Objects.Null_Object;
         end if;

         Recursion := Recursion - 1;
         Expr := EL.Expressions.Create_Expression (Value, Context);
         Result := Expr.Get_Value (Context);
         Recursion := Recursion + 1;
         return Result;

         --  Ignore any exception and copy the value verbatim.
      exception
         when others =>
            Recursion := Recursion + 1;
            return Util.Beans.Objects.To_Object (Value);
      end Expand;

      Resolver       : aliased Local_Resolver;
      Local_Context  : aliased EL.Contexts.Default.Default_Context;

      --  ------------------------------
      --  Copy the property identified by Name into the application config properties.
      --  The value passed in Item is expanded if it contains an EL expression.
      --  ------------------------------
      procedure Process (Name : in String;
                         Item : in Util.Properties.Value) is
         use Ada.Strings;
         Value : constant String := Util.Properties.To_String (Item);
      begin
         if Util.Strings.Index (Value, '{') = 0 or Util.Strings.Index (Value, '}') = 0 then
            Log.Debug ("Adding config {0} = {1}", Name, Value);

            Into.Set_Value (Name, Item);
         else
            declare
               New_Value : constant Object := Expand (Value, Local_Context);
            begin
               Log.Debug ("Adding config {0} = {1}",
                          Name, Util.Beans.Objects.To_String (New_Value));
               if Util.Beans.Objects.Is_Null (New_Value) then
                  Into.Set (Name, "");
               else
                  Into.Set_Value (Name, New_Value);
               end if;
            end;
         end if;
      end Process;

   begin
      Resolver.Set_Properties (Source);
      Local_Context.Set_Function_Mapper (Context.Get_Function_Mapper);
      Local_Context.Set_Resolver (Resolver'Unchecked_Access);

      Source.Iterate (Process'Access);
   end Expand;

   --  ------------------------------
   --  Evaluate the possible EL expressions used in Value and return the
   --  string that correspond to that evaluation.
   --  ------------------------------
   function Eval (Value   : in String;
                  Context : in EL.Contexts.ELContext'Class) return String is
      Expr   : EL.Expressions.Expression;
      Result : Util.Beans.Objects.Object;
   begin
      Expr := EL.Expressions.Create_Expression (Value, Context);
      Result := Expr.Get_Value (Context);
      return Util.Beans.Objects.To_String (Result);

      --  Ignore any exception and copy the value verbatim.
   exception
      when others =>
         return Value;
   end Eval;

   --  ------------------------------
   --  Evaluate the possible EL expressions used in Value and return an
   --  object that correspond to that evaluation.
   --  ------------------------------
   function Eval (Value   : in String;
                  Context : in EL.Contexts.ELContext'Class) return Util.Beans.Objects.Object is
      Expr   : EL.Expressions.Expression;
   begin
      Expr := EL.Expressions.Create_Expression (Value, Context);
      return Expr.Get_Value (Context);

      --  Ignore any exception and copy the value verbatim.
   exception
      when others =>
         return Util.Beans.Objects.To_Object (Value);
   end Eval;

   --  ------------------------------
   --  Evaluate the possible EL expressions used in Value and return an
   --  object that correspond to that evaluation.
   --  ------------------------------
   function Eval (Value   : in Util.Beans.Objects.Object;
                  Context : in EL.Contexts.ELContext'Class) return Util.Beans.Objects.Object is
   begin
      case Util.Beans.Objects.Get_Type (Value) is
         when Util.Beans.Objects.TYPE_STRING | Util.Beans.Objects.TYPE_WIDE_STRING =>
            declare
               S    : constant String := Util.Beans.Objects.To_String (Value);
               Expr : EL.Expressions.Expression;
            begin
               Expr := EL.Expressions.Create_Expression (S, Context);
               return Expr.Get_Value (Context);
            end;

         when others =>
            return Value;
      end case;

      --  Ignore any exception and copy the value verbatim.
   exception
      when others =>
         return Value;
   end Eval;

end EL.Utils;

Update the Expand procedure to take into account the new Util.Properties package operations


-----------------------------------------------------------------------
--  measure -- Benchmark tools
--  Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 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.Text_IO;
with Ada.Calendar;
with Ada.Containers;
with Ada.Finalization;

with Util.Streams.Texts;

--  = Performance Measurements =
--
--  Performance measurements is often made using profiling tools such as GNU gprof or others.
--  This profiling is however not always appropriate for production or release delivery.
--  The mechanism presented here is a lightweight performance measurement that can be
--  used in production systems.
--
--  The Ada package `Util.Measures` defines the types and operations to make
--  performance measurements.  It is designed to be used for production and multi-threaded
--  environments.
--
--  == Create the measure set ==
--
--  Measures are collected in a `Measure_Set`.  Each measure has a name, a counter and
--  a sum of time spent for all the measure.  The measure set should be declared as some
--  global variable.  The implementation is thread safe meaning that a measure set can
--  be used by several threads at the same time.  It can also be associated with
--  a per-thread data (or task attribute).
--
--  To declare the measure set, use:
--
--     with Util.Measures;
--        ...
--        Perf : Util.Measures.Measure_Set;
--
--  == Measure the implementation ==
--
--  A measure is made by creating a variable of type `Stamp`.  The declaration of
--  this variable marks the begining of the measure.  The measure ends at the
--  next call to the `Report` procedure.
--
--     with Util.Measures;
--     ...
--       declare
--          Start : Util.Measures.Stamp;
--       begin
--          ...
--          Util.Measures.Report (Perf, Start, "Measure for a block");
--       end;
--
--  When the `Report` procedure is called, the time that elapsed between the creation of
--  the `Start` variable and the procedure call is computed.  This time is
--  then associated with the measure title and the associated counter is incremented.
--  The precision of the measured time depends on the system.  On GNU/Linux, it uses
--  `gettimeofday`.
--
--  If the block code is executed several times, the measure set will report
--  the number of times it was executed.
--
--  == Reporting results ==
--
--  After measures are collected, the results can be saved in a file or in
--  an output stream.  When saving the measures, the measure set is cleared.
--
--     Util.Measures.Write (Perf, "Title of measures",
--                          Ada.Text_IO.Standard_Output);
--
--  == Measure Overhead ==
--
--  The overhead introduced by the measurement is quite small as it does not exceeds 1.5 us
--  on a 2.6 Ghz Core Quad.
--
--  == What must be measured ==
--
--  Defining a lot of measurements for a production system is in general not very useful.
--  Measurements should be relatively high level measurements.  For example:
--
--    * Loading or saving a file
--    * Rendering a page in a web application
--    * Executing a database query
--
package Util.Measures is

   type Unit_Type is (Seconds, Milliseconds, Microseconds, Nanoseconds);

   --  ------------------------------
   --  Measure Set
   --  ------------------------------
   --  The measure set represent a collection of measures each of them being
   --  associated with a same name.  Several measure sets can be created to
   --  collect different kinds of runtime information.  The measure set can be
   --  set on a per-thread data and every call to Report will be
   --  associated with that measure set.
   --
   --  Measure set are thread-safe.
   type Measure_Set is limited private;
   type Measure_Set_Access is access all Measure_Set;

   --  Disable collecting measures on the measure set.
   procedure Disable (Measures : in out Measure_Set);

   --  Enable collecting measures on the measure set.
   procedure Enable (Measures : in out Measure_Set);

   --  Set the per-thread measure set.
   procedure Set_Current (Measures : in Measure_Set_Access);

   --  Get the per-thread measure set.
   function Get_Current return Measure_Set_Access;

   --  Dump an XML result with the measures collected by the measure set.
   --  When writing the measures, the measure set is cleared.  It is safe
   --  to write measures while other measures are being collected.
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Stream   : in out Util.Streams.Texts.Print_Stream'Class);

   --  Dump an XML result with the measures collected by the measure set.
   --  When writing the measures, the measure set is cleared.  It is safe
   --  to write measures while other measures are being collected.
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Stream   : in Ada.Text_IO.File_Type);

   --  Dump  an XML result with the measures in a file.
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Path     : in String);

   --  ------------------------------
   --  Stamp
   --  ------------------------------
   --  The stamp marks the beginning of a measure when the variable of such
   --  type is declared.  The measure represents the time that elapsed between
   --  the stamp creation and when the Report method is called.
   type Stamp is limited private;

   --  Report the time spent between the stamp creation and this method call.
   --  Collect the result in the per-thread measure set under the given measure
   --  title.
   procedure Report (S     : in out Stamp;
                     Title : in String;
                     Count : in Positive := 1);

   --  Report the time spent between the stamp creation and this method call.
   --  Collect the result in the measure set under the given measure title.
   procedure Report (Measures : in out Measure_Set;
                     S        : in out Stamp;
                     Title    : in String;
                     Count    : in Positive := 1);

   --  Report the time spent between the stamp creation and this method call.
   --  The report is written in the file with the given title.  The duration is
   --  expressed in the unit defined in <tt>Unit</tt>.
   procedure Report (S     : in out Stamp;
                     File  : in out Ada.Text_IO.File_Type;
                     Title : in String;
                     Unit  : in Unit_Type := Microseconds);

private

   type String_Access is access String;

   type Stamp is limited record
      Start : Ada.Calendar.Time := Ada.Calendar.Clock;
   end record;

   type Measure;
   type Measure_Access is access Measure;

   type Measure is limited record
      Next  : Measure_Access;
      Time  : Duration;
      Count : Positive;
      Name  : String_Access;
   end record;

   type Buckets_Type is
     array (Ada.Containers.Hash_Type range <>) of Measure_Access;
   type Buckets_Access is access all Buckets_Type;

   --  To reduce contention we only protect insertion and updates of measures.
   --  To write the measure set, we steal the buckets and force the next call
   --  to Add to reallocate the buckets.
   protected type Measure_Data is

      --  Get the measures and clear to start a new set of measures.
      --  Return in Time_Start and Time_End the period of time.
      procedure Steal_Map (Result     : out Buckets_Access;
                           Time_Start : out Ada.Calendar.Time;
                           Time_End   : out Ada.Calendar.Time);

      --  Add the measure
      procedure Add (Title : in String;
                     D     : in Duration;
                     Count : in Positive := 1);

   private
      Start   : Ada.Calendar.Time := Ada.Calendar.Clock;
      Buckets : Buckets_Access;
   end Measure_Data;

   type Measure_Set is new Ada.Finalization.Limited_Controlled with record
      Enabled : Boolean := True;
      pragma Atomic (Enabled);

      Data    : Measure_Data;
   end record;

   --  Finalize the measures and release the storage.
   overriding
   procedure Finalize (Measures : in out Measure_Set);

end Util.Measures;

Fix style compilation warning

Fix style compilation warning


-----------------------------------------------------------------------
--  mat-consoles-text - Text console interface
--  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.Text_IO;

with Gtk.Enums;
with Gtk.Tree_View_Column;
with Gtk.Scrolled_Window;

with Util.Log.Loggers;
package body MAT.Consoles.Gtkmat is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Consoles.Gtkmat");

   --  ------------------------------
   --  Initialize the console to display the result in the Gtk frame.
   --  ------------------------------
   procedure Initialize (Console : in out Console_Type;
                         Frame   : in Gtk.Frame.Gtk_Frame) is
   begin
      Console.Frame := Frame;
   end Initialize;

   --  Report a notice message.
   overriding
   procedure Notice (Console : in out Console_Type;
                     Kind    : in Notice_Type;
                     Message : in String) is
   begin
      null;
   end Notice;

   --  Report an error message.
   overriding
   procedure Error (Console : in out Console_Type;
                    Message : in String) is
   begin
      null;
   end Error;

   --  Print the field value for the given field.
   overriding
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in String) is
   begin
      Log.Debug ("Field {0} - {1}", Field_Type'Image (Field), Value);
      Gtk.List_Store.Set (Console.List, Console.Current_Row, Console.Indexes (Field), Value);
   end Print_Field;

   --  Print the title for the given field.
   overriding
   procedure Print_Title (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Title   : in String) is
      Pos : constant Positive := Console.Field_Count;
   begin
      Console.Indexes (Field) := Glib.Gint (Pos - 1);
      Console.Columns (Pos).Field := Field;
      Console.Columns (Pos).Title := Ada.Strings.Unbounded.To_Unbounded_String (Title);
   end Print_Title;

   --  Start a new title in a report.
   overriding
   procedure Start_Title (Console : in out Console_Type) is
   begin
      Gtk.Cell_Renderer_Text.Gtk_New (Console.Col_Text);
      Console.Indexes := (others => 0);
   end Start_Title;

   --  Finish a new title in a report.
   procedure End_Title (Console : in out Console_Type) is
      use type Glib.Guint;
      use type Glib.Gint;
      use Gtk.List_Store;

      Types : Glib.GType_Array (0 .. Glib.Guint (Console.Field_Count) - 1)
        := (others => Glib.GType_String);
      Col      : Gtk.Tree_View_Column.Gtk_Tree_View_Column;
      Num : Glib.Gint;
      Scrolled : Gtk.Scrolled_Window.Gtk_Scrolled_Window;
   begin
      Gtk.List_Store.Gtk_New (Console.List, Types);

      Gtk.Scrolled_Window.Gtk_New (Scrolled);
      Scrolled.Set_Policy (Gtk.Enums.Policy_Always, Gtk.Enums.Policy_Always);

      Gtk.Tree_View.Gtk_New (Console.Tree);
      for I in 1 .. Console.Field_Count loop
         Gtk.Tree_View_Column.Gtk_New (Col);
         Num := Console.Tree.Append_Column (Col);
         Col.Set_Sort_Column_Id (Glib.Gint (I) - 1);
         Col.Set_Title (Ada.Strings.Unbounded.To_String (Console.Columns (I).Title));
         Col.Pack_Start (Console.Col_Text, True);
         Col.Set_Sizing (Gtk.Tree_View_Column.Tree_View_Column_Autosize);
         Col.Add_Attribute (Console.Col_Text, "text", Glib.Gint (I) - 1);
      end loop;
      Scrolled.Add (Console.Tree);
      Scrolled.Show_All;

      Console.Tree.Set_Model (+Console.List);
      Console.Frame.Add (Scrolled);
      Console.Frame.Show_All;
   end End_Title;

   --  Start a new row in a report.
   overriding
   procedure Start_Row (Console : in out Console_Type) is
   begin
      Console.List.Append (Console.Current_Row);
   end Start_Row;

   --  Finish a new row in a report.
   overriding
   procedure End_Row (Console : in out Console_Type) is
   begin
      null;
   end End_Row;

end MAT.Consoles.Gtkmat;

-----------------------------------------------------------------------
--  mat-consoles-text - Text console interface
--  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.Text_IO;

with Gtk.Enums;
with Gtk.Tree_View_Column;

with Util.Log.Loggers;
package body MAT.Consoles.Gtkmat is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Consoles.Gtkmat");

   --  ------------------------------
   --  Initialize the console to display the result in the Gtk frame.
   --  ------------------------------
   procedure Initialize (Console : in out Console_Type;
                         Frame   : in Gtk.Frame.Gtk_Frame) is
   begin
      Gtk.Scrolled_Window.Gtk_New (Console.Scrolled);
      Console.Scrolled.Set_Policy (Gtk.Enums.Policy_Always, Gtk.Enums.Policy_Always);
      Console.Frame := Frame;
      Console.Frame.Add (Console.Scrolled);
--        Console.Frame.Show_All;
   end Initialize;

   --  Report a notice message.
   overriding
   procedure Notice (Console : in out Console_Type;
                     Kind    : in Notice_Type;
                     Message : in String) is
   begin
      null;
   end Notice;

   --  Report an error message.
   overriding
   procedure Error (Console : in out Console_Type;
                    Message : in String) is
   begin
      null;
   end Error;

   --  Print the field value for the given field.
   overriding
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in String) is
   begin
      Log.Debug ("Field {0} - {1}", Field_Type'Image (Field), Value);
      Gtk.List_Store.Set (Console.List, Console.Current_Row, Console.Indexes (Field), Value);
   end Print_Field;

   --  Print the title for the given field.
   overriding
   procedure Print_Title (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Title   : in String) is
      Pos : constant Positive := Console.Field_Count;
   begin
      Console.Indexes (Field) := Glib.Gint (Pos - 1);
      Console.Columns (Pos).Field := Field;
      Console.Columns (Pos).Title := Ada.Strings.Unbounded.To_Unbounded_String (Title);
   end Print_Title;

   --  Start a new title in a report.
   overriding
   procedure Start_Title (Console : in out Console_Type) is
   begin
      Gtk.Cell_Renderer_Text.Gtk_New (Console.Col_Text);
      Console.Indexes := (others => 0);
   end Start_Title;

   --  Finish a new title in a report.
   procedure End_Title (Console : in out Console_Type) is
      use type Glib.Guint;
      use type Glib.Gint;
      use Gtk.List_Store;

      Types : Glib.GType_Array (0 .. Glib.Guint (Console.Field_Count) - 1)
        := (others => Glib.GType_String);
      Col      : Gtk.Tree_View_Column.Gtk_Tree_View_Column;
      Num : Glib.Gint;
   begin
      Gtk.List_Store.Gtk_New (Console.List, Types);

      Gtk.Tree_View.Gtk_New (Console.Tree);
      for I in 1 .. Console.Field_Count loop
         Gtk.Tree_View_Column.Gtk_New (Col);
         Num := Console.Tree.Append_Column (Col);
         Col.Set_Sort_Column_Id (Glib.Gint (I) - 1);
         Col.Set_Title (Ada.Strings.Unbounded.To_String (Console.Columns (I).Title));
         Col.Pack_Start (Console.Col_Text, True);
         Col.Set_Sizing (Gtk.Tree_View_Column.Tree_View_Column_Autosize);
         Col.Add_Attribute (Console.Col_Text, "text", Glib.Gint (I) - 1);
      end loop;
      Console.Scrolled.Add (Console.Tree);
      Console.Scrolled.Show_All;

      Console.Tree.Set_Model (+Console.List);
   end End_Title;

   --  Start a new row in a report.
   overriding
   procedure Start_Row (Console : in out Console_Type) is
   begin
      Console.List.Append (Console.Current_Row);
   end Start_Row;

   --  Finish a new row in a report.
   overriding
   procedure End_Row (Console : in out Console_Type) is
   begin
      null;
   end End_Row;

end MAT.Consoles.Gtkmat;

Create the scrolled window when the console is created