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

with Ada.Finalization;

with ADO.Schemas;
with ADO.Statements;
with ADO.Objects;
with ADO.Objects.Cache;
with ADO.Drivers.Connections;
with ADO.Queries;
with ADO.SQL;
with ADO.Caches;

with Util.Concurrent.Counters;
limited with ADO.Sequences;
limited with ADO.Schemas.Entities;

--  == Session ==
--  The <tt>ADO.Sessions</tt> package defines the control and management of database sessions.
--  The database session is represented by the <tt>Session</tt> or <tt>Master_Session</tt> types.
--  It provides operation to create a database statement that can be executed.
--  The <tt>Session</tt> type is used to represent read-only database sessions.  It provides
--  operations to query the database but it does not allow to update or delete content.
--  The <tt>Master_Session</tt> type extends the <tt>Session</tt> type to provide write
--  access and it provides operations to get update or delete statements.  The differentiation
--  between the two sessions is provided for the support of database replications with
--  databases such as MySQL.
--
--  @include ado-sessions-factory.ads
--
package ADO.Sessions is

   use ADO.Statements;

   --  Raised for all errors reported by the database
   DB_Error : exception;

   --  Raised if the database connection is not open.
   NOT_OPEN : exception;

   NOT_FOUND : exception;

   NO_DATABASE : exception;

   --  Raised when the connection URI is invalid.
   Connection_Error : exception;

   --  The database connection status
   type Connection_Status is (OPEN, CLOSED);

   type Object_Factory is tagged private;

   --  ---------
   --  Session
   --  ---------
   --  Read-only database connection (or slave connection).
   --
   type Session is tagged private;

   --  Get the session status.
   function Get_Status (Database : in Session) return Connection_Status;

   --  Get the database driver which manages this connection.
   function Get_Driver (Database : in Session) return ADO.Drivers.Connections.Driver_Access;

   --  Close the session.
   procedure Close (Database : in out Session);

   --  Insert a new cache in the manager.  The cache is identified by the given name.
   procedure Add_Cache (Database : in out Session;
                        Name     : in String;
                        Cache    : in ADO.Caches.Cache_Type_Access);

   --  Attach the object to the session.
   procedure Attach (Database : in out Session;
                     Object   : in ADO.Objects.Object_Ref'Class);

   --  Check if the session contains the object identified by the given key.
   function Contains (Database : in Session;
                      Item     : in ADO.Objects.Object_Key) return Boolean;

   --  Remove the object from the session cache.
   procedure Evict (Database : in out Session;
                    Item     : in ADO.Objects.Object_Key);

   --  Create a query statement.  The statement is not prepared
   function Create_Statement (Database : in Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement;

   --  Create a query statement.  The statement is not prepared
   function Create_Statement (Database : in Session;
                              Query    : in String)
                              return Query_Statement;

   --  Create a query statement.  The statement is not prepared
   function Create_Statement (Database : in Session;
                              Query    : in ADO.Queries.Context'Class)
                              return Query_Statement;

   --  Create a query statement and initialize the SQL statement with the query definition.
   function Create_Statement (Database : in Session;
                              Query    : in ADO.Queries.Query_Definition_Access)
                              return Query_Statement;

   --  Create a query statement.  The statement is not prepared
   function Create_Statement (Database : in Session;
                              Query    : in ADO.SQL.Query'Class;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement;

   --  Load the database schema definition for the current database.
   procedure Load_Schema (Database : in Session;
                          Schema   : out ADO.Schemas.Schema_Definition);

   --  Internal method to get the session proxy associated with the given database session.
   --  The session proxy is associated with some ADO objects to be able to retrieve the database
   --  session for the implementation of lazy loading.  The session proxy is kept until the
   --  session exist and at least one ADO object is refering to it.
   function Get_Session_Proxy (Database : in Session) return ADO.Objects.Session_Proxy_Access;

   --  ---------
   --  Master Session
   --  ---------
   --  Read-write session.
   --
   type Master_Session is new Session with private;

   --  Start a transaction.
   procedure Begin_Transaction (Database : in out Master_Session);

   --  Commit the current transaction.
   procedure Commit (Database : in out Master_Session);

   --  Rollback the current transaction.
   procedure Rollback (Database : in out Master_Session);

   --  Allocate an identifier for the table.
   procedure Allocate (Database : in out Master_Session;
                       Id       : in out ADO.Objects.Object_Record'Class);

   --  Flush the objects that were modified.
   procedure Flush (Database : in out Master_Session);

   --  Create a delete statement
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement;

   --  Create an update statement
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement;

   --  Create an insert statement
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement;

   type Session_Record is limited private;
   type Session_Record_Access is access all Session_Record;

private

   type Entity_Cache_Access is access ADO.Schemas.Entities.Entity_Cache;

   type Object_Factory is tagged record
      A : Integer;
   end record;
   type Object_Factory_Access is access all Object_Factory'Class;

   --  The Session_Record maintains the connection information to the database for
   --  the duration of the session.  It also maintains a cache of application objects
   --  which is used when session objects are fetched (either through Load or a Find).
   --  The connection is released and the session record is deleted when the session
   --  is closed with Close.
   --
   --  For the lazy loading support, each object is associated with a shared Session_Proxy
   --  object that allows to give access to the session record associated with the object.
   --  When a session is closed, the Session_Proxy is not deleted but it is simply
   --  unlinked from the session record.
   type Session_Record is limited record
      Counter  : Util.Concurrent.Counters.Counter := Util.Concurrent.Counters.ONE;
      Database : ADO.Drivers.Connections.Ref.Ref;
      Proxy    : ADO.Objects.Session_Proxy_Access;
      Cache    : ADO.Objects.Cache.Object_Cache;
      Entities : Entity_Cache_Access;
      Values   : ADO.Caches.Cache_Manager_Access;
   end record;

   type Session is new Ada.Finalization.Controlled with record
      Impl : Session_Record_Access := null;
   end record;

   overriding
   procedure Adjust (Object : in out Session);

   overriding
   procedure Finalize (Object : in out Session);

   type Factory_Access is access all ADO.Sequences.Factory;

   type Master_Session is new Session with record
      Sequences : Factory_Access;
   end record;

   procedure Check_Session (Database : in Session'Class;
                            Message  : in String := "");
   pragma Inline (Check_Session);

end ADO.Sessions;

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

with Ada.Finalization;

with ADO.Schemas;
with ADO.Statements;
with ADO.Objects;
with ADO.Objects.Cache;
with ADO.Drivers.Connections;
with ADO.Queries;
with ADO.SQL;
with ADO.Caches;

with Util.Concurrent.Counters;
limited with ADO.Sequences;
limited with ADO.Schemas.Entities;

--  == Session ==
--  The `ADO.Sessions` package defines the control and management of database sessions.
--  The database session is represented by the `Session` or `Master_Session` types.
--  It provides operation to create a database statement that can be executed.
--  The `Session` type is used to represent read-only database sessions.  It provides
--  operations to query the database but it does not allow to update or delete content.
--  The `Master_Session` type extends the `Session` type to provide write
--  access and it provides operations to get update or delete statements.  The differentiation
--  between the two sessions is provided for the support of database replications with
--  databases such as MySQL.
--
--  @include ado-sessions-factory.ads
--  @include ado-sequences.ads
--
package ADO.Sessions is

   use ADO.Statements;

   --  Raised for all errors reported by the database
   DB_Error : exception;

   --  Raised if the database connection is not open.
   NOT_OPEN : exception;

   NOT_FOUND : exception;

   NO_DATABASE : exception;

   --  Raised when the connection URI is invalid.
   Connection_Error : exception;

   --  The database connection status
   type Connection_Status is (OPEN, CLOSED);

   type Object_Factory is tagged private;

   --  ---------
   --  Session
   --  ---------
   --  Read-only database connection (or slave connection).
   --
   type Session is tagged private;

   --  Get the session status.
   function Get_Status (Database : in Session) return Connection_Status;

   --  Get the database driver which manages this connection.
   function Get_Driver (Database : in Session) return ADO.Drivers.Connections.Driver_Access;

   --  Close the session.
   procedure Close (Database : in out Session);

   --  Insert a new cache in the manager.  The cache is identified by the given name.
   procedure Add_Cache (Database : in out Session;
                        Name     : in String;
                        Cache    : in ADO.Caches.Cache_Type_Access);

   --  Attach the object to the session.
   procedure Attach (Database : in out Session;
                     Object   : in ADO.Objects.Object_Ref'Class);

   --  Check if the session contains the object identified by the given key.
   function Contains (Database : in Session;
                      Item     : in ADO.Objects.Object_Key) return Boolean;

   --  Remove the object from the session cache.
   procedure Evict (Database : in out Session;
                    Item     : in ADO.Objects.Object_Key);

   --  Create a query statement.  The statement is not prepared
   function Create_Statement (Database : in Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement;

   --  Create a query statement.  The statement is not prepared
   function Create_Statement (Database : in Session;
                              Query    : in String)
                              return Query_Statement;

   --  Create a query statement.  The statement is not prepared
   function Create_Statement (Database : in Session;
                              Query    : in ADO.Queries.Context'Class)
                              return Query_Statement;

   --  Create a query statement and initialize the SQL statement with the query definition.
   function Create_Statement (Database : in Session;
                              Query    : in ADO.Queries.Query_Definition_Access)
                              return Query_Statement;

   --  Create a query statement.  The statement is not prepared
   function Create_Statement (Database : in Session;
                              Query    : in ADO.SQL.Query'Class;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement;

   --  Load the database schema definition for the current database.
   procedure Load_Schema (Database : in Session;
                          Schema   : out ADO.Schemas.Schema_Definition);

   --  Internal method to get the session proxy associated with the given database session.
   --  The session proxy is associated with some ADO objects to be able to retrieve the database
   --  session for the implementation of lazy loading.  The session proxy is kept until the
   --  session exist and at least one ADO object is refering to it.
   function Get_Session_Proxy (Database : in Session) return ADO.Objects.Session_Proxy_Access;

   --  ---------
   --  Master Session
   --  ---------
   --  Read-write session.
   --
   type Master_Session is new Session with private;

   --  Start a transaction.
   procedure Begin_Transaction (Database : in out Master_Session);

   --  Commit the current transaction.
   procedure Commit (Database : in out Master_Session);

   --  Rollback the current transaction.
   procedure Rollback (Database : in out Master_Session);

   --  Allocate an identifier for the table.
   procedure Allocate (Database : in out Master_Session;
                       Id       : in out ADO.Objects.Object_Record'Class);

   --  Flush the objects that were modified.
   procedure Flush (Database : in out Master_Session);

   --  Create a delete statement
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement;

   --  Create an update statement
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement;

   --  Create an insert statement
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement;

   type Session_Record is limited private;
   type Session_Record_Access is access all Session_Record;

private

   type Entity_Cache_Access is access ADO.Schemas.Entities.Entity_Cache;

   type Object_Factory is tagged record
      A : Integer;
   end record;
   type Object_Factory_Access is access all Object_Factory'Class;

   --  The Session_Record maintains the connection information to the database for
   --  the duration of the session.  It also maintains a cache of application objects
   --  which is used when session objects are fetched (either through Load or a Find).
   --  The connection is released and the session record is deleted when the session
   --  is closed with Close.
   --
   --  For the lazy loading support, each object is associated with a shared Session_Proxy
   --  object that allows to give access to the session record associated with the object.
   --  When a session is closed, the Session_Proxy is not deleted but it is simply
   --  unlinked from the session record.
   type Session_Record is limited record
      Counter  : Util.Concurrent.Counters.Counter := Util.Concurrent.Counters.ONE;
      Database : ADO.Drivers.Connections.Ref.Ref;
      Proxy    : ADO.Objects.Session_Proxy_Access;
      Cache    : ADO.Objects.Cache.Object_Cache;
      Entities : Entity_Cache_Access;
      Values   : ADO.Caches.Cache_Manager_Access;
   end record;

   type Session is new Ada.Finalization.Controlled with record
      Impl : Session_Record_Access := null;
   end record;

   overriding
   procedure Adjust (Object : in out Session);

   overriding
   procedure Finalize (Object : in out Session);

   type Factory_Access is access all ADO.Sequences.Factory;

   type Master_Session is new Session with record
      Sequences : Factory_Access;
   end record;

   procedure Check_Session (Database : in Session'Class;
                            Message  : in String := "");
   pragma Inline (Check_Session);

end ADO.Sessions;

Add some documentation

Add some documentation


--  Generated by gperfhash
package Sqlite3_H.Perfect_Hash is

   function Hash (S : String) return Natural;

   --  Returns true if the string <b>S</b> is a keyword.
   function Is_Keyword (S : in String) return Boolean;

   type Name_Access is access constant String;
   type Keyword_Array is array (Natural range <>) of Name_Access;
   Keywords : constant Keyword_Array;
private

   K_0             : aliased constant String := "ABORT";
   K_1             : aliased constant String := "ACTION";
   K_2             : aliased constant String := "ADD";
   K_3             : aliased constant String := "AFTER";
   K_4             : aliased constant String := "ALL";
   K_5             : aliased constant String := "ALTER";
   K_6             : aliased constant String := "ANALYZE";
   K_7             : aliased constant String := "AND";
   K_8             : aliased constant String := "AS";
   K_9             : aliased constant String := "ASC";
   K_10            : aliased constant String := "ATTACH";
   K_11            : aliased constant String := "AUTOINCREMENT";
   K_12            : aliased constant String := "BEFORE";
   K_13            : aliased constant String := "BEGIN";
   K_14            : aliased constant String := "BETWEEN";
   K_15            : aliased constant String := "BY";
   K_16            : aliased constant String := "CASCADE";
   K_17            : aliased constant String := "CASE";
   K_18            : aliased constant String := "CAST";
   K_19            : aliased constant String := "CHECK";
   K_20            : aliased constant String := "COLLATE";
   K_21            : aliased constant String := "COLUMN";
   K_22            : aliased constant String := "COMMIT";
   K_23            : aliased constant String := "CONFLICT";
   K_24            : aliased constant String := "CONSTRAINT";
   K_25            : aliased constant String := "CREATE";
   K_26            : aliased constant String := "CROSS";
   K_27            : aliased constant String := "CURRENT_DATE";
   K_28            : aliased constant String := "CURRENT_TIME";
   K_29            : aliased constant String := "CURRENT_TIMESTAMP";
   K_30            : aliased constant String := "DATABASE";
   K_31            : aliased constant String := "DEFAULT";
   K_32            : aliased constant String := "DEFERRABLE";
   K_33            : aliased constant String := "DEFERRED";
   K_34            : aliased constant String := "DELETE";
   K_35            : aliased constant String := "DESC";
   K_36            : aliased constant String := "DETACH";
   K_37            : aliased constant String := "DISTINCT";
   K_38            : aliased constant String := "DROP";
   K_39            : aliased constant String := "EACH";
   K_40            : aliased constant String := "ELSE";
   K_41            : aliased constant String := "END";
   K_42            : aliased constant String := "ESCAPE";
   K_43            : aliased constant String := "EXCEPT";
   K_44            : aliased constant String := "EXCLUSIVE";
   K_45            : aliased constant String := "EXISTS";
   K_46            : aliased constant String := "EXPLAIN";
   K_47            : aliased constant String := "FAIL";
   K_48            : aliased constant String := "FOR";
   K_49            : aliased constant String := "FOREIGN";
   K_50            : aliased constant String := "FROM";
   K_51            : aliased constant String := "FULL";
   K_52            : aliased constant String := "GLOB";
   K_53            : aliased constant String := "GROUP";
   K_54            : aliased constant String := "HAVING";
   K_55            : aliased constant String := "IF";
   K_56            : aliased constant String := "IGNORE";
   K_57            : aliased constant String := "IMMEDIATE";
   K_58            : aliased constant String := "IN";
   K_59            : aliased constant String := "INDEX";
   K_60            : aliased constant String := "INDEXED";
   K_61            : aliased constant String := "INITIALLY";
   K_62            : aliased constant String := "INNER";
   K_63            : aliased constant String := "INSERT";
   K_64            : aliased constant String := "INSTEAD";
   K_65            : aliased constant String := "INTERSECT";
   K_66            : aliased constant String := "INTO";
   K_67            : aliased constant String := "IS";
   K_68            : aliased constant String := "ISNULL";
   K_69            : aliased constant String := "JOIN";
   K_70            : aliased constant String := "KEY";
   K_71            : aliased constant String := "LEFT";
   K_72            : aliased constant String := "LIKE";
   K_73            : aliased constant String := "LIMIT";
   K_74            : aliased constant String := "MATCH";
   K_75            : aliased constant String := "NATURAL";
   K_76            : aliased constant String := "NO";
   K_77            : aliased constant String := "NOT";
   K_78            : aliased constant String := "NOTNULL";
   K_79            : aliased constant String := "NULL";
   K_80            : aliased constant String := "OF";
   K_81            : aliased constant String := "OFFSET";
   K_82            : aliased constant String := "ON";
   K_83            : aliased constant String := "OR";
   K_84            : aliased constant String := "ORDER";
   K_85            : aliased constant String := "OUTER";
   K_86            : aliased constant String := "PLAN";
   K_87            : aliased constant String := "PRAGMA";
   K_88            : aliased constant String := "PRIMARY";
   K_89            : aliased constant String := "QUERY";
   K_90            : aliased constant String := "RAISE";
   K_91            : aliased constant String := "REFERENCES";
   K_92            : aliased constant String := "REGEXP";
   K_93            : aliased constant String := "REINDEX";
   K_94            : aliased constant String := "RELEASE";
   K_95            : aliased constant String := "RENAME";
   K_96            : aliased constant String := "REPLACE";
   K_97            : aliased constant String := "RESTRICT";
   K_98            : aliased constant String := "RIGHT";
   K_99            : aliased constant String := "ROLLBACK";
   K_100           : aliased constant String := "ROW";
   K_101           : aliased constant String := "SAVEPOINT";
   K_102           : aliased constant String := "SELECT";
   K_103           : aliased constant String := "SET";
   K_104           : aliased constant String := "TABLE";
   K_105           : aliased constant String := "TEMP";
   K_106           : aliased constant String := "TEMPORARY";
   K_107           : aliased constant String := "THEN";
   K_108           : aliased constant String := "TO";
   K_109           : aliased constant String := "TRANSACTION";
   K_110           : aliased constant String := "TRIGGER";
   K_111           : aliased constant String := "UNION";
   K_112           : aliased constant String := "UNIQUE";
   K_113           : aliased constant String := "UPDATE";
   K_114           : aliased constant String := "USING";
   K_115           : aliased constant String := "VACUUM";
   K_116           : aliased constant String := "VALUES";
   K_117           : aliased constant String := "VIEW";
   K_118           : aliased constant String := "VIRTUAL";
   K_119           : aliased constant String := "WHEN";
   K_120           : aliased constant String := "WHERE";

   Keywords : constant Keyword_Array := (
      K_0'Access, K_1'Access, K_2'Access, K_3'Access,
      K_4'Access, K_5'Access, K_6'Access, K_7'Access,
      K_8'Access, K_9'Access, K_10'Access, K_11'Access,
      K_12'Access, K_13'Access, K_14'Access, K_15'Access,
      K_16'Access, K_17'Access, K_18'Access, K_19'Access,
      K_20'Access, K_21'Access, K_22'Access, K_23'Access,
      K_24'Access, K_25'Access, K_26'Access, K_27'Access,
      K_28'Access, K_29'Access, K_30'Access, K_31'Access,
      K_32'Access, K_33'Access, K_34'Access, K_35'Access,
      K_36'Access, K_37'Access, K_38'Access, K_39'Access,
      K_40'Access, K_41'Access, K_42'Access, K_43'Access,
      K_44'Access, K_45'Access, K_46'Access, K_47'Access,
      K_48'Access, K_49'Access, K_50'Access, K_51'Access,
      K_52'Access, K_53'Access, K_54'Access, K_55'Access,
      K_56'Access, K_57'Access, K_58'Access, K_59'Access,
      K_60'Access, K_61'Access, K_62'Access, K_63'Access,
      K_64'Access, K_65'Access, K_66'Access, K_67'Access,
      K_68'Access, K_69'Access, K_70'Access, K_71'Access,
      K_72'Access, K_73'Access, K_74'Access, K_75'Access,
      K_76'Access, K_77'Access, K_78'Access, K_79'Access,
      K_80'Access, K_81'Access, K_82'Access, K_83'Access,
      K_84'Access, K_85'Access, K_86'Access, K_87'Access,
      K_88'Access, K_89'Access, K_90'Access, K_91'Access,
      K_92'Access, K_93'Access, K_94'Access, K_95'Access,
      K_96'Access, K_97'Access, K_98'Access, K_99'Access,
      K_100'Access, K_101'Access, K_102'Access, K_103'Access,
      K_104'Access, K_105'Access, K_106'Access, K_107'Access,
      K_108'Access, K_109'Access, K_110'Access, K_111'Access,
      K_112'Access, K_113'Access, K_114'Access, K_115'Access,
      K_116'Access, K_117'Access, K_118'Access, K_119'Access,
      K_120'Access);
end Sqlite3_H.Perfect_Hash;

--  Generated by gperfhash
package Sqlite3_H.Perfect_Hash is

   pragma Preelaborate;

   function Hash (S : String) return Natural;

   --  Returns true if the string <b>S</b> is a keyword.
   function Is_Keyword (S : in String) return Boolean;

   type Name_Access is access constant String;
   type Keyword_Array is array (Natural range <>) of Name_Access;
   Keywords : constant Keyword_Array;
private

   K_0             : aliased constant String := "ABORT";
   K_1             : aliased constant String := "ACTION";
   K_2             : aliased constant String := "ADD";
   K_3             : aliased constant String := "AFTER";
   K_4             : aliased constant String := "ALL";
   K_5             : aliased constant String := "ALTER";
   K_6             : aliased constant String := "ANALYZE";
   K_7             : aliased constant String := "AND";
   K_8             : aliased constant String := "AS";
   K_9             : aliased constant String := "ASC";
   K_10            : aliased constant String := "ATTACH";
   K_11            : aliased constant String := "AUTOINCREMENT";
   K_12            : aliased constant String := "BEFORE";
   K_13            : aliased constant String := "BEGIN";
   K_14            : aliased constant String := "BETWEEN";
   K_15            : aliased constant String := "BY";
   K_16            : aliased constant String := "CASCADE";
   K_17            : aliased constant String := "CASE";
   K_18            : aliased constant String := "CAST";
   K_19            : aliased constant String := "CHECK";
   K_20            : aliased constant String := "COLLATE";
   K_21            : aliased constant String := "COLUMN";
   K_22            : aliased constant String := "COMMIT";
   K_23            : aliased constant String := "CONFLICT";
   K_24            : aliased constant String := "CONSTRAINT";
   K_25            : aliased constant String := "CREATE";
   K_26            : aliased constant String := "CROSS";
   K_27            : aliased constant String := "CURRENT_DATE";
   K_28            : aliased constant String := "CURRENT_TIME";
   K_29            : aliased constant String := "CURRENT_TIMESTAMP";
   K_30            : aliased constant String := "DATABASE";
   K_31            : aliased constant String := "DEFAULT";
   K_32            : aliased constant String := "DEFERRABLE";
   K_33            : aliased constant String := "DEFERRED";
   K_34            : aliased constant String := "DELETE";
   K_35            : aliased constant String := "DESC";
   K_36            : aliased constant String := "DETACH";
   K_37            : aliased constant String := "DISTINCT";
   K_38            : aliased constant String := "DROP";
   K_39            : aliased constant String := "EACH";
   K_40            : aliased constant String := "ELSE";
   K_41            : aliased constant String := "END";
   K_42            : aliased constant String := "ESCAPE";
   K_43            : aliased constant String := "EXCEPT";
   K_44            : aliased constant String := "EXCLUSIVE";
   K_45            : aliased constant String := "EXISTS";
   K_46            : aliased constant String := "EXPLAIN";
   K_47            : aliased constant String := "FAIL";
   K_48            : aliased constant String := "FOR";
   K_49            : aliased constant String := "FOREIGN";
   K_50            : aliased constant String := "FROM";
   K_51            : aliased constant String := "FULL";
   K_52            : aliased constant String := "GLOB";
   K_53            : aliased constant String := "GROUP";
   K_54            : aliased constant String := "HAVING";
   K_55            : aliased constant String := "IF";
   K_56            : aliased constant String := "IGNORE";
   K_57            : aliased constant String := "IMMEDIATE";
   K_58            : aliased constant String := "IN";
   K_59            : aliased constant String := "INDEX";
   K_60            : aliased constant String := "INDEXED";
   K_61            : aliased constant String := "INITIALLY";
   K_62            : aliased constant String := "INNER";
   K_63            : aliased constant String := "INSERT";
   K_64            : aliased constant String := "INSTEAD";
   K_65            : aliased constant String := "INTERSECT";
   K_66            : aliased constant String := "INTO";
   K_67            : aliased constant String := "IS";
   K_68            : aliased constant String := "ISNULL";
   K_69            : aliased constant String := "JOIN";
   K_70            : aliased constant String := "KEY";
   K_71            : aliased constant String := "LEFT";
   K_72            : aliased constant String := "LIKE";
   K_73            : aliased constant String := "LIMIT";
   K_74            : aliased constant String := "MATCH";
   K_75            : aliased constant String := "NATURAL";
   K_76            : aliased constant String := "NO";
   K_77            : aliased constant String := "NOT";
   K_78            : aliased constant String := "NOTNULL";
   K_79            : aliased constant String := "NULL";
   K_80            : aliased constant String := "OF";
   K_81            : aliased constant String := "OFFSET";
   K_82            : aliased constant String := "ON";
   K_83            : aliased constant String := "OR";
   K_84            : aliased constant String := "ORDER";
   K_85            : aliased constant String := "OUTER";
   K_86            : aliased constant String := "PLAN";
   K_87            : aliased constant String := "PRAGMA";
   K_88            : aliased constant String := "PRIMARY";
   K_89            : aliased constant String := "QUERY";
   K_90            : aliased constant String := "RAISE";
   K_91            : aliased constant String := "REFERENCES";
   K_92            : aliased constant String := "REGEXP";
   K_93            : aliased constant String := "REINDEX";
   K_94            : aliased constant String := "RELEASE";
   K_95            : aliased constant String := "RENAME";
   K_96            : aliased constant String := "REPLACE";
   K_97            : aliased constant String := "RESTRICT";
   K_98            : aliased constant String := "RIGHT";
   K_99            : aliased constant String := "ROLLBACK";
   K_100           : aliased constant String := "ROW";
   K_101           : aliased constant String := "SAVEPOINT";
   K_102           : aliased constant String := "SELECT";
   K_103           : aliased constant String := "SET";
   K_104           : aliased constant String := "TABLE";
   K_105           : aliased constant String := "TEMP";
   K_106           : aliased constant String := "TEMPORARY";
   K_107           : aliased constant String := "THEN";
   K_108           : aliased constant String := "TO";
   K_109           : aliased constant String := "TRANSACTION";
   K_110           : aliased constant String := "TRIGGER";
   K_111           : aliased constant String := "UNION";
   K_112           : aliased constant String := "UNIQUE";
   K_113           : aliased constant String := "UPDATE";
   K_114           : aliased constant String := "USING";
   K_115           : aliased constant String := "VACUUM";
   K_116           : aliased constant String := "VALUES";
   K_117           : aliased constant String := "VIEW";
   K_118           : aliased constant String := "VIRTUAL";
   K_119           : aliased constant String := "WHEN";
   K_120           : aliased constant String := "WHERE";

   Keywords : constant Keyword_Array := (
      K_0'Access, K_1'Access, K_2'Access, K_3'Access,
      K_4'Access, K_5'Access, K_6'Access, K_7'Access,
      K_8'Access, K_9'Access, K_10'Access, K_11'Access,
      K_12'Access, K_13'Access, K_14'Access, K_15'Access,
      K_16'Access, K_17'Access, K_18'Access, K_19'Access,
      K_20'Access, K_21'Access, K_22'Access, K_23'Access,
      K_24'Access, K_25'Access, K_26'Access, K_27'Access,
      K_28'Access, K_29'Access, K_30'Access, K_31'Access,
      K_32'Access, K_33'Access, K_34'Access, K_35'Access,
      K_36'Access, K_37'Access, K_38'Access, K_39'Access,
      K_40'Access, K_41'Access, K_42'Access, K_43'Access,
      K_44'Access, K_45'Access, K_46'Access, K_47'Access,
      K_48'Access, K_49'Access, K_50'Access, K_51'Access,
      K_52'Access, K_53'Access, K_54'Access, K_55'Access,
      K_56'Access, K_57'Access, K_58'Access, K_59'Access,
      K_60'Access, K_61'Access, K_62'Access, K_63'Access,
      K_64'Access, K_65'Access, K_66'Access, K_67'Access,
      K_68'Access, K_69'Access, K_70'Access, K_71'Access,
      K_72'Access, K_73'Access, K_74'Access, K_75'Access,
      K_76'Access, K_77'Access, K_78'Access, K_79'Access,
      K_80'Access, K_81'Access, K_82'Access, K_83'Access,
      K_84'Access, K_85'Access, K_86'Access, K_87'Access,
      K_88'Access, K_89'Access, K_90'Access, K_91'Access,
      K_92'Access, K_93'Access, K_94'Access, K_95'Access,
      K_96'Access, K_97'Access, K_98'Access, K_99'Access,
      K_100'Access, K_101'Access, K_102'Access, K_103'Access,
      K_104'Access, K_105'Access, K_106'Access, K_107'Access,
      K_108'Access, K_109'Access, K_110'Access, K_111'Access,
      K_112'Access, K_113'Access, K_114'Access, K_115'Access,
      K_116'Access, K_117'Access, K_118'Access, K_119'Access,
      K_120'Access);
end Sqlite3_H.Perfect_Hash;

Make the package Preelaborate

Make the package Preelaborate


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

with MAT.Targets.Gtkmat;
package MAT.Callbacks is

   --  Initialize and register the callbacks.
   procedure Initialize (Target  : in MAT.Targets.Gtkmat.Target_Type_Access;
                         Builder : in Gtkada.Builder.Gtkada_Builder);

   --  Callback executed when the "quit" action is executed from the menu.
   procedure On_Menu_Quit (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

   --  Callback executed when the "about" action is executed from the menu.
   procedure On_Menu_About (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

   --  Callback executed when the "close-about" action is executed from the about box.
   procedure On_Close_About (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

end MAT.Callbacks;

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

with MAT.Targets.Gtkmat;
package MAT.Callbacks is

   --  Initialize and register the callbacks.
   procedure Initialize (Target  : in MAT.Targets.Gtkmat.Target_Type_Access;
                         Builder : in Gtkada.Builder.Gtkada_Builder);

   --  Callback executed when the "quit" action is executed from the menu.
   procedure On_Menu_Quit (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

   --  Callback executed when the "about" action is executed from the menu.
   procedure On_Menu_About (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

   --  Callback executed when the "close-about" action is executed from the about box.
   procedure On_Close_About (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

   --  Callback executed when the "cmd-sizes" action is executed from the "Sizes" action.
   procedure On_Btn_Sizes (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

end MAT.Callbacks;

Declare the On_Btn_Sizes procedure

Declare the On_Btn_Sizes procedure


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

with ASF.Server.Web;
with ASF.Servlets;
with Volume_Servlet;
with Util.Log.Loggers;

procedure Volume_Server is
   Compute : aliased Volume_Servlet.Servlet;
   App     : aliased ASF.Servlets.Servlet_Registry;
   WS      : ASF.Server.Web.AWS_Container;
   Log     : Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Volume_Server");
begin
   --  Register the servlets and filters
   App.Add_Servlet (Name => "compute", Server => Compute'Unchecked_Access);

   --  Define servlet mappings
   App.Add_Mapping (Name => "compute", Pattern => "*.html");

   WS.Register_Application ("/volume", App'Unchecked_Access);

   Log.Info ("Connect you browser to: http://localhost:8080/volume/compute.html");

   WS.Start;

   delay 60.0;

end Volume_Server;

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

with ASF.Server.Web;
with ASF.Servlets;
with Volume_Servlet;
with Util.Log.Loggers;

procedure Volume_Server is
   Compute : aliased Volume_Servlet.Servlet;
   App     : aliased ASF.Servlets.Servlet_Registry;
   WS      : ASF.Server.Web.AWS_Container;
   Log     : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Volume_Server");
begin
   --  Register the servlets and filters
   App.Add_Servlet (Name => "compute", Server => Compute'Unchecked_Access);

   --  Define servlet mappings
   App.Add_Mapping (Name => "compute", Pattern => "*.html");

   WS.Register_Application ("/volume", App'Unchecked_Access);

   Log.Info ("Connect you browser to: http://localhost:8080/volume/compute.html");

   WS.Start;

   delay 60.0;

end Volume_Server;

Fix compilation warnings

Fix compilation warnings


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

with Ada.Calendar;

with AWA.Users.Models;
with AWA.Modules.Beans;
with AWA.Permissions.Services;

with ADO.SQL;
with Util.Log.Loggers;
with AWA.Users.Modules;
with AWA.Workspaces.Beans;
package body AWA.Workspaces.Modules is

   package ASC renames AWA.Services.Contexts;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Awa.Workspaces.Module");

   package Register is new AWA.Modules.Beans (Module => Workspace_Module,
                                              Module_Access => Workspace_Module_Access);

   --  ------------------------------
   --  Initialize the workspaces module.
   --  ------------------------------
   overriding
   procedure Initialize (Plugin : in out Workspace_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config) is
   begin
      Log.Info ("Initializing the workspaces module");

      --  Register here any bean class, servlet, filter.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Workspaces.Beans.Workspaces_Bean",
                         Handler => AWA.Workspaces.Beans.Create_Workspaces_Bean'Access);
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Workspaces.Beans.Member_List_Bean",
                         Handler => AWA.Workspaces.Beans.Create_Member_List_Bean'Access);
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Workspaces.Beans.Invitation_Bean",
                         Handler => AWA.Workspaces.Beans.Create_Invitation_Bean'Access);

      AWA.Modules.Module (Plugin).Initialize (App, Props);

      Plugin.User_Manager := AWA.Users.Modules.Get_User_Manager;
      --  Add here the creation of manager instances.
   end Initialize;

   --  ------------------------------
   --  Get the current workspace associated with the current user.
   --  If the user has not workspace, create one.
   --  ------------------------------
   procedure Get_Workspace (Session   : in out ADO.Sessions.Master_Session;
                            Context   : in AWA.Services.Contexts.Service_Context_Access;
                            Workspace : out AWA.Workspaces.Models.Workspace_Ref) is
      User    : constant AWA.Users.Models.User_Ref := Context.Get_User;
      WS      : AWA.Workspaces.Models.Workspace_Ref;
      Query   : ADO.SQL.Query;
      Found   : Boolean;
   begin
      if User.Is_Null then
         Log.Error ("There is no current user.  The workspace cannot be identified");
         Workspace := AWA.Workspaces.Models.Null_Workspace;
         return;
      end if;

      --  Find the workspace associated with the current user.
      Query.Add_Param (User.Get_Id);
      Query.Set_Filter ("o.owner_id = ?");
      WS.Find (Session, Query, Found);
      if Found then
         Workspace := WS;
         return;
      end if;

      --  Create a workspace for this user.
      WS.Set_Owner (User);
      WS.Set_Create_Date (Ada.Calendar.Clock);
      WS.Save (Session);

      --  And give full control of the workspace for this user
      AWA.Permissions.Services.Add_Permission (Session => Session,
                                               User    => User.Get_Id,
                                               Entity  => WS);

      Workspace := WS;
   end Get_Workspace;

   --  ------------------------------
   --  Load the invitation from the access key and verify that the key is still valid.
   --  ------------------------------
   procedure Load_Invitation (Module     : in Workspace_Module;
                              Key        : in String;
                              Invitation : in out AWA.Workspaces.Models.Invitation_Ref'Class) is
      use type Ada.Calendar.Time;

      Ctx    : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB     : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Query  : ADO.SQL.Query;
      DB_Key : AWA.Users.Models.Access_Key_Ref;
      Found  : Boolean;
   begin
      Log.Debug ("Loading invitation from key {0}", Key);

      Query.Set_Filter ("o.access_key = :key");
      Query.Bind_Param ("key", Key);
      DB_Key.Find (DB, Query, Found);
      if not Found then
         Log.Info ("Invitation key {0} does not exist");
         raise Not_Found;
      end if;
      if DB_Key.Get_Expire_Date < Ada.Calendar.Clock then
         Log.Info ("Invitation key {0} has expired");
         raise Not_Found;
      end if;
      Query.Set_Filter ("o.invitee_id = :user");
      Query.Bind_Param ("user", DB_Key.Get_User.Get_Id);
      Invitation.Find (DB, Query, Found);
      if not Found then
         Log.Warn ("Invitation key {0} has been withdawn");
         raise Not_Found;
      end if;
   end Load_Invitation;

   --  ------------------------------
   --  Send the invitation to the user.
   --  ------------------------------
   procedure Send_Invitation (Module     : in Workspace_Module;
                              Invitation : in out AWA.Workspaces.Models.Invitation_Ref'Class) is
      Ctx     : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB      : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      User    : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      WS      : AWA.Workspaces.Models.Workspace_Ref;
      Query   : ADO.SQL.Query;
      Found   : Boolean;
      Key     : AWA.Users.Models.Access_Key_Ref;
      Email   : AWA.Users.Models.Email_Ref;
      Invitee : AWA.Users.Models.User_Ref;
   begin
      Log.Info ("Sending invitation to {0}", String '(Invitation.Get_Email));

      Ctx.Start;
      if User.Is_Null then
         Log.Error ("There is no current user.  The workspace cannot be identified");
         return;
      end if;

      --  Find the workspace associated with the current user.
      Query.Add_Param (User.Get_Id);
      Query.Set_Filter ("o.owner_id = ?");
      WS.Find (DB, Query, Found);
      if not Found then
         return;
      end if;

      Query.Clear;
      Query.Set_Filter ("o.email = ?");
      Query.Add_Param (String '(Invitation.Get_Email));
      Email.Find (DB, Query, Found);
      if not Found then
         Email.Set_User_Id (0);
         Email.Set_Email (String '(Invitation.Get_Email));
         Email.Save (DB);
         Invitee.Set_Email (Email);
         Invitee.Set_Name (String '(Invitation.Get_Email));
         Invitee.Save (DB);
      else
         Invitee.Load (DB, Email.Get_User_Id);
      end if;
      Key := AWA.Users.Models.Access_Key_Ref (Invitation.Get_Access_Key);
      Module.User_Manager.Create_Access_Key (Invitee, Key, 365 * 86400.0, DB);
      Key.Save (DB);
      Invitation.Set_Access_Key (Key);
      Invitation.Set_Inviter (User);
      Invitation.Set_Invitee (Invitee);
      Invitation.Set_Workspace (WS);
      Invitation.Set_Create_Date (Ada.Calendar.Clock);
      Invitation.Save (DB);
      Ctx.Commit;
   end Send_Invitation;

end AWA.Workspaces.Modules;

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

with Ada.Calendar;

with AWA.Users.Models;
with AWA.Modules.Beans;
with AWA.Permissions.Services;

with ADO.SQL;
with Util.Log.Loggers;
with AWA.Users.Modules;
with AWA.Workspaces.Beans;
package body AWA.Workspaces.Modules is

   package ASC renames AWA.Services.Contexts;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Awa.Workspaces.Module");

   package Register is new AWA.Modules.Beans (Module => Workspace_Module,
                                              Module_Access => Workspace_Module_Access);

   --  ------------------------------
   --  Initialize the workspaces module.
   --  ------------------------------
   overriding
   procedure Initialize (Plugin : in out Workspace_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config) is
   begin
      Log.Info ("Initializing the workspaces module");

      --  Register here any bean class, servlet, filter.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Workspaces.Beans.Workspaces_Bean",
                         Handler => AWA.Workspaces.Beans.Create_Workspaces_Bean'Access);
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Workspaces.Beans.Member_List_Bean",
                         Handler => AWA.Workspaces.Beans.Create_Member_List_Bean'Access);
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Workspaces.Beans.Invitation_Bean",
                         Handler => AWA.Workspaces.Beans.Create_Invitation_Bean'Access);

      AWA.Modules.Module (Plugin).Initialize (App, Props);

      Plugin.User_Manager := AWA.Users.Modules.Get_User_Manager;
      --  Add here the creation of manager instances.
   end Initialize;

   --  ------------------------------
   --  Get the current workspace associated with the current user.
   --  If the user has not workspace, create one.
   --  ------------------------------
   procedure Get_Workspace (Session   : in out ADO.Sessions.Master_Session;
                            Context   : in AWA.Services.Contexts.Service_Context_Access;
                            Workspace : out AWA.Workspaces.Models.Workspace_Ref) is
      User    : constant AWA.Users.Models.User_Ref := Context.Get_User;
      WS      : AWA.Workspaces.Models.Workspace_Ref;
      Query   : ADO.SQL.Query;
      Found   : Boolean;
   begin
      if User.Is_Null then
         Log.Error ("There is no current user.  The workspace cannot be identified");
         Workspace := AWA.Workspaces.Models.Null_Workspace;
         return;
      end if;

      --  Find the workspace associated with the current user.
      Query.Add_Param (User.Get_Id);
      Query.Set_Filter ("o.owner_id = ?");
      WS.Find (Session, Query, Found);
      if Found then
         Workspace := WS;
         return;
      end if;

      --  Create a workspace for this user.
      WS.Set_Owner (User);
      WS.Set_Create_Date (Ada.Calendar.Clock);
      WS.Save (Session);

      --  And give full control of the workspace for this user
      AWA.Permissions.Services.Add_Permission (Session => Session,
                                               User    => User.Get_Id,
                                               Entity  => WS);

      Workspace := WS;
   end Get_Workspace;

   --  ------------------------------
   --  Load the invitation from the access key and verify that the key is still valid.
   --  ------------------------------
   procedure Load_Invitation (Module     : in Workspace_Module;
                              Key        : in String;
                              Invitation : in out AWA.Workspaces.Models.Invitation_Ref'Class) is
      use type Ada.Calendar.Time;

      Ctx    : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB     : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Query  : ADO.SQL.Query;
      DB_Key : AWA.Users.Models.Access_Key_Ref;
      Found  : Boolean;
   begin
      Log.Debug ("Loading invitation from key {0}", Key);

      Query.Set_Filter ("o.access_key = :key");
      Query.Bind_Param ("key", Key);
      DB_Key.Find (DB, Query, Found);
      if not Found then
         Log.Info ("Invitation key {0} does not exist");
         raise Not_Found;
      end if;
      if DB_Key.Get_Expire_Date < Ada.Calendar.Clock then
         Log.Info ("Invitation key {0} has expired");
         raise Not_Found;
      end if;
      Query.Set_Filter ("o.invitee_id = :user");
      Query.Bind_Param ("user", DB_Key.Get_User.Get_Id);
      Invitation.Find (DB, Query, Found);
      if not Found then
         Log.Warn ("Invitation key {0} has been withdawn");
         raise Not_Found;
      end if;
   end Load_Invitation;

   --  ------------------------------
   --  Send the invitation to the user.
   --  ------------------------------
   procedure Send_Invitation (Module     : in Workspace_Module;
                              Invitation : in out AWA.Workspaces.Models.Invitation_Ref'Class) is
      Ctx     : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB      : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      User    : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      WS      : AWA.Workspaces.Models.Workspace_Ref;
      Query   : ADO.SQL.Query;
      Found   : Boolean;
      Key     : AWA.Users.Models.Access_Key_Ref;
      Email   : AWA.Users.Models.Email_Ref;
      Invitee : AWA.Users.Models.User_Ref;
   begin
      Log.Info ("Sending invitation to {0}", String '(Invitation.Get_Email));

      Ctx.Start;
      if User.Is_Null then
         Log.Error ("There is no current user.  The workspace cannot be identified");
         return;
      end if;

      --  Find the workspace associated with the current user.
      Query.Add_Param (User.Get_Id);
      Query.Set_Filter ("o.owner_id = ?");
      WS.Find (DB, Query, Found);
      if not Found then
         return;
      end if;

      Query.Clear;
      Query.Set_Filter ("o.email = ?");
      Query.Add_Param (String '(Invitation.Get_Email));
      Email.Find (DB, Query, Found);
      if not Found then
         Email.Set_User_Id (0);
         Email.Set_Email (String '(Invitation.Get_Email));
         Email.Save (DB);
         Invitee.Set_Email (Email);
         Invitee.Set_Name (String '(Invitation.Get_Email));
         Invitee.Save (DB);
         Email.Set_User_Id (Invitee.Get_Id);
         Email.Save (DB);
      else
         Invitee.Load (DB, Email.Get_User_Id);
      end if;
      Key := AWA.Users.Models.Access_Key_Ref (Invitation.Get_Access_Key);
      Module.User_Manager.Create_Access_Key (Invitee, Key, 365 * 86400.0, DB);
      Key.Save (DB);
      Invitation.Set_Access_Key (Key);
      Invitation.Set_Inviter (User);
      Invitation.Set_Invitee (Invitee);
      Invitation.Set_Workspace (WS);
      Invitation.Set_Create_Date (Ada.Calendar.Clock);
      Invitation.Save (DB);
      Ctx.Commit;
   end Send_Invitation;

end AWA.Workspaces.Modules;

Fix the email user link

Fix the email user link


--  SPDX-License-Identifier: Apache-2.0
--
--  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.Calendar.Formatting;
with Ada.Characters.Latin_1;
with Ada.Real_Time;
with Ada.Strings.Fixed;
with Ada.Text_IO;

with Orka.Strings;

package body Orka.Terminals is

   Style_Codes : constant array (Style) of Natural :=
     (Default   => 0,
      Bold      => 1,
      Dark      => 2,
      Italic    => 3,
      Underline => 4,
      Blink     => 5,
      Reversed  => 7,
      Cross_Out => 9);

   Foreground_Color_Codes : constant array (Color) of Natural :=
     (Default => 0,
      Grey    => 30,
      Red     => 31,
      Green   => 32,
      Yellow  => 33,
      Blue    => 34,
      Magenta => 35,
      Cyan    => 36,
      White   => 37);

   Background_Color_Codes : constant array (Color) of Natural :=
     (Default => 0,
      Grey    => 40,
      Red     => 41,
      Green   => 42,
      Yellow  => 43,
      Blue    => 44,
      Magenta => 45,
      Cyan    => 46,
      White   => 47);

   package L renames Ada.Characters.Latin_1;
   package SF renames Ada.Strings.Fixed;

   Reset : constant String := L.ESC & "[0m";

   function Sequence (Code : Natural) return String is
      Image : constant String := SF.Trim (Code'Image, Ada.Strings.Both);
   begin
      return (if Code /= 0 then L.ESC & "[" & Image & "m" else "");
   end Sequence;

   function Colorize (Text : String; Foreground, Background : Color := Default;
                      Attribute : Style := Default) return String is
      FG : constant String := Sequence (Foreground_Color_Codes (Foreground));
      BG : constant String := Sequence (Background_Color_Codes (Background));
      ST : constant String := Sequence (Style_Codes (Attribute));
   begin
      return Reset & FG & BG & ST & Text & Reset;
   end Colorize;

   -----------------------------------------------------------------------------

   Time_Zero : constant Ada.Real_Time.Time := Ada.Real_Time.Clock;

   Days_Since_Zero : Natural := 0;

   function Time_Image return String is
      use Ada.Real_Time;
      use Ada.Calendar.Formatting;

      Hour       : Hour_Number;
      Minute     : Minute_Number;
      Second     : Second_Number;
      Sub_Second : Second_Duration;

      Seconds_Since_Zero : Duration := To_Duration (Clock - Time_Zero);
   begin
      if Seconds_Since_Zero > Ada.Calendar.Day_Duration'Last then
         Seconds_Since_Zero := Seconds_Since_Zero - Ada.Calendar.Day_Duration'Last;
         Days_Since_Zero    := Days_Since_Zero + 1;
      end if;
      Split (Seconds_Since_Zero, Hour, Minute, Second, Sub_Second);

      declare
         --  Remove first character (space) from ' hhmmss' image and then pad it to six digits
         Image1 : constant String := Natural'Image
           ((Days_Since_Zero * 24 + Hour) * 1e4 + Minute * 1e2 + Second);
         Image2 : constant String := SF.Tail (Image1 (2 .. Image1'Last), 6, '0');

         --  Insert ':' characters to get 'hh:mm:ss'
         Image3 : constant String := SF.Insert (Image2, 5, ":");
         Image4 : constant String := SF.Insert (Image3, 3, ":");

         --  Take image without first character (space) and then pad it to six digits
         Image5 : constant String := Natural'Image (Natural (Sub_Second * 1e6));
         Image6 : constant String := SF.Tail (Image5 (2 .. Image5'Last), 6, '0');
      begin
         return Image4 & "." & Image6;
      end;
   end Time_Image;

   package Duration_IO is new Ada.Text_IO.Fixed_IO (Duration);

   type String_Access is not null access String;

   Suffices : constant array (1 .. 3) of String_Access
     := (new String'("s"),
         new String'("ms"),
         new String'("us"));
   Last_Suffix : constant String_Access := Suffices (Suffices'Last);

   function Image (Value : Duration) return String is
      Result : String   := "-9999.999";
      Number : Duration := Value;

      Suffix : String_Access := Suffices (Suffices'First);
   begin
      for S of Suffices loop
         Suffix := S;
         exit when Number >= 1.0 or else Number <= -1.0 or else S = Last_Suffix;
         Number := Number * 1e3;
      end loop;

      begin
         Duration_IO.Put (Result, Item => Number, Aft => 3);
      exception
         when others =>
            return Number'Image & " " & Suffix.all;
      end;
      return Result & " " & Suffix.all;
   end Image;

   function Trim (Value : String) return String renames Orka.Strings.Trim;

   function Strip_Line_Term (Value : String) return String renames Orka.Strings.Strip_Line_Term;

end Orka.Terminals;

--  SPDX-License-Identifier: Apache-2.0
--
--  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.Calendar.Formatting;
with Ada.Characters.Latin_1;
with Ada.Strings.Fixed;
with Ada.Text_IO;

with Orka.OS;
with Orka.Strings;

package body Orka.Terminals is

   Style_Codes : constant array (Style) of Natural :=
     (Default   => 0,
      Bold      => 1,
      Dark      => 2,
      Italic    => 3,
      Underline => 4,
      Blink     => 5,
      Reversed  => 7,
      Cross_Out => 9);

   Foreground_Color_Codes : constant array (Color) of Natural :=
     (Default => 0,
      Grey    => 30,
      Red     => 31,
      Green   => 32,
      Yellow  => 33,
      Blue    => 34,
      Magenta => 35,
      Cyan    => 36,
      White   => 37);

   Background_Color_Codes : constant array (Color) of Natural :=
     (Default => 0,
      Grey    => 40,
      Red     => 41,
      Green   => 42,
      Yellow  => 43,
      Blue    => 44,
      Magenta => 45,
      Cyan    => 46,
      White   => 47);

   package L renames Ada.Characters.Latin_1;
   package SF renames Ada.Strings.Fixed;

   Reset : constant String := L.ESC & "[0m";

   function Sequence (Code : Natural) return String is
      Image : constant String := SF.Trim (Code'Image, Ada.Strings.Both);
   begin
      return (if Code /= 0 then L.ESC & "[" & Image & "m" else "");
   end Sequence;

   function Colorize (Text : String; Foreground, Background : Color := Default;
                      Attribute : Style := Default) return String is
      FG : constant String := Sequence (Foreground_Color_Codes (Foreground));
      BG : constant String := Sequence (Background_Color_Codes (Background));
      ST : constant String := Sequence (Style_Codes (Attribute));
   begin
      return Reset & FG & BG & ST & Text & Reset;
   end Colorize;

   -----------------------------------------------------------------------------

   Time_Zero : constant Duration := Orka.OS.Monotonic_Clock;

   Days_Since_Zero : Natural := 0;

   function Time_Image return String is
      use Ada.Calendar.Formatting;

      Hour       : Hour_Number;
      Minute     : Minute_Number;
      Second     : Second_Number;
      Sub_Second : Second_Duration;

      Seconds_Since_Zero : Duration := Orka.OS.Monotonic_Clock - Time_Zero;
   begin
      if Seconds_Since_Zero > Ada.Calendar.Day_Duration'Last then
         Seconds_Since_Zero := Seconds_Since_Zero - Ada.Calendar.Day_Duration'Last;
         Days_Since_Zero    := Days_Since_Zero + 1;
      end if;
      Split (Seconds_Since_Zero, Hour, Minute, Second, Sub_Second);

      declare
         --  Remove first character (space) from ' hhmmss' image and then pad it to six digits
         Image1 : constant String := Natural'Image
           ((Days_Since_Zero * 24 + Hour) * 1e4 + Minute * 1e2 + Second);
         Image2 : constant String := SF.Tail (Image1 (2 .. Image1'Last), 6, '0');

         --  Insert ':' characters to get 'hh:mm:ss'
         Image3 : constant String := SF.Insert (Image2, 5, ":");
         Image4 : constant String := SF.Insert (Image3, 3, ":");

         --  Take image without first character (space) and then pad it to six digits
         Image5 : constant String := Natural'Image (Natural (Sub_Second * 1e6));
         Image6 : constant String := SF.Tail (Image5 (2 .. Image5'Last), 6, '0');
      begin
         return Image4 & "." & Image6;
      end;
   end Time_Image;

   package Duration_IO is new Ada.Text_IO.Fixed_IO (Duration);

   type String_Access is not null access String;

   Suffices : constant array (1 .. 3) of String_Access
     := (new String'("s"),
         new String'("ms"),
         new String'("us"));
   Last_Suffix : constant String_Access := Suffices (Suffices'Last);

   function Image (Value : Duration) return String is
      Result : String   := "-9999.999";
      Number : Duration := Value;

      Suffix : String_Access := Suffices (Suffices'First);
   begin
      for S of Suffices loop
         Suffix := S;
         exit when Number >= 1.0 or else Number <= -1.0 or else S = Last_Suffix;
         Number := Number * 1e3;
      end loop;

      begin
         Duration_IO.Put (Result, Item => Number, Aft => 3);
      exception
         when others =>
            return Number'Image & " " & Suffix.all;
      end;
      return Result & " " & Suffix.all;
   end Image;

   function Trim (Value : String) return String renames Orka.Strings.Trim;

   function Strip_Line_Term (Value : String) return String renames Orka.Strings.Strip_Line_Term;

end Orka.Terminals;

orka: Use monotonic clock in function Time_Image

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


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

with Util.Properties;

--  The <b>ADO.Drivers</b> package represents the database driver that will create
--  database connections and provide the database specific implementation.
package ADO.Drivers is

   use Ada.Strings.Unbounded;

   --  Raised when the connection URI is invalid.
   Connection_Error : exception;

   --  Raised for all errors reported by the database
   DB_Error : exception;

   type Driver_Index is new Natural range 0 .. 4;

   --  Initialize the drivers and the library by reading the property file
   --  and configure the runtime with it.
   procedure Initialize (Config : in String);

   --  Initialize the drivers and the library and configure the runtime with the given properties.
   procedure Initialize (Config : in Util.Properties.Manager'Class);

   --  Get the global configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Name    : in String;
                        Default : in String := "") return String;

end ADO.Drivers;

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

with Util.Properties;

--  == Introduction ==
--  The ADO.Drivers package represents the database driver that will create
--  database connections and provide the database specific implementation.  The driver
--  is either statically linked to the application and can be loaded dynamically if it was
--  built as a shared library.  For a dynamic load, the driver shared library name must be
--  prefixed by libada_ado_.  For example, for a <tt>mysql</tt> driver, the shared
--  library name is <tt>libada_ado_mysql.so</tt>.
--
--  === Initialization ===
--  The ADO runtime must be initialized by calling one of the Initialize operation.
--  A property file contains the configuration for the database drivers and the database
--  connection properties.
--
--    ADO.Drivers.Initialize ("db.properties");
--
--  Once initialized, a configuration property can be retrieved by using the <tt>Get_Config</tt>
--  operation.
--
--    URI : constant String := ADO.Drivers.Get_Config ("ado.database");
--
--  === Connection string ===
--  The database connection string is an URI that specifies the database driver to use as well
--  as the information for the database driver to connect to the database.
--  The driver connection is a string of the form:
--
--    driver://[host][:port]/[database][?property1][=value1]...
--
--  The database connection string is passed to the session factory that maintains connections
--  to the database (see ADO.Sessions.Factory).
--
package ADO.Drivers is

   use Ada.Strings.Unbounded;

   --  Raised when the connection URI is invalid.
   Connection_Error : exception;

   --  Raised for all errors reported by the database
   DB_Error : exception;

   type Driver_Index is new Natural range 0 .. 4;

   --  Initialize the drivers and the library by reading the property file
   --  and configure the runtime with it.
   procedure Initialize (Config : in String);

   --  Initialize the drivers and the library and configure the runtime with the given properties.
   procedure Initialize (Config : in Util.Properties.Manager'Class);

   --  Get the global configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Name    : in String;
                        Default : in String := "") return String;

end ADO.Drivers;

Add some documentation on database drivers


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

   --  ------------------------------
   --  Split the date into a date record (See Ada.Calendar.Formatting.Split).
   --  ------------------------------
   procedure Split (Into       : out Date_Record;
                    Date       : in Ada.Calendar.Time;
                    Time_Zone  : in Ada.Calendar.Time_Zones.Time_Offset := 0) is
      use Ada.Calendar;
      D : Ada.Calendar.Time := Date;
   begin
      Into.Date      := Date;
      Into.Time_Zone := Time_Zone;
      Ada.Calendar.Formatting.Split (Date        => Date,
                                     Year        => Into.Year,
                                     Month       => Into.Month,
                                     Day         => Into.Month_Day,
                                     Hour        => Into.Hour,
                                     Minute      => Into.Minute,
                                     Second      => Into.Second,
                                     Sub_Second  => Into.Sub_Second,
                                     Leap_Second => Into.Leap_Second,
                                     Time_Zone   => Time_Zone);

      --  The Day_Of_Week function uses the local timezone to find the week day.
      --  The wrong day is computed if the timezone is different.  If the current
      --  date is 23:30 GMT and the current system timezone is GMT+2, then the computed
      --  day of week will be the next day due to the +2 hour offset (01:30 AM).
      --  To avoid the timezone issue, we virtually force the hour to 12:00 am.
      if Into.Hour > 12 then
         D := D - Duration ((Into.Hour - 12) * 3600);
      elsif Into.Hour < 12 then
         D := D + Duration ((12 - Into.Hour) * 3600);
      end if;
      D := D - Duration ((60 - Into.Minute) * 60);
      Into.Day := Ada.Calendar.Formatting.Day_Of_Week (D);
   end Split;

   --  ------------------------------
   --  Returns true if the given year is a leap year.
   --  ------------------------------
   function Is_Leap_Year (Year : in Ada.Calendar.Year_Number) return Boolean is
   begin
      if Year mod 400 = 0 then
         return True;
      elsif Year mod 100 = 0 then
         return False;
      elsif Year mod 4 = 0 then
         return True;
      else
         return False;
      end if;
   end Is_Leap_Year;

   --  ------------------------------
   --  Get the number of days in the given year.
   --  ------------------------------
   function Get_Day_Count (Year : in Ada.Calendar.Year_Number)
                           return Ada.Calendar.Arithmetic.Day_Count is
   begin
      if Is_Leap_Year (Year) then
         return 365;
      else
         return 366;
      end if;
   end Get_Day_Count;

   Month_Day_Count : constant array (Ada.Calendar.Month_Number)
     of Ada.Calendar.Arithmetic.Day_Count
       := (1 => 31, 2 => 28, 3 => 31, 4 => 30, 5 => 31, 6 => 30,
           7 => 31, 8 => 31, 9 => 30, 10 => 31, 11 => 30, 12 => 31);

   --  ------------------------------
   --  Get the number of days in the given month.
   --  ------------------------------
   function Get_Day_Count (Year  : in Ada.Calendar.Year_Number;
                           Month : in Ada.Calendar.Month_Number)
                           return Ada.Calendar.Arithmetic.Day_Count is
   begin
      if Month /= 2 then
         return Month_Day_Count (Month);
      elsif Is_Leap_Year (Year) then
         return 29;
      else
         return 28;
      end if;
   end Get_Day_Count;

   --  ------------------------------
   --  Get a time representing the given date at 00:00:00.
   --  ------------------------------
   function Get_Day_Start (Date : in Date_Record) return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Date.Month_Day,
                                              Hour        => 0,
                                              Minute      => 0,
                                              Second      => 0,
                                              Sub_Second  => 0.0,
                                              Time_Zone   => Date.Time_Zone);
   end Get_Day_Start;

   function Get_Day_Start (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Day_Start (D);
   end Get_Day_Start;

   --  ------------------------------
   --  Get a time representing the given date at 23:59:59.
   --  ------------------------------
   function Get_Day_End (Date : in Date_Record) return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Date.Month_Day,
                                              Hour        => 23,
                                              Minute      => 59,
                                              Second      => 59,
                                              Sub_Second  => 0.999,
                                              Time_Zone   => Date.Time_Zone);
   end Get_Day_End;

   function Get_Day_End (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Day_End (D);
   end Get_Day_End;

   --  ------------------------------
   --  Get a time representing the beginning of the week at 00:00:00.
   --  ------------------------------
   function Get_Week_Start (Date : in Date_Record) return Ada.Calendar.Time is
      use Ada.Calendar.Formatting;
      use Ada.Calendar.Arithmetic;

      T : constant Ada.Calendar.Time := Time_Of (Year        => Date.Year,
                                                 Month       => Date.Month,
                                                 Day         => Date.Month_Day,
                                                 Hour        => 0,
                                                 Minute      => 0,
                                                 Second      => 0,
                                                 Sub_Second  => 0.0,
                                                 Time_Zone   => Date.Time_Zone);
   begin
      if Date.Day = Ada.Calendar.Formatting.Monday then
         return T;
      else
         return T - Day_Count (Day_Name'Pos (Date.Day) - Day_Name'Pos (Monday));
      end if;
   end Get_Week_Start;

   function Get_Week_Start (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Week_Start (D);
   end Get_Week_Start;

   --  ------------------------------
   --  Get a time representing the end of the week at 23:59:99.
   --  ------------------------------
   function Get_Week_End (Date : in Date_Record) return Ada.Calendar.Time is
      use Ada.Calendar.Formatting;
      use Ada.Calendar.Arithmetic;

      T : constant Ada.Calendar.Time := Time_Of (Year        => Date.Year,
                                                 Month       => Date.Month,
                                                 Day         => Date.Month_Day,
                                                 Hour        => 23,
                                                 Minute      => 59,
                                                 Second      => 59,
                                                 Sub_Second  => 0.999,
                                                 Time_Zone   => Date.Time_Zone);
   begin
      --  End of week is 6 days + 23:59:59
      if Date.Day = Ada.Calendar.Formatting.Sunday then
         return T;
      else
         return T + Day_Count (6 - (Day_Name'Pos (Date.Day) - Day_Name'Pos (Monday)));
      end if;
   end Get_Week_End;

   function Get_Week_End (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Week_End (D);
   end Get_Week_End;

   --  ------------------------------
   --  Get a time representing the beginning of the month at 00:00:00.
   --  ------------------------------
   function Get_Month_Start (Date : in Date_Record) return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Ada.Calendar.Day_Number'First,
                                              Hour        => 0,
                                              Minute      => 0,
                                              Second      => 0,
                                              Sub_Second  => 0.0,
                                              Time_Zone   => Date.Time_Zone);
   end Get_Month_Start;

   function Get_Month_Start (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Month_Start (D);
   end Get_Month_Start;

   --  ------------------------------
   --  Get a time representing the end of the month at 23:59:59.
   --  ------------------------------
   function Get_Month_End (Date : in Date_Record) return Ada.Calendar.Time is
      Last_Day : constant Ada.Calendar.Day_Number
        := Ada.Calendar.Day_Number (Get_Day_Count (Date.Year, Date.Month));
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Last_Day,
                                              Hour        => 23,
                                              Minute      => 59,
                                              Second      => 59,
                                              Sub_Second  => 0.999,
                                              Time_Zone   => Date.Time_Zone);
   end Get_Month_End;

   function Get_Month_End (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Month_End (D);
   end Get_Month_End;

end Util.Dates;

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

   --  ------------------------------
   --  Split the date into a date record (See Ada.Calendar.Formatting.Split).
   --  ------------------------------
   procedure Split (Into       : out Date_Record;
                    Date       : in Ada.Calendar.Time;
                    Time_Zone  : in Ada.Calendar.Time_Zones.Time_Offset := 0) is
      use Ada.Calendar;
      D : Ada.Calendar.Time := Date;
   begin
      Into.Date      := Date;
      Into.Time_Zone := Time_Zone;
      Ada.Calendar.Formatting.Split (Date        => Date,
                                     Year        => Into.Year,
                                     Month       => Into.Month,
                                     Day         => Into.Month_Day,
                                     Hour        => Into.Hour,
                                     Minute      => Into.Minute,
                                     Second      => Into.Second,
                                     Sub_Second  => Into.Sub_Second,
                                     Leap_Second => Into.Leap_Second,
                                     Time_Zone   => Time_Zone);

      --  The Day_Of_Week function uses the local timezone to find the week day.
      --  The wrong day is computed if the timezone is different.  If the current
      --  date is 23:30 GMT and the current system timezone is GMT+2, then the computed
      --  day of week will be the next day due to the +2 hour offset (01:30 AM).
      --  To avoid the timezone issue, we virtually force the hour to 12:00 am.
      if Into.Hour > 12 then
         D := D - Duration ((Into.Hour - 12) * 3600);
      elsif Into.Hour < 12 then
         D := D + Duration ((12 - Into.Hour) * 3600);
      end if;
      D := D - Duration ((60 - Into.Minute) * 60);
      Into.Day := Ada.Calendar.Formatting.Day_Of_Week (D);
   end Split;

   --  ------------------------------
   --  Return the date from the date record (See Ada.Calendar.Formatting.Time_Of).
   --  ------------------------------
   function Time_Of (Date : in Date_Record) return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Date.Month_Day,
                                              Hour        => Date.Hour,
                                              Minute      => Date.Minute,
                                              Second      => Date.Second,
                                              Sub_Second  => Date.Sub_Second,
                                              Time_Zone   => Date.Time_Zone);
   end Time_Of;

   --  ------------------------------
   --  Returns true if the given year is a leap year.
   --  ------------------------------
   function Is_Leap_Year (Year : in Ada.Calendar.Year_Number) return Boolean is
   begin
      if Year mod 400 = 0 then
         return True;
      elsif Year mod 100 = 0 then
         return False;
      elsif Year mod 4 = 0 then
         return True;
      else
         return False;
      end if;
   end Is_Leap_Year;

   --  ------------------------------
   --  Get the number of days in the given year.
   --  ------------------------------
   function Get_Day_Count (Year : in Ada.Calendar.Year_Number)
                           return Ada.Calendar.Arithmetic.Day_Count is
   begin
      if Is_Leap_Year (Year) then
         return 365;
      else
         return 366;
      end if;
   end Get_Day_Count;

   Month_Day_Count : constant array (Ada.Calendar.Month_Number)
     of Ada.Calendar.Arithmetic.Day_Count
       := (1 => 31, 2 => 28, 3 => 31, 4 => 30, 5 => 31, 6 => 30,
           7 => 31, 8 => 31, 9 => 30, 10 => 31, 11 => 30, 12 => 31);

   --  ------------------------------
   --  Get the number of days in the given month.
   --  ------------------------------
   function Get_Day_Count (Year  : in Ada.Calendar.Year_Number;
                           Month : in Ada.Calendar.Month_Number)
                           return Ada.Calendar.Arithmetic.Day_Count is
   begin
      if Month /= 2 then
         return Month_Day_Count (Month);
      elsif Is_Leap_Year (Year) then
         return 29;
      else
         return 28;
      end if;
   end Get_Day_Count;

   --  ------------------------------
   --  Get a time representing the given date at 00:00:00.
   --  ------------------------------
   function Get_Day_Start (Date : in Date_Record) return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Date.Month_Day,
                                              Hour        => 0,
                                              Minute      => 0,
                                              Second      => 0,
                                              Sub_Second  => 0.0,
                                              Time_Zone   => Date.Time_Zone);
   end Get_Day_Start;

   function Get_Day_Start (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Day_Start (D);
   end Get_Day_Start;

   --  ------------------------------
   --  Get a time representing the given date at 23:59:59.
   --  ------------------------------
   function Get_Day_End (Date : in Date_Record) return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Date.Month_Day,
                                              Hour        => 23,
                                              Minute      => 59,
                                              Second      => 59,
                                              Sub_Second  => 0.999,
                                              Time_Zone   => Date.Time_Zone);
   end Get_Day_End;

   function Get_Day_End (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Day_End (D);
   end Get_Day_End;

   --  ------------------------------
   --  Get a time representing the beginning of the week at 00:00:00.
   --  ------------------------------
   function Get_Week_Start (Date : in Date_Record) return Ada.Calendar.Time is
      use Ada.Calendar.Formatting;
      use Ada.Calendar.Arithmetic;

      T : constant Ada.Calendar.Time := Time_Of (Year        => Date.Year,
                                                 Month       => Date.Month,
                                                 Day         => Date.Month_Day,
                                                 Hour        => 0,
                                                 Minute      => 0,
                                                 Second      => 0,
                                                 Sub_Second  => 0.0,
                                                 Time_Zone   => Date.Time_Zone);
   begin
      if Date.Day = Ada.Calendar.Formatting.Monday then
         return T;
      else
         return T - Day_Count (Day_Name'Pos (Date.Day) - Day_Name'Pos (Monday));
      end if;
   end Get_Week_Start;

   function Get_Week_Start (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Week_Start (D);
   end Get_Week_Start;

   --  ------------------------------
   --  Get a time representing the end of the week at 23:59:99.
   --  ------------------------------
   function Get_Week_End (Date : in Date_Record) return Ada.Calendar.Time is
      use Ada.Calendar.Formatting;
      use Ada.Calendar.Arithmetic;

      T : constant Ada.Calendar.Time := Time_Of (Year        => Date.Year,
                                                 Month       => Date.Month,
                                                 Day         => Date.Month_Day,
                                                 Hour        => 23,
                                                 Minute      => 59,
                                                 Second      => 59,
                                                 Sub_Second  => 0.999,
                                                 Time_Zone   => Date.Time_Zone);
   begin
      --  End of week is 6 days + 23:59:59
      if Date.Day = Ada.Calendar.Formatting.Sunday then
         return T;
      else
         return T + Day_Count (6 - (Day_Name'Pos (Date.Day) - Day_Name'Pos (Monday)));
      end if;
   end Get_Week_End;

   function Get_Week_End (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Week_End (D);
   end Get_Week_End;

   --  ------------------------------
   --  Get a time representing the beginning of the month at 00:00:00.
   --  ------------------------------
   function Get_Month_Start (Date : in Date_Record) return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Ada.Calendar.Day_Number'First,
                                              Hour        => 0,
                                              Minute      => 0,
                                              Second      => 0,
                                              Sub_Second  => 0.0,
                                              Time_Zone   => Date.Time_Zone);
   end Get_Month_Start;

   function Get_Month_Start (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Month_Start (D);
   end Get_Month_Start;

   --  ------------------------------
   --  Get a time representing the end of the month at 23:59:59.
   --  ------------------------------
   function Get_Month_End (Date : in Date_Record) return Ada.Calendar.Time is
      Last_Day : constant Ada.Calendar.Day_Number
        := Ada.Calendar.Day_Number (Get_Day_Count (Date.Year, Date.Month));
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Last_Day,
                                              Hour        => 23,
                                              Minute      => 59,
                                              Second      => 59,
                                              Sub_Second  => 0.999,
                                              Time_Zone   => Date.Time_Zone);
   end Get_Month_End;

   function Get_Month_End (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Month_End (D);
   end Get_Month_End;

end Util.Dates;

Implement Time_Of function

Implement Time_Of function