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

with Util.Strings;
with Util.Refs;
with ADO.SQL;
with ADO.Drivers;

with Interfaces;
with Ada.Strings.Unbounded;

--  == Introduction ==
--  Ada Database Objects provides a small framework which helps in
--  using complex SQL queries in an application.
--  The benefit of the framework are the following:
--
--    * The SQL query result are directly mapped in Ada records,
--    * It is easy to change or tune an SQL query without re-building the application,
--    * The SQL query can be easily tuned for a given database
--
--  The database query framework uses an XML query file:
--
--    * The XML query file defines a mapping that represents the result of SQL queries,
--    * The XML mapping is used by [http://code.google.com/p/ada-gen Dynamo] to generate an Ada record,
--    * The XML query file also defines a set of SQL queries, each query being identified by a unique name,
--    * The XML query file is read by the application to obtain the SQL query associated with a query name,
--    * The application uses the `List` procedure generated by [http://code.google.com/p/ada-gen Dynamo].
--
--  == XML Query File and Mapping ==
--  === XML Query File ===
--  The XML query file uses the `query-mapping` root element.  It should
--  define at most one `class` mapping and several `query` definitions.
--  The `class` definition should come first before any `query` definition.
--
--    <query-mapping>
--       <class>...</class>
--       <query>...</query>
--    </query-mapping>
--
--  == SQL Result Mapping ==
--  The XML query mapping is very close to the database table mapping.
--  The difference is that there is no need to specify and table name
--  nor any SQL type.  The XML query mapping is used to build an Ada
--  record that correspond to query results.  Unlike the database table mapping,
--  the Ada record will not be tagged and its definition will expose all the record
--  members directly.
--
--  The following XML query mapping:
--
--    <query-mapping>
--      <class name='Samples.Model.User_Info'>
--        <property name="name" type="String">
--           <comment>the user name</comment>
--        </property>
--        <property name="email" type="String">
--           <comment>the email address</comment>
--        </property>
--      </class>
--    </query-mapping>
--
--  will generate the following Ada record:
--
--    package Samples.Model is
--       type User_Info is record
--         Name  : Unbounded_String;
--         Email : Unbounded_String;
--       end record;
--    end Samples.Model;
--
--  The same query mapping can be used by different queries.
--
--  === SQL Queries ===
--  The XML query file defines a list of SQL queries that the application
--  can use.  Each query is associated with a unique name.  The application
--  will use that name to identify the SQL query to execute.  For each query,
--  the file also describes the SQL query pattern that must be used for
--  the query execution.
--
--    <query name='xxx' class='Samples.Model.User_Info'>
--       <sql driver='mysql'>
--         select u.name, u.email from user
--       </sql>
--       <sql driver='sqlite'>
--          ...
--       </sql>
--       <sql-count driver='mysql'>
--          select count(*) from user u
--       </sql-count>
--    </query>
--
--  The query contains basically two SQL patterns.  The `sql` element represents
--  the main SQL pattern.  This is the SQL that is used by the `List` operation.
--  In some cases, the result set returned by the query is limited to return only
--  a maximum number of rows.  This is often use in paginated lists.
--
--  The `sql-count` element represents an SQL query to indicate the total number
--  of elements if the SQL query was not limited.
package ADO.Queries is

   type Query_Index is new Natural;

   type File_Index is new Natural;

   type Query_File is limited private;
   type Query_File_Access is access all Query_File;

   type Query_Definition is limited private;
   type Query_Definition_Access is access all Query_Definition;

   type Query_Info is limited private;
   type Query_Info_Access is access all Query_Info;

   type Query_Info_Ref_Access is private;

   type Query_Manager (Query_Count : Query_Index;
                       File_Count  : File_Index) is limited private;
   type Query_Manager_Access is access all Query_Manager;

   Null_Query_Info_Ref : constant Query_Info_Ref_Access;

   --  ------------------------------
   --  Query Context
   --  ------------------------------
   --  The Context type holds the necessary information to build and execute
   --  a query whose SQL pattern is defined in an XML query file.
   type Context is new ADO.SQL.Query with private;

   --  Set the query definition which identifies the SQL query to execute.
   --  The query is represented by the <tt>sql</tt> XML entry.
   procedure Set_Query (Into  : in out Context;
                        Query : in Query_Definition_Access);

   --  Set the query count definition which identifies the SQL query to execute.
   --  The query count is represented by the <tt>sql-count</tt> XML entry.
   procedure Set_Count_Query (Into  : in out Context;
                              Query : in Query_Definition_Access);

   --  Set the query to execute as SQL statement.
   procedure Set_SQL (Into : in out Context;
                      SQL  : in String);

   procedure Set_Query (Into  : in out Context;
                        Name  : in String);

   --  Set the limit for the SQL query.
   procedure Set_Limit (Into  : in out Context;
                        First : in Natural;
                        Last  : in Natural);

   --  Get the first row index.
   function Get_First_Row_Index (From : in Context) return Natural;

   --  Get the last row index.
   function Get_Last_Row_Index (From : in Context) return Natural;

   --  Get the maximum number of rows that the SQL query can return.
   --  This operation uses the sql-count query.
   function Get_Max_Row_Count (From : in Context) return Natural;

   --  Get the SQL query that correspond to the query context.
   function Get_SQL (From    : in Context;
                     Manager : in Query_Manager_Access) return String;

   function Get_SQL (From      : in Query_Definition_Access;
                     Manager   : in Query_Manager_Access;
                     Use_Count : in Boolean) return String;

private

   --  ------------------------------
   --  Query Definition
   --  ------------------------------
   --  The Query_Definition holds the SQL query pattern which is defined
   --  in an XML query file.  The query is identified by a name and a given XML
   --  query file can contain several queries.  The Dynamo generator generates
   --  one instance of Query_Definition for each query defined in the XML
   --  file.  The XML file is loaded during application initialization (or later)
   --  to get the SQL query pattern.  Multi-thread concurrency is achieved by
   --  the Query_Info_Ref atomic reference.
   type Query_Definition is limited record
      --  The query name.
      Name   : Util.Strings.Name_Access;

      --  The query file in which the query is defined.
      File   : Query_File_Access;

      --  The next query defined in the query file.
      Next   : Query_Definition_Access;

      --  The SQL query pattern (initialized when reading the XML query file).
      --  Query  : Query_Info_Ref_Access;
      Query  : Query_Index := 0;
   end record;

   --  ------------------------------
   --  Query File
   --  ------------------------------
   --  The Query_File describes the SQL queries associated and loaded from
   --  a given XML query file.  The Dynamo generator generates one instance of
   --  Query_File for each XML query file that it has read.  The Path,
   --  Sha1_Map, Queries and Next are initialized statically by the generator (during
   --  package elaboration).
   type Query_File is limited record
      --  Query relative path name
      Name          : Util.Strings.Name_Access;

      --  The SHA1 hash of the query map section.
      Sha1_Map      : Util.Strings.Name_Access;

      --  The first query defined for that file.
      Queries       : Query_Definition_Access;

      --  The next XML query file registered in the application.
      Next          : Query_File_Access;

      --  The unique file index.
      File          : File_Index := 0;
   end record;

   type Context is new ADO.SQL.Query with record
      First      : Natural := 0;
      Last       : Natural := 0;
      Last_Index : Natural := 0;
      Max_Row_Count : Natural := 0;
      Query_Def  : Query_Definition_Access := null;
      Is_Count   : Boolean := False;
   end record;

   use Ada.Strings.Unbounded;

   --  SQL query pattern
   type Query_Pattern is limited record
      SQL : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   type Query_Pattern_Array is array (ADO.Drivers.Driver_Index) of Query_Pattern;

   type Query_Info is new Util.Refs.Ref_Entity with record
      Main_Query  : Query_Pattern_Array;
      Count_Query : Query_Pattern_Array;
   end record;

   package Query_Info_Ref is
      new Util.Refs.References (Query_Info, Query_Info_Access);

   type Query_Info_Ref_Access is access all Query_Info_Ref.Atomic_Ref;

   subtype Query_Index_Table is Query_Index range 1 .. Query_Index'Last;
   subtype File_Index_Table is File_Index range 1 .. File_Index'Last;

   type Query_File_Info is record
      --  Query absolute path name (after path resolution).
      Path          : Ada.Strings.Unbounded.String_Access;

      --  File
      File          : Query_File_Access;

      --  Stamp when the query file will be checked.
      Next_Check    : Interfaces.Unsigned_32;

      --  Stamp identifying the modification date of the query file.
      Last_Modified : Interfaces.Unsigned_32;
   end record;

   --  Find the query with the given name.
   --  Returns the query definition that matches the name or null if there is none
   function Find_Query (File : in Query_File_Info;
                        Name : in String) return Query_Definition_Access;

   type Query_Table is array (Query_Index_Table range <>) of Query_Info_Ref.Atomic_Ref;

   type File_Table is array (File_Index_Table range <>) of Query_File_Info;

   type Query_Manager (Query_Count : Query_Index;
                       File_Count  : File_Index) is limited record
      Driver  : ADO.Drivers.Driver_Index;
      Queries : Query_Table (1 .. Query_Count);
      Files   : File_Table (1 .. File_Count);
   end record;

   Null_Query_Info_Ref : constant Query_Info_Ref_Access := null;

end ADO.Queries;

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

with Util.Strings;
with Util.Refs;
with ADO.SQL;
with ADO.Drivers;

with Interfaces;
with Ada.Strings.Unbounded;
with Ada.Finalization;

--  == Introduction ==
--  Ada Database Objects provides a small framework which helps in
--  using complex SQL queries in an application.
--  The benefit of the framework are the following:
--
--    * The SQL query result are directly mapped in Ada records,
--    * It is easy to change or tune an SQL query without re-building the application,
--    * The SQL query can be easily tuned for a given database
--
--  The database query framework uses an XML query file:
--
--    * The XML query file defines a mapping that represents the result of SQL queries,
--    * The XML mapping is used by [http://code.google.com/p/ada-gen Dynamo] to generate an Ada record,
--    * The XML query file also defines a set of SQL queries, each query being identified by a unique name,
--    * The XML query file is read by the application to obtain the SQL query associated with a query name,
--    * The application uses the `List` procedure generated by [http://code.google.com/p/ada-gen Dynamo].
--
--  == XML Query File and Mapping ==
--  === XML Query File ===
--  The XML query file uses the `query-mapping` root element.  It should
--  define at most one `class` mapping and several `query` definitions.
--  The `class` definition should come first before any `query` definition.
--
--    <query-mapping>
--       <class>...</class>
--       <query>...</query>
--    </query-mapping>
--
--  == SQL Result Mapping ==
--  The XML query mapping is very close to the database table mapping.
--  The difference is that there is no need to specify and table name
--  nor any SQL type.  The XML query mapping is used to build an Ada
--  record that correspond to query results.  Unlike the database table mapping,
--  the Ada record will not be tagged and its definition will expose all the record
--  members directly.
--
--  The following XML query mapping:
--
--    <query-mapping>
--      <class name='Samples.Model.User_Info'>
--        <property name="name" type="String">
--           <comment>the user name</comment>
--        </property>
--        <property name="email" type="String">
--           <comment>the email address</comment>
--        </property>
--      </class>
--    </query-mapping>
--
--  will generate the following Ada record:
--
--    package Samples.Model is
--       type User_Info is record
--         Name  : Unbounded_String;
--         Email : Unbounded_String;
--       end record;
--    end Samples.Model;
--
--  The same query mapping can be used by different queries.
--
--  === SQL Queries ===
--  The XML query file defines a list of SQL queries that the application
--  can use.  Each query is associated with a unique name.  The application
--  will use that name to identify the SQL query to execute.  For each query,
--  the file also describes the SQL query pattern that must be used for
--  the query execution.
--
--    <query name='xxx' class='Samples.Model.User_Info'>
--       <sql driver='mysql'>
--         select u.name, u.email from user
--       </sql>
--       <sql driver='sqlite'>
--          ...
--       </sql>
--       <sql-count driver='mysql'>
--          select count(*) from user u
--       </sql-count>
--    </query>
--
--  The query contains basically two SQL patterns.  The `sql` element represents
--  the main SQL pattern.  This is the SQL that is used by the `List` operation.
--  In some cases, the result set returned by the query is limited to return only
--  a maximum number of rows.  This is often use in paginated lists.
--
--  The `sql-count` element represents an SQL query to indicate the total number
--  of elements if the SQL query was not limited.
package ADO.Queries is

   type Query_Index is new Natural;

   type File_Index is new Natural;

   type Query_File is limited private;
   type Query_File_Access is access all Query_File;

   type Query_Definition is limited private;
   type Query_Definition_Access is access all Query_Definition;

   type Query_Info is limited private;
   type Query_Info_Access is access all Query_Info;

   type Query_Info_Ref_Access is private;

   type Query_Manager is limited new Ada.Finalization.Limited_Controlled with private;
   type Query_Manager_Access is access all Query_Manager;

   Null_Query_Info_Ref : constant Query_Info_Ref_Access;

   --  ------------------------------
   --  Query Context
   --  ------------------------------
   --  The Context type holds the necessary information to build and execute
   --  a query whose SQL pattern is defined in an XML query file.
   type Context is new ADO.SQL.Query with private;

   --  Set the query definition which identifies the SQL query to execute.
   --  The query is represented by the <tt>sql</tt> XML entry.
   procedure Set_Query (Into  : in out Context;
                        Query : in Query_Definition_Access);

   --  Set the query count definition which identifies the SQL query to execute.
   --  The query count is represented by the <tt>sql-count</tt> XML entry.
   procedure Set_Count_Query (Into  : in out Context;
                              Query : in Query_Definition_Access);

   --  Set the query to execute as SQL statement.
   procedure Set_SQL (Into : in out Context;
                      SQL  : in String);

   procedure Set_Query (Into  : in out Context;
                        Name  : in String);

   --  Set the limit for the SQL query.
   procedure Set_Limit (Into  : in out Context;
                        First : in Natural;
                        Last  : in Natural);

   --  Get the first row index.
   function Get_First_Row_Index (From : in Context) return Natural;

   --  Get the last row index.
   function Get_Last_Row_Index (From : in Context) return Natural;

   --  Get the maximum number of rows that the SQL query can return.
   --  This operation uses the sql-count query.
   function Get_Max_Row_Count (From : in Context) return Natural;

   --  Get the SQL query that correspond to the query context.
   function Get_SQL (From    : in Context;
                     Manager : in Query_Manager'Class) return String;

   function Get_SQL (From      : in Query_Definition_Access;
                     Manager   : in Query_Manager;
                     Use_Count : in Boolean) return String;

private

   --  ------------------------------
   --  Query Definition
   --  ------------------------------
   --  The Query_Definition holds the SQL query pattern which is defined
   --  in an XML query file.  The query is identified by a name and a given XML
   --  query file can contain several queries.  The Dynamo generator generates
   --  one instance of Query_Definition for each query defined in the XML
   --  file.  The XML file is loaded during application initialization (or later)
   --  to get the SQL query pattern.  Multi-thread concurrency is achieved by
   --  the Query_Info_Ref atomic reference.
   type Query_Definition is limited record
      --  The query name.
      Name   : Util.Strings.Name_Access;

      --  The query file in which the query is defined.
      File   : Query_File_Access;

      --  The next query defined in the query file.
      Next   : Query_Definition_Access;

      --  The SQL query pattern (initialized when reading the XML query file).
      --  Query  : Query_Info_Ref_Access;
      Query  : Query_Index := 0;
   end record;

   --  ------------------------------
   --  Query File
   --  ------------------------------
   --  The Query_File describes the SQL queries associated and loaded from
   --  a given XML query file.  The Dynamo generator generates one instance of
   --  Query_File for each XML query file that it has read.  The Path,
   --  Sha1_Map, Queries and Next are initialized statically by the generator (during
   --  package elaboration).
   type Query_File is limited record
      --  Query relative path name
      Name          : Util.Strings.Name_Access;

      --  The SHA1 hash of the query map section.
      Sha1_Map      : Util.Strings.Name_Access;

      --  The first query defined for that file.
      Queries       : Query_Definition_Access;

      --  The next XML query file registered in the application.
      Next          : Query_File_Access;

      --  The unique file index.
      File          : File_Index := 0;
   end record;

   type Context is new ADO.SQL.Query with record
      First      : Natural := 0;
      Last       : Natural := 0;
      Last_Index : Natural := 0;
      Max_Row_Count : Natural := 0;
      Query_Def  : Query_Definition_Access := null;
      Is_Count   : Boolean := False;
   end record;

   use Ada.Strings.Unbounded;

   --  SQL query pattern
   type Query_Pattern is limited record
      SQL : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   type Query_Pattern_Array is array (ADO.Drivers.Driver_Index) of Query_Pattern;

   type Query_Info is new Util.Refs.Ref_Entity with record
      Main_Query  : Query_Pattern_Array;
      Count_Query : Query_Pattern_Array;
   end record;

   package Query_Info_Ref is
      new Util.Refs.References (Query_Info, Query_Info_Access);

   type Query_Info_Ref_Access is access all Query_Info_Ref.Atomic_Ref;

   subtype Query_Index_Table is Query_Index range 1 .. Query_Index'Last;
   subtype File_Index_Table is File_Index range 1 .. File_Index'Last;

   type Query_File_Info is record
      --  Query absolute path name (after path resolution).
      Path          : Ada.Strings.Unbounded.String_Access;

      --  File
      File          : Query_File_Access;

      --  Stamp when the query file will be checked.
      Next_Check    : Interfaces.Unsigned_32;

      --  Stamp identifying the modification date of the query file.
      Last_Modified : Interfaces.Unsigned_32;
   end record;

   --  Find the query with the given name.
   --  Returns the query definition that matches the name or null if there is none
   function Find_Query (File : in Query_File_Info;
                        Name : in String) return Query_Definition_Access;

   type Query_Table is array (Query_Index_Table range <>) of Query_Info_Ref.Atomic_Ref;
   type Query_Table_Access is access all Query_Table;

   type File_Table is array (File_Index_Table range <>) of Query_File_Info;
   type File_Table_Access is access all File_Table;
--
--     type Query_Manager (Query_Count : Query_Index;
--                         File_Count  : File_Index) is limited record
--        Driver  : ADO.Drivers.Driver_Index;
--        Queries : Query_Table (1 .. Query_Count);
--        Files   : File_Table (1 .. File_Count);
--     end record;

   type Query_Manager is limited new Ada.Finalization.Limited_Controlled with record
      Driver  : ADO.Drivers.Driver_Index;
      Queries : Query_Table_Access;
      Files   : File_Table_Access;
   end record;

   overriding
   procedure Finalize (Manager : in out Query_Manager);

   Null_Query_Info_Ref : constant Query_Info_Ref_Access := null;

end ADO.Queries;

Change Query_Manager to better take care of memory and simplify the operations


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

with Ada.Strings;
with Util.Strings;
package body Gen.Model.Tables is

   --  ------------------------------
   --  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 : Column_Definition;
                       Name : String) return Util.Beans.Objects.Object is
      use type Gen.Model.Mappings.Mapping_Definition_Access;
   begin

      if Name = "type" and From.Type_Mapping /= null then
         declare
            Bean : constant Util.Beans.Basic.Readonly_Bean_Access := From.Type_Mapping.all'Access;
         begin
            return Util.Beans.Objects.To_Object (Bean, Util.Beans.Objects.STATIC);
         end;

      elsif Name = "type" then
         return Util.Beans.Objects.To_Object (From.Type_Name);

      elsif Name = "index" then
         return Util.Beans.Objects.To_Object (From.Number);

      elsif Name = "isUnique" then
         return Util.Beans.Objects.To_Object (From.Unique);

      elsif Name = "isNull" then
         return Util.Beans.Objects.To_Object (not From.Not_Null);

      elsif Name = "isInserted" then
         return Util.Beans.Objects.To_Object (From.Is_Inserted);

      elsif Name = "isUpdated" then
         return Util.Beans.Objects.To_Object (From.Is_Updated);

      elsif Name = "sqlType" then
         return Util.Beans.Objects.To_Object (From.Sql_Type);

      elsif Name = "sqlName" then
         return Util.Beans.Objects.To_Object (From.Sql_Name);

      elsif Name = "isVersion" then
         return Util.Beans.Objects.To_Object (From.Is_Version);

      elsif Name = "isReadable" then
         return Util.Beans.Objects.To_Object (From.Is_Readable);

      elsif Name = "isPrimaryKey" then
         return Util.Beans.Objects.To_Object (From.Is_Key);

      elsif Name = "isPrimitiveType" then
         return Util.Beans.Objects.To_Object (From.Is_Basic_Type);

      elsif Name = "generator" then
         return From.Generator;

      else
         return Definition (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Returns true if the column type is a basic type.
   --  ------------------------------
   function Is_Basic_Type (From : Column_Definition) return Boolean is
      use type Gen.Model.Mappings.Mapping_Definition_Access;
      use type Gen.Model.Mappings.Basic_Type;

      Name : constant String := To_String (From.Type_Name);
   begin
      if From.Type_Mapping /= null then
         return From.Type_Mapping.Kind /= Gen.Model.Mappings.T_BLOB;
      end if;
      return Name = "int" or Name = "String"
        or Name = "ADO.Identifier" or Name = "Timestamp"
        or Name = "Integer"
        or Name = "long" or Name = "Long" or Name = "Date" or Name = "Time";
   end Is_Basic_Type;

   --  ------------------------------
   --  Returns the column type.
   --  ------------------------------
   function Get_Type (From : Column_Definition) return String is
      use type Gen.Model.Mappings.Mapping_Definition_Access;
   begin
      if From.Type_Mapping /= null then
         return To_String (From.Type_Mapping.Target);
      else
         return To_String (From.Type_Name);
      end if;
   end Get_Type;

   --  ------------------------------
   --  Prepare the generation of the model.
   --  ------------------------------
   overriding
   procedure Prepare (O : in out Column_Definition) is
   begin
      O.Type_Mapping := Gen.Model.Mappings.Find_Type (O.Type_Name);
      if Length (O.Sql_Type) = 0 then

      end if;
   end Prepare;

   --  ------------------------------
   --  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 : Association_Definition;
                       Name : String) return Util.Beans.Objects.Object is
   begin
      return Column_Definition (From).Get_Value (Name);
   end Get_Value;

   --  ------------------------------
   --  Initialize the table definition instance.
   --  ------------------------------
   overriding
   procedure Initialize (O : in out Table_Definition) is
   begin
      O.Members_Bean := Util.Beans.Objects.To_Object (O.Members'Unchecked_Access,
                                                      Util.Beans.Objects.STATIC);
   end Initialize;

   --  ------------------------------
   --  Create a table with the given name.
   --  ------------------------------
   function Create_Table (Name : in Unbounded_String) return Table_Definition_Access is
      Table : constant Table_Definition_Access := new Table_Definition;
   begin
      Table.Name := Name;
      declare
         Pos : constant Natural := Index (Table.Name, ".", Ada.Strings.Backward);
      begin
         if Pos > 0 then
            Table.Pkg_Name := Unbounded_Slice (Table.Name, 1, Pos - 1);
            Table.Type_Name := Unbounded_Slice (Table.Name, Pos + 1, Length (Table.Name));
         else
            Table.Pkg_Name := To_Unbounded_String ("ADO");
            Table.Type_Name := Table.Name;
         end if;
      end;
      return Table;
   end Create_Table;

   --  ------------------------------
   --  Create a table column with the given name and add it to the table.
   --  ------------------------------
   procedure Add_Column (Table  : in out Table_Definition;
                         Name   : in Unbounded_String;
                         Column : out Column_Definition_Access) is
   begin
      Column := new Column_Definition;
      Column.Name     := Name;
      Column.Sql_Name := Name;
      Column.Number   := Table.Members.Get_Count;
      Table.Members.Append (Column);
      if Name = "version" then
         Table.Version_Column := Column;
         Column.Is_Version  := True;
         Column.Is_Updated  := False;
         Column.Is_Inserted := False;

      elsif Name = "id" then
         Table.Id_Column := Column;
         Column.Is_Key := True;

      end if;
   end Add_Column;

   --  ------------------------------
   --  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 Table_Definition;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "members" or Name = "columns" then
         return From.Members_Bean;

      elsif Name = "id" and From.Id_Column /= null then
         declare
            Bean : constant Util.Beans.Basic.Readonly_Bean_Access := From.Id_Column.all'Access;
         begin
            return Util.Beans.Objects.To_Object (Bean, Util.Beans.Objects.STATIC);
         end;

      elsif Name = "version" and From.Version_Column /= null then
         declare
            Bean : constant Util.Beans.Basic.Readonly_Bean_Access
              := From.Version_Column.all'Unchecked_Access;
         begin
            return Util.Beans.Objects.To_Object (Bean, Util.Beans.Objects.STATIC);
         end;

      elsif Name = "hasAssociations" then
         return Util.Beans.Objects.To_Object (From.Has_Associations);

      elsif Name = "type" then
         return Util.Beans.Objects.To_Object (From.Type_Name);

      elsif Name = "table" then
         return Util.Beans.Objects.To_Object (From.Name);

      else
         return Definition (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Prepare the generation of the model.
   --  ------------------------------
   overriding
   procedure Prepare (O : in out Table_Definition) is
      Iter : Column_List.Cursor := O.Members.First;
   begin
      while Column_List.Has_Element (Iter) loop
         Column_List.Element (Iter).Prepare;
         Column_List.Next (Iter);
      end loop;
   end Prepare;

   --  ------------------------------
   --  Set the table name and determines the package name.
   --  ------------------------------
   procedure Set_Table_Name (Table : in out Table_Definition;
                             Name  : in String) is
      Pos : constant Natural := Util.Strings.Rindex (Name, '.');
   begin
      Table.Name := To_Unbounded_String (Name);
      if Pos > 0 then
         Table.Pkg_Name := To_Unbounded_String (Name (Name'First .. Pos - 1));
         Table.Type_Name := To_Unbounded_String (Name (Pos + 1 .. Name'Last));
      else
         Table.Pkg_Name := To_Unbounded_String ("ADO");
         Table.Type_Name := Table.Name;
      end if;
   end Set_Table_Name;

end Gen.Model.Tables;

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

with Ada.Strings;
with Util.Strings;
package body Gen.Model.Tables is

   --  ------------------------------
   --  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 : Column_Definition;
                       Name : String) return Util.Beans.Objects.Object is
      use type Gen.Model.Mappings.Mapping_Definition_Access;
   begin

      if Name = "type" and From.Type_Mapping /= null then
         declare
            Bean : constant Util.Beans.Basic.Readonly_Bean_Access := From.Type_Mapping.all'Access;
         begin
            return Util.Beans.Objects.To_Object (Bean, Util.Beans.Objects.STATIC);
         end;

      elsif Name = "type" then
         return Util.Beans.Objects.To_Object (From.Type_Name);

      elsif Name = "index" then
         return Util.Beans.Objects.To_Object (From.Number);

      elsif Name = "isUnique" then
         return Util.Beans.Objects.To_Object (From.Unique);

      elsif Name = "isNull" then
         return Util.Beans.Objects.To_Object (not From.Not_Null);

      elsif Name = "isInserted" then
         return Util.Beans.Objects.To_Object (From.Is_Inserted);

      elsif Name = "isUpdated" then
         return Util.Beans.Objects.To_Object (From.Is_Updated);

      elsif Name = "sqlType" then
         return Util.Beans.Objects.To_Object (From.Sql_Type);

      elsif Name = "sqlName" then
         return Util.Beans.Objects.To_Object (From.Sql_Name);

      elsif Name = "isVersion" then
         return Util.Beans.Objects.To_Object (From.Is_Version);

      elsif Name = "isReadable" then
         return Util.Beans.Objects.To_Object (From.Is_Readable);

      elsif Name = "isPrimaryKey" then
         return Util.Beans.Objects.To_Object (From.Is_Key);

      elsif Name = "isPrimitiveType" then
         return Util.Beans.Objects.To_Object (From.Is_Basic_Type);

      elsif Name = "generator" then
         return From.Generator;

      else
         return Definition (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Returns true if the column type is a basic type.
   --  ------------------------------
   function Is_Basic_Type (From : Column_Definition) return Boolean is
      use type Gen.Model.Mappings.Mapping_Definition_Access;
      use type Gen.Model.Mappings.Basic_Type;

      Name : constant String := To_String (From.Type_Name);
   begin
      if From.Type_Mapping /= null then
         return From.Type_Mapping.Kind /= Gen.Model.Mappings.T_BLOB;
      end if;
      return Name = "int" or Name = "String"
        or Name = "ADO.Identifier" or Name = "Timestamp"
        or Name = "Integer"
        or Name = "long" or Name = "Long" or Name = "Date" or Name = "Time";
   end Is_Basic_Type;

   --  ------------------------------
   --  Returns the column type.
   --  ------------------------------
   function Get_Type (From : Column_Definition) return String is
      use type Gen.Model.Mappings.Mapping_Definition_Access;
   begin
      if From.Type_Mapping /= null then
         return To_String (From.Type_Mapping.Target);
      else
         return To_String (From.Type_Name);
      end if;
   end Get_Type;

   --  ------------------------------
   --  Prepare the generation of the model.
   --  ------------------------------
   overriding
   procedure Prepare (O : in out Column_Definition) is
   begin
      O.Type_Mapping := Gen.Model.Mappings.Find_Type (O.Type_Name);
   end Prepare;

   --  ------------------------------
   --  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 : Association_Definition;
                       Name : String) return Util.Beans.Objects.Object is
   begin
      return Column_Definition (From).Get_Value (Name);
   end Get_Value;

   --  ------------------------------
   --  Initialize the table definition instance.
   --  ------------------------------
   overriding
   procedure Initialize (O : in out Table_Definition) is
   begin
      O.Members_Bean := Util.Beans.Objects.To_Object (O.Members'Unchecked_Access,
                                                      Util.Beans.Objects.STATIC);
   end Initialize;

   --  ------------------------------
   --  Create a table with the given name.
   --  ------------------------------
   function Create_Table (Name : in Unbounded_String) return Table_Definition_Access is
      Table : constant Table_Definition_Access := new Table_Definition;
   begin
      Table.Name := Name;
      declare
         Pos : constant Natural := Index (Table.Name, ".", Ada.Strings.Backward);
      begin
         if Pos > 0 then
            Table.Pkg_Name := Unbounded_Slice (Table.Name, 1, Pos - 1);
            Table.Type_Name := Unbounded_Slice (Table.Name, Pos + 1, Length (Table.Name));
         else
            Table.Pkg_Name := To_Unbounded_String ("ADO");
            Table.Type_Name := Table.Name;
         end if;
      end;
      return Table;
   end Create_Table;

   --  ------------------------------
   --  Create a table column with the given name and add it to the table.
   --  ------------------------------
   procedure Add_Column (Table  : in out Table_Definition;
                         Name   : in Unbounded_String;
                         Column : out Column_Definition_Access) is
   begin
      Column := new Column_Definition;
      Column.Name     := Name;
      Column.Sql_Name := Name;
      Column.Number   := Table.Members.Get_Count;
      Table.Members.Append (Column);
      if Name = "version" then
         Table.Version_Column := Column;
         Column.Is_Version  := True;
         Column.Is_Updated  := False;
         Column.Is_Inserted := False;

      elsif Name = "id" then
         Table.Id_Column := Column;
         Column.Is_Key := True;

      end if;
   end Add_Column;

   --  ------------------------------
   --  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 Table_Definition;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "members" or Name = "columns" then
         return From.Members_Bean;

      elsif Name = "id" and From.Id_Column /= null then
         declare
            Bean : constant Util.Beans.Basic.Readonly_Bean_Access := From.Id_Column.all'Access;
         begin
            return Util.Beans.Objects.To_Object (Bean, Util.Beans.Objects.STATIC);
         end;

      elsif Name = "version" and From.Version_Column /= null then
         declare
            Bean : constant Util.Beans.Basic.Readonly_Bean_Access
              := From.Version_Column.all'Unchecked_Access;
         begin
            return Util.Beans.Objects.To_Object (Bean, Util.Beans.Objects.STATIC);
         end;

      elsif Name = "hasAssociations" then
         return Util.Beans.Objects.To_Object (From.Has_Associations);

      elsif Name = "type" then
         return Util.Beans.Objects.To_Object (From.Type_Name);

      elsif Name = "table" then
         return Util.Beans.Objects.To_Object (From.Name);

      else
         return Definition (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Prepare the generation of the model.
   --  ------------------------------
   overriding
   procedure Prepare (O : in out Table_Definition) is
      Iter : Column_List.Cursor := O.Members.First;
   begin
      while Column_List.Has_Element (Iter) loop
         Column_List.Element (Iter).Prepare;
         Column_List.Next (Iter);
      end loop;
   end Prepare;

   --  ------------------------------
   --  Set the table name and determines the package name.
   --  ------------------------------
   procedure Set_Table_Name (Table : in out Table_Definition;
                             Name  : in String) is
      Pos : constant Natural := Util.Strings.Rindex (Name, '.');
   begin
      Table.Name := To_Unbounded_String (Name);
      if Pos > 0 then
         Table.Pkg_Name := To_Unbounded_String (Name (Name'First .. Pos - 1));
         Table.Type_Name := To_Unbounded_String (Name (Pos + 1 .. Name'Last));
      else
         Table.Pkg_Name := To_Unbounded_String ("ADO");
         Table.Type_Name := Table.Name;
      end if;
   end Set_Table_Name;

end Gen.Model.Tables;

Fix compilation

Fix compilation


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

with ADO.Audits;
with ADO.Sessions;

package AWA.Audits.Services is

   --  ------------------------------
   --  Event manager
   --  ------------------------------
   --  The <b>Event_Manager</b> manages the dispatch of event to the right event queue
   --  or to the event action.  The event manager holds a list of actions that must be
   --  triggered for a particular event/queue pair.  Such list is created and initialized
   --  when the application is configured.  It never changes.
   type Audit_Manager is limited new ADO.Audits.Audit_Manager with null record;
   type Audit_Manager_Access is access all Audit_Manager'Class;

   --  Save the audit changes in the database.
   overriding
   procedure Save (Manager : in out Audit_Manager;
                   Session : in out ADO.Sessions.Master_Session'Class;
                   Object  : in ADO.Audits.Auditable_Object_Record'Class;
                   Changes : in ADO.Audits.Audit_Array);

end AWA.Audits.Services;

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

with ADO.Audits;
with ADO.Sessions;

package AWA.Audits.Services is

   --  ------------------------------
   --  Event manager
   --  ------------------------------
   --  The <b>Event_Manager</b> manages the dispatch of event to the right event queue
   --  or to the event action.  The event manager holds a list of actions that must be
   --  triggered for a particular event/queue pair.  Such list is created and initialized
   --  when the application is configured.  It never changes.
   type Audit_Manager is limited new ADO.Audits.Audit_Manager with private;
   type Audit_Manager_Access is access all Audit_Manager'Class;

   --  Save the audit changes in the database.
   overriding
   procedure Save (Manager : in out Audit_Manager;
                   Session : in out ADO.Sessions.Master_Session'Class;
                   Object  : in ADO.Audits.Auditable_Object_Record'Class;
                   Changes : in ADO.Audits.Audit_Array);

   --  Find the audit field identification number from the entity type and field name.
   function Get_Audit_Field (Manager : in Audit_Manager;
                             Name    : in String;
                             Entity  : in ADO.Entity_Type) return ADO.Identifier;

private

   type Field_Key (Len : Natural) is record
      Entity : ADO.Entity_Type;
      Name   : String (1 .. Len);
   end record;

   function Hash (Item : in Field_Key) return Ada.Containers.Hash_Type;

   package Audit_Field_Maps is
     new Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => Field_Key,
                                                Element_Type    => ADO.Identifier,
                                                Hash            => Hash,
                                                Equivalent_Keys => "=",
                                                "="             => ADO."=");

   type Audit_Manager is limited new ADO.Audits.Audit_Manager with record
      Fields : Audit_Field_Maps.Map;
   end record;

end AWA.Audits.Services;

Add audit field support in the model: - Declare Get_Audit_Field function - Declare Field_Key record - Instantiate Audit_Fields_Maps package - Keep a map of audited field to the audit field unique id


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

with Ada.Text_IO;

with Glfw.Errors;
with Glfw.Windows.Context;
with Glfw.Windows.Hints;

with Orka.Inputs.GLFW;

package body Orka.Windows.GLFW is

   procedure Print_Error (Code : Standard.Glfw.Errors.Kind; Description : String) is
   begin
      Ada.Text_IO.Put_Line ("Error occured (" & Standard.Glfw.Errors.Kind'Image (Code) & "): " & Description);
   end Print_Error;

   function Initialize
     (Major, Minor : Natural;
      Debug : Boolean := False) return Active_GLFW'Class is
   begin
      --  Initialize GLFW
      Standard.Glfw.Errors.Set_Callback (Print_Error'Access);
      Standard.Glfw.Init;

      --  Initialize OpenGL context
      Standard.Glfw.Windows.Hints.Set_Minimum_OpenGL_Version (Major, Minor);
      Standard.Glfw.Windows.Hints.Set_Forward_Compat (True);
      Standard.Glfw.Windows.Hints.Set_Profile (Standard.Glfw.Windows.Context.Core_Profile);
      Standard.Glfw.Windows.Hints.Set_Debug_Context (Debug);

      return Active_GLFW'(Ada.Finalization.Limited_Controlled
        with Debug => Debug, Finalized => False);
   end Initialize;

   overriding
   procedure Finalize (Object : in out Active_GLFW) is
   begin
      if not Object.Finalized then
         if Object.Debug then
            Ada.Text_IO.Put_Line ("Shutting down GLFW");
         end if;
         Standard.Glfw.Shutdown;
         Object.Finalized := True;
      end if;
   end Finalize;

   overriding
   procedure Finalize (Object : in out GLFW_Window) is
   begin
      if not Object.Finalized then
         Object.Destroy;
         Object.Finalized := True;
      end if;
   end Finalize;

   function Create_Window
     (Width, Height : Positive;
      Samples : Natural := 0;
      Visible, Resizable : Boolean := True) return Window'Class
   is
      package Windows renames Standard.Glfw.Windows;
   begin
      return Result : GLFW_Window := GLFW_Window'(Windows.Window
        with Input => Inputs.GLFW.Create_Pointer_Input, Finalized => False, others => <>)
      do
         declare
            Reference : constant Windows.Window_Reference := Windows.Window (Window'Class (Result))'Access;
         begin
            Windows.Hints.Set_Visible (Visible);
            Windows.Hints.Set_Resizable (Resizable);
            Windows.Hints.Set_Samples (Samples);

            Reference.Init (Standard.Glfw.Size (Width), Standard.Glfw.Size (Height), "");

            Inputs.GLFW.GLFW_Pointer_Input (Result.Input.all).Set_Window (Reference);

            declare
               Width, Height : Standard.Glfw.Size;
            begin
               Reference.Get_Framebuffer_Size (Width, Height);
               Result.Framebuffer_Size_Changed (Natural (Width), Natural (Height));
            end;

            --  Callbacks
            Reference.Enable_Callback (Windows.Callbacks.Close);
            Reference.Enable_Callback (Windows.Callbacks.Mouse_Button);
            Reference.Enable_Callback (Windows.Callbacks.Mouse_Position);
            Reference.Enable_Callback (Windows.Callbacks.Mouse_Scroll);
            Reference.Enable_Callback (Windows.Callbacks.Key);
            Reference.Enable_Callback (Windows.Callbacks.Framebuffer_Size);

            Windows.Context.Make_Current (Reference);
         end;
      end return;
   end Create_Window;

   overriding
   function Pointer_Input
     (Object : GLFW_Window) return Inputs.Pointer_Input_Ptr
   is (Object.Input);

   overriding
   function Width (Object : GLFW_Window) return Positive is
     (Object.Width);

   overriding
   function Height (Object : GLFW_Window) return Positive is
     (Object.Height);

   overriding
   procedure Set_Title (Object : in out GLFW_Window; Value : String) is
   begin
      Standard.Glfw.Windows.Window (Object)'Access.Set_Title (Value);
   end Set_Title;

   overriding
   procedure Close (Object : in out GLFW_Window) is
   begin
      Object.Set_Should_Close (True);
   end Close;

   overriding
   function Should_Close (Object : in out GLFW_Window) return Boolean is
   begin
      return Standard.Glfw.Windows.Window (Object)'Access.Should_Close;
   end Should_Close;

   overriding
   procedure Process_Input (Object : in out GLFW_Window) is
   begin
      Standard.Glfw.Input.Poll_Events;

      --  Update position of mouse
      Inputs.GLFW.GLFW_Pointer_Input (Object.Input.all).Set_Position
        (Object.Position_X, Object.Position_Y);

      --  Update scroll offset of mouse
      Inputs.GLFW.GLFW_Pointer_Input (Object.Input.all).Set_Scroll_Offset
        (Object.Scroll_X, Object.Scroll_Y);
   end Process_Input;

   overriding
   procedure Swap_Buffers (Object : in out GLFW_Window) is
   begin
      Standard.Glfw.Windows.Context.Swap_Buffers (Object'Access);
   end Swap_Buffers;

   overriding
   procedure Close_Requested (Object : not null access GLFW_Window) is
   begin
      --  TODO Call Object.Set_Should_Close (False); if certain conditions are not met
      null;
   end Close_Requested;

   overriding
   procedure Key_Changed
     (Object   : not null access GLFW_Window;
      Key      : Standard.Glfw.Input.Keys.Key;
      Scancode : Standard.Glfw.Input.Keys.Scancode;
      Action   : Standard.Glfw.Input.Keys.Action;
      Mods     : Standard.Glfw.Input.Keys.Modifiers)
   is
      use Standard.Glfw.Input.Keys;
   begin
      if Key = Escape and Action = Press then
         Object.Set_Should_Close (True);
      end if;
      --  TODO Add Button_Input object
   end Key_Changed;

   overriding
   procedure Mouse_Position_Changed
     (Object : not null access GLFW_Window;
      X, Y   : Standard.Glfw.Input.Mouse.Coordinate) is
   begin
      Object.Position_X := GL.Types.Double (X);
      Object.Position_Y := GL.Types.Double (Y);
   end Mouse_Position_Changed;

   overriding
   procedure Mouse_Scrolled
     (Object : not null access GLFW_Window;
      X, Y   : Standard.Glfw.Input.Mouse.Scroll_Offset)
   is
      use type GL.Types.Double;
   begin
      Object.Scroll_X := Object.Scroll_X + GL.Types.Double (X);
      Object.Scroll_Y := Object.Scroll_Y + GL.Types.Double (Y);
   end Mouse_Scrolled;

   overriding
   procedure Mouse_Button_Changed
     (Object  : not null access GLFW_Window;
      Button  : Standard.Glfw.Input.Mouse.Button;
      State   : Standard.Glfw.Input.Button_State;
      Mods    : Standard.Glfw.Input.Keys.Modifiers) is
   begin
      Inputs.GLFW.GLFW_Pointer_Input (Object.Input.all).Set_Button_State (Button, State);
   end Mouse_Button_Changed;

   overriding
   procedure Framebuffer_Size_Changed
     (Object : not null access GLFW_Window;
      Width, Height : Natural) is
   begin
      Object.Width  := Width;
      Object.Height := Height;
   end Framebuffer_Size_Changed;

end Orka.Windows.GLFW;

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

with Glfw.Errors;
with Glfw.Windows.Context;
with Glfw.Windows.Hints;

with Orka.Inputs.GLFW;
with Orka.Logging;

package body Orka.Windows.GLFW is

   use Orka.Logging;
   package Messages is new Orka.Logging.Messages (Other);

   procedure Print_Error (Code : Standard.Glfw.Errors.Kind; Description : String) is
   begin
      Messages.Insert (Error, "GLFW " & Code'Image & ": " & Trim (Description));
   end Print_Error;

   function Initialize
     (Major, Minor : Natural;
      Debug : Boolean := False) return Active_GLFW'Class is
   begin
      --  Initialize GLFW
      Standard.Glfw.Errors.Set_Callback (Print_Error'Access);
      Standard.Glfw.Init;

      --  Initialize OpenGL context
      Standard.Glfw.Windows.Hints.Set_Minimum_OpenGL_Version (Major, Minor);
      Standard.Glfw.Windows.Hints.Set_Forward_Compat (True);
      Standard.Glfw.Windows.Hints.Set_Profile (Standard.Glfw.Windows.Context.Core_Profile);
      Standard.Glfw.Windows.Hints.Set_Debug_Context (Debug);

      return Active_GLFW'(Ada.Finalization.Limited_Controlled
        with Debug => Debug, Finalized => False);
   end Initialize;

   overriding
   procedure Finalize (Object : in out Active_GLFW) is
   begin
      if not Object.Finalized then
         if Object.Debug then
            Messages.Insert (Debug, "Shutting down GLFW");
         end if;
         Standard.Glfw.Shutdown;
         Object.Finalized := True;
      end if;
   end Finalize;

   overriding
   procedure Finalize (Object : in out GLFW_Window) is
   begin
      if not Object.Finalized then
         Object.Destroy;
         Object.Finalized := True;
      end if;
   end Finalize;

   function Create_Window
     (Width, Height : Positive;
      Samples : Natural := 0;
      Visible, Resizable : Boolean := True) return Window'Class
   is
      package Windows renames Standard.Glfw.Windows;
   begin
      return Result : GLFW_Window := GLFW_Window'(Windows.Window
        with Input => Inputs.GLFW.Create_Pointer_Input, Finalized => False, others => <>)
      do
         declare
            Reference : constant Windows.Window_Reference := Windows.Window (Window'Class (Result))'Access;
         begin
            Windows.Hints.Set_Visible (Visible);
            Windows.Hints.Set_Resizable (Resizable);
            Windows.Hints.Set_Samples (Samples);

            Reference.Init (Standard.Glfw.Size (Width), Standard.Glfw.Size (Height), "");

            Inputs.GLFW.GLFW_Pointer_Input (Result.Input.all).Set_Window (Reference);

            declare
               Width, Height : Standard.Glfw.Size;
            begin
               Reference.Get_Framebuffer_Size (Width, Height);
               Result.Framebuffer_Size_Changed (Natural (Width), Natural (Height));
            end;

            --  Callbacks
            Reference.Enable_Callback (Windows.Callbacks.Close);
            Reference.Enable_Callback (Windows.Callbacks.Mouse_Button);
            Reference.Enable_Callback (Windows.Callbacks.Mouse_Position);
            Reference.Enable_Callback (Windows.Callbacks.Mouse_Scroll);
            Reference.Enable_Callback (Windows.Callbacks.Key);
            Reference.Enable_Callback (Windows.Callbacks.Framebuffer_Size);

            Windows.Context.Make_Current (Reference);
         end;
      end return;
   end Create_Window;

   overriding
   function Pointer_Input
     (Object : GLFW_Window) return Inputs.Pointer_Input_Ptr
   is (Object.Input);

   overriding
   function Width (Object : GLFW_Window) return Positive is
     (Object.Width);

   overriding
   function Height (Object : GLFW_Window) return Positive is
     (Object.Height);

   overriding
   procedure Set_Title (Object : in out GLFW_Window; Value : String) is
   begin
      Standard.Glfw.Windows.Window (Object)'Access.Set_Title (Value);
   end Set_Title;

   overriding
   procedure Close (Object : in out GLFW_Window) is
   begin
      Object.Set_Should_Close (True);
   end Close;

   overriding
   function Should_Close (Object : in out GLFW_Window) return Boolean is
   begin
      return Standard.Glfw.Windows.Window (Object)'Access.Should_Close;
   end Should_Close;

   overriding
   procedure Process_Input (Object : in out GLFW_Window) is
   begin
      Standard.Glfw.Input.Poll_Events;

      --  Update position of mouse
      Inputs.GLFW.GLFW_Pointer_Input (Object.Input.all).Set_Position
        (Object.Position_X, Object.Position_Y);

      --  Update scroll offset of mouse
      Inputs.GLFW.GLFW_Pointer_Input (Object.Input.all).Set_Scroll_Offset
        (Object.Scroll_X, Object.Scroll_Y);
   end Process_Input;

   overriding
   procedure Swap_Buffers (Object : in out GLFW_Window) is
   begin
      Standard.Glfw.Windows.Context.Swap_Buffers (Object'Access);
   end Swap_Buffers;

   overriding
   procedure Close_Requested (Object : not null access GLFW_Window) is
   begin
      --  TODO Call Object.Set_Should_Close (False); if certain conditions are not met
      null;
   end Close_Requested;

   overriding
   procedure Key_Changed
     (Object   : not null access GLFW_Window;
      Key      : Standard.Glfw.Input.Keys.Key;
      Scancode : Standard.Glfw.Input.Keys.Scancode;
      Action   : Standard.Glfw.Input.Keys.Action;
      Mods     : Standard.Glfw.Input.Keys.Modifiers)
   is
      use Standard.Glfw.Input.Keys;
   begin
      if Key = Escape and Action = Press then
         Object.Set_Should_Close (True);
      end if;
      --  TODO Add Button_Input object
   end Key_Changed;

   overriding
   procedure Mouse_Position_Changed
     (Object : not null access GLFW_Window;
      X, Y   : Standard.Glfw.Input.Mouse.Coordinate) is
   begin
      Object.Position_X := GL.Types.Double (X);
      Object.Position_Y := GL.Types.Double (Y);
   end Mouse_Position_Changed;

   overriding
   procedure Mouse_Scrolled
     (Object : not null access GLFW_Window;
      X, Y   : Standard.Glfw.Input.Mouse.Scroll_Offset)
   is
      use type GL.Types.Double;
   begin
      Object.Scroll_X := Object.Scroll_X + GL.Types.Double (X);
      Object.Scroll_Y := Object.Scroll_Y + GL.Types.Double (Y);
   end Mouse_Scrolled;

   overriding
   procedure Mouse_Button_Changed
     (Object  : not null access GLFW_Window;
      Button  : Standard.Glfw.Input.Mouse.Button;
      State   : Standard.Glfw.Input.Button_State;
      Mods    : Standard.Glfw.Input.Keys.Modifiers) is
   begin
      Inputs.GLFW.GLFW_Pointer_Input (Object.Input.all).Set_Button_State (Button, State);
   end Mouse_Button_Changed;

   overriding
   procedure Framebuffer_Size_Changed
     (Object : not null access GLFW_Window;
      Width, Height : Natural) is
   begin
      Object.Width  := Width;
      Object.Height := Height;
   end Framebuffer_Size_Changed;

end Orka.Windows.GLFW;

Use Orka.Logging in GLFW error callback

orka: Use Orka.Logging in GLFW error callback

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


-----------------------------------------------------------------------
--  druss-commands -- Commands available for Druss
--  Copyright (C) 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 Util.Commands.Drivers;
with Util.Properties;
with Druss.Gateways;
package Druss.Commands is

   type Context_Type is limited record
      Gateways : Druss.Gateways.Gateway_Vector;
   end record;

   package Drivers is
     new Util.Commands.Drivers (Context_Type => Context_Type,
                                Driver_Name  => "druss-drivers");

   subtype Argument_List is Util.Commands.Argument_List;

   Driver : Drivers.Driver_Type;

   procedure Initialize;

end Druss.Commands;

-----------------------------------------------------------------------
--  druss-commands -- Commands available for Druss
--  Copyright (C) 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 Util.Commands.Drivers;
with Druss.Gateways;
package Druss.Commands is

   type Context_Type is limited record
      Gateways : Druss.Gateways.Gateway_Vector;
   end record;

   package Drivers is
     new Util.Commands.Drivers (Context_Type => Context_Type,
                                Driver_Name  => "druss-drivers");

   subtype Argument_List is Util.Commands.Argument_List;

   Driver : Drivers.Driver_Type;

   procedure Initialize;

end Druss.Commands;

Remove unused with clause

Remove unused with clause


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

with Ada.Finalization;
with Ada.Strings.Unbounded.Hash;
with Ada.Containers.Hashed_Maps;
with ADO.Sessions;
with ADO.Objects;
limited with ADO.Sessions.Factory;

--  == Sequence Generators ==
--  The sequence generator is responsible for creating unique ID's
--  across all database objects.
--
--  Each table can be associated with a sequence generator.
--  The sequence factory is shared by several sessions and the
--  implementation is thread-safe.
--
--  The HiLoGenerator implements a simple High Low sequence generator
--  by using sequences that avoid to access the database.
--
--  Example:
--
--    F  : Factory;
--    Id : Identifier;
--
--    Allocate (Manager => F, Name => "user", Id => Id);
--
--  @include ado-sequences-hilo.ads
package ADO.Sequences is

   type Session_Factory_Access is access all ADO.Sessions.Factory.Session_Factory'Class;

   --  ------------------------------
   --  Abstract sequence generator
   --  ------------------------------
   type Generator is abstract new Ada.Finalization.Limited_Controlled with private;
   type Generator_Access is access all Generator'Class;

   --  Get the name of the sequence.
   function Get_Sequence_Name (Gen : in Generator'Class) return String;

   --  Allocate an identifier using the generator.
   procedure Allocate (Gen : in out Generator;
                       Id  : in out Objects.Object_Record'Class) is abstract;

   --  Get a session to connect to the database.
   function Get_Session (Gen : in Generator) return ADO.Sessions.Master_Session'Class;

   type Generator_Factory is access
     function (Sess_Factory : in Session_Factory_Access)
               return Generator_Access;

   --  ------------------------------
   --  Sequence factory
   --  ------------------------------
   --  The sequence <b>Factory</b> allocates unique ids for new objects.
   --  The factory is shared by all connections to the same database.
   type Factory is limited private;
   type Factory_Access is access all Factory;

   --  Allocate a unique identifier for the given sequence.
   procedure Allocate (Manager : in out Factory;
                       Id      : in out Objects.Object_Record'Class);

   --  Set a generator to be used for the given sequence.
   procedure Set_Generator (Manager : in out Factory;
                            Name    : in String;
                            Gen     : in Generator_Access);

   --  Set the default factory for creating generators.
   --  The default factory is the HiLo generator.
   procedure Set_Default_Generator
     (Manager      : in out Factory;
      Factory      : in Generator_Factory;
      Sess_Factory : in Session_Factory_Access);

private

   use Ada.Strings.Unbounded;

   type Generator is abstract new Ada.Finalization.Limited_Controlled with record
      Name    : Unbounded_String;
      Factory : Session_Factory_Access;
   end record;

   --  Each sequence generator is accessed through a protected type
   --  to make sure the allocation is unique and works in multi-threaded
   --  environments.
   protected type Sequence_Generator is

      --  Allocate a unique identifier for the given sequence.
      procedure Allocate (Id   : in out Objects.Object_Record'Class);

      procedure Set_Generator (Name : in Unbounded_String;
                               Gen  : in Generator_Access);

      --  Free the generator
      procedure Clear;

   private
      Generator : Generator_Access;
   end Sequence_Generator;
   type Sequence_Generator_Access is access all Sequence_Generator;

   --  Map to keep track of allocation generators for each sequence.
   package Sequence_Maps is new Ada.Containers.Hashed_Maps
     (Key_Type     => Unbounded_String,
      Element_Type => Sequence_Generator_Access,
      Hash         => Ada.Strings.Unbounded.Hash,
      Equivalent_Keys => "=",
      "=" => "=");

   --  The sequence factory map is also accessed through a protected type.
   protected type Factory_Map is

      --  Get the sequence generator associated with the name.
      --  If there is no such generator, an entry is created by using
      --  the default generator.
      procedure Get_Generator (Name : in Unbounded_String;
                               Gen  : out Sequence_Generator_Access);

      --  Set the sequence generator associated with the name.
      procedure Set_Generator (Name : in Unbounded_String;
                               Gen  : in Sequence_Generator_Access);

      --  Set the default sequence generator.
      procedure Set_Default_Generator
        (Gen : in Generator_Factory;
         Factory : in Session_Factory_Access);

      --  Clear the factory map.
      procedure Clear;
   private
      Map              : Sequence_Maps.Map;
      Create_Generator : Generator_Factory;
      Sess_Factory     : Session_Factory_Access;
   end Factory_Map;

   type Factory is new Ada.Finalization.Limited_Controlled with record
      Map : Factory_Map;
   end record;

   overriding
   procedure Finalize (Manager : in out Factory);

end ADO.Sequences;

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

with Ada.Finalization;
with Ada.Strings.Unbounded.Hash;
with Ada.Containers.Hashed_Maps;
with ADO.Sessions;
with ADO.Objects;
limited with ADO.Sessions.Factory;

--  == Sequence Generators ==
--  The sequence generator is responsible for creating unique ID's
--  across all database objects.
--
--  Each table can be associated with a sequence generator.
--  The sequence factory is shared by several sessions and the
--  implementation is thread-safe.
--
--  The `HiLoGenerator` implements a simple High Low sequence generator
--  by using sequences that avoid to access the database.
--
--  Example:
--
--    F  : Factory;
--    Id : Identifier;
--    ...
--      Allocate (Manager => F, Name => "user", Id => Id);
--
--  @include ado-sequences-hilo.ads
package ADO.Sequences is

   type Session_Factory_Access is access all ADO.Sessions.Factory.Session_Factory'Class;

   --  ------------------------------
   --  Abstract sequence generator
   --  ------------------------------
   type Generator is abstract new Ada.Finalization.Limited_Controlled with private;
   type Generator_Access is access all Generator'Class;

   --  Get the name of the sequence.
   function Get_Sequence_Name (Gen : in Generator'Class) return String;

   --  Allocate an identifier using the generator.
   procedure Allocate (Gen : in out Generator;
                       Id  : in out Objects.Object_Record'Class) is abstract;

   --  Get a session to connect to the database.
   function Get_Session (Gen : in Generator) return ADO.Sessions.Master_Session'Class;

   type Generator_Factory is access
     function (Sess_Factory : in Session_Factory_Access)
               return Generator_Access;

   --  ------------------------------
   --  Sequence factory
   --  ------------------------------
   --  The sequence <b>Factory</b> allocates unique ids for new objects.
   --  The factory is shared by all connections to the same database.
   type Factory is limited private;
   type Factory_Access is access all Factory;

   --  Allocate a unique identifier for the given sequence.
   procedure Allocate (Manager : in out Factory;
                       Id      : in out Objects.Object_Record'Class);

   --  Set a generator to be used for the given sequence.
   procedure Set_Generator (Manager : in out Factory;
                            Name    : in String;
                            Gen     : in Generator_Access);

   --  Set the default factory for creating generators.
   --  The default factory is the HiLo generator.
   procedure Set_Default_Generator
     (Manager      : in out Factory;
      Factory      : in Generator_Factory;
      Sess_Factory : in Session_Factory_Access);

private

   use Ada.Strings.Unbounded;

   type Generator is abstract new Ada.Finalization.Limited_Controlled with record
      Name    : Unbounded_String;
      Factory : Session_Factory_Access;
   end record;

   --  Each sequence generator is accessed through a protected type
   --  to make sure the allocation is unique and works in multi-threaded
   --  environments.
   protected type Sequence_Generator is

      --  Allocate a unique identifier for the given sequence.
      procedure Allocate (Id   : in out Objects.Object_Record'Class);

      procedure Set_Generator (Name : in Unbounded_String;
                               Gen  : in Generator_Access);

      --  Free the generator
      procedure Clear;

   private
      Generator : Generator_Access;
   end Sequence_Generator;
   type Sequence_Generator_Access is access all Sequence_Generator;

   --  Map to keep track of allocation generators for each sequence.
   package Sequence_Maps is new Ada.Containers.Hashed_Maps
     (Key_Type     => Unbounded_String,
      Element_Type => Sequence_Generator_Access,
      Hash         => Ada.Strings.Unbounded.Hash,
      Equivalent_Keys => "=",
      "=" => "=");

   --  The sequence factory map is also accessed through a protected type.
   protected type Factory_Map is

      --  Get the sequence generator associated with the name.
      --  If there is no such generator, an entry is created by using
      --  the default generator.
      procedure Get_Generator (Name : in Unbounded_String;
                               Gen  : out Sequence_Generator_Access);

      --  Set the sequence generator associated with the name.
      procedure Set_Generator (Name : in Unbounded_String;
                               Gen  : in Sequence_Generator_Access);

      --  Set the default sequence generator.
      procedure Set_Default_Generator
        (Gen : in Generator_Factory;
         Factory : in Session_Factory_Access);

      --  Clear the factory map.
      procedure Clear;
   private
      Map              : Sequence_Maps.Map;
      Create_Generator : Generator_Factory;
      Sess_Factory     : Session_Factory_Access;
   end Factory_Map;

   type Factory is new Ada.Finalization.Limited_Controlled with record
      Map : Factory_Map;
   end record;

   overriding
   procedure Finalize (Manager : in out Factory);

end ADO.Sequences;

Add some documentation

Add some documentation


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

with System;
with Interfaces.C;
with Interfaces.C.Strings;
with Util.Systems.Constants;
with Util.Systems.Types;

--  The Util.Systems.Os package defines various types and operations which are specific
--  to the OS (Unix).
package Util.Systems.Os is

   --  The directory separator.
   Directory_Separator : constant Character := '/';

   --  The path separator.
   Path_Separator      : constant Character := ':';

   --  The line ending separator.
   Line_Separator      : constant String := "" & ASCII.LF;

   use Util.Systems.Constants;

   subtype Ptr is Interfaces.C.Strings.chars_ptr;
   subtype Ptr_Array is Interfaces.C.Strings.chars_ptr_array;
   type Ptr_Ptr_Array is access all Ptr_Array;

   type Process_Identifier is new Integer;

   subtype File_Type is Util.Systems.Types.File_Type;

   --  Standard file streams Posix, X/Open standard values.
   STDIN_FILENO  : constant File_Type := 0;
   STDOUT_FILENO : constant File_Type := 1;
   STDERR_FILENO : constant File_Type := 2;

   --  File is not opened
   use type Util.Systems.Types.File_Type;  --  This use clause is required by GNAT 2018 for the -1!
   NO_FILE       : constant File_Type := -1;

   --  The following values should be externalized.  They are valid for GNU/Linux.
   F_SETFL    : constant Interfaces.C.int := Util.Systems.Constants.F_SETFL;
   FD_CLOEXEC : constant Interfaces.C.int := Util.Systems.Constants.FD_CLOEXEC;

   --  These values are specific to Linux.
   O_RDONLY   : constant Interfaces.C.int := Util.Systems.Constants.O_RDONLY;
   O_WRONLY   : constant Interfaces.C.int := Util.Systems.Constants.O_WRONLY;
   O_RDWR     : constant Interfaces.C.int := Util.Systems.Constants.O_RDWR;
   O_CREAT    : constant Interfaces.C.int := Util.Systems.Constants.O_CREAT;
   O_EXCL     : constant Interfaces.C.int := Util.Systems.Constants.O_EXCL;
   O_TRUNC    : constant Interfaces.C.int := Util.Systems.Constants.O_TRUNC;
   O_APPEND   : constant Interfaces.C.int := Util.Systems.Constants.O_APPEND;

   type Size_T is mod 2 ** Standard'Address_Size;

   type Ssize_T is range -(2 ** (Standard'Address_Size - 1))
     .. +(2 ** (Standard'Address_Size - 1)) - 1;

   function Close (Fd : in File_Type) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "close";

   function Read (Fd   : in File_Type;
                  Buf  : in System.Address;
                  Size : in Size_T) return Ssize_T
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "read";

   function Write (Fd   : in File_Type;
                   Buf  : in System.Address;
                   Size : in Size_T) return Ssize_T
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "write";

   --  System exit without any process cleaning.
   --  (destructors, finalizers, atexit are not called)
   procedure Sys_Exit (Code : in Integer)
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "exit";

   --  Fork a new process
   function Sys_Fork return Process_Identifier
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "fork";

   --  Fork a new process (vfork implementation)
   function Sys_VFork return Process_Identifier
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "fork";

   --  Execute a process with the given arguments.
   function Sys_Execvp (File : in Ptr;
                        Args : in Ptr_Array) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "execvp";

   --  Execute a process with the given arguments.
   function Sys_Execve (File : in Ptr;
                        Args : in Ptr_Array;
                        Envp : in Ptr_Array) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "execve";

   --  Wait for the process Pid to finish and return
   function Sys_Waitpid (Pid     : in Integer;
                         Status  : in System.Address;
                         Options : in Integer) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "waitpid";

   --  Get the current process identification.
   function Sys_Getpid return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "getpid";

   --  Create a bi-directional pipe
   function Sys_Pipe (Fds : in System.Address) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "pipe";

   --  Make fd2 the copy of fd1
   function Sys_Dup2 (Fd1, Fd2 : in File_Type) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "dup2";

   --  Close a file
   function Sys_Close (Fd : in File_Type) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "close";

   --  Open a file
   function Sys_Open (Path  : in Ptr;
                      Flags : in Interfaces.C.int;
                      Mode  : in Util.Systems.Types.mode_t) return File_Type
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "open";

   --  Change the file settings
   function Sys_Fcntl (Fd    : in File_Type;
                       Cmd   : in Interfaces.C.int;
                       Flags : in Interfaces.C.int) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "fcntl";

   function Sys_Kill (Pid : in Integer;
                      Signal : in Integer) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "kill";

   function Sys_Stat (Path : in Ptr;
                      Stat : access Util.Systems.Types.Stat_Type) return Integer
     with Import => True, Convention => C, Link_Name => Util.Systems.Types.STAT_NAME;

   function Sys_Fstat (Fs : in File_Type;
                       Stat : access Util.Systems.Types.Stat_Type) return Integer
     with Import => True, Convention => C, Link_Name => Util.Systems.Types.FSTAT_NAME;

   function Sys_Lseek (Fs : in File_Type;
                       Offset : in Util.Systems.Types.off_t;
                       Mode   : in Util.Systems.Types.Seek_Mode)
                       return Util.Systems.Types.off_t
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "lseek";

   function Sys_Ftruncate (Fs : in File_Type;
                           Length : in Util.Systems.Types.off_t) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "ftruncate";

   function Sys_Truncate (Path  : in Ptr;
                          Length : in Util.Systems.Types.off_t) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "truncate";

   function Sys_Fchmod (Fd   : in File_Type;
                        Mode : in Util.Systems.Types.mode_t) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "fchmod";

   --  Change permission of a file.
   function Sys_Chmod (Path  : in Ptr;
                       Mode  : in Util.Systems.Types.mode_t) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "chmod";

   --  Change working directory.
   function Sys_Chdir (Path : in Ptr) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "chdir";

   --  Rename a file (the Ada.Directories.Rename does not allow to use
   --  the Unix atomic file rename!)
   function Sys_Rename (Oldpath  : in String;
                        Newpath  : in String) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "rename";

   function Sys_Unlink (Path  : in String) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "unlink";

   --  Libc errno.  The __get_errno function is provided by the GNAT runtime.
   function Errno return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "__get_errno";

   function Strerror (Errno : in Integer) return Interfaces.C.Strings.chars_ptr
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "strerror";

   type DIR is new System.Address;

   Null_Dir : constant DIR := DIR (System.Null_Address);

   --  Equivalent to Posix opendir (3) but handles some portability issues.
   --  We could use opendir, readdir_r and closedir but the __gnat_* alternative
   --  solves
   function Opendir (Directory : in String) return DIR
      with Import, External_Name => "__gnat_opendir", Convention => C;

   function Readdir (Directory : in DIR;
                     Buffer    : in System.Address;
                     Last      : not null access Integer) return System.Address
      with Import, External_Name => "__gnat_readdir", Convention => C;

   function Closedir (Directory : in DIR) return Integer
      with Import, External_Name => "__gnat_closedir", Convention => C;

end Util.Systems.Os;

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

with System;
with Interfaces.C;
with Interfaces.C.Strings;
with Util.Systems.Constants;
with Util.Systems.Types;

--  The Util.Systems.Os package defines various types and operations which are specific
--  to the OS (Unix).
package Util.Systems.Os is

   --  The directory separator.
   Directory_Separator : constant Character := '/';

   --  The path separator.
   Path_Separator      : constant Character := ':';

   --  The line ending separator.
   Line_Separator      : constant String := "" & ASCII.LF;

   use Util.Systems.Constants;

   subtype Ptr is Interfaces.C.Strings.chars_ptr;
   subtype Ptr_Array is Interfaces.C.Strings.chars_ptr_array;
   type Ptr_Ptr_Array is access all Ptr_Array;

   type Process_Identifier is new Integer;

   subtype File_Type is Util.Systems.Types.File_Type;

   --  Standard file streams Posix, X/Open standard values.
   STDIN_FILENO  : constant File_Type := 0;
   STDOUT_FILENO : constant File_Type := 1;
   STDERR_FILENO : constant File_Type := 2;

   --  File is not opened
   use type Util.Systems.Types.File_Type;  --  This use clause is required by GNAT 2018 for the -1!
   NO_FILE       : constant File_Type := -1;

   --  The following values should be externalized.  They are valid for GNU/Linux.
   F_SETFL    : constant Interfaces.C.int := Util.Systems.Constants.F_SETFL;
   FD_CLOEXEC : constant Interfaces.C.int := Util.Systems.Constants.FD_CLOEXEC;

   --  These values are specific to Linux.
   O_RDONLY   : constant Interfaces.C.int := Util.Systems.Constants.O_RDONLY;
   O_WRONLY   : constant Interfaces.C.int := Util.Systems.Constants.O_WRONLY;
   O_RDWR     : constant Interfaces.C.int := Util.Systems.Constants.O_RDWR;
   O_CREAT    : constant Interfaces.C.int := Util.Systems.Constants.O_CREAT;
   O_EXCL     : constant Interfaces.C.int := Util.Systems.Constants.O_EXCL;
   O_TRUNC    : constant Interfaces.C.int := Util.Systems.Constants.O_TRUNC;
   O_APPEND   : constant Interfaces.C.int := Util.Systems.Constants.O_APPEND;

   type Size_T is mod 2 ** Standard'Address_Size;

   type Ssize_T is range -(2 ** (Standard'Address_Size - 1))
     .. +(2 ** (Standard'Address_Size - 1)) - 1;

   function Close (Fd : in File_Type) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "close";

   function Read (Fd   : in File_Type;
                  Buf  : in System.Address;
                  Size : in Size_T) return Ssize_T
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "read";

   function Write (Fd   : in File_Type;
                   Buf  : in System.Address;
                   Size : in Size_T) return Ssize_T
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "write";

   --  System exit without any process cleaning.
   --  (destructors, finalizers, atexit are not called)
   procedure Sys_Exit (Code : in Integer)
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "exit";

   --  Fork a new process
   function Sys_Fork return Process_Identifier
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "fork";

   --  Fork a new process (vfork implementation)
   function Sys_VFork return Process_Identifier
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "fork";

   --  Execute a process with the given arguments.
   function Sys_Execvp (File : in Ptr;
                        Args : in Ptr_Array) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "execvp";

   --  Execute a process with the given arguments.
   function Sys_Execve (File : in Ptr;
                        Args : in Ptr_Array;
                        Envp : in Ptr_Array) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "execve";

   --  Wait for the process Pid to finish and return
   function Sys_Waitpid (Pid     : in Integer;
                         Status  : in System.Address;
                         Options : in Integer) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "waitpid";

   --  Get the current process identification.
   function Sys_Getpid return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "getpid";

   --  Create a bi-directional pipe
   function Sys_Pipe (Fds : in System.Address) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "pipe";

   --  Make fd2 the copy of fd1
   function Sys_Dup2 (Fd1, Fd2 : in File_Type) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "dup2";

   --  Close a file
   function Sys_Close (Fd : in File_Type) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "close";

   --  Open a file
   function Sys_Open (Path  : in Ptr;
                      Flags : in Interfaces.C.int;
                      Mode  : in Util.Systems.Types.mode_t) return File_Type
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "open";

   --  Change the file settings
   function Sys_Fcntl (Fd    : in File_Type;
                       Cmd   : in Interfaces.C.int;
                       Flags : in Interfaces.C.int) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "fcntl";

   function Sys_Kill (Pid : in Integer;
                      Signal : in Integer) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "kill";

   function Sys_Stat (Path : in Ptr;
                      Stat : access Util.Systems.Types.Stat_Type) return Integer
     with Import => True, Convention => C, Link_Name => Util.Systems.Types.STAT_NAME;

   function Sys_Lstat (Path : in String;
                       Stat : access Util.Systems.Types.Stat_Type) return Integer
     with Import => True, Convention => C, Link_Name => Util.Systems.Types.LSTAT_NAME;

   function Sys_Fstat (Fs : in File_Type;
                       Stat : access Util.Systems.Types.Stat_Type) return Integer
     with Import => True, Convention => C, Link_Name => Util.Systems.Types.FSTAT_NAME;

   function Sys_Lseek (Fs : in File_Type;
                       Offset : in Util.Systems.Types.off_t;
                       Mode   : in Util.Systems.Types.Seek_Mode)
                       return Util.Systems.Types.off_t
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "lseek";

   function Sys_Ftruncate (Fs : in File_Type;
                           Length : in Util.Systems.Types.off_t) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "ftruncate";

   function Sys_Truncate (Path  : in Ptr;
                          Length : in Util.Systems.Types.off_t) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "truncate";

   function Sys_Fchmod (Fd   : in File_Type;
                        Mode : in Util.Systems.Types.mode_t) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "fchmod";

   --  Change permission of a file.
   function Sys_Chmod (Path  : in Ptr;
                       Mode  : in Util.Systems.Types.mode_t) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "chmod";

   --  Change working directory.
   function Sys_Chdir (Path : in Ptr) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "chdir";

   --  Rename a file (the Ada.Directories.Rename does not allow to use
   --  the Unix atomic file rename!)
   function Sys_Rename (Oldpath  : in String;
                        Newpath  : in String) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "rename";

   function Sys_Unlink (Path  : in String) return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "unlink";

   --  Libc errno.  The __get_errno function is provided by the GNAT runtime.
   function Errno return Integer
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "__get_errno";

   function Strerror (Errno : in Integer) return Interfaces.C.Strings.chars_ptr
     with Import => True, Convention => C, Link_Name => SYMBOL_PREFIX & "strerror";

   type DIR is new System.Address;

   Null_Dir : constant DIR := DIR (System.Null_Address);

   --  Equivalent to Posix opendir (3) but handles some portability issues.
   --  We could use opendir, readdir_r and closedir but the __gnat_* alternative
   --  solves
   function Opendir (Directory : in String) return DIR
      with Import, External_Name => "__gnat_opendir", Convention => C;

   function Readdir (Directory : in DIR;
                     Buffer    : in System.Address;
                     Last      : not null access Integer) return System.Address
      with Import, External_Name => "__gnat_readdir", Convention => C;

   function Closedir (Directory : in DIR) return Integer
      with Import, External_Name => "__gnat_closedir", Convention => C;

end Util.Systems.Os;

Declare Sys_Lstat function

Declare Sys_Lstat function