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

with Ada.Unchecked_Deallocation;
package body Util.Concurrent.Fifos is

   --  ------------------------------
   --  Put the element in the queue.
   --  ------------------------------
   procedure Enqueue (Into    : in out Fifo;
                      Item    : in Element_Type;
                      Wait    : in Duration := FOREVER) is
   begin
      if Wait < 0.0 then
         Into.Buffer.Enqueue (Item);
      else
         select
            Into.Buffer.Enqueue (Item);
         or
            delay Wait;
            raise Timeout;
         end select;
      end if;
   end Enqueue;

   --  ------------------------------
   --  Get an element from the queue.
   --  Wait until one element gets available.
   --  ------------------------------
   procedure Dequeue (From    : in out Fifo;
                      Item    : out Element_Type;
                      Wait    : in Duration := FOREVER) is
   begin
      if Wait < 0.0 then
         From.Buffer.Dequeue (Item);
      else
         select
            From.Buffer.Dequeue (Item);
         or
            delay Wait;
            raise Timeout;
         end select;
      end if;
   end Dequeue;

   --  ------------------------------
   --  Get the number of elements in the queue.
   --  ------------------------------
   function Get_Count (From : in Fifo) return Natural is
   begin
      return From.Buffer.Get_Count;
   end Get_Count;

   --  ------------------------------
   --  Set the queue size.
   --  ------------------------------
   procedure Set_Size (Into : in out Fifo;
                       Capacity : in Positive) is
   begin
      Into.Buffer.Set_Size (Capacity);
   end Set_Size;

   --  ------------------------------
   --  Initializes the queue.
   --  ------------------------------
   overriding
   procedure Initialize (Object : in out Fifo) is
   begin
      Object.Buffer.Set_Size (Default_Size);
   end Initialize;

   --  ------------------------------
   --  Release the queue elements.
   --  ------------------------------
   overriding
   procedure Finalize (Object : in out Fifo) is
   begin
      if Clear_On_Dequeue then
         while Object.Get_Count > 0 loop
            declare
               Unused : Element_Type;
            begin
               Object.Dequeue (Unused);
            end;
         end loop;
      end if;
      Object.Buffer.Set_Size (0);
   end Finalize;

   --  Queue of objects.
   protected body Protected_Fifo is

      --  ------------------------------
      --  Put the element in the queue.
      --  If the queue is full, wait until some room is available.
      --  ------------------------------
      entry Enqueue (Item : in Element_Type) when Count < Elements'Length is
      begin
         Elements (Last) := Item;
         Last := Last + 1;
         if Last > Elements'Last then
            if Clear_On_Dequeue then
               Last := Elements'First + 1;
            else
               Last := Elements'First;
            end if;
         end if;
         Count := Count + 1;
      end Enqueue;

      --  ------------------------------
      --  Get an element from the queue.
      --  Wait until one element gets available.
      --  ------------------------------
      entry Dequeue (Item : out Element_Type) when Count > 0 is
      begin
         Count := Count - 1;
         Item := Elements (First);

         --  For the clear on dequeue mode, erase the queue element.
         --  If the element holds some storage or a reference, this gets cleared here.
         --  The element used to clear is at index 0 (which does not exist if Clear_On_Dequeue
         --  is false).  There is no overhead when this is not used
         --  (ie, instantiation/compile time flag).
         if Clear_On_Dequeue then
            Elements (First) := Elements (0);
         end if;
         First := First + 1;
         if First > Elements'Last then
            if Clear_On_Dequeue then
               First := Elements'First + 1;
            else
               First := Elements'First;
            end if;
         end if;
      end Dequeue;

      --  ------------------------------
      --  Get the number of elements in the queue.
      --  ------------------------------
      function Get_Count return Natural is
      begin
         return Count;
      end Get_Count;

      --  ------------------------------
      --  Set the queue size.
      --  ------------------------------
      procedure Set_Size (Capacity : in Natural) is
         procedure Free is new Ada.Unchecked_Deallocation (Element_Array, Element_Array_Access);
         First_Pos : Natural := 1;
      begin
         if Clear_On_Dequeue then
            First_Pos := 0;
         end if;
         if Capacity = 0 then
            Free (Elements);
         elsif Elements = null then
            Elements := new Element_Array (First_Pos .. Capacity);
         else
            declare
               New_Array : constant Element_Array_Access
                 := new Element_Array (First_Pos .. Capacity);
            begin
               if Capacity > Elements'Length then
                  New_Array (First_Pos .. Elements'Last) := Elements (First_Pos .. Elements'Last);
               else
                  New_Array (First_Pos .. Capacity) := Elements (First_Pos .. Capacity);
               end if;

               Free (Elements);
               Elements := New_Array;
            end;
         end if;
      end Set_Size;

   end Protected_Fifo;

end Util.Concurrent.Fifos;

-----------------------------------------------------------------------
--  util-concurrent-fifos -- Concurrent Fifo Queues
--  Copyright (C) 2012, 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 Ada.Unchecked_Deallocation;
package body Util.Concurrent.Fifos is

   --  ------------------------------
   --  Put the element in the queue.
   --  ------------------------------
   procedure Enqueue (Into    : in out Fifo;
                      Item    : in Element_Type;
                      Wait    : in Duration := FOREVER) is
   begin
      if Wait < 0.0 then
         Into.Buffer.Enqueue (Item);
      else
         select
            Into.Buffer.Enqueue (Item);
         or
            delay Wait;
            raise Timeout;
         end select;
      end if;
   end Enqueue;

   --  ------------------------------
   --  Get an element from the queue.
   --  Wait until one element gets available.
   --  ------------------------------
   procedure Dequeue (From    : in out Fifo;
                      Item    : out Element_Type;
                      Wait    : in Duration := FOREVER) is
   begin
      if Wait < 0.0 then
         From.Buffer.Dequeue (Item);
      else
         select
            From.Buffer.Dequeue (Item);
         or
            delay Wait;
            raise Timeout;
         end select;
      end if;
   end Dequeue;

   --  ------------------------------
   --  Get the number of elements in the queue.
   --  ------------------------------
   function Get_Count (From : in Fifo) return Natural is
   begin
      return From.Buffer.Get_Count;
   end Get_Count;

   --  ------------------------------
   --  Set the queue size.
   --  ------------------------------
   procedure Set_Size (Into : in out Fifo;
                       Capacity : in Positive) is
   begin
      Into.Buffer.Set_Size (Capacity);
   end Set_Size;

   --  ------------------------------
   --  Initializes the queue.
   --  ------------------------------
   overriding
   procedure Initialize (Object : in out Fifo) is
   begin
      Object.Buffer.Set_Size (Default_Size);
   end Initialize;

   --  ------------------------------
   --  Release the queue elements.
   --  ------------------------------
   overriding
   procedure Finalize (Object : in out Fifo) is
   begin
      if Clear_On_Dequeue then
         while Object.Get_Count > 0 loop
            declare
               Unused : Element_Type;
            begin
               Object.Dequeue (Unused);
            end;
         end loop;
      end if;
      Object.Buffer.Set_Size (0);
   end Finalize;

   --  Queue of objects.
   protected body Protected_Fifo is

      --  ------------------------------
      --  Put the element in the queue.
      --  If the queue is full, wait until some room is available.
      --  ------------------------------
      entry Enqueue (Item : in Element_Type) when Count < Elements'Length is
      begin
         Elements (Last) := Item;
         Last := Last + 1;
         if Last > Elements'Last then
            if Clear_On_Dequeue then
               Last := Elements'First + 1;
            else
               Last := Elements'First;
            end if;
         end if;
         Count := Count + 1;
      end Enqueue;

      --  ------------------------------
      --  Get an element from the queue.
      --  Wait until one element gets available.
      --  ------------------------------
      entry Dequeue (Item : out Element_Type) when Count > 0 is
      begin
         Count := Count - 1;
         Item := Elements (First);

         --  For the clear on dequeue mode, erase the queue element.
         --  If the element holds some storage or a reference, this gets cleared here.
         --  The element used to clear is at index 0 (which does not exist if Clear_On_Dequeue
         --  is false).  There is no overhead when this is not used
         --  (ie, instantiation/compile time flag).
         if Clear_On_Dequeue then
            Elements (First) := Elements (0);
         end if;
         First := First + 1;
         if First > Elements'Last then
            if Clear_On_Dequeue then
               First := Elements'First + 1;
            else
               First := Elements'First;
            end if;
         end if;
      end Dequeue;

      --  ------------------------------
      --  Get the number of elements in the queue.
      --  ------------------------------
      function Get_Count return Natural is
      begin
         return Count;
      end Get_Count;

      --  ------------------------------
      --  Set the queue size.
      --  ------------------------------
      procedure Set_Size (Capacity : in Natural) is
         procedure Free is new Ada.Unchecked_Deallocation (Element_Array, Element_Array_Access);
         First_Pos : Natural := 1;
      begin
         if Clear_On_Dequeue then
            First_Pos := 0;
         end if;
         if Capacity = 0 then
            Free (Elements);
         elsif Elements = null then
            Elements := new Element_Array (First_Pos .. Capacity);
         else
            declare
               New_Array : constant Element_Array_Access
                 := new Element_Array (First_Pos .. Capacity);
            begin
               if Capacity > Elements'Length then
                  New_Array (First_Pos .. Elements'Last) := Elements (First_Pos .. Elements'Last);
               else
                  New_Array (First_Pos .. Capacity) := Elements (First_Pos .. Capacity);
               end if;

               Free (Elements);
               Elements := New_Array;
            end;
         end if;
      end Set_Size;

   end Protected_Fifo;

