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

with GL.Low_Level;

package GL.Objects.Queries is
   pragma Preelaborate;

   type Query_Type is
     (Transform_Feedback_Overflow,
      Transform_Feedback_Stream_Overflow,
      Time_Elapsed,
      Samples_Passed,
      Any_Samples_Passed,
      Primitives_Generated,
      Transform_Feedback_Primitives_Written,
      Any_Samples_Passed_Conservative,
      Timestamp);

   --  Has to be defined here because of the subtype declaration below
   for Query_Type use
     (Transform_Feedback_Overflow           => 16#82EC#,
      Transform_Feedback_Stream_Overflow    => 16#82ED#,
      Time_Elapsed                          => 16#88BF#,
      Samples_Passed                        => 16#8914#,
      Any_Samples_Passed                    => 16#8C2F#,
      Primitives_Generated                  => 16#8C87#,
      Transform_Feedback_Primitives_Written => 16#8C88#,
      Any_Samples_Passed_Conservative       => 16#8D6A#,
      Timestamp                             => 16#8E28#);
   for Query_Type'Size use Low_Level.Enum'Size;

   subtype Async_Query_Type is Query_Type
     range Transform_Feedback_Overflow .. Any_Samples_Passed_Conservative;

   subtype Timestamp_Query_Type is Query_Type range Timestamp .. Timestamp;

   subtype Stream_Query_Type is Query_Type
     with Static_Predicate =>
       Stream_Query_Type in Primitives_Generated |
                            Transform_Feedback_Primitives_Written |
                            Transform_Feedback_Stream_Overflow;

   type Query_Mode is (Wait, No_Wait, By_Region_Wait, By_Region_No_Wait,
                       Wait_Inverted, No_Wait_Inverted, By_Region_Wait_Inverted,
                       By_Region_No_Wait_Inverted);

   type Query_Param is (Result, Result_Available, Result_No_Wait);

   type Target_Param is (Counter_Bits, Current_Query);

   type Query (Target : Query_Type) is new GL_Object with private;

   overriding
   procedure Initialize_Id (Object : in out Query);

   overriding
   procedure Delete_Id (Object : in out Query);

   overriding
   function Identifier (Object : Query) return Types.Debug.Identifier is
     (Types.Debug.Query);

   type Active_Query is limited new Ada.Finalization.Limited_Controlled with private;

   type Conditional_Render is limited new Ada.Finalization.Limited_Controlled with private;

   function Begin_Query
     (Object : in out Query;
      Target : in     Async_Query_Type;
      Index  : in     Natural := 0) return Active_Query'Class
   with Pre => (if Target not in Stream_Query_Type then Index = 0);
   --  Start an asynchronous query. The value returned is of a controlled
   --  type, meaning you must assign it to some local variable, so that
   --  the query will be automatically ended when the variable goes out
   --  of scope.
   --
   --  Queries of type Timestamp are not used within a scope. For such
   --  a query you can record the time into the query object by calling
   --  Record_Current_Time.
   --
   --  Certain queries support multiple query operations; one for each
   --  index. The index represents the vertex output stream used in a
   --  Geometry Shader. These targets are:
   --
   --    * Primitives_Generated
   --    * Transform_Feedback_Primitives_Written
   --    * Transform_Feedback_Stream_Overflow
   --
   --  The query should be issued while within a transform feedback scope
   --  for one of the following targets:
   --
   --    * Transform_Feedback_Primitives_Written
   --    * Transform_Feedback_Overflow
   --    * Transform_Feedback_Stream_Overflow

   function Begin_Conditional_Render (Object : in out Query;
                                      Mode   : in     Query_Mode)
     return Conditional_Render'Class;
   --  Start a conditional rendering. The value returned is of a controlled
   --  type, meaning you must assign it to some local variable, so that
   --  the rendering will be automatically ended when the variable goes
   --  out of scope.
   --
   --  If Mode is (By_Region_)Wait, then OpenGL will wait until the result
   --  becomes available and uses the value of the result to determine
   --  whether to execute or discard rendering commands.
   --
   --  If Mode is *_Inverted, then the condition is inverted, meaning it
   --  will execute rendering commands if the query result is zero/false.
   --
   --  If Mode is (By_Region_)No_Wait(_Inverted), then OpenGL may choose
   --  to execute rendering commands while the result of the query is not
   --  available.

   function Result_Available (Object : in out Query) return Boolean;
   --  Return true if a result is available, false otherwise. This function
   --  can be used to avoid calling Result (and thereby stalling the CPU)
   --  when the result is not yet available.

   function Result_If_Available (Object : in out Query; Default_Value : Boolean)
     return Boolean;
   --  Return the result if available, otherwise return the default value

   function Result_If_Available (Object : in out Query; Default_Value : Natural)
     return Natural;
   --  Return the result if available, otherwise return the default value

   function Result (Object : in out Query) return Boolean;
   --  Return the result. If the result is not yet available, then the
   --  CPU will stall until the result becomes available. This means
   --  that if you do not call Result_Available, then this function call
   --  will make the query synchronous.

   function Result (Object : in out Query) return Natural;
   --  Return the result. If the result is not yet available, then the
   --  CPU will stall until the result becomes available. This means
   --  that if you do not call Result_Available, then this function call
   --  will make the query synchronous.

   function Result_Bits (Target : in Query_Type) return Natural;

   procedure Record_Current_Time (Object : in out Query);
   --  Record the time when the GPU has completed all previous commands
   --  in a query object. The result must be retrieved asynchronously using
   --  one of the Result functions.

   function Get_Current_Time return Long;
   --  Return the time when the GPU has received (but not necessarily
   --  completed) all previous commands. Calling this function stalls the CPU.

private

   for Query_Mode use (Wait                       => 16#8E13#,
                       No_Wait                    => 16#8E14#,
                       By_Region_Wait             => 16#8E15#,
                       By_Region_No_Wait          => 16#8E16#,
                       Wait_Inverted              => 16#8E17#,
                       No_Wait_Inverted           => 16#8E18#,
                       By_Region_Wait_Inverted    => 16#8E19#,
                       By_Region_No_Wait_Inverted => 16#8E1A#);
   for Query_Mode'Size use Low_Level.Enum'Size;

   for Target_Param use (Counter_Bits  => 16#8864#,
                         Current_Query => 16#8865#);
   for Target_Param'Size use Low_Level.Enum'Size;

   for Query_Param use (Result           => 16#8866#,
                        Result_Available => 16#8867#,
                        Result_No_Wait   => 16#9194#);
   for Query_Param'Size use Low_Level.Enum'Size;

   type Query (Target : Query_Type) is new GL_Object with null record;

   type Active_Query is limited new Ada.Finalization.Limited_Controlled with record
      Target : Query_Type;
      Index  : Natural;
      Finalized : Boolean;
   end record;

   overriding
   procedure Finalize (Object : in out Active_Query);

   type Conditional_Render is limited new Ada.Finalization.Limited_Controlled with record
      Finalized : Boolean;
   end record;

   overriding
   procedure Finalize (Object : in out Conditional_Render);

end GL.Objects.Queries;

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

with GL.Low_Level;

package GL.Objects.Queries is
   pragma Preelaborate;

   type Query_Type is
     (Transform_Feedback_Overflow,
      Transform_Feedback_Stream_Overflow,
      Vertices_Submitted,
      Primitives_Submitted,
      Vertex_Shader_Invocations,
      Tess_Control_Shader_Invocations,
      Tess_Evaluation_Shader_Invocations,
      Geometry_Shader_Primitives_Emitted,
      Fragment_Shader_Invocations,
      Compute_Shader_Invocations,
      Clipping_Input_Primitives,
      Clipping_Output_Primitives,
      Geometry_Shader_Invocations,
      Time_Elapsed,
      Samples_Passed,
      Any_Samples_Passed,
      Primitives_Generated,
      Transform_Feedback_Primitives_Written,
      Any_Samples_Passed_Conservative,
      Timestamp);

   --  Has to be defined here because of the subtype declaration below
   for Query_Type use
     (Transform_Feedback_Overflow           => 16#82EC#,
      Transform_Feedback_Stream_Overflow    => 16#82ED#,
      Vertices_Submitted                    => 16#82EE#,
      Primitives_Submitted                  => 16#82EF#,
      Vertex_Shader_Invocations             => 16#82F0#,
      Tess_Control_Shader_Invocations       => 16#82F1#,
      Tess_Evaluation_Shader_Invocations    => 16#82F2#,
      Geometry_Shader_Primitives_Emitted    => 16#82F3#,
      Fragment_Shader_Invocations           => 16#82F4#,
      Compute_Shader_Invocations            => 16#82F5#,
      Clipping_Input_Primitives             => 16#82F6#,
      Clipping_Output_Primitives            => 16#82F7#,
      Geometry_Shader_Invocations           => 16#887F#,
      Time_Elapsed                          => 16#88BF#,
      Samples_Passed                        => 16#8914#,
      Any_Samples_Passed                    => 16#8C2F#,
      Primitives_Generated                  => 16#8C87#,
      Transform_Feedback_Primitives_Written => 16#8C88#,
      Any_Samples_Passed_Conservative       => 16#8D6A#,
      Timestamp                             => 16#8E28#);
   for Query_Type'Size use Low_Level.Enum'Size;

   subtype Async_Query_Type is Query_Type
     range Transform_Feedback_Overflow .. Any_Samples_Passed_Conservative;

   subtype Timestamp_Query_Type is Query_Type range Timestamp .. Timestamp;

   subtype Stream_Query_Type is Query_Type
     with Static_Predicate =>
       Stream_Query_Type in Primitives_Generated |
                            Transform_Feedback_Primitives_Written |
                            Transform_Feedback_Stream_Overflow;

   type Query_Mode is (Wait, No_Wait, By_Region_Wait, By_Region_No_Wait,
                       Wait_Inverted, No_Wait_Inverted, By_Region_Wait_Inverted,
                       By_Region_No_Wait_Inverted);

   type Query_Param is (Result, Result_Available, Result_No_Wait);

   type Target_Param is (Counter_Bits, Current_Query);

   type Query (Target : Query_Type) is new GL_Object with private;

   overriding
   procedure Initialize_Id (Object : in out Query);

   overriding
   procedure Delete_Id (Object : in out Query);

   overriding
   function Identifier (Object : Query) return Types.Debug.Identifier is
     (Types.Debug.Query);

   type Active_Query is limited new Ada.Finalization.Limited_Controlled with private;

   type Conditional_Render is limited new Ada.Finalization.Limited_Controlled with private;

   function Begin_Query
     (Object : in out Query;
      Target : in     Async_Query_Type;
      Index  : in     Natural := 0) return Active_Query'Class
   with Pre => (if Target not in Stream_Query_Type then Index = 0);
   --  Start an asynchronous query. The value returned is of a controlled
   --  type, meaning you must assign it to some local variable, so that
   --  the query will be automatically ended when the variable goes out
   --  of scope.
   --
   --  Queries of type Timestamp are not used within a scope. For such
   --  a query you can record the time into the query object by calling
   --  Record_Current_Time.
   --
   --  Certain queries support multiple query operations; one for each
   --  index. The index represents the vertex output stream used in a
   --  Geometry Shader. These targets are:
   --
   --    * Primitives_Generated
   --    * Transform_Feedback_Primitives_Written
   --    * Transform_Feedback_Stream_Overflow
   --
   --  The query should be issued while within a transform feedback scope
   --  for one of the following targets:
   --
   --    * Transform_Feedback_Primitives_Written
   --    * Transform_Feedback_Overflow
   --    * Transform_Feedback_Stream_Overflow

   function Begin_Conditional_Render (Object : in out Query;
                                      Mode   : in     Query_Mode)
     return Conditional_Render'Class;
   --  Start a conditional rendering. The value returned is of a controlled
   --  type, meaning you must assign it to some local variable, so that
   --  the rendering will be automatically ended when the variable goes
   --  out of scope.
   --
   --  If Mode is (By_Region_)Wait, then OpenGL will wait until the result
   --  becomes available and uses the value of the result to determine
   --  whether to execute or discard rendering commands.
   --
   --  If Mode is *_Inverted, then the condition is inverted, meaning it
   --  will execute rendering commands if the query result is zero/false.
   --
   --  If Mode is (By_Region_)No_Wait(_Inverted), then OpenGL may choose
   --  to execute rendering commands while the result of the query is not
   --  available.

   function Result_Available (Object : in out Query) return Boolean;
   --  Return true if a result is available, false otherwise. This function
   --  can be used to avoid calling Result (and thereby stalling the CPU)
   --  when the result is not yet available.

   function Result_If_Available (Object : in out Query; Default_Value : Boolean)
     return Boolean;
   --  Return the result if available, otherwise return the default value

   function Result_If_Available (Object : in out Query; Default_Value : Natural)
     return Natural;
   --  Return the result if available, otherwise return the default value

   function Result (Object : in out Query) return Boolean;
   --  Return the result. If the result is not yet available, then the
   --  CPU will stall until the result becomes available. This means
   --  that if you do not call Result_Available, then this function call
   --  will make the query synchronous.

   function Result (Object : in out Query) return Natural;
   --  Return the result. If the result is not yet available, then the
   --  CPU will stall until the result becomes available. This means
   --  that if you do not call Result_Available, then this function call
   --  will make the query synchronous.

   function Result_Bits (Target : in Query_Type) return Natural;

   procedure Record_Current_Time (Object : in out Query);
   --  Record the time when the GPU has completed all previous commands
   --  in a query object. The result must be retrieved asynchronously using
   --  one of the Result functions.

   function Get_Current_Time return Long;
   --  Return the time when the GPU has received (but not necessarily
   --  completed) all previous commands. Calling this function stalls the CPU.

private

   for Query_Mode use (Wait                       => 16#8E13#,
                       No_Wait                    => 16#8E14#,
                       By_Region_Wait             => 16#8E15#,
                       By_Region_No_Wait          => 16#8E16#,
                       Wait_Inverted              => 16#8E17#,
                       No_Wait_Inverted           => 16#8E18#,
                       By_Region_Wait_Inverted    => 16#8E19#,
                       By_Region_No_Wait_Inverted => 16#8E1A#);
   for Query_Mode'Size use Low_Level.Enum'Size;

   for Target_Param use (Counter_Bits  => 16#8864#,
                         Current_Query => 16#8865#);
   for Target_Param'Size use Low_Level.Enum'Size;

   for Query_Param use (Result           => 16#8866#,
                        Result_Available => 16#8867#,
                        Result_No_Wait   => 16#9194#);
   for Query_Param'Size use Low_Level.Enum'Size;

   type Query (Target : Query_Type) is new GL_Object with null record;

   type Active_Query is limited new Ada.Finalization.Limited_Controlled with record
      Target : Query_Type;
      Index  : Natural;
      Finalized : Boolean;
   end record;

   overriding
   procedure Finalize (Object : in out Active_Query);

   type Conditional_Render is limited new Ada.Finalization.Limited_Controlled with record
      Finalized : Boolean;
   end record;

   overriding
   procedure Finalize (Object : in out Conditional_Render);

end GL.Objects.Queries;

gl: Add query targets for pipeline statistics

 * Extension ARB_pipeline_statistics_query (OpenGL 4.6)

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


-----------------------------------------------------------------------
--  awa-comments-logic -- Comments management
--  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 AWA.Services.Contexts;
with ADO.Sessions;
with ADO.Sessions.Entities;

with Ada.Calendar;

with Util.Log.Loggers;

package body AWA.Comments.Services is

   use Util.Log;
   use ADO.Sessions;
   use AWA.Services;

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

   --  ------------------------------
   --  Create a comment associated with the given database entity.
   --  The user must have permission to add comments on the given entity.
   --  ------------------------------
   procedure Create_Comment (Model   : in Comment_Service;
                             Entity  : in ADO.Objects.Object_Key;
                             Message : in String;
                             User    : in AWA.Users.Models.User_Ref'Class;
                             Result  : out ADO.Identifier) is
      pragma Unreferenced (Model);

      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB        : Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Comment   : Comment_Ref;
      Entity_Id : constant ADO.Identifier := ADO.Objects.Get_Value (Entity);
   begin
      Log.Info ("Create comment for user {0}", String'(User.Get_Name));

   --
   --  select from asset inner join acl
   --    on asset.collection_id = acl.entity_id and acl.entity_type = :entity_type
   --    where asset.id = :entity_id and acl.user_id = :user_id
--        AWA.Permissions.Module.Check (Entity => Entity, Permission => CREATE_COMMENT);
      Ctx.Start;
      Comment.Set_Message (Message);
      Comment.Set_Entity_Id (Entity_Id);
      Comment.Set_Entity_Type (ADO.Sessions.Entities.Find_Entity_Type (DB, Entity));
      Comment.Set_User (User);
      Comment.Set_Date (Ada.Calendar.Clock);
      Comment.Save (DB);
      Ctx.Commit;
      Result := Comment.Get_Id;

      Log.Info ("Comment {0} created", ADO.Identifier'Image (Result));
   end Create_Comment;

   procedure Find_Comment (Model   : in Comment_Service;
                           Id      : in ADO.Identifier;
                           Comment : in out Comment_Ref'Class) is
   begin
      null;
   end Find_Comment;

   --  ------------------------------
   --  Delete the comment identified by the given identifier.
   --  ------------------------------
   procedure Delete_Comment (Model   : in Comment_Service;
                             Id      : in ADO.Identifier) is
      pragma Unreferenced (Model);

      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB        : Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Comment   : Comment_Ref;
   begin
      Log.Info ("Delete comment {0}", ADO.Identifier'Image (Id));

      --        AWA.Permissions.Module.Check (Entity => Entity, Permission => CREATE_COMMENT);
      Ctx.Start;
      Comment.Set_Id (Id);
      Comment.Delete (DB);
      Ctx.Commit;
   end Delete_Comment;

end AWA.Comments.Services;

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

with AWA.Services.Contexts;
with ADO.Sessions;
with ADO.Sessions.Entities;

with Ada.Calendar;

with Util.Log.Loggers;

package body AWA.Comments.Services is

   use Util.Log;
   use ADO.Sessions;
   use AWA.Services;

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

   --  ------------------------------
   --  Create a comment associated with the given database entity.
   --  The user must have permission to add comments on the given entity.
   --  ------------------------------
   procedure Create_Comment (Model   : in Comment_Service;
                             Entity  : in ADO.Objects.Object_Key;
                             Message : in String;
                             User    : in AWA.Users.Models.User_Ref'Class;
                             Result  : out ADO.Identifier) is
      pragma Unreferenced (Model);

      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB        : Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Comment   : Comment_Ref;
      Entity_Id : constant ADO.Identifier := ADO.Objects.Get_Value (Entity);
   begin
      Log.Info ("Create comment for user {0}", String'(User.Get_Name));

   --
   --  select from asset inner join acl
   --    on asset.collection_id = acl.entity_id and acl.entity_type = :entity_type
   --    where asset.id = :entity_id and acl.user_id = :user_id
--        AWA.Permissions.Module.Check (Entity => Entity, Permission => CREATE_COMMENT);
      Ctx.Start;
      Comment.Set_Message (Message);
      Comment.Set_Entity_Id (Entity_Id);
      Comment.Set_Entity_Type (ADO.Sessions.Entities.Find_Entity_Type (DB, Entity));
      Comment.Set_Author (User);
      Comment.Set_Date (Ada.Calendar.Clock);
      Comment.Save (DB);
      Ctx.Commit;
      Result := Comment.Get_Id;

      Log.Info ("Comment {0} created", ADO.Identifier'Image (Result));
   end Create_Comment;

   procedure Find_Comment (Model   : in Comment_Service;
                           Id      : in ADO.Identifier;
                           Comment : in out Comment_Ref'Class) is
   begin
      null;
   end Find_Comment;

   --  ------------------------------
   --  Delete the comment identified by the given identifier.
   --  ------------------------------
   procedure Delete_Comment (Model   : in Comment_Service;
                             Id      : in ADO.Identifier) is
      pragma Unreferenced (Model);

      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB        : Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Comment   : Comment_Ref;
   begin
      Log.Info ("Delete comment {0}", ADO.Identifier'Image (Id));

      --        AWA.Permissions.Module.Check (Entity => Entity, Permission => CREATE_COMMENT);
      Ctx.Start;
      Comment.Set_Id (Id);
      Comment.Delete (DB);
      Ctx.Commit;
   end Delete_Comment;

end AWA.Comments.Services;

Update the implementation according to the UML model


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

with ASF.Servlets;
with ASF.Requests;
with ASF.Responses;

--  == Storage Servlet ==
--  The <tt>Storage_Servlet</tt> type is the servlet that allows to retrieve the file
--  content that was uploaded.
package AWA.Storages.Servlets is

   --  The <b>Storage_Servlet</b> represents the component that will handle
   --  an HTTP request received by the server.
   type Storage_Servlet is new ASF.Servlets.Servlet with private;

   --  Called by the servlet container to indicate to a servlet that the servlet
   --  is being placed into service.
   overriding
   procedure Initialize (Server  : in out Storage_Servlet;
                         Context : in ASF.Servlets.Servlet_Registry'Class);

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

   --  Load the data content that correspond to the GET request and get the name as well
   --  as mime-type and date.
   procedure Load (Server   : in Storage_Servlet;
                   Request  : in out ASF.Requests.Request'Class;
                   Name     : out Ada.Strings.Unbounded.Unbounded_String;
                   Mime     : out Ada.Strings.Unbounded.Unbounded_String;
                   Date     : out Ada.Calendar.Time;
                   Data     : out ADO.Blob_Ref);

private

   type Storage_Servlet is new ASF.Servlets.Servlet with null record;

end AWA.Storages.Servlets;

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

with Servlet.Core;
with ASF.Requests;
with ASF.Responses;

--  == Storage Servlet ==
--  The <tt>Storage_Servlet</tt> type is the servlet that allows to retrieve the file
--  content that was uploaded.
package AWA.Storages.Servlets is

   --  The <b>Storage_Servlet</b> represents the component that will handle
   --  an HTTP request received by the server.
   type Storage_Servlet is new Servlet.Core.Servlet with private;

   --  Called by the servlet container to indicate to a servlet that the servlet
   --  is being placed into service.
   overriding
   procedure Initialize (Server  : in out Storage_Servlet;
                         Context : in Servlet.Core.Servlet_Registry'Class);

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

   --  Load the data content that correspond to the GET request and get the name as well
   --  as mime-type and date.
   procedure Load (Server   : in Storage_Servlet;
                   Request  : in out ASF.Requests.Request'Class;
                   Name     : out Ada.Strings.Unbounded.Unbounded_String;
                   Mime     : out Ada.Strings.Unbounded.Unbounded_String;
                   Date     : out Ada.Calendar.Time;
                   Data     : out ADO.Blob_Ref);

private

   type Storage_Servlet is new Servlet.Core.Servlet with null record;

end AWA.Storages.Servlets;

Use the Servlet.Core package instread of ASF.Servlets


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

with ASF.Requests;
with ASF.Responses;
with ASF.Server;
with Ada.IO_Exceptions;

with Util.Files;
with Util.Properties;

with EL.Contexts.Default;

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

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

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

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

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

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

   exception
      when Constraint_Error =>
         return Default;
   end Get_Config;

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

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

   exception
      when E : others =>
         Log.Error ("Invalid parameter ", E, True);
         return EL.Expressions.Create_Expression ("", Ctx);

   end Get_Config;

   --  ------------------------------
   --  Send the event to the module
   --  ------------------------------
   procedure Send_Event (Plugin  : in Module;
                         Content : in AWA.Events.Module_Event'Class) is
   begin
      Plugin.App.Send_Event (Content);
   end Send_Event;

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

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

   --  ------------------------------
   --  Finalize the module.
   --  ------------------------------
   overriding
   procedure Finalize (Plugin : in out Module) is
   begin
      null;
   end Finalize;

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

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

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

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

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

   procedure Initialize (Plugin : in out Module;
                         App    : in Application_Access;
                         Props  : in ASF.Applications.Config) is
      pragma Unreferenced (Props);
   begin
      Plugin.Self := Plugin'Unchecked_Access;
      Plugin.App := App;
   end Initialize;

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

   --  ------------------------------
   --  Register the module in the registry.
   --  ------------------------------
   procedure Register (Registry : in Module_Registry_Access;
                       App      : in Application_Access;
                       Plugin   : in Module_Access;
                       Name     : in String;
                       URI      : in String) is
      procedure Copy (Params : in Util.Properties.Manager'Class);

      procedure Copy (Params : in Util.Properties.Manager'Class) is
      begin
         Plugin.Config.Copy (From => Params, Prefix => Name & ".", Strip => True);
      end Copy;

      Paths : constant String := Registry.Config.Get (Applications.P_Module_Dir.P);
   begin
      Log.Info ("Register module '{0}' under URI '{1}'", Name, URI);

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

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

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

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

      Plugin.Initialize (App, Plugin.Config);

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

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

      --  Override the module configuration with the application configuration
      App.Get_Init_Parameters (Copy'Access);

      Plugin.Configure (Plugin.Config);

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

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

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

   --  ------------------------------
   --  Iterate over the modules that have been registered and execute the Process
   --  procedure on each of the module instance.
   --  ------------------------------
   procedure Iterate (Registry : in Module_Registry;
                      Process  : access procedure (Plugin : in out Module'Class)) is
      Iter : Module_Maps.Cursor := Registry.Name_Map.First;
   begin
      while Module_Maps.Has_Element (Iter) loop
         Process (Module_Maps.Element (Iter).all);
         Module_Maps.Next (Iter);
      end loop;
   end Iterate;

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

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

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

   --  ------------------------------
   --  Find the module with the given name in the application and add the listener to the
   --  module listener list.
   --  ------------------------------
   procedure Add_Listener (Plugin : in Module;
                           Name   : in String;
                           Item   : in Util.Listeners.Listener_Access) is
      M : constant Module_Access := Plugin.App.Find_Module (Name);
   begin
      if M = null then
         Log.Error ("Cannot find module {0} to add a lifecycle listener", Name);
      else
         M.Add_Listener (Item);
      end if;
   end Add_Listener;

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

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

      procedure Process (Request  : in out ASF.Requests.Request'Class;
                         Response : in out ASF.Responses.Response'Class);

      Value : Util.Beans.Objects.Object;

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

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

end AWA.Modules;

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

with ASF.Requests;
with ASF.Responses;
with ASF.Server;
with Ada.IO_Exceptions;

with Util.Files;
with Util.Properties;

with EL.Contexts.Default;

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

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

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

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

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

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

   exception
      when Constraint_Error =>
         return Default;
   end Get_Config;

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

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

      type Event_ELResolver is new EL.Contexts.Default.Default_ELResolver with null record;

      overriding
      function Get_Value (Resolver : Event_ELResolver;
                          Context  : EL.Contexts.ELContext'Class;
                          Base     : access Util.Beans.Basic.Readonly_Bean'Class;
                          Name     : Unbounded_String) return Util.Beans.Objects.Object;

      --  ------------------------------
      --  Get the value associated with a base object and a given property.
      --  ------------------------------
      overriding
      function Get_Value (Resolver : Event_ELResolver;
                          Context  : EL.Contexts.ELContext'Class;
                          Base     : access Util.Beans.Basic.Readonly_Bean'Class;
                          Name     : Unbounded_String) return Util.Beans.Objects.Object is
      begin
         if Base /= null then
            return EL.Contexts.Default.Default_ELResolver (Resolver).Get_Value (Context, Base,
                                                                                Name);
         else
            return Util.Beans.Objects.To_Object (Plugin.Get_Config (To_String (Name), ""));
         end if;
      end Get_Value;

      Resolver : aliased Event_ELResolver;
      Context  : EL.Contexts.Default.Default_Context;
      Value    : constant String := Plugin.Get_Config (Name, Default);
   begin
      Context.Set_Resolver (Resolver'Unchecked_Access);
      return EL.Expressions.Reduce_Expression (EL.Expressions.Create_Expression (Value, Context),
                                               Context);

   exception
      when E : others =>
         Log.Error ("Invalid parameter ", E, True);
         return EL.Expressions.Create_Expression ("", Context);

   end Get_Config;

   --  ------------------------------
   --  Send the event to the module
   --  ------------------------------
   procedure Send_Event (Plugin  : in Module;
                         Content : in AWA.Events.Module_Event'Class) is
   begin
      Plugin.App.Send_Event (Content);
   end Send_Event;

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

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

   --  ------------------------------
   --  Finalize the module.
   --  ------------------------------
   overriding
   procedure Finalize (Plugin : in out Module) is
   begin
      null;
   end Finalize;

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

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

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

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

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

   procedure Initialize (Plugin : in out Module;
                         App    : in Application_Access;
                         Props  : in ASF.Applications.Config) is
      pragma Unreferenced (Props);
   begin
      Plugin.Self := Plugin'Unchecked_Access;
      Plugin.App := App;
   end Initialize;

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

   --  ------------------------------
   --  Register the module in the registry.
   --  ------------------------------
   procedure Register (Registry : in Module_Registry_Access;
                       App      : in Application_Access;
                       Plugin   : in Module_Access;
                       Name     : in String;
                       URI      : in String) is
      procedure Copy (Params : in Util.Properties.Manager'Class);

      procedure Copy (Params : in Util.Properties.Manager'Class) is
      begin
         Plugin.Config.Copy (From => Params, Prefix => Name & ".", Strip => True);
      end Copy;

      Paths : constant String := Registry.Config.Get (Applications.P_Module_Dir.P);
   begin
      Log.Info ("Register module '{0}' under URI '{1}'", Name, URI);

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

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

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

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

      Plugin.Initialize (App, Plugin.Config);

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

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

      --  Override the module configuration with the application configuration
      App.Get_Init_Parameters (Copy'Access);

      Plugin.Configure (Plugin.Config);

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

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

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

   --  ------------------------------
   --  Iterate over the modules that have been registered and execute the Process
   --  procedure on each of the module instance.
   --  ------------------------------
   procedure Iterate (Registry : in Module_Registry;
                      Process  : access procedure (Plugin : in out Module'Class)) is
      Iter : Module_Maps.Cursor := Registry.Name_Map.First;
   begin
      while Module_Maps.Has_Element (Iter) loop
         Process (Module_Maps.Element (Iter).all);
         Module_Maps.Next (Iter);
      end loop;
   end Iterate;

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

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

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

   --  ------------------------------
   --  Find the module with the given name in the application and add the listener to the
   --  module listener list.
   --  ------------------------------
   procedure Add_Listener (Plugin : in Module;
                           Name   : in String;
                           Item   : in Util.Listeners.Listener_Access) is
      M : constant Module_Access := Plugin.App.Find_Module (Name);
   begin
      if M = null then
         Log.Error ("Cannot find module {0} to add a lifecycle listener", Name);
      else
         M.Add_Listener (Item);
      end if;
   end Add_Listener;

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

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

      procedure Process (Request  : in out ASF.Requests.Request'Class;
                         Response : in out ASF.Responses.Response'Class);

      Value : Util.Beans.Objects.Object;

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

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

end AWA.Modules;

Update the Get_Config function for a better support of EL expressions


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

with MAT.Types;
with MAT.Memory.Targets;
with MAT.Symbols.Targets;
with MAT.Readers;
with MAT.Consoles;
package MAT.Targets is

   type Target_Process_Type is tagged limited record
      Pid     : MAT.Types.Target_Process_Ref;
      Memory  : MAT.Memory.Targets.Target_Memory;
      Console : MAT.Consoles.Console_Access;
   end record;
   type Target_Process_Type_Access is access all Target_Process_Type'Class;

   type Target_Type is tagged limited record
      Pid     : MAT.Types.Target_Process_Ref;
      Memory  : MAT.Memory.Targets.Target_Memory;
      Symbols : MAT.Symbols.Targets.Target_Symbols;
      Console : MAT.Consoles.Console_Access;
   end record;

   type Target_Type_Access is access all Target_Type'Class;

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

   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Process : out Target_Process_Type_Access);

private

   --  Define a map of <tt>Target_Process_Type_Access</tt> keyed by the process Id.
   --  This map allows to retrieve the information about a process.
   use type MAT.Types.Target_Process_Ref;
   package Process_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Process_Ref,
                                      Element_Type => Target_Process_Type_Access);

end MAT.Targets;

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

with MAT.Types;
with MAT.Memory.Targets;
with MAT.Symbols.Targets;
with MAT.Readers;
with MAT.Consoles;
package MAT.Targets is

   type Target_Process_Type is tagged limited record
      Pid     : MAT.Types.Target_Process_Ref;
      Memory  : MAT.Memory.Targets.Target_Memory;
      Console : MAT.Consoles.Console_Access;
   end record;
   type Target_Process_Type_Access is access all Target_Process_Type'Class;

   type Target_Type is tagged limited record
      Pid     : MAT.Types.Target_Process_Ref;
      Memory  : MAT.Memory.Targets.Target_Memory;
      Symbols : MAT.Symbols.Targets.Target_Symbols;
      Console : MAT.Consoles.Console_Access;
   end record;

   type Target_Type_Access is access all Target_Type'Class;

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

   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Process : out Target_Process_Type_Access);

private

   --  Define a map of <tt>Target_Process_Type_Access</tt> keyed by the process Id.
   --  This map allows to retrieve the information about a process.
   use type MAT.Types.Target_Process_Ref;
   package Process_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Process_Ref,
                                      Element_Type => Target_Process_Type_Access);

   subtype Process_Map is Process_Maps.Map;
   subtype Process_Cursor is Process_Maps.Cursor;

end MAT.Targets;

Declare the Process_Map and Process_Cursor types


-----------------------------------------------------------------------
--  mat-callbacks - Callbacks for Gtk
--  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 Glib.Main;
with Gtk.Main;
with Gtk.Widget;
with Gtk.Label;

with Util.Log.Loggers;

with MAT.Commands;
package body MAT.Callbacks is

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

   type Info is record
      Builder : access Gtkada.Builder.Gtkada_Builder_Record'Class;
   end record;

   package Timer_Callback is
     new Glib.Main.Generic_Sources (MAT.Targets.Gtkmat.Target_Type_Access);

   Timer : Glib.Main.G_Source_Id;
   MemTotal : Natural := 1;

   Target : MAT.Targets.Gtkmat.Target_Type_Access;

   function Refresh_Timeout (Target : in MAT.Targets.Gtkmat.Target_Type_Access) return Boolean is
   begin
      Target.Refresh_Process;
      return True;
   end Refresh_Timeout;

   --  ------------------------------
   --  Initialize and register the callbacks.
   --  ------------------------------
   procedure Initialize (Target  : in MAT.Targets.Gtkmat.Target_Type_Access;
                         Builder : in Gtkada.Builder.Gtkada_Builder) is
   begin
      MAT.Callbacks.Target := Target;
      Builder.Register_Handler (Handler_Name => "quit",
                                Handler      => MAT.Callbacks.On_Menu_Quit'Access);
      Builder.Register_Handler (Handler_Name => "about",
                                Handler      => MAT.Callbacks.On_Menu_About'Access);
      Builder.Register_Handler (Handler_Name => "close-about",
                                Handler      => MAT.Callbacks.On_Close_About'Access);
      Builder.Register_Handler (Handler_Name => "cmd-sizes",
                                Handler      => MAT.Callbacks.On_Btn_Sizes'Access);
      Timer := Timer_Callback.Timeout_Add (1000, Refresh_Timeout'Access, Target);
   end Initialize;

   --  ------------------------------
   --  Callback executed when the "quit" action is executed from the menu.
   --  ------------------------------
   procedure On_Menu_Quit (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class) is
   begin
      Gtk.Main.Main_Quit;
   end On_Menu_Quit;

   --  ------------------------------
   --  Callback executed when the "about" action is executed from the menu.
   --  ------------------------------
   procedure On_Menu_About (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class) is
      About : constant Gtk.Widget.Gtk_Widget :=
        Gtk.Widget.Gtk_Widget (Object.Get_Object ("about"));
   begin
      About.Show;
   end On_Menu_About;

   --  ------------------------------
   --  Callback executed when the "close-about" action is executed from the about box.
   --  ------------------------------
   procedure On_Close_About (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class) is
      About : constant Gtk.Widget.Gtk_Widget :=
        Gtk.Widget.Gtk_Widget (Object.Get_Object ("about"));
   begin
      About.Hide;
   end On_Close_About;

   --  ------------------------------
   --  Callback executed when the "cmd-sizes" action is executed from the "Sizes" action.
   --  ------------------------------
   procedure On_Btn_Sizes (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class) is
      pragma Unreferenced (Object);
   begin
      MAT.Commands.Sizes_Command (Target.all, "");
   end On_Btn_Sizes;

end MAT.Callbacks;

-----------------------------------------------------------------------
--  mat-callbacks - Callbacks for Gtk
--  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 Glib.Main;
with Gtk.Main;
with Gtk.Widget;
with Gtk.Label;

with Util.Log.Loggers;

with MAT.Commands;
package body MAT.Callbacks is

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

   type Info is record
      Builder : access Gtkada.Builder.Gtkada_Builder_Record'Class;
   end record;

   package Timer_Callback is
     new Glib.Main.Generic_Sources (MAT.Targets.Gtkmat.Target_Type_Access);

   Timer : Glib.Main.G_Source_Id;
   MemTotal : Natural := 1;

   Target : MAT.Targets.Gtkmat.Target_Type_Access;

   function Refresh_Timeout (Target : in MAT.Targets.Gtkmat.Target_Type_Access) return Boolean is
   begin
      Target.Refresh_Process;
      return True;
   end Refresh_Timeout;

   --  ------------------------------
   --  Initialize and register the callbacks.
   --  ------------------------------
   procedure Initialize (Target  : in MAT.Targets.Gtkmat.Target_Type_Access;
                         Builder : in Gtkada.Builder.Gtkada_Builder) is
   begin
      MAT.Callbacks.Target := Target;
      Builder.Register_Handler (Handler_Name => "quit",
                                Handler      => MAT.Callbacks.On_Menu_Quit'Access);
      Builder.Register_Handler (Handler_Name => "about",
                                Handler      => MAT.Callbacks.On_Menu_About'Access);
      Builder.Register_Handler (Handler_Name => "close-about",
                                Handler      => MAT.Callbacks.On_Close_About'Access);
      Builder.Register_Handler (Handler_Name => "cmd-sizes",
                                Handler      => MAT.Callbacks.On_Btn_Sizes'Access);
      Builder.Register_Handler (Handler_Name => "cmd-threads",
                                Handler      => MAT.Callbacks.On_Btn_Threads'Access);
      Timer := Timer_Callback.Timeout_Add (1000, Refresh_Timeout'Access, Target);
   end Initialize;

   --  ------------------------------
   --  Callback executed when the "quit" action is executed from the menu.
   --  ------------------------------
   procedure On_Menu_Quit (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class) is
   begin
      Gtk.Main.Main_Quit;
   end On_Menu_Quit;

   --  ------------------------------
   --  Callback executed when the "about" action is executed from the menu.
   --  ------------------------------
   procedure On_Menu_About (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class) is
      About : constant Gtk.Widget.Gtk_Widget :=
        Gtk.Widget.Gtk_Widget (Object.Get_Object ("about"));
   begin
      About.Show;
   end On_Menu_About;

   --  ------------------------------
   --  Callback executed when the "close-about" action is executed from the about box.
   --  ------------------------------
   procedure On_Close_About (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class) is
      About : constant Gtk.Widget.Gtk_Widget :=
        Gtk.Widget.Gtk_Widget (Object.Get_Object ("about"));
   begin
      About.Hide;
   end On_Close_About;

   --  ------------------------------
   --  Callback executed when the "cmd-sizes" action is executed from the "Sizes" action.
   --  ------------------------------
   procedure On_Btn_Sizes (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class) is
      pragma Unreferenced (Object);
   begin
      MAT.Commands.Sizes_Command (Target.all, "");
   end On_Btn_Sizes;

   --  ------------------------------
   --  Callback executed when the "cmd-threads" action is executed from the "Threads" action.
   --  ------------------------------
   procedure On_Btn_Threads (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class) is
      pragma Unreferenced (Object);
   begin
      MAT.Commands.Threads_Command (Target.all, "");
   end On_Btn_Threads;

end MAT.Callbacks;

Implement the On_Btn_Threads procedure and register the callback


-----------------------------------------------------------------------
--  Memory - Memory slot
--  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 MAT.Types;
with MAT.Frames;

with Interfaces;
package MAT.Memory is

   type Allocation is record
      Size   : MAT.Types.Target_Size;
      Frame  : Frames.Frame_Type;
      Time   : MAT.Types.Target_Tick_Ref;
      Thread : MAT.Types.Target_Thread_Ref;
   end record;

   --  Statistics about memory allocation.
   type Memory_Info is record
      Total_Size    : MAT.Types.Target_Size := 0;
      Alloc_Count   : Natural := 0;
      Min_Slot_Size : MAT.Types.Target_Size := 0;
      Max_Slot_Size : MAT.Types.Target_Size := 0;
      Min_Addr      : MAT.Types.Target_Addr := 0;
      Max_Addr      : MAT.Types.Target_Addr := 0;
   end record;

   use type MAT.Types.Target_Addr;
   package Allocation_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Addr,
                                      Element_Type => Allocation);

   subtype Allocation_Map is Allocation_Maps.Map;
   subtype Allocation_Cursor is Allocation_Maps.Cursor;

   --  Define a map of <tt>Memory_Info</tt> keyed by the thread Id.
   --  Such map allows to give the list of threads and a summary of their allocation.
   use type MAT.Types.Target_Thread_Ref;
   package Memory_Info_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Thread_Ref,
                                      Element_Type => Memory_Info);

   subtype Memory_Info_Map is Memory_Info_Maps.Map;
   subtype Memory_Info_Cursor is Memory_Info_Maps.Cursor;

   type Frame_Info is record
      Thread : MAT.Types.Target_Thread_Ref;
      Memory : Memory_Info;
   end record;

   --  Define a map of <tt>Frame_Info</tt> keyed by the backtrace function address
   --  that performed the memory allocation directly or indirectly.
   package Frame_Info_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Addr,
                                      Element_Type => Frame_Info);

private

end MAT.Memory;

-----------------------------------------------------------------------
--  Memory - Memory slot
--  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 MAT.Types;
with MAT.Frames;

with Interfaces;
package MAT.Memory is

   type Allocation is record
      Size   : MAT.Types.Target_Size;
      Frame  : Frames.Frame_Type;
      Time   : MAT.Types.Target_Tick_Ref;
      Thread : MAT.Types.Target_Thread_Ref;
   end record;

   --  Statistics about memory allocation.
   type Memory_Info is record
      Total_Size    : MAT.Types.Target_Size := 0;
      Alloc_Count   : Natural := 0;
      Min_Slot_Size : MAT.Types.Target_Size := 0;
      Max_Slot_Size : MAT.Types.Target_Size := 0;
      Min_Addr      : MAT.Types.Target_Addr := 0;
      Max_Addr      : MAT.Types.Target_Addr := 0;
   end record;

   use type MAT.Types.Target_Addr;
   package Allocation_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Addr,
                                      Element_Type => Allocation);

   subtype Allocation_Map is Allocation_Maps.Map;
   subtype Allocation_Cursor is Allocation_Maps.Cursor;

   --  Define a map of <tt>Memory_Info</tt> keyed by the thread Id.
   --  Such map allows to give the list of threads and a summary of their allocation.
   use type MAT.Types.Target_Thread_Ref;
   package Memory_Info_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Thread_Ref,
                                      Element_Type => Memory_Info);

   subtype Memory_Info_Map is Memory_Info_Maps.Map;
   subtype Memory_Info_Cursor is Memory_Info_Maps.Cursor;

   type Frame_Info is record
      Thread : MAT.Types.Target_Thread_Ref;
      Memory : Memory_Info;
   end record;

   --  Define a map of <tt>Frame_Info</tt> keyed by the backtrace function address
   --  that performed the memory allocation directly or indirectly.
   package Frame_Info_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Addr,
                                      Element_Type => Frame_Info);

   subtype Frame_Info_Map is Frame_Info_Maps.Map;
   subtype Frame_Info_Cursor is Frame_Info_Maps.Cursor;

private

end MAT.Memory;

Define Frame_Info_Map and Frame_Info_Cursor subtypes


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

with AWA.Modules.Beans;
with AWA.Modules.Get;
with AWA.Questions.Beans;
with AWA.Applications;
package body AWA.Questions.Modules is

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

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

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

      --  Setup the resource bundles.
      App.Register ("questionMsg", "questions");

      --  Register here any bean class, servlet, filter.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Questions.Beans.Questions_Bean",
                         Handler => AWA.Questions.Beans.Create_Question_Bean'Access);

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

      --  Add here the creation of manager instances.
      Plugin.Manager := Plugin.Create_Question_Manager;
   end Initialize;

   --  ------------------------------
   --  Get the question manager.
   --  ------------------------------
   function Get_Question_Manager (Plugin : in Question_Module)
                                  return Services.Question_Service_Access is
   begin
      return Plugin.Manager;
   end Get_Question_Manager;

   --  ------------------------------
   --  Create a question manager.  This operation can be overridden to provide another
   --  question service implementation.
   --  ------------------------------
   function Create_Question_Manager (Plugin : in Question_Module)
                                     return Services.Question_Service_Access is
      Result : constant Services.Question_Service_Access := new Services.Question_Service;
   begin
      Result.Initialize (Plugin);
      return Result;
   end Create_Question_Manager;

   --  ------------------------------
   --  Get the questions module.
   --  ------------------------------
   function Get_Question_Module return Question_Module_Access is
      function Get is new AWA.Modules.Get (Question_Module, Question_Module_Access, NAME);
   begin
      return Get;
   end Get_Question_Module;

end AWA.Questions.Modules;

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

with AWA.Modules.Beans;
with AWA.Modules.Get;
with AWA.Questions.Beans;
with AWA.Applications;
package body AWA.Questions.Modules is

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

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

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

      --  Setup the resource bundles.
      App.Register ("questionMsg", "questions");

      --  Register here any bean class, servlet, filter.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Questions.Beans.Questions_Bean",
                         Handler => AWA.Questions.Beans.Create_Question_Bean'Access);

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

      --  Add here the creation of manager instances.
      Plugin.Manager := Plugin.Create_Question_Manager;
   end Initialize;

   --  ------------------------------
   --  Get the question manager.
   --  ------------------------------
   function Get_Question_Manager (Plugin : in Question_Module)
                                  return Services.Question_Service_Access is
   begin
      return Plugin.Manager;
   end Get_Question_Manager;

   --  ------------------------------
   --  Create a question manager.  This operation can be overridden to provide another
   --  question service implementation.
   --  ------------------------------
   function Create_Question_Manager (Plugin : in Question_Module)
                                     return Services.Question_Service_Access is
      Result : constant Services.Question_Service_Access := new Services.Question_Service;
   begin
      Result.Initialize (Plugin);
      return Result;
   end Create_Question_Manager;

   --  ------------------------------
   --  Get the questions module.
   --  ------------------------------
   function Get_Question_Module return Question_Module_Access is
      function Get is new AWA.Modules.Get (Question_Module, Question_Module_Access, NAME);
   begin
      return Get;
   end Get_Question_Module;

   --  ------------------------------
   --  Get the question manager instance associated with the current application.
   --  ------------------------------
   function Get_Question_Manager return Services.Question_Service_Access is
      Module : constant Question_Module_Access := Get_Question_Module;
   begin
      if Module = null then
         Log.Error ("There is no active Question_Module");
         return null;
      else
         return Module.Get_Question_Manager;
      end if;
   end Get_Question_Manager;

end AWA.Questions.Modules;

Implement the new function Get_Question_Manager