-----------------------------------------------------------------------
--  awa-storages-beans -- Storage Ada Beans
--  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.Containers;

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

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.Objects.To_Object (From.Get_Folder.Get_Key);
      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;
   begin
      if Name = "folderId" then
         Manager.Load_Folder (Folder, ADO.Identifier (Util.Beans.Objects.To_Integer (Value)));
         From.Set_Folder (Folder);
      elsif Name = "id" then
         Manager.Load_Storage (From, ADO.Identifier (Util.Beans.Objects.To_Integer (Value)));
      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;
   begin
      Bean.Set_Name (Part.Get_Name);
      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.
   --  @method
   --  ------------------------------
   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;

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

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

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

with AWA.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.Objects.To_Object (From.Get_Folder.Get_Key);
      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;
   begin
      if Name = "folderId" then
         Manager.Load_Folder (Folder, ADO.Utils.To_Identifier (Value));
         From.Set_Folder (Folder);
      elsif Name = "id" then
         Manager.Load_Storage (From, ADO.Utils.To_Identifier (Value));
      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;
   begin
      Bean.Set_Name (Part.Get_Name);
      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.
   --  @method
   --  ------------------------------
   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;

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

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

Use the ADO.Utils.To_Identifier operation


-----------------------------------------------------------------------
--  awa-storages-beans -- Storage Ada Beans
--  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 AWA.Storages.Models;
with AWA.Storages.Modules;

with ASF.Parts;

with ADO;

with Util.Beans.Objects;
with Util.Beans.Basic;
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;
   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 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;
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;
   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);

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

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

Declare the Load_Files procedure

Declare the Load_Files procedure


-----------------------------------------------------------------------
--  gen-xmi-tests -- Tests for xmi
--  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.Strings.Unbounded;