end Util.Concurrent.Fifos;

Update the header

Update the header


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

with GNAT.Command_Line;

with ASF.Applications.Main;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;

with EL.Objects;
--  This example reads an XHTML file and renders the result.
procedure Render is

   use GNAT.Command_Line;
   use Ada.Strings.Fixed;

   use ASF;

   use EL.Objects;

   Factory  : ASF.Applications.Main.Application_Factory;
   App      : Applications.Main.Application;
   Conf     : Applications.Config;
begin
   Conf.Set ("view.ignore_white_spaces", "false");
   Conf.Set ("view.escape_unknown_tags", "false");
   Conf.Set ("view.ignore_empty_lines", "true");

   App.Initialize (Conf, Factory);
   loop
      case Getopt ("D:") is
         when 'D' =>
            declare
               Value : constant String := Parameter;
               Pos   : constant Natural := Index (Value, "=");
            begin
               if Pos > 0 then
                  App.Set_Global (Name  => Value (1 .. Pos - 1),
                                  Value => To_Object (Value (Pos + 1 .. Value'Last)));
               else
                  App.Set_Global (Name  => Value (1 .. Pos - 1),
                                  Value => To_Object(True));
               end if;
            end;

         when others =>
            exit;
      end case;
   end loop;

   declare
      View_Name : constant String := Get_Argument;
      Req       : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Content   : Ada.Strings.Unbounded.Unbounded_String;
   begin

      Req.Set_Path_Info (View_Name);
      App.Dispatch (Page     => View_Name,
                    Request  => Req,
                    Response => Reply);

      Reply.Read_Content (Content);
      Ada.Text_IO.Put_Line (Ada.Strings.Unbounded.To_String (Content));

   exception
      when Ada.IO_Exceptions.Name_Error =>
         Ada.Text_IO.Put_Line ("Cannot read file '" & View_Name & "'");
   end;
end Render;

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

with GNAT.Command_Line;

with ASF.Applications.Main;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;

with EL.Objects;
--  This example reads an XHTML file and renders the result.
procedure Render is

   use GNAT.Command_Line;
   use Ada.Strings.Fixed;

   use ASF;

   use EL.Objects;

   Factory  : ASF.Applications.Main.Application_Factory;
   App      : Applications.Main.Application;
   Conf     : Applications.Config;
begin
   Conf.Set ("view.ignore_white_spaces", "false");
   Conf.Set ("view.escape_unknown_tags", "false");
   Conf.Set ("view.ignore_empty_lines", "true");

   App.Initialize (Conf, Factory);
   loop
      case Getopt ("D:") is
         when 'D' =>
            declare
               Value : constant String := Parameter;
               Pos   : constant Natural := Index (Value, "=");
            begin
               if Pos > 0 then
                  App.Set_Global (Name  => Value (Value'First .. Pos - 1),
                                  Value => To_Object (Value (Pos + 1 .. Value'Last)));
               else
                  App.Set_Global (Name  => Value (Value'First .. Pos - 1),
                                  Value => To_Object (True));
               end if;
            end;

         when others =>
            exit;
      end case;
   end loop;

   declare
      View_Name : constant String := Get_Argument;
      Pos       : constant Natural := Index (View_Name, ".");
      Req       : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Content   : Ada.Strings.Unbounded.Unbounded_String;
   begin
      if View_Name = "" or Pos = 0 then
         Ada.Text_IO.Put_Line ("Usage: render [-DNAME=VALUE ] file");
         Ada.Text_IO.Put_Line ("Example: render -DcontextPath=/test samples/web/ajax.xhtml");
         return;
      end if;

      Req.Set_Path_Info (View_Name (View_Name'First .. Pos - 1));
      App.Dispatch (Page     => View_Name (View_Name'First .. Pos - 1),
                    Request  => Req,
                    Response => Reply);

      Reply.Read_Content (Content);
      Ada.Text_IO.Put_Line (Ada.Strings.Unbounded.To_String (Content));

   exception
      when Ada.IO_Exceptions.Name_Error =>
         Ada.Text_IO.Put_Line ("Cannot read file '" & View_Name & "'");
   end;
end Render;

Fix usage of render example

Fix usage of render example


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

with AWA.Services.Contexts;
package body AWA.Questions.Beans is

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Question_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if From.Is_Null then
         return Util.Beans.Objects.Null_Object;
      else
         return AWA.Questions.Models.Question_Bean (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Question_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "title" then
         From.Set_Title (Util.Beans.Objects.To_String (Value));

      elsif Name = "description" then
         From.Set_Description (Util.Beans.Objects.To_String (Value));

      elsif Name = "id" and not Util.Beans.Objects.Is_Empty (Value) then
            From.Service.Load_Question (From,
                                        ADO.Identifier (Util.Beans.Objects.To_Integer (Value)));
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create or save the question.
   --  ------------------------------
   procedure Save (Bean    : in out Question_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   begin
      Bean.Service.Save_Question (Bean);
   end Save;

   --  ------------------------------
   --  Delete the question.
   --  ------------------------------
   procedure Delete (Bean    : in out Question_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   begin
      Bean.Service.Delete_Question (Bean);
   end Delete;

   --  ------------------------------
   --  Create the Question_Bean bean instance.
   --  ------------------------------
   function Create_Question_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Question_Bean_Access := new Question_Bean;
   begin
      Object.Service := Module.Get_Question_Manager;
      return Object.all'Access;
   end Create_Question_Bean;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Answer_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "question_id" then
         return Util.Beans.Objects.To_Object (Long_Long_Integer (From.Question.Get_Id));
      elsif From.Is_Null then
         return Util.Beans.Objects.Null_Object;
      else
         return AWA.Questions.Models.Answer_Bean (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Answer_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "id" and not Util.Beans.Objects.Is_Null (Value) then
         From.Service.Load_Answer (From, From.Question,
                                   ADO.Identifier (Util.Beans.Objects.To_Integer (Value)));

      elsif Name = "answer" then
         From.Set_Answer (Util.Beans.Objects.To_String (Value));

      elsif Name = "question_id" and not Util.Beans.Objects.Is_Null (Value) then
         From.Service.Load_Question (From.Question,
                                     ADO.Identifier (Util.Beans.Objects.To_Integer (Value)));
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create or save the answer.
   --  ------------------------------
   procedure Save (Bean    : in out Answer_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   begin
      Bean.Service.Save_Answer (Question => Bean.Question,
                                Answer   => Bean);
   end Save;

   --  ------------------------------
   --  Delete the question.
   --  ------------------------------
   procedure Delete (Bean    : in out Answer_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   begin
      Bean.Service.Delete_Answer (Answer => Bean);
   end Delete;

   --  ------------------------------
   --  Create the answer bean instance.
   --  ------------------------------
   function Create_Answer_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Answer_Bean_Access := new Answer_Bean;
   begin
      Object.Service := Module.Get_Question_Manager;
      return Object.all'Access;
   end Create_Answer_Bean;

   --  ------------------------------
   --  Create the Question_Info_List_Bean bean instance.
   --  ------------------------------
   function Create_Question_List_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                       return Util.Beans.Basic.Readonly_Bean_Access is
      use AWA.Questions.Models;
      use AWA.Services;

      Object  : constant Question_Info_List_Bean_Access := new Question_Info_List_Bean;
      Session : ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;
   begin
      Query.Set_Query (AWA.Questions.Models.Query_Question_List);
      ADO.Sessions.Entities.Bind_Param (Params  => Query,
                                        Name    => "entity_type",
                                        Table   => AWA.Questions.Models.QUESTION_TABLE,
                                        Session => Session);
      AWA.Questions.Models.List (Object.all, Session, Query);
      return Object.all'Access;
   end Create_Question_List_Bean;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Question_Display_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "answers" then
         return Util.Beans.Objects.To_Object (Value   => From.Answer_List_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      elsif Name = "question" then
         return Util.Beans.Objects.To_Object (Value   => From.Question_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Question_Display_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "id" and not Util.Beans.Objects.Is_Empty (Value) then
         declare
            package ASC renames AWA.Services.Contexts;
            use AWA.Questions.Models;
            use AWA.Services;

            Session : ADO.Sessions.Session := From.Service.Get_Session;
            Query   : ADO.Queries.Context;
            List    : AWA.Questions.Models.Question_Display_Info_List_Bean;
            Ctx     : constant ASC.Service_Context_Access := ASC.Current;
         begin
            Query.Set_Query (AWA.Questions.Models.Query_Question_Info);
            Query.Bind_Param ("question_id", Util.Beans.Objects.To_Integer (Value));
            Query.Bind_Param ("user_id", Ctx.Get_User_Identifier);
            ADO.Sessions.Entities.Bind_Param (Params  => Query,
                                              Name    => "entity_type",
                                              Table   => AWA.Questions.Models.QUESTION_TABLE,
                                              Session => Session);
            AWA.Questions.Models.List (List, Session, Query);
            if not List.List.Is_Empty then
               From.Question := List.List.Element (0);
            end if;
            Query.Clear;
            Query.Bind_Param ("question_id", Util.Beans.Objects.To_Integer (Value));
            Query.Bind_Param ("user_id", Ctx.Get_User_Identifier);
            ADO.Sessions.Entities.Bind_Param (Params  => Query,
                                              Name    => "entity_type",
                                              Table   => AWA.Questions.Models.ANSWER_TABLE,
                                              Session => Session);

            Query.Set_Query (AWA.Questions.Models.Query_Answer_List);
            AWA.Questions.Models.List (From.Answer_List, Session, Query);
         end;
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create the Question_Display_Bean bean instance.
   --  ------------------------------
   function Create_Question_Display_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                       return Util.Beans.Basic.Readonly_Bean_Access is
      Object  : constant Question_Display_Bean_Access := new Question_Display_Bean;
   begin
      Object.Service          := Module.Get_Question_Manager;
      Object.Question_Bean    := Object.Question'Access;
      Object.Answer_List_Bean := Object.Answer_List'Access;
      return Object.all'Access;
   end Create_Question_Display_Bean;

end AWA.Questions.Beans;

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

with AWA.Services.Contexts;
package body AWA.Questions.Beans is

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Question_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if From.Is_Null then
         return Util.Beans.Objects.Null_Object;
      else
         return AWA.Questions.Models.Question_Bean (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Question_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "title" then
         From.Set_Title (Util.Beans.Objects.To_String (Value));

      elsif Name = "description" then
         From.Set_Description (Util.Beans.Objects.To_String (Value));

      elsif Name = "id" and not Util.Beans.Objects.Is_Empty (Value) then
            From.Service.Load_Question (From,
                                        ADO.Identifier (Util.Beans.Objects.To_Integer (Value)));
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create or save the question.
   --  ------------------------------
   procedure Save (Bean    : in out Question_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   begin
      Bean.Service.Save_Question (Bean);
   end Save;

   --  ------------------------------
   --  Delete the question.
   --  ------------------------------
   procedure Delete (Bean    : in out Question_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   begin
      Bean.Service.Delete_Question (Bean);
   end Delete;

   --  ------------------------------
   --  Create the Question_Bean bean instance.
   --  ------------------------------
   function Create_Question_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Question_Bean_Access := new Question_Bean;
   begin
      Object.Service := Module;
      return Object.all'Access;
   end Create_Question_Bean;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Answer_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "question_id" then
         return Util.Beans.Objects.To_Object (Long_Long_Integer (From.Question.Get_Id));
      elsif From.Is_Null then
         return Util.Beans.Objects.Null_Object;
      else
         return AWA.Questions.Models.Answer_Bean (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Answer_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "id" and not Util.Beans.Objects.Is_Null (Value) then
         From.Service.Load_Answer (From, From.Question,
                                   ADO.Identifier (Util.Beans.Objects.To_Integer (Value)));

      elsif Name = "answer" then
         From.Set_Answer (Util.Beans.Objects.To_String (Value));

      elsif Name = "question_id" and not Util.Beans.Objects.Is_Null (Value) then
         From.Service.Load_Question (From.Question,
                                     ADO.Identifier (Util.Beans.Objects.To_Integer (Value)));
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create or save the answer.
   --  ------------------------------
   procedure Save (Bean    : in out Answer_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   begin
      Bean.Service.Save_Answer (Question => Bean.Question,
                                Answer   => Bean);
   end Save;

   --  ------------------------------
   --  Delete the question.
   --  ------------------------------
   procedure Delete (Bean    : in out Answer_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   begin
      Bean.Service.Delete_Answer (Answer => Bean);
   end Delete;

   --  ------------------------------
   --  Create the answer bean instance.
   --  ------------------------------
   function Create_Answer_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Answer_Bean_Access := new Answer_Bean;
   begin
      Object.Service := Module;
      return Object.all'Access;
   end Create_Answer_Bean;

   --  ------------------------------
   --  Create the Question_Info_List_Bean bean instance.
   --  ------------------------------
   function Create_Question_List_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                       return Util.Beans.Basic.Readonly_Bean_Access is
      use AWA.Questions.Models;
      use AWA.Services;

      Object  : constant Question_Info_List_Bean_Access := new Question_Info_List_Bean;
      Session : ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;
   begin
      Query.Set_Query (AWA.Questions.Models.Query_Question_List);
      ADO.Sessions.Entities.Bind_Param (Params  => Query,
                                        Name    => "entity_type",
                                        Table   => AWA.Questions.Models.QUESTION_TABLE,
                                        Session => Session);
      AWA.Questions.Models.List (Object.all, Session, Query);
      return Object.all'Access;
   end Create_Question_List_Bean;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Question_Display_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "answers" then
         return Util.Beans.Objects.To_Object (Value   => From.Answer_List_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      elsif Name = "question" then
         return Util.Beans.Objects.To_Object (Value   => From.Question_Bean,
                                              Storage => Util.Beans.Objects.STATIC);

      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Question_Display_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "id" and not Util.Beans.Objects.Is_Empty (Value) then
         declare
            package ASC renames AWA.Services.Contexts;
            use AWA.Questions.Models;
            use AWA.Services;

            Session : ADO.Sessions.Session := From.Service.Get_Session;
            Query   : ADO.Queries.Context;
            List    : AWA.Questions.Models.Question_Display_Info_List_Bean;
            Ctx     : constant ASC.Service_Context_Access := ASC.Current;
         begin
            Query.Set_Query (AWA.Questions.Models.Query_Question_Info);
            Query.Bind_Param ("question_id", Util.Beans.Objects.To_Integer (Value));
            Query.Bind_Param ("user_id", Ctx.Get_User_Identifier);
            ADO.Sessions.Entities.Bind_Param (Params  => Query,
                                              Name    => "entity_type",
                                              Table   => AWA.Questions.Models.QUESTION_TABLE,
                                              Session => Session);
            AWA.Questions.Models.List (List, Session, Query);
            if not List.List.Is_Empty then
               From.Question := List.List.Element (0);
            end if;
            Query.Clear;
            Query.Bind_Param ("question_id", Util.Beans.Objects.To_Integer (Value));
            Query.Bind_Param ("user_id", Ctx.Get_User_Identifier);
            ADO.Sessions.Entities.Bind_Param (Params  => Query,
                                              Name    => "entity_type",
                                              Table   => AWA.Questions.Models.ANSWER_TABLE,
                                              Session => Session);

            Query.Set_Query (AWA.Questions.Models.Query_Answer_List);
            AWA.Questions.Models.List (From.Answer_List, Session, Query);
         end;
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create the Question_Display_Bean bean instance.
   --  ------------------------------
   function Create_Question_Display_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                       return Util.Beans.Basic.Readonly_Bean_Access is
      Object  : constant Question_Display_Bean_Access := new Question_Display_Bean;
   begin
      Object.Service          := Module;
      Object.Question_Bean    := Object.Question'Access;
      Object.Answer_List_Bean := Object.Answer_List'Access;
      return Object.all'Access;
   end Create_Question_Display_Bean;

end AWA.Questions.Beans;

Move the question services in the question module (simplify the implementation)


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

with Util.Test_Caller;
with Util.Beans.Basic;
with Util.Beans.Objects;

with ADO;
with ADO.Objects;

with Security.Contexts;

with AWA.Services.Contexts;
with AWA.Questions.Modules;
with AWA.Questions.Beans;
with AWA.Tests.Helpers.Users;
package body AWA.Questions.Services.Tests is

   use Util.Tests;
   use ADO;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Questions.Services.Save_Question",
                       Test_Create_Question'Access);
      Caller.Add_Test (Suite, "Test AWA.Questions.Queries question-list",
                       Test_List_Questions'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test creation of a question.
   --  ------------------------------
   procedure Test_Create_Question (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      Q         : AWA.Questions.Models.Question_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-storage@test.com");

      T.Manager := AWA.Questions.Modules.Get_Question_Manager;
      T.Assert (T.Manager /= null, "There is no question manager");

      Q.Set_Title ("How can I append strings in Ada?");
      Q.Set_Description ("I have two strings that I want to concatenate.  + does not work.");
      T.Manager.Save_Question (Q);
      T.Assert (Q.Is_Inserted, "The new question was not inserted");

      Q.Set_Description ("I have two strings that I want to concatenate.  + does not work. "
                        & "I also tried '.' without success.  What should I do?");
      T.Manager.Save_Question (Q);

      Q.Set_Description ("I have two strings that I want to concatenate.  + does not work. "
                         & "I also tried '.' without success.  What should I do? "
                         & "This is a stupid question for someone who reads this file. "
                         & "But I need some long text for the unit test.");
      T.Manager.Save_Question (Q);
   end Test_Create_Question;

   --  ------------------------------
   --  Test list of questions.
   --  ------------------------------
   procedure Test_List_Questions (T : in out Test) is
      use AWA.Questions.Models;
      use type Util.Beans.Basic.Readonly_Bean_Access;

      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      Q         : AWA.Questions.Models.Question_Ref;
      Module    : AWA.Questions.Modules.Question_Module_Access;
      List      : Util.Beans.Basic.Readonly_Bean_Access;
      Bean      : Util.Beans.Objects.Object;
      Count     : Natural;
   begin
      AWA.Tests.Helpers.Users.Anonymous (Context, Sec_Ctx);
      Module := AWA.Questions.Modules.Get_Question_Module;
      List := AWA.Questions.Beans.Create_Question_List_Bean (Module);
      T.Assert (List /= null, "The Create_Question_List_Bean returned null");

      Bean := Util.Beans.Objects.To_Object (List);
      T.Assert (not Util.Beans.Objects.Is_Null (Bean), "The list bean should not be null");
      Count := Questions.Models.Question_Info_List_Bean'Class (List.all).Get_Count;

      T.Assert (Count > 0, "The list of question is empty");
   end Test_List_Questions;

end AWA.Questions.Services.Tests;

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

with Util.Test_Caller;
with Util.Beans.Basic;
with Util.Beans.Objects;

with ADO;
with ADO.Objects;

with Security.Contexts;

with ASF.Contexts.Faces;
with ASF.Contexts.Faces.Mockup;

with AWA.Permissions;
with AWA.Services.Contexts;
with AWA.Questions.Modules;
with AWA.Questions.Beans;
with AWA.Votes.Beans;
with AWA.Tests.Helpers.Users;
package body AWA.Questions.Services.Tests is

   use Util.Tests;
   use ADO;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Questions.Services.Save_Question",
                       Test_Create_Question'Access);
      Caller.Add_Test (Suite, "Test AWA.Questions.Queries question-list",
                       Test_List_Questions'Access);
      Caller.Add_Test (Suite, "Test AWA.Questions.Beans questionVote bean",
                       Test_Question_Vote'Access);
      Caller.Add_Test (Suite, "Test AWA.Questions.Beans questionVote bean (anonymous user)",
                       Test_Question_Vote'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test creation of a question.
   --  ------------------------------
   procedure Test_Create_Question (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      Q         : AWA.Questions.Models.Question_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-storage@test.com");

      T.Manager := AWA.Questions.Modules.Get_Question_Manager;
      T.Assert (T.Manager /= null, "There is no question manager");

      Q.Set_Title ("How can I append strings in Ada?");
      Q.Set_Description ("I have two strings that I want to concatenate.  + does not work.");
      T.Manager.Save_Question (Q);
      T.Assert (Q.Is_Inserted, "The new question was not inserted");

      Q.Set_Description ("I have two strings that I want to concatenate.  + does not work. "
                        & "I also tried '.' without success.  What should I do?");
      T.Manager.Save_Question (Q);

      Q.Set_Description ("I have two strings that I want to concatenate.  + does not work. "
                         & "I also tried '.' without success.  What should I do? "
                         & "This is a stupid question for someone who reads this file. "
                         & "But I need some long text for the unit test.");
      T.Manager.Save_Question (Q);
   end Test_Create_Question;

   --  ------------------------------
   --  Test list of questions.
   --  ------------------------------
   procedure Test_List_Questions (T : in out Test) is
      use AWA.Questions.Models;
      use type Util.Beans.Basic.Readonly_Bean_Access;

      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      Module    : AWA.Questions.Modules.Question_Module_Access;
      List      : Util.Beans.Basic.Readonly_Bean_Access;
      Bean      : Util.Beans.Objects.Object;
      Count     : Natural;
   begin
      AWA.Tests.Helpers.Users.Anonymous (Context, Sec_Ctx);
      Module := AWA.Questions.Modules.Get_Question_Module;
      List := AWA.Questions.Beans.Create_Question_List_Bean (Module);
      T.Assert (List /= null, "The Create_Question_List_Bean returned null");

      Bean := Util.Beans.Objects.To_Object (List);
      T.Assert (not Util.Beans.Objects.Is_Null (Bean), "The list bean should not be null");
      Count := Questions.Models.Question_Info_List_Bean'Class (List.all).Get_Count;

      T.Assert (Count > 0, "The list of question is empty");
   end Test_List_Questions;

   --  ------------------------------
   --  Do a vote on a question through the question vote bean.
   --  ------------------------------
   procedure Do_Vote (T : in out Test) is
      use type Util.Beans.Basic.Readonly_Bean_Access;

      Context : ASF.Contexts.Faces.Mockup.Mockup_Faces_Context;
      Outcome : Ada.Strings.Unbounded.Unbounded_String;
      Bean    : Util.Beans.Basic.Readonly_Bean_Access;
      Vote    : AWA.Votes.Beans.Vote_Bean_Access;
   begin
      Bean := Context.Get_Bean ("questionVote");
      T.Assert (Bean /= null, "The questionVote bean was not created");

      T.Assert (Bean.all in AWA.Votes.Beans.Vote_Bean'Class,
                "The questionVote is not a Vote_Bean");

      Vote := AWA.Votes.Beans.Vote_Bean (Bean.all)'Access;
      Vote.Rating    := 1;
      Vote.Entity_Id := 1;
      Vote.Vote_Up (Outcome);
   end Do_Vote;

   --  ------------------------------
   --  Test anonymous user voting for a question.
   --  ------------------------------
   procedure Test_Question_Vote_Anonymous (T : in out Test) is
      Sec_Ctx : Security.Contexts.Security_Context;
      Context : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Anonymous (Context, Sec_Ctx);

      Do_Vote (T);
      T.Fail ("Anonymous users should not be allowed to vote");

   exception
      when AWA.Permissions.NO_PERMISSION =>
         null;
   end Test_Question_Vote_Anonymous;

   --  ------------------------------
   --  Test voting for a question.
   --  ------------------------------
   procedure Test_Question_Vote (T : in out Test) is
      Sec_Ctx : Security.Contexts.Security_Context;
      Context : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-voter@test.com");

      Do_Vote (T);
   end Test_Question_Vote;

end AWA.Questions.Services.Tests;

Add unit tests for the questionVote bean


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

with AWA.Modules.Beans;
with AWA.Modules.Get;
with AWA.Services.Contexts;

with ADO.Sessions;

with Util.Log.Loggers;
with Atlas.Microblog.Beans;
package body Atlas.Microblog.Modules is

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

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

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

      --  Register here any bean class, servlet, filter.
      Register.Register (Plugin => Plugin,
                         Name   => "Atlas.Microblog.Beans.Microblog_Bean",
                         Handler => Atlas.Microblog.Beans.Create_Microblog_Bean'Access);

      Register.Register (Plugin => Plugin,
                         Name   => "Atlas.Microblog.Beans.List_Bean",
                         Handler => Atlas.Microblog.Beans.Create_List_Bean'Access);

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

      --  Add here the creation of manager instances.
   end Initialize;

   --  ------------------------------
   --  Get the microblog module.
   --  ------------------------------
   function Get_Microblog_Module return Microblog_Module_Access is
      function Get is new AWA.Modules.Get (Microblog_Module, Microblog_Module_Access, NAME);
   begin
      return Get;
   end Get_Microblog_Module;

   --  ------------------------------
   --  Create a post for the microblog.
   --  ------------------------------
   procedure Create (Plugin : in Microblog_Module;
                     Post   : in out Atlas.Microblog.Models.Mblog_Ref) is
      pragma Unreferenced (Plugin);
      use AWA.Services;

      Ctx   : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;
      Post.Set_Create_Date (Ada.Calendar.Clock);
      Post.Set_Author (Ctx.Get_User);
      Post.Save (DB);
      Ctx.Commit;
   end Create;

end Atlas.Microblog.Modules;

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

with AWA.Modules.Beans;
with AWA.Modules.Get;
with AWA.Services.Contexts;

with ADO.Sessions;

with Util.Log.Loggers;
with Atlas.Microblog.Beans;
package body Atlas.Microblog.Modules is

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

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

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

      --  Register here any bean class, servlet, filter.
      Register.Register (Plugin => Plugin,
                         Name   => "Atlas.Microblog.Beans.Microblog_Bean",
                         Handler => Atlas.Microblog.Beans.Create_Microblog_Bean'Access);

      Register.Register (Plugin => Plugin,
                         Name   => "Atlas.Microblog.Beans.List_Bean",
                         Handler => Atlas.Microblog.Beans.Create_List_Bean'Access);

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

      --  Add here the creation of manager instances.
   end Initialize;

   --  ------------------------------
   --  Get the microblog module.
   --  ------------------------------
   function Get_Microblog_Module return Microblog_Module_Access is
      function Get is new AWA.Modules.Get (Microblog_Module, Microblog_Module_Access, NAME);
   begin
      return Get;
   end Get_Microblog_Module;

   --  ------------------------------
   --  Create a post for the microblog.
   --  ------------------------------
   procedure Create (Plugin : in Microblog_Module;
                     Post   : in out Atlas.Microblog.Models.Mblog_Ref) is
      pragma Unreferenced (Plugin);
      use AWA.Services;

      Ctx   : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;
      Post.Set_Creation_Date (Ada.Calendar.Clock);
      Post.Set_Author (Ctx.Get_User);
      Post.Save (DB);
      Ctx.Commit;
   end Create;

end Atlas.Microblog.Modules;

Rename Set_Create_Date into Set_Creation_Date


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

--  == OAuth ==
--  The Security.OAuth package defines and implements the OAuth 2.0 authorization
--  framework as defined by the IETF working group.
--  See http://tools.ietf.org/html/draft-ietf-oauth-v2-26
package Security.OAuth is

   --  OAuth 2.0: Section 10.2.2. Initial Registry Contents
   --  RFC 6749: 11.2.2.  Initial Registry Contents
   CLIENT_ID         : constant String := "client_id";
   CLIENT_SECRET     : constant String := "client_secret";
   RESPONSE_TYPE     : constant String := "response_type";
   REDIRECT_URI      : constant String := "redirect_uri";
   SCOPE             : constant String := "scope";
   STATE             : constant String := "state";
   CODE              : constant String := "code";
   ERROR_DESCRIPTION : constant String := "error_description";
   ERROR_URI         : constant String := "error_uri";
   GRANT_TYPE        : constant String := "grant_type";
   ACCESS_TOKEN      : constant String := "access_token";
   TOKEN_TYPE        : constant String := "token_type";
   EXPIRES_IN        : constant String := "expires_in";
   USERNAME          : constant String := "username";
   PASSWORD          : constant String := "password";
   REFRESH_TOKEN     : constant String := "refresh_token";

   --  RFC 6749: 5.2.  Error Response
   INVALID_REQUEST        : aliased constant String := "invalid_request";
   INVALID_CLIENT         : aliased constant String := "invalid_client";
   INVALID_GRANT          : aliased constant String := "invalid_grant";
   UNAUTHORIZED_CLIENT    : aliased constant String := "unauthorized_client";
   UNSUPPORTED_GRANT_TYPE : aliased constant String := "unsupported_grant_type";
   INVALID_SCOPE          : aliased constant String := "invalid_scope";

   --  RFC 6749: 4.1.2.1.  Error Response
   ACCESS_DENIED             : aliased constant String := "access_denied";
   UNSUPPORTED_RESPONSE_TYPE : aliased constant String := "unsupported_response_type";
   SERVER_ERROR              : aliased constant String := "server_error";
   TEMPORARILY_UNAVAILABLE   : aliased constant String := "temporarily_unavailable";

   --  ------------------------------
   --  Application
   --  ------------------------------
   --  The Application holds the necessary information to let a user
   --  grant access to its protected resources on the resource server.  It contains
   --  information that allows the OAuth authorization server to identify the
   --  application (client id and secret key).
   type Application is tagged private;

   --  Get the application identifier.
   function Get_Application_Identifier (App : in Application) return String;

   --  Set the application identifier used by the OAuth authorization server
   --  to identify the application (for example, the App ID in Facebook).
   procedure Set_Application_Identifier (App    : in out Application;
                                         Client : in String);

   --  Set the application secret defined in the OAuth authorization server
   --  for the application (for example, the App Secret in Facebook).
   procedure Set_Application_Secret (App    : in out Application;
                                     Secret : in String);

   --  Set the redirection callback that will be used to redirect the user
   --  back to the application after the OAuth authorization is finished.
   procedure Set_Application_Callback (App : in out Application;
                                       URI : in String);

private

   type Application is tagged record
      Client_Id   : Ada.Strings.Unbounded.Unbounded_String;
      Secret      : Ada.Strings.Unbounded.Unbounded_String;
      Callback    : Ada.Strings.Unbounded.Unbounded_String;
   end record;

end Security.OAuth;

-----------------------------------------------------------------------
--  security-oauth -- OAuth Security
--  Copyright (C) 2012, 2016, 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.Strings.Unbounded;

--  == OAuth ==
--  The Security.OAuth package defines and implements the OAuth 2.0 authorization
--  framework as defined by the IETF working group.
--  See http://tools.ietf.org/html/draft-ietf-oauth-v2-26
package Security.OAuth is

   --  OAuth 2.0: Section 10.2.2. Initial Registry Contents
   --  RFC 6749: 11.2.2.  Initial Registry Contents
   CLIENT_ID         : constant String := "client_id";
   CLIENT_SECRET     : constant String := "client_secret";
   RESPONSE_TYPE     : constant String := "response_type";
   REDIRECT_URI      : constant String := "redirect_uri";
   SCOPE             : constant String := "scope";
   STATE             : constant String := "state";
   CODE              : constant String := "code";
   ERROR_DESCRIPTION : constant String := "error_description";
   ERROR_URI         : constant String := "error_uri";
   GRANT_TYPE        : constant String := "grant_type";
   ACCESS_TOKEN      : constant String := "access_token";
   TOKEN_TYPE        : constant String := "token_type";
   EXPIRES_IN        : constant String := "expires_in";
   USERNAME          : constant String := "username";
   PASSWORD          : constant String := "password";
   REFRESH_TOKEN     : constant String := "refresh_token";

   --  RFC 6749: 5.2.  Error Response
   INVALID_REQUEST        : aliased constant String := "invalid_request";
   INVALID_CLIENT         : aliased constant String := "invalid_client";
   INVALID_GRANT          : aliased constant String := "invalid_grant";
   UNAUTHORIZED_CLIENT    : aliased constant String := "unauthorized_client";
   UNSUPPORTED_GRANT_TYPE : aliased constant String := "unsupported_grant_type";
   INVALID_SCOPE          : aliased constant String := "invalid_scope";

   --  RFC 6749: 4.1.2.1.  Error Response
   ACCESS_DENIED             : aliased constant String := "access_denied";
   UNSUPPORTED_RESPONSE_TYPE : aliased constant String := "unsupported_response_type";
   SERVER_ERROR              : aliased constant String := "server_error";
   TEMPORARILY_UNAVAILABLE   : aliased constant String := "temporarily_unavailable";

   type Client_Authentication_Type is (AUTH_NONE, AUTH_BASIC);

   --  ------------------------------
   --  Application
   --  ------------------------------
   --  The Application holds the necessary information to let a user
   --  grant access to its protected resources on the resource server.  It contains
   --  information that allows the OAuth authorization server to identify the
   --  application (client id and secret key).
   type Application is tagged private;

   --  Get the application identifier.
   function Get_Application_Identifier (App : in Application) return String;

   --  Set the application identifier used by the OAuth authorization server
   --  to identify the application (for example, the App ID in Facebook).
   procedure Set_Application_Identifier (App    : in out Application;
                                         Client : in String);

   --  Set the application secret defined in the OAuth authorization server
   --  for the application (for example, the App Secret in Facebook).
   procedure Set_Application_Secret (App    : in out Application;
                                     Secret : in String);

   --  Set the redirection callback that will be used to redirect the user
   --  back to the application after the OAuth authorization is finished.
   procedure Set_Application_Callback (App : in out Application;
                                       URI : in String);

   --  Set the client authentication method used when doing OAuth calls for this application.
   --  See RFC 6749, 2.3.  Client Authentication
   procedure Set_Client_Authentication (App    : in out Application;
                                        Method : in Client_Authentication_Type);

private

   type Application is tagged record
      Client_Id   : Ada.Strings.Unbounded.Unbounded_String;
      Secret      : Ada.Strings.Unbounded.Unbounded_String;
      Callback    : Ada.Strings.Unbounded.Unbounded_String;
      Client_Auth : Client_Authentication_Type := AUTH_NONE;
   end record;

end Security.OAuth;

Declare Set_Client_Authentication procedure Declare Client_Authentication_Type type


with Ada.Strings.Wide_Unbounded;

package Symbex.Lex is

  type Lexer_t is private;

  --
  -- Token type.
  --

  type Token_Kind_t is
    (Token_Quoted_String,
     Token_Symbol,
     Token_List_Open,
     Token_List_Close,
     Token_EOF);

  type Line_Number_t is new Positive;

  type Token_t is record
    Is_Valid    : Boolean;
    Line_Number : Line_Number_t;
    Kind        : Token_Kind_t;
    Text        : Ada.Strings.Wide_Unbounded.Unbounded_Wide_String;
  end record;

  --
  -- Token value for incomplete or invalid tokens.
  --

  Invalid_Token : constant Token_t;

  --
  -- Lexer status value.
  --

  type Lexer_Status_t is
    (Lexer_OK,
     Lexer_Needs_More_Data,
     Lexer_Error_Line_Overflow,
     Lexer_Error_Out_Of_Memory,
     Lexer_Error_Stream_Error,
     Lexer_Error_Early_EOF);

  --
  -- Status values corresponding to error conditions.
  --

  subtype Lexer_Error_Status_t is Lexer_Status_t
    range Lexer_Error_Line_Overflow .. Lexer_Status_t'Last;

  --
  -- Lexer is initialized?
  --

  function Initialized
    (Lexer  : in     Lexer_t) return Boolean;

  --
  -- Initialize lexer state.
  --

  procedure Initialize_Lexer
    (Lexer  :    out Lexer_t;
     Status :    out Lexer_Status_t);
--  pragma Postcondition
--    (((Status  = Lexer_OK) and     Initialized (Lexer)) or
--     ((Status /= Lexer_OK) and not Initialized (Lexer)));

  --
  -- Return token from Read_Item 'stream'.
  --

  type Stream_Status_t is
    (Stream_OK,
     Stream_EOF,
     Stream_Error);

  generic
    with procedure Read_Item
      (Item   :     out Wide_Character;
       Status :     out Stream_Status_t);

  procedure Get_Token
    (Lexer     : in out Lexer_t;
     Token     :    out Token_t;
     Status    :    out Lexer_Status_t);
--  pragma Precondition (Initialized (Lexer));
--  pragma Postcondition
--    (((Status  = Lexer_OK) and (Token /= Invalid_Token)) or
--     ((Status /= Lexer_OK) and (Token  = Invalid_Token)));

private
  package UBW_Strings renames Ada.Strings.Wide_Unbounded;

  --
  -- Lexer state machine.
  --

  type State_Stage_t is
    (Inside_String,
     Inside_Escape,
     Inside_Comment);

  type State_t                 is array (State_Stage_t) of Boolean;
  type Input_Buffer_Position_t is (Current, Next);
  type Input_Buffer_t          is array (Input_Buffer_Position_t) of Wide_Character;
  subtype Token_Buffer_t       is UBW_Strings.Unbounded_Wide_String;

  type Lexer_t is record
    Inited       : Boolean;
    Current_Line : Line_Number_t;
    Token_Buffer : Token_Buffer_t;
    Input_Buffer : Input_Buffer_t;
    State        : State_t;
  end record;

  --
  -- Token deferred.
  --

  Invalid_Token : constant Token_t :=
    Token_t'(Is_Valid    => False,
             Line_Number => Line_Number_t'First,
             Text        => UBW_Strings.Null_Unbounded_Wide_String,
             Kind        => Token_Kind_t'First);

  --
  -- Character class.
  --

  type Character_Class_t is
    (Comment_Delimiter,
     Escape_Character,
     Line_Break,
     List_Close_Delimiter,
     List_Open_Delimiter,
     Ordinary_Text,
     String_Delimiter,
     Whitespace);

  --
  -- Utility subprograms.
  --

  procedure Set_State
    (Lexer : in out Lexer_t;
     State : in     State_Stage_t);
  pragma Precondition (not Lexer.State (State));
  pragma Postcondition (Lexer.State (State));

  procedure Unset_State
    (Lexer : in out Lexer_t;
     State : in     State_Stage_t);
  pragma Precondition (Lexer.State (State));
  pragma Postcondition (not Lexer.State (State));

  function State_Is_Set
    (Lexer : in     Lexer_t;
     State : in     State_Stage_t) return Boolean;

  function Token_Is_Nonzero_Length
    (Lexer : in Lexer_t) return Boolean;

  procedure Complete_Token
    (Lexer : in out Lexer_t;
     Kind  : in     Token_Kind_t;
     Token :    out Token_t);
  pragma Precondition (Token_Is_Nonzero_Length (Lexer));
--  pragma Postcondition
--    ((Token /= Invalid_Token) and (not Token_Is_Nonzero_Length (Lexer)));

end Symbex.Lex;

with Ada.Strings.Wide_Unbounded;

package Symbex.Lex is

  type Lexer_t is private;

  --
  -- Token type.
  --

  type Token_Kind_t is
    (Token_Quoted_String,
     Token_Symbol,
     Token_List_Open,
     Token_List_Close,
     Token_EOF);

  type Line_Number_t is new Positive;

  type Token_t is record
    Is_Valid    : Boolean;
    Line_Number : Line_Number_t;
    Kind        : Token_Kind_t;
    Text        : Ada.Strings.Wide_Unbounded.Unbounded_Wide_String;
  end record;

  --
  -- Token value for incomplete or invalid tokens.
  --

  Invalid_Token : constant Token_t;

  --
  -- Lexer status value.
  --

  type Lexer_Status_t is
    (Lexer_OK,
     Lexer_Needs_More_Data,
     Lexer_Error_Line_Overflow,
     Lexer_Error_Out_Of_Memory,
     Lexer_Error_Stream_Error,
     Lexer_Error_Early_EOF);

  --
  -- Status values corresponding to error conditions.
  --

  subtype Lexer_Error_Status_t is Lexer_Status_t
    range Lexer_Error_Line_Overflow .. Lexer_Status_t'Last;

  --
  -- Lexer is initialized?
  --

  function Initialized
    (Lexer  : in     Lexer_t) return Boolean;

  --
  -- Initialize lexer state.
  --

  procedure Initialize_Lexer
    (Lexer  :    out Lexer_t;
     Status :    out Lexer_Status_t);
--  pragma Postcondition
--    (((Status  = Lexer_OK) and     Initialized (Lexer)) or
--     ((Status /= Lexer_OK) and not Initialized (Lexer)));

  --
  -- Return token from Read_Item 'stream'.
  --

  type Stream_Status_t is
    (Stream_OK,
     Stream_EOF,
     Stream_Error);

  generic
    with procedure Read_Item
      (Item   :     out Wide_Character;
       Status :     out Stream_Status_t);

  procedure Get_Token
    (Lexer     : in out Lexer_t;
     Token     :    out Token_t;
     Status    :    out Lexer_Status_t);
--  pragma Precondition (Initialized (Lexer));
--  pragma Postcondition
--    (((Status  = Lexer_OK) and (Token /= Invalid_Token)) or
--     ((Status /= Lexer_OK) and (Token  = Invalid_Token)));

private
  package UBW_Strings renames Ada.Strings.Wide_Unbounded;

  --
  -- Lexer state machine.
  --

  type State_Stage_t is
    (Inside_String,
     Inside_Escape,
     Inside_Comment);

  type State_t                 is array (State_Stage_t) of Boolean;
  type Input_Buffer_Position_t is (Current, Next);
  type Input_Buffer_t          is array (Input_Buffer_Position_t) of Wide_Character;
  subtype Token_Buffer_t       is UBW_Strings.Unbounded_Wide_String;

  type Lexer_t is record
    Inited       : Boolean;
    Current_Line : Line_Number_t;
    Token_Buffer : Token_Buffer_t;
    Input_Buffer : Input_Buffer_t;
    State        : State_t;
  end record;

  --
  -- Token deferred.
  --

  Invalid_Token : constant Token_t :=
    Token_t'(Is_Valid    => False,
             Line_Number => Line_Number_t'First,
             Text        => <>,
             Kind        => Token_Kind_t'First);

  --
  -- Character class.
  --

  type Character_Class_t is
    (Comment_Delimiter,
     Escape_Character,
     Line_Break,
     List_Close_Delimiter,
     List_Open_Delimiter,
     Ordinary_Text,
     String_Delimiter,
     Whitespace);

  --
  -- Utility subprograms.
  --

  procedure Set_State
    (Lexer : in out Lexer_t;
     State : in     State_Stage_t);
  pragma Precondition (not Lexer.State (State));
  pragma Postcondition (Lexer.State (State));

  procedure Unset_State
    (Lexer : in out Lexer_t;
     State : in     State_Stage_t);
  pragma Precondition (Lexer.State (State));
  pragma Postcondition (not Lexer.State (State));

  function State_Is_Set
    (Lexer : in     Lexer_t;
     State : in     State_Stage_t) return Boolean;

  function Token_Is_Nonzero_Length
    (Lexer : in Lexer_t) return Boolean;

  procedure Complete_Token
    (Lexer : in out Lexer_t;
     Kind  : in     Token_Kind_t;
     Token :    out Token_t);
  pragma Precondition (Token_Is_Nonzero_Length (Lexer));
--  pragma Postcondition
--    ((Token /= Invalid_Token) and (not Token_Is_Nonzero_Length (Lexer)));

end Symbex.Lex;

Use <> for init.

Use <> for init.


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

with Util.Beans.Objects;

with ADO.Configs;
with ADO.Objects;
with ADO.Schemas;
with ADO.Sessions;
package ADO.Audits is

   subtype Object_Key_Type is ADO.Objects.Object_Key_Type;
   subtype Auditable_Class_Mapping is ADO.Schemas.Auditable_Class_Mapping;
   subtype Auditable_Class_Mapping_Access is ADO.Schemas.Auditable_Class_Mapping_Access;
   subtype Class_Mapping_Access is ADO.Schemas.Class_Mapping_Access;

   package UBO renames Util.Beans.Objects;

   --  The `Audit_Info` describes a column field that is modified.
   type Audit_Info is limited record
      Field     : ADO.Schemas.Column_Index := 0;
      Old_Value : UBO.Object;
      New_Value : UBO.Object;
   end record;

   type Audit_Index is new Positive range 1 .. ADO.Configs.MAX_COLUMNS;

   type Audit_Array is array (Audit_Index range <>) of Audit_Info;

   --  The `Auditable_Object_Record` is the root type of any auditable database record.
   --  It inherit from the `Object_Record` and adds auditing support by defining the
   --  database column fields which can be audited.  When a field is modified, it holds
   --  the audit information that tracks the old and new values.
   type Auditable_Object_Record (Key_Type   : Object_Key_Type;
                                 Of_Class   : Class_Mapping_Access;
                                 With_Audit : Auditable_Class_Mapping_Access) is abstract
       new ADO.Objects.Object_Record with private;

   --  Release the object.
   overriding
   procedure Finalize (Object : in out Auditable_Object_Record);

   --  Record an audit information for a field.
   procedure Audit_Field (Object    : in out Auditable_Object_Record;
                          Field     : in ADO.Schemas.Column_Index;
                          Old_Value : in UBO.Object;
                          New_Value : in UBO.Object);

   --  The `Audit_Manager` is the interface of the audit manager component that is responsible
   --  for saving the audit information in the database.
   type Audit_Manager is limited interface;

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

   procedure Save (Session : in out ADO.Sessions.Master_Session'Class;
                   Object  : in out Auditable_Object_Record'Class);

private

   type Audit_Array_Access is access all Audit_Array;

   type Auditable_Object_Record (Key_Type   : Object_Key_Type;
                                 Of_Class   : Class_Mapping_Access;
                                 With_Audit : Auditable_Class_Mapping_Access) is abstract
   new ADO.Objects.Object_Record (Key_Type => Key_Type, Of_Class => Of_Class) with record
      Audits : Audit_Array_Access;
   end record;

end ADO.Audits;

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

with Util.Beans.Objects;

with ADO.Configs;
with ADO.Objects;
with ADO.Schemas;
with ADO.Sessions;
package ADO.Audits is

   subtype Object_Key_Type is ADO.Objects.Object_Key_Type;
   subtype Auditable_Class_Mapping is ADO.Schemas.Auditable_Class_Mapping;
   subtype Auditable_Class_Mapping_Access is ADO.Schemas.Auditable_Class_Mapping_Access;
   subtype Class_Mapping_Access is ADO.Schemas.Class_Mapping_Access;

   package UBO renames Util.Beans.Objects;

   --  The `Audit_Info` describes a column field that is modified.
   type Audit_Info is limited record
      Field     : ADO.Schemas.Column_Index := 0;
      Old_Value : UBO.Object;
      New_Value : UBO.Object;
   end record;

   type Audit_Index is new Positive range 1 .. ADO.Configs.MAX_COLUMNS;

   type Audit_Array is array (Audit_Index range <>) of Audit_Info;

   --  The `Auditable_Object_Record` is the root type of any auditable database record.
   --  It inherit from the `Object_Record` and adds auditing support by defining the
   --  database column fields which can be audited.  When a field is modified, it holds
   --  the audit information that tracks the old and new values.
   type Auditable_Object_Record (Key_Type   : Object_Key_Type;
                                 Of_Class   : Class_Mapping_Access;
                                 With_Audit : Auditable_Class_Mapping_Access) is abstract
       new ADO.Objects.Object_Record with private;

   --  Release the object.
   overriding
   procedure Finalize (Object : in out Auditable_Object_Record);

   --  Record an audit information for a field.
   procedure Audit_Field (Object    : in out Auditable_Object_Record;
                          Field     : in ADO.Schemas.Column_Index;
                          Old_Value : in UBO.Object;
                          New_Value : in UBO.Object);

   --  The `Audit_Manager` is the interface of the audit manager component that is responsible
   --  for saving the audit information in the database.
   type Audit_Manager is limited interface;
   type Audit_Manager_Access is access all Audit_Manager'Class;

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

   procedure Save (Session : in out ADO.Sessions.Master_Session'Class;
                   Object  : in out Auditable_Object_Record'Class);

private

   type Audit_Array_Access is access all Audit_Array;

   type Auditable_Object_Record (Key_Type   : Object_Key_Type;
                                 Of_Class   : Class_Mapping_Access;
                                 With_Audit : Auditable_Class_Mapping_Access) is abstract
   new ADO.Objects.Object_Record (Key_Type => Key_Type, Of_Class => Of_Class) with record
      Audits : Audit_Array_Access;
   end record;

end ADO.Audits;

Declare Audit_Manager_Access access type


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

   type Auth_Manager is new Security.OAuth.Servers.Auth_Manager with private;
   type Auth_Manager_Access is access all Auth_Manager'Class;

private

   type Auth_Manager is new Security.OAuth.Servers.Auth_Manager with record
     N : Natural;
   end record;

end AWA.OAuth.Services;

Fix compilation warning

Fix compilation warning