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

with ASF.Applications.Main;
with ASF.Applications.Main.Configs;
with ADO.Queries;
with ADO.Sessions.Factory;
with AWA.Modules;
with AWA.Events;
with AWA.Events.Services;
with AWA.Audits.Services;

--  == Initialization ==
--  The AWA application is represented by the `Application` type which should
--  be extended for the final application to provide the modules and specific
--  components of the final application.
--
--  The initialization of an AWA application is made in several steps
--  represented by different procedures of the main `Application` type.
--  The whole initialization is handled by the `Initialize` procedure
--  which gets a first set of configuration properties and a factory
--  to build specific component.
--
--  The `Initialize` procedure will perform the following steps:
--
--  * It uses the factory to allocate the ASF lifecycle handler, the navigation
--    handler, the security manager, the OAuth manager, the exception
--    handlers.
--  * It calls the `Initialize_Components` procedure to let the
--    application register all the ASF components.  These components must
--    be registered before any configuration file is read.
--  * It calls the `Initialize_Config`
--  * It calls the `Initialize_Servlets` procedure to allow the application
--    to register all the servlet instances used by the application.
--  * It calls the `Initialize_Filters` procedure to allow the application
--    to register all the servlet filter instances.  The application servlets
--    and filters must be registered before reading the global configuration file.
--  * It loads the global application configuration by reading the `awa.xml`
--    file.  By reading this configuration, some global configuration is
--    established on the servlets, filters.
--  * It calls the `Initialize_Modules` procedure so that all the application
--    modules can be registered, configured and initialized.  Each module
--    brings its own component, servlet and filter.  They are configured
--    by their own XML configuration file.
--  * It loads the module application configuration by reading the XML
--    files described by the `app.config.plugins` configuration.  This last
--    step allows the application to setup and update the configuration
--    of all modules that have been registered.
--
--  == Configuration ==
--  The following global configuration parameter are defined:
--
--  @include-config awa.xml
--
package AWA.Applications is

   --  Directories where the configuration files are searched.
   package P_Module_Dir is
     new ASF.Applications.Main.Configs.Parameter ("app.modules.dir",
                                                  "#{fn:composePath(app_search_dirs,'config')}");

   --  A list of configuration files separated by ';'.  These files are
   --  searched in 'app.modules.dir' and loaded in the order specified before
   --  the application modules.
   package P_Config_File is
     new ASF.Applications.Main.Configs.Parameter ("app.config", "awa.xml");

   --  A list of configuration files separated by ';'.  These files are
   --  searched in 'app.modules.dir' and loaded in the order specified after
   --  all the application modules are initialized.
   package P_Plugin_Config_File is
     new ASF.Applications.Main.Configs.Parameter ("app.config.plugins", "");

   --  The database connection string to connect to the database.
   package P_Database is
     new ASF.Applications.Main.Configs.Parameter ("database",
                                                  "mysql://localhost:3306/db");

   --  The application contextPath configuration that gives the base URL
   --  of the application.
   package P_Context_Path is
     new ASF.Applications.Main.Configs.Parameter ("contextPath",
                                                  "");

   --  Module manager
   --
   --  The `Module_Manager` represents the root of the logic manager

   type Application is new ASF.Applications.Main.Application with private;
   type Application_Access is access all Application'Class;

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

   --  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);

   --  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);

   --  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);

   --  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);

   --  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);

   --  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);

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

   --  Close the application.
   overriding
   procedure Close (App : in out Application);

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

   --  Set a static query loader to load SQL queries.
   procedure Set_Query_Loader (App     : in out Application;
                               Loader  : in ADO.Queries.Static_Loader_Access);

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

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

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

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

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

   --  Execute the `Process` 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));

   --  Get the current application from the servlet context or service context.
   function Current return Application_Access;

private

   --  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);

   type Application is new ASF.Applications.Main.Application with record
      DB_Factory : ADO.Sessions.Factory.Session_Factory;
      Modules    : aliased AWA.Modules.Module_Registry;
      Events     : aliased AWA.Events.Services.Event_Manager;
      Audits     : aliased AWA.Audits.Services.Audit_Manager;
   end record;

end AWA.Applications;

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

with ASF.Applications.Main;
with ASF.Applications.Main.Configs;
with ADO.Queries;
with ADO.Sessions.Factory;
with AWA.Modules;
with AWA.Events;
with AWA.Events.Services;
with AWA.Audits.Services;

--  == Initialization ==
--  The AWA application is represented by the `Application` type which should
--  be extended for the final application to provide the modules and specific
--  components of the final application.
--
--  The initialization of an AWA application is made in several steps
--  represented by different procedures of the main `Application` type.
--  The whole initialization is handled by the `Initialize` procedure
--  which gets a first set of configuration properties and a factory
--  to build specific component.
--
--  The `Initialize` procedure will perform the following steps:
--
--  * It uses the factory to allocate the ASF lifecycle handler, the navigation
--    handler, the security manager, the OAuth manager, the exception
--    handlers.
--  * It calls the `Initialize_Components` procedure to let the
--    application register all the ASF components.  These components must
--    be registered before any configuration file is read.
--  * It calls the `Initialize_Config`
--  * It calls the `Initialize_Servlets` procedure to allow the application
--    to register all the servlet instances used by the application.
--  * It calls the `Initialize_Filters` procedure to allow the application
--    to register all the servlet filter instances.  The application servlets
--    and filters must be registered before reading the global configuration file.
--  * It loads the global application configuration by reading the `awa.xml`
--    file as well as some application specific files.  By reading this
--    configuration, some global configuration is established on the servlets,
--    filters, navigation rules.  The list of XML files loaded during this
--    step is controlled by the `app.config` configuration.
--  * It calls the `Initialize_Modules` procedure so that all the application
--    modules can be registered, configured and initialized.  Each module
--    brings its own component, servlet and filter.  They are configured
--    by their own XML configuration file.
--  * It loads the module application configuration by reading the XML
--    files described by the `app.config.plugins` configuration.  This last
--    step allows the application to setup and update the configuration
--    of all modules that have been registered.
--
--  == Configuration ==
--  The following global configuration parameter are defined:
--
--  @include-config awa.xml
--
package AWA.Applications is

   --  Directories where the configuration files are searched.
   package P_Module_Dir is
     new ASF.Applications.Main.Configs.Parameter ("app.modules.dir",
                                                  "#{fn:composePath(app_search_dirs,'config')}");

   --  A list of configuration files separated by ';'.  These files are
   --  searched in 'app.modules.dir' and loaded in the order specified before
   --  the application modules.
   package P_Config_File is
     new ASF.Applications.Main.Configs.Parameter ("app.config", "awa.xml");

   --  A list of configuration files separated by ';'.  These files are
   --  searched in 'app.modules.dir' and loaded in the order specified after
   --  all the application modules are initialized.
   package P_Plugin_Config_File is
     new ASF.Applications.Main.Configs.Parameter ("app.config.plugins", "");

   --  The database connection string to connect to the database.
   package P_Database is
     new ASF.Applications.Main.Configs.Parameter ("database",
                                                  "mysql://localhost:3306/db");

   --  The application contextPath configuration that gives the base URL
   --  of the application.
   package P_Context_Path is
     new ASF.Applications.Main.Configs.Parameter ("contextPath",
                                                  "");

   --  Module manager
   --
   --  The `Module_Manager` represents the root of the logic manager

   type Application is new ASF.Applications.Main.Application with private;
   type Application_Access is access all Application'Class;

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

   --  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);

   --  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);

   --  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);

   --  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);

   --  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);

   --  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);

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

   --  Close the application.
   overriding
   procedure Close (App : in out Application);

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

   --  Set a static query loader to load SQL queries.
   procedure Set_Query_Loader (App     : in out Application;
                               Loader  : in ADO.Queries.Static_Loader_Access);

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

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

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

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

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

   --  Execute the `Process` 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));

   --  Get the current application from the servlet context or service context.
   function Current return Application_Access;

private

   --  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);

   type Application is new ASF.Applications.Main.Application with record
      DB_Factory : ADO.Sessions.Factory.Session_Factory;
      Modules    : aliased AWA.Modules.Module_Registry;
      Events     : aliased AWA.Events.Services.Event_Manager;
      Audits     : aliased AWA.Audits.Services.Audit_Manager;
   end record;

end AWA.Applications;

Document the app.config setup

Document the app.config setup


