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

with Util.Log.Loggers;

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

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

   use Ada.Strings.Unbounded;

   package ASC renames AWA.Services.Contexts;

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

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

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

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

   exception
      when AWA.Permissions.NO_PERMISSION =>
         Bean.Error := True;
         Log.Error ("Saving document is refused by the permission controller");
         raise;

      when E : others =>
         Bean.Error := True;
         Log.Error ("Exception when saving the document", E);
         raise;

   end Save_Part;

   --  ------------------------------
   --  Upload the file.
   --  ------------------------------
   procedure Upload (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Outcome := To_Unbounded_String (if Bean.Error then "failure" else "success");
   end Upload;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

   overriding
   procedure Load (Into    : in out Storage_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      use type ADO.Identifier;

      Ctx     : constant ASC.Service_Context_Access := ASC.Current;
      User    : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Session : ADO.Sessions.Session := ASC.Get_Session (Ctx);
      Query   : ADO.Queries.Context;
   begin
      if Into.Id = ADO.NO_IDENTIFIER then
         Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("not-found");
         return;
      end if;

      --  Get the image information.
      Query.Set_Query (AWA.Storages.Models.Query_Storage_Info);
      Query.Bind_Param (Name => "user_id", Value => User);
      Query.Bind_Param (Name => "file_id", Value => Into.Id);
      Into.Load (Session, Query);

   exception
      when ADO.Objects.NOT_FOUND =>
         Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("not-found");

   end Load;

   --  ------------------------------
   --  Create the Storage_Bean bean instance.
   --  ------------------------------
   function Create_Storage_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                               return Util.Beans.Basic.Readonly_Bean_Access is
      Object    : constant Storage_Bean_Access := new Storage_Bean;
   begin
      Object.Module  := Module;
      Object.Id      := ADO.NO_IDENTIFIER;
      return Object.all'Access;
   end Create_Storage_Bean;

end AWA.Storages.Beans;

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

with Util.Log.Loggers;
with Util.Strings;

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

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

   use Ada.Strings.Unbounded;

   package ASC renames AWA.Services.Contexts;

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

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

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

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

   exception
      when AWA.Permissions.NO_PERMISSION =>
         Bean.Error := True;
         Log.Error ("Saving document is refused by the permission controller");
         raise;

      when E : others =>
         Bean.Error := True;
         Log.Error ("Exception when saving the document", E);
         raise;

   end Save_Part;

   --  ------------------------------
   --  Upload the file.
   --  ------------------------------
   procedure Upload (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Outcome := To_Unbounded_String (if Bean.Error then "failure" else "success");
   end Upload;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

   --  ------------------------------
   --  Returns true if the given mime type can be displayed by a browser.
   --  Mime types: application/pdf, text/*, image/*
   --  ------------------------------
   function Is_Browser_Visible (Mime_Type : in String) return Boolean is
   begin
      if Mime_Type = "application/pdf" then
         return True;
      end if;
      if Util.Strings.Starts_With (Mime_Type, Prefix => "text/") then
         return True;
      end if;
      if Util.Strings.Starts_With (Mime_Type, Prefix => "image/") then
         return True;
      end if;
      return False;
   end Is_Browser_Visible;

   overriding
   function Get_Value (From : in Storage_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "isBrowserVisible" then
         return Util.Beans.Objects.To_Object (Is_Browser_Visible (To_String (From.Mime_Type)));
      else
         return AWA.Storages.Models.Storage_Bean (From).Get_Value (Name);
      end if;
   end Get_Value;

   overriding
   procedure Load (Into    : in out Storage_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      use type ADO.Identifier;

      Ctx     : constant ASC.Service_Context_Access := ASC.Current;
      User    : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Session : ADO.Sessions.Session := ASC.Get_Session (Ctx);
      Query   : ADO.Queries.Context;
   begin
      if Into.Id = ADO.NO_IDENTIFIER then
         Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("not-found");
         return;
      end if;

      --  Get the image information.
      Query.Set_Query (AWA.Storages.Models.Query_Storage_Info);
      Query.Bind_Param (Name => "user_id", Value => User);
      Query.Bind_Param (Name => "file_id", Value => Into.Id);
      Into.Load (Session, Query);

   exception
      when ADO.Objects.NOT_FOUND =>
         Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("not-found");

   end Load;

   --  ------------------------------
   --  Create the Storage_Bean bean instance.
   --  ------------------------------
   function Create_Storage_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                               return Util.Beans.Basic.Readonly_Bean_Access is
      Object    : constant Storage_Bean_Access := new Storage_Bean;
   begin
      Object.Module  := Module;
      Object.Id      := ADO.NO_IDENTIFIER;
      return Object.all'Access;
   end Create_Storage_Bean;

end AWA.Storages.Beans;

Implement Is_Browser_Visible and Get_Value for Storage_Bean


-----------------------------------------------------------------------
--  awa-images-modules -- Image management module
--  Copyright (C) 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 ASF.Applications;

with AWA.Modules;
with AWA.Storages.Models;
with AWA.Storages.Services;
with AWA.Images.Services;

--  == Image Module ==
--  The <tt>Image_Module</tt> type represents the image module.  An instance of the image
--  module must be declared and registered when the application is created and initialized.
--  The image module is associated with the image service which provides and implements
--  the image management operations.
--
--  When the image module is initialized, it registers itself as a listener to the storage
--  module to be notified when a storage file is created, updated or removed.  When a file
--  is added, it looks at the file type and extracts the image information if the storage file
--  is an image.
package AWA.Images.Modules is

   NAME : constant String := "images";

   type Image_Module is new AWA.Modules.Module and AWA.Storages.Services.Listener with private;
   type Image_Module_Access is access all Image_Module'Class;

   --  Initialize the image module.
   overriding
   procedure Initialize (Plugin : in out Image_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

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

   --  Get the image manager.
   function Get_Image_Manager (Plugin : in Image_Module)
                                 return Services.Image_Service_Access;

   --  Create an image manager.  This operation can be overridden to provide another
   --  image service implementation.
   function Create_Image_Manager (Plugin : in Image_Module)
                                    return Services.Image_Service_Access;

   --  The `On_Create` procedure is called by `Notify_Create` to notify the creation of the item.
   overriding
   procedure On_Create (Instance : in Image_Module;
                        Item     : in AWA.Storages.Models.Storage_Ref'Class);

   --  The `On_Update` procedure is called by `Notify_Update` to notify the update of the item.
   overriding
   procedure On_Update (Instance : in Image_Module;
                        Item     : in AWA.Storages.Models.Storage_Ref'Class);

   --  The `On_Delete` procedure is called by `Notify_Delete` to notify the deletion of the item.
   overriding
   procedure On_Delete (Instance : in Image_Module;
                        Item     : in AWA.Storages.Models.Storage_Ref'Class);

   --  Get the image module instance associated with the current application.
   function Get_Image_Module return Image_Module_Access;

   --  Get the image manager instance associated with the current application.
   function Get_Image_Manager return Services.Image_Service_Access;

   --  Returns true if the storage file has an image mime type.
   function Is_Image (File : in AWA.Storages.Models.Storage_Ref'Class) return Boolean;

private

   type Image_Module is new AWA.Modules.Module and AWA.Storages.Services.Listener with record
      Manager         : Services.Image_Service_Access := null;
   end record;

end AWA.Images.Modules;

-----------------------------------------------------------------------
--  awa-images-modules -- Image management module
--  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 ASF.Applications;

with AWA.Modules;
with AWA.Storages.Models;
with AWA.Storages.Services;
with AWA.Images.Services;
with AWA.Images.Models;
with AWA.Jobs.Services;
with AWA.Jobs.Modules;

--  == Image Module ==
--  The <tt>Image_Module</tt> type represents the image module.  An instance of the image
--  module must be declared and registered when the application is created and initialized.
--  The image module is associated with the image service which provides and implements
--  the image management operations.
--
--  When the image module is initialized, it registers itself as a listener to the storage
--  module to be notified when a storage file is created, updated or removed.  When a file
--  is added, it looks at the file type and extracts the image information if the storage file
--  is an image.
package AWA.Images.Modules is

   NAME : constant String := "images";

   --  Job worker procedure to identify an image and generate its thumnbnail.
   procedure Thumbnail_Worker (Job : in out AWA.Jobs.Services.Abstract_Job_Type'Class);

   package Thumbnail_Job_Definition is
     new AWA.Jobs.Services.Work_Definition (Thumbnail_Worker'Access);

   type Image_Module is new AWA.Modules.Module and AWA.Storages.Services.Listener with private;
   type Image_Module_Access is access all Image_Module'Class;

   --  Initialize the image module.
   overriding
   procedure Initialize (Plugin : in out Image_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

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

   --  Get the image manager.
   function Get_Image_Manager (Plugin : in Image_Module)
                                 return Services.Image_Service_Access;

   --  Create an image manager.  This operation can be overridden to provide another
   --  image service implementation.
   function Create_Image_Manager (Plugin : in Image_Module)
                                    return Services.Image_Service_Access;

   --  The `On_Create` procedure is called by `Notify_Create` to notify the creation of the item.
   overriding
   procedure On_Create (Instance : in Image_Module;
                        Item     : in AWA.Storages.Models.Storage_Ref'Class);

   --  The `On_Update` procedure is called by `Notify_Update` to notify the update of the item.
   overriding
   procedure On_Update (Instance : in Image_Module;
                        Item     : in AWA.Storages.Models.Storage_Ref'Class);

   --  The `On_Delete` procedure is called by `Notify_Delete` to notify the deletion of the item.
   overriding
   procedure On_Delete (Instance : in Image_Module;
                        Item     : in AWA.Storages.Models.Storage_Ref'Class);

   --  Create a thumbnail job for the image.
   procedure Make_Thumbnail_Job (Plugin : in Image_Module;
                                 Image  : in AWA.Images.Models.Image_Ref'Class);

   --  Thumbnail job to identify the image dimension and produce a thumbnail.
   procedure Do_Thumbnail_Job (Plugin : in Image_Module;
                               Job    : in out AWA.Jobs.Services.Abstract_Job_Type'Class);

   --  Get the image module instance associated with the current application.
   function Get_Image_Module return Image_Module_Access;

   --  Get the image manager instance associated with the current application.
   function Get_Image_Manager return Services.Image_Service_Access;

   --  Returns true if the storage file has an image mime type.
   function Is_Image (File : in AWA.Storages.Models.Storage_Ref'Class) return Boolean;

private

   type Image_Module is new AWA.Modules.Module and AWA.Storages.Services.Listener with record
      Manager    : Services.Image_Service_Access := null;
      Job_Module : AWA.Jobs.Modules.Job_Module_Access;
   end record;

   --  Create an image instance.
   procedure Create_Image (Plugin  : in Image_Module;
                           File    : in AWA.Storages.Models.Storage_Ref'Class);

end AWA.Images.Modules;

Declare the Thumbnail_Worker procedure and the Thumbnail_Job_Definition job Declare Make_Thumbnail_Job and Do_Thumbnail_Job procedures Declare Create_Image procedure


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

with ASF.Server.Tests;
with ASF.Server.Web;
with ASF.Converters.Dates;

with ASF.Tests;

with AWA.Users.Module;
with AWA.Mail.Module;
with AWA.Blogs.Module;
with AWA.Workspaces.Module;

--  with AWA.Applications;
with AWA.Applications.Factory;
with AWA.Services.Filters;
package body AWA.Tests is

   protected Shutdown is
      procedure Termination (Cause : in Ada.Task_Termination.Cause_Of_Termination;
                             Id    : in Ada.Task_Identification.Task_Id;
                             Ex    : in Ada.Exceptions.Exception_Occurrence);
   end Shutdown;

   Application_Created : Boolean := False;
   Application    : AWA.Applications.Application_Access := null;

   Factory        : AWA.Applications.Factory.Application_Factory;

   Service_Filter : aliased AWA.Services.Filters.Service_Filter;

   Users          : aliased AWA.Users.Module.User_Module;

   Workspaces     : aliased AWA.Workspaces.Module.Workspace_Module;

   Mail           : aliased AWA.Mail.Module.Mail_Module;

   Blogs          : aliased AWA.Blogs.Module.Blog_Module;

   Date_Converter : aliased ASF.Converters.Dates.Date_Converter;

   protected body Shutdown is
      procedure Termination (Cause : in Ada.Task_Termination.Cause_Of_Termination;
                             Id    : in Ada.Task_Identification.Task_Id;
                             Ex    : in Ada.Exceptions.Exception_Occurrence) is
         pragma Unreferenced (Cause, Id, Ex);

         procedure Free is
            new Ada.Unchecked_Deallocation (Object => AWA.Applications.Application'Class,
                                            Name   => AWA.Applications.Application_Access);
      begin
         Free (Application);
      end Termination;
   end Shutdown;

   --  ------------------------------
   --  Setup the service context before executing the test.
   --  ------------------------------
   overriding
   procedure Set_Up (T : in out Test) is
      pragma Unreferenced (T);
   begin
      ASF.Server.Tests.Set_Context (Application.all'Access);
   end Set_Up;

   procedure Initialize (Props : in Util.Properties.Manager) is
   begin
      Initialize (null, Props, True);
   end Initialize;

   --  ------------------------------
   --  Called when the testsuite execution has finished.
   --  ------------------------------
   procedure Finish (Status : in Util.XUnit.Status) is
      pragma Unreferenced (Status);

      procedure Free is
        new Ada.Unchecked_Deallocation (Object => AWA.Applications.Application'Class,
                                        Name   => AWA.Applications.Application_Access);

   begin
      if Application_Created then
         Free (Application);
      end if;
   end Finish;

   --  ------------------------------
   --  Initialize the AWA test framework mockup.
   --  ------------------------------
   procedure Initialize (App         : in AWA.Applications.Application_Access;
                         Props       : in Util.Properties.Manager;
                         Add_Modules : in Boolean) is
      use AWA.Applications;
   begin
      --  Create the application unless it is specified as argument.
      --  Install a shutdown hook to delete the application when the primary task exits.
      --  This allows to stop the event threads if any.
      if App = null then
         Application_Created := True;
         Application := new AWA.Applications.Application;
         Ada.Task_Termination.Set_Specific_Handler (Ada.Task_Identification.Current_Task,
                                                    Shutdown.Termination'Access);
      else
         Application := App;
      end if;

      ASF.Tests.Initialize (Props, Application.all'Access, Factory);
      Application.Add_Filter ("service", Service_Filter'Access);
      Application.Add_Filter_Mapping (Name => "service", Pattern => "*.html");

      if Add_Modules then
         declare
            Users : constant AWA.Users.Module.User_Module_Access := AWA.Tests.Users'Access;
         begin
            Register (App    => Application.all'Access,
                      Name   => AWA.Users.Module.NAME,
                      URI    => "user",
                      Module => Users.all'Access);

            Register (App    => Application.all'Access,
                      Name   => "mail",
                      URI    => "mail",
                      Module => Mail'Access);

            Register (App    => Application.all'Access,
                      Name   => "workspaces",
                      URI    => "workspaces",
                      Module => Workspaces'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Blogs.Module.NAME,
                      URI    => "blogs",
                      Module => Blogs'Access);

            if Props.Exists ("test.server") then
               declare
                  WS : ASF.Server.Web.AWS_Container;
               begin
                  Application.Add_Converter (Name      => "dateConverter",
                                             Converter => Date_Converter'Access);

                  WS.Register_Application ("/asfunit", Application.all'Access);

                  WS.Start;
                  delay 6000.0;
               end;
            end if;
            ASF.Server.Tests.Set_Context (Application.all'Access);
         end;
      end if;
   end Initialize;

   --  ------------------------------
   --  Get the test application.
   --  ------------------------------
   function Get_Application return AWA.Applications.Application_Access is
   begin
      return Application;
   end Get_Application;

   --  ------------------------------
   --  Set the application context to simulate a web request context.
   --  ------------------------------
   procedure Set_Application_Context is
   begin
      ASF.Server.Tests.Set_Context (Application.all'Access);
   end Set_Application_Context;

end AWA.Tests;

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

with ASF.Server.Tests;
with ASF.Server.Web;
with ASF.Converters.Dates;

with ASF.Tests;

with AWA.Users.Module;
with AWA.Mail.Module;
with AWA.Blogs.Module;
with AWA.Workspaces.Module;
with AWA.Storages.Modules;

--  with AWA.Applications;
with AWA.Applications.Factory;
with AWA.Services.Filters;
package body AWA.Tests is

   protected Shutdown is
      procedure Termination (Cause : in Ada.Task_Termination.Cause_Of_Termination;
                             Id    : in Ada.Task_Identification.Task_Id;
                             Ex    : in Ada.Exceptions.Exception_Occurrence);
   end Shutdown;

   Application_Created : Boolean := False;
   Application    : AWA.Applications.Application_Access := null;

   Factory        : AWA.Applications.Factory.Application_Factory;

   Service_Filter : aliased AWA.Services.Filters.Service_Filter;

   Users          : aliased AWA.Users.Module.User_Module;

   Workspaces     : aliased AWA.Workspaces.Module.Workspace_Module;

   Mail           : aliased AWA.Mail.Module.Mail_Module;

   Blogs          : aliased AWA.Blogs.Module.Blog_Module;

   Storages       : aliased AWA.Storages.Modules.Storage_Module;

   Date_Converter : aliased ASF.Converters.Dates.Date_Converter;

   protected body Shutdown is
      procedure Termination (Cause : in Ada.Task_Termination.Cause_Of_Termination;
                             Id    : in Ada.Task_Identification.Task_Id;
                             Ex    : in Ada.Exceptions.Exception_Occurrence) is
         pragma Unreferenced (Cause, Id, Ex);

         procedure Free is
            new Ada.Unchecked_Deallocation (Object => AWA.Applications.Application'Class,
                                            Name   => AWA.Applications.Application_Access);
      begin
         Free (Application);
      end Termination;
   end Shutdown;

   --  ------------------------------
   --  Setup the service context before executing the test.
   --  ------------------------------
   overriding
   procedure Set_Up (T : in out Test) is
      pragma Unreferenced (T);
   begin
      ASF.Server.Tests.Set_Context (Application.all'Access);
   end Set_Up;

   procedure Initialize (Props : in Util.Properties.Manager) is
   begin
      Initialize (null, Props, True);
   end Initialize;

   --  ------------------------------
   --  Called when the testsuite execution has finished.
   --  ------------------------------
   procedure Finish (Status : in Util.XUnit.Status) is
      pragma Unreferenced (Status);

      procedure Free is
        new Ada.Unchecked_Deallocation (Object => AWA.Applications.Application'Class,
                                        Name   => AWA.Applications.Application_Access);

   begin
      if Application_Created then
         Free (Application);
      end if;
   end Finish;

   --  ------------------------------
   --  Initialize the AWA test framework mockup.
   --  ------------------------------
   procedure Initialize (App         : in AWA.Applications.Application_Access;
                         Props       : in Util.Properties.Manager;
                         Add_Modules : in Boolean) is
      use AWA.Applications;
   begin
      --  Create the application unless it is specified as argument.
      --  Install a shutdown hook to delete the application when the primary task exits.
      --  This allows to stop the event threads if any.
      if App = null then
         Application_Created := True;
         Application := new AWA.Applications.Application;
         Ada.Task_Termination.Set_Specific_Handler (Ada.Task_Identification.Current_Task,
                                                    Shutdown.Termination'Access);
      else
         Application := App;
      end if;

      ASF.Tests.Initialize (Props, Application.all'Access, Factory);
      Application.Add_Filter ("service", Service_Filter'Access);
      Application.Add_Filter_Mapping (Name => "service", Pattern => "*.html");

      if Add_Modules then
         declare
            Users : constant AWA.Users.Module.User_Module_Access := AWA.Tests.Users'Access;
         begin
            Register (App    => Application.all'Access,
                      Name   => AWA.Users.Module.NAME,
                      URI    => "user",
                      Module => Users.all'Access);

            Register (App    => Application.all'Access,
                      Name   => "mail",
                      URI    => "mail",
                      Module => Mail'Access);

            Register (App    => Application.all'Access,
                      Name   => "workspaces",
                      URI    => "workspaces",
                      Module => Workspaces'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Storages.Modules.NAME,
                      URI    => "storages",
                      Module => Storages'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Blogs.Module.NAME,
                      URI    => "blogs",
                      Module => Blogs'Access);

            if Props.Exists ("test.server") then
               declare
                  WS : ASF.Server.Web.AWS_Container;
               begin
                  Application.Add_Converter (Name      => "dateConverter",
                                             Converter => Date_Converter'Access);

                  WS.Register_Application ("/asfunit", Application.all'Access);

                  WS.Start;
                  delay 6000.0;
               end;
            end if;
            ASF.Server.Tests.Set_Context (Application.all'Access);
         end;
      end if;
   end Initialize;

   --  ------------------------------
   --  Get the test application.
   --  ------------------------------
   function Get_Application return AWA.Applications.Application_Access is
   begin
      return Application;
   end Get_Application;

   --  ------------------------------
   --  Set the application context to simulate a web request context.
   --  ------------------------------
   procedure Set_Application_Context is
   begin
      ASF.Server.Tests.Set_Context (Application.all'Access);
   end Set_Application_Context;

end AWA.Tests;

Add the storage module in the unit tests


-----------------------------------------------------------------------
--  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.Strings.Unbounded;

with Util.Log.Loggers;

with ADO.Objects;

with ASF.Streams;

with AWA.Storages.Services;
with AWA.Storages.Modules;
package body AWA.Storages.Servlets is

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

   --  ------------------------------
   --  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) is
   begin
      null;
   end Initialize;

   --  ------------------------------
   --  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) is
      Data    : ADO.Blob_Ref;
      Mime    : Ada.Strings.Unbounded.Unbounded_String;
      Name    : Ada.Strings.Unbounded.Unbounded_String;
      Date    : Ada.Calendar.Time;
   begin
      Storage_Servlet'Class (Server).Load (Request, Name, Mime, Date, Data);
      if Data.Is_Null then
         Log.Info ("Storage file {0} not found", Request.Get_Request_URI);
         Response.Send_Error (ASF.Responses.SC_NOT_FOUND);
         return;
      end if;

      --  Send the file.
      Response.Set_Content_Type (Ada.Strings.Unbounded.To_String (Mime));
      if Ada.Strings.Unbounded.Length (Name) > 0 then
         Response.Add_Header ("Content-Disposition",
                              "attachment; filename=" & Ada.Strings.Unbounded.To_String (Name));
      end if;
      declare
         Output : ASF.Streams.Print_Stream := Response.Get_Output_Stream;
      begin
         Output.Write (Data.Value.Data);
      end;

   exception
      when ADO.Objects.NOT_FOUND | Constraint_Error =>
         Log.Info ("Storage file {0} not found", Request.Get_Request_URI);
         Response.Send_Error (ASF.Responses.SC_NOT_FOUND);
         return;
   end Do_Get;

   --  ------------------------------
   --  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) is
      pragma Unreferenced (Server);

      Store   : constant String := Request.Get_Path_Parameter (1);
      Manager : constant Services.Storage_Service_Access := Storages.Modules.Get_Storage_Manager;
      Id      : ADO.Identifier;
   begin
      if Store'Length = 0 then
         Log.Info ("Invalid storage URI: {0}", Store);
         return;
      end if;

      --  Extract the storage identifier from the URI.
      Id := ADO.Identifier'Value (Store);

      Log.Info ("GET storage file {0}", Store);
      Manager.Load (From => Id, Name => Name, Mime => Mime, Date => Date, Into => Data);
   end Load;

end AWA.Storages.Servlets;

-----------------------------------------------------------------------
--  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.Strings.Unbounded;

with Util.Log.Loggers;

with ADO.Objects;

with ASF.Streams;

with AWA.Storages.Services;
with AWA.Storages.Modules;
package body AWA.Storages.Servlets is

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

   --  ------------------------------
   --  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) is
   begin
      null;
   end Initialize;

   --  ------------------------------
   --  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) is
      Data    : ADO.Blob_Ref;
      Mime    : Ada.Strings.Unbounded.Unbounded_String;
      Name    : Ada.Strings.Unbounded.Unbounded_String;
      Date    : Ada.Calendar.Time;
   begin
      Storage_Servlet'Class (Server).Load (Request, Name, Mime, Date, Data);
      if Data.Is_Null then
         Log.Info ("Storage file {0} not found", Request.Get_Request_URI);
         Response.Send_Error (ASF.Responses.SC_NOT_FOUND);
         return;
      end if;

      --  Send the file.
      Response.Set_Content_Type (Ada.Strings.Unbounded.To_String (Mime));
      if Ada.Strings.Unbounded.Length (Name) > 0 then
         Response.Add_Header ("Content-Disposition",
                              "attachment; filename=" & Ada.Strings.Unbounded.To_String (Name));
      end if;
      declare
         Output : ASF.Streams.Print_Stream := Response.Get_Output_Stream;
      begin
         Output.Write (Data.Value.Data);
      end;

   exception
      when ADO.Objects.NOT_FOUND | Constraint_Error =>
         Log.Info ("Storage file {0} not found", Request.Get_Request_URI);
         Response.Send_Error (ASF.Responses.SC_NOT_FOUND);
         return;
   end Do_Get;

   --  ------------------------------
   --  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) is
      pragma Unreferenced (Server);

      Store   : constant String := Request.Get_Path_Parameter (1);
      Manager : constant Services.Storage_Service_Access := Storages.Modules.Get_Storage_Manager;
      Id      : ADO.Identifier;
   begin
      if Store'Length = 0 then
         Log.Info ("Invalid storage URI: {0}", Store);
         return;
      end if;

      --  Extract the storage identifier from the URI.
      Id := ADO.Identifier'Value (Store);

      Log.Info ("GET storage file {0}", Store);
      Manager.Load (From => Id, Name => Name, Mime => Mime, Date => Date, Into => Data);
   end Load;

end AWA.Storages.Servlets;

Use the Servlet.Core package instread of ASF.Servlets


-----------------------------------------------------------------------
--  asf-views-facelets -- Facelets representation and management
--  Copyright (C) 2009, 2010, 2011, 2014, 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 Ada.Exceptions;
with Ada.Directories;
with Ada.Unchecked_Deallocation;
with ASF.Views.Nodes.Reader;
with Input_Sources.File;
with Sax.Readers;
with EL.Contexts.Default;
with Util.Files;
with Util.Log.Loggers;
package body ASF.Views.Facelets is

   use ASF.Views.Nodes;
   use Util.Log;

   --  The logger
   Log : constant Loggers.Logger := Loggers.Create ("ASF.Views.Facelets");

   procedure Free is
      new Ada.Unchecked_Deallocation (Object => ASF.Views.File_Info,
                                      Name   => ASF.Views.File_Info_Access);

   --  Find in the factory for the facelet with the given name.
   procedure Find (Factory : in out Facelet_Factory;
                   Name    : in Unbounded_String;
                   Result  : out Facelet);

   --  Load the facelet node tree by reading the facelet XHTML file.
   procedure Load (Factory : in out Facelet_Factory;
                   Name    : in String;
                   Context : in ASF.Contexts.Facelets.Facelet_Context'Class;
                   Result  : out Facelet);

   --  Update the factory to store the facelet node tree
   procedure Update (Factory : in out Facelet_Factory;
                     Name    : in Unbounded_String;
                     Item    : in Facelet);

   --  ------------------------------
   --  Returns True if the facelet is null/empty.
   --  ------------------------------
   function Is_Null (F : Facelet) return Boolean is
   begin
      return F.Root = null;
   end Is_Null;

   --  ------------------------------
   --  Get the facelet identified by the given name.  If the facelet is already
   --  loaded, the cached value is returned.  The facelet file is searched in
   --  a set of directories configured in the facelet factory.
   --  ------------------------------
   procedure Find_Facelet (Factory : in out Facelet_Factory;
                           Name    : in String;
                           Context : in ASF.Contexts.Facelets.Facelet_Context'Class;
                           Result  : out Facelet) is
      Res   : Facelet;
      Fname : constant Unbounded_String := To_Unbounded_String (Name);
   begin
      Log.Debug ("Find facelet {0}", Name);

      Find (Factory, Fname, Res);
      if Res.Root = null then
         Load (Factory, Name, Context, Res);
         if Res.Root = null then
            Result.Root := null;
            return;
         end if;
         Update (Factory, Fname, Res);
      end if;
      Result.Root := Res.Root;
      Result.File := Res.File;
   end Find_Facelet;

   --  ------------------------------
   --  Create the component tree from the facelet view.
   --  ------------------------------
   procedure Build_View (View    : in Facelet;
                         Context : in out ASF.Contexts.Facelets.Facelet_Context'Class;
                         Root    : in ASF.Components.Base.UIComponent_Access) is
      Old : Unbounded_String;
   begin
      if View.Root /= null then
         Context.Set_Relative_Path (Path     => ASF.Views.Relative_Path (View.File.all),
                                    Previous => Old);
         View.Root.Build_Children (Parent => Root, Context => Context);
         Context.Set_Relative_Path (Path => Old);
      end if;
   end Build_View;

   --  ------------------------------
   --  Initialize the facelet factory.
   --  Set the search directories for facelet files.
   --  Set the ignore white space configuration when reading XHTML files.
   --  Set the ignore empty lines configuration when reading XHTML files.
   --  Set the escape unknown tags configuration when reading XHTML files.
   --  ------------------------------
   procedure Initialize (Factory             : in out Facelet_Factory;
                         Components          : access ASF.Factory.Component_Factory;
                         Paths               : in String;
                         Ignore_White_Spaces : in Boolean;
                         Ignore_Empty_Lines  : in Boolean;
                         Escape_Unknown_Tags : in Boolean) is
   begin
      Log.Info ("Set facelet search directory to: '{0}'", Paths);

      Factory.Factory := Components;
      Factory.Paths := To_Unbounded_String (Paths);
      Factory.Ignore_White_Spaces := Ignore_White_Spaces;
      Factory.Ignore_Empty_Lines  := Ignore_Empty_Lines;
      Factory.Escape_Unknown_Tags := Escape_Unknown_Tags;
   end Initialize;

   --  ------------------------------
   --  Find the facelet file in one of the facelet directories.
   --  Returns the path to be used for reading the facelet file.
   --  ------------------------------
   function Find_Facelet_Path (Factory : Facelet_Factory;
                               Name    : String) return String is
   begin
      return Util.Files.Find_File_Path (Name, To_String (Factory.Paths));
   end Find_Facelet_Path;

   --  ------------------------------
   --  Find in the factory for the facelet with the given name.
   --  ------------------------------
   procedure Find (Factory : in out Facelet_Factory;
                   Name    : in Unbounded_String;
                   Result  : out Facelet) is
      use Ada.Directories;
      use Ada.Calendar;
   begin
      Result.Root := null;
      Result := Factory.Map.Find (Name);
      if Result.Root /= null and then
        Modification_Time (Result.File.Path) > Result.Modify_Time
      then
            Result.Root := null;
            Log.Info ("Ignoring cache because file '{0}' was modified",
                      Result.File.Path);
      end if;
   end Find;

   --  ------------------------------
   --  Load the facelet node tree by reading the facelet XHTML file.
   --  ------------------------------
   procedure Load (Factory : in out Facelet_Factory;
                   Name    : in String;
                   Context : in ASF.Contexts.Facelets.Facelet_Context'Class;
                   Result  : out Facelet) is
      Path   : constant String := Find_Facelet_Path (Factory, Name);
   begin
      if not Ada.Directories.Exists (Path) then
         Log.Warn ("Cannot read '{0}': file does not exist", Path);
         Result.Root := null;
         return;
      end if;

      declare
         RPos   : constant Natural := Path'Length - Name'Length + 1;
         File   : File_Info_Access := Create_File_Info (Path, RPos);
         Reader : ASF.Views.Nodes.Reader.Xhtml_Reader;
         Read   : Input_Sources.File.File_Input;
         Mtime  : Ada.Calendar.Time;
         Ctx    : aliased EL.Contexts.Default.Default_Context;
      begin
         Log.Info ("Loading facelet: '{0}' - {1} - {2}", Path, Name,
                   Natural'Image (File.Relative_Pos));

         Ctx.Set_Function_Mapper (Context.Get_Function_Mapper);
         Mtime  := Ada.Directories.Modification_Time (Path);
         Input_Sources.File.Open (Path, Read);

         --  If True, xmlns:* attributes will be reported in Start_Element
         Reader.Set_Feature (Sax.Readers.Namespace_Prefixes_Feature, False);
         Reader.Set_Feature (Sax.Readers.Validation_Feature, False);

         Reader.Set_Ignore_White_Spaces (Factory.Ignore_White_Spaces);
         Reader.Set_Escape_Unknown_Tags (Factory.Escape_Unknown_Tags);
         Reader.Set_Ignore_Empty_Lines (Factory.Ignore_Empty_Lines);
         begin
            Reader.Parse (File, Read, Factory.Factory, Ctx'Unchecked_Access);

         exception
            when ASF.Views.Nodes.Reader.Parsing_Error =>
               Free (File);

            when E : others =>
               Free (File);
               Log.Error ("Unexpected exception while reading: '{0}': {1}: {2}", Path,
                          Ada.Exceptions.Exception_Name (E), Ada.Exceptions.Exception_Message (E));
         end;
         Result.Root := Reader.Get_Root;
         Result.File := File;
         if File = null then
            if Result.Root /= null then
               Result.Root.Delete;
            end if;
            Result.Root := null;
         else
            Result.Modify_Time := Mtime;
         end if;
         Input_Sources.File.Close (Read);
      end;
   end Load;

   --  ------------------------------
   --  Update the factory to store the facelet node tree
   --  ------------------------------
   procedure Update (Factory : in out Facelet_Factory;
                     Name    : in Unbounded_String;
                     Item    : in Facelet) is
   begin
      Factory.Map.Insert (Name, Item);
   end Update;

   --  ------------------------------
   --  Clear the facelet cache
   --  ------------------------------
   procedure Clear_Cache (Factory : in out Facelet_Factory) is
   begin
      Log.Info ("Clearing facelet cache");

      Factory.Map.Clear;
   end Clear_Cache;

   protected body Facelet_Cache is

      --  ------------------------------
      --  Find the facelet entry associated with the given name.
      --  ------------------------------
      function Find (Name : in Unbounded_String) return Facelet is
         Pos    : constant Facelet_Maps.Cursor := Map.Find (Name);
      begin
         if Facelet_Maps.Has_Element (Pos) then
            return Element (Pos);
         else
            return Empty;
         end if;
      end Find;

      --  ------------------------------
      --  Insert or replace the facelet entry associated with the given name.
      --  ------------------------------
      procedure Insert (Name : in Unbounded_String;
                        Item : in Facelet) is
      begin
         Map.Include (Name, Item);
      end Insert;

      --  ------------------------------
      --  Clear the cache.
      --  ------------------------------
      procedure Clear is
      begin
         loop
            declare
               Pos  : Facelet_Maps.Cursor := Map.First;
               Node : Facelet;
            begin
               exit when not Has_Element (Pos);
               Node := Element (Pos);
               Map.Delete (Pos);
               Free (Node.File);
               ASF.Views.Nodes.Destroy (Node.Root);
            end;
         end loop;
      end Clear;

   end Facelet_Cache;

   --  ------------------------------
   --  Free the storage held by the factory cache.
   --  ------------------------------
   overriding
   procedure Finalize (Factory : in out Facelet_Factory) is
   begin
      Factory.Clear_Cache;
   end Finalize;

end ASF.Views.Facelets;

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

with Ada.Exceptions;
with Ada.Directories;
with Ada.Unchecked_Deallocation;
with ASF.Views.Nodes.Reader;
with Input_Sources.File;
with Sax.Readers;
with EL.Contexts.Default;
with Util.Files;
with Util.Log.Loggers;
package body ASF.Views.Facelets is

   use ASF.Views.Nodes;
   use Util.Log;

   --  The logger
   Log : constant Loggers.Logger := Loggers.Create ("ASF.Views.Facelets");

   procedure Free is
      new Ada.Unchecked_Deallocation (Object => ASF.Views.File_Info,
                                      Name   => ASF.Views.File_Info_Access);

   --  Find in the factory for the facelet with the given name.
   procedure Find (Factory : in out Facelet_Factory;
                   Name    : in Unbounded_String;
                   Result  : out Facelet);

   --  Load the facelet node tree by reading the facelet XHTML file.
   procedure Load (Factory : in out Facelet_Factory;
                   Name    : in String;
                   Context : in ASF.Contexts.Facelets.Facelet_Context'Class;
                   Result  : out Facelet);

   --  Update the factory to store the facelet node tree
   procedure Update (Factory : in out Facelet_Factory;
                     Name    : in Unbounded_String;
                     Item    : in Facelet);

   --  ------------------------------
   --  Returns True if the facelet is null/empty.
   --  ------------------------------
   function Is_Null (F : Facelet) return Boolean is
   begin
      return F.Root = null;
   end Is_Null;

   --  ------------------------------
   --  Get the facelet identified by the given name.  If the facelet is already
   --  loaded, the cached value is returned.  The facelet file is searched in
   --  a set of directories configured in the facelet factory.
   --  ------------------------------
   procedure Find_Facelet (Factory : in out Facelet_Factory;
                           Name    : in String;
                           Context : in ASF.Contexts.Facelets.Facelet_Context'Class;
                           Result  : out Facelet) is
      Res   : Facelet;
      Fname : constant Unbounded_String := To_Unbounded_String (Name);
   begin
      Log.Debug ("Find facelet {0}", Name);

      Find (Factory, Fname, Res);
      if Res.Root = null then
         Load (Factory, Name, Context, Res);
         if Res.Root = null then
            Result.Root := null;
            return;
         end if;
         Update (Factory, Fname, Res);
      end if;
      Result.Root := Res.Root;
      Result.File := Res.File;
   end Find_Facelet;

   --  ------------------------------
   --  Create the component tree from the facelet view.
   --  ------------------------------
   procedure Build_View (View    : in Facelet;
                         Context : in out ASF.Contexts.Facelets.Facelet_Context'Class;
                         Root    : in ASF.Components.Base.UIComponent_Access) is
      Old : Unbounded_String;
   begin
      if View.Root /= null then
         Context.Set_Relative_Path (Path     => ASF.Views.Relative_Path (View.File.all),
                                    Previous => Old);
         View.Root.Build_Children (Parent => Root, Context => Context);
         Context.Set_Relative_Path (Path => Old);
      end if;
   end Build_View;

   --  ------------------------------
   --  Initialize the facelet factory.
   --  Set the search directories for facelet files.
   --  Set the ignore white space configuration when reading XHTML files.
   --  Set the ignore empty lines configuration when reading XHTML files.
   --  Set the escape unknown tags configuration when reading XHTML files.
   --  ------------------------------
   procedure Initialize (Factory             : in out Facelet_Factory;
                         Components          : access ASF.Factory.Component_Factory;
                         Paths               : in String;
                         Ignore_White_Spaces : in Boolean;
                         Ignore_Empty_Lines  : in Boolean;
                         Escape_Unknown_Tags : in Boolean) is
   begin
      Log.Info ("Set facelet search directory to: '{0}'", Paths);

      Factory.Factory := Components;
      Factory.Paths := To_Unbounded_String (Paths);
      Factory.Ignore_White_Spaces := Ignore_White_Spaces;
      Factory.Ignore_Empty_Lines  := Ignore_Empty_Lines;
      Factory.Escape_Unknown_Tags := Escape_Unknown_Tags;
   end Initialize;

   --  ------------------------------
   --  Find the facelet file in one of the facelet directories.
   --  Returns the path to be used for reading the facelet file.
   --  ------------------------------
   function Find_Facelet_Path (Factory : Facelet_Factory;
                               Name    : String) return String is
   begin
      return Util.Files.Find_File_Path (Name, To_String (Factory.Paths));
   end Find_Facelet_Path;

   --  ------------------------------
   --  Find in the factory for the facelet with the given name.
   --  ------------------------------
   procedure Find (Factory : in out Facelet_Factory;
                   Name    : in Unbounded_String;
                   Result  : out Facelet) is
      use Ada.Directories;
      use Ada.Calendar;
   begin
      Result.Root := null;
      Result := Factory.Map.Find (Name);
      if Result.Root /= null and then
        Modification_Time (Result.File.Path) > Result.Modify_Time
      then
            Result.Root := null;
            Log.Info ("Ignoring cache because file '{0}' was modified",
                      Result.File.Path);
      end if;
   end Find;

   --  ------------------------------
   --  Load the facelet node tree by reading the facelet XHTML file.
   --  ------------------------------
   procedure Load (Factory : in out Facelet_Factory;
                   Name    : in String;
                   Context : in ASF.Contexts.Facelets.Facelet_Context'Class;
                   Result  : out Facelet) is
      Path   : constant String := Find_Facelet_Path (Factory, Name);
   begin
      if Path = "" or else not Ada.Directories.Exists (Path) then
         Log.Warn ("Cannot read '{0}': file does not exist", Path);
         Result.Root := null;
         return;
      end if;

      declare
         RPos   : constant Integer := Path'Last - Name'Length + 1;
         File   : File_Info_Access;
         Reader : ASF.Views.Nodes.Reader.Xhtml_Reader;
         Read   : Input_Sources.File.File_Input;
         Mtime  : Ada.Calendar.Time;
         Ctx    : aliased EL.Contexts.Default.Default_Context;
      begin
         if Rpos <= Path'First then
            File := Create_File_Info (Path, Path'First);
         else
            File := Create_File_Info (Path, RPos);
         end if;
         Log.Info ("Loading facelet: '{0}' - {1} - {2}", Path, Name,
                   Natural'Image (File.Relative_Pos));

         Ctx.Set_Function_Mapper (Context.Get_Function_Mapper);
         Mtime  := Ada.Directories.Modification_Time (Path);
         Input_Sources.File.Open (Path, Read);

         --  If True, xmlns:* attributes will be reported in Start_Element
         Reader.Set_Feature (Sax.Readers.Namespace_Prefixes_Feature, False);
         Reader.Set_Feature (Sax.Readers.Validation_Feature, False);

         Reader.Set_Ignore_White_Spaces (Factory.Ignore_White_Spaces);
         Reader.Set_Escape_Unknown_Tags (Factory.Escape_Unknown_Tags);
         Reader.Set_Ignore_Empty_Lines (Factory.Ignore_Empty_Lines);
         begin
            Reader.Parse (File, Read, Factory.Factory, Ctx'Unchecked_Access);

         exception
            when ASF.Views.Nodes.Reader.Parsing_Error =>
               Free (File);

            when E : others =>
               Free (File);
               Log.Error ("Unexpected exception while reading: '{0}': {1}: {2}", Path,
                          Ada.Exceptions.Exception_Name (E), Ada.Exceptions.Exception_Message (E));
         end;
         Result.Root := Reader.Get_Root;
         Result.File := File;
         if File = null then
            if Result.Root /= null then
               Result.Root.Delete;
            end if;
            Result.Root := null;
         else
            Result.Modify_Time := Mtime;
         end if;
         Input_Sources.File.Close (Read);
      end;
   end Load;

   --  ------------------------------
   --  Update the factory to store the facelet node tree
   --  ------------------------------
   procedure Update (Factory : in out Facelet_Factory;
                     Name    : in Unbounded_String;
                     Item    : in Facelet) is
   begin
      Factory.Map.Insert (Name, Item);
   end Update;

   --  ------------------------------
   --  Clear the facelet cache
   --  ------------------------------
   procedure Clear_Cache (Factory : in out Facelet_Factory) is
   begin
      Log.Info ("Clearing facelet cache");

      Factory.Map.Clear;
   end Clear_Cache;

   protected body Facelet_Cache is

      --  ------------------------------
      --  Find the facelet entry associated with the given name.
      --  ------------------------------
      function Find (Name : in Unbounded_String) return Facelet is
         Pos    : constant Facelet_Maps.Cursor := Map.Find (Name);
      begin
         if Facelet_Maps.Has_Element (Pos) then
            return Element (Pos);
         else
            return Empty;
         end if;
      end Find;

      --  ------------------------------
      --  Insert or replace the facelet entry associated with the given name.
      --  ------------------------------
      procedure Insert (Name : in Unbounded_String;
                        Item : in Facelet) is
      begin
         Map.Include (Name, Item);
      end Insert;

      --  ------------------------------
      --  Clear the cache.
      --  ------------------------------
      procedure Clear is
      begin
         loop
            declare
               Pos  : Facelet_Maps.Cursor := Map.First;
               Node : Facelet;
            begin
               exit when not Has_Element (Pos);
               Node := Element (Pos);
               Map.Delete (Pos);
               Free (Node.File);
               ASF.Views.Nodes.Destroy (Node.Root);
            end;
         end loop;
      end Clear;

   end Facelet_Cache;

   --  ------------------------------
   --  Free the storage held by the factory cache.
   --  ------------------------------
   overriding
   procedure Finalize (Factory : in out Facelet_Factory) is
   begin
      Factory.Clear_Cache;
   end Finalize;

end ASF.Views.Facelets;

Fix path and relative path when loading a facelet file


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

with Util.Tests;

package Util.Strings.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   procedure Test_Escape_Javascript (T : in out Test);

   procedure Test_Escape_Xml (T : in out Test);
   procedure Test_Escape_Java (T : in out Test);

   procedure Test_Unescape_Xml (T : in out Test);

   procedure Test_Capitalize (T : in out Test);

   procedure Test_To_Upper_Case (T : in out Test);

   procedure Test_To_Lower_Case (T : in out Test);
   procedure Test_To_Hex (T : in out Test);
   procedure Test_Measure_Copy (T : in out Test);
   procedure Test_Index (T : in out Test);
   procedure Test_Rindex (T : in out Test);
   procedure Test_Starts_With (T : in out Test);
   procedure Test_Ends_With (T : in out Test);

   --  Do some benchmark on String -> X hash mapped.
   procedure Test_Measure_Hash (T : in out Test);

   --  Test String_Ref creation
   procedure Test_String_Ref (T : in out Test);

   --  Benchmark comparison between the use of Iterate vs Query_Element.
   procedure Test_Perf_Vector (T : in out Test);

   --  Test perfect hash (samples/gperfhash)
   procedure Test_Perfect_Hash (T : in out Test);

   --  Test the token iteration.
   procedure Test_Iterate_Token (T : in out Test);

   --  Test formatting strings.
   procedure Test_Format (T : in out Test);

end Util.Strings.Tests;

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

with Util.Tests;

package Util.Strings.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   procedure Test_Escape_Javascript (T : in out Test);

   procedure Test_Escape_Xml (T : in out Test);
   procedure Test_Escape_Java (T : in out Test);

   procedure Test_Unescape_Xml (T : in out Test);

   procedure Test_Capitalize (T : in out Test);

   procedure Test_To_Upper_Case (T : in out Test);

   procedure Test_To_Lower_Case (T : in out Test);
   procedure Test_To_Hex (T : in out Test);
   procedure Test_Measure_Copy (T : in out Test);
   procedure Test_Index (T : in out Test);
   procedure Test_Rindex (T : in out Test);
   procedure Test_Starts_With (T : in out Test);
   procedure Test_Ends_With (T : in out Test);
   procedure Test_Replace (T : in out Test);

   --  Do some benchmark on String -> X hash mapped.
   procedure Test_Measure_Hash (T : in out Test);

   --  Test String_Ref creation
   procedure Test_String_Ref (T : in out Test);

   --  Benchmark comparison between the use of Iterate vs Query_Element.
   procedure Test_Perf_Vector (T : in out Test);

   --  Test perfect hash (samples/gperfhash)
   procedure Test_Perfect_Hash (T : in out Test);

   --  Test the token iteration.
   procedure Test_Iterate_Token (T : in out Test);

   --  Test formatting strings.
   procedure Test_Format (T : in out Test);

end Util.Strings.Tests;

Add Test_Replace procedure

Add Test_Replace procedure