with Util.Test_Caller;
with Gen.Generator;
package body Gen.Artifacts.XMI.Tests is

   use Ada.Strings.Unbounded;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Gen.XMI.Read_UML_Configuration",
                       Test_Read_XMI'Access);
      Caller.Add_Test (Suite, "Test Gen.XMI.Find_Element",
                       Test_Find_Element'Access);
      Caller.Add_Test (Suite, "Test Gen.XMI.Find_Element",
                       Test_Find_Tag_Definition'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test reading the XMI files defines in the Dynamo UML configuration repository.
   --  ------------------------------
   procedure Test_Read_XMI (T : in out Test) is
      procedure Check (Namespace : in String;
                       Name      : in String;
                       Id        : in String);

      A : Artifact;
      G : Gen.Generator.Handler;
      C : constant String := Util.Tests.Get_Parameter ("config_dir", "config");

      use type Gen.Model.XMI.Model_Element_Access;

      procedure Check (Namespace : in String;
                       Name      : in String;
                       Id        : in String) is
         Empty  : Gen.Model.XMI.Model_Map.Map;
         XMI_Id : constant Unbounded_String := To_Unbounded_String (Namespace & "#" & Id);
         N      : constant Gen.Model.XMI.Model_Element_Access := Gen.Model.XMI.Find (A.Nodes,
                                                                                Empty,
                                                                                XMI_Id);
      begin
         T.Assert (N /= null, "Cannot find UML element " & To_String (XMI_Id));
         Util.Tests.Assert_Equals (T, Name, To_String (N.Name), "Invalid element name");
      end Check;

   begin
      Gen.Generator.Initialize (G, Ada.Strings.Unbounded.To_Unbounded_String (C), False);
      A.Read_UML_Configuration (G);

      --  ArgoUML Integer DataType
      Check ("default-uml14.xmi", "Integer",
             "-84-17--56-5-43645a83:11466542d86:-8000:000000000000087C");
      --  ArgoUML String DataType
      Check ("default-uml14.xmi", "String",
             "-84-17--56-5-43645a83:11466542d86:-8000:000000000000087E");
      --  ArgoUML documentation TagDefinition
      Check ("default-uml14.xmi", "documentation",
             ".:000000000000087C");
      --  ArgoUML type Stereotype
      Check ("default-uml14.xmi", "type",
             ".:0000000000000842");

      --  Persistence Table Stereotype
      Check ("Dynamo.xmi", "Table",
             "127-0-1-1--44304ba0:139c0f2a59c:-8000:0000000000001D4F");
      Check ("Dynamo.xmi", "PK",
             "127-0-1-1--44304ba0:139c0f2a59c:-8000:0000000000001D50");
      Check ("Dynamo.xmi", "FK",
             "127-0-1-1--44304ba0:139c0f2a59c:-8000:0000000000001F70");
      Check ("Dynamo.xmi", "Bean",
             "127-0-1-1--44304ba0:139c0f2a59c:-8000:0000000000001F72");

   end Test_Read_XMI;

   --  ------------------------------
   --  Test searching an XMI element by using a qualified name.
   --  ------------------------------
   procedure Test_Find_Element (T : in out Test) is
      A : Artifact;
      G : Gen.Generator.Handler;
      C : constant String := Util.Tests.Get_Parameter ("config_dir", "config");

      use Gen.Model.XMI;

      function Find_Stereotype is
        new Gen.Model.XMI.Find_Element (Element_Type        => Stereotype_Element,
                                        Element_Type_Access => Stereotype_Element_Access);

   begin
      Gen.Generator.Initialize (G, Ada.Strings.Unbounded.To_Unbounded_String (C), False);
      A.Read_UML_Configuration (G);

      declare
         S : Gen.Model.XMI.Stereotype_Element_Access;
      begin
         S := Find_Stereotype (A.Nodes, "Dynamo.xmi", "ADO.Table", Gen.Model.XMI.BY_NAME);
         T.Assert (S /= null, "Stereotype not found");

         S := Find_Stereotype (A.Nodes, "Dynamo.xmi", "ADO.PK", Gen.Model.XMI.BY_NAME);
         T.Assert (S /= null, "Stereotype not found");

         S := Find_Stereotype (A.Nodes, "Dynamo.xmi", "ADO.FK", Gen.Model.XMI.BY_NAME);
         T.Assert (S /= null, "Stereotype not found");

         S := Find_Stereotype (A.Nodes, "Dynamo.xmi", "ADO.DataModel", Gen.Model.XMI.BY_NAME);
         T.Assert (S /= null, "Stereotype not found");

         S := Find_Stereotype (A.Nodes, "Dynamo.xmi", "AWA.Bean", Gen.Model.XMI.BY_NAME);
         T.Assert (S /= null, "Stereotype not found");
      end;
   end Test_Find_Element;

   --  Test searching an XMI Tag definition element by using its name.
   procedure Test_Find_Tag_Definition (T : in out Test) is
      A : Artifact;
      G : Gen.Generator.Handler;
      C : constant String := Util.Tests.Get_Parameter ("config_dir", "config");

      use Gen.Model.XMI;

      function Find_Tag_Definition is
        new Gen.Model.XMI.Find_Element (Element_Type        => Tag_Definition_Element,
                                        Element_Type_Access => Tag_Definition_Element_Access);

   begin
      Gen.Generator.Initialize (G, Ada.Strings.Unbounded.To_Unbounded_String (C), False);
      A.Read_UML_Configuration (G);

      declare
         Tag : Tag_Definition_Element_Access;
      begin
         Tag := Find_Tag_Definition (A.Nodes, "Dynamo.xmi", "ADO.Table.@dynamo.table.hasList",
                                     Gen.Model.XMI.BY_NAME);
         T.Assert (Tag /= null, "Tag definition not found");
      end;
   end Test_Find_Tag_Definition;

end Gen.Artifacts.XMI.Tests;

-----------------------------------------------------------------------
--  gen-xmi-tests -- Tests for xmi
--  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.Strings.Unbounded;

with Util.Test_Caller;

with Gen.Configs;
with Gen.Generator;
package body Gen.Artifacts.XMI.Tests is

   use Ada.Strings.Unbounded;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Gen.XMI.Read_UML_Configuration",
                       Test_Read_XMI'Access);
      Caller.Add_Test (Suite, "Test Gen.XMI.Find_Element",
                       Test_Find_Element'Access);
      Caller.Add_Test (Suite, "Test Gen.XMI.Find_Element",
                       Test_Find_Tag_Definition'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test reading the XMI files defines in the Dynamo UML configuration repository.
   --  ------------------------------
   procedure Test_Read_XMI (T : in out Test) is
      procedure Check (Namespace : in String;
                       Name      : in String;
                       Id        : in String);

      A : Artifact;
      G : Gen.Generator.Handler;
      C : constant String := Util.Tests.Get_Parameter ("config_dir", "config");

      use type Gen.Model.XMI.Model_Element_Access;

      procedure Check (Namespace : in String;
                       Name      : in String;
                       Id        : in String) is
         Empty  : Gen.Model.XMI.Model_Map.Map;
         XMI_Id : constant Unbounded_String := To_Unbounded_String (Namespace & "#" & Id);
         N      : constant Gen.Model.XMI.Model_Element_Access := Gen.Model.XMI.Find (A.Nodes,
                                                                                Empty,
                                                                                XMI_Id);
      begin
         T.Assert (N /= null, "Cannot find UML element " & To_String (XMI_Id));
         Util.Tests.Assert_Equals (T, Name, To_String (N.Name), "Invalid element name");
      end Check;

   begin
      Gen.Generator.Initialize (G, Ada.Strings.Unbounded.To_Unbounded_String (C), False);
      A.Read_Model (G.Get_Parameter (Gen.Configs.GEN_UML_DIR) & "/Dynamo.xmi", G);

      --  ArgoUML Integer DataType
      Check ("default-uml14.xmi", "Integer",
             "-84-17--56-5-43645a83:11466542d86:-8000:000000000000087C");
      --  ArgoUML String DataType
      Check ("default-uml14.xmi", "String",
             "-84-17--56-5-43645a83:11466542d86:-8000:000000000000087E");
      --  ArgoUML documentation TagDefinition
      Check ("default-uml14.xmi", "documentation",
             ".:000000000000087C");
      --  ArgoUML type Stereotype
      Check ("default-uml14.xmi", "type",
             ".:0000000000000842");

      --  Persistence Table Stereotype
      Check ("Dynamo.xmi", "Table",
             "127-0-1-1--44304ba0:139c0f2a59c:-8000:0000000000001D4F");
      Check ("Dynamo.xmi", "PK",
             "127-0-1-1--44304ba0:139c0f2a59c:-8000:0000000000001D50");
      Check ("Dynamo.xmi", "FK",
             "127-0-1-1--44304ba0:139c0f2a59c:-8000:0000000000001F70");
      Check ("Dynamo.xmi", "Bean",
             "127-0-1-1--44304ba0:139c0f2a59c:-8000:0000000000001F72");

   end Test_Read_XMI;

   --  ------------------------------
   --  Test searching an XMI element by using a qualified name.
   --  ------------------------------
   procedure Test_Find_Element (T : in out Test) is
      A : Artifact;
      G : Gen.Generator.Handler;
      C : constant String := Util.Tests.Get_Parameter ("config_dir", "config");

      use Gen.Model.XMI;

      function Find_Stereotype is
        new Gen.Model.XMI.Find_Element (Element_Type        => Stereotype_Element,
                                        Element_Type_Access => Stereotype_Element_Access);

   begin
      Gen.Generator.Initialize (G, Ada.Strings.Unbounded.To_Unbounded_String (C), False);
      A.Read_Model (G.Get_Parameter (Gen.Configs.GEN_UML_DIR) & "/Dynamo.xmi", G);

      declare
         S : Gen.Model.XMI.Stereotype_Element_Access;
      begin
         S := Find_Stereotype (A.Nodes, "Dynamo.xmi", "ADO.Table", Gen.Model.XMI.BY_NAME);
         T.Assert (S /= null, "Stereotype not found");

         S := Find_Stereotype (A.Nodes, "Dynamo.xmi", "ADO.PK", Gen.Model.XMI.BY_NAME);
         T.Assert (S /= null, "Stereotype not found");

         S := Find_Stereotype (A.Nodes, "Dynamo.xmi", "ADO.FK", Gen.Model.XMI.BY_NAME);
         T.Assert (S /= null, "Stereotype not found");

         S := Find_Stereotype (A.Nodes, "Dynamo.xmi", "ADO.DataModel", Gen.Model.XMI.BY_NAME);
         T.Assert (S /= null, "Stereotype not found");

         S := Find_Stereotype (A.Nodes, "Dynamo.xmi", "AWA.Bean", Gen.Model.XMI.BY_NAME);
         T.Assert (S /= null, "Stereotype not found");
      end;
   end Test_Find_Element;

   --  Test searching an XMI Tag definition element by using its name.
   procedure Test_Find_Tag_Definition (T : in out Test) is
      A : Artifact;
      G : Gen.Generator.Handler;
      C : constant String := Util.Tests.Get_Parameter ("config_dir", "config");

      use Gen.Model.XMI;

      function Find_Tag_Definition is
        new Gen.Model.XMI.Find_Element (Element_Type        => Tag_Definition_Element,
                                        Element_Type_Access => Tag_Definition_Element_Access);

   begin
      Gen.Generator.Initialize (G, Ada.Strings.Unbounded.To_Unbounded_String (C), False);
      A.Read_Model (G.Get_Parameter (Gen.Configs.GEN_UML_DIR) & "/Dynamo.xmi", G);

      declare
         Tag : Tag_Definition_Element_Access;
      begin
         Tag := Find_Tag_Definition (A.Nodes, "Dynamo.xmi", "ADO.Table.@dynamo.table.hasList",
                                     Gen.Model.XMI.BY_NAME);
         T.Assert (Tag /= null, "Tag definition not found");
      end;
   end Test_Find_Tag_Definition;

end Gen.Artifacts.XMI.Tests;

Update the unit test to use Read_Model

Update the unit test to use Read_Model


-----------------------------------------------------------------------
--  ADO Sequences -- Database sequence generator
--  Copyright (C) 2009, 2010, 2011, 2012, 2015, 2017, 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.Exceptions;
with Ada.Calendar;

with ADO.Statements;
with ADO.Objects;
with ADO.Sessions;
with ADO.Utils;
with Regtests;

with Regtests.Simple.Model;
with Regtests.Images.Model;

with Util.Assertions;
with Util.Measures;
with Util.Log;
with Util.Log.Loggers;
with Util.Beans.Objects;
with Util.Test_Caller;

package body ADO.Tests is

   use Ada.Exceptions;
   use ADO.Statements;

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

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

   procedure Assert_Has_Message (T : in Test;
                                 E : in Exception_Occurrence);

   procedure Assert_Has_Message (T : in Test;
                                 E : in Exception_Occurrence) is
      Message : constant String := Exception_Message (E);
   begin
      Log.Info ("Exception: {0}", Message);
      T.Assert (Message'Length > 0,
                "Exception " & Exception_Name (E) & " does not have any message");
   end Assert_Has_Message;

   procedure Set_Up (T : in out Test) is
   begin
      null;
   end Set_Up;

   --  ------------------------------
   --  Check:
   --     Object_Ref.Load
   --     Object_Ref.Is_Null
   --  ------------------------------
   procedure Test_Load (T : in out Test) is

      DB  : ADO.Sessions.Session := Regtests.Get_Database;

      Object : Regtests.Simple.Model.User_Ref;
   begin
      T.Assert (Object.Is_Null, "Object_Ref.Is_Null: Empty object must be null");

      Object.Load (DB, -1);
      T.Assert (False, "Object_Ref.Load: Load must raise NOT_FOUND exception");

   exception
      when ADO.Objects.NOT_FOUND =>
         T.Assert (Object.Is_Null, "Object_Ref.Load: Must not change the object");
   end Test_Load;

   --  ------------------------------
   --  Check:
   --    Object_Ref.Load
   --    Object_Ref.Save
   --    <Model>.Set_xxx (Unbounded_String)
   --    <Model>.Create
   --  ------------------------------
   procedure Test_Create_Load (T : in out Test) is

      DB     : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;

      Object : Regtests.Simple.Model.User_Ref;
      Check  : Regtests.Simple.Model.User_Ref;
   begin
      --  Initialize and save an object
      Object.Set_Name ("A simple test name");
      Object.Save (DB);

      T.Assert (Object.Get_Id > 0, "Saving an object did not allocate an identifier");

      --  Load the object
      Check.Load (DB, Object.Get_Id);
      T.Assert (not Check.Is_Null, "Object_Ref.Load: Loading the object failed");
   end Test_Create_Load;

   --  ------------------------------
   --  Check:
   --    Various error checks on database connections
   --
   --    Master_Connection.Rollback
   --  ------------------------------
   procedure Test_Not_Open (T : in out Test) is
      DB : ADO.Sessions.Master_Session;
   begin
      begin
         DB.Rollback;
         T.Fail ("Master_Connection.Rollback should raise an exception");

      exception
         when E : ADO.Sessions.NOT_OPEN =>
            Assert_Has_Message (T, E);
      end;

      begin
         DB.Commit;
         T.Fail ("Master_Connection.Commit should raise an exception");

      exception
         when E : ADO.Sessions.NOT_OPEN =>
            Assert_Has_Message (T, E);
      end;

   end Test_Not_Open;

   --  ------------------------------
   --  Check id generation
   --  ------------------------------
   procedure Test_Allocate (T : in out Test) is
      DB     : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      Key    : ADO.Objects.Object_Key (Of_Type => ADO.Objects.KEY_INTEGER,
                                       Of_Class => Regtests.Simple.Model.ALLOCATE_TABLE);
      PrevId : Identifier := NO_IDENTIFIER;
      S      : Util.Measures.Stamp;
   begin
      for I in 1 .. 200 loop
         declare
            Obj : Regtests.Simple.Model.Allocate_Ref;
         begin
            Obj.Save (DB);
            Key := Obj.Get_Key;
            if PrevId /= NO_IDENTIFIER then
               T.Assert (Objects.Get_Value (Key) = PrevId + 1, "Invalid allocated identifier: "
                         & Objects.To_String (Key) & " previous=" & Identifier'Image (PrevId));
            end if;
            PrevId := Objects.Get_Value (Key);
         end;
      end loop;
      Util.Measures.Report (S, "Allocate 200 ids");
   end Test_Allocate;

   --  ------------------------------
   --  Check:
   --    Object.Save (with creation)
   --    Object.Find
   --    Object.Save (update)
   --  ------------------------------
   procedure Test_Create_Save (T : in out Test) is
      use type ADO.Sessions.Connection_Status;

      DB   : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      Ref  : Regtests.Simple.Model.Allocate_Ref;
      Ref2 : Regtests.Simple.Model.Allocate_Ref;
   begin
      T.Assert (DB.Get_Status = ADO.Sessions.OPEN,
                "The database connection is open");

      Ref.Set_Name ("Testing the allocation");
      Ref.Save (DB);
      T.Assert (Ref.Get_Id > 0, "Object must have an id");

      Ref.Set_Name ("Testing the allocation: update");
      Ref.Save (DB);

      Ref2.Load (DB, Ref.Get_Id);

   end Test_Create_Save;

   --  ------------------------------
   --  Check:
   --    Object.Save (with creation)
   --  ------------------------------
   procedure Test_Perf_Create_Save (T : in out Test) is
      DB : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      S  : Util.Measures.Stamp;
   begin
      DB.Begin_Transaction;
      for I in 1 .. 1_000 loop
         declare
            Ref  : Regtests.Simple.Model.Allocate_Ref;
         begin
            Ref.Set_Name ("Testing the allocation");
            Ref.Save (DB);
            T.Assert (Ref.Get_Id > 0, "Object must have an id");
         end;
      end loop;
      DB.Commit;
      Util.Measures.Report (S, "Create 1000 rows");
   end Test_Perf_Create_Save;

   procedure Test_Delete_All (T : in out Test) is

      DB : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      Stmt : ADO.Statements.Delete_Statement
        := DB.Create_Statement (Regtests.Simple.Model.ALLOCATE_TABLE);
      Result : Natural;
   begin
      DB.Begin_Transaction;
      Stmt.Execute (Result);
      Log.Info ("Deleted {0} rows", Natural'Image (Result));
      DB.Commit;

      T.Assert (Result > 100, "Too few rows were deleted");
   end Test_Delete_All;

   --  ------------------------------
   --  Test string insert.
   --  ------------------------------
   procedure Test_String (T : in out Test) is
      use Ada.Strings.Unbounded;

      DB   : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      User : Regtests.Simple.Model.User_Ref;
      Usr2 : Regtests.Simple.Model.User_Ref;
      Name : Unbounded_String;
   begin
      for I in 1 .. 127 loop
         Append (Name, Character'Val (I));
      end loop;
      Append (Name, ' ');
      Append (Name, ' ');
      Append (Name, ' ');
      Append (Name, ' ');
      DB.Begin_Transaction;
      User.Set_Name (Name);
      User.Save (DB);
      DB.Commit;

      --  Check that we can load the image and the blob.
      Usr2.Load (DB, User.Get_Id);
      Util.Tests.Assert_Equals (T, To_String (Name), String '(Usr2.Get_Name),
                                "Invalid name inserted for user");
   end Test_String;

   --  ------------------------------
   --  Test blob insert.
   --  ------------------------------
   procedure Test_Blob (T : in out Test) is
      use Ada.Streams;

      procedure Assert_Equals is
        new Util.Assertions.Assert_Equals_T (Ada.Streams.Stream_Element);

      DB   : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      Img  : Regtests.Images.Model.Image_Ref;
      Size : constant Natural := 100;
      Data : ADO.Blob_Ref := ADO.Create_Blob (Size);
      Img2 : Regtests.Images.Model.Image_Ref;
   begin
      for I in 1 .. Size loop
         Data.Value.Data (Ada.Streams.Stream_Element_Offset (I)) := Integer'Pos ((64 + I) mod 255);
      end loop;
      DB.Begin_Transaction;
      Img.Set_Image (Data);
      Img.Set_Create_Date (Ada.Calendar.Clock);
      Img.Save (DB);
      DB.Commit;

      --  Check that we can load the image and the blob.
      Img2.Load (DB, Img.Get_Id);
      T.Assert (Img2.Get_Image.Is_Null = False, "No image blob loaded");

      --  And verify that the blob data matches what we inserted.
      Util.Tests.Assert_Equals (T, Size, Integer (Img2.Get_Image.Value.Len),
                                "Invalid blob length");
      for I in 1 .. Data.Value.Len loop
         Assert_Equals (T, Data.Value.Data (I), Img2.Get_Image.Value.Data (I),
                        "Invalid blob content at " & Stream_Element_Offset'Image (I));
      end loop;

      --  Create a blob initialized with a file content.
      Data := ADO.Create_Blob ("Makefile");
      T.Assert (not Data.Is_Null, "Null blob returned by Create_Blob");
      T.Assert (Data.Value.Len > 100, "Blob length initialized from file is too small");

      declare
         Content : Ada.Streams.Stream_Element_Array (1 .. 10);
         Img3    : Regtests.Images.Model.Image_Ref;
      begin
         for I in Content'Range loop
            Content (I) := Ada.Streams.Stream_Element_Offset'Pos (I + 30);
         end loop;
         Data := ADO.Create_Blob (Content);
         T.Assert (not Data.Is_Null, "Null blob returned by Create_Blob (Stream_Element_Array)");
         T.Assert (Data.Value.Len = 10, "Blob length initialized from array is too small");

         DB.Begin_Transaction;
         Img3.Set_Image (Data);
         Img3.Set_Create_Date (Ada.Calendar.Clock);
         Img3.Save (DB);
         DB.Commit;

         --  Check that we can load the image and the blob.
         Img2.Load (DB, Img3.Get_Id);
         T.Assert (Img2.Get_Image.Is_Null = False, "No image blob loaded");

         Img2.Set_Image (ADO.Null_Blob);
         Img2.Save (DB);
         DB.Commit;
      end;
   end Test_Blob;

   --  ------------------------------
   --  Test the To_Object and To_Identifier operations.
   --  ------------------------------
   procedure Test_Identifier_To_Object (T : in out Test) is
      Val : Util.Beans.Objects.Object := ADO.Utils.To_Object (ADO.NO_IDENTIFIER);
   begin
      T.Assert (Util.Beans.Objects.Is_Null (Val),
                "To_Object must return null for ADO.NO_IDENTIFIER");
      T.Assert (ADO.Utils.To_Identifier (Val) = ADO.NO_IDENTIFIER,
                "To_Identifier must return ADO.NO_IDENTIFIER for null");
      Val := ADO.Utils.To_Object (1);
      T.Assert (not Util.Beans.Objects.Is_Null (Val),
                "To_Object must not return null for a valid Identifier");
      T.Assert (ADO.Utils.To_Identifier (Val) = 1,
                "To_Identifier must return the correct identifier");
   end Test_Identifier_To_Object;

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Object_Ref.Load", Test_Load'Access);
      Caller.Add_Test (Suite, "Test Object_Ref.Save", Test_Create_Load'Access);
      Caller.Add_Test (Suite, "Test Master_Connection init error", Test_Not_Open'Access);
      Caller.Add_Test (Suite, "Test Sequences.Factory", Test_Allocate'Access);
      Caller.Add_Test (Suite, "Test Object_Ref.Save/Create/Update",
                       Test_Create_Save'Access);
      Caller.Add_Test (Suite, "Test Object_Ref.Create (DB Insert)",
                       Test_Perf_Create_Save'Access);
      Caller.Add_Test (Suite, "Test Statement.Delete_Statement (delete all)",
                       Test_Delete_All'Access);
      Caller.Add_Test (Suite, "Test insert string",
                       Test_String'Access);
      Caller.Add_Test (Suite, "Test insert blob",
                       Test_Blob'Access);
      Caller.Add_Test (Suite, "Test ADO.Utils.To_Object/To_Identifier",
                       Test_Identifier_To_Object'Access);
   end Add_Tests;

end ADO.Tests;

-----------------------------------------------------------------------
--  ADO Sequences -- Database sequence generator
--  Copyright (C) 2009, 2010, 2011, 2012, 2015, 2017, 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.Exceptions;
with Ada.Calendar;

with ADO.Statements;
with ADO.Objects;
with ADO.Sessions;
with ADO.Utils;
with Regtests;

with Regtests.Simple.Model;
with Regtests.Images.Model;

with Util.Assertions;
with Util.Measures;
with Util.Log;
with Util.Log.Loggers;
with Util.Beans.Objects;
with Util.Test_Caller;

package body ADO.Tests is

   use Ada.Exceptions;
   use ADO.Statements;

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

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

   procedure Assert_Has_Message (T : in Test;
                                 E : in Exception_Occurrence);

   procedure Assert_Has_Message (T : in Test;
                                 E : in Exception_Occurrence) is
      Message : constant String := Exception_Message (E);
   begin
      Log.Info ("Exception: {0}", Message);
      T.Assert (Message'Length > 0,
                "Exception " & Exception_Name (E) & " does not have any message");
   end Assert_Has_Message;

   procedure Set_Up (T : in out Test) is
   begin
      null;
   end Set_Up;

   --  ------------------------------
   --  Check:
   --     Object_Ref.Load
   --     Object_Ref.Is_Null
   --  ------------------------------
   procedure Test_Load (T : in out Test) is

      DB  : ADO.Sessions.Session := Regtests.Get_Database;

      Object : Regtests.Simple.Model.User_Ref;
   begin
      T.Assert (Object.Is_Null, "Object_Ref.Is_Null: Empty object must be null");

      Object.Load (DB, -1);
      T.Assert (False, "Object_Ref.Load: Load must raise NOT_FOUND exception");

   exception
      when ADO.Objects.NOT_FOUND =>
         T.Assert (Object.Is_Null, "Object_Ref.Load: Must not change the object");
   end Test_Load;

   --  ------------------------------
   --  Check:
   --    Object_Ref.Load
   --    Object_Ref.Save
   --    <Model>.Set_xxx (Unbounded_String)
   --    <Model>.Create
   --  ------------------------------
   procedure Test_Create_Load (T : in out Test) is

      DB     : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;

      Object : Regtests.Simple.Model.User_Ref;
      Check  : Regtests.Simple.Model.User_Ref;
   begin
      --  Initialize and save an object
      Object.Set_Name ("A simple test name");
      Object.Save (DB);

      T.Assert (Object.Get_Id > 0, "Saving an object did not allocate an identifier");

      --  Load the object
      Check.Load (DB, Object.Get_Id);
      T.Assert (not Check.Is_Null, "Object_Ref.Load: Loading the object failed");
   end Test_Create_Load;

   --  ------------------------------
   --  Check:
   --    Various error checks on database connections
   --
   --    Master_Connection.Rollback
   --  ------------------------------
   procedure Test_Not_Open (T : in out Test) is
      DB : ADO.Sessions.Master_Session;
   begin
      begin
         DB.Rollback;
         T.Fail ("Master_Connection.Rollback should raise an exception");

      exception
         when E : ADO.Sessions.NOT_OPEN =>
            Assert_Has_Message (T, E);
      end;

      begin
         DB.Commit;
         T.Fail ("Master_Connection.Commit should raise an exception");

      exception
         when E : ADO.Sessions.NOT_OPEN =>
            Assert_Has_Message (T, E);
      end;

   end Test_Not_Open;

   --  ------------------------------
   --  Check id generation
   --  ------------------------------
   procedure Test_Allocate (T : in out Test) is
      DB     : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      Key    : ADO.Objects.Object_Key (Of_Type => ADO.Objects.KEY_INTEGER,
                                       Of_Class => Regtests.Simple.Model.ALLOCATE_TABLE);
      PrevId : Identifier := NO_IDENTIFIER;
      S      : Util.Measures.Stamp;
   begin
      for I in 1 .. 200 loop
         declare
            Obj : Regtests.Simple.Model.Allocate_Ref;
         begin
            Obj.Save (DB);
            Key := Obj.Get_Key;
            if PrevId /= NO_IDENTIFIER then
               T.Assert (Objects.Get_Value (Key) = PrevId + 1, "Invalid allocated identifier: "
                         & Objects.To_String (Key) & " previous=" & Identifier'Image (PrevId));
            end if;
            PrevId := Objects.Get_Value (Key);
         end;
      end loop;
      Util.Measures.Report (S, "Allocate 200 ids");
   end Test_Allocate;

   --  ------------------------------
   --  Check:
   --    Object.Save (with creation)
   --    Object.Find
   --    Object.Save (update)
   --  ------------------------------
   procedure Test_Create_Save (T : in out Test) is
      use type ADO.Sessions.Connection_Status;

      DB   : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      Ref  : Regtests.Simple.Model.Allocate_Ref;
      Ref2 : Regtests.Simple.Model.Allocate_Ref;
   begin
      T.Assert (DB.Get_Status = ADO.Sessions.OPEN,
                "The database connection is open");

      Ref.Set_Name ("Testing the allocation");
      Ref.Save (DB);
      T.Assert (Ref.Get_Id > 0, "Object must have an id");

      Ref.Set_Name ("Testing the allocation: update");
      Ref.Save (DB);

      Ref2.Load (DB, Ref.Get_Id);

   end Test_Create_Save;

   --  ------------------------------
   --  Check:
   --    Object.Save (with creation)
   --  ------------------------------
   procedure Test_Perf_Create_Save (T : in out Test) is
      DB : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      S  : Util.Measures.Stamp;
   begin
      DB.Begin_Transaction;
      for I in 1 .. 1_000 loop
         declare
            Ref  : Regtests.Simple.Model.Allocate_Ref;
         begin
            Ref.Set_Name ("Testing the allocation");
            Ref.Save (DB);
            T.Assert (Ref.Get_Id > 0, "Object must have an id");
         end;
      end loop;
      DB.Commit;
      Util.Measures.Report (S, "Create 1000 rows");
   end Test_Perf_Create_Save;

   procedure Test_Delete_All (T : in out Test) is

      DB : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      Stmt : ADO.Statements.Delete_Statement
        := DB.Create_Statement (Regtests.Simple.Model.ALLOCATE_TABLE);
      Result : Natural;
   begin
      DB.Begin_Transaction;
      Stmt.Execute (Result);
      Log.Info ("Deleted {0} rows", Natural'Image (Result));
      DB.Commit;

      T.Assert (Result > 100, "Too few rows were deleted");
   end Test_Delete_All;

   --  ------------------------------
   --  Test string insert.
   --  ------------------------------
   procedure Test_String (T : in out Test) is
      use Ada.Strings.Unbounded;

      DB   : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      User : Regtests.Simple.Model.User_Ref;
      Usr2 : Regtests.Simple.Model.User_Ref;
      Name : Nullable_String;
   begin
      Name.Is_Null := False;
      for I in 1 .. 127 loop
         Append (Name.Value, Character'Val (I));
      end loop;
      Append (Name.Value, ' ');
      Append (Name.Value, ' ');
      Append (Name.Value, ' ');
      Append (Name.Value, ' ');
      DB.Begin_Transaction;
      User.Set_Name (Name);
      User.Save (DB);
      DB.Commit;

      --  Check that we can load the image and the blob.
      Usr2.Load (DB, User.Get_Id);
      Util.Tests.Assert_Equals (T, To_String (Name.Value), String '(Usr2.Get_Name),
                                "Invalid name inserted for user");
   end Test_String;

   --  ------------------------------
   --  Test blob insert.
   --  ------------------------------
   procedure Test_Blob (T : in out Test) is
      use Ada.Streams;

      procedure Assert_Equals is
        new Util.Assertions.Assert_Equals_T (Ada.Streams.Stream_Element);

      DB   : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      Img  : Regtests.Images.Model.Image_Ref;
      Size : constant Natural := 100;
      Data : ADO.Blob_Ref := ADO.Create_Blob (Size);
      Img2 : Regtests.Images.Model.Image_Ref;
   begin
      for I in 1 .. Size loop
         Data.Value.Data (Ada.Streams.Stream_Element_Offset (I)) := Integer'Pos ((64 + I) mod 255);
      end loop;
      DB.Begin_Transaction;
      Img.Set_Image (Data);
      Img.Set_Create_Date (Ada.Calendar.Clock);
      Img.Save (DB);
      DB.Commit;

      --  Check that we can load the image and the blob.
      Img2.Load (DB, Img.Get_Id);
      T.Assert (Img2.Get_Image.Is_Null = False, "No image blob loaded");

      --  And verify that the blob data matches what we inserted.
      Util.Tests.Assert_Equals (T, Size, Integer (Img2.Get_Image.Value.Len),
                                "Invalid blob length");
      for I in 1 .. Data.Value.Len loop
         Assert_Equals (T, Data.Value.Data (I), Img2.Get_Image.Value.Data (I),
                        "Invalid blob content at " & Stream_Element_Offset'Image (I));
      end loop;

      --  Create a blob initialized with a file content.
      Data := ADO.Create_Blob ("Makefile");
      T.Assert (not Data.Is_Null, "Null blob returned by Create_Blob");
      T.Assert (Data.Value.Len > 100, "Blob length initialized from file is too small");

      declare
         Content : Ada.Streams.Stream_Element_Array (1 .. 10);
         Img3    : Regtests.Images.Model.Image_Ref;
      begin
         for I in Content'Range loop
            Content (I) := Ada.Streams.Stream_Element_Offset'Pos (I + 30);
         end loop;
         Data := ADO.Create_Blob (Content);
         T.Assert (not Data.Is_Null, "Null blob returned by Create_Blob (Stream_Element_Array)");
         T.Assert (Data.Value.Len = 10, "Blob length initialized from array is too small");

         DB.Begin_Transaction;
         Img3.Set_Image (Data);
         Img3.Set_Create_Date (Ada.Calendar.Clock);
         Img3.Save (DB);
         DB.Commit;

         --  Check that we can load the image and the blob.
         Img2.Load (DB, Img3.Get_Id);
         T.Assert (Img2.Get_Image.Is_Null = False, "No image blob loaded");

         Img2.Set_Image (ADO.Null_Blob);
         Img2.Save (DB);
         DB.Commit;
      end;
   end Test_Blob;

   --  ------------------------------
   --  Test the To_Object and To_Identifier operations.
   --  ------------------------------
   procedure Test_Identifier_To_Object (T : in out Test) is
      Val : Util.Beans.Objects.Object := ADO.Utils.To_Object (ADO.NO_IDENTIFIER);
   begin
      T.Assert (Util.Beans.Objects.Is_Null (Val),
                "To_Object must return null for ADO.NO_IDENTIFIER");
      T.Assert (ADO.Utils.To_Identifier (Val) = ADO.NO_IDENTIFIER,
                "To_Identifier must return ADO.NO_IDENTIFIER for null");
      Val := ADO.Utils.To_Object (1);
      T.Assert (not Util.Beans.Objects.Is_Null (Val),
                "To_Object must not return null for a valid Identifier");
      T.Assert (ADO.Utils.To_Identifier (Val) = 1,
                "To_Identifier must return the correct identifier");
   end Test_Identifier_To_Object;

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Object_Ref.Load", Test_Load'Access);
      Caller.Add_Test (Suite, "Test Object_Ref.Save", Test_Create_Load'Access);
      Caller.Add_Test (Suite, "Test Master_Connection init error", Test_Not_Open'Access);
      Caller.Add_Test (Suite, "Test Sequences.Factory", Test_Allocate'Access);
      Caller.Add_Test (Suite, "Test Object_Ref.Save/Create/Update",
                       Test_Create_Save'Access);
      Caller.Add_Test (Suite, "Test Object_Ref.Create (DB Insert)",
                       Test_Perf_Create_Save'Access);
      Caller.Add_Test (Suite, "Test Statement.Delete_Statement (delete all)",
                       Test_Delete_All'Access);
      Caller.Add_Test (Suite, "Test insert string",
                       Test_String'Access);
      Caller.Add_Test (Suite, "Test insert blob",
                       Test_Blob'Access);
      Caller.Add_Test (Suite, "Test ADO.Utils.To_Object/To_Identifier",
                       Test_Identifier_To_Object'Access);
   end Add_Tests;

end ADO.Tests;

Fix to use the Nullable_String type

Fix to use the Nullable_String type


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

with GNAT.Command_Line;

with Readline;

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

with MAT.Commands;
with MAT.Targets.Readers;
package body MAT.Targets is

   --  ------------------------------
   --  Get the console instance.
   --  ------------------------------
   function Console (Target : in Target_Type) return MAT.Consoles.Console_Access is
   begin
      return Target.Console;
   end Console;

   --  ------------------------------
   --  Set the console instance.
   --  ------------------------------
   procedure Console (Target  : in out Target_Type;
                      Console : in MAT.Consoles.Console_Access) is
   begin
      Target.Console := Console;
   end Console;

   --  ------------------------------
   --  Get the current process instance.
   --  ------------------------------
   function Process (Target : in Target_Type) return Target_Process_Type_Access is
   begin
      return Target.Current;
   end Process;

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

   --  ------------------------------
   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   --  ------------------------------
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Path    : in Ada.Strings.Unbounded.Unbounded_String;
                             Process : out Target_Process_Type_Access) is
      Path_String : constant String := Ada.Strings.Unbounded.To_String (Path);
   begin
      Process := Target.Find_Process (Pid);
      if Process = null then
         Process := new Target_Process_Type;
         Process.Pid := Pid;
         Process.Path := Path;
         Process.Symbols := MAT.Symbols.Targets.Target_Symbols_Refs.Create;
         Target.Processes.Insert (Pid, Process);
         Target.Console.Notice (MAT.Consoles.N_PID_INFO,
                                "Process" & MAT.Types.Target_Process_Ref'Image (Pid) & " created");
         Target.Console.Notice (MAT.Consoles.N_PATH_INFO,
                                "Path " & Path_String);
      end if;
      if Target.Current = null then
         Target.Current := Process;
      end if;
      if Target.Options.Load_Symbols then
         MAT.Commands.Symbol_Command (Target, Path_String);
      end if;
   end Create_Process;

   --  ------------------------------
   --  Find the process instance from the process ID.
   --  ------------------------------
   function Find_Process (Target : in Target_Type;
                          Pid    : in MAT.Types.Target_Process_Ref)
                          return Target_Process_Type_Access is
      Pos : constant Process_Cursor := Target.Processes.Find (Pid);
   begin
      if Process_Maps.Has_Element (Pos) then
         return Process_Maps.Element (Pos);
      else
         return null;
      end if;
   end Find_Process;

   --  ------------------------------
   --  Iterate over the list of connected processes and execute the <tt>Process</tt> procedure.
   --  ------------------------------
   procedure Iterator (Target  : in Target_Type;
                       Process : access procedure (Proc : in Target_Process_Type'Class)) is
      Iter : Process_Cursor := Target.Processes.First;
   begin
      while Process_Maps.Has_Element (Iter) loop
         Process (Process_Maps.Element (Iter).all);
         Process_Maps.Next (Iter);
      end loop;
   end Iterator;

   --  ------------------------------
   --  Convert the string to a socket address.  The string can have two forms:
   --     port
   --     host:port
   --  ------------------------------
   function To_Sock_Addr_Type (Param : in String) return GNAT.Sockets.Sock_Addr_Type is
      Pos    : constant Natural := Util.Strings.Index (Param, ':');
      Result : GNAT.Sockets.Sock_Addr_Type;
   begin
      if Pos > 0 then
         Result.Port := GNAT.Sockets.Port_Type'Value (Param (Pos + 1 .. Param'Last));
         Result.Addr := GNAT.Sockets.Inet_Addr (Param (Param'First .. Pos - 1));
      else
         Result.Port := GNAT.Sockets.Port_Type'Value (Param);
         Result.Addr := GNAT.Sockets.Any_Inet_Addr;
      end if;
      return Result;
   end To_Sock_Addr_Type;

   --  ------------------------------
   --  Print the application usage.
   --  ------------------------------
   procedure Usage is
      use Ada.Text_IO;
   begin
      Put_Line ("Usage: mat [-i] [-e] [-nw] [-ns] [-b [ip:]port] [file.mat]");
      Put_Line ("-i            Enable the interactive mode");
      Put_Line ("-e            Print the probe events as they are received");
      Put_Line ("-nw           Disable the graphical mode");
      Put_Line ("-b [ip:]port  Define the port and local address to bind");
      Put_Line ("-ns           Disable the automatic symbols loading");
      Ada.Command_Line.Set_Exit_Status (2);
      raise Usage_Error;
   end Usage;

   --  ------------------------------
   --  Parse the command line arguments and configure the target instance.
   --  ------------------------------
   procedure Initialize_Options (Target  : in out MAT.Targets.Target_Type) is
   begin
      Util.Log.Loggers.Initialize ("matp.properties");
      GNAT.Command_Line.Initialize_Option_Scan (Stop_At_First_Non_Switch => True,
                                                Section_Delimiters       => "targs");
      loop
         case GNAT.Command_Line.Getopt ("i e nw ns b:") is
            when ASCII.NUL =>
               exit;

            when 'i' =>
               Target.Options.Interactive := True;

            when 'e' =>
               Target.Options.Print_Events := True;

            when 'b' =>
               Target.Options.Address := To_Sock_Addr_Type (GNAT.Command_Line.Parameter);

            when 'n' =>
               if GNAT.Command_Line.Full_Switch = "nw" then
                  Target.Options.Graphical := False;
               else
                  Target.Options.Load_Symbols := False;
               end if;

            when '*' =>
               exit;

            when others =>
               Usage;

         end case;
      end loop;

   exception
      when Usage_Error =>
         raise;

      when others =>
         Usage;

   end Initialize_Options;

   --  ------------------------------
   --  Enter in the interactive loop reading the commands from the standard input
   --  and executing the commands.
   --  ------------------------------
   procedure Interactive (Target : in out MAT.Targets.Target_Type) is
   begin
      loop
         declare
            Line : constant String := Readline.Get_Line ("matp>");
         begin
            MAT.Commands.Execute (Target, Line);

         exception
            when MAT.Commands.Stop_Interp =>
               exit;
         end;
      end loop;
   end Interactive;

   --  ------------------------------
   --  Start the server to listen to MAT event socket streams.
   --  ------------------------------
   procedure Start (Target : in out Target_Type) is
   begin
      Target.Server.Start (Target'Unchecked_Access, Target.Options.Address);
   end Start;

   --  ------------------------------
   --  Stop the server thread.
   --  ------------------------------
   procedure Stop (Target : in out Target_Type) is
   begin
      Target.Server.Stop;
   end Stop;

end MAT.Targets;

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

with GNAT.Command_Line;

with Readline;

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

with MAT.Commands;
with MAT.Targets.Probes;
package body MAT.Targets is

   --  ------------------------------
   --  Get the console instance.
   --  ------------------------------
   function Console (Target : in Target_Type) return MAT.Consoles.Console_Access is
   begin
      return Target.Console;
   end Console;

   --  ------------------------------
   --  Set the console instance.
   --  ------------------------------
   procedure Console (Target  : in out Target_Type;
                      Console : in MAT.Consoles.Console_Access) is
   begin
      Target.Console := Console;
   end Console;

   --  ------------------------------
   --  Get the current process instance.
   --  ------------------------------
   function Process (Target : in Target_Type) return Target_Process_Type_Access is
   begin
      return Target.Current;
   end Process;

   --  ------------------------------
   --  Initialize the target object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory and other events.
   --  ------------------------------
   procedure Initialize (Target : in out Target_Type;
                         Reader : in out MAT.Events.Probes.Probe_Manager_Type'Class) is
   begin
      MAT.Targets.Probes.Initialize (Target  => Target,
                                     Manager => Reader);
   end Initialize;

   --  ------------------------------
   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   --  ------------------------------
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Path    : in Ada.Strings.Unbounded.Unbounded_String;
                             Process : out Target_Process_Type_Access) is
      Path_String : constant String := Ada.Strings.Unbounded.To_String (Path);
   begin
      Process := Target.Find_Process (Pid);
      if Process = null then
         Process := new Target_Process_Type;
         Process.Pid := Pid;
         Process.Path := Path;
         Process.Symbols := MAT.Symbols.Targets.Target_Symbols_Refs.Create;
         Target.Processes.Insert (Pid, Process);
         Target.Console.Notice (MAT.Consoles.N_PID_INFO,
                                "Process" & MAT.Types.Target_Process_Ref'Image (Pid) & " created");
         Target.Console.Notice (MAT.Consoles.N_PATH_INFO,
                                "Path " & Path_String);
      end if;
      if Target.Current = null then
         Target.Current := Process;
      end if;
      if Target.Options.Load_Symbols then
         MAT.Commands.Symbol_Command (Target, Path_String);
      end if;
   end Create_Process;

   --  ------------------------------
   --  Find the process instance from the process ID.
   --  ------------------------------
   function Find_Process (Target : in Target_Type;
                          Pid    : in MAT.Types.Target_Process_Ref)
                          return Target_Process_Type_Access is
      Pos : constant Process_Cursor := Target.Processes.Find (Pid);
   begin
      if Process_Maps.Has_Element (Pos) then
         return Process_Maps.Element (Pos);
      else
         return null;
      end if;
   end Find_Process;

   --  ------------------------------
   --  Iterate over the list of connected processes and execute the <tt>Process</tt> procedure.
   --  ------------------------------
   procedure Iterator (Target  : in Target_Type;
                       Process : access procedure (Proc : in Target_Process_Type'Class)) is
      Iter : Process_Cursor := Target.Processes.First;
   begin
      while Process_Maps.Has_Element (Iter) loop
         Process (Process_Maps.Element (Iter).all);
         Process_Maps.Next (Iter);
      end loop;
   end Iterator;

   --  ------------------------------
   --  Convert the string to a socket address.  The string can have two forms:
   --     port
   --     host:port
   --  ------------------------------
   function To_Sock_Addr_Type (Param : in String) return GNAT.Sockets.Sock_Addr_Type is
      Pos    : constant Natural := Util.Strings.Index (Param, ':');
      Result : GNAT.Sockets.Sock_Addr_Type;
   begin
      if Pos > 0 then
         Result.Port := GNAT.Sockets.Port_Type'Value (Param (Pos + 1 .. Param'Last));
         Result.Addr := GNAT.Sockets.Inet_Addr (Param (Param'First .. Pos - 1));
      else
         Result.Port := GNAT.Sockets.Port_Type'Value (Param);
         Result.Addr := GNAT.Sockets.Any_Inet_Addr;
      end if;
      return Result;
   end To_Sock_Addr_Type;

   --  ------------------------------
   --  Print the application usage.
   --  ------------------------------
   procedure Usage is
      use Ada.Text_IO;
   begin
      Put_Line ("Usage: mat [-i] [-e] [-nw] [-ns] [-b [ip:]port] [file.mat]");
      Put_Line ("-i            Enable the interactive mode");
      Put_Line ("-e            Print the probe events as they are received");
      Put_Line ("-nw           Disable the graphical mode");
      Put_Line ("-b [ip:]port  Define the port and local address to bind");
      Put_Line ("-ns           Disable the automatic symbols loading");
      Ada.Command_Line.Set_Exit_Status (2);
      raise Usage_Error;
   end Usage;

   --  ------------------------------
   --  Parse the command line arguments and configure the target instance.
   --  ------------------------------
   procedure Initialize_Options (Target  : in out MAT.Targets.Target_Type) is
   begin
      Util.Log.Loggers.Initialize ("matp.properties");
      GNAT.Command_Line.Initialize_Option_Scan (Stop_At_First_Non_Switch => True,
                                                Section_Delimiters       => "targs");
      loop
         case GNAT.Command_Line.Getopt ("i e nw ns b:") is
            when ASCII.NUL =>
               exit;

            when 'i' =>
               Target.Options.Interactive := True;

            when 'e' =>
               Target.Options.Print_Events := True;

            when 'b' =>
               Target.Options.Address := To_Sock_Addr_Type (GNAT.Command_Line.Parameter);

            when 'n' =>
               if GNAT.Command_Line.Full_Switch = "nw" then
                  Target.Options.Graphical := False;
               else
                  Target.Options.Load_Symbols := False;
               end if;

            when '*' =>
               exit;

            when others =>
               Usage;

         end case;
      end loop;

   exception
      when Usage_Error =>
         raise;

      when others =>
         Usage;

   end Initialize_Options;

   --  ------------------------------
   --  Enter in the interactive loop reading the commands from the standard input
   --  and executing the commands.
   --  ------------------------------
   procedure Interactive (Target : in out MAT.Targets.Target_Type) is
   begin
      loop
         declare
            Line : constant String := Readline.Get_Line ("matp>");
         begin
            MAT.Commands.Execute (Target, Line);

         exception
            when MAT.Commands.Stop_Interp =>
               exit;
         end;
      end loop;
   end Interactive;

   --  ------------------------------
   --  Start the server to listen to MAT event socket streams.
   --  ------------------------------
   procedure Start (Target : in out Target_Type) is
   begin
      Target.Server.Start (Target'Unchecked_Access, Target.Options.Address);
   end Start;

   --  ------------------------------
   --  Stop the server thread.
   --  ------------------------------
   procedure Stop (Target : in out Target_Type) is
   begin
      Target.Server.Stop;
   end Stop;

end MAT.Targets;

Use the MAT.Targets.Probes package

Use the MAT.Targets.Probes package