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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

end AWA.Storages.Beans;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

end AWA.Storages.Beans;

Update the upload_bean to setup the storage id only when the value is not empty


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

with AWA.Storages.Models;
with AWA.Storages.Modules;

with ASF.Parts;

with ADO;

with Util.Beans.Objects;
with Util.Beans.Basic;

--  == Storage Beans ==
--  The <tt>Upload_Bean</tt> type is used to upload a file in the storage space.
--  It expect that the folder already exists.
--
--  The <tt>Folder_Bean</tt> type controls the creation of new folders.
--
--  The <tt>Storage_List_Bean</tt> type gives the files associated with a given folder.
package AWA.Storages.Beans is

   FOLDER_ID_PARAMETER : constant String := "folderId";

   --  ------------------------------
   --  Upload Bean
   --  ------------------------------
   --  The Upload_Bean allows to upload a file in the storage space.
   type Upload_Bean is new AWA.Storages.Models.Upload_Bean with record
      Module    : AWA.Storages.Modules.Storage_Module_Access := null;
      Folder_Id : ADO.Identifier;
      Error     : Boolean := False;
   end record;
   type Upload_Bean_Access is access all Upload_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Upload_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

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

   --  Save the uploaded file in the storage service.
   --  @method
   procedure Save_Part (Bean : in out Upload_Bean;
                        Part : in ASF.Parts.Part'Class);

   --  Upload the file.
   overriding
   procedure Upload (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the file.
   overriding
   procedure Delete (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Publish the file.
   overriding
   procedure Publish (Bean    : in out Upload_Bean;
                      Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

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

   --  ------------------------------
   --  Folder Bean
   --  ------------------------------
   --  The Folder_Bean allows to create or update the folder name.
   type Folder_Bean is new AWA.Storages.Models.Storage_Folder_Ref
     and Util.Beans.Basic.Bean with record
      Module  : AWA.Storages.Modules.Storage_Module_Access := null;
   end record;
   type Folder_Bean_Access is access all Folder_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Folder_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

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

   --  Create or save the folder.
   procedure Save (Bean    : in out Folder_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   type Init_Flag is (INIT_FOLDER, INIT_FOLDER_LIST, INIT_FILE_LIST);
   type Init_Map is array (Init_Flag) of Boolean;

   --  ------------------------------
   --  Storage List Bean
   --  ------------------------------
   --  This bean represents a list of storage files for a given folder.
   type Storage_List_Bean is new AWA.Storages.Models.Storage_List_Bean with record
      Module           : AWA.Storages.Modules.Storage_Module_Access := null;

      --  Current folder.
      Folder           : aliased Folder_Bean;
      Folder_Bean      : Folder_Bean_Access;

      --  List of folders.
      Folder_List      : aliased AWA.Storages.Models.Folder_Info_List_Bean;
      Folder_List_Bean : AWA.Storages.Models.Folder_Info_List_Bean_Access;

      --  List of files.
      Files_List       : aliased AWA.Storages.Models.Storage_Info_List_Bean;
      Files_List_Bean  : AWA.Storages.Models.Storage_Info_List_Bean_Access;

      Init_Flags       : aliased Init_Map := (others => False);
      Flags            : access Init_Map;
   end record;
   type Storage_List_Bean_Access is access all Storage_List_Bean'Class;

   --  Load the folder instance.
   procedure Load_Folder (Storage : in Storage_List_Bean);

   --  Load the list of folders.
   procedure Load_Folders (Storage : in Storage_List_Bean);

   --  Load the list of files associated with the current folder.
   procedure Load_Files (Storage : in Storage_List_Bean);

   overriding
   function Get_Value (List : in Storage_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

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

   --  Load the files and folder information.
   overriding
   procedure Load (List    : in out Storage_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

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

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

end AWA.Storages.Beans;

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

with AWA.Storages.Models;
with AWA.Storages.Modules;

with ASF.Parts;

with ADO;

with Util.Beans.Objects;
with Util.Beans.Basic;

--  == Storage Beans ==
--  The <tt>Upload_Bean</tt> type is used to upload a file in the storage space.
--  It expect that the folder already exists.
--
--  The <tt>Folder_Bean</tt> type controls the creation of new folders.
--
--  The <tt>Storage_List_Bean</tt> type gives the files associated with a given folder.
package AWA.Storages.Beans is

   FOLDER_ID_PARAMETER : constant String := "folderId";

   --  ------------------------------
   --  Upload Bean
   --  ------------------------------
   --  The Upload_Bean allows to upload a file in the storage space.
   type Upload_Bean is new AWA.Storages.Models.Upload_Bean with record
      Module    : AWA.Storages.Modules.Storage_Module_Access := null;
      Folder_Id : ADO.Identifier;
      Error     : Boolean := False;
   end record;
   type Upload_Bean_Access is access all Upload_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Upload_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

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

   --  Save the uploaded file in the storage service.
   --  @method
   procedure Save_Part (Bean : in out Upload_Bean;
                        Part : in ASF.Parts.Part'Class);

   --  Upload the file.
   overriding
   procedure Upload (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the file.
   overriding
   procedure Delete (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Publish the file.
   overriding
   procedure Publish (Bean    : in out Upload_Bean;
                      Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

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

   --  ------------------------------
   --  Folder Bean
   --  ------------------------------
   --  The Folder_Bean allows to create or update the folder name.
   type Folder_Bean is new AWA.Storages.Models.Storage_Folder_Ref
     and Util.Beans.Basic.Bean with record
      Module  : AWA.Storages.Modules.Storage_Module_Access := null;
   end record;
   type Folder_Bean_Access is access all Folder_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Folder_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

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

   --  Create or save the folder.
   procedure Save (Bean    : in out Folder_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   type Init_Flag is (INIT_FOLDER, INIT_FOLDER_LIST, INIT_FILE_LIST);
   type Init_Map is array (Init_Flag) of Boolean;

   --  ------------------------------
   --  Storage List Bean
   --  ------------------------------
   --  This bean represents a list of storage files for a given folder.
   type Storage_List_Bean is new AWA.Storages.Models.Storage_List_Bean with record
      Module           : AWA.Storages.Modules.Storage_Module_Access := null;

      --  Current folder.
      Folder           : aliased Folder_Bean;
      Folder_Bean      : Folder_Bean_Access;

      --  List of folders.
      Folder_List      : aliased AWA.Storages.Models.Folder_Info_List_Bean;
      Folder_List_Bean : AWA.Storages.Models.Folder_Info_List_Bean_Access;

      --  List of files.
      Files_List       : aliased AWA.Storages.Models.Storage_Info_List_Bean;
      Files_List_Bean  : AWA.Storages.Models.Storage_Info_List_Bean_Access;

      Init_Flags       : aliased Init_Map := (others => False);
      Flags            : access Init_Map;
   end record;
   type Storage_List_Bean_Access is access all Storage_List_Bean'Class;

   --  Load the folder instance.
   procedure Load_Folder (Storage : in Storage_List_Bean);

   --  Load the list of folders.
   procedure Load_Folders (Storage : in Storage_List_Bean);

   --  Load the list of files associated with the current folder.
   procedure Load_Files (Storage : in Storage_List_Bean);

   overriding
   function Get_Value (List : in Storage_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

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

   --  Load the files and folder information.
   overriding
   procedure Load (List    : in out Storage_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

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

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

   --  ------------------------------
   --  Storage Bean
   --  ------------------------------
   --  Information about a document (excluding the document data itself).
   type Storage_Bean is new AWA.Storages.Models.Storage_Bean with record
      Module : AWA.Storages.Modules.Storage_Module_Access;
   end record;
   type Storage_Bean_Access is access all Storage_Bean'Class;

   overriding
   procedure Load (Into    : in out Storage_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

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

end AWA.Storages.Beans;

Declare the Storage_Bean type with Load and Create_Storage_Bean operations


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

with Util.Test_Caller;
with Util.Strings;

with Servlet.Streams;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Tests;
with AWA.Tests.Helpers.Users;

package body AWA.Wikis.Tests is

   use Ada.Strings.Unbounded;
   use AWA.Tests;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Wikis.Beans.Load_List (Anonymous)",
                       Test_Anonymous_Access'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Beans.Save",
                       Test_Create_Wiki'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Beans.Load (missing)",
                       Test_Missing_Page'Access);
   end Add_Tests;

   --  ------------------------------
   --  Get some access on the wiki as anonymous users.
   --  ------------------------------
   procedure Verify_Anonymous (T     : in out Test;
                               Page  : in String;
                               Title : in String) is
      function Get_Link (Title : in String) return String;

      Wiki      : constant String := To_String (T.Wiki_Ident);
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;

      function Get_Link (Title : in String) return String is
         Stream  : Servlet.Streams.Print_Stream := Reply.Get_Output_Stream;
         Content : Ada.Strings.Unbounded.Unbounded_String;
      begin
         Reply.Read_Content (Content);
         Stream.Write (Content);
         return AWA.Tests.Helpers.Extract_Link (To_String (Content), Title);
      end Get_Link;

   begin
      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/recent",
                        "wiki-list-recent.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list recent page is invalid");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/tags/" & Wiki,
                        "wiki-list-tagged.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki tag page is invalid");

      if Page'Length > 0 then
         ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Wiki & "/" & Page,
                           "wiki-page-" & Page & ".html");
         ASF.Tests.Assert_Contains (T, "The wiki page content", Reply,
                                    "Wiki page " & Page & " is invalid");
         declare
            Info    : constant String := Get_Link ("Info");
            History : constant String := Get_Link ("History");
         begin
            Util.Tests.Assert_Matches (T, "/asfunit/wikis/info/[0-9]+/[0-9]+$", Info,
                                    "Invalid wiki info link in the response");
            Util.Tests.Assert_Matches (T, "/asfunit/wikis/history/[0-9]+/[0-9]+$", History,
                                       "Invalid wiki history link in the response");

            --  Get the information page.
            ASF.Tests.Do_Get (Request, Reply, Info (Info'First + 8 .. Info'Last),
                              "wiki-info-" & Page & ".html");
            ASF.Tests.Assert_Contains (T, "wiki-word-list", Reply,
                                       "Wiki info page " & Page & " is invalid");

            --  Get the history page.
            ASF.Tests.Do_Get (Request, Reply, History (History'First + 8 .. History'Last),
                              "wiki-history-" & Page & ".html");
            ASF.Tests.Assert_Contains (T, "wiki-page-version", Reply,
                                       "Wiki history page " & Page & " is invalid");

         end;
      end if;
   end Verify_Anonymous;

   --  ------------------------------
   --  Verify that the wiki lists contain the given page.
   --  ------------------------------
   procedure Verify_List_Contains (T    : in out Test;
                                   Page : in String) is
      Wiki      : constant String := To_String (T.Wiki_Ident);
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/recent",
                        "wiki-list-recent.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list recent page is invalid");
      ASF.Tests.Assert_Contains (T, "/wikis/view/" & To_String (T.Wiki_Ident)
                                 & "/" & Page, Reply,
                                 "Wiki list recent page does not reference the page");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/popular",
                        "wiki-list-popular.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list popular page is invalid");
      ASF.Tests.Assert_Contains (T, "/wikis/view/" & To_String (T.Wiki_Ident)
                                 & "/" & Page, Reply,
                                 "Wiki list popular page does not reference the page");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/name",
                        "wiki-list-name.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list name page is invalid");
      ASF.Tests.Assert_Contains (T, "/wikis/view/" & To_String (T.Wiki_Ident)
                                 & "/" & Page, Reply,
                                 "Wiki list name page does not reference the page");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/name/grid",
                        "wiki-list-name-grid.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list name/grid page is invalid");
      ASF.Tests.Assert_Contains (T, "/wikis/view/" & To_String (T.Wiki_Ident)
                                 & "/" & Page, Reply,
                                 "Wiki list name/grid page does not reference the page");

   end Verify_List_Contains;

   --  ------------------------------
   --  Test access to the blog as anonymous user.
   --  ------------------------------
   procedure Test_Anonymous_Access (T : in out Test) is
   begin
      T.Verify_Anonymous ("", "");
   end Test_Anonymous_Access;

   --  ------------------------------
   --  Test creation of blog by simulating web requests.
   --  ------------------------------
   procedure Test_Create_Wiki (T : in out Test) is
      procedure Create_Page (Name : in String; Title : in String);

      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Uuid      : constant String := Util.Tests.Get_Uuid;

      procedure Create_Page (Name : in String; Title : in String) is
      begin
         Request.Set_Parameter ("page-wiki-id", To_String (T.Wiki_Ident));
         Request.Set_Parameter ("post", "1");
         Request.Set_Parameter ("page-title", Title);
         Request.Set_Parameter ("text", "# Main title" & ASCII.LF
                                & "* The wiki page content." & ASCII.LF
                                & "* Second item." & ASCII.LF);
         Request.Set_Parameter ("name", Name);
         Request.Set_Parameter ("comment", "Created wiki page " & Name);
         Request.Set_Parameter ("save", "1");
         Request.Set_Parameter ("page-is-public", "1");
         Request.Set_Parameter ("wiki-format", "FORMAT_MARKDOWN");
         ASF.Tests.Do_Post (Request, Reply, "/wikis/create.html", "create-wiki.html");

         T.Page_Ident := Helpers.Extract_Redirect (Reply, "/asfunit/wikis/view/"
                                                   & To_String (T.Wiki_Ident) & "/");

         Util.Tests.Assert_Equals (T, Name, To_String (T.Page_Ident),
                                   "Invalid redirect after wiki page creation");

         --  Remove the 'wikiPage' bean from the request so that we get a new instance
         --  for the next call.
         Request.Remove_Attribute ("wikiPage");
      end Create_Page;

   begin
      AWA.Tests.Helpers.Users.Login ("test-wiki@test.com", Request);
      Request.Set_Parameter ("title", "The Wiki Space Title");
      Request.Set_Parameter ("post", "1");
      Request.Set_Parameter ("create", "1");
      ASF.Tests.Do_Post (Request, Reply, "/wikis/setup.html", "setup-wiki.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY,
                "Invalid response after wiki space creation");
      declare
         Ident : constant String
           := Helpers.Extract_Redirect (Reply, "/asfunit/wikis/list/");
         Pos   : constant Natural
           := Util.Strings.Index (Ident, '/');
      begin
         Util.Tests.Assert_Matches (T, "^[0-9]+/recent/grid$", Ident,
                                    "Invalid wiki space identifier in the response");
         T.Wiki_Ident := To_Unbounded_String (Ident (Ident'First .. Pos - 1));
      end;
      Create_Page ("WikiPageTestName", "Wiki page title1");
      T.Verify_List_Contains (To_String (T.Page_Ident));

      Create_Page ("WikiSecondPageName", "Wiki page title2");
      T.Verify_List_Contains (To_String (T.Page_Ident));

      Create_Page ("WikiThirdPageName", "Wiki page title3");

      T.Verify_Anonymous ("WikiPageTestName", "Wiki page title1");
      T.Verify_Anonymous ("WikiSecondPageName", "Wiki page title2");
      T.Verify_Anonymous ("WikiThirdPageName", "Wiki page title3");

   end Test_Create_Wiki;

   --  ------------------------------
   --  Test getting a wiki page which does not exist.
   --  ------------------------------
   procedure Test_Missing_Page (T : in out Test) is
      Wiki      : constant String := To_String (T.Wiki_Ident);
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Wiki & "/MissingPage",
                        "wiki-page-missing.html");
      ASF.Tests.Assert_Matches (T, ".title.Wiki page does not exist./title.", Reply,
                                "Wiki page 'MissingPage' is invalid",
                                ASF.Responses.SC_NOT_FOUND);
      ASF.Tests.Assert_Matches (T, ".h2.MissingPage./h2.", Reply,
                                "Wiki page 'MissingPage' header is invalid",
                                ASF.Responses.SC_NOT_FOUND);
   end Test_Missing_Page;

end AWA.Wikis.Tests;

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

with Util.Test_Caller;
with Util.Strings;

with Servlet.Streams;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Tests;
with AWA.Tests.Helpers.Users;

package body AWA.Wikis.Tests is

   use Ada.Strings.Unbounded;
   use AWA.Tests;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Wikis.Beans.Load_List (Anonymous)",
                       Test_Anonymous_Access'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Beans.Save",
                       Test_Create_Wiki'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Beans.Load (missing)",
                       Test_Missing_Page'Access);
   end Add_Tests;

   --  ------------------------------
   --  Get some access on the wiki as anonymous users.
   --  ------------------------------
   procedure Verify_Anonymous (T     : in out Test;
                               Page  : in String;
                               Title : in String) is
      function Get_Link (Title : in String) return String;

      Wiki      : constant String := To_String (T.Wiki_Ident);
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;

      function Get_Link (Title : in String) return String is
         Stream  : Servlet.Streams.Print_Stream := Reply.Get_Output_Stream;
         Content : Ada.Strings.Unbounded.Unbounded_String;
      begin
         Reply.Read_Content (Content);
         Stream.Write (Content);
         return AWA.Tests.Helpers.Extract_Link (To_String (Content), Title);
      end Get_Link;

   begin
      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/recent",
                        "wiki-list-recent.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list recent page is invalid");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/tags/" & Wiki,
                        "wiki-list-tagged.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki tag page is invalid");

      if Page'Length > 0 then
         ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Wiki & "/" & Page,
                           "wiki-page-" & Page & ".html");
         ASF.Tests.Assert_Contains (T, "The wiki page content", Reply,
                                    "Wiki page " & Page & " is invalid");
         declare
            Info    : constant String := Get_Link ("Info");
            History : constant String := Get_Link ("History");
         begin
            Util.Tests.Assert_Matches (T, "/asfunit/wikis/info/[0-9]+/[0-9]+$", Info,
                                    "Invalid wiki info link in the response");
            Util.Tests.Assert_Matches (T, "/asfunit/wikis/history/[0-9]+/[0-9]+$", History,
                                       "Invalid wiki history link in the response");

            --  Get the information page.
            ASF.Tests.Do_Get (Request, Reply, Info (Info'First + 8 .. Info'Last),
                              "wiki-info-" & Page & ".html");
            ASF.Tests.Assert_Contains (T, "wiki-word-list", Reply,
                                       "Wiki info page " & Page & " is invalid");

            --  Get the history page.
            ASF.Tests.Do_Get (Request, Reply, History (History'First + 8 .. History'Last),
                              "wiki-history-" & Page & ".html");
            ASF.Tests.Assert_Contains (T, "wiki-page-version", Reply,
                                       "Wiki history page " & Page & " is invalid");

         end;
      end if;
   end Verify_Anonymous;

   --  ------------------------------
   --  Verify that the wiki lists contain the given page.
   --  ------------------------------
   procedure Verify_List_Contains (T    : in out Test;
                                   Page : in String) is
      Wiki      : constant String := To_String (T.Wiki_Ident);
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/recent",
                        "wiki-list-recent.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list recent page is invalid");
      ASF.Tests.Assert_Contains (T, "/wikis/view/" & To_String (T.Wiki_Ident)
                                 & "/" & Page, Reply,
                                 "Wiki list recent page does not reference the page");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/popular",
                        "wiki-list-popular.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list popular page is invalid");
      ASF.Tests.Assert_Contains (T, "/wikis/view/" & To_String (T.Wiki_Ident)
                                 & "/" & Page, Reply,
                                 "Wiki list popular page does not reference the page");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/name",
                        "wiki-list-name.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list name page is invalid");
      ASF.Tests.Assert_Contains (T, "/wikis/view/" & To_String (T.Wiki_Ident)
                                 & "/" & Page, Reply,
                                 "Wiki list name page does not reference the page");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Wiki & "/name/grid",
                        "wiki-list-name-grid.html");
      ASF.Tests.Assert_Contains (T, "List of pages", Reply,
                                 "Wiki list name/grid page is invalid");
      ASF.Tests.Assert_Contains (T, "/wikis/view/" & To_String (T.Wiki_Ident)
                                 & "/" & Page, Reply,
                                 "Wiki list name/grid page does not reference the page");

   end Verify_List_Contains;

   --  ------------------------------
   --  Test access to the blog as anonymous user.
   --  ------------------------------
   procedure Test_Anonymous_Access (T : in out Test) is
   begin
      T.Verify_Anonymous ("", "");
   end Test_Anonymous_Access;

   --  ------------------------------
   --  Test creation of blog by simulating web requests.
   --  ------------------------------
   procedure Test_Create_Wiki (T : in out Test) is
      procedure Create_Page (Name : in String; Title : in String);

      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Uuid      : constant String := Util.Tests.Get_Uuid;

      procedure Create_Page (Name : in String; Title : in String) is
      begin
         Request.Set_Parameter ("page-wiki-id", To_String (T.Wiki_Ident));
         Request.Set_Parameter ("post", "1");
         Request.Set_Parameter ("page-title", Title);
         Request.Set_Parameter ("text", "# Main title" & ASCII.LF
                                & "* The wiki page content." & ASCII.LF
                                & "* Second item." & ASCII.LF);
         Request.Set_Parameter ("name", Name);
         Request.Set_Parameter ("comment", "Created wiki page " & Name);
         Request.Set_Parameter ("save", "1");
         Request.Set_Parameter ("page-is-public", "1");
         Request.Set_Parameter ("wiki-format", "FORMAT_MARKDOWN");
         ASF.Tests.Do_Post (Request, Reply, "/wikis/create.html", "create-wiki.html");

         T.Page_Ident := Helpers.Extract_Redirect (Reply, "/asfunit/wikis/view/"
                                                   & To_String (T.Wiki_Ident) & "/");

         Util.Tests.Assert_Equals (T, Name, To_String (T.Page_Ident),
                                   "Invalid redirect after wiki page creation");

         --  Remove the 'wikiPage' bean from the request so that we get a new instance
         --  for the next call.
         Request.Remove_Attribute ("wikiPage");
      end Create_Page;

   begin
      AWA.Tests.Helpers.Users.Login ("test-wiki@test.com", Request);
      Request.Set_Parameter ("title", "The Wiki Space Title");
      Request.Set_Parameter ("post", "1");
      Request.Set_Parameter ("create", "1");
      ASF.Tests.Do_Post (Request, Reply, "/wikis/setup.html", "setup-wiki.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY,
                "Invalid response after wiki space creation");
      declare
         Ident : constant String
           := Helpers.Extract_Redirect (Reply, "/asfunit/wikis/list/");
         Pos   : constant Natural
           := Util.Strings.Index (Ident, '/');
      begin
         Util.Tests.Assert_Matches (T, "^[0-9]+/recent/grid$", Ident,
                                    "Invalid wiki space identifier in the response");
         T.Wiki_Ident := To_Unbounded_String (Ident (Ident'First .. Pos - 1));
      end;
      Create_Page ("WikiPageTestName", "Wiki page title1");
      T.Verify_List_Contains (To_String (T.Page_Ident));

      Create_Page ("WikiSecondPageName", "Wiki page title2");
      T.Verify_List_Contains (To_String (T.Page_Ident));

      Create_Page ("WikiThirdPageName", "Wiki page title3");

      T.Verify_Anonymous ("WikiPageTestName", "Wiki page title1");
      T.Verify_Anonymous ("WikiSecondPageName", "Wiki page title2");
      T.Verify_Anonymous ("WikiThirdPageName", "Wiki page title3");

   end Test_Create_Wiki;

   --  ------------------------------
   --  Test getting a wiki page which does not exist.
   --  ------------------------------
   procedure Test_Missing_Page (T : in out Test) is
      Wiki      : constant String := To_String (T.Wiki_Ident);
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Wiki & "/MissingPage",
                        "wiki-page-missing.html");
      ASF.Tests.Assert_Matches (T, ".title.Wiki page does not exist./title.", Reply,
                                "Wiki page 'MissingPage' is invalid",
                                ASF.Responses.SC_NOT_FOUND);
      ASF.Tests.Assert_Matches (T, ".h2.MissingPage./h2.", Reply,
                                "Wiki page 'MissingPage' header is invalid",
                                ASF.Responses.SC_NOT_FOUND);
   end Test_Missing_Page;

end AWA.Wikis.Tests;

Rename the test for the results

Rename the test for the results


-----------------------------------------------------------------------
--  xmi -- XMI parser example
--  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 Ada.Text_IO;
with Ada.Command_Line;

with Util.Log.Loggers;
with Util.Beans;
with Util.Beans.Objects;
with Util.Serialize.Mappers.Record_Mapper;
with Util.Serialize.IO.XML;

--  This sample reads an UML 1.4 model saved in XMI 1.2 format.  It uses the serialization
--  framework to indicate what XML nodes and attributes must be reported.
procedure XMI is

   use type Ada.Text_IO.Count;

   Reader : Util.Serialize.IO.XML.Parser;

   Count  : constant Natural := Ada.Command_Line.Argument_Count;

   type XMI_Fields is (FIELD_CLASS_NAME, FIELD_CLASS_ID, FIELD_STEREOTYPE,
                       FIELD_ATTRIBUTE_NAME,
                       FIELD_PACKAGE_NAME,
                       FIELD_PACKAGE_END,
                       FIELD_VISIBILITY,
                       FIELD_DATA_TYPE,
                       FIELD_ENUM_DATA_TYPE,
                       FIELD_ENUM_NAME,
                       FIELD_ENUM_END,
                       FIELD_ENUM_LITERAL,
                       FIELD_ENUM_LITERAL_END,
                       FIELD_CLASS_END,
                       FIELD_MULTIPLICITY_LOWER,
                       FIELD_MULTIPLICITY_UPPER,
                       FIELD_ASSOCIATION_AGGREGATION,
                       FIELD_ASSOCIATION_NAME,
                       FIELD_ASSOCIATION_VISIBILITY,
                       FIELD_ASSOCIATION_END_ID,
                       FIELD_ASSOCIATION_END,
                       FIELD_TAG_DEFINITION_ID,
                       FIELD_TAG_DEFINITION_NAME,
                       FIELD_OPERATION_NAME,
                       FIELD_COMMENT_NAME,
                       FIELD_COMMENT_BODY,
                       FIELD_COMMENT_CLASS_ID,
                       FIELD_TAGGED_VALUE_TYPE,
                       FIELD_TAGGED_VALUE_VALUE);

   type XMI_Info is record
      Indent : Ada.Text_IO.Count := 1;
   end record;
   type XMI_Access is access all XMI_Info;

   procedure Set_Member (P     : in out XMI_Info;
                         Field : in XMI_Fields;
                         Value : in Util.Beans.Objects.Object);

   procedure Print (Col  : in Ada.Text_IO.Count;
                    Line : in String) is
   begin
      Ada.Text_IO.Set_Col (Col);
      Ada.Text_IO.Put_Line (Line);
   end Print;

   procedure Set_Member (P     : in out XMI_Info;
                         Field : in XMI_Fields;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
      when FIELD_CLASS_NAME =>
         Print (P.Indent, "Class " & Util.Beans.Objects.To_String (Value));
         P.Indent := P.Indent + 2;

      when FIELD_VISIBILITY =>
         Print (P.Indent, "visibility: " & Util.Beans.Objects.To_String (Value));

      when FIELD_CLASS_ID =>
         Print (P.Indent, "id: " & Util.Beans.Objects.To_String (Value));

      when FIELD_ATTRIBUTE_NAME =>
         Ada.Text_IO.Set_Col (P.Indent);
         Ada.Text_IO.Put ("attr: " & Util.Beans.Objects.To_String (Value));

      when FIELD_MULTIPLICITY_LOWER =>
         Ada.Text_IO.Set_Col (P.Indent);
         Ada.Text_IO.Put ("  multiplicity: " & Util.Beans.Objects.To_String (Value));

      when FIELD_MULTIPLICITY_UPPER =>
         Ada.Text_IO.Put_Line (".." & Util.Beans.Objects.To_String (Value));

      when FIELD_STEREOTYPE =>
         Print (P.Indent, "<<" & Util.Beans.Objects.To_String (Value) & ">>");

      when FIELD_DATA_TYPE =>
         Print (P.Indent, "  data-type:" & Util.Beans.Objects.To_String (Value));

      when FIELD_ENUM_DATA_TYPE =>
         Print (P.Indent, "  enum-type:" & Util.Beans.Objects.To_String (Value));
         P.Indent := P.Indent + 2;

      when FIELD_ENUM_NAME =>
         Print (P.Indent, "  enum " & Util.Beans.Objects.To_String (Value));
         P.Indent := P.Indent + 2;

      when FIELD_ENUM_LITERAL =>
         Print (P.Indent, "  enum:" & Util.Beans.Objects.To_String (Value));
         P.Indent := P.Indent + 2;

      when FIELD_OPERATION_NAME =>
         Print (P.Indent, "operation:" & Util.Beans.Objects.To_String (Value));

      when FIELD_ASSOCIATION_NAME =>
         Print (P.Indent, "association " & Util.Beans.Objects.To_String (Value));
         P.Indent := P.Indent + 2;

      when FIELD_ASSOCIATION_VISIBILITY =>
         Print (P.Indent, "visibility: " & Util.Beans.Objects.To_String (Value));

      when FIELD_ASSOCIATION_AGGREGATION =>
         Print (P.Indent, "   aggregate: " & Util.Beans.Objects.To_String (Value));

      when FIELD_ASSOCIATION_END_ID =>
         Print (P.Indent, "   end-id: " & Util.Beans.Objects.To_String (Value));

      when FIELD_PACKAGE_NAME =>
         Print (P.Indent, "package " & Util.Beans.Objects.To_String (Value));
         P.Indent := P.Indent + 2;

      when FIELD_TAGGED_VALUE_VALUE =>
         Print (P.Indent, "-- " & Util.Beans.Objects.To_String (Value));

      when FIELD_TAGGED_VALUE_TYPE =>
         Print (P.Indent, "tag-type: " & Util.Beans.Objects.To_String (Value));

      when FIELD_TAG_DEFINITION_NAME =>
         Print (P.Indent, "Tag: " & Util.Beans.Objects.To_String (Value));

      when FIELD_TAG_DEFINITION_ID =>
         Print (P.Indent, "  tag-id: " & Util.Beans.Objects.To_String (Value));

      when FIELD_COMMENT_NAME =>
         Print (P.Indent, "Comment: " & Util.Beans.Objects.To_String (Value));

      when FIELD_COMMENT_BODY =>
         Print (P.Indent, "   text: " & Util.Beans.Objects.To_String (Value));

      when FIELD_COMMENT_CLASS_ID =>
         Print (P.Indent, "   for-id: " & Util.Beans.Objects.To_String (Value));

      when FIELD_PACKAGE_END | FIELD_CLASS_END | FIELD_ENUM_END | FIELD_ENUM_LITERAL_END |
           FIELD_ASSOCIATION_END =>
         P.Indent := P.Indent - 2;

      end case;
   end Set_Member;

   package XMI_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => XMI_Info,
                                               Element_Type_Access => XMI_Access,
                                               Fields              => XMI_Fields,
                                               Set_Member          => Set_Member);

   XMI_Mapping        : aliased XMI_Mapper.Mapper;

begin
--        Util.Log.Loggers.Initialize ("samples/log4j.properties");

   if Count = 0 then
      Ada.Text_IO.Put_Line ("Usage: xmi file...");
      Ada.Text_IO.Put_Line ("Example xmi samples/demo-atlas.xmi");
      return;
   end if;

   --  Define the XMI mapping.
   XMI_Mapping.Add_Mapping ("**/Package/@name", FIELD_PACKAGE_NAME);
   XMI_Mapping.Add_Mapping ("**/Package/@visibility", FIELD_VISIBILITY);
   XMI_Mapping.Add_Mapping ("**/Package", FIELD_PACKAGE_END);

   XMI_Mapping.Add_Mapping ("**/Class/@name", FIELD_CLASS_NAME);
   XMI_Mapping.Add_Mapping ("**/Class/@xmi.idref", FIELD_CLASS_NAME);
   XMI_Mapping.Add_Mapping ("**/Class/@xmi.id", FIELD_CLASS_ID);
   XMI_Mapping.Add_Mapping ("**/Class/@visibility", FIELD_VISIBILITY);
   XMI_Mapping.Add_Mapping ("**/Class", FIELD_CLASS_END);

   XMI_Mapping.Add_Mapping ("**/Stereotype/@href", FIELD_STEREOTYPE);
   XMI_Mapping.Add_Mapping ("**/Stereotype/@name", FIELD_STEREOTYPE);

   XMI_Mapping.Add_Mapping ("**/Attribute/@name", FIELD_ATTRIBUTE_NAME);
   XMI_Mapping.Add_Mapping ("**/Attribute/@visibility", FIELD_VISIBILITY);

   XMI_Mapping.Add_Mapping ("**/TaggedValue.dataValue", FIELD_TAGGED_VALUE_VALUE);

   XMI_Mapping.Add_Mapping ("**/DataType/@href", FIELD_DATA_TYPE);

   XMI_Mapping.Add_Mapping ("**/Enumeration/@href", FIELD_ENUM_NAME);
   XMI_Mapping.Add_Mapping ("**/Enumeration/@name", FIELD_ENUM_NAME);
   XMI_Mapping.Add_Mapping ("**/Enumeration", FIELD_ENUM_END);

   XMI_Mapping.Add_Mapping ("**/EnumerationLiteral/@name", FIELD_ENUM_LITERAL);
   XMI_Mapping.Add_Mapping ("**/EnumerationLiteral", FIELD_ENUM_LITERAL_END);

   XMI_Mapping.Add_Mapping ("**/MultiplicityRange/@lower", FIELD_MULTIPLICITY_LOWER);
   XMI_Mapping.Add_Mapping ("**/MultiplicityRange/@upper", FIELD_MULTIPLICITY_UPPER);

   XMI_Mapping.Add_Mapping ("**/Operation/@name", FIELD_OPERATION_NAME);
   XMI_Mapping.Add_Mapping ("**/Operation/@visibility", FIELD_VISIBILITY);

   XMI_Mapping.Add_Mapping ("**/Association/@name", FIELD_ASSOCIATION_NAME);
   XMI_Mapping.Add_Mapping ("**/Association/@visibility", FIELD_ASSOCIATION_VISIBILITY);
   XMI_Mapping.Add_Mapping ("**/Association/@aggregation", FIELD_ASSOCIATION_AGGREGATION);
   XMI_Mapping.Add_Mapping ("**/AssociationEnd.participant/Class/@xmi.idref",
                            FIELD_ASSOCIATION_END_ID);
   XMI_Mapping.Add_Mapping ("**/Association", FIELD_ASSOCIATION_END);

   XMI_Mapping.Add_Mapping ("**/TagDefinition/@name", FIELD_TAG_DEFINITION_NAME);
   XMI_Mapping.Add_Mapping ("**/TagDefinition/@xm.id", FIELD_TAG_DEFINITION_ID);

   XMI_Mapping.Add_Mapping ("**/Comment/@name", FIELD_COMMENT_NAME);
   XMI_Mapping.Add_Mapping ("**/Comment/@body", FIELD_COMMENT_BODY);
   XMI_Mapping.Add_Mapping ("**/Comment/Comment.annotatedElement/Class/@xmi.idref",
                            FIELD_COMMENT_CLASS_ID);

   Reader.Add_Mapping ("XMI", XMI_Mapping'Unchecked_Access);

   for I in 1 .. Count loop
      declare
         S    : constant String := Ada.Command_Line.Argument (I);
         Data : aliased XMI_Info;
      begin
         XMI_Mapper.Set_Context (Reader, Data'Unchecked_Access);
         Reader.Parse (S);
      end;
   end loop;
end XMI;

-----------------------------------------------------------------------
--  xmi -- XMI parser example
--  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 Ada.Text_IO;
with Ada.Command_Line;

with Util.Log.Loggers;
with Util.Beans;
with Util.Beans.Objects;
with Util.Serialize.Mappers.Record_Mapper;
with Util.Serialize.IO.XML;

--  This sample reads an UML 1.4 model saved in XMI 1.2 format.  It uses the serialization
--  framework to indicate what XML nodes and attributes must be reported.
procedure XMI is

   use type Ada.Text_IO.Count;

   Reader : Util.Serialize.IO.XML.Parser;

   Count  : constant Natural := Ada.Command_Line.Argument_Count;

   type XMI_Fields is (FIELD_CLASS_NAME, FIELD_CLASS_ID, FIELD_STEREOTYPE,
                       FIELD_ATTRIBUTE_NAME,
                       FIELD_PACKAGE_NAME,
                       FIELD_PACKAGE_END,
                       FIELD_VISIBILITY,
                       FIELD_DATA_TYPE,
                       FIELD_ENUM_DATA_TYPE,
                       FIELD_ENUM_NAME,
                       FIELD_ENUM_END,
                       FIELD_ENUM_LITERAL,
                       FIELD_ENUM_LITERAL_END,
                       FIELD_CLASS_END,
                       FIELD_MULTIPLICITY_LOWER,
                       FIELD_MULTIPLICITY_UPPER,
                       FIELD_ASSOCIATION_AGGREGATION,
                       FIELD_ASSOCIATION_NAME,
                       FIELD_ASSOCIATION_VISIBILITY,
                       FIELD_ASSOCIATION_END_ID,
                       FIELD_ASSOCIATION_END,
                       FIELD_TAG_DEFINITION_ID,
                       FIELD_TAG_DEFINITION_NAME,
                       FIELD_OPERATION_NAME,
                       FIELD_COMMENT_NAME,
                       FIELD_COMMENT_BODY,
                       FIELD_COMMENT_CLASS_ID,
                       FIELD_TAGGED_VALUE_TYPE,
                       FIELD_TAGGED_VALUE_VALUE);

   type XMI_Info is record
      Indent : Ada.Text_IO.Count := 1;
   end record;
   type XMI_Access is access all XMI_Info;

   procedure Set_Member (P     : in out XMI_Info;
                         Field : in XMI_Fields;
                         Value : in Util.Beans.Objects.Object);

   procedure Print (Col  : in Ada.Text_IO.Count;
                    Line : in String) is
   begin
      Ada.Text_IO.Set_Col (Col);
      Ada.Text_IO.Put_Line (Line);
   end Print;

   procedure Set_Member (P     : in out XMI_Info;
                         Field : in XMI_Fields;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
      when FIELD_CLASS_NAME =>
         Print (P.Indent, "Class " & Util.Beans.Objects.To_String (Value));
         P.Indent := P.Indent + 2;

      when FIELD_VISIBILITY =>
         Print (P.Indent, "visibility: " & Util.Beans.Objects.To_String (Value));

      when FIELD_CLASS_ID =>
         Print (P.Indent, "id: " & Util.Beans.Objects.To_String (Value));

      when FIELD_ATTRIBUTE_NAME =>
         Ada.Text_IO.Set_Col (P.Indent);
         Ada.Text_IO.Put ("attr: " & Util.Beans.Objects.To_String (Value));

      when FIELD_MULTIPLICITY_LOWER =>
         Ada.Text_IO.Set_Col (P.Indent);
         Ada.Text_IO.Put ("  multiplicity: " & Util.Beans.Objects.To_String (Value));

      when FIELD_MULTIPLICITY_UPPER =>
         Ada.Text_IO.Put_Line (".." & Util.Beans.Objects.To_String (Value));

      when FIELD_STEREOTYPE =>
         Print (P.Indent, "<<" & Util.Beans.Objects.To_String (Value) & ">>");

      when FIELD_DATA_TYPE =>
         Print (P.Indent, "  data-type:" & Util.Beans.Objects.To_String (Value));

      when FIELD_ENUM_DATA_TYPE =>
         Print (P.Indent, "  enum-type:" & Util.Beans.Objects.To_String (Value));
         P.Indent := P.Indent + 2;

      when FIELD_ENUM_NAME =>
         Print (P.Indent, "  enum " & Util.Beans.Objects.To_String (Value));
         P.Indent := P.Indent + 2;

      when FIELD_ENUM_LITERAL =>
         Print (P.Indent, "  enum:" & Util.Beans.Objects.To_String (Value));
         P.Indent := P.Indent + 2;

      when FIELD_OPERATION_NAME =>
         Print (P.Indent, "operation:" & Util.Beans.Objects.To_String (Value));

      when FIELD_ASSOCIATION_NAME =>
         Print (P.Indent, "association " & Util.Beans.Objects.To_String (Value));
         P.Indent := P.Indent + 2;

      when FIELD_ASSOCIATION_VISIBILITY =>
         Print (P.Indent, "visibility: " & Util.Beans.Objects.To_String (Value));

      when FIELD_ASSOCIATION_AGGREGATION =>
         Print (P.Indent, "   aggregate: " & Util.Beans.Objects.To_String (Value));

      when FIELD_ASSOCIATION_END_ID =>
         Print (P.Indent, "   end-id: " & Util.Beans.Objects.To_String (Value));

      when FIELD_PACKAGE_NAME =>
         Print (P.Indent, "package " & Util.Beans.Objects.To_String (Value));
         P.Indent := P.Indent + 2;

      when FIELD_TAGGED_VALUE_VALUE =>
         Print (P.Indent, "-- " & Util.Beans.Objects.To_String (Value));

      when FIELD_TAGGED_VALUE_TYPE =>
         Print (P.Indent, "tag-type: " & Util.Beans.Objects.To_String (Value));

      when FIELD_TAG_DEFINITION_NAME =>
         Print (P.Indent, "Tag: " & Util.Beans.Objects.To_String (Value));

      when FIELD_TAG_DEFINITION_ID =>
         Print (P.Indent, "  tag-id: " & Util.Beans.Objects.To_String (Value));

      when FIELD_COMMENT_NAME =>
         Print (P.Indent, "Comment: " & Util.Beans.Objects.To_String (Value));

      when FIELD_COMMENT_BODY =>
         Print (P.Indent, "   text: " & Util.Beans.Objects.To_String (Value));

      when FIELD_COMMENT_CLASS_ID =>
         Print (P.Indent, "   for-id: " & Util.Beans.Objects.To_String (Value));

      when FIELD_PACKAGE_END | FIELD_CLASS_END | FIELD_ENUM_END | FIELD_ENUM_LITERAL_END |
           FIELD_ASSOCIATION_END =>
         P.Indent := P.Indent - 2;

      end case;
   end Set_Member;

   package XMI_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => XMI_Info,
                                               Element_Type_Access => XMI_Access,
                                               Fields              => XMI_Fields,
                                               Set_Member          => Set_Member);

   XMI_Mapping        : aliased XMI_Mapper.Mapper;
   Mapper             : Util.Serialize.Mappers.Processing;

begin
--        Util.Log.Loggers.Initialize ("samples/log4j.properties");

   if Count = 0 then
      Ada.Text_IO.Put_Line ("Usage: xmi file...");
      Ada.Text_IO.Put_Line ("Example xmi samples/demo-atlas.xmi");
      return;
   end if;

   --  Define the XMI mapping.
   XMI_Mapping.Add_Mapping ("**/Package/@name", FIELD_PACKAGE_NAME);
   XMI_Mapping.Add_Mapping ("**/Package/@visibility", FIELD_VISIBILITY);
   XMI_Mapping.Add_Mapping ("**/Package", FIELD_PACKAGE_END);

   XMI_Mapping.Add_Mapping ("**/Class/@name", FIELD_CLASS_NAME);
   XMI_Mapping.Add_Mapping ("**/Class/@xmi.idref", FIELD_CLASS_NAME);
   XMI_Mapping.Add_Mapping ("**/Class/@xmi.id", FIELD_CLASS_ID);
   XMI_Mapping.Add_Mapping ("**/Class/@visibility", FIELD_VISIBILITY);
   XMI_Mapping.Add_Mapping ("**/Class", FIELD_CLASS_END);

   XMI_Mapping.Add_Mapping ("**/Stereotype/@href", FIELD_STEREOTYPE);
   XMI_Mapping.Add_Mapping ("**/Stereotype/@name", FIELD_STEREOTYPE);

   XMI_Mapping.Add_Mapping ("**/Attribute/@name", FIELD_ATTRIBUTE_NAME);
   XMI_Mapping.Add_Mapping ("**/Attribute/@visibility", FIELD_VISIBILITY);

   XMI_Mapping.Add_Mapping ("**/TaggedValue.dataValue", FIELD_TAGGED_VALUE_VALUE);

   XMI_Mapping.Add_Mapping ("**/DataType/@href", FIELD_DATA_TYPE);

   XMI_Mapping.Add_Mapping ("**/Enumeration/@href", FIELD_ENUM_NAME);
   XMI_Mapping.Add_Mapping ("**/Enumeration/@name", FIELD_ENUM_NAME);
   XMI_Mapping.Add_Mapping ("**/Enumeration", FIELD_ENUM_END);

   XMI_Mapping.Add_Mapping ("**/EnumerationLiteral/@name", FIELD_ENUM_LITERAL);
   XMI_Mapping.Add_Mapping ("**/EnumerationLiteral", FIELD_ENUM_LITERAL_END);

   XMI_Mapping.Add_Mapping ("**/MultiplicityRange/@lower", FIELD_MULTIPLICITY_LOWER);
   XMI_Mapping.Add_Mapping ("**/MultiplicityRange/@upper", FIELD_MULTIPLICITY_UPPER);

   XMI_Mapping.Add_Mapping ("**/Operation/@name", FIELD_OPERATION_NAME);
   XMI_Mapping.Add_Mapping ("**/Operation/@visibility", FIELD_VISIBILITY);

   XMI_Mapping.Add_Mapping ("**/Association/@name", FIELD_ASSOCIATION_NAME);
   XMI_Mapping.Add_Mapping ("**/Association/@visibility", FIELD_ASSOCIATION_VISIBILITY);
   XMI_Mapping.Add_Mapping ("**/Association/@aggregation", FIELD_ASSOCIATION_AGGREGATION);
   XMI_Mapping.Add_Mapping ("**/AssociationEnd.participant/Class/@xmi.idref",
                            FIELD_ASSOCIATION_END_ID);
   XMI_Mapping.Add_Mapping ("**/Association", FIELD_ASSOCIATION_END);

   XMI_Mapping.Add_Mapping ("**/TagDefinition/@name", FIELD_TAG_DEFINITION_NAME);
   XMI_Mapping.Add_Mapping ("**/TagDefinition/@xm.id", FIELD_TAG_DEFINITION_ID);

   XMI_Mapping.Add_Mapping ("**/Comment/@name", FIELD_COMMENT_NAME);
   XMI_Mapping.Add_Mapping ("**/Comment/@body", FIELD_COMMENT_BODY);
   XMI_Mapping.Add_Mapping ("**/Comment/Comment.annotatedElement/Class/@xmi.idref",
                            FIELD_COMMENT_CLASS_ID);

   Mapper.Add_Mapping ("XMI", XMI_Mapping'Unchecked_Access);

   for I in 1 .. Count loop
      declare
         S    : constant String := Ada.Command_Line.Argument (I);
         Data : aliased XMI_Info;
      begin
         XMI_Mapper.Set_Context (Mapper, Data'Unchecked_Access);
         Reader.Parse (S, Mapper);
      end;
   end loop;
end XMI;

Update the example to use the new parser/mapper interface


-----------------------------------------------------------------------
--  Memory - Memory slot
--  Copyright (C) 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.Containers.Ordered_Maps;
with Ada.Strings.Unbounded;

with ELF;
with MAT.Types;
with MAT.Frames;

with Interfaces;
package MAT.Memory is

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

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

   --  Description of a memory region.
   type Region_Info is record
      Start_Addr : MAT.Types.Target_Addr := 0;
      End_Addr   : MAT.Types.Target_Addr := 0;
      Size       : MAT.Types.Target_Size := 0;
      Flags      : ELF.Elf32_Word := 0;
      Path       : Ada.Strings.Unbounded.Unbounded_String;
   end record;

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

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

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

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

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

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

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

   package Region_Info_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Addr,
                                      Element_Type => Region_Info);

   subtype Region_Info_Map is Region_Info_Maps.Map;
   subtype Region_Info_Cursor is Region_Info_Maps.Cursor;

private

end MAT.Memory;

-----------------------------------------------------------------------
--  Memory - Memory slot
--  Copyright (C) 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.Containers.Ordered_Maps;
with Ada.Strings.Unbounded;

with ELF;
with MAT.Types;
with MAT.Frames;

package MAT.Memory is

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

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

   --  Description of a memory region.
   type Region_Info is record
      Start_Addr : MAT.Types.Target_Addr := 0;
      End_Addr   : MAT.Types.Target_Addr := 0;
      Size       : MAT.Types.Target_Size := 0;
      Flags      : ELF.Elf32_Word := 0;
      Path       : Ada.Strings.Unbounded.Unbounded_String;
   end record;

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

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

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

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

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

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

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

   package Region_Info_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Addr,
                                      Element_Type => Region_Info);

   subtype Region_Info_Map is Region_Info_Maps.Map;
   subtype Region_Info_Cursor is Region_Info_Maps.Cursor;

end MAT.Memory;

Fix compilation warnings

Fix compilation warnings