--  Generated by gperfhash
package Sqlite3_H.Perfect_Hash is

   function Hash (S : String) return Natural;

   --  Returns true if the string <b>S</b> is a keyword.
   function Is_Keyword (S : in String) return Boolean;

   type Name_Access is access constant String;
   type Keyword_Array is array (Natural range <>) of Name_Access;
   Keywords : constant Keyword_Array;
private

   K_0             : aliased constant String := "ABORT";
   K_1             : aliased constant String := "ACTION";
   K_2             : aliased constant String := "ADD";
   K_3             : aliased constant String := "AFTER";
   K_4             : aliased constant String := "ALL";
   K_5             : aliased constant String := "ALTER";
   K_6             : aliased constant String := "ANALYZE";
   K_7             : aliased constant String := "AND";
   K_8             : aliased constant String := "AS";
   K_9             : aliased constant String := "ASC";
   K_10            : aliased constant String := "ATTACH";
   K_11            : aliased constant String := "AUTOINCREMENT";
   K_12            : aliased constant String := "BEFORE";
   K_13            : aliased constant String := "BEGIN";
   K_14            : aliased constant String := "BETWEEN";
   K_15            : aliased constant String := "BY";
   K_16            : aliased constant String := "CASCADE";
   K_17            : aliased constant String := "CASE";
   K_18            : aliased constant String := "CAST";
   K_19            : aliased constant String := "CHECK";
   K_20            : aliased constant String := "COLLATE";
   K_21            : aliased constant String := "COLUMN";
   K_22            : aliased constant String := "COMMIT";
   K_23            : aliased constant String := "CONFLICT";
   K_24            : aliased constant String := "CONSTRAINT";
   K_25            : aliased constant String := "CREATE";
   K_26            : aliased constant String := "CROSS";
   K_27            : aliased constant String := "CURRENT_DATE";
   K_28            : aliased constant String := "CURRENT_TIME";
   K_29            : aliased constant String := "CURRENT_TIMESTAMP";
   K_30            : aliased constant String := "DATABASE";
   K_31            : aliased constant String := "DEFAULT";
   K_32            : aliased constant String := "DEFERRABLE";
   K_33            : aliased constant String := "DEFERRED";
   K_34            : aliased constant String := "DELETE";
   K_35            : aliased constant String := "DESC";
   K_36            : aliased constant String := "DETACH";
   K_37            : aliased constant String := "DISTINCT";
   K_38            : aliased constant String := "DROP";
   K_39            : aliased constant String := "EACH";
   K_40            : aliased constant String := "ELSE";
   K_41            : aliased constant String := "END";
   K_42            : aliased constant String := "ESCAPE";
   K_43            : aliased constant String := "EXCEPT";
   K_44            : aliased constant String := "EXCLUSIVE";
   K_45            : aliased constant String := "EXISTS";
   K_46            : aliased constant String := "EXPLAIN";
   K_47            : aliased constant String := "FAIL";
   K_48            : aliased constant String := "FOR";
   K_49            : aliased constant String := "FOREIGN";
   K_50            : aliased constant String := "FROM";
   K_51            : aliased constant String := "FULL";
   K_52            : aliased constant String := "GLOB";
   K_53            : aliased constant String := "GROUP";
   K_54            : aliased constant String := "HAVING";
   K_55            : aliased constant String := "IF";
   K_56            : aliased constant String := "IGNORE";
   K_57            : aliased constant String := "IMMEDIATE";
   K_58            : aliased constant String := "IN";
   K_59            : aliased constant String := "INDEX";
   K_60            : aliased constant String := "INDEXED";
   K_61            : aliased constant String := "INITIALLY";
   K_62            : aliased constant String := "INNER";
   K_63            : aliased constant String := "INSERT";
   K_64            : aliased constant String := "INSTEAD";
   K_65            : aliased constant String := "INTERSECT";
   K_66            : aliased constant String := "INTO";
   K_67            : aliased constant String := "IS";
   K_68            : aliased constant String := "ISNULL";
   K_69            : aliased constant String := "JOIN";
   K_70            : aliased constant String := "KEY";
   K_71            : aliased constant String := "LEFT";
   K_72            : aliased constant String := "LIKE";
   K_73            : aliased constant String := "LIMIT";
   K_74            : aliased constant String := "MATCH";
   K_75            : aliased constant String := "NATURAL";
   K_76            : aliased constant String := "NO";
   K_77            : aliased constant String := "NOT";
   K_78            : aliased constant String := "NOTNULL";
   K_79            : aliased constant String := "NULL";
   K_80            : aliased constant String := "OF";
   K_81            : aliased constant String := "OFFSET";
   K_82            : aliased constant String := "ON";
   K_83            : aliased constant String := "OR";
   K_84            : aliased constant String := "ORDER";
   K_85            : aliased constant String := "OUTER";
   K_86            : aliased constant String := "PLAN";
   K_87            : aliased constant String := "PRAGMA";
   K_88            : aliased constant String := "PRIMARY";
   K_89            : aliased constant String := "QUERY";
   K_90            : aliased constant String := "RAISE";
   K_91            : aliased constant String := "REFERENCES";
   K_92            : aliased constant String := "REGEXP";
   K_93            : aliased constant String := "REINDEX";
   K_94            : aliased constant String := "RELEASE";
   K_95            : aliased constant String := "RENAME";
   K_96            : aliased constant String := "REPLACE";
   K_97            : aliased constant String := "RESTRICT";
   K_98            : aliased constant String := "RIGHT";
   K_99            : aliased constant String := "ROLLBACK";
   K_100           : aliased constant String := "ROW";
   K_101           : aliased constant String := "SAVEPOINT";
   K_102           : aliased constant String := "SELECT";
   K_103           : aliased constant String := "SET";
   K_104           : aliased constant String := "TABLE";
   K_105           : aliased constant String := "TEMP";
   K_106           : aliased constant String := "TEMPORARY";
   K_107           : aliased constant String := "THEN";
   K_108           : aliased constant String := "TO";
   K_109           : aliased constant String := "TRANSACTION";
   K_110           : aliased constant String := "TRIGGER";
   K_111           : aliased constant String := "UNION";
   K_112           : aliased constant String := "UNIQUE";
   K_113           : aliased constant String := "UPDATE";
   K_114           : aliased constant String := "USING";
   K_115           : aliased constant String := "VACUUM";
   K_116           : aliased constant String := "VALUES";
   K_117           : aliased constant String := "VIEW";
   K_118           : aliased constant String := "VIRTUAL";
   K_119           : aliased constant String := "WHEN";
   K_120           : aliased constant String := "WHERE";

   Keywords : constant Keyword_Array := (
      K_0'Access, K_1'Access, K_2'Access, K_3'Access,
      K_4'Access, K_5'Access, K_6'Access, K_7'Access,
      K_8'Access, K_9'Access, K_10'Access, K_11'Access,
      K_12'Access, K_13'Access, K_14'Access, K_15'Access,
      K_16'Access, K_17'Access, K_18'Access, K_19'Access,
      K_20'Access, K_21'Access, K_22'Access, K_23'Access,
      K_24'Access, K_25'Access, K_26'Access, K_27'Access,
      K_28'Access, K_29'Access, K_30'Access, K_31'Access,
      K_32'Access, K_33'Access, K_34'Access, K_35'Access,
      K_36'Access, K_37'Access, K_38'Access, K_39'Access,
      K_40'Access, K_41'Access, K_42'Access, K_43'Access,
      K_44'Access, K_45'Access, K_46'Access, K_47'Access,
      K_48'Access, K_49'Access, K_50'Access, K_51'Access,
      K_52'Access, K_53'Access, K_54'Access, K_55'Access,
      K_56'Access, K_57'Access, K_58'Access, K_59'Access,
      K_60'Access, K_61'Access, K_62'Access, K_63'Access,
      K_64'Access, K_65'Access, K_66'Access, K_67'Access,
      K_68'Access, K_69'Access, K_70'Access, K_71'Access,
      K_72'Access, K_73'Access, K_74'Access, K_75'Access,
      K_76'Access, K_77'Access, K_78'Access, K_79'Access,
      K_80'Access, K_81'Access, K_82'Access, K_83'Access,
      K_84'Access, K_85'Access, K_86'Access, K_87'Access,
      K_88'Access, K_89'Access, K_90'Access, K_91'Access,
      K_92'Access, K_93'Access, K_94'Access, K_95'Access,
      K_96'Access, K_97'Access, K_98'Access, K_99'Access,
      K_100'Access, K_101'Access, K_102'Access, K_103'Access,
      K_104'Access, K_105'Access, K_106'Access, K_107'Access,
      K_108'Access, K_109'Access, K_110'Access, K_111'Access,
      K_112'Access, K_113'Access, K_114'Access, K_115'Access,
      K_116'Access, K_117'Access, K_118'Access, K_119'Access,
      K_120'Access);
end Sqlite3_H.Perfect_Hash;

--  Generated by gperfhash
package Sqlite3_H.Perfect_Hash is

   pragma Preelaborate;

   function Hash (S : String) return Natural;

   --  Returns true if the string <b>S</b> is a keyword.
   function Is_Keyword (S : in String) return Boolean;

   type Name_Access is access constant String;
   type Keyword_Array is array (Natural range <>) of Name_Access;
   Keywords : constant Keyword_Array;
private

   K_0             : aliased constant String := "ABORT";
   K_1             : aliased constant String := "ACTION";
   K_2             : aliased constant String := "ADD";
   K_3             : aliased constant String := "AFTER";
   K_4             : aliased constant String := "ALL";
   K_5             : aliased constant String := "ALTER";
   K_6             : aliased constant String := "ANALYZE";
   K_7             : aliased constant String := "AND";
   K_8             : aliased constant String := "AS";
   K_9             : aliased constant String := "ASC";
   K_10            : aliased constant String := "ATTACH";
   K_11            : aliased constant String := "AUTOINCREMENT";
   K_12            : aliased constant String := "BEFORE";
   K_13            : aliased constant String := "BEGIN";
   K_14            : aliased constant String := "BETWEEN";
   K_15            : aliased constant String := "BY";
   K_16            : aliased constant String := "CASCADE";
   K_17            : aliased constant String := "CASE";
   K_18            : aliased constant String := "CAST";
   K_19            : aliased constant String := "CHECK";
   K_20            : aliased constant String := "COLLATE";
   K_21            : aliased constant String := "COLUMN";
   K_22            : aliased constant String := "COMMIT";
   K_23            : aliased constant String := "CONFLICT";
   K_24            : aliased constant String := "CONSTRAINT";
   K_25            : aliased constant String := "CREATE";
   K_26            : aliased constant String := "CROSS";
   K_27            : aliased constant String := "CURRENT_DATE";
   K_28            : aliased constant String := "CURRENT_TIME";
   K_29            : aliased constant String := "CURRENT_TIMESTAMP";
   K_30            : aliased constant String := "DATABASE";
   K_31            : aliased constant String := "DEFAULT";
   K_32            : aliased constant String := "DEFERRABLE";
   K_33            : aliased constant String := "DEFERRED";
   K_34            : aliased constant String := "DELETE";
   K_35            : aliased constant String := "DESC";
   K_36            : aliased constant String := "DETACH";
   K_37            : aliased constant String := "DISTINCT";
   K_38            : aliased constant String := "DROP";
   K_39            : aliased constant String := "EACH";
   K_40            : aliased constant String := "ELSE";
   K_41            : aliased constant String := "END";
   K_42            : aliased constant String := "ESCAPE";
   K_43            : aliased constant String := "EXCEPT";
   K_44            : aliased constant String := "EXCLUSIVE";
   K_45            : aliased constant String := "EXISTS";
   K_46            : aliased constant String := "EXPLAIN";
   K_47            : aliased constant String := "FAIL";
   K_48            : aliased constant String := "FOR";
   K_49            : aliased constant String := "FOREIGN";
   K_50            : aliased constant String := "FROM";
   K_51            : aliased constant String := "FULL";
   K_52            : aliased constant String := "GLOB";
   K_53            : aliased constant String := "GROUP";
   K_54            : aliased constant String := "HAVING";
   K_55            : aliased constant String := "IF";
   K_56            : aliased constant String := "IGNORE";
   K_57            : aliased constant String := "IMMEDIATE";
   K_58            : aliased constant String := "IN";
   K_59            : aliased constant String := "INDEX";
   K_60            : aliased constant String := "INDEXED";
   K_61            : aliased constant String := "INITIALLY";
   K_62            : aliased constant String := "INNER";
   K_63            : aliased constant String := "INSERT";
   K_64            : aliased constant String := "INSTEAD";
   K_65            : aliased constant String := "INTERSECT";
   K_66            : aliased constant String := "INTO";
   K_67            : aliased constant String := "IS";
   K_68            : aliased constant String := "ISNULL";
   K_69            : aliased constant String := "JOIN";
   K_70            : aliased constant String := "KEY";
   K_71            : aliased constant String := "LEFT";
   K_72            : aliased constant String := "LIKE";
   K_73            : aliased constant String := "LIMIT";
   K_74            : aliased constant String := "MATCH";
   K_75            : aliased constant String := "NATURAL";
   K_76            : aliased constant String := "NO";
   K_77            : aliased constant String := "NOT";
   K_78            : aliased constant String := "NOTNULL";
   K_79            : aliased constant String := "NULL";
   K_80            : aliased constant String := "OF";
   K_81            : aliased constant String := "OFFSET";
   K_82            : aliased constant String := "ON";
   K_83            : aliased constant String := "OR";
   K_84            : aliased constant String := "ORDER";
   K_85            : aliased constant String := "OUTER";
   K_86            : aliased constant String := "PLAN";
   K_87            : aliased constant String := "PRAGMA";
   K_88            : aliased constant String := "PRIMARY";
   K_89            : aliased constant String := "QUERY";
   K_90            : aliased constant String := "RAISE";
   K_91            : aliased constant String := "REFERENCES";
   K_92            : aliased constant String := "REGEXP";
   K_93            : aliased constant String := "REINDEX";
   K_94            : aliased constant String := "RELEASE";
   K_95            : aliased constant String := "RENAME";
   K_96            : aliased constant String := "REPLACE";
   K_97            : aliased constant String := "RESTRICT";
   K_98            : aliased constant String := "RIGHT";
   K_99            : aliased constant String := "ROLLBACK";
   K_100           : aliased constant String := "ROW";
   K_101           : aliased constant String := "SAVEPOINT";
   K_102           : aliased constant String := "SELECT";
   K_103           : aliased constant String := "SET";
   K_104           : aliased constant String := "TABLE";
   K_105           : aliased constant String := "TEMP";
   K_106           : aliased constant String := "TEMPORARY";
   K_107           : aliased constant String := "THEN";
   K_108           : aliased constant String := "TO";
   K_109           : aliased constant String := "TRANSACTION";
   K_110           : aliased constant String := "TRIGGER";
   K_111           : aliased constant String := "UNION";
   K_112           : aliased constant String := "UNIQUE";
   K_113           : aliased constant String := "UPDATE";
   K_114           : aliased constant String := "USING";
   K_115           : aliased constant String := "VACUUM";
   K_116           : aliased constant String := "VALUES";
   K_117           : aliased constant String := "VIEW";
   K_118           : aliased constant String := "VIRTUAL";
   K_119           : aliased constant String := "WHEN";
   K_120           : aliased constant String := "WHERE";

   Keywords : constant Keyword_Array := (
      K_0'Access, K_1'Access, K_2'Access, K_3'Access,
      K_4'Access, K_5'Access, K_6'Access, K_7'Access,
      K_8'Access, K_9'Access, K_10'Access, K_11'Access,
      K_12'Access, K_13'Access, K_14'Access, K_15'Access,
      K_16'Access, K_17'Access, K_18'Access, K_19'Access,
      K_20'Access, K_21'Access, K_22'Access, K_23'Access,
      K_24'Access, K_25'Access, K_26'Access, K_27'Access,
      K_28'Access, K_29'Access, K_30'Access, K_31'Access,
      K_32'Access, K_33'Access, K_34'Access, K_35'Access,
      K_36'Access, K_37'Access, K_38'Access, K_39'Access,
      K_40'Access, K_41'Access, K_42'Access, K_43'Access,
      K_44'Access, K_45'Access, K_46'Access, K_47'Access,
      K_48'Access, K_49'Access, K_50'Access, K_51'Access,
      K_52'Access, K_53'Access, K_54'Access, K_55'Access,
      K_56'Access, K_57'Access, K_58'Access, K_59'Access,
      K_60'Access, K_61'Access, K_62'Access, K_63'Access,
      K_64'Access, K_65'Access, K_66'Access, K_67'Access,
      K_68'Access, K_69'Access, K_70'Access, K_71'Access,
      K_72'Access, K_73'Access, K_74'Access, K_75'Access,
      K_76'Access, K_77'Access, K_78'Access, K_79'Access,
      K_80'Access, K_81'Access, K_82'Access, K_83'Access,
      K_84'Access, K_85'Access, K_86'Access, K_87'Access,
      K_88'Access, K_89'Access, K_90'Access, K_91'Access,
      K_92'Access, K_93'Access, K_94'Access, K_95'Access,
      K_96'Access, K_97'Access, K_98'Access, K_99'Access,
      K_100'Access, K_101'Access, K_102'Access, K_103'Access,
      K_104'Access, K_105'Access, K_106'Access, K_107'Access,
      K_108'Access, K_109'Access, K_110'Access, K_111'Access,
      K_112'Access, K_113'Access, K_114'Access, K_115'Access,
      K_116'Access, K_117'Access, K_118'Access, K_119'Access,
      K_120'Access);
end Sqlite3_H.Perfect_Hash;

Make the package Preelaborate

Make the package Preelaborate


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

with Ada.Text_IO;
with ASF.Applications.Main;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with Ada.Directories;
with Util.Tests;
with Util.Files;
with Util.Measures;
package body ASF.Applications.Views.Tests is

   use AUnit;
   use Ada.Strings.Unbounded;

   overriding
   procedure Set_Up (T : in out Test) is
   begin
      null;
   end Set_Up;
   --  Set up performed before each test case

   --  Test loading of facelet file
   procedure Test_Load_Facelet (T : in out Test) is

      use ASF;
      use ASF.Contexts.Faces;

      App      : Applications.Main.Application;
--        H        : Applications.Views.View_Handler;

      View_Name   : constant String := To_String (T.File);
      Result_File : constant String := To_String (T.Result);
      Conf        : Applications.Config;
      App_Factory : Applications.Main.Application_Factory;
   begin
      Conf.Load_Properties ("regtests/view.properties");
      App.Initialize (Conf, App_Factory);

      for I in 1 .. 2 loop
         declare
            S : Util.Measures.Stamp;
            Req       : ASF.Requests.Mockup.Request;
            Rep       : ASF.Responses.Mockup.Response;
            Content   : Unbounded_String;
         begin

            Req.Set_Method ("GET");
            Req.Set_Path_Info (View_Name);
            App.Dispatch (Page     => View_Name,
                          Request  => Req,
                          Response => Rep);
            Util.Measures.Report (S, "Pass" & Integer'Image (I) & ": Render view "
                                  & View_Name);

            Rep.Read_Content (Content);
            Util.Files.Write_File (Result_File, Content);
            Util.Tests.Assert_Equal_Files (T       => T,
                                           Expect  => To_String (T.Expect),
                                           Test    => Result_File,
                                           Message => "Restore and render view");
         end;
      end loop;
   end Test_Load_Facelet;

   --  Test case name
   overriding
   function Name (T : Test) return Message_String is
   begin
      return Format ("Test " & To_String (T.Name));
   end Name;

   --  Perform the test.
   overriding
   procedure Run_Test (T : in out Test) is
   begin
      T.Test_Load_Facelet;
   end Run_Test;

   procedure Add_Tests (Suite : AUnit.Test_Suites.Access_Test_Suite) is
      use Ada.Directories;

      Result_Dir  : constant String := "regtests/result/views";
      Dir         : constant String := "regtests/files/views";
      Expect_Dir  : constant String := "regtests/expect/views";
      Path        : constant String := Util.Tests.Get_Path (Dir);
      Expect_Path : constant String := Util.Tests.Get_Path (Expect_Dir);
      Result_Path : constant String := Util.Tests.Get_Test_Path (Result_Dir);
      Search      : Search_Type;
      Filter      : constant Filter_Type := (others => True);
      Ent         : Directory_Entry_Type;
   begin
      if Kind (Path) = Directory then
         Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
      end if;

      Start_Search (Search, Directory => Path, Pattern => "*.xhtml", Filter => Filter);
      while More_Entries (Search) loop
         Get_Next_Entry (Search, Ent);
         declare
            Simple    : constant String := Simple_Name (Ent);
            File_Path : constant String := Full_Name (Ent);
            Tst      : Test_Case_Access;
         begin
            if Simple /= "." and then Simple /= ".."
              and then Simple /= ".svn" then
               Tst := new Test;
               Tst.Name := To_Unbounded_String (Dir & "/" & Simple);
               Tst.File := To_Unbounded_String (File_Path);
               Tst.Expect := To_Unbounded_String (Expect_Path & "/" & Simple);
               Tst.Result := To_Unbounded_String (Result_Path & "/" & Simple);
               Suite.Add_Test (Tst);
            end if;
         end;
      end loop;
   end Add_Tests;

end ASF.Applications.Views.Tests;

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

with Ada.Text_IO;
with ASF.Applications.Main;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with Ada.Directories;
with Util.Tests;
with Util.Files;
with Util.Measures;
package body ASF.Applications.Views.Tests is

   use AUnit;
   use Ada.Strings.Unbounded;

   overriding
   procedure Set_Up (T : in out Test) is
   begin
      null;
   end Set_Up;
   --  Set up performed before each test case

   --  Test loading of facelet file
   procedure Test_Load_Facelet (T : in out Test) is

      use ASF;
      use ASF.Contexts.Faces;

      App      : Applications.Main.Application;
--        H        : Applications.Views.View_Handler;

      View_Name   : constant String := To_String (T.File);
      Result_File : constant String := To_String (T.Result);
      Conf        : Applications.Config;
      App_Factory : Applications.Main.Application_Factory;
   begin
      Conf.Load_Properties ("regtests/view.properties");
      App.Initialize (Conf, App_Factory);

      App.Set_Global ("function", "Test_Load_Facelet");
      for I in 1 .. 2 loop
         declare
            S : Util.Measures.Stamp;
            Req       : ASF.Requests.Mockup.Request;
            Rep       : ASF.Responses.Mockup.Response;
            Content   : Unbounded_String;
         begin

            Req.Set_Method ("GET");
            Req.Set_Path_Info (View_Name);
            App.Dispatch (Page     => View_Name,
                          Request  => Req,
                          Response => Rep);
            Util.Measures.Report (S, "Pass" & Integer'Image (I) & ": Render view "
                                  & View_Name);

            Rep.Read_Content (Content);
            Util.Files.Write_File (Result_File, Content);
            Util.Tests.Assert_Equal_Files (T       => T,
                                           Expect  => To_String (T.Expect),
                                           Test    => Result_File,
                                           Message => "Restore and render view");
         end;
      end loop;
   end Test_Load_Facelet;

   --  Test case name
   overriding
   function Name (T : Test) return Message_String is
   begin
      return Format ("Test " & To_String (T.Name));
   end Name;

   --  Perform the test.
   overriding
   procedure Run_Test (T : in out Test) is
   begin
      T.Test_Load_Facelet;
   end Run_Test;

   procedure Add_Tests (Suite : AUnit.Test_Suites.Access_Test_Suite) is
      use Ada.Directories;

      Result_Dir  : constant String := "regtests/result/views";
      Dir         : constant String := "regtests/files/views";
      Expect_Dir  : constant String := "regtests/expect/views";
      Path        : constant String := Util.Tests.Get_Path (Dir);
      Expect_Path : constant String := Util.Tests.Get_Path (Expect_Dir);
      Result_Path : constant String := Util.Tests.Get_Test_Path (Result_Dir);
      Search      : Search_Type;
      Filter      : constant Filter_Type := (others => True);
      Ent         : Directory_Entry_Type;
   begin
      if Kind (Path) = Directory then
         Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
      end if;

      Start_Search (Search, Directory => Path, Pattern => "*.xhtml", Filter => Filter);
      while More_Entries (Search) loop
         Get_Next_Entry (Search, Ent);
         declare
            Simple    : constant String := Simple_Name (Ent);
            File_Path : constant String := Full_Name (Ent);
            Tst      : Test_Case_Access;
         begin
            if Simple /= "." and then Simple /= ".."
              and then Simple /= ".svn" then
               Tst := new Test;
               Tst.Name := To_Unbounded_String (Dir & "/" & Simple);
               Tst.File := To_Unbounded_String (File_Path);
               Tst.Expect := To_Unbounded_String (Expect_Path & "/" & Simple);
               Tst.Result := To_Unbounded_String (Result_Path & "/" & Simple);
               Suite.Add_Test (Tst);
            end if;
         end;
      end loop;
   end Add_Tests;

end ASF.Applications.Views.Tests;

Declare a variable that can be used in tests


-----------------------------------------------------------------------
--  awa-storages-beans -- Storage Ada Beans
--  Copyright (C) 2012, 2013, 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.Containers;

with ADO;
with ADO.Utils;
with ADO.Queries;
with ADO.Sessions;
with ADO.Objects;
with ADO.Sessions.Entities;

with AWA.Helpers.Requests;
with AWA.Workspaces.Models;
with AWA.Services.Contexts;
with AWA.Storages.Services;
package body AWA.Storages.Beans is

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Upload_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "folderId" then
         return ADO.Utils.To_Object (From.Folder_Id);
      elsif From.Is_Null then
         return Util.Beans.Objects.Null_Object;
      else
         return AWA.Storages.Models.Storage_Ref (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Upload_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
      Manager : constant Services.Storage_Service_Access := From.Module.Get_Storage_Manager;
      Folder  : Models.Storage_Folder_Ref;
      Found   : Boolean;
   begin
      if Name = "folderId" then
         From.Folder_Id := ADO.Utils.To_Identifier (Value);
         Manager.Load_Folder (Folder, From.Folder_Id);
         From.Set_Folder (Folder);
      elsif Name = "id" then
         Manager.Load_Storage (From, ADO.Utils.To_Identifier (Value));
      elsif Name = "name" then
         Folder := Models.Storage_Folder_Ref (From.Get_Folder);
         Manager.Load_Storage (From, From.Folder_Id, Util.Beans.Objects.To_String (Value), Found);
         if not Found then
            From.Set_Name (Util.Beans.Objects.To_String (Value));
         end if;
         From.Set_Folder (Folder);
      end if;
   end Set_Value;

   --  ------------------------------
   --  Save the uploaded file in the storage service.
   --  ------------------------------
   procedure Save_Part (Bean : in out Upload_Bean;
                        Part : in ASF.Parts.Part'Class) is
      Manager : constant Services.Storage_Service_Access := Bean.Module.Get_Storage_Manager;
      Name    : constant String := Bean.Get_Name;
   begin
      if Name'Length = 0 then
         Bean.Set_Name (Part.Get_Name);
      end if;
      Bean.Set_Mime_Type (Part.Get_Content_Type);
      Bean.Set_File_Size (Part.Get_Size);
      Manager.Save (Bean, Part, AWA.Storages.Models.DATABASE);
   end Save_Part;

   --  ------------------------------
   --  Upload the file.
   --  ------------------------------
   procedure Upload (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Bean);
   begin
      Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("success");
   end Upload;

   --  ------------------------------
   --  Delete the file.
   --  ------------------------------
   procedure Delete (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Manager : constant Services.Storage_Service_Access := Bean.Module.Get_Storage_Manager;
   begin
      Manager.Delete (Bean);
      Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("success");
   end Delete;

   --  ------------------------------
   --  Publish the file.
   --  ------------------------------
   overriding
   procedure Publish (Bean    : in out Upload_Bean;
                      Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Manager : constant Services.Storage_Service_Access := Bean.Module.Get_Storage_Manager;
      Id      : constant ADO.Identifier := Helpers.Requests.Get_Parameter ("id");
      Value   : constant Util.Beans.Objects.Object := Helpers.Requests.Get_Parameter ("status");
   begin
      Manager.Publish (Id, Util.Beans.Objects.To_Boolean (Value), Bean);
      Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("success");
   end Publish;

   --  ------------------------------
   --  Create the Upload_Bean bean instance.
   --  ------------------------------
   function Create_Upload_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                return Util.Beans.Basic.Readonly_Bean_Access is
      Result : constant Upload_Bean_Access := new Upload_Bean;
   begin
      Result.Module := Module;
      return Result.all'Access;
   end Create_Upload_Bean;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Folder_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if ADO.Objects.Is_Null (From) then
         return Util.Beans.Objects.Null_Object;
      else
         return AWA.Storages.Models.Storage_Folder_Ref (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Folder_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "name" then
         From.Set_Name (Util.Beans.Objects.To_String (Value));
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create or save the folder.
   --  ------------------------------
   procedure Save (Bean    : in out Folder_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Manager : constant Services.Storage_Service_Access := Bean.Module.Get_Storage_Manager;
   begin
      Manager.Save_Folder (Bean);
      Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("success");
   end Save;

   --  ------------------------------
   --  Load the folder instance.
   --  ------------------------------
   procedure Load_Folder (Storage : in Storage_List_Bean) is
      use AWA.Storages.Models;
      use AWA.Services;
      use type Ada.Containers.Count_Type;

      Manager : constant Services.Storage_Service_Access := Storage.Module.Get_Storage_Manager;
   begin
      Load_Folders (Storage);
      if Storage.Folder_List.List.Length > 0 then
         Manager.Load_Folder (Storage.Folder_Bean.all,
                                      Storage.Folder_List.List.Element (0).Id);

      end if;
      Storage.Flags (INIT_FOLDER) := True;
   end Load_Folder;

   --  ------------------------------
   --  Load the list of folders.
   --  ------------------------------
   procedure Load_Folders (Storage : in Storage_List_Bean) is
      use AWA.Storages.Models;
      use AWA.Services;
      use type ADO.Identifier;

      Ctx     : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User    : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Session : ADO.Sessions.Session := Storage.Module.Get_Session;
      Query   : ADO.Queries.Context;
   begin
      Query.Set_Query (AWA.Storages.Models.Query_Storage_Folder_List);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE, Session);
      AWA.Storages.Models.List (Storage.Folder_List_Bean.all, Session, Query);
      Storage.Flags (INIT_FOLDER_LIST) := True;
   end Load_Folders;

   --  ------------------------------
   --  Load the list of files associated with the current folder.
   --  ------------------------------
   procedure Load_Files (Storage : in Storage_List_Bean) is
      use AWA.Storages.Models;
      use AWA.Services;

      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User      : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Session   : ADO.Sessions.Session := Storage.Module.Get_Session;
      Query     : ADO.Queries.Context;
   begin
      if not Storage.Init_Flags (INIT_FOLDER) then
         Load_Folder (Storage);
      end if;
      Query.Set_Query (AWA.Storages.Models.Query_Storage_List);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE, Session);
      if Storage.Folder_Bean.Is_Null then
         Query.Bind_Null_Param ("folder_id");
      else
         Query.Bind_Param ("folder_id", Storage.Folder_Bean.Get_Id);
      end if;
      AWA.Storages.Models.List (Storage.Files_List_Bean.all, Session, Query);
      Storage.Flags (INIT_FILE_LIST) := True;
   end Load_Files;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Storage_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
      Manager : constant Services.Storage_Service_Access := From.Module.Get_Storage_Manager;
   begin
      if Name = "folderId" and not Util.Beans.Objects.Is_Empty (Value) then
         Manager.Load_Folder (From.Folder, ADO.Identifier (Util.Beans.Objects.To_Integer (Value)));
         From.Flags (INIT_FOLDER) := True;
      end if;
   end Set_Value;

   overriding
   function Get_Value (List : in Storage_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "files" then
         if not List.Init_Flags (INIT_FILE_LIST) then
            Load_Files (List);
         end if;
         return Util.Beans.Objects.To_Object (Value   => List.Files_List_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      elsif Name = "folders" then
         if not List.Init_Flags (INIT_FOLDER_LIST) then
            Load_Folders (List);
         end if;
         return Util.Beans.Objects.To_Object (Value   => List.Folder_List_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      elsif Name = "folder" then
         if not List.Init_Flags (INIT_FOLDER) then
            Load_Folder (List);
         end if;
         if List.Folder_Bean.Is_Null then
            return Util.Beans.Objects.Null_Object;
         end if;
         return Util.Beans.Objects.To_Object (Value   => List.Folder_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

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

   --  ------------------------------
   --  Load the files and folder information.
   --  ------------------------------
   overriding
   procedure Load (List    : in out Storage_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Storage_List_Bean'Class (List).Load_Folders;
      Storage_List_Bean'Class (List).Load_Files;
   end Load;

   --  ------------------------------
   --  Create the Folder_List_Bean bean instance.
   --  ------------------------------
   function Create_Folder_List_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access is
      use AWA.Storages.Models;
      use AWA.Services;
      use type ADO.Identifier;

      Ctx   : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;

      Object  : constant Folder_Info_List_Bean_Access := new Folder_Info_List_Bean;
      Session : ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;
   begin
      Query.Set_Query (AWA.Storages.Models.Query_Storage_Folder_List);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE, Session);
      AWA.Storages.Models.List (Object.all, Session, Query);
      return Object.all'Access;
   end Create_Folder_List_Bean;

   --  ------------------------------
   --  Create the Storage_List_Bean bean instance.
   --  ------------------------------
   function Create_Storage_List_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access is
      Object    : constant Storage_List_Bean_Access := new Storage_List_Bean;
   begin
      Object.Module           := Module;
      Object.Folder_Bean      := Object.Folder'Access;
      Object.Folder_List_Bean := Object.Folder_List'Access;
      Object.Files_List_Bean  := Object.Files_List'Access;
      Object.Flags            := Object.Init_Flags'Access;
      return Object.all'Access;
   end Create_Storage_List_Bean;

end AWA.Storages.Beans;

-----------------------------------------------------------------------
--  awa-storages-beans -- Storage Ada Beans
--  Copyright (C) 2012, 2013, 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.Containers;

with ADO.Utils;
with ADO.Queries;
with ADO.Sessions;
with ADO.Objects;
with ADO.Sessions.Entities;

with AWA.Helpers.Requests;
with AWA.Workspaces.Models;
with AWA.Services.Contexts;
with AWA.Storages.Services;
package body AWA.Storages.Beans is

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Upload_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "folderId" then
         return ADO.Utils.To_Object (From.Folder_Id);
      elsif From.Is_Null then
         return Util.Beans.Objects.Null_Object;
      else
         return AWA.Storages.Models.Storage_Ref (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Upload_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
      Manager : constant Services.Storage_Service_Access := From.Module.Get_Storage_Manager;
      Folder  : Models.Storage_Folder_Ref;
      Found   : Boolean;
   begin
      if Name = "folderId" then
         From.Folder_Id := ADO.Utils.To_Identifier (Value);
         Manager.Load_Folder (Folder, From.Folder_Id);
         From.Set_Folder (Folder);
      elsif Name = "id" then
         Manager.Load_Storage (From, ADO.Utils.To_Identifier (Value));
      elsif Name = "name" then
         Folder := Models.Storage_Folder_Ref (From.Get_Folder);
         Manager.Load_Storage (From, From.Folder_Id, Util.Beans.Objects.To_String (Value), Found);
         if not Found then
            From.Set_Name (Util.Beans.Objects.To_String (Value));
         end if;
         From.Set_Folder (Folder);
      end if;
   end Set_Value;

   --  ------------------------------
   --  Save the uploaded file in the storage service.
   --  ------------------------------
   procedure Save_Part (Bean : in out Upload_Bean;
                        Part : in ASF.Parts.Part'Class) is
      Manager : constant Services.Storage_Service_Access := Bean.Module.Get_Storage_Manager;
      Name    : constant String := Bean.Get_Name;
   begin
      if Name'Length = 0 then
         Bean.Set_Name (Part.Get_Name);
      end if;
      Bean.Set_Mime_Type (Part.Get_Content_Type);
      Bean.Set_File_Size (Part.Get_Size);
      Manager.Save (Bean, Part, AWA.Storages.Models.DATABASE);
   end Save_Part;

   --  ------------------------------
   --  Upload the file.
   --  ------------------------------
   procedure Upload (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Bean);
   begin
      Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("success");
   end Upload;

   --  ------------------------------
   --  Delete the file.
   --  ------------------------------
   procedure Delete (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Manager : constant Services.Storage_Service_Access := Bean.Module.Get_Storage_Manager;
   begin
      Manager.Delete (Bean);
      Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("success");
   end Delete;

   --  ------------------------------
   --  Publish the file.
   --  ------------------------------
   overriding
   procedure Publish (Bean    : in out Upload_Bean;
                      Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Manager : constant Services.Storage_Service_Access := Bean.Module.Get_Storage_Manager;
      Id      : constant ADO.Identifier := Helpers.Requests.Get_Parameter ("id");
      Value   : constant Util.Beans.Objects.Object := Helpers.Requests.Get_Parameter ("status");
   begin
      Manager.Publish (Id, Util.Beans.Objects.To_Boolean (Value), Bean);
      Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("success");
   end Publish;

   --  ------------------------------
   --  Create the Upload_Bean bean instance.
   --  ------------------------------
   function Create_Upload_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                return Util.Beans.Basic.Readonly_Bean_Access is
      Result : constant Upload_Bean_Access := new Upload_Bean;
   begin
      Result.Module := Module;
      return Result.all'Access;
   end Create_Upload_Bean;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Folder_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if ADO.Objects.Is_Null (From) then
         return Util.Beans.Objects.Null_Object;
      else
         return AWA.Storages.Models.Storage_Folder_Ref (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Folder_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "name" then
         From.Set_Name (Util.Beans.Objects.To_String (Value));
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create or save the folder.
   --  ------------------------------
   procedure Save (Bean    : in out Folder_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Manager : constant Services.Storage_Service_Access := Bean.Module.Get_Storage_Manager;
   begin
      Manager.Save_Folder (Bean);
      Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("success");
   end Save;

   --  ------------------------------
   --  Load the folder instance.
   --  ------------------------------
   procedure Load_Folder (Storage : in Storage_List_Bean) is
      use AWA.Storages.Models;
      use AWA.Services;
      use type Ada.Containers.Count_Type;

      Manager : constant Services.Storage_Service_Access := Storage.Module.Get_Storage_Manager;
   begin
      Load_Folders (Storage);
      if Storage.Folder_List.List.Length > 0 then
         Manager.Load_Folder (Storage.Folder_Bean.all,
                                      Storage.Folder_List.List.Element (0).Id);

      end if;
      Storage.Flags (INIT_FOLDER) := True;
   end Load_Folder;

   --  ------------------------------
   --  Load the list of folders.
   --  ------------------------------
   procedure Load_Folders (Storage : in Storage_List_Bean) is
      use AWA.Storages.Models;
      use AWA.Services;
      use type ADO.Identifier;

      Ctx     : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User    : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Session : ADO.Sessions.Session := Storage.Module.Get_Session;
      Query   : ADO.Queries.Context;
   begin
      Query.Set_Query (AWA.Storages.Models.Query_Storage_Folder_List);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE, Session);
      AWA.Storages.Models.List (Storage.Folder_List_Bean.all, Session, Query);
      Storage.Flags (INIT_FOLDER_LIST) := True;
   end Load_Folders;

   --  ------------------------------
   --  Load the list of files associated with the current folder.
   --  ------------------------------
   procedure Load_Files (Storage : in Storage_List_Bean) is
      use AWA.Storages.Models;
      use AWA.Services;

      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User      : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Session   : ADO.Sessions.Session := Storage.Module.Get_Session;
      Query     : ADO.Queries.Context;
   begin
      if not Storage.Init_Flags (INIT_FOLDER) then
         Load_Folder (Storage);
      end if;
      Query.Set_Query (AWA.Storages.Models.Query_Storage_List);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE, Session);
      if Storage.Folder_Bean.Is_Null then
         Query.Bind_Null_Param ("folder_id");
      else
         Query.Bind_Param ("folder_id", Storage.Folder_Bean.Get_Id);
      end if;
      AWA.Storages.Models.List (Storage.Files_List_Bean.all, Session, Query);
      Storage.Flags (INIT_FILE_LIST) := True;
   end Load_Files;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Storage_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
      Manager : constant Services.Storage_Service_Access := From.Module.Get_Storage_Manager;
   begin
      if Name = "folderId" and not Util.Beans.Objects.Is_Empty (Value) then
         Manager.Load_Folder (From.Folder, ADO.Identifier (Util.Beans.Objects.To_Integer (Value)));
         From.Flags (INIT_FOLDER) := True;
      end if;
   end Set_Value;

   overriding
   function Get_Value (List : in Storage_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "files" then
         if not List.Init_Flags (INIT_FILE_LIST) then
            Load_Files (List);
         end if;
         return Util.Beans.Objects.To_Object (Value   => List.Files_List_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      elsif Name = "folders" then
         if not List.Init_Flags (INIT_FOLDER_LIST) then
            Load_Folders (List);
         end if;
         return Util.Beans.Objects.To_Object (Value   => List.Folder_List_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      elsif Name = "folder" then
         if not List.Init_Flags (INIT_FOLDER) then
            Load_Folder (List);
         end if;
         if List.Folder_Bean.Is_Null then
            return Util.Beans.Objects.Null_Object;
         end if;
         return Util.Beans.Objects.To_Object (Value   => List.Folder_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

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

   --  ------------------------------
   --  Load the files and folder information.
   --  ------------------------------
   overriding
   procedure Load (List    : in out Storage_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   begin
      Storage_List_Bean'Class (List).Load_Folders;
      Storage_List_Bean'Class (List).Load_Files;
   end Load;

   --  ------------------------------
   --  Create the Folder_List_Bean bean instance.
   --  ------------------------------
   function Create_Folder_List_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access is
      use AWA.Storages.Models;
      use AWA.Services;
      use type ADO.Identifier;

      Ctx   : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;

      Object  : constant Folder_Info_List_Bean_Access := new Folder_Info_List_Bean;
      Session : ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;
   begin
      Query.Set_Query (AWA.Storages.Models.Query_Storage_Folder_List);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE, Session);
      AWA.Storages.Models.List (Object.all, Session, Query);
      return Object.all'Access;
   end Create_Folder_List_Bean;

   --  ------------------------------
   --  Create the Storage_List_Bean bean instance.
   --  ------------------------------
   function Create_Storage_List_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access is
      Object    : constant Storage_List_Bean_Access := new Storage_List_Bean;
   begin
      Object.Module           := Module;
      Object.Folder_Bean      := Object.Folder'Access;
      Object.Folder_List_Bean := Object.Folder_List'Access;
      Object.Files_List_Bean  := Object.Files_List'Access;
      Object.Flags            := Object.Init_Flags'Access;
      return Object.all'Access;
   end Create_Storage_List_Bean;

end AWA.Storages.Beans;

Fix compilation warning

Fix compilation warning


-----------------------------------------------------------------------
--  mat-events-targets - Events received and collected from a target
--  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.
-----------------------------------------------------------------------

package body MAT.Events.Targets is

   --  ------------------------------
   --  Add the event in the list of events and increment the event counter.
   --  ------------------------------
   procedure Insert (Target : in out Target_Events;
                     Event  : in Probe_Event_Type) is
   begin
      Target.Events.Insert (Event);
      Util.Concurrent.Counters.Increment (Target.Event_Count);
   end Insert;

   procedure Get_Events (Target : in out Target_Events;
                         Start  : in MAT.Types.Target_Time;
                         Finish : in MAT.Types.Target_Time;
                         Into   : in out Target_Event_Vector) is
   begin
      Target.Events.Get_Events (Start, Finish, Into);
   end Get_Events;

   --  ------------------------------
   --  Get the start and finish time for the events that have been received.
   --  ------------------------------
   procedure Get_Time_Range (Target : in out Target_Events;
                             Start  : out MAT.Types.Target_Time;
                             Finish : out MAT.Types.Target_Time) is
   begin
      Target.Events.Get_Time_Range (Start, Finish);
   end Get_Time_Range;

   --  ------------------------------
   --  Get the current event counter.
   --  ------------------------------
   function Get_Event_Counter (Target : in Target_Events) return Integer is
   begin
      return Util.Concurrent.Counters.Value (Target.Event_Count);
   end Get_Event_Counter;

   protected body Event_Collector is

      --  ------------------------------
      --  Add the event in the list of events.
      --  ------------------------------
      procedure Insert (Event : in Probe_Event_Type) is
         Info : Target_Event;
      begin
         if Current = null then
            Current := new Event_Block;
            Current.Start := Event.Time;
            Events.Insert (Event.Time, Current);
            Ids.Insert (Last_Id + 1, Current);
         end if;
         Current.Count := Current.Count + 1;
         Current.Events (Current.Count) := Event;
         Current.Events (Current.Count).Id := Last_Id;
         Last_Id := Last_Id + 1;
         Current.Finish := Event.Time;
         if Current.Count = Current.Events'Last then
            Current := null;
         end if;
      end Insert;

      procedure Get_Events (Start  : in MAT.Types.Target_Time;
                            Finish : in MAT.Types.Target_Time;
                            Into   : in out Target_Event_Vector) is
         Iter  : Event_Cursor := Events.Floor (Start);
         Block : Event_Block_Access;
      begin
         while Event_Maps.Has_Element (Iter) loop
            Block := Event_Maps.Element (Iter);
            exit when Block.Start > Finish;
            for I in Block.Events'First .. Block.Count loop
               exit when Block.Events (I).Time > Finish;
               if Block.Events (I).Time >= Start then
                  Into.Append (Block.Events (I));
               end if;
            end loop;
            Event_Maps.Next (Iter);
         end loop;
      end Get_Events;

      --  ------------------------------
      --  Get the start and finish time for the events that have been received.
      --  ------------------------------
      procedure Get_Time_Range (Start  : out MAT.Types.Target_Time;
                                Finish : out MAT.Types.Target_Time) is
         First : constant Event_Block_Access := Events.First_Element;
         Last  : constant Event_Block_Access := Events.Last_Element;
      begin
         Start  := First.Events (First.Events'First).Time;
         Finish := Last.Events (Last.Count).Time;
      end Get_Time_Range;

      --  ------------------------------
      --  Get the probe event with the given allocated unique id.
      --  ------------------------------
      function Get_Event (Id : in Event_Id_Type) return Probe_Event_Type is
         Iter  : Event_Id_Cursor := Ids.Floor (Id);
         Block : Event_Block_Access;
         Pos   : Event_Id_Type;
      begin
         while not Event_Id_Maps.Has_Element (Iter) loop
            Block := Event_Id_Maps.Element (Iter);
            exit when Id < Block.Events (Block.Events'First).Id;
            Pos := Id - Block.Events (Block.Events'First).Id;
            if Pos < Block.Count then
               return Block.Events (Pos);
            end if;
            Event_Id_Maps.Next (Iter);
         end loop;
         raise Not_Found;
      end Get_Event;

   end Event_Collector;

end MAT.Events.Targets;

-----------------------------------------------------------------------
--  mat-events-targets - Events received and collected from a target
--  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.
-----------------------------------------------------------------------

package body MAT.Events.Targets is

   --  ------------------------------
   --  Add the event in the list of events and increment the event counter.
   --  ------------------------------
   procedure Insert (Target : in out Target_Events;
                     Event  : in Probe_Event_Type) is
   begin
      Target.Events.Insert (Event);
      Util.Concurrent.Counters.Increment (Target.Event_Count);
   end Insert;

   procedure Get_Events (Target : in out Target_Events;
                         Start  : in MAT.Types.Target_Time;
                         Finish : in MAT.Types.Target_Time;
                         Into   : in out Target_Event_Vector) is
   begin
      Target.Events.Get_Events (Start, Finish, Into);
   end Get_Events;

   --  ------------------------------
   --  Get the start and finish time for the events that have been received.
   --  ------------------------------
   procedure Get_Time_Range (Target : in out Target_Events;
                             Start  : out MAT.Types.Target_Time;
                             Finish : out MAT.Types.Target_Time) is
   begin
      Target.Events.Get_Time_Range (Start, Finish);
   end Get_Time_Range;

   --  ------------------------------
   --  Get the probe event with the given allocated unique id.
   --  ------------------------------
   function Get_Event (Target : in Target_Events;
                       Id     : in Event_Id_Type) return Probe_Event_Type is
   begin
      return Target.Events.Get_Event (Id);
   end Get_Event;

   --  ------------------------------
   --  Get the current event counter.
   --  ------------------------------
   function Get_Event_Counter (Target : in Target_Events) return Integer is
   begin
      return Util.Concurrent.Counters.Value (Target.Event_Count);
   end Get_Event_Counter;

   protected body Event_Collector is

      --  ------------------------------
      --  Add the event in the list of events.
      --  ------------------------------
      procedure Insert (Event : in Probe_Event_Type) is
         Info : Target_Event;
      begin
         if Current = null then
            Current := new Event_Block;
            Current.Start := Event.Time;
            Events.Insert (Event.Time, Current);
            Ids.Insert (Last_Id + 1, Current);
         end if;
         Current.Count := Current.Count + 1;
         Current.Events (Current.Count) := Event;
         Current.Events (Current.Count).Id := Last_Id;
         Last_Id := Last_Id + 1;
         Current.Finish := Event.Time;
         if Current.Count = Current.Events'Last then
            Current := null;
         end if;
      end Insert;

      procedure Get_Events (Start  : in MAT.Types.Target_Time;
                            Finish : in MAT.Types.Target_Time;
                            Into   : in out Target_Event_Vector) is
         Iter  : Event_Cursor := Events.Floor (Start);
         Block : Event_Block_Access;
      begin
         while Event_Maps.Has_Element (Iter) loop
            Block := Event_Maps.Element (Iter);
            exit when Block.Start > Finish;
            for I in Block.Events'First .. Block.Count loop
               exit when Block.Events (I).Time > Finish;
               if Block.Events (I).Time >= Start then
                  Into.Append (Block.Events (I));
               end if;
            end loop;
            Event_Maps.Next (Iter);
         end loop;
      end Get_Events;

      --  ------------------------------
      --  Get the start and finish time for the events that have been received.
      --  ------------------------------
      procedure Get_Time_Range (Start  : out MAT.Types.Target_Time;
                                Finish : out MAT.Types.Target_Time) is
         First : constant Event_Block_Access := Events.First_Element;
         Last  : constant Event_Block_Access := Events.Last_Element;
      begin
         Start  := First.Events (First.Events'First).Time;
         Finish := Last.Events (Last.Count).Time;
      end Get_Time_Range;

      --  ------------------------------
      --  Get the probe event with the given allocated unique id.
      --  ------------------------------
      function Get_Event (Id : in Event_Id_Type) return Probe_Event_Type is
         Iter  : Event_Id_Cursor := Ids.Floor (Id);
         Block : Event_Block_Access;
         Pos   : Event_Id_Type;
      begin
         while not Event_Id_Maps.Has_Element (Iter) loop
            Block := Event_Id_Maps.Element (Iter);
            exit when Id < Block.Events (Block.Events'First).Id;
            Pos := Id - Block.Events (Block.Events'First).Id;
            if Pos < Block.Count then
               return Block.Events (Pos);
            end if;
            Event_Id_Maps.Next (Iter);
         end loop;
         raise Not_Found;
      end Get_Event;

   end Event_Collector;

end MAT.Events.Targets;

Implement the Get_Event function

Implement the Get_Event function


-----------------------------------------------------------------------
--  mat-events-targets - Events received and collected from a target
--  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.Containers.Ordered_Maps;
with Ada.Containers.Vectors;

with Util.Concurrent.Counters;

with MAT.Frames;
package MAT.Events.Targets is

   type Event_Type is mod 16;
   type Probe_Index_Type is mod 16;

   type Event_Id_Type is new Natural;

   type Probe_Event_Type is record
      Id       : Event_Id_Type;
      Event    : MAT.Types.Uint16;
      Index    : Probe_Index_Type;
      Time     : MAT.Types.Target_Time;
      Thread   : MAT.Types.Target_Thread_Ref;
      Frame    : MAT.Frames.Frame_Type;
      Addr     : MAT.Types.Target_Addr;
      Size     : MAT.Types.Target_Size;
      Old_Addr : MAT.Types.Target_Addr;
   end record;

   subtype Target_Event is Probe_Event_Type;

   package Target_Event_Vectors is
     new Ada.Containers.Vectors (Positive, Target_Event);

   subtype Target_Event_Vector is Target_Event_Vectors.Vector;
   subtype Target_Event_Cursor is Target_Event_Vectors.Cursor;

   type Target_Events is tagged limited private;
   type Target_Events_Access is access all Target_Events'Class;

   --  Add the event in the list of events and increment the event counter.
   procedure Insert (Target : in out Target_Events;
                     Event  : in Probe_Event_Type);

   procedure Get_Events (Target : in out Target_Events;
                         Start  : in MAT.Types.Target_Time;
                         Finish : in MAT.Types.Target_Time;
                         Into   : in out Target_Event_Vector);

   --  Get the start and finish time for the events that have been received.
   procedure Get_Time_Range (Target : in out Target_Events;
                             Start  : out MAT.Types.Target_Time;
                             Finish : out MAT.Types.Target_Time);

   --  Get the current event counter.
   function Get_Event_Counter (Target : in Target_Events) return Integer;

private

   EVENT_BLOCK_SIZE : constant Positive := 1024;

   type Probe_Event_Array is array (1 .. EVENT_BLOCK_SIZE) of Probe_Event_Type;

   type Event_Block is record
      Start  : MAT.Types.Target_Time;
      Finish : MAT.Types.Target_Time;
      Count  : Natural := 0;
      Events : Probe_Event_Array;
   end record;
   type Event_Block_Access is access all Event_Block;

   use type MAT.Types.Target_Time;
   package Event_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Time,
                                      Element_Type => Event_Block_Access);

   subtype Event_Map is Event_Maps.Map;
   subtype Event_Cursor is Event_Maps.Cursor;

   protected type Event_Collector is

      --  Add the event in the list of events.
      procedure Insert (Event  : in Probe_Event_Type);

      procedure Get_Events (Start  : in MAT.Types.Target_Time;
                            Finish : in MAT.Types.Target_Time;
                            Into   : in out Target_Event_Vector);

      --  Get the start and finish time for the events that have been received.
      procedure Get_Time_Range (Start  : out MAT.Types.Target_Time;
                                Finish : out MAT.Types.Target_Time);

   private
      Current       : Event_Block_Access := null;
      Events        : Event_Map;
      Last_Id       : Event_Id_Type := 0;
   end Event_Collector;

   type Target_Events is tagged limited record
      Events      : Event_Collector;
      Event_Count : Util.Concurrent.Counters.Counter;
   end record;

end MAT.Events.Targets;

-----------------------------------------------------------------------
--  mat-events-targets - Events received and collected from a target
--  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.Containers.Ordered_Maps;
with Ada.Containers.Vectors;

with Util.Concurrent.Counters;

with MAT.Frames;
package MAT.Events.Targets is

   type Event_Type is mod 16;
   type Probe_Index_Type is mod 16;

   type Event_Id_Type is new Natural;

   type Probe_Event_Type is record
      Id       : Event_Id_Type;
      Event    : MAT.Types.Uint16;
      Index    : Probe_Index_Type;
      Time     : MAT.Types.Target_Time;
      Thread   : MAT.Types.Target_Thread_Ref;
      Frame    : MAT.Frames.Frame_Type;
      Addr     : MAT.Types.Target_Addr;
      Size     : MAT.Types.Target_Size;
      Old_Addr : MAT.Types.Target_Addr;
   end record;

   subtype Target_Event is Probe_Event_Type;

   package Target_Event_Vectors is
     new Ada.Containers.Vectors (Positive, Target_Event);

   subtype Target_Event_Vector is Target_Event_Vectors.Vector;
   subtype Target_Event_Cursor is Target_Event_Vectors.Cursor;

   type Target_Events is tagged limited private;
   type Target_Events_Access is access all Target_Events'Class;

   --  Add the event in the list of events and increment the event counter.
   procedure Insert (Target : in out Target_Events;
                     Event  : in Probe_Event_Type);

   procedure Get_Events (Target : in out Target_Events;
                         Start  : in MAT.Types.Target_Time;
                         Finish : in MAT.Types.Target_Time;
                         Into   : in out Target_Event_Vector);

   --  Get the start and finish time for the events that have been received.
   procedure Get_Time_Range (Target : in out Target_Events;
                             Start  : out MAT.Types.Target_Time;
                             Finish : out MAT.Types.Target_Time);

   --  Get the current event counter.
   function Get_Event_Counter (Target : in Target_Events) return Integer;

private

   EVENT_BLOCK_SIZE : constant Positive := 1024;

   type Probe_Event_Array is array (1 .. EVENT_BLOCK_SIZE) of Probe_Event_Type;

   type Event_Block is record
      Start  : MAT.Types.Target_Time;
      Finish : MAT.Types.Target_Time;
      Count  : Natural := 0;
      Events : Probe_Event_Array;
   end record;
   type Event_Block_Access is access all Event_Block;

   use type MAT.Types.Target_Time;
   package Event_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Time,
                                      Element_Type => Event_Block_Access);

   subtype Event_Map is Event_Maps.Map;
   subtype Event_Cursor is Event_Maps.Cursor;

   protected type Event_Collector is

      --  Add the event in the list of events.
      procedure Insert (Event  : in Probe_Event_Type);

      procedure Get_Events (Start  : in MAT.Types.Target_Time;
                            Finish : in MAT.Types.Target_Time;
                            Into   : in out Target_Event_Vector);

      --  Get the start and finish time for the events that have been received.
      procedure Get_Time_Range (Start  : out MAT.Types.Target_Time;
                                Finish : out MAT.Types.Target_Time);

      --  Get the probe event with the given allocated unique id.
      function Get_Event (Id : in Event_Id_Type) return Probe_Event_Type;

   private
      Current       : Event_Block_Access := null;
      Events        : Event_Map;
      Last_Id       : Event_Id_Type := 0;
   end Event_Collector;

   type Target_Events is tagged limited record
      Events      : Event_Collector;
      Event_Count : Util.Concurrent.Counters.Counter;
   end record;

end MAT.Events.Targets;

Declare the protected procedure Get_Event to retrieve an event from the event ID