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

with Util.Log;
with Util.Log.Loggers;
with Ada.Unchecked_Deallocation;

with ADO.Drivers;
with ADO.Sequences;
package body ADO.Sessions is

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

   procedure Check_Session (Database : in Session'Class;
                            Message  : in String := "") is
   begin
      if Database.Impl = null then
         Log.Error ("Session is closed or not initialized");
         raise NOT_OPEN;
      end if;
      if Message'Length > 0 then
         Log.Info (Message, Database.Impl.Database.Get_Ident);
      end if;
   end Check_Session;

   --  ---------
   --  Session
   --  ---------

   --  ------------------------------
   --  Get the session status.
   --  ------------------------------
   function Get_Status (Database : in Session) return ADO.Databases.Connection_Status is
   begin
      if Database.Impl = null then
         return ADO.Databases.CLOSED;
      end if;
      return Database.Impl.Database.Get_Status;
   end Get_Status;

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

      procedure Free is new
        Ada.Unchecked_Deallocation (Object => Session_Record,
                                    Name   => Session_Record_Access);

      Is_Zero : Boolean;
   begin
      Log.Info ("Closing session");
      if Database.Impl /= null then
         ADO.Objects.Release_Proxy (Database.Impl.Proxy);
         Database.Impl.Database.Close;
         Util.Concurrent.Counters.Decrement (Database.Impl.Counter, Is_Zero);
         if Is_Zero then
            Free (Database.Impl);
         end if;
         Database.Impl := null;
      end if;
   end Close;

   --  ------------------------------
   --  Get the database connection.
   --  ------------------------------
   function Get_Connection (Database : in Session) return ADO.Databases.Connection'Class is
   begin
      Check_Session (Database);
      return Database.Impl.Database;
   end Get_Connection;

   --  ------------------------------
   --  Attach the object to the session.
   --  ------------------------------
   procedure Attach (Database : in out Session;
                     Object   : in ADO.Objects.Object_Ref'Class) is
      pragma Unreferenced (Object);
   begin
      Check_Session (Database);
   end Attach;

   --  ------------------------------
   --  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 is
   begin
      Check_Session (Database);
      return ADO.Objects.Cache.Contains (Database.Impl.Cache, Item);
   end Contains;

   --  ------------------------------
   --  Remove the object from the session cache.
   --  ------------------------------
   procedure Evict (Database : in out Session;
                    Item     : in ADO.Objects.Object_Key) is
   begin
      Check_Session (Database);
      ADO.Objects.Cache.Remove (Database.Impl.Cache, Item);
   end Evict;

   --  ------------------------------
   --  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 is
   begin
      Check_Session (Database);
      return Database.Impl.Database.Create_Statement (Table);
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in String)
                              return Query_Statement is
   begin
      Check_Session (Database);
      return Database.Impl.Database.Create_Statement (Query);
   end Create_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 is
   begin
      Check_Session (Database);
      declare
         SQL  : constant String := Query.Get_SQL (Database.Impl.Database.Get_Driver_Index);
         Stmt : Query_Statement := Database.Impl.Database.Create_Statement (SQL);
      begin
         Stmt.Set_Parameters (Query);
         return Stmt;
      end;
   end Create_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 is
   begin
      Check_Session (Database);
      declare
         Index : constant ADO.Drivers.Driver_Index := Database.Impl.Database.Get_Driver_Index;
         SQL   : constant String := ADO.Queries.Get_SQL (Query, Index);
      begin
         return Database.Impl.Database.Create_Statement (SQL);
      end;
   end Create_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 is
   begin
      Check_Session (Database);
      declare
         Stmt : Query_Statement := Database.Impl.Database.Create_Statement (Table);
      begin
         if Query in ADO.Queries.Context'Class then
            declare
               Pos : constant ADO.Drivers.Driver_Index := Database.Impl.Database.Get_Driver_Index;
               SQL : constant String := ADO.Queries.Context'Class (Query).Get_SQL (Pos);
            begin
               ADO.SQL.Append (Stmt.Get_Query.SQL, SQL);
            end;
         end if;
         Stmt.Set_Parameters (Query);
         return Stmt;
      end;
   end Create_Statement;

   --  ---------
   --  Master Session
   --  ---------

   --  ------------------------------
   --  Start a transaction.
   --  ------------------------------
   procedure Begin_Transaction (Database : in out Master_Session) is
   begin
      Check_Session (Database, "Begin transaction {0}");
      Database.Impl.Database.Begin_Transaction;
   end Begin_Transaction;

   --  ------------------------------
   --  Commit the current transaction.
   --  ------------------------------
   procedure Commit (Database : in out Master_Session) is
   begin
      Check_Session (Database, "Commit transaction {0}");
      Database.Impl.Database.Commit;
   end Commit;

   --  ------------------------------
   --  Rollback the current transaction.
   --  ------------------------------
   procedure Rollback (Database : in out Master_Session) is
   begin
      Check_Session (Database, "Rollback transaction {0}");
      Database.Impl.Database.Rollback;
   end Rollback;

   --  ------------------------------
   --  Allocate an identifier for the table.
   --  ------------------------------
   procedure Allocate (Database : in out Master_Session;
                       Id       : in out ADO.Objects.Object_Record'Class) is
   begin
      Check_Session (Database);
      ADO.Sequences.Allocate (Database.Sequences.all, Id);
   end Allocate;

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

   overriding
   procedure Adjust (Object : in out Session) is
   begin
      if Object.Impl /= null then
         Util.Concurrent.Counters.Increment (Object.Impl.Counter);
      end if;
   end Adjust;

   overriding
   procedure Finalize (Object : in out Session) is
      procedure Free is
         new Ada.Unchecked_Deallocation (Object => Session_Record,
                                         Name   => Session_Record_Access);
      Is_Zero : Boolean;
   begin
      if Object.Impl /= null then
         Util.Concurrent.Counters.Decrement (Object.Impl.Counter, Is_Zero);
         if Is_Zero then
            ADO.Objects.Release_Proxy (Object.Impl.Proxy);
            Object.Impl.Database.Close;
            Free (Object.Impl);
         end if;
         Object.Impl := null;
      end if;
   end Finalize;

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

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

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

   --  ------------------------------
   --  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 is
      use type ADO.Objects.Session_Proxy_Access;
   begin
      Check_Session (Database);
      if Database.Impl.Proxy = null then
         Database.Impl.Proxy := ADO.Objects.Create_Session_Proxy (Database.Impl);
      end if;
      return Database.Impl.Proxy;
   end Get_Session_Proxy;

end ADO.Sessions;

-----------------------------------------------------------------------
--  ADO Sessions -- Sessions Management
--  Copyright (C) 2009, 2010, 2011, 2012, 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.
-----------------------------------------------------------------------

with Util.Log;
with Util.Log.Loggers;
with Ada.Unchecked_Deallocation;

with ADO.Drivers;
with ADO.Sequences;
package body ADO.Sessions is

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

   procedure Check_Session (Database : in Session'Class;
                            Message  : in String := "") is
   begin
      if Database.Impl = null then
         Log.Error ("Session is closed or not initialized");
         raise NOT_OPEN;
      end if;
      if Message'Length > 0 then
         Log.Info (Message, Database.Impl.Database.Get_Ident);
      end if;
   end Check_Session;

   --  ---------
   --  Session
   --  ---------

   --  ------------------------------
   --  Get the session status.
   --  ------------------------------
   function Get_Status (Database : in Session) return ADO.Databases.Connection_Status is
   begin
      if Database.Impl = null then
         return ADO.Databases.CLOSED;
      end if;
      return Database.Impl.Database.Get_Status;
   end Get_Status;

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

      procedure Free is new
        Ada.Unchecked_Deallocation (Object => Session_Record,
                                    Name   => Session_Record_Access);

      Is_Zero : Boolean;
   begin
      Log.Info ("Closing session");
      if Database.Impl /= null then
         ADO.Objects.Release_Proxy (Database.Impl.Proxy);
         Database.Impl.Database.Close;
         Util.Concurrent.Counters.Decrement (Database.Impl.Counter, Is_Zero);
         if Is_Zero then
            Free (Database.Impl);
         end if;
         Database.Impl := null;
      end if;
   end Close;

   --  ------------------------------
   --  Get the database connection.
   --  ------------------------------
   function Get_Connection (Database : in Session) return ADO.Databases.Connection'Class is
   begin
      Check_Session (Database);
      return Database.Impl.Database;
   end Get_Connection;

   --  ------------------------------
   --  Attach the object to the session.
   --  ------------------------------
   procedure Attach (Database : in out Session;
                     Object   : in ADO.Objects.Object_Ref'Class) is
      pragma Unreferenced (Object);
   begin
      Check_Session (Database);
   end Attach;

   --  ------------------------------
   --  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 is
   begin
      Check_Session (Database);
      return ADO.Objects.Cache.Contains (Database.Impl.Cache, Item);
   end Contains;

   --  ------------------------------
   --  Remove the object from the session cache.
   --  ------------------------------
   procedure Evict (Database : in out Session;
                    Item     : in ADO.Objects.Object_Key) is
   begin
      Check_Session (Database);
      ADO.Objects.Cache.Remove (Database.Impl.Cache, Item);
   end Evict;

   --  ------------------------------
   --  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 is
   begin
      Check_Session (Database);
      return Database.Impl.Database.Create_Statement (Table);
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in String)
                              return Query_Statement is
   begin
      Check_Session (Database);
      return Database.Impl.Database.Create_Statement (Query);
   end Create_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 is
   begin
      Check_Session (Database);
      declare
         SQL  : constant String := Query.Get_SQL (Database.Impl.Database.Get_Driver_Index);
         Stmt : Query_Statement := Database.Impl.Database.Create_Statement (SQL);
      begin
         Stmt.Set_Parameters (Query);
         return Stmt;
      end;
   end Create_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 is
   begin
      Check_Session (Database);
      declare
         Index : constant ADO.Drivers.Driver_Index := Database.Impl.Database.Get_Driver_Index;
         SQL   : constant String := ADO.Queries.Get_SQL (Query, Index, False);
      begin
         return Database.Impl.Database.Create_Statement (SQL);
      end;
   end Create_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 is
   begin
      Check_Session (Database);
      declare
         Stmt : Query_Statement := Database.Impl.Database.Create_Statement (Table);
      begin
         if Query in ADO.Queries.Context'Class then
            declare
               Pos : constant ADO.Drivers.Driver_Index := Database.Impl.Database.Get_Driver_Index;
               SQL : constant String := ADO.Queries.Context'Class (Query).Get_SQL (Pos);
            begin
               ADO.SQL.Append (Stmt.Get_Query.SQL, SQL);
            end;
         end if;
         Stmt.Set_Parameters (Query);
         return Stmt;
      end;
   end Create_Statement;

   --  ---------
   --  Master Session
   --  ---------

   --  ------------------------------
   --  Start a transaction.
   --  ------------------------------
   procedure Begin_Transaction (Database : in out Master_Session) is
   begin
      Check_Session (Database, "Begin transaction {0}");
      Database.Impl.Database.Begin_Transaction;
   end Begin_Transaction;

   --  ------------------------------
   --  Commit the current transaction.
   --  ------------------------------
   procedure Commit (Database : in out Master_Session) is
   begin
      Check_Session (Database, "Commit transaction {0}");
      Database.Impl.Database.Commit;
   end Commit;

   --  ------------------------------
   --  Rollback the current transaction.
   --  ------------------------------
   procedure Rollback (Database : in out Master_Session) is
   begin
      Check_Session (Database, "Rollback transaction {0}");
      Database.Impl.Database.Rollback;
   end Rollback;

   --  ------------------------------
   --  Allocate an identifier for the table.
   --  ------------------------------
   procedure Allocate (Database : in out Master_Session;
                       Id       : in out ADO.Objects.Object_Record'Class) is
   begin
      Check_Session (Database);
      ADO.Sequences.Allocate (Database.Sequences.all, Id);
   end Allocate;

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

   overriding
   procedure Adjust (Object : in out Session) is
   begin
      if Object.Impl /= null then
         Util.Concurrent.Counters.Increment (Object.Impl.Counter);
      end if;
   end Adjust;

   overriding
   procedure Finalize (Object : in out Session) is
      procedure Free is
         new Ada.Unchecked_Deallocation (Object => Session_Record,
                                         Name   => Session_Record_Access);
      Is_Zero : Boolean;
   begin
      if Object.Impl /= null then
         Util.Concurrent.Counters.Decrement (Object.Impl.Counter, Is_Zero);
         if Is_Zero then
            ADO.Objects.Release_Proxy (Object.Impl.Proxy);
            Object.Impl.Database.Close;
            Free (Object.Impl);
         end if;
         Object.Impl := null;
      end if;
   end Finalize;

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

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

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

   --  ------------------------------
   --  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 is
      use type ADO.Objects.Session_Proxy_Access;
   begin
      Check_Session (Database);
      if Database.Impl.Proxy = null then
         Database.Impl.Proxy := ADO.Objects.Create_Session_Proxy (Database.Impl);
      end if;
      return Database.Impl.Proxy;
   end Get_Session_Proxy;

end ADO.Sessions;

Update the Create_Statement operation to use the normal query definition


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

with Util.Log;
with Util.Log.Loggers;
with Ada.Unchecked_Deallocation;

with ADO.Drivers;
with ADO.Sequences;
with ADO.Statements.Create;
package body ADO.Sessions is

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

   procedure Check_Session (Database : in Session'Class;
                            Message  : in String := "") is
   begin
      if Database.Impl = null then
         Log.Error ("Session is closed or not initialized");
         raise NOT_OPEN;
      end if;
      if Message'Length > 0 then
         Log.Info (Message, Database.Impl.Database.Value.Ident);
      end if;
   end Check_Session;

   --  ---------
   --  Session
   --  ---------

   --  ------------------------------
   --  Get the session status.
   --  ------------------------------
   function Get_Status (Database : in Session) return Connection_Status is
   begin
      if Database.Impl = null or else Database.Impl.Database.Is_Null then
         return CLOSED;
      else
         return OPEN;
      end if;
   end Get_Status;

   --  ------------------------------
   --  Get the database driver which manages this connection.
   --  ------------------------------
   function Get_Driver (Database : in Session) return ADO.Drivers.Connections.Driver_Access is
   begin
      if Database.Impl = null or else Database.Impl.Database.Is_Null then
         return null;
      else
         return Database.Impl.Database.Value.Get_Driver;
      end if;
   end Get_Driver;

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

      procedure Free is new
        Ada.Unchecked_Deallocation (Object => Session_Record,
                                    Name   => Session_Record_Access);

      Is_Zero : Boolean;
   begin
      Log.Info ("Closing session");
      if Database.Impl /= null then
         ADO.Objects.Release_Proxy (Database.Impl.Proxy);
         Database.Impl.Database.Value.Close;
         Util.Concurrent.Counters.Decrement (Database.Impl.Counter, Is_Zero);
         if Is_Zero then
            Free (Database.Impl);
         end if;
         Database.Impl := null;
      end if;
   end Close;

   --  ------------------------------
   --  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) is
   begin
      Check_Session (Database);
      Database.Impl.Values.Add_Cache (Name, Cache);
   end Add_Cache;

   --  ------------------------------
   --  Attach the object to the session.
   --  ------------------------------
   procedure Attach (Database : in out Session;
                     Object   : in ADO.Objects.Object_Ref'Class) is
      pragma Unreferenced (Object);
   begin
      Check_Session (Database);
   end Attach;

   --  ------------------------------
   --  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 is
   begin
      Check_Session (Database);
      return ADO.Objects.Cache.Contains (Database.Impl.Cache, Item);
   end Contains;

   --  ------------------------------
   --  Remove the object from the session cache.
   --  ------------------------------
   procedure Evict (Database : in out Session;
                    Item     : in ADO.Objects.Object_Key) is
   begin
      Check_Session (Database);
      ADO.Objects.Cache.Remove (Database.Impl.Cache, Item);
   end Evict;

   --  ------------------------------
   --  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 is
   begin
      Check_Session (Database);
      declare
         Query : constant Query_Statement_Access
           := Database.Impl.Database.Value.all.Create_Statement (Table);
      begin
         return ADO.Statements.Create.Create_Statement (Query, Database.Impl.Values.all'Access);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in String)
                              return Query_Statement is
   begin
      Check_Session (Database);
      declare
         Stmt : constant Query_Statement_Access
           := Database.Impl.Database.Value.all.Create_Statement (Query);
      begin
         return ADO.Statements.Create.Create_Statement (Stmt, Database.Impl.Values.all'Access);
      end;
   end Create_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 is
   begin
      Check_Session (Database);
      declare
         SQL  : constant String := Query.Get_SQL (Database.Impl.Queries.all);
         Stmt : Query_Statement := Database.Create_Statement (SQL);
      begin
         Stmt.Set_Parameters (Query);
         return Stmt;
      end;
   end Create_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 is
   begin
      Check_Session (Database);
      declare
         SQL   : constant String := ADO.Queries.Get_SQL (Query, Database.Impl.Queries.all, False);
      begin
         return Database.Create_Statement (SQL);
      end;
   end Create_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 is
   begin
      Check_Session (Database);
      declare
         Stmt : Query_Statement := Database.Create_Statement (Table);
      begin
         if Query in ADO.Queries.Context'Class then
            declare
               SQL : constant String
                 := ADO.Queries.Context'Class (Query).Get_SQL (Database.Impl.Queries.all);
            begin
               ADO.SQL.Append (Stmt.Get_Query.SQL, SQL);
            end;
         end if;
         Stmt.Set_Parameters (Query);
         return Stmt;
      end;
   end Create_Statement;

   --  ------------------------------
   --  Load the database schema definition for the current database.
   --  ------------------------------
   procedure Load_Schema (Database : in Session;
                          Schema   : out ADO.Schemas.Schema_Definition) is
   begin
      Check_Session (Database, "Loading schema {0}");
      Database.Impl.Database.Value.Load_Schema (Schema);
   end Load_Schema;

   --  ---------
   --  Master Session
   --  ---------

   --  ------------------------------
   --  Start a transaction.
   --  ------------------------------
   procedure Begin_Transaction (Database : in out Master_Session) is
   begin
      Check_Session (Database, "Begin transaction {0}");
      Database.Impl.Database.Value.Begin_Transaction;
   end Begin_Transaction;

   --  ------------------------------
   --  Commit the current transaction.
   --  ------------------------------
   procedure Commit (Database : in out Master_Session) is
   begin
      Check_Session (Database, "Commit transaction {0}");
      Database.Impl.Database.Value.Commit;
   end Commit;

   --  ------------------------------
   --  Rollback the current transaction.
   --  ------------------------------
   procedure Rollback (Database : in out Master_Session) is
   begin
      Check_Session (Database, "Rollback transaction {0}");
      Database.Impl.Database.Value.Rollback;
   end Rollback;

   --  ------------------------------
   --  Allocate an identifier for the table.
   --  ------------------------------
   procedure Allocate (Database : in out Master_Session;
                       Id       : in out ADO.Objects.Object_Record'Class) is
   begin
      Check_Session (Database);
      ADO.Sequences.Allocate (Database.Sequences.all, Id);
   end Allocate;

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

   overriding
   procedure Adjust (Object : in out Session) is
   begin
      if Object.Impl /= null then
         Util.Concurrent.Counters.Increment (Object.Impl.Counter);
      end if;
   end Adjust;

   overriding
   procedure Finalize (Object : in out Session) is
      procedure Free is
         new Ada.Unchecked_Deallocation (Object => Session_Record,
                                         Name   => Session_Record_Access);
      Is_Zero : Boolean;
   begin
      if Object.Impl /= null then
         Util.Concurrent.Counters.Decrement (Object.Impl.Counter, Is_Zero);
         if Is_Zero then
            ADO.Objects.Release_Proxy (Object.Impl.Proxy, Detach => True);
            if not Object.Impl.Database.Is_Null then
               Object.Impl.Database.Value.Close;
            end if;
            Free (Object.Impl);
         end if;
         Object.Impl := null;
      end if;
   end Finalize;

   --  ------------------------------
   --  Create a delete statement
   --  ------------------------------
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement is
   begin
      Check_Session (Database);
      declare
         Stmt : constant Delete_Statement_Access
           := Database.Impl.Database.Value.all.Create_Statement (Table);
      begin
         return ADO.Statements.Create.Create_Statement (Stmt.all'Access,
                                                        Database.Impl.Values.all'Access);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create an update statement
   --  ------------------------------
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement is
   begin
      Check_Session (Database);
      declare
         Stmt : constant Update_Statement_Access
           := Database.Impl.Database.Value.all.Create_Statement (Table);
      begin
         return ADO.Statements.Create.Create_Statement (Stmt.all'Access,
                                                        Database.Impl.Values.all'Access);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create an insert statement
   --  ------------------------------
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement is
   begin
      Check_Session (Database);
      declare
         Stmt : constant Insert_Statement_Access
           := Database.Impl.Database.Value.all.Create_Statement (Table);
      begin
         return ADO.Statements.Create.Create_Statement (Stmt.all'Access,
                                                        Database.Impl.Values.all'Access);
      end;
   end Create_Statement;

   --  ------------------------------
   --  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 is
      use type ADO.Objects.Session_Proxy_Access;
   begin
      Check_Session (Database);
      if Database.Impl.Proxy = null then
         Database.Impl.Proxy := ADO.Objects.Create_Session_Proxy (Database.Impl);
      end if;
      return Database.Impl.Proxy;
   end Get_Session_Proxy;

end ADO.Sessions;

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

with Util.Log;
with Util.Log.Loggers;
with Ada.Unchecked_Deallocation;

with ADO.Drivers;
with ADO.Sequences;
with ADO.Statements.Create;
package body ADO.Sessions is

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

   procedure Check_Session (Database : in Session'Class;
                            Message  : in String := "") is
   begin
      if Database.Impl = null then
         Log.Error ("Session is closed or not initialized");
         raise Session_Error;
      end if;
      if Message'Length > 0 then
         Log.Info (Message, Database.Impl.Database.Value.Ident);
      end if;
   end Check_Session;

   --  ---------
   --  Session
   --  ---------

   --  ------------------------------
   --  Get the session status.
   --  ------------------------------
   function Get_Status (Database : in Session) return Connection_Status is
   begin
      if Database.Impl = null or else Database.Impl.Database.Is_Null then
         return CLOSED;
      else
         return OPEN;
      end if;
   end Get_Status;

   --  ------------------------------
   --  Get the database driver which manages this connection.
   --  ------------------------------
   function Get_Driver (Database : in Session) return ADO.Drivers.Connections.Driver_Access is
   begin
      if Database.Impl = null or else Database.Impl.Database.Is_Null then
         return null;
      else
         return Database.Impl.Database.Value.Get_Driver;
      end if;
   end Get_Driver;

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

      procedure Free is new
        Ada.Unchecked_Deallocation (Object => Session_Record,
                                    Name   => Session_Record_Access);

      Is_Zero : Boolean;
   begin
      Log.Info ("Closing session");
      if Database.Impl /= null then
         ADO.Objects.Release_Proxy (Database.Impl.Proxy);
         Database.Impl.Database.Value.Close;
         Util.Concurrent.Counters.Decrement (Database.Impl.Counter, Is_Zero);
         if Is_Zero then
            Free (Database.Impl);
         end if;
         Database.Impl := null;
      end if;
   end Close;

   --  ------------------------------
   --  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) is
   begin
      Check_Session (Database);
      Database.Impl.Values.Add_Cache (Name, Cache);
   end Add_Cache;

   --  ------------------------------
   --  Attach the object to the session.
   --  ------------------------------
   procedure Attach (Database : in out Session;
                     Object   : in ADO.Objects.Object_Ref'Class) is
      pragma Unreferenced (Object);
   begin
      Check_Session (Database);
   end Attach;

   --  ------------------------------
   --  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 is
   begin
      Check_Session (Database);
      return ADO.Objects.Cache.Contains (Database.Impl.Cache, Item);
   end Contains;

   --  ------------------------------
   --  Remove the object from the session cache.
   --  ------------------------------
   procedure Evict (Database : in out Session;
                    Item     : in ADO.Objects.Object_Key) is
   begin
      Check_Session (Database);
      ADO.Objects.Cache.Remove (Database.Impl.Cache, Item);
   end Evict;

   --  ------------------------------
   --  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 is
   begin
      Check_Session (Database);
      declare
         Query : constant Query_Statement_Access
           := Database.Impl.Database.Value.all.Create_Statement (Table);
      begin
         return ADO.Statements.Create.Create_Statement (Query, Database.Impl.Values.all'Access);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in String)
                              return Query_Statement is
   begin
      Check_Session (Database);
      declare
         Stmt : constant Query_Statement_Access
           := Database.Impl.Database.Value.all.Create_Statement (Query);
      begin
         return ADO.Statements.Create.Create_Statement (Stmt, Database.Impl.Values.all'Access);
      end;
   end Create_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 is
   begin
      Check_Session (Database);
      declare
         SQL  : constant String := Query.Get_SQL (Database.Impl.Queries.all);
         Stmt : Query_Statement := Database.Create_Statement (SQL);
      begin
         Stmt.Set_Parameters (Query);
         return Stmt;
      end;
   end Create_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 is
   begin
      Check_Session (Database);
      declare
         SQL   : constant String := ADO.Queries.Get_SQL (Query, Database.Impl.Queries.all, False);
      begin
         return Database.Create_Statement (SQL);
      end;
   end Create_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 is
   begin
      Check_Session (Database);
      declare
         Stmt : Query_Statement := Database.Create_Statement (Table);
      begin
         if Query in ADO.Queries.Context'Class then
            declare
               SQL : constant String
                 := ADO.Queries.Context'Class (Query).Get_SQL (Database.Impl.Queries.all);
            begin
               ADO.SQL.Append (Stmt.Get_Query.SQL, SQL);
            end;
         end if;
         Stmt.Set_Parameters (Query);
         return Stmt;
      end;
   end Create_Statement;

   --  ------------------------------
   --  Load the database schema definition for the current database.
   --  ------------------------------
   procedure Load_Schema (Database : in Session;
                          Schema   : out ADO.Schemas.Schema_Definition) is
   begin
      Check_Session (Database, "Loading schema {0}");
      Database.Impl.Database.Value.Load_Schema (Schema);
   end Load_Schema;

   --  ---------
   --  Master Session
   --  ---------

   --  ------------------------------
   --  Start a transaction.
   --  ------------------------------
   procedure Begin_Transaction (Database : in out Master_Session) is
   begin
      Check_Session (Database, "Begin transaction {0}");
      Database.Impl.Database.Value.Begin_Transaction;
   end Begin_Transaction;

   --  ------------------------------
   --  Commit the current transaction.
   --  ------------------------------
   procedure Commit (Database : in out Master_Session) is
   begin
      Check_Session (Database, "Commit transaction {0}");
      Database.Impl.Database.Value.Commit;
   end Commit;

   --  ------------------------------
   --  Rollback the current transaction.
   --  ------------------------------
   procedure Rollback (Database : in out Master_Session) is
   begin
      Check_Session (Database, "Rollback transaction {0}");
      Database.Impl.Database.Value.Rollback;
   end Rollback;

   --  ------------------------------
   --  Allocate an identifier for the table.
   --  ------------------------------
   procedure Allocate (Database : in out Master_Session;
                       Id       : in out ADO.Objects.Object_Record'Class) is
   begin
      Check_Session (Database);
      ADO.Sequences.Allocate (Database.Sequences.all, Id);
   end Allocate;

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

   overriding
   procedure Adjust (Object : in out Session) is
   begin
      if Object.Impl /= null then
         Util.Concurrent.Counters.Increment (Object.Impl.Counter);
      end if;
   end Adjust;

   overriding
   procedure Finalize (Object : in out Session) is
      procedure Free is
         new Ada.Unchecked_Deallocation (Object => Session_Record,
                                         Name   => Session_Record_Access);
      Is_Zero : Boolean;
   begin
      if Object.Impl /= null then
         Util.Concurrent.Counters.Decrement (Object.Impl.Counter, Is_Zero);
         if Is_Zero then
            ADO.Objects.Release_Proxy (Object.Impl.Proxy, Detach => True);
            if not Object.Impl.Database.Is_Null then
               Object.Impl.Database.Value.Close;
            end if;
            Free (Object.Impl);
         end if;
         Object.Impl := null;
      end if;
   end Finalize;

   --  ------------------------------
   --  Create a delete statement
   --  ------------------------------
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement is
   begin
      Check_Session (Database);
      declare
         Stmt : constant Delete_Statement_Access
           := Database.Impl.Database.Value.all.Create_Statement (Table);
      begin
         return ADO.Statements.Create.Create_Statement (Stmt.all'Access,
                                                        Database.Impl.Values.all'Access);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create an update statement
   --  ------------------------------
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement is
   begin
      Check_Session (Database);
      declare
         Stmt : constant Update_Statement_Access
           := Database.Impl.Database.Value.all.Create_Statement (Table);
      begin
         return ADO.Statements.Create.Create_Statement (Stmt.all'Access,
                                                        Database.Impl.Values.all'Access);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create an insert statement
   --  ------------------------------
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement is
   begin
      Check_Session (Database);
      declare
         Stmt : constant Insert_Statement_Access
           := Database.Impl.Database.Value.all.Create_Statement (Table);
      begin
         return ADO.Statements.Create.Create_Statement (Stmt.all'Access,
                                                        Database.Impl.Values.all'Access);
      end;
   end Create_Statement;

   --  ------------------------------
   --  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 is
      use type ADO.Objects.Session_Proxy_Access;
   begin
      Check_Session (Database);
      if Database.Impl.Proxy = null then
         Database.Impl.Proxy := ADO.Objects.Create_Session_Proxy (Database.Impl);
      end if;
      return Database.Impl.Proxy;
   end Get_Session_Proxy;

end ADO.Sessions;

Raise the Session_Error exception if the session is not initialized


-----------------------------------------------------------------------
--  awa-comments-module -- Comments module
--  Copyright (C) 2011 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 AWA.Comments.Module is

   overriding
   procedure Initialize (Plugin : in out Comment_Module;
                         App    : access ASF.Applications.Main.Application'Class) is
   begin
      null;
   end Initialize;

end AWA.Comments.Module;

-----------------------------------------------------------------------
--  awa-comments-module -- Comments module
--  Copyright (C) 2011 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.Log.Loggers;
package body AWA.Comments.Module is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Comments.Module");

   overriding
   procedure Initialize (Plugin : in out Comment_Module;
                         App    : access ASF.Applications.Main.Application'Class) is
   begin
      Log.Info ("Initializing the comments module");

      --  Setup the resource bundles.
      App.Register ("userMsg", "users");

--        Plugin.Manager := Plugin.Create_User_Manager;
--        Register.Register (Plugin  => Plugin,
--                           Name    => "AWA.Users.Beans.Authenticate_Bean",
--                           Handler => AWA.Users.Beans.Create_Authenticate_Bean'Access);

      AWA.Modules.Module (Plugin).Initialize (App);
   end Initialize;

end AWA.Comments.Module;

Update the comments module

Update the comments module


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

with Ada.Finalization;

with ADO.Configs;
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-drivers.ads
--  @include ado-sessions-sources.ads
--  @include ado-sessions-factory.ads
--  @include ado-caches.ads
package ADO.Sessions is

   use ADO.Statements;

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

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

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

   subtype Database_Connection is Drivers.Connections.Database_Connection;

   --  Internal operation to get access to the database connection.
   procedure Access_Connection (Database : in out Master_Session;
                                Process  : not null access
                                  procedure (Connection : in out Database_Connection'Class));

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

with Ada.Finalization;

with ADO.Configs;
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;
limited with ADO.Audits;

--  = 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-drivers.ads
--  @include ado-sessions-sources.ads
--  @include ado-sessions-factory.ads
--  @include ado-caches.ads
package ADO.Sessions is

   use ADO.Statements;

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

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

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

   --  Get the audit manager.
   function Get_Audit_Manager (Database : in Master_Session)
                               return access Audits.Audit_Manager'Class;

   subtype Database_Connection is Drivers.Connections.Database_Connection;

   --  Internal operation to get access to the database connection.
   procedure Access_Connection (Database : in out Master_Session;
                                Process  : not null access
                                  procedure (Connection : in out Database_Connection'Class));

   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;
      Queries  : ADO.Queries.Query_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;
      Audit     : access ADO.Audits.Audit_Manager'Class;
   end record;

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

end ADO.Sessions;

Declare the Get_Audit_Manager function

Declare the Get_Audit_Manager function


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

with Util.Tests;
with Util.Strings;

package Security.Policies.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   --  Test Add_Permission and Get_Permission_Index
   procedure Test_Add_Permission (T : in out Test);

   --  Test Create_Role and Get_Role_Name
   procedure Test_Create_Role (T : in out Test);

   --  Test Has_Permission
   procedure Test_Has_Permission (T : in out Test);

   --  Test reading policy files
   procedure Test_Read_Policy (T : in out Test);

   --  Test reading policy files and using the <role-permission> controller
   procedure Test_Role_Policy (T : in out Test);

      --  Read the policy file <b>File</b> and perform a test on the given URI
   --  with a user having the given role.
   procedure Check_Policy (T     : in out Test;
                           File  : in String;
                           Role  : in String;
                           URI   : in String);

   type Test_Principal is new Principal with record
      Name  : Util.Strings.String_Ref;
      Roles : Security.Policies.Roles.Role_Map := (others => False);
   end record;

   --  Returns true if the given permission is stored in the user principal.
   function Has_Role (User : in Test_Principal;
                      Role : in Role_Type) return Boolean;

   --  Get the principal name.
   function Get_Name (From : in Test_Principal) return String;

end Security.Policies.Tests;

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

with Util.Tests;
with Util.Strings;

with Security.Policies.Roles;

package Security.Policies.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   --  Test Create_Role and Get_Role_Name
   procedure Test_Create_Role (T : in out Test);

   --  Test Has_Permission
   procedure Test_Has_Permission (T : in out Test);

   --  Test reading policy files
   procedure Test_Read_Policy (T : in out Test);

   --  Test reading policy files and using the <role-permission> controller
   procedure Test_Role_Policy (T : in out Test);

      --  Read the policy file <b>File</b> and perform a test on the given URI
   --  with a user having the given role.
   procedure Check_Policy (T     : in out Test;
                           File  : in String;
                           Role  : in String;
                           URI   : in String);

   type Test_Principal is new Principal with record
      Name  : Util.Strings.String_Ref;
      Roles : Security.Policies.Roles.Role_Map := (others => False);
   end record;

   --  Returns true if the given permission is stored in the user principal.
   function Has_Role (User : in Test_Principal;
                      Role : in Security.Policies.Roles.Role_Type) return Boolean;

   --  Get the principal name.
   function Get_Name (From : in Test_Principal) return String;

end Security.Policies.Tests;

Fix compilation for Policies.Roles

Fix compilation for Policies.Roles


-----------------------------------------------------------------------
--  asf.server -- ASF Server for AWS
--  Copyright (C) 2009, 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 AWS.Templates;
with AWS.MIME;
with AWS.Messages;
with AWS.Services.Web_Block.Registry;

with Ada.Strings.Fixed;
with Ada.Exceptions;

with EL.Beans;
with ASF.Beans;
with ASF.Applications.Views;
with ASF.Components.Core;
with ASF.Contexts.Faces;
with ASF.Contexts.Writer.String;

with EL.Objects;
with EL.Contexts;
with EL.Contexts.Default;
with EL.Variables;
with EL.Variables.Default;

with Ada.Strings.Unbounded;
with Util.Log.Loggers;
with Ada.Containers.Vectors;
package body ASF.Server.Web is

   use Util.Log;
   use ASF.Contexts;
   use Ada.Exceptions;
   use AWS.Templates;
   use ASF.Beans;
   use Ada.Strings.Unbounded;

   Log : constant Loggers.Logger := Loggers.Create ("ASF.Server.Web");
   --  The logger

   function Reply_Page_500 (Request : in AWS.Status.Data;
                            E       : in Exception_Occurrence)
                            return AWS.Response.Data;

   function Dispatch (App  : Main.Application_Access;
                      Page : String;
                      Request : in AWS.Status.Data) return AWS.Response.Data;

   --  Binding to record the ASF applications and bind them to URI prefixes.
   type Binding is record
      Application : Main.Application_Access;
      Base_URI    : access String;
   end record;
   type Binding_Array is array (Natural range <>) of Binding;
   type Binding_Array_Access is access all Binding_Array;

   Nb_Bindings  : Natural := 0;
   Applications : Binding_Array_Access := null;

   type Bean_Object is record
      Bean : EL.Beans.Readonly_Bean_Access;
      Free : ASF.Beans.Free_Bean_Access;
   end record;

   package Bean_Vectors is new Ada.Containers.Vectors
     (Index_Type => Natural, Element_Type => Bean_Object);

   type Bean_Vector_Access is access all Bean_Vectors.Vector;

   --  ------------------------------
   --  Default Resolver
   --  ------------------------------
   type Web_ELResolver is new EL.Contexts.ELResolver with record
      Request     : EL.Contexts.Default.Default_ELResolver_Access;
      Application : Main.Application_Access;
      Beans       : Bean_Vector_Access;
   end record;

   overriding
   function Get_Value (Resolver : Web_ELResolver;
                       Context  : EL.Contexts.ELContext'Class;
                       Base     : access EL.Beans.Readonly_Bean'Class;
                       Name     : Unbounded_String) return EL.Objects.Object;
   overriding
   procedure Set_Value (Resolver : in Web_ELResolver;
                        Context  : in EL.Contexts.ELContext'Class;
                        Base     : access EL.Beans.Bean'Class;
                        Name     : in Unbounded_String;
                        Value    : in EL.Objects.Object);

   --  Get the value associated with a base object and a given property.
   overriding
   function Get_Value (Resolver : Web_ELResolver;
                       Context  : EL.Contexts.ELContext'Class;
                       Base     : access EL.Beans.Readonly_Bean'Class;
                       Name     : Unbounded_String) return EL.Objects.Object is
      use EL.Objects;
      Result : Object := Resolver.Request.Get_Value (Context, Base, Name);
      Bean   : EL.Beans.Readonly_Bean_Access;
      Free   : ASF.Beans.Free_Bean_Access;
      Scope  : Scope_Type;
   begin
      if not EL.Objects.Is_Null (Result) then
         return Result;
      end if;
      Resolver.Application.Create (Name, Bean, Free, Scope);
      Resolver.Beans.Append (Bean_Object '(Bean, Free));
      Result := To_Object (Bean);
      Resolver.Request.Register (Name, Result);
      return Result;
   end Get_Value;

   --  Set the value associated with a base object and a given property.
   overriding
   procedure Set_Value (Resolver : in Web_ELResolver;
                        Context  : in EL.Contexts.ELContext'Class;
                        Base     : access EL.Beans.Bean'Class;
                        Name     : in Unbounded_String;
                        Value    : in EL.Objects.Object) is
   begin
      Resolver.Request.Set_Value (Context, Base, Name, Value);
   end Set_Value;

   --  Register the application to serve requests
   procedure Register_Application (URI    : in String;
                                   App    : in Main.Application_Access) is

      Apps : constant Binding_Array_Access := new Binding_Array (1 .. Nb_Bindings + 1);
   begin
      if Applications /= null then
         Apps (1 .. Nb_Bindings) := Applications (1 .. Nb_Bindings);
      end if;
      Nb_Bindings := Nb_Bindings + 1;
      Apps (Apps'Last).Application := App;
      Apps (Apps'Last).Base_URI := new String '(URI);
      Applications := Apps;
   end Register_Application;

   function Dispatch (App  : Main.Application_Access;
                      Page : String;
                      Request : in AWS.Status.Data) return AWS.Response.Data is

      use ASF;
      use ASF.Contexts.Faces;
      use ASF.Applications.Views;

      use EL.Contexts.Default;
      use EL.Variables;
      use EL.Variables.Default;
      use EL.Contexts;
      use EL.Objects;

      Writer   : aliased Contexts.Writer.String.String_Writer;
      Context  : aliased Faces_Context;
      View     : Components.Core.UIViewRoot;
      ELContext : aliased EL.Contexts.Default.Default_Context;
      Variables : aliased Default_Variable_Mapper;
      Req_Resolver   : aliased Default_ELResolver;
      Root_Resolver  : aliased Web_ELResolver;

      Beans    : aliased Bean_Vectors.Vector;
      --  Get the view handler
      Handler   : constant access View_Handler'Class := App.Get_View_Handler;
   begin
      Root_Resolver.Application := App;
      Root_Resolver.Request := Req_Resolver'Unchecked_Access;
      Root_Resolver.Beans := Beans'Unchecked_Access;
      ELContext.Set_Resolver (Root_Resolver'Unchecked_Access);
      ELContext.Set_Variable_Mapper (Variables'Unchecked_Access);

      Context.Set_Response_Writer (Writer'Unchecked_Access);
      Context.Set_ELContext (ELContext'Unchecked_Access);
      Writer.Initialize ("text/xml", "UTF-8", 8192);

      Context.Set_Request (Request'Unrestricted_Access);
      Set_Current (Context'Unchecked_Access);
      Handler.Restore_View (Page, Context, View);

      Handler.Render_View (Context, View);
      Writer.Flush;

      declare
         C : Bean_Vectors.Cursor := Beans.First;
      begin
         while Bean_Vectors.Has_Element (C) loop
            declare
               Bean : Bean_Object := Bean_Vectors.Element (C);
            begin
               Bean.Free (Bean.Bean);
            end;
            Bean_Vectors.Next (C);
         end loop;
      end;
      return AWS.Response.Build (Content_Type => Writer.Get_Content_Type,
                                 UString_Message => Writer.Get_Response);
   end Dispatch;

   ----------------------
   --  Main server callback
   ----------------------
   function Server_Callback (Request : in AWS.Status.Data) return AWS.Response.Data is
      use Ada.Strings.Fixed;

      URI        : constant String := AWS.Status.URI (Request);
      Slash_Pos  : constant Natural := Index (URI, "/", URI'First + 1);
      Prefix_End : Natural;
   begin
      --  Find the module and action to invoke
      if Slash_Pos > 1 then
         Prefix_End := Slash_Pos - 1;
      else
         Prefix_End := URI'Last;
      end if;
      declare
         Prefix : constant String := URI (URI'First .. Prefix_End);
         Page   : constant String := URI (Prefix_End + 1 .. URI'Last);
      begin
         for I in Applications.all'Range loop
            if Applications (I).Base_URI.all = Prefix then
               return Dispatch (Applications (I).Application, Page, Request);
            end if;
         end loop;
      end;
      return AWS.Response.Build ("text/html", "
Unknown application
");
   exception
      when E : others =>
         return Reply_Page_500 (Request, E);
   end Server_Callback;

   --  Return a 500 error
   function Reply_Page_500 (Request : in AWS.Status.Data;
                            E       : in Exception_Occurrence)
                            return AWS.Response.Data is
      use type AWS.Messages.Status_Code;
      use AWS.Services;
      use AWS;

      Translations : Templates.Translate_Set;
      URI          : constant String := AWS.Status.URI (Request);
      Name         : constant String := Exception_Name (E);
      Message      : constant String := Exception_Message (E);
      ContentType  : constant String := Web_Block.Registry.Content_Type (URI);
   begin
      Templates.Insert (Translations,
                        Templates.Assoc ("URI", URI));
      Templates.Insert (Translations,
                        Templates.Assoc ("EXCEPTION_NAME", Name));
      Templates.Insert (Translations,
                        Templates.Assoc ("EXCEPTION_MESSAGE", Message));

      Log.Error ("Default_Callback exception for URI '{0}': {1}: {2}",
                 URI, Name, Message);

      if ContentType = AWS.MIME.Text_HTML then
         return AWS.Response.Build
           (Content_Type => AWS.MIME.Text_HTML,
            Message_Body => String'(Templates.Parse
              ("errors/exception.thtml",
                 Translations)));
      else
         return AWS.Response.Build
           (Content_Type => AWS.MIME.Text_XML,
            Message_Body => String'(Templates.Parse
              ("errors/exception.txml",
                 Translations)));
      end if;
   end Reply_Page_500;

end ASF.Server.Web;

-----------------------------------------------------------------------
--  asf.server -- ASF Server for AWS
--  Copyright (C) 2009, 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 AWS.Templates;
with AWS.MIME;
with AWS.Messages;
with AWS.Services.Web_Block.Registry;

with Ada.Strings.Fixed;
with Ada.Exceptions;

with EL.Beans;
with ASF.Beans;
with ASF.Applications.Views;
with ASF.Components.Core;
with ASF.Contexts.Faces;
with ASF.Contexts.Writer.String;

with EL.Objects;
with EL.Contexts;
with EL.Contexts.Default;
with EL.Variables;
with EL.Variables.Default;

with Ada.Strings.Unbounded;
with Util.Log.Loggers;
with Ada.Containers.Vectors;
package body ASF.Server.Web is

   use Util.Log;
   use ASF.Contexts;
   use Ada.Exceptions;
   use AWS.Templates;
   use ASF.Beans;
   use Ada.Strings.Unbounded;

   Log : constant Loggers.Logger := Loggers.Create ("ASF.Server.Web");
   --  The logger

   function Reply_Page_500 (Request : in AWS.Status.Data;
                            E       : in Exception_Occurrence)
                            return AWS.Response.Data;

   function Dispatch (App  : Main.Application_Access;
                      Page : String;
                      Request : in AWS.Status.Data) return AWS.Response.Data;

   --  Binding to record the ASF applications and bind them to URI prefixes.
   type Binding is record
      Application : Main.Application_Access;
      Base_URI    : access String;
   end record;
   type Binding_Array is array (Natural range <>) of Binding;
   type Binding_Array_Access is access all Binding_Array;

   Nb_Bindings  : Natural := 0;
   Applications : Binding_Array_Access := null;

   type Bean_Object is record
      Bean : EL.Beans.Readonly_Bean_Access;
      Free : ASF.Beans.Free_Bean_Access;
   end record;

   package Bean_Vectors is new Ada.Containers.Vectors
     (Index_Type => Natural, Element_Type => Bean_Object);

   type Bean_Vector_Access is access all Bean_Vectors.Vector;

   --  ------------------------------
   --  Default Resolver
   --  ------------------------------
   type Web_ELResolver is new EL.Contexts.ELResolver with record
      Request     : EL.Contexts.Default.Default_ELResolver_Access;
      Application : Main.Application_Access;
      Beans       : Bean_Vector_Access;
   end record;

   overriding
   function Get_Value (Resolver : Web_ELResolver;
                       Context  : EL.Contexts.ELContext'Class;
                       Base     : access EL.Beans.Readonly_Bean'Class;
                       Name     : Unbounded_String) return EL.Objects.Object;
   overriding
   procedure Set_Value (Resolver : in Web_ELResolver;
                        Context  : in EL.Contexts.ELContext'Class;
                        Base     : access EL.Beans.Bean'Class;
                        Name     : in Unbounded_String;
                        Value    : in EL.Objects.Object);

   --  Get the value associated with a base object and a given property.
   overriding
   function Get_Value (Resolver : Web_ELResolver;
                       Context  : EL.Contexts.ELContext'Class;
                       Base     : access EL.Beans.Readonly_Bean'Class;
                       Name     : Unbounded_String) return EL.Objects.Object is
      use EL.Objects;
      use EL.Beans;
      use EL.Variables;

      Result : Object := Resolver.Request.Get_Value (Context, Base, Name);
      Bean   : EL.Beans.Readonly_Bean_Access;
      Free   : ASF.Beans.Free_Bean_Access;
      Scope  : Scope_Type;
   begin
      if not EL.Objects.Is_Null (Result) then
         return Result;
      end if;
      Resolver.Application.Create (Name, Bean, Free, Scope);
      if Bean = null then
         raise No_Variable
           with "Bean not found: '" & To_String (Name) & "'";
      end if;
      Resolver.Beans.Append (Bean_Object '(Bean, Free));
      Result := To_Object (Bean);
      Resolver.Request.Register (Name, Result);
      return Result;
   end Get_Value;

   --  Set the value associated with a base object and a given property.
   overriding
   procedure Set_Value (Resolver : in Web_ELResolver;
                        Context  : in EL.Contexts.ELContext'Class;
                        Base     : access EL.Beans.Bean'Class;
                        Name     : in Unbounded_String;
                        Value    : in EL.Objects.Object) is
   begin
      Resolver.Request.Set_Value (Context, Base, Name, Value);
   end Set_Value;

   --  Register the application to serve requests
   procedure Register_Application (URI    : in String;
                                   App    : in Main.Application_Access) is

      Apps : constant Binding_Array_Access := new Binding_Array (1 .. Nb_Bindings + 1);
   begin
      if Applications /= null then
         Apps (1 .. Nb_Bindings) := Applications (1 .. Nb_Bindings);
      end if;
      Nb_Bindings := Nb_Bindings + 1;
      Apps (Apps'Last).Application := App;
      Apps (Apps'Last).Base_URI := new String '(URI);
      Applications := Apps;
   end Register_Application;

   function Dispatch (App  : Main.Application_Access;
                      Page : String;
                      Request : in AWS.Status.Data) return AWS.Response.Data is

      use ASF;
      use ASF.Contexts.Faces;
      use ASF.Applications.Views;

      use EL.Contexts.Default;
      use EL.Variables;
      use EL.Variables.Default;
      use EL.Contexts;
      use EL.Objects;
      use EL.Beans;

      Writer   : aliased Contexts.Writer.String.String_Writer;
      Context  : aliased Faces_Context;
      View     : Components.Core.UIViewRoot;
      ELContext : aliased EL.Contexts.Default.Default_Context;
      Variables : aliased Default_Variable_Mapper;
      Req_Resolver   : aliased Default_ELResolver;
      Root_Resolver  : aliased Web_ELResolver;

      Beans    : aliased Bean_Vectors.Vector;
      --  Get the view handler
      Handler   : constant access View_Handler'Class := App.Get_View_Handler;
   begin
      Root_Resolver.Application := App;
      Root_Resolver.Request := Req_Resolver'Unchecked_Access;
      Root_Resolver.Beans := Beans'Unchecked_Access;
      ELContext.Set_Resolver (Root_Resolver'Unchecked_Access);
      ELContext.Set_Variable_Mapper (Variables'Unchecked_Access);

      Context.Set_Response_Writer (Writer'Unchecked_Access);
      Context.Set_ELContext (ELContext'Unchecked_Access);
      Writer.Initialize ("text/xml", "UTF-8", 8192);

      Context.Set_Request (Request'Unrestricted_Access);
      Set_Current (Context'Unchecked_Access);
      Handler.Restore_View (Page, Context, View);

      Handler.Render_View (Context, View);
      Writer.Flush;

      declare
         C : Bean_Vectors.Cursor := Beans.First;
      begin
         while Bean_Vectors.Has_Element (C) loop
            declare
               Bean : Bean_Object := Bean_Vectors.Element (C);
            begin
               if Bean.Bean /= null then
                  Bean.Free (Bean.Bean);
               end if;
            end;
            Bean_Vectors.Next (C);
         end loop;
      end;
      return AWS.Response.Build (Content_Type => Writer.Get_Content_Type,
                                 UString_Message => Writer.Get_Response);
   end Dispatch;

   ----------------------
   --  Main server callback
   ----------------------
   function Server_Callback (Request : in AWS.Status.Data) return AWS.Response.Data is
      use Ada.Strings.Fixed;

      URI        : constant String := AWS.Status.URI (Request);
      Slash_Pos  : constant Natural := Index (URI, "/", URI'First + 1);
      Prefix_End : Natural;
   begin
      --  Find the module and action to invoke
      if Slash_Pos > 1 then
         Prefix_End := Slash_Pos - 1;
      else
         Prefix_End := URI'Last;
      end if;
      declare
         Prefix : constant String := URI (URI'First .. Prefix_End);
         Page   : constant String := URI (Prefix_End + 1 .. URI'Last);
      begin
         for I in Applications.all'Range loop
            if Applications (I).Base_URI.all = Prefix then
               return Dispatch (Applications (I).Application, Page, Request);
            end if;
         end loop;
      end;
      return AWS.Response.Build ("text/html", "
Unknown application
");
   exception
      when E : others =>
         return Reply_Page_500 (Request, E);
   end Server_Callback;

   --  Return a 500 error
   function Reply_Page_500 (Request : in AWS.Status.Data;
                            E       : in Exception_Occurrence)
                            return AWS.Response.Data is
      use type AWS.Messages.Status_Code;
      use AWS.Services;
      use AWS;

      Translations : Templates.Translate_Set;
      URI          : constant String := AWS.Status.URI (Request);
      Name         : constant String := Exception_Name (E);
      Message      : constant String := Exception_Message (E);
      ContentType  : constant String := Web_Block.Registry.Content_Type (URI);
   begin
      Templates.Insert (Translations,
                        Templates.Assoc ("URI", URI));
      Templates.Insert (Translations,
                        Templates.Assoc ("EXCEPTION_NAME", Name));
      Templates.Insert (Translations,
                        Templates.Assoc ("EXCEPTION_MESSAGE", Message));

      Log.Error ("Default_Callback exception for URI '{0}': {1}: {2}",
                 URI, Name, Message);

      if ContentType = AWS.MIME.Text_HTML then
         return AWS.Response.Build
           (Content_Type => AWS.MIME.Text_HTML,
            Message_Body => String'(Templates.Parse
              ("errors/exception.thtml",
                 Translations)));
      else
         return AWS.Response.Build
           (Content_Type => AWS.MIME.Text_XML,
            Message_Body => String'(Templates.Parse
              ("errors/exception.txml",
                 Translations)));
      end if;
   end Reply_Page_500;

end ASF.Server.Web;

Raise an exception if we cannot create a bean