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

with GNAT.MD5;

with Util.Log.Loggers;
with Util.Beans.Basic;
with Util.Strings.Transforms;

with EL.Functions;

with ASF.Applications.Main;

with ADO.Queries;
with ADO.Sessions;

with AWA.Applications.Factory;
with AWA.Services.Contexts;
with Atlas.Applications.Models;

--  with Atlas.XXX.Module;
package body Atlas.Applications is

   package ASC renames AWA.Services.Contexts;

   use AWA.Applications;

   type User_Stat_Info_Access is access all Atlas.Applications.Models.User_Stat_Info;

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

   procedure Set_Functions (Mapper : in out EL.Functions.Function_Mapper'Class);
   function Create_User_Stat_Bean return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Create the user statistics bean which indicates what feature the user has used.
   --  ------------------------------
   function Create_User_Stat_Bean return Util.Beans.Basic.Readonly_Bean_Access is
      use type ASC.Service_Context_Access;

      Ctx    : constant ASC.Service_Context_Access := ASC.Current;
      Result : User_Stat_Info_Access;
   begin
      if Ctx /= null then
         declare
            List    : Atlas.Applications.Models.User_Stat_Info_List_Bean;
            Session : ADO.Sessions.Session := ASC.Get_Session (Ctx);
            User    : constant ADO.Identifier := Ctx.Get_User_Identifier;
            Query   : ADO.Queries.Context;
         begin
            Query.Set_Query (Atlas.Applications.Models.Query_User_Stat);
            Query.Bind_Param ("user_id", User);
            Atlas.Applications.Models.List (List, Session, Query);

            Result := new Atlas.Applications.Models.User_Stat_Info;
            Result.all := List.List.Element (1);
         end;
      else
         Result := new Atlas.Applications.Models.User_Stat_Info;
         Result.Post_Count     := 0;
         Result.Document_Count := 0;
         Result.Question_Count := 0;
         Result.Answer_Count   := 0;
      end if;
      return Result.all'Access;
   end Create_User_Stat_Bean;

   --  ------------------------------
   --  Given an Email address, return the Gravatar link to the user image.
   --  (See http://en.gravatar.com/site/implement/hash/ and
   --  http://en.gravatar.com/site/implement/images/)
   --  ------------------------------
   function Get_Gravatar_Link (Email : in String) return String is
      E : constant String := Util.Strings.Transforms.To_Lower_Case (Email);
      C : constant GNAT.MD5.Message_Digest := GNAT.MD5.Digest (E);
   begin
      return "http://www.gravatar.com/avatar/" & C;
   end Get_Gravatar_Link;

   --  ------------------------------
   --  EL function to convert an Email address to a Gravatar image.
   --  ------------------------------
   function To_Gravatar_Link (Email : in Util.Beans.Objects.Object)
                              return Util.Beans.Objects.Object is
      Link : constant String := Get_Gravatar_Link (Util.Beans.Objects.To_String (Email));
   begin
      return Util.Beans.Objects.To_Object (Link);
   end To_Gravatar_Link;

   procedure Set_Functions (Mapper : in out EL.Functions.Function_Mapper'Class) is
   begin
      Mapper.Set_Function (Name      => "gravatar",
                           Namespace => ATLAS_NS_URI,
                           Func      => To_Gravatar_Link'Access);
   end Set_Functions;

   --  ------------------------------
   --  Initialize the application:
   --

   --
Register the servlets and filters.
   --
Register the application modules.
   --
Define the servlet and filter mappings.
   --

   --  ------------------------------
   procedure Initialize (App    : in Application_Access;
                         Config : in ASF.Applications.Config) is
      Fact  : AWA.Applications.Factory.Application_Factory;
   begin
      App.Self := App;
      App.Initialize (Config, Fact);
      App.Set_Global ("contextPath", CONTEXT_PATH);
   end Initialize;

   --  ------------------------------
   --  Initialize the ASF components provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the component factories used by the application.
   --  ------------------------------
   overriding
   procedure Initialize_Components (App : in out Application) is
      procedure Register is
         new ASF.Applications.Main.Register_Functions (Set_Functions);
   begin
      Register (App);
      AWA.Applications.Application (App).Initialize_Components;
      App.Add_Converter (Name      => "smartDateConverter",
                         Converter => App.Self.Rel_Date_Converter'Access);
      App.Add_Converter (Name      => "sizeConverter",
                         Converter => App.Self.Size_Converter'Access);

      App.Register_Class (Name => "Atlas.Applications.User_Stat_Bean",
                          Handler => Create_User_Stat_Bean'Access);
   end Initialize_Components;

   --  ------------------------------
   --  Initialize the servlets provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application servlets.
   --  ------------------------------
   overriding
   procedure Initialize_Servlets (App : in out Application) is
   begin
      Log.Info ("Initializing application servlets...");

      AWA.Applications.Application (App).Initialize_Servlets;
      App.Add_Servlet (Name => "faces", Server => App.Self.Faces'Access);
      App.Add_Servlet (Name => "files", Server => App.Self.Files'Access);
      App.Add_Servlet (Name => "ajax", Server => App.Self.Ajax'Access);
      App.Add_Servlet (Name => "measures", Server => App.Self.Measures'Access);
      App.Add_Servlet (Name => "auth", Server => App.Self.Auth'Access);
      App.Add_Servlet (Name => "verify-auth", Server => App.Self.Verify_Auth'Access);
   end Initialize_Servlets;

   --  ------------------------------
   --  Initialize the filters provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application filters.
   --  ------------------------------
   overriding
   procedure Initialize_Filters (App : in out Application) is
   begin
      Log.Info ("Initializing application filters...");

      AWA.Applications.Application (App).Initialize_Filters;
      App.Add_Filter (Name => "dump", Filter => App.Self.Dump'Access);
      App.Add_Filter (Name => "measures", Filter => App.Self.Measures'Access);
      App.Add_Filter (Name => "service", Filter => App.Self.Service_Filter'Access);
      App.Add_Filter (Name => "no-cache", Filter => App.Self.No_Cache'Access);
   end Initialize_Filters;

   --  ------------------------------
   --  Initialize the AWA modules provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the modules used by the application.
   --  ------------------------------
   overriding
   procedure Initialize_Modules (App : in out Application) is
   begin
      Log.Info ("Initializing application modules...");

      Register (App    => App.Self.all'Access,
                Name   => AWA.Users.Modules.NAME,
                URI    => "user",
                Module => App.User_Module'Access);

      Register (App    => App.Self.all'Access,
                Name   => AWA.Workspaces.Modules.NAME,
                URI    => "workspaces",
                Module => App.Workspace_Module'Access);

      Register (App    => App.Self.all'Access,
                Name   => AWA.Mail.Modules.NAME,
                URI    => "mail",
                Module => App.Mail_Module'Access);

      Register (App    => App.Self.all'Access,
                Name   => AWA.Counters.Modules.NAME,
                Module => App.Counter_Module'Access);

      Register (App    => App.Self.all'Access,
                Name   => AWA.Jobs.Modules.NAME,
                URI    => "jobs",
                Module => App.Job_Module'Access);

      Register (App    => App.Self.all'Access,
                Name   => AWA.Tags.Modules.NAME,
                URI    => "tags",
                Module => App.Tag_Module'Access);

      Register (App    => App.Self.all'Access,
                Name   => AWA.Comments.Modules.NAME,
                URI    => "comments",
                Module => App.Comment_Module'Access);

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

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

      Register (App    => App.Self.all'Access,
                Name   => AWA.Images.Modules.NAME,
                URI    => "images",
                Module => App.Image_Module'Access);

      Register (App    => App.Self.all'Access,
                Name   => AWA.Votes.Modules.NAME,
                URI    => "votes",
                Module => App.Vote_Module'Access);

      Register (App    => App.Self.all'Access,
                Name   => AWA.Questions.Modules.NAME,
                URI    => "questions",
                Module => App.Question_Module'Access);

      Register (App    => App.Self.all'Access,
                Name   => AWA.Wikis.Modules.NAME,
                URI    => "wikis",
                Module => App.Wiki_Module'Access);

      Register (App    => App.Self.all'Access,
                Name   => AWA.Wikis.Previews.NAME,
                URI    => "wikis-preview",
                Module => App.Preview_Module'Access);

      Register (App    => App.Self.all'Access,
                Name   => Atlas.Microblog.Modules.NAME,
                URI    => "microblog",
                Module => App.Microblog_Module'Access);

      Register (App    => App.Self.all'Access,
                Name   => Atlas.Reviews.Modules.NAME,
                URI    => "reviews",
                Module => App.Review_Module'Access);
   end Initialize_Modules;

end Atlas.Applications;

-----------------------------------------------------------------------
--  atlas -- atlas applications
-----------------------------------------------------------------------
--  Copyright (C) 2012, 2013, 2014, 2015, 2016, 2017, 2020 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 GNAT.MD5;

with Util.Log.Loggers;
with Util.Beans.Basic;
with Util.Strings.Transforms;

with EL.Functions;

with ASF.Applications.Main;

with ADO.Queries;
with ADO.Sessions;

with AWA.Applications.Factory;
with AWA.Services.Contexts;
with Atlas.Applications.Models;

--  with Atlas.XXX.Module;
package body Atlas.Applications is

   package ASC renames AWA.Services.Contexts;

   use AWA.Applications;

   type User_Stat_Info_Access is access all Atlas.Applications.Models.User_Stat_Info;

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

   procedure Set_Functions (Mapper : in out EL.Functions.Function_Mapper'Class);
   function Create_User_Stat_Bean return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Create the user statistics bean which indicates what feature the user has used.
   --  ------------------------------
   function Create_User_Stat_Bean return Util.Beans.Basic.Readonly_Bean_Access is
      use type ASC.Service_Context_Access;

      Ctx    : constant ASC.Service_Context_Access := ASC.Current;
      Result : User_Stat_Info_Access;
   begin
      if Ctx /= null then
         declare
            List    : Atlas.Applications.Models.User_Stat_Info_List_Bean;
            Session : ADO.Sessions.Session := ASC.Get_Session (Ctx);
            User    : constant ADO.Identifier := Ctx.Get_User_Identifier;
            Query   : ADO.Queries.Context;
         begin
            Query.Set_Query (Atlas.Applications.Models.Query_User_Stat);
            Query.Bind_Param ("user_id", User);
            Atlas.Applications.Models.List (List, Session, Query);

            Result := new Atlas.Applications.Models.User_Stat_Info;
            Result.all := List.List.Element (1);
         end;
      else
         Result := new Atlas.Applications.Models.User_Stat_Info;
         Result.Post_Count     := 0;
         Result.Document_Count := 0;
         Result.Question_Count := 0;
         Result.Answer_Count   := 0;
      end if;
      return Result.all'Access;
   end Create_User_Stat_Bean;

   --  ------------------------------
   --  Given an Email address, return the Gravatar link to the user image.
   --  (See http://en.gravatar.com/site/implement/hash/ and
   --  http://en.gravatar.com/site/implement/images/)
   --  ------------------------------
   function Get_Gravatar_Link (Email : in String) return String is
      E : constant String := Util.Strings.Transforms.To_Lower_Case (Email);
      C : constant GNAT.MD5.Message_Digest := GNAT.MD5.Digest (E);
   begin
      return "http://www.gravatar.com/avatar/" & C;
   end Get_Gravatar_Link;

   --  ------------------------------
   --  EL function to convert an Email address to a Gravatar image.
   --  ------------------------------
   function To_Gravatar_Link (Email : in Util.Beans.Objects.Object)
                              return Util.Beans.Objects.Object is
      Link : constant String := Get_Gravatar_Link (Util.Beans.Objects.To_String (Email));
   begin
      return Util.Beans.Objects.To_Object (Link);
   end To_Gravatar_Link;

   procedure Set_Functions (Mapper : in out EL.Functions.Function_Mapper'Class) is
   begin
      Mapper.Set_Function (Name      => "gravatar",
                           Namespace => ATLAS_NS_URI,
                           Func      => To_Gravatar_Link'Access);
   end Set_Functions;

   --  ------------------------------
   --  Initialize the ASF components provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the component factories used by the application.
   --  ------------------------------
   overriding
   procedure Initialize_Components (App : in out Application) is
      procedure Register is
         new ASF.Applications.Main.Register_Functions (Set_Functions);
   begin
      App.Self := App'Unchecked_Access;
      App.Set_Global ("contextPath", CONTEXT_PATH);
      Register (App);
      AWA.Applications.Application (App).Initialize_Components;
      App.Add_Converter (Name      => "smartDateConverter",
                         Converter => App.Self.Rel_Date_Converter'Access);
      App.Add_Converter (Name      => "sizeConverter",
                         Converter => App.Self.Size_Converter'Access);

      App.Register_Class (Name => "Atlas.Applications.User_Stat_Bean",
                          Handler => Create_User_Stat_Bean'Access);
   end Initialize_Components;

   --  ------------------------------
   --  Initialize the servlets provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application servlets.
   --  ------------------------------
   overriding
   procedure Initialize_Servlets (App : in out Application) is
   begin
      Log.Info ("Initializing application servlets...");

      AWA.Applications.Application (App).Initialize_Servlets;
      App.Add_Servlet (Name => "faces", Server => App.Self.Faces'Access);
      App.Add_Servlet (Name => "files", Server => App.Self.Files'Access);
      App.Add_Servlet (Name => "ajax", Server => App.Self.Ajax'Access);
      App.Add_Servlet (Name => "measures", Server => App.Self.Measures'Access);
      App.Add_Servlet (Name => "auth", Server => App.Self.Auth'Access);
      App.Add_Servlet (Name => "verify-auth", Server => App.Self.Verify_Auth'Access);
   end Initialize_Servlets;

   --  ------------------------------
   --  Initialize the filters provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application filters.
   --  ------------------------------
   overriding
   procedure Initialize_Filters (App : in out Application) is
   begin
      Log.Info ("Initializing application filters...");

      AWA.Applications.Application (App).Initialize_Filters;
      App.Add_Filter (Name => "dump", Filter => App.Self.Dump'Access);
      App.Add_Filter (Name => "measures", Filter => App.Self.Measures'Access);
      App.Add_Filter (Name => "service", Filter => App.Self.Service_Filter'Access);
      App.Add_Filter (Name => "no-cache", Filter => App.Self.No_Cache'Access);
   end Initialize_Filters;

   --  ------------------------------
   --  Initialize the AWA modules provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the modules used by the application.
   --  ------------------------------
   overriding
   procedure Initialize_Modules (App : in out Application) is
   begin
      Log.Info ("Initializing application modules...");

      Register (App    => App.Self.all'Access,
                Name   => AWA.Users.Modules.NAME,
                URI    => "user",
                Module => App.User_Module'Access);

      Register (App    => App.Self.all'Access,
                Name   => AWA.Workspaces.Modules.NAME,
                URI    => "workspaces",
                Module => App.Workspace_Module'Access);

      Register (App    => App.Self.all'Access,
                Name   => AWA.Mail.Modules.NAME,
                URI    => "mail",
                Module => App.Mail_Module'Access);

      Register (App    => App.Self.all'Access,
                Name   => AWA.Counters.Modules.NAME,
                Module => App.Counter_Module'Access);

      Register (App    => App.Self.all'Access,
                Name   => AWA.Jobs.Modules.NAME,
                URI    => "jobs",
                Module => App.Job_Module'Access);

      Register (App    => App.Self.all'Access,
                Name   => AWA.Tags.Modules.NAME,
                URI    => "tags",
                Module => App.Tag_Module'Access);

      Register (App    => App.Self.all'Access,
                Name   => AWA.Comments.Modules.NAME,
                URI    => "comments",
                Module => App.Comment_Module'Access);

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

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

      Register (App    => App.Self.all'Access,
                Name   => AWA.Images.Modules.NAME,
                URI    => "images",
                Module => App.Image_Module'Access);

      Register (App    => App.Self.all'Access,
                Name   => AWA.Votes.Modules.NAME,
                URI    => "votes",
                Module => App.Vote_Module'Access);

      Register (App    => App.Self.all'Access,
                Name   => AWA.Questions.Modules.NAME,
                URI    => "questions",
                Module => App.Question_Module'Access);

      Register (App    => App.Self.all'Access,
                Name   => AWA.Wikis.Modules.NAME,
                URI    => "wikis",
                Module => App.Wiki_Module'Access);

      Register (App    => App.Self.all'Access,
                Name   => AWA.Wikis.Previews.NAME,
                URI    => "wikis-preview",
                Module => App.Preview_Module'Access);

      Register (App    => App.Self.all'Access,
                Name   => Atlas.Microblog.Modules.NAME,
                URI    => "microblog",
                Module => App.Microblog_Module'Access);

      Register (App    => App.Self.all'Access,
                Name   => Atlas.Reviews.Modules.NAME,
                URI    => "reviews",
                Module => App.Review_Module'Access);
   end Initialize_Modules;

end Atlas.Applications;

Remove the Initialize procedure and do the initialization in Initialize_Components


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

package body ADO.Sessions.Sources is

   use ADO.Drivers;
   use type ADO.Drivers.Connections.Database_Connection_Access;

   --  ------------------------------
   --  Set the master data source
   --  ------------------------------
   procedure Set_Master (Controller : in out Replicated_DataSource;
                         Master     : in Data_Source_Access) is
   begin
      Controller.Master := Master;
   end Set_Master;

   --  ------------------------------
   --  Get the master data source
   --  ------------------------------
   function Get_Master (Controller : in Replicated_DataSource)
                       return Data_Source_Access is
   begin
      return Controller.Master;
   end Get_Master;

   --  ------------------------------
   --  Set the slave data source
   --  ------------------------------
   procedure Set_Slave (Controller : in out Replicated_DataSource;
                        Slave      : in Data_Source_Access) is
   begin
      Controller.Slave := Slave;
   end Set_Slave;

   --  ------------------------------
   --  Get the slave data source
   --  ------------------------------
   function Get_Slave (Controller : in Replicated_DataSource)
                      return Data_Source_Access is
   begin
      return Controller.Slave;
   end Get_Slave;

   --  ------------------------------
   --  Get a slave database connection
   --  ------------------------------
--   function Get_Slave_Connection (Controller : in Replicated_DataSource)
--                                 return Connection'Class is
--   begin
--      return Controller.Slave.Get_Connection;
--   end Get_Slave_Connection;

end ADO.Sessions.Sources;

-----------------------------------------------------------------------
--  ADO Databases -- Database Connections
--  Copyright (C) 2010, 2011, 2012, 2013, 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.
-----------------------------------------------------------------------

package body ADO.Sessions.Sources is

   --  ------------------------------
   --  Set the master data source
   --  ------------------------------
   procedure Set_Master (Controller : in out Replicated_DataSource;
                         Master     : in Data_Source_Access) is
   begin
      Controller.Master := Master;
   end Set_Master;

   --  ------------------------------
   --  Get the master data source
   --  ------------------------------
   function Get_Master (Controller : in Replicated_DataSource)
                       return Data_Source_Access is
   begin
      return Controller.Master;
   end Get_Master;

   --  ------------------------------
   --  Set the slave data source
   --  ------------------------------
   procedure Set_Slave (Controller : in out Replicated_DataSource;
                        Slave      : in Data_Source_Access) is
   begin
      Controller.Slave := Slave;
   end Set_Slave;

   --  ------------------------------
   --  Get the slave data source
   --  ------------------------------
   function Get_Slave (Controller : in Replicated_DataSource)
                      return Data_Source_Access is
   begin
      return Controller.Slave;
   end Get_Slave;

   --  ------------------------------
   --  Get a slave database connection
   --  ------------------------------
--   function Get_Slave_Connection (Controller : in Replicated_DataSource)
--                                 return Connection'Class is
--   begin
--      return Controller.Slave.Get_Connection;
--   end Get_Slave_Connection;

end ADO.Sessions.Sources;

Remove unecessary use clause

Remove unecessary use clause


-----------------------------------------------------------------------
--  gen-commands-plugins -- Plugin creation and management commands for dynamo
--  Copyright (C) 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.Directories;
with Ada.Text_IO;
with Gen.Artifacts;
with Gen.Model.Projects;
with GNAT.Command_Line;

with Util.Files;
with Util.Log.Loggers;
with Util.Strings.Transforms;
package body Gen.Commands.Plugins is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Gen.Commands.Project");

   --  ------------------------------
   --  Generator Command
   --  ------------------------------

   --  Execute the command with the arguments.
   overriding
   procedure Execute (Cmd       : in out Command;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Name, Args);
      use GNAT.Command_Line;

      function Get_Directory_Name (Name     : in String;
                                   Name_Dir : in Ada.Strings.Unbounded.Unbounded_String)
        return String;

      function Get_Directory_Name (Name     : in String;
                                   Name_Dir : in Ada.Strings.Unbounded.Unbounded_String)
                                   return String is
      begin
         if Ada.Strings.Unbounded.Length (Name_Dir) = 0 then
            return Name;
         else
            return Ada.Strings.Unbounded.To_String (Name_Dir);
         end if;
      end Get_Directory_Name;

      Result_Dir : constant String := Generator.Get_Result_Directory;
      Name_Dir   : Ada.Strings.Unbounded.Unbounded_String;
   begin
      --  If a dynamo.xml file exists, read it.
      if Ada.Directories.Exists ("dynamo.xml") then
         Generator.Read_Project ("dynamo.xml");
      else
         Generator.Set_Project_Property ("license", "apache");
         Generator.Set_Project_Property ("author", "unknown");
         Generator.Set_Project_Property ("author_email", "unknown@company.com");
      end if;
      --  Parse the command line
      loop
         case Getopt ("l: d:") is
         when ASCII.NUL => exit;

         when 'd' =>
            Name_Dir := Ada.Strings.Unbounded.To_Unbounded_String (Parameter);

         when 'l' =>
            declare
               L : constant String := Util.Strings.Transforms.To_Lower_Case (Parameter);
            begin
               Log.Info ("License {0}", L);

               if L = "apache" then
                  Generator.Set_Project_Property ("license", "apache");
               elsif L = "gpl" then
                  Generator.Set_Project_Property ("license", "gpl");
               elsif L = "gpl3" then
                  Generator.Set_Project_Property ("license", "gpl3");
               elsif L = "mit" then
                  Generator.Set_Project_Property ("license", "mit");
               elsif L = "bsd3" then
                  Generator.Set_Project_Property ("license", "bsd3");
               elsif L = "proprietary" then
                  Generator.Set_Project_Property ("license", "proprietary");
               else
                  Generator.Error ("Invalid license: {0}", L);
                  Generator.Error ("Valid licenses: apache, gpl, gpl3, mit, bsd3, proprietary");
                  return;
               end if;
            end;

         when others =>
            null;
         end case;
      end loop;
      declare
         Name  : constant String := Get_Argument;
         Kind  : constant String := Get_Argument;
         Dir   : constant String := Generator.Get_Plugin_Directory;
         Path  : constant String := Util.Files.Compose (Dir, Get_Directory_Name (Name, Name_Dir));
      begin
         if Name'Length = 0 then
            Generator.Error ("Missing plugin name");
            Cmd.Usage (Name, Generator);
            return;
         end if;
         if Kind /= "ada" and Kind /= "web" then
            Generator.Error ("Invalid plugin type (must be 'ada' or 'web')");
            return;
         end if;

         if Ada.Directories.Exists (Path) then
            Generator.Error ("Plugin {0} exists already", Name);
            return;
         end if;
         if not Ada.Directories.Exists (Dir) then
            Ada.Directories.Create_Directory (Dir);
         end if;
         Ada.Directories.Create_Directory (Path);

         Generator.Set_Result_Directory (Path);

         --  Create the plugin project instance and generate its dynamo.xml file.
         --  The new plugin is added to the current project so that it will be referenced.
         declare
            procedure Create_Plugin (Project : in out Model.Projects.Root_Project_Definition);

            procedure Create_Plugin (Project : in out Model.Projects.Root_Project_Definition) is
               Plugin : Gen.Model.Projects.Project_Definition_Access;
               File   : constant String := Util.Files.Compose (Path, "dynamo.xml");
            begin
               Project.Create_Project (Name    => Name,
                                       Path    => File,
                                       Project => Plugin);
               Project.Add_Module (Plugin);

               Plugin.Props.Set ("license", Project.Props.Get ("license", "none"));
               Plugin.Props.Set ("author", Project.Props.Get ("author", ""));
               Plugin.Props.Set ("author_email", Project.Props.Get ("author_email", ""));
               Plugin.Save (File);
            end Create_Plugin;

         begin
            Generator.Update_Project (Create_Plugin'Access);
         end;

         --  Generate the new plugin content.
         Generator.Set_Force_Save (False);
         Generator.Set_Global ("pluginName", Name);
         Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE,
                                     "create-plugin-" & Kind);

         --  And save the project dynamo.xml file which now refers to the new plugin.
         Generator.Set_Result_Directory (Result_Dir);
         Generator.Save_Project;

      exception
         when Ada.Directories.Name_Error | Ada.Directories.Use_Error =>
            Generator.Error ("Cannot create directory {0}", Path);
      end;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd       : in out Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("create-plugin: Create a new plugin for the current project");
      Put_Line ("Usage: create-plugin [-l apache|gpl|gpl3|mit|bsd3|proprietary] "
                & "[-d DIR] NAME [ada | web]");
      New_Line;
      Put_Line ("  Creates a new AWA plugin for the application with the name passed in NAME.");
      Put_Line ("  The plugin license is controlled by the -l option.");
      Put_Line ("  The plugin type is specified as the last argument which can be one of:");
      New_Line;
      Put_Line ("    ada  the plugin contains Ada code and a GNAT project is created");
      Put_Line ("    web  the plugin contains XHTML, CSS, Javascript files only");
      New_Line;
      Put_Line ("  The -d option allows to control the plugin directory name.  The plugin NAME");
      Put_Line ("  is used by default.  The plugin is created in the directory:");
      Put_Line ("    plugins/NAME or plugins/DIR");
      New_Line;
      Put_Line ("  For the Ada plugin, the command generates the following files"
                & " in the plugin directory:");
      Put_Line ("    src/<project>-<plugin>.ads");
      Put_Line ("    src/<project>-<plugin>-<module>.ads");
      Put_Line ("    src/<project>-<plugin>-<module>.adb");
   end Help;

end Gen.Commands.Plugins;

-----------------------------------------------------------------------
--  gen-commands-plugins -- Plugin creation and management commands for dynamo
--  Copyright (C) 2012, 2015, 2017, 2018, 2019 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Directories;
with Ada.Text_IO;
with Gen.Artifacts;
with Gen.Model.Projects;
with GNAT.Command_Line;

with Util.Files;
with Util.Log.Loggers;
with Util.Strings.Transforms;
package body Gen.Commands.Plugins is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Gen.Commands.Project");

   --  ------------------------------
   --  Generator Command
   --  ------------------------------

   --  Execute the command with the arguments.
   overriding
   procedure Execute (Cmd       : in out Command;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Name, Args);
      use GNAT.Command_Line;

      function Get_Directory_Name (Name     : in String;
                                   Name_Dir : in Ada.Strings.Unbounded.Unbounded_String)
        return String;

      function Get_Directory_Name (Name     : in String;
                                   Name_Dir : in Ada.Strings.Unbounded.Unbounded_String)
                                   return String is
      begin
         if Ada.Strings.Unbounded.Length (Name_Dir) = 0 then
            return Name;
         else
            return Ada.Strings.Unbounded.To_String (Name_Dir);
         end if;
      end Get_Directory_Name;

      Result_Dir : constant String := Generator.Get_Result_Directory;
      Name_Dir   : Ada.Strings.Unbounded.Unbounded_String;
   begin
      --  If a dynamo.xml file exists, read it.
      if Ada.Directories.Exists ("dynamo.xml") then
         Generator.Read_Project ("dynamo.xml");
      else
         Generator.Set_Project_Property ("license", "apache");
         Generator.Set_Project_Property ("author", "unknown");
         Generator.Set_Project_Property ("author_email", "unknown@company.com");
      end if;
      --  Parse the command line
      loop
         case Getopt ("l: d:") is
         when ASCII.NUL => exit;

         when 'd' =>
            Name_Dir := Ada.Strings.Unbounded.To_Unbounded_String (Parameter);

         when 'l' =>
            declare
               L : constant String := Util.Strings.Transforms.To_Lower_Case (Parameter);
            begin
               Log.Info ("License {0}", L);

               if L = "apache" then
                  Generator.Set_Project_Property ("license", "apache");
               elsif L = "gpl" then
                  Generator.Set_Project_Property ("license", "gpl");
               elsif L = "gpl3" then
                  Generator.Set_Project_Property ("license", "gpl3");
               elsif L = "mit" then
                  Generator.Set_Project_Property ("license", "mit");
               elsif L = "bsd3" then
                  Generator.Set_Project_Property ("license", "bsd3");
               elsif L = "proprietary" then
                  Generator.Set_Project_Property ("license", "proprietary");
               else
                  Generator.Error ("Invalid license: {0}", L);
                  Generator.Error ("Valid licenses: apache, gpl, gpl3, mit, bsd3, proprietary");
                  return;
               end if;
            end;

         when others =>
            null;
         end case;
      end loop;
      declare
         Name       : constant String := Get_Argument;
         Kind       : constant String := Get_Argument;
         Dir        : constant String := Generator.Get_Plugin_Directory;
         Plugin_Dir : constant String := Get_Directory_Name (Name, Name_Dir);
         Path       : constant String := Util.Files.Compose (Dir, Plugin_Dir);
      begin
         if Name'Length = 0 then
            Generator.Error ("Missing plugin name");
            Cmd.Usage (Name, Generator);
            return;
         end if;
         if Kind /= "ada" and Kind /= "web" then
            Generator.Error ("Invalid plugin type (must be 'ada' or 'web')");
            return;
         end if;

         if Ada.Directories.Exists (Path) then
            Generator.Error ("Plugin {0} exists already", Name);
            return;
         end if;
         if not Ada.Directories.Exists (Dir) then
            Ada.Directories.Create_Directory (Dir);
         end if;
         Ada.Directories.Create_Directory (Path);

         Generator.Set_Result_Directory (Path);

         --  Create the plugin project instance and generate its dynamo.xml file.
         --  The new plugin is added to the current project so that it will be referenced.
         declare
            procedure Create_Plugin (Project : in out Model.Projects.Root_Project_Definition);

            procedure Create_Plugin (Project : in out Model.Projects.Root_Project_Definition) is
               Plugin : Gen.Model.Projects.Project_Definition_Access;
               File   : constant String := Util.Files.Compose (Path, "dynamo.xml");
            begin
               Project.Create_Project (Name    => Name,
                                       Path    => File,
                                       Project => Plugin);
               Project.Add_Module (Plugin);

               Plugin.Props.Set ("license", Project.Props.Get ("license", "none"));
               Plugin.Props.Set ("author", Project.Props.Get ("author", ""));
               Plugin.Props.Set ("author_email", Project.Props.Get ("author_email", ""));
               Plugin.Save (File);
            end Create_Plugin;

         begin
            Generator.Update_Project (Create_Plugin'Access);
         end;

         --  Generate the new plugin content.
         Generator.Set_Force_Save (False);
         Generator.Set_Global ("pluginName", Name);
         Generator.Set_Global ("pluginDir", Plugin_Dir);
         Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE,
                                     "create-plugin-" & Kind);

         --  And save the project dynamo.xml file which now refers to the new plugin.
         Generator.Set_Result_Directory (Result_Dir);
         Generator.Save_Project;

      exception
         when Ada.Directories.Name_Error | Ada.Directories.Use_Error =>
            Generator.Error ("Cannot create directory {0}", Path);
      end;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd       : in out Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("create-plugin: Create a new plugin for the current project");
      Put_Line ("Usage: create-plugin [-l apache|gpl|gpl3|mit|bsd3|proprietary] "
                & "[-d DIR] NAME [ada | web]");
      New_Line;
      Put_Line ("  Creates a new AWA plugin for the application with the name passed in NAME.");
      Put_Line ("  The plugin license is controlled by the -l option.");
      Put_Line ("  The plugin type is specified as the last argument which can be one of:");
      New_Line;
      Put_Line ("    ada  the plugin contains Ada code and a GNAT project is created");
      Put_Line ("    web  the plugin contains XHTML, CSS, Javascript files only");
      New_Line;
      Put_Line ("  The -d option allows to control the plugin directory name.  The plugin NAME");
      Put_Line ("  is used by default.  The plugin is created in the directory:");
      Put_Line ("    plugins/NAME or plugins/DIR");
      New_Line;
      Put_Line ("  For the Ada plugin, the command generates the following files"
                & " in the plugin directory:");
      Put_Line ("    src/<project>-<plugin>.ads");
      Put_Line ("    src/<project>-<plugin>-<module>.ads");
      Put_Line ("    src/<project>-<plugin>-<module>.adb");
   end Help;

end Gen.Commands.Plugins;

Update the create-plugin generator to pass a #{pluginDir} variable that holds the plugin directory name


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

with Util.Beans.Objects;

--  The Gen.Model.Mappings package controls the mappings to convert an XML
--  type into the Ada type.
package Gen.Model.Mappings is

   ADA_MAPPING    : constant String := "Ada05";

   MySQL_MAPPING  : constant String := "MySQL";

   SQLite_MAPPING : constant String := "SQLite";

   type Basic_Type is (T_BOOLEAN, T_INTEGER, T_DATE, T_ENUM, T_IDENTIFIER, T_STRING, T_BLOB,
                       T_ENTITY_TYPE, T_BEAN, T_TABLE);

   --  ------------------------------
   --  Mapping Definition
   --  ------------------------------
   type Mapping_Definition;
   type Mapping_Definition_Access is access all Mapping_Definition'Class;

   type Mapping_Definition is new Definition with record
      Target        : Ada.Strings.Unbounded.Unbounded_String;
      Kind          : Basic_Type := T_INTEGER;
      Allow_Null    : Mapping_Definition_Access;
      Nullable      : Boolean := False;
   end record;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : Mapping_Definition;
                       Name : String) return Util.Beans.Objects.Object;

   --  Find the mapping for the given type name.
   function Find_Type (Name       : in Ada.Strings.Unbounded.Unbounded_String;
                       Allow_Null : in Boolean)
                       return Mapping_Definition_Access;

   --  Get the type name.
   function Get_Type_Name (From : Mapping_Definition) return String;

   procedure Register_Type (Name    : in String;
                            Mapping : in Mapping_Definition_Access;
                            Kind    : in Basic_Type);

   --  Register a type mapping From that is mapped to Target.
   procedure Register_Type (Target        : in String;
                            From          : in String;
                            Kind          : in Basic_Type;
                            Allow_Null    : in Boolean);

   --  Setup the type mapping for the language identified by the given name.
   procedure Set_Mapping_Name (Name : in String);

   package Mapping_Maps is
     new Ada.Containers.Hashed_Maps (Key_Type        => Ada.Strings.Unbounded.Unbounded_String,
                                     Element_Type    => Mapping_Definition_Access,
                                     Hash            => Ada.Strings.Unbounded.Hash,
                                     Equivalent_Keys => Ada.Strings.Unbounded."=");

   subtype Map is Mapping_Maps.Map;

   subtype Cursor is Mapping_Maps.Cursor;

end Gen.Model.Mappings;

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

with Util.Beans.Objects;

--  The Gen.Model.Mappings package controls the mappings to convert an XML
--  type into the Ada type.
package Gen.Model.Mappings is

   ADA_MAPPING    : constant String := "Ada05";

   MySQL_MAPPING  : constant String := "MySQL";

   SQLite_MAPPING : constant String := "SQLite";

   Postgresql_MAPPING : constant String := "Postgresql";

   type Basic_Type is (T_BOOLEAN, T_INTEGER, T_DATE, T_ENUM, T_IDENTIFIER, T_STRING, T_BLOB,
                       T_ENTITY_TYPE, T_BEAN, T_TABLE);

   --  ------------------------------
   --  Mapping Definition
   --  ------------------------------
   type Mapping_Definition;
   type Mapping_Definition_Access is access all Mapping_Definition'Class;

   type Mapping_Definition is new Definition with record
      Target        : Ada.Strings.Unbounded.Unbounded_String;
      Kind          : Basic_Type := T_INTEGER;
      Allow_Null    : Mapping_Definition_Access;
      Nullable      : Boolean := False;
   end record;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : Mapping_Definition;
                       Name : String) return Util.Beans.Objects.Object;

   --  Find the mapping for the given type name.
   function Find_Type (Name       : in Ada.Strings.Unbounded.Unbounded_String;
                       Allow_Null : in Boolean)
                       return Mapping_Definition_Access;

   --  Get the type name.
   function Get_Type_Name (From : Mapping_Definition) return String;

   procedure Register_Type (Name    : in String;
                            Mapping : in Mapping_Definition_Access;
                            Kind    : in Basic_Type);

   --  Register a type mapping From that is mapped to Target.
   procedure Register_Type (Target        : in String;
                            From          : in String;
                            Kind          : in Basic_Type;
                            Allow_Null    : in Boolean);

   --  Setup the type mapping for the language identified by the given name.
   procedure Set_Mapping_Name (Name : in String);

   package Mapping_Maps is
     new Ada.Containers.Hashed_Maps (Key_Type        => Ada.Strings.Unbounded.Unbounded_String,
                                     Element_Type    => Mapping_Definition_Access,
                                     Hash            => Ada.Strings.Unbounded.Hash,
                                     Equivalent_Keys => Ada.Strings.Unbounded."=");

   subtype Map is Mapping_Maps.Map;

   subtype Cursor is Mapping_Maps.Cursor;

end Gen.Model.Mappings;

Declare Postgresql_MAPPING constant

Declare Postgresql_MAPPING constant


-----------------------------------------------------------------------
--  gen-model-packages -- Packages holding model, query representation
--  Copyright (C) 2009, 2010, 2011, 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.Hashed_Maps;
with Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Hash;

with Util.Beans.Objects;
with Util.Beans.Objects.Vectors;
with Util.Strings.Sets;

with Gen.Model.List;
with Gen.Model.Mappings;
limited with Gen.Model.Enums;
limited with Gen.Model.Tables;
limited with Gen.Model.Queries;
limited with Gen.Model.Beans;
package Gen.Model.Packages is

   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Model Definition
   --  ------------------------------
   --  The Model_Definition contains the complete model from one or
   --  several files.  It maintains a list of Ada packages that must be generated.
   type Model_Definition is new Definition with private;
   type Model_Definition_Access is access all Model_Definition'Class;

   --  ------------------------------
   --  Package Definition
   --  ------------------------------
   --  The Package_Definition holds the tables, queries and other information
   --  that must be generated for a given Ada package.
   type Package_Definition is new Definition with private;
   type Package_Definition_Access is access all Package_Definition'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in Package_Definition;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Prepare the generation of the package:
   --  o identify the column types which are used
   --  o build a list of package for the with clauses.
   overriding
   procedure Prepare (O : in out Package_Definition);

   --  Initialize the package instance
   overriding
   procedure Initialize (O : in out Package_Definition);

   --  Find the type identified by the name.
   function Find_Type (From : in Package_Definition;
                       Name : in Unbounded_String)
                       return Gen.Model.Mappings.Mapping_Definition_Access;

   --  Get the model which contains all the package definitions.
   function Get_Model (From : in Package_Definition)
                       return Model_Definition_Access;

   --  Returns True if the package is a pre-defined package and must not be generated.
   function Is_Predefined (From : in Package_Definition) return Boolean;

   --  Set the package as a pre-defined package.
   procedure Set_Predefined (From : in out Package_Definition);

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : Model_Definition;
                       Name : String) return Util.Beans.Objects.Object;

   --  Initialize the model definition instance.
   overriding
   procedure Initialize (O : in out Model_Definition);

   --  Returns True if the model contains at least one package.
   function Has_Packages (O : in Model_Definition) return Boolean;

   --  Register or find the package knowing its name
   procedure Register_Package (O      : in out Model_Definition;
                               Name   : in Unbounded_String;
                               Result : out Package_Definition_Access);

   --  Register the declaration of the given enum in the model.
   procedure Register_Enum (O    : in out Model_Definition;
                            Enum : access Gen.Model.Enums.Enum_Definition'Class);

   --  Register the declaration of the given table in the model.
   procedure Register_Table (O     : in out Model_Definition;
                             Table : access Gen.Model.Tables.Table_Definition'Class);

   --  Register the declaration of the given query in the model.
   procedure Register_Query (O     : in out Model_Definition;
                             Table : access Gen.Model.Queries.Query_File_Definition'Class);

   --  Register the declaration of the given bean in the model.
   procedure Register_Bean (O     : in out Model_Definition;
                            Bean  : access Gen.Model.Beans.Bean_Definition'Class);

   --  Register a type mapping.  The From type describes a type in the XML
   --  configuration files (hibernate, query, ...) and the To represents the
   --  corresponding Ada type.
   procedure Register_Type (O    : in out Model_Definition;
                            From : in String;
                            To   : in String);

   --  Find the type identified by the name.
   function Find_Type (From : in Model_Definition;
                       Name : in Unbounded_String)
                       return Gen.Model.Mappings.Mapping_Definition_Access;

   --  Set the directory name associated with the model. This directory name allows to
   --  save and build a model in separate directories for the application, the unit tests
   --  and others.
   procedure Set_Dirname (O : in out Model_Definition;
                          Target_Dir : in String;
                          Model_Dir  : in String);

   --  Get the directory name associated with the model.
   function Get_Dirname (O : in Model_Definition) return String;

   --  Get the directory name which contains the model.
   function Get_Model_Directory (O : in Model_Definition) return String;

   --  Enable the generation of the Ada package given by the name.  By default all the Ada
   --  packages found in the model are generated.  When called, this enables the generation
   --  only for the Ada packages registered here.
   procedure Enable_Package_Generation (Model : in out Model_Definition;
                                        Name  : in String);

   --  Returns True if the generation is enabled for the given package name.
   function Is_Generation_Enabled (Model : in Model_Definition;
                                   Name  : in String) return Boolean;

   --  Prepare the generation of the package:
   --  o identify the column types which are used
   --  o build a list of package for the with clauses.
   overriding
   procedure Prepare (O : in out Model_Definition);

   package Package_Map is
     new Ada.Containers.Hashed_Maps (Key_Type        => Unbounded_String,
                                     Element_Type    => Package_Definition_Access,
                                     Hash            => Ada.Strings.Unbounded.Hash,
                                     Equivalent_Keys => "=");

   subtype Package_Cursor is Package_Map.Cursor;

   --  Get the first package of the model definition.
   function First (From : Model_Definition) return Package_Cursor;

   --  Returns true if the package cursor contains a valid package
   function Has_Element (Position : Package_Cursor) return Boolean
                         renames Package_Map.Has_Element;

   --  Returns the package definition.
   function Element (Position : Package_Cursor) return Package_Definition_Access
                     renames Package_Map.Element;

   --  Move the iterator to the next package definition.
   procedure Next (Position : in out Package_Cursor)
                   renames Package_Map.Next;

private

   package Table_List is new Gen.Model.List (T        => Definition,
                                             T_Access => Definition_Access);

   --  Returns False if the <tt>Left</tt> table does not depend on <tt>Right</tt>.
   --  Returns True if the <tt>Left</tt> table depends on the <tt>Right</tt> table.
   function Dependency_Compare (Left, Right : in Definition_Access) return Boolean;

   --  Sort the tables on their dependency.
   procedure Dependency_Sort is new Table_List.Sort_On ("<" => Dependency_Compare);

   subtype Table_List_Definition is Table_List.List_Definition;
   subtype Enum_List_Definition is Table_List.List_Definition;

   type List_Object is new Util.Beans.Basic.List_Bean with record
      Values     : Util.Beans.Objects.Vectors.Vector;
      Row        : Natural;
      Value_Bean : Util.Beans.Objects.Object;
   end record;

   --  Get the number of elements in the list.
   overriding
   function Get_Count (From : in List_Object) return Natural;

   --  Set the current row index.  Valid row indexes start at 1.
   overriding
   procedure Set_Row_Index (From  : in out List_Object;
                            Index : in Natural);

   --  Get the element at the current row index.
   overriding
   function Get_Row (From  : in List_Object) return Util.Beans.Objects.Object;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in List_Object;
                       Name : in String) return Util.Beans.Objects.Object;

   type Package_Definition is new Definition with record
      --  Enums defined in the package.
      Enums        : aliased Enum_List_Definition;
      Enums_Bean   : Util.Beans.Objects.Object;

      --  Hibernate tables
      Tables       : aliased Table_List_Definition;
      Tables_Bean  : Util.Beans.Objects.Object;

      --  Custom queries
      Queries      : aliased Table_List_Definition;
      Queries_Bean : Util.Beans.Objects.Object;

      --  Ada Beans
      Beans        : aliased Table_List_Definition;
      Beans_Bean   : Util.Beans.Objects.Object;

      --  A list of external packages which are used (used for with clause generation).
      Used_Types   : aliased List_Object;
      Used         : Util.Beans.Objects.Object;

      --  A map of all types defined in this package.
      Types        : Gen.Model.Mappings.Mapping_Maps.Map;

      --  The base name for the package (ex: gen-model-users)
      Base_Name    : Unbounded_String;

      --  The global model (used to resolve types from other packages).
      Model              : Model_Definition_Access;

      --  True if the package uses Ada.Calendar.Time
      Uses_Calendar_Time : Boolean := False;

      --  True if the package is a pre-defined package (ie, defined by a UML profile).
      Is_Predefined      : Boolean := False;
   end record;

   type Model_Definition is new Definition with record
      --  List of all enums.
      Enums        : aliased Enum_List_Definition;
      Enums_Bean   : Util.Beans.Objects.Object;

      --  List of all tables.
      Tables       : aliased Table_List_Definition;
      Tables_Bean  : Util.Beans.Objects.Object;

      --  List of all queries.
      Queries      : aliased Table_List_Definition;
      Queries_Bean : Util.Beans.Objects.Object;

      --  Ada Beans
      Beans        : aliased Table_List_Definition;
      Beans_Bean   : Util.Beans.Objects.Object;

      --  Map of all packages.
      Packages     : Package_Map.Map;

      --  Directory associated with the model ('src', 'samples', 'regtests', ...).
      Dir_Name     : Unbounded_String;

      --  Directory that contains the SQL and model files.
      DB_Name      : Unbounded_String;

      --  When not empty, a list of packages that must be taken into account for the generation.
      --  By default all packages and tables defined in the model are generated.
      Gen_Packages : Util.Strings.Sets.Set;
   end record;

end Gen.Model.Packages;

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

with Ada.Containers.Hashed_Maps;
with Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Hash;

with Util.Beans.Objects;
with Util.Beans.Objects.Vectors;
with Util.Strings.Sets;

with Gen.Model.List;
with Gen.Model.Mappings;
limited with Gen.Model.Enums;
limited with Gen.Model.Tables;
limited with Gen.Model.Queries;
limited with Gen.Model.Beans;
package Gen.Model.Packages is

   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Model Definition
   --  ------------------------------
   --  The Model_Definition contains the complete model from one or
   --  several files.  It maintains a list of Ada packages that must be generated.
   type Model_Definition is new Definition with private;
   type Model_Definition_Access is access all Model_Definition'Class;

   --  ------------------------------
   --  Package Definition
   --  ------------------------------
   --  The Package_Definition holds the tables, queries and other information
   --  that must be generated for a given Ada package.
   type Package_Definition is new Definition with private;
   type Package_Definition_Access is access all Package_Definition'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in Package_Definition;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Prepare the generation of the package:
   --  o identify the column types which are used
   --  o build a list of package for the with clauses.
   overriding
   procedure Prepare (O : in out Package_Definition);

   --  Initialize the package instance
   overriding
   procedure Initialize (O : in out Package_Definition);

   --  Find the type identified by the name.
   function Find_Type (From : in Package_Definition;
                       Name : in Unbounded_String)
                       return Gen.Model.Mappings.Mapping_Definition_Access;

   --  Get the model which contains all the package definitions.
   function Get_Model (From : in Package_Definition)
                       return Model_Definition_Access;

   --  Returns True if the package is a pre-defined package and must not be generated.
   function Is_Predefined (From : in Package_Definition) return Boolean;

   --  Set the package as a pre-defined package.
   procedure Set_Predefined (From : in out Package_Definition);

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : Model_Definition;
                       Name : String) return Util.Beans.Objects.Object;

   --  Initialize the model definition instance.
   overriding
   procedure Initialize (O : in out Model_Definition);

   --  Returns True if the model contains at least one package.
   function Has_Packages (O : in Model_Definition) return Boolean;

   --  Register or find the package knowing its name
   procedure Register_Package (O      : in out Model_Definition;
                               Name   : in Unbounded_String;
                               Result : out Package_Definition_Access);

   --  Register the declaration of the given enum in the model.
   procedure Register_Enum (O    : in out Model_Definition;
                            Enum : access Gen.Model.Enums.Enum_Definition'Class);

   --  Register the declaration of the given table in the model.
   procedure Register_Table (O     : in out Model_Definition;
                             Table : access Gen.Model.Tables.Table_Definition'Class);

   --  Register the declaration of the given query in the model.
   procedure Register_Query (O     : in out Model_Definition;
                             Table : access Gen.Model.Queries.Query_File_Definition'Class);

   --  Register the declaration of the given bean in the model.
   procedure Register_Bean (O     : in out Model_Definition;
                            Bean  : access Gen.Model.Beans.Bean_Definition'Class);

   --  Register a type mapping.  The From type describes a type in the XML
   --  configuration files (hibernate, query, ...) and the To represents the
   --  corresponding Ada type.
   procedure Register_Type (O    : in out Model_Definition;
                            From : in String;
                            To   : in String);

   --  Find the type identified by the name.
   function Find_Type (From : in Model_Definition;
                       Name : in Unbounded_String)
                       return Gen.Model.Mappings.Mapping_Definition_Access;

   --  Set the directory name associated with the model. This directory name allows to
   --  save and build a model in separate directories for the application, the unit tests
   --  and others.
   procedure Set_Dirname (O : in out Model_Definition;
                          Target_Dir : in String;
                          Model_Dir  : in String);

   --  Get the directory name associated with the model.
   function Get_Dirname (O : in Model_Definition) return String;

   --  Get the directory name which contains the model.
   function Get_Model_Directory (O : in Model_Definition) return String;

   --  Enable the generation of the Ada package given by the name.  By default all the Ada
   --  packages found in the model are generated.  When called, this enables the generation
   --  only for the Ada packages registered here.
   procedure Enable_Package_Generation (Model : in out Model_Definition;
                                        Name  : in String);

   --  Returns True if the generation is enabled for the given package name.
   function Is_Generation_Enabled (Model : in Model_Definition;
                                   Name  : in String) return Boolean;

   --  Prepare the generation of the package:
   --  o identify the column types which are used
   --  o build a list of package for the with clauses.
   overriding
   procedure Prepare (O : in out Model_Definition);

   package Package_Map is
     new Ada.Containers.Hashed_Maps (Key_Type        => Unbounded_String,
                                     Element_Type    => Package_Definition_Access,
                                     Hash            => Ada.Strings.Unbounded.Hash,
                                     Equivalent_Keys => "=");

   subtype Package_Cursor is Package_Map.Cursor;

   --  Get the first package of the model definition.
   function First (From : Model_Definition) return Package_Cursor;

   --  Returns true if the package cursor contains a valid package
   function Has_Element (Position : Package_Cursor) return Boolean
                         renames Package_Map.Has_Element;

   --  Returns the package definition.
   function Element (Position : Package_Cursor) return Package_Definition_Access
                     renames Package_Map.Element;

   --  Move the iterator to the next package definition.
   procedure Next (Position : in out Package_Cursor)
                   renames Package_Map.Next;

private

   package Table_List is new Gen.Model.List (T        => Definition,
                                             T_Access => Definition_Access);

   --  Returns False if the <tt>Left</tt> table does not depend on <tt>Right</tt>.
   --  Returns True if the <tt>Left</tt> table depends on the <tt>Right</tt> table.
   function Dependency_Compare (Left, Right : in Definition_Access) return Boolean;

   --  Sort the tables on their dependency.
   procedure Dependency_Sort is new Table_List.Sort_On ("<" => Dependency_Compare);

   subtype Table_List_Definition is Table_List.List_Definition;
   subtype Enum_List_Definition is Table_List.List_Definition;

   type List_Object is new Util.Beans.Basic.List_Bean with record
      Values     : Util.Beans.Objects.Vectors.Vector;
      Row        : Natural;
      Value_Bean : Util.Beans.Objects.Object;
   end record;

   --  Get the number of elements in the list.
   overriding
   function Get_Count (From : in List_Object) return Natural;

   --  Set the current row index.  Valid row indexes start at 1.
   overriding
   procedure Set_Row_Index (From  : in out List_Object;
                            Index : in Natural);

   --  Get the element at the current row index.
   overriding
   function Get_Row (From  : in List_Object) return Util.Beans.Objects.Object;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in List_Object;
                       Name : in String) return Util.Beans.Objects.Object;

   type Package_Definition is new Definition with record
      --  Enums defined in the package.
      Enums        : aliased Enum_List_Definition;
      Enums_Bean   : Util.Beans.Objects.Object;

      --  Hibernate tables
      Tables       : aliased Table_List_Definition;
      Tables_Bean  : Util.Beans.Objects.Object;

      --  Custom queries
      Queries      : aliased Table_List_Definition;
      Queries_Bean : Util.Beans.Objects.Object;

      --  Ada Beans
      Beans        : aliased Table_List_Definition;
      Beans_Bean   : Util.Beans.Objects.Object;

      --  A list of external packages which are used (used for with clause generation).
      Used_Spec_Types    : aliased List_Object;
      Used_Spec          : Util.Beans.Objects.Object;

      --  A list of external packages which are used (used for with clause generation).
      Used_Body_Types    : aliased List_Object;
      Used_Body          : Util.Beans.Objects.Object;

      --  A map of all types defined in this package.
      Types        : Gen.Model.Mappings.Mapping_Maps.Map;

      --  The base name for the package (ex: gen-model-users)
      Base_Name    : Unbounded_String;

      --  The global model (used to resolve types from other packages).
      Model              : Model_Definition_Access;

      --  True if the package uses Ada.Calendar.Time
      Uses_Calendar_Time : Boolean := False;

      --  True if the package is a pre-defined package (ie, defined by a UML profile).
      Is_Predefined      : Boolean := False;
   end record;

   type Model_Definition is new Definition with record
      --  List of all enums.
      Enums        : aliased Enum_List_Definition;
      Enums_Bean   : Util.Beans.Objects.Object;

      --  List of all tables.
      Tables       : aliased Table_List_Definition;
      Tables_Bean  : Util.Beans.Objects.Object;

      --  List of all queries.
      Queries      : aliased Table_List_Definition;
      Queries_Bean : Util.Beans.Objects.Object;

      --  Ada Beans
      Beans        : aliased Table_List_Definition;
      Beans_Bean   : Util.Beans.Objects.Object;

      --  Map of all packages.
      Packages     : Package_Map.Map;

      --  Directory associated with the model ('src', 'samples', 'regtests', ...).
      Dir_Name     : Unbounded_String;

      --  Directory that contains the SQL and model files.
      DB_Name      : Unbounded_String;

      --  When not empty, a list of packages that must be taken into account for the generation.
      --  By default all packages and tables defined in the model are generated.
      Gen_Packages : Util.Strings.Sets.Set;
   end record;

end Gen.Model.Packages;

Add Used_Spec_Types and Used_Body_Types to separate the list of packages required by the specification and the body


with C_String.Arrays;
with C_String;
with Interfaces.C;
with System.Address_To_Access_Conversions;

package body Jack.Client is
  package C renames Interfaces.C;

  use type C.int;
  use type Port_Name_t;
  use type System.Address;
  use type Thin.Port_Flags_t;
  use type Thin.Status_t;

  --
  -- Activate
  --

  procedure Activate
    (Client : in     Client_t;
     Failed :    out Boolean)
  is
    C_Return : constant C.int := Thin.Activate (System.Address (Client));
  begin
    Failed := C_Return /= 0;
  end Activate;

  --
  -- Close
  --

  procedure Close
    (Client : in     Client_t;
     Failed :    out Boolean) is
  begin
    Failed := Thin.Client_Close (System.Address (Client)) /= 0;
  end Close;

  --
  -- Compare
  --

  function Compare
    (Left  : in Client_t;
     Right : in Client_t) return Boolean is
  begin
    return System.Address (Left) = System.Address (Right);
  end Compare;

  function Compare
    (Left  : in Port_t;
     Right : in Port_t) return Boolean is
  begin
    return System.Address (Left) = System.Address (Right);
  end Compare;

  --
  -- Connect
  --

  procedure Connect
    (Client           : in     Client_t;
     Source_Port      : in     Port_Name_t;
     Destination_Port : in     Port_Name_t;
     Failed           :    out Boolean)
  is
    C_Source : aliased C.char_array := C.To_C (Port_Names.To_String (Source_Port));
    C_Dest   : aliased C.char_array := C.To_C (Port_Names.To_String (Destination_Port));
    C_Result : constant C.int       := Thin.Connect
      (Client           => System.Address (Client),
       Source_Port      => C_String.To_C_String (C_Source'Unchecked_Access),
       Destination_Port => C_String.To_C_String (C_Dest'Unchecked_Access));
  begin
    Failed := C_Result /= 0;
  end Connect;

  --
  -- Disconnect
  --

  procedure Disconnect
    (Client           : in     Client_t;
     Source_Port      : in     Port_Name_t;
     Destination_Port : in     Port_Name_t;
     Failed           :    out Boolean)
  is
    C_Source : aliased C.char_array := C.To_C (Port_Names.To_String (Source_Port));
    C_Dest   : aliased C.char_array := C.To_C (Port_Names.To_String (Destination_Port));
    C_Result : constant C.int       := Thin.Disconnect
      (Client           => System.Address (Client),
       Source_Port      => C_String.To_C_String (C_Source'Unchecked_Access),
       Destination_Port => C_String.To_C_String (C_Dest'Unchecked_Access));
  begin
    Failed := C_Result /= 0;
  end Disconnect;

  --
  -- Get_Ports
  --

  procedure Get_Ports_Free (Data : System.Address);
  pragma Import (C, Get_Ports_Free, "jack_ada_client_get_ports_free");

  procedure Get_Ports
    (Client            : in     Client_t;
     Port_Name_Pattern : in     String           := "";
     Port_Type_Pattern : in     String           := "";
     Port_Flags        : in     Port_Flags_t     := (others => False);
     Ports             :    out Port_Name_Set_t)
  is
    Name    : Port_Name_t;
    Size    : Natural;
    C_Flags : constant Thin.Port_Flags_t := Map_Port_Flags_To_Thin (Port_Flags);
    C_Name  : aliased C.char_array       := C.To_C (Port_Name_Pattern);
    C_Type  : aliased C.char_array       := C.To_C (Port_Type_Pattern);
    Address : constant C_String.Arrays.Pointer_Array_t :=
      Thin.Get_Ports
        (Client            => System.Address (Client),
         Port_Name_Pattern => C_String.To_C_String (C_Name'Unchecked_Access),
         Type_Name_Pattern => C_String.To_C_String (C_Type'Unchecked_Access),
         Flags             => C_Flags);
  begin
    Size := C_String.Arrays.Size_Terminated (Address);

    for Index in 0 .. Size loop
      Port_Names.Set_Bounded_String
        (Source => C_String.Arrays.Index_Terminated (Address, Index),
         Target => Name);
      Port_Name_Sets.Insert (Ports, Name);
    end loop;

    -- The strings returned by jack_get_ports are heap allocated.
    Get_Ports_Free (System.Address (Address));
  end Get_Ports;

  --
  -- Status, option and flag mapping.
  --

  type Status_Map_t is array (Status_Selector_t) of Thin.Status_t;

  Status_Map : constant Status_Map_t := Status_Map_t'
    (Failure               => Thin.JackFailure,
     Invalid_Option        => Thin.JackInvalidOption,
     Name_Not_Unique       => Thin.JackNameNotUnique,
     Server_Started        => Thin.JackServerStarted,
     Server_Failed         => Thin.JackServerFailed,
     Server_Error          => Thin.JackServerError,
     No_Such_Client        => Thin.JackNoSuchClient,
     Load_Failure          => Thin.JackLoadFailure,
     Init_Failure          => Thin.JackInitFailure,
     Shared_Memory_Failure => Thin.JackShmFailure,
     Version_Error         => Thin.JackVersionError);

  type Options_Map_t is array (Option_Selector_t) of Thin.Options_t;

  Options_Map : constant Options_Map_t := Options_Map_t'
    (Do_Not_Start_Server => Thin.JackNoStartServer,
     Use_Exact_Name      => Thin.JackUseExactName,
     Server_Name         => Thin.JackServerName,
     Load_Name           => Thin.JackLoadName,
     Load_Initialize     => Thin.JackLoadInit);

  type Port_Flags_Map_t is array (Port_Flag_Selector_t) of Thin.Port_Flags_t;

  Port_Flags_Map : constant Port_Flags_Map_t := Port_Flags_Map_t'
    (Port_Is_Input    => Thin.JackPortIsInput,
     Port_Is_Output   => Thin.JackPortIsOutput,
     Port_Is_Physical => Thin.JackPortIsPhysical,
     Port_Can_Monitor => Thin.JackPortCanMonitor,
     Port_Is_Terminal => Thin.JackPortIsTerminal);

  function Map_Options_To_Thin (Options : Options_t) return Thin.Options_t is
    Return_Options : Thin.Options_t := 0;
  begin
    for Selector in Options_t'Range loop
      if Options (Selector) then
        Return_Options := Return_Options or Options_Map (Selector);
      end if;
    end loop;
    return Return_Options;
  end Map_Options_To_Thin;

  function Map_Port_Flags_To_Thin (Port_Flags : Port_Flags_t) return Thin.Port_Flags_t is
    Return_Port_Flags : Thin.Port_Flags_t := 0;
  begin
    for Selector in Port_Flags_t'Range loop
      if Port_Flags (Selector) then
        Return_Port_Flags := Return_Port_Flags or Port_Flags_Map (Selector);
      end if;
    end loop;
    return Return_Port_Flags;
  end Map_Port_Flags_To_Thin;

  function Map_Status_To_Thin (Status : Status_t) return Thin.Status_t is
    Return_Status : Thin.Status_t := 0;
  begin
    for Selector in Status_t'Range loop
      if Status (Selector) then
        Return_Status := Return_Status or Status_Map (Selector);
      end if;
    end loop;
    return Return_Status;
  end Map_Status_To_Thin;

  function Map_Thin_To_Options (Options : Thin.Options_t) return Options_t is
    Return_Options : Options_t := (others => False);
  begin
    for Selector in Options_t'Range loop
      Return_Options (Selector) :=
        (Options and Options_Map (Selector)) = Options_Map (Selector);
    end loop;
    return Return_Options;
  end Map_Thin_To_Options;

  function Map_Thin_To_Port_Flags (Port_Flags : Thin.Port_Flags_t) return Port_Flags_t is
    Return_Port_Flags : Port_Flags_t := (others => False);
  begin
    for Selector in Port_Flags_t'Range loop
      Return_Port_Flags (Selector) :=
        (Port_Flags and Port_Flags_Map (Selector)) = Port_Flags_Map (Selector);
    end loop;
    return Return_Port_Flags;
  end Map_Thin_To_Port_Flags;

  function Map_Thin_To_Status (Status : Thin.Status_t) return Status_t is
    Return_Status : Status_t := (others => False);
  begin
    for Selector in Status_t'Range loop
      Return_Status (Selector) :=
        (Status and Status_Map (Selector)) = Status_Map (Selector);
    end loop;
    return Return_Status;
  end Map_Thin_To_Status;

  --
  -- Open
  --

  procedure Open
    (Client_Name : in     String;
     Options     : in     Options_t;
     Client      :    out Client_t;
     Status      : in out Status_t)
  is
    function C_Client_Open
      (Client_Name : C_String.String_Not_Null_Ptr_t;
       Options     : Thin.Options_t;
       Status      : System.Address) return System.Address;
    pragma Import (C, C_Client_Open, "jack_ada_client_open");

    C_Client  : System.Address;
    C_Name    : aliased C.char_array    := C.To_C (Client_Name);
    C_Options : constant Thin.Options_t := Map_Options_To_Thin (Options);
    C_Status  : aliased Thin.Status_t   := 0;
  begin
    pragma Assert (Client_Name /= "");

    C_Client := C_Client_Open
      (Client_Name => C_String.To_C_String (C_Name'Unchecked_Access),
       Options     => C_Options,
       Status      => C_Status'Address);
    Status := Map_Thin_To_Status (C_Status);

    if C_Client = System.Null_Address then
      Client := Invalid_Client;
    else
      Client := Client_t (C_Client);
    end if;
  end Open;

  --
  -- Port_Register
  --

  procedure Port_Register
    (Client      : in     Client_t;
     Port        :    out Port_t;
     Port_Name   : in     Port_Name_t;
     Port_Type   : in     String       := Default_Audio_Type;
     Port_Flags  : in     Port_Flags_t := (others => False);
     Buffer_Size : in     Natural      := 0)
  is
    C_Flags  : constant Thin.Port_Flags_t := Map_Port_Flags_To_Thin (Port_Flags);
    C_Name   : aliased C.char_array       := C.To_C (Port_Names.To_String (Port_Name));
    C_Port   : System.Address;
    C_Type   : aliased C.char_array       := C.To_C (Port_Type);
    Ptr_Name : C_String.String_Ptr_t;
    Ptr_Type : C_String.String_Ptr_t;
  begin
    if Port_Name /= Port_Names.Null_Bounded_String then
      Ptr_Name := C_String.To_C_String (C_Name'Unchecked_Access);
    end if;

    if Port_Type /= "" then
      Ptr_Type := C_String.To_C_String (C_Type'Unchecked_Access);
    end if;

    C_Port := Thin.Port_Register
      (Client      => System.Address (Client),
       Port_Name   => Ptr_Name,
       Port_Type   => Ptr_Type,
       Flags       => C_Flags,
       Buffer_Size => C.unsigned_long (Buffer_Size));

    if C_Port = System.Null_Address then
      Port := Invalid_Port;
    else
      Port := Port_t (C_Port);
    end if;
  end Port_Register;

  --
  -- Generic_Callbacks
  --

  package body Generic_Callbacks is

    package Convert_Process is new
      System.Address_To_Access_Conversions (Process_Callback_State_t);

    function C_Set_Process_Callback
      (Client   : System.Address;
       Callback : access procedure
        (Number_Of_Frames : Thin.Number_Of_Frames_t;
         Data             : System.Address);
       Data     : System.Address) return Thin.Integer_t;
    pragma Import (C, C_Set_Process_Callback, "jack_set_process_callback");

    procedure Process_Callback_Inner
      (Number_Of_Frames : Thin.Number_Of_Frames_t;
       Data             : System.Address)
    is
      State : Process_Callback_State_t;
      for State'Address use Data;
    begin
      State.Callback
        (Number_Of_Frames => Number_Of_Frames_t (Number_Of_Frames),
         User_Data        => State.User_Data);
    end Process_Callback_Inner;

    procedure Set_Process_Callback
      (Client    : in     Client_t;
       State     : in     Process_Callback_State_Access_t;
       Failed    :    out Boolean)
    is
      Pointer : constant Convert_Process.Object_Pointer :=
        Convert_Process.Object_Pointer (State);
    begin
      Failed := 0 /= C_Set_Process_Callback
        (Client   => System.Address (Client),
         Callback => Process_Callback_Inner'Access,
         Data     => Convert_Process.To_Address (Pointer));
    end Set_Process_Callback;

  end Generic_Callbacks;

  --
  -- To_Address
  --

  function To_Address (Client : in Client_t) return System.Address is
  begin
    return System.Address (Client);
  end To_Address;

  function To_Address (Port : in Port_t) return System.Address is
  begin
    return System.Address (Port);
  end To_Address;

end Jack.Client;

with C_String.Arrays;
with C_String;
with Interfaces.C;
with System.Address_To_Access_Conversions;

package body Jack.Client is
  package C renames Interfaces.C;

  use type C.int;
  use type Port_Name_t;
  use type System.Address;
  use type Thin.Port_Flags_t;
  use type Thin.Status_t;

  --
  -- Activate
  --

  procedure Activate
    (Client : in     Client_t;
     Failed :    out Boolean)
  is
    C_Return : constant C.int := Thin.Activate (System.Address (Client));
  begin
    Failed := C_Return /= 0;
  end Activate;

  --
  -- Close
  --

  procedure Close
    (Client : in     Client_t;
     Failed :    out Boolean) is
  begin
    Failed := Thin.Client_Close (System.Address (Client)) /= 0;
  end Close;

  --
  -- Compare
  --

  function Compare
    (Left  : in Client_t;
     Right : in Client_t) return Boolean is
  begin
    return System.Address (Left) = System.Address (Right);
  end Compare;

  function Compare
    (Left  : in Port_t;
     Right : in Port_t) return Boolean is
  begin
    return System.Address (Left) = System.Address (Right);
  end Compare;

  --
  -- Connect
  --

  procedure Connect
    (Client           : in     Client_t;
     Source_Port      : in     Port_Name_t;
     Destination_Port : in     Port_Name_t;
     Failed           :    out Boolean)
  is
    C_Source : aliased C.char_array := C.To_C (Port_Names.To_String (Source_Port));
    C_Dest   : aliased C.char_array := C.To_C (Port_Names.To_String (Destination_Port));
    C_Result : constant C.int       := Thin.Connect
      (Client           => System.Address (Client),
       Source_Port      => C_String.To_C_String (C_Source'Unchecked_Access),
       Destination_Port => C_String.To_C_String (C_Dest'Unchecked_Access));
  begin
    Failed := C_Result /= 0;
  end Connect;

  --
  -- Disconnect
  --

  procedure Disconnect
    (Client           : in     Client_t;
     Source_Port      : in     Port_Name_t;
     Destination_Port : in     Port_Name_t;
     Failed           :    out Boolean)
  is
    C_Source : aliased C.char_array := C.To_C (Port_Names.To_String (Source_Port));
    C_Dest   : aliased C.char_array := C.To_C (Port_Names.To_String (Destination_Port));
    C_Result : constant C.int       := Thin.Disconnect
      (Client           => System.Address (Client),
       Source_Port      => C_String.To_C_String (C_Source'Unchecked_Access),
       Destination_Port => C_String.To_C_String (C_Dest'Unchecked_Access));
  begin
    Failed := C_Result /= 0;
  end Disconnect;

  --
  -- Get_Ports
  --

  procedure Get_Ports_Free (Data : System.Address);
  pragma Import (C, Get_Ports_Free, "jack_ada_client_get_ports_free");

  procedure Get_Ports
    (Client            : in     Client_t;
     Port_Name_Pattern : in     String           := "";
     Port_Type_Pattern : in     String           := "";
     Port_Flags        : in     Port_Flags_t     := (others => False);
     Ports             :    out Port_Name_Set_t)
  is
    Name     : Port_Name_t;
    Size     : Natural;
    C_Flags  : constant Thin.Port_Flags_t := Map_Port_Flags_To_Thin (Port_Flags);
    C_Name   : aliased C.char_array       := C.To_C (Port_Name_Pattern);
    C_Type   : aliased C.char_array       := C.To_C (Port_Type_Pattern);
    Ptr_Name : C_String.String_Ptr_t;
    Ptr_Type : C_String.String_Ptr_t;
    Address  : C_String.Arrays.Pointer_Array_t;
  begin
    if Port_Name_Pattern /= Port_Names.Null_Bounded_String then
      Ptr_Name := C_String.To_C_String (C_Name'Unchecked_Access);
    end if;
    if Port_Type_Pattern /= "" then
      Ptr_Type := C_String.To_C_String (C_Type'Unchecked_Access);
    end if;

    Address := Thin.Get_Ports
     (Client            => System.Address (Client),
      Port_Name_Pattern => Ptr_Name,
      Type_Name_Pattern => Ptr_Type,
      Flags             => C_Flags);

    Size := C_String.Arrays.Size_Terminated (Address);

    for Index in 0 .. Size loop
      Port_Names.Set_Bounded_String
        (Source => C_String.Arrays.Index_Terminated (Address, Index),
         Target => Name);
      Port_Name_Sets.Insert (Ports, Name);
    end loop;

    -- The strings returned by jack_get_ports are heap allocated.
    Get_Ports_Free (System.Address (Address));
  end Get_Ports;

  --
  -- Status, option and flag mapping.
  --

  type Status_Map_t is array (Status_Selector_t) of Thin.Status_t;

  Status_Map : constant Status_Map_t := Status_Map_t'
    (Failure               => Thin.JackFailure,
     Invalid_Option        => Thin.JackInvalidOption,
     Name_Not_Unique       => Thin.JackNameNotUnique,
     Server_Started        => Thin.JackServerStarted,
     Server_Failed         => Thin.JackServerFailed,
     Server_Error          => Thin.JackServerError,
     No_Such_Client        => Thin.JackNoSuchClient,
     Load_Failure          => Thin.JackLoadFailure,
     Init_Failure          => Thin.JackInitFailure,
     Shared_Memory_Failure => Thin.JackShmFailure,
     Version_Error         => Thin.JackVersionError);

  type Options_Map_t is array (Option_Selector_t) of Thin.Options_t;

  Options_Map : constant Options_Map_t := Options_Map_t'
    (Do_Not_Start_Server => Thin.JackNoStartServer,
     Use_Exact_Name      => Thin.JackUseExactName,
     Server_Name         => Thin.JackServerName,
     Load_Name           => Thin.JackLoadName,
     Load_Initialize     => Thin.JackLoadInit);

  type Port_Flags_Map_t is array (Port_Flag_Selector_t) of Thin.Port_Flags_t;

  Port_Flags_Map : constant Port_Flags_Map_t := Port_Flags_Map_t'
    (Port_Is_Input    => Thin.JackPortIsInput,
     Port_Is_Output   => Thin.JackPortIsOutput,
     Port_Is_Physical => Thin.JackPortIsPhysical,
     Port_Can_Monitor => Thin.JackPortCanMonitor,
     Port_Is_Terminal => Thin.JackPortIsTerminal);

  function Map_Options_To_Thin (Options : Options_t) return Thin.Options_t is
    Return_Options : Thin.Options_t := 0;
  begin
    for Selector in Options_t'Range loop
      if Options (Selector) then
        Return_Options := Return_Options or Options_Map (Selector);
      end if;
    end loop;
    return Return_Options;
  end Map_Options_To_Thin;

  function Map_Port_Flags_To_Thin (Port_Flags : Port_Flags_t) return Thin.Port_Flags_t is
    Return_Port_Flags : Thin.Port_Flags_t := 0;
  begin
    for Selector in Port_Flags_t'Range loop
      if Port_Flags (Selector) then
        Return_Port_Flags := Return_Port_Flags or Port_Flags_Map (Selector);
      end if;
    end loop;
    return Return_Port_Flags;
  end Map_Port_Flags_To_Thin;

  function Map_Status_To_Thin (Status : Status_t) return Thin.Status_t is
    Return_Status : Thin.Status_t := 0;
  begin
    for Selector in Status_t'Range loop
      if Status (Selector) then
        Return_Status := Return_Status or Status_Map (Selector);
      end if;
    end loop;
    return Return_Status;
  end Map_Status_To_Thin;

  function Map_Thin_To_Options (Options : Thin.Options_t) return Options_t is
    Return_Options : Options_t := (others => False);
  begin
    for Selector in Options_t'Range loop
      Return_Options (Selector) :=
        (Options and Options_Map (Selector)) = Options_Map (Selector);
    end loop;
    return Return_Options;
  end Map_Thin_To_Options;

  function Map_Thin_To_Port_Flags (Port_Flags : Thin.Port_Flags_t) return Port_Flags_t is
    Return_Port_Flags : Port_Flags_t := (others => False);
  begin
    for Selector in Port_Flags_t'Range loop
      Return_Port_Flags (Selector) :=
        (Port_Flags and Port_Flags_Map (Selector)) = Port_Flags_Map (Selector);
    end loop;
    return Return_Port_Flags;
  end Map_Thin_To_Port_Flags;

  function Map_Thin_To_Status (Status : Thin.Status_t) return Status_t is
    Return_Status : Status_t := (others => False);
  begin
    for Selector in Status_t'Range loop
      Return_Status (Selector) :=
        (Status and Status_Map (Selector)) = Status_Map (Selector);
    end loop;
    return Return_Status;
  end Map_Thin_To_Status;

  --
  -- Open
  --

  procedure Open
    (Client_Name : in     String;
     Options     : in     Options_t;
     Client      :    out Client_t;
     Status      : in out Status_t)
  is
    function C_Client_Open
      (Client_Name : C_String.String_Not_Null_Ptr_t;
       Options     : Thin.Options_t;
       Status      : System.Address) return System.Address;
    pragma Import (C, C_Client_Open, "jack_ada_client_open");

    C_Client  : System.Address;
    C_Name    : aliased C.char_array    := C.To_C (Client_Name);
    C_Options : constant Thin.Options_t := Map_Options_To_Thin (Options);
    C_Status  : aliased Thin.Status_t   := 0;
  begin
    pragma Assert (Client_Name /= "");

    C_Client := C_Client_Open
      (Client_Name => C_String.To_C_String (C_Name'Unchecked_Access),
       Options     => C_Options,
       Status      => C_Status'Address);
    Status := Map_Thin_To_Status (C_Status);

    if C_Client = System.Null_Address then
      Client := Invalid_Client;
    else
      Client := Client_t (C_Client);
    end if;
  end Open;

  --
  -- Port_Register
  --

  procedure Port_Register
    (Client      : in     Client_t;
     Port        :    out Port_t;
     Port_Name   : in     Port_Name_t;
     Port_Type   : in     String       := Default_Audio_Type;
     Port_Flags  : in     Port_Flags_t := (others => False);
     Buffer_Size : in     Natural      := 0)
  is
    C_Flags  : constant Thin.Port_Flags_t := Map_Port_Flags_To_Thin (Port_Flags);
    C_Name   : aliased C.char_array       := C.To_C (Port_Names.To_String (Port_Name));
    C_Port   : System.Address;
    C_Type   : aliased C.char_array       := C.To_C (Port_Type);
  begin
    C_Port := Thin.Port_Register
      (Client      => System.Address (Client),
       Port_Name   => C_String.To_C_String (C_Name'Unchecked_Access),
       Port_Type   => C_String.To_C_String (C_Type'Unchecked_Access),
       Flags       => C_Flags,
       Buffer_Size => C.unsigned_long (Buffer_Size));

    if C_Port = System.Null_Address then
      Port := Invalid_Port;
    else
      Port := Port_t (C_Port);
    end if;
  end Port_Register;

  --
  -- Generic_Callbacks
  --

  package body Generic_Callbacks is

    package Convert_Process is new
      System.Address_To_Access_Conversions (Process_Callback_State_t);

    function C_Set_Process_Callback
      (Client   : System.Address;
       Callback : access procedure
        (Number_Of_Frames : Thin.Number_Of_Frames_t;
         Data             : System.Address);
       Data     : System.Address) return Thin.Integer_t;
    pragma Import (C, C_Set_Process_Callback, "jack_set_process_callback");

    procedure Process_Callback_Inner
      (Number_Of_Frames : Thin.Number_Of_Frames_t;
       Data             : System.Address)
    is
      State : Process_Callback_State_t;
      for State'Address use Data;
    begin
      State.Callback
        (Number_Of_Frames => Number_Of_Frames_t (Number_Of_Frames),
         User_Data        => State.User_Data);
    end Process_Callback_Inner;

    procedure Set_Process_Callback
      (Client    : in     Client_t;
       State     : in     Process_Callback_State_Access_t;
       Failed    :    out Boolean)
    is
      Pointer : constant Convert_Process.Object_Pointer :=
        Convert_Process.Object_Pointer (State);
    begin
      Failed := 0 /= C_Set_Process_Callback
        (Client   => System.Address (Client),
         Callback => Process_Callback_Inner'Access,
         Data     => Convert_Process.To_Address (Pointer));
    end Set_Process_Callback;

  end Generic_Callbacks;

  --
  -- To_Address
  --

  function To_Address (Client : in Client_t) return System.Address is
  begin
    return System.Address (Client);
  end To_Address;

  function To_Address (Port : in Port_t) return System.Address is
  begin
    return System.Address (Port);
  end To_Address;

end Jack.Client;

Fix default values

Fix default values