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

with EL.Objects;

with ASF.Components.Core;
with ASF.Utils;
package body ASF.Components.Html.Text is

   use EL.Objects;

   TEXT_ATTRIBUTE_NAMES  : Util.Strings.String_Set.Set;

   LABEL_ATTRIBUTE_NAMES : Util.Strings.String_Set.Set;

   --  ------------------------------
   --  Get the local value of the component without evaluating
   --  the associated Value_Expression.
   --  ------------------------------
   overriding
   function Get_Local_Value (UI : in UIOutput) return EL.Objects.Object is
   begin
      return UI.Value;
   end Get_Local_Value;

   --  ------------------------------
   --  Get the value to write on the output.
   --  ------------------------------
   overriding
   function Get_Value (UI    : in UIOutput) return EL.Objects.Object is
   begin
      if not EL.Objects.Is_Null (UI.Value) then
         return UI.Value;
      else
         return UI.Get_Attribute (UI.Get_Context.all, "value");
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value to write on the output.
   --  ------------------------------
   overriding
   procedure Set_Value (UI    : in out UIOutput;
                        Value : in EL.Objects.Object) is
   begin
      UI.Value := Value;
   end Set_Value;

   --  ------------------------------
   --  Get the converter that is registered on the component.
   --  ------------------------------
   overriding
   function Get_Converter (UI : in UIOutput)
                           return ASF.Converters.Converter_Access is
   begin
      return UI.Converter;
   end Get_Converter;

   --  ------------------------------
   --  Set the converter to be used on the component.
   --  ------------------------------
   overriding
   procedure Set_Converter (UI        : in out UIOutput;
                            Converter : in ASF.Converters.Converter_Access) is
      use type ASF.Converters.Converter_Access;
   begin
      if Converter = null then
         UI.Converter := null;
      else
         UI.Converter := Converter.all'Unchecked_Access;
      end if;
   end Set_Converter;

   --  ------------------------------
   --  Get the value of the component and apply the converter on it if there is one.
   --  ------------------------------
   function Get_Formatted_Value (UI      : in UIOutput;
                                 Context : in Faces_Context'Class) return String is
      Value : constant EL.Objects.Object := UIOutput'Class (UI).Get_Value;
   begin
      return UIOutput'Class (UI).Get_Formatted_Value (Value, Context);
   end Get_Formatted_Value;

   --  ------------------------------
   --  Format the value by appling the To_String converter on it if there is one.
   --  ------------------------------
   function Get_Formatted_Value (UI      : in UIOutput;
                                 Value   : in Util.Beans.Objects.Object;
                                 Context : in Contexts.Faces.Faces_Context'Class) return String is
      use type ASF.Converters.Converter_Access;
   begin
      if UI.Converter /= null then
         return UI.Converter.To_String (Context   => Context,
                                        Component => UI,
                                        Value     => Value);
      else
         declare
            Converter : constant access ASF.Converters.Converter'Class
              := UI.Get_Converter (Context);
         begin
            if Converter /= null then
               return Converter.To_String (Context   => Context,
                                           Component => UI,
                                           Value     => Value);
            elsif not Is_Null (Value) then
               return EL.Objects.To_String (Value);

            else
               return "";
            end if;
         end;
      end if;

      --  If the converter raises an exception, report an error in the logs.
      --  At this stage, we know the value and we can report it in this log message.
      --  We must queue the exception in the context, so this is done later.
   exception
      when E : others =>
         UI.Log_Error ("Error when converting value '{0}': {1}: {2}",
                       Util.Beans.Objects.To_String (Value),
                       Ada.Exceptions.Exception_Name (E),
                       Ada.Exceptions.Exception_Message (E));
         raise;
   end Get_Formatted_Value;

   procedure Write_Output (UI      : in UIOutput;
                           Context : in out Faces_Context'Class;
                           Value   : in String) is
      Writer : constant Response_Writer_Access := Context.Get_Response_Writer;
      Escape : constant Object := UI.Get_Attribute (Context, "escape");
   begin
      Writer.Start_Optional_Element ("span");
      UI.Render_Attributes (Context, TEXT_ATTRIBUTE_NAMES, Writer);
      if Is_Null (Escape) or To_Boolean (Escape) then
         Writer.Write_Text (Value);
      else
         Writer.Write_Raw (Value);
      end if;
      Writer.End_Optional_Element ("span");
   end Write_Output;

   procedure Encode_Begin (UI      : in UIOutput;
                           Context : in out Faces_Context'Class) is
   begin
      if UI.Is_Rendered (Context) then
         UI.Write_Output (Context => Context,
                          Value   => UIOutput'Class (UI).Get_Formatted_Value (Context));

      end if;

      --  Queue any block converter exception that could be raised.
   exception
      when E : others =>
         Context.Queue_Exception (E);
   end Encode_Begin;

   --  ------------------------------
   --  Label Component
   --  ------------------------------

   procedure Encode_Begin (UI      : in UIOutputLabel;
                           Context : in out Faces_Context'Class) is
      Writer : Response_Writer_Access;
   begin
      if UI.Is_Rendered (Context) then
         Writer := Context.Get_Response_Writer;
         Writer.Start_Element ("label");
         UI.Render_Attributes (Context, LABEL_ATTRIBUTE_NAMES, Writer);
         declare
            Value : Util.Beans.Objects.Object := UI.Get_Attribute (Name    => "for",
                                                                   Context => Context);
         begin
            if not Util.Beans.Objects.Is_Null (Value) then
               Writer.Write_Attribute ("for", Value);
            end if;

            Value := UIOutputLabel'Class (UI).Get_Value;
            if not Util.Beans.Objects.Is_Null (Value) then
               declare
                  S : constant String
                    := UIOutputLabel'Class (UI).Get_Formatted_Value (Value, Context);
               begin
                  if UI.Get_Attribute (Name => "escape", Context => Context, Default => True) then
                     Writer.Write_Text (S);
                  else
                     Writer.Write_Raw (S);
                  end if;
               end;
            end if;

            --  Queue and block any converter exception that could be raised.
         exception
            when E : others =>
               Context.Queue_Exception (E);
         end;
      end if;
   end Encode_Begin;

   procedure Encode_End (UI      : in UIOutputLabel;
                         Context : in out Faces_Context'Class) is
      Writer : Response_Writer_Access;
   begin
      if UI.Is_Rendered (Context) then
         Writer := Context.Get_Response_Writer;
         Writer.End_Element ("label");
      end if;
   end Encode_End;

   --  ------------------------------
   --  OutputFormat Component
   --  ------------------------------
   procedure Encode_Begin (UI      : in UIOutputFormat;
                           Context : in out Faces_Context'Class) is
      use ASF.Components.Core;
      use ASF.Utils;
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;

      declare
         Params : constant UIParameter_Access_Array := Get_Parameters (UI);
         Values : Object_Array (Params'Range);
         Result : Ada.Strings.Unbounded.Unbounded_String;
         Fmt    : constant String := EL.Objects.To_String (UI.Get_Value);
      begin
         --  Get the values associated with the parameters.
         for I in Params'Range loop
            Values (I) := Params (I).Get_Value (Context);
         end loop;
         Formats.Format (Fmt, Values, Result);
         UI.Write_Output (Context => Context,
                          Value   => To_String (Result));
      end;
   end Encode_Begin;

begin
   Utils.Set_Text_Attributes (TEXT_ATTRIBUTE_NAMES);
   Utils.Set_Text_Attributes (LABEL_ATTRIBUTE_NAMES);
   Utils.Set_Interactive_Attributes (LABEL_ATTRIBUTE_NAMES);
end ASF.Components.Html.Text;

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

with EL.Objects;

with ASF.Components.Core;
with ASF.Utils;
package body ASF.Components.Html.Text is

   use EL.Objects;

   TEXT_ATTRIBUTE_NAMES  : Util.Strings.String_Set.Set;

   LABEL_ATTRIBUTE_NAMES : Util.Strings.String_Set.Set;

   --  ------------------------------
   --  Get the local value of the component without evaluating
   --  the associated Value_Expression.
   --  ------------------------------
   overriding
   function Get_Local_Value (UI : in UIOutput) return EL.Objects.Object is
   begin
      return UI.Value;
   end Get_Local_Value;

   --  ------------------------------
   --  Get the value to write on the output.
   --  ------------------------------
   overriding
   function Get_Value (UI    : in UIOutput) return EL.Objects.Object is
   begin
      if not EL.Objects.Is_Null (UI.Value) then
         return UI.Value;
      else
         return UI.Get_Attribute (UI.Get_Context.all, "value");
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value to write on the output.
   --  ------------------------------
   overriding
   procedure Set_Value (UI    : in out UIOutput;
                        Value : in EL.Objects.Object) is
   begin
      UI.Value := Value;
   end Set_Value;

   --  ------------------------------
   --  Get the converter that is registered on the component.
   --  ------------------------------
   overriding
   function Get_Converter (UI : in UIOutput)
                           return ASF.Converters.Converter_Access is
   begin
      return UI.Converter;
   end Get_Converter;

   --  ------------------------------
   --  Set the converter to be used on the component.
   --  ------------------------------
   overriding
   procedure Set_Converter (UI        : in out UIOutput;
                            Converter : in ASF.Converters.Converter_Access) is
      use type ASF.Converters.Converter_Access;
   begin
      if Converter = null then
         UI.Converter := null;
      else
         UI.Converter := Converter.all'Unchecked_Access;
      end if;
   end Set_Converter;

   --  ------------------------------
   --  Get the value of the component and apply the converter on it if there is one.
   --  ------------------------------
   function Get_Formatted_Value (UI      : in UIOutput;
                                 Context : in Faces_Context'Class) return String is
      Value : constant EL.Objects.Object := UIOutput'Class (UI).Get_Value;
   begin
      return UIOutput'Class (UI).Get_Formatted_Value (Value, Context);
   end Get_Formatted_Value;

   --  ------------------------------
   --  Format the value by appling the To_String converter on it if there is one.
   --  ------------------------------
   function Get_Formatted_Value (UI      : in UIOutput;
                                 Value   : in Util.Beans.Objects.Object;
                                 Context : in Contexts.Faces.Faces_Context'Class) return String is
      use type ASF.Converters.Converter_Access;
   begin
      if UI.Converter /= null then
         return UI.Converter.To_String (Context   => Context,
                                        Component => UI,
                                        Value     => Value);
      else
         declare
            Converter : constant access ASF.Converters.Converter'Class
              := UI.Get_Converter (Context);
         begin
            if Converter /= null then
               return Converter.To_String (Context   => Context,
                                           Component => UI,
                                           Value     => Value);
            elsif not Is_Null (Value) then
               return EL.Objects.To_String (Value);

            else
               return "";
            end if;
         end;
      end if;

      --  If the converter raises an exception, report an error in the logs.
      --  At this stage, we know the value and we can report it in this log message.
      --  We must queue the exception in the context, so this is done later.
   exception
      when E : others =>
         UI.Log_Error ("Error when converting value '{0}': {1}: {2}",
                       Util.Beans.Objects.To_String (Value),
                       Ada.Exceptions.Exception_Name (E),
                       Ada.Exceptions.Exception_Message (E));
         raise;
   end Get_Formatted_Value;

   procedure Write_Output (UI      : in UIOutput;
                           Context : in out Faces_Context'Class;
                           Value   : in String) is
      Writer : constant Response_Writer_Access := Context.Get_Response_Writer;
      Escape : constant Object := UI.Get_Attribute (Context, "escape");
   begin
      Writer.Start_Optional_Element ("span");
      UI.Render_Attributes (Context, TEXT_ATTRIBUTE_NAMES, Writer);
      if Is_Null (Escape) or To_Boolean (Escape) then
         Writer.Write_Text (Value);
      else
         Writer.Write_Raw (Value);
      end if;
      Writer.End_Optional_Element ("span");
   end Write_Output;

   procedure Encode_Begin (UI      : in UIOutput;
                           Context : in out Faces_Context'Class) is
   begin
      if UI.Is_Rendered (Context) then
         UI.Write_Output (Context => Context,
                          Value   => UIOutput'Class (UI).Get_Formatted_Value (Context));

      end if;

      --  Queue any block converter exception that could be raised.
   exception
      when E : others =>
         Context.Queue_Exception (E);
   end Encode_Begin;

   --  ------------------------------
   --  Label Component
   --  ------------------------------

   procedure Encode_Begin (UI      : in UIOutputLabel;
                           Context : in out Faces_Context'Class) is
      Writer : Response_Writer_Access;
   begin
      if UI.Is_Rendered (Context) then
         Writer := Context.Get_Response_Writer;
         Writer.Start_Element ("label");
         UI.Render_Attributes (Context, LABEL_ATTRIBUTE_NAMES, Writer);
         declare
            Value : Util.Beans.Objects.Object := UI.Get_Attribute (Name    => "for",
                                                                   Context => Context);
         begin
            if not Util.Beans.Objects.Is_Null (Value) then
               Writer.Write_Attribute ("for", Value);
            end if;

            Value := UIOutputLabel'Class (UI).Get_Value;
            if not Util.Beans.Objects.Is_Null (Value) then
               declare
                  S : constant String
                    := UIOutputLabel'Class (UI).Get_Formatted_Value (Value, Context);
               begin
                  if UI.Get_Attribute (Name => "escape", Context => Context, Default => True) then
                     Writer.Write_Text (S);
                  else
                     Writer.Write_Raw (S);
                  end if;
               end;
            end if;

            --  Queue and block any converter exception that could be raised.
         exception
            when E : others =>
               Context.Queue_Exception (E);
         end;
      end if;
   end Encode_Begin;

   procedure Encode_End (UI      : in UIOutputLabel;
                         Context : in out Faces_Context'Class) is
      Writer : Response_Writer_Access;
   begin
      if UI.Is_Rendered (Context) then
         Writer := Context.Get_Response_Writer;
         Writer.End_Element ("label");
      end if;
   end Encode_End;

   --  ------------------------------
   --  OutputFormat Component
   --  ------------------------------
   procedure Encode_Begin (UI      : in UIOutputFormat;
                           Context : in out Faces_Context'Class) is
      use ASF.Components.Core;
      use ASF.Utils;
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;

      declare
         Params : constant UIParameter_Access_Array := Get_Parameters (UI);
         Values : ASF.Utils.Object_Array (Params'Range);
         Result : Ada.Strings.Unbounded.Unbounded_String;
         Fmt    : constant String := EL.Objects.To_String (UI.Get_Value);
      begin
         --  Get the values associated with the parameters.
         for I in Params'Range loop
            Values (I) := Params (I).Get_Value (Context);
         end loop;
         Formats.Format (Fmt, Values, Result);
         UI.Write_Output (Context => Context,
                          Value   => To_String (Result));
      end;
   end Encode_Begin;

begin
   Utils.Set_Text_Attributes (TEXT_ATTRIBUTE_NAMES);
   Utils.Set_Text_Attributes (LABEL_ATTRIBUTE_NAMES);
   Utils.Set_Interactive_Attributes (LABEL_ATTRIBUTE_NAMES);
end ASF.Components.Html.Text;

Fix compilation issue on Object_Array type (still ASF.Utils.Object_Array type should be removed some day)


-----------------------------------------------------------------------
--  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
   begin
      null;
   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.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;

Call the delete answer

Call the delete answer


-----------------------------------------------------------------------
--  ADO Sessions -- Sessions Management
--  Copyright (C) 2009, 2010, 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;
with Util.Log.Loggers;
with Ada.Unchecked_Deallocation;
with ADO.Sequences;
package body ADO.Sessions is

   use Util.Log;

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

   procedure Check_Session (Database : in Session'Class) is
   begin
      if Database.Impl = null then
         Log.Error ("Session is closed or not initialized");
         raise NOT_OPEN;
      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);

   begin
      Log.Info ("Closing session");
      if Database.Impl /= null then
         Database.Impl.Database.Close;
         Database.Impl.Counter := Database.Impl.Counter - 1;
         if Database.Impl.Counter = 0 then
            Free (Database.Impl);
         end if;
--
--           if Database.Impl.Proxy /= null then
--              Database.Impl.Proxy.Counter := Database.Impl.Proxy.Counter - 1;
--           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);
      begin
         return Database.Impl.Database.Create_Statement (SQL);
      end;
   end Create_Statement;

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

   --  ------------------------------
   --  Start a transaction.
   --  ------------------------------
   procedure Begin_Transaction (Database : in out Master_Session) is
   begin
      Log.Info ("Begin transaction");

      Check_Session (Database);
      Database.Impl.Database.Begin_Transaction;
   end Begin_Transaction;

   --  ------------------------------
   --  Commit the current transaction.
   --  ------------------------------
   procedure Commit (Database : in out Master_Session) is
   begin
      Log.Info ("Commit transaction");

      Check_Session (Database);
      Database.Impl.Database.Commit;
   end Commit;

   --  ------------------------------
   --  Rollback the current transaction.
   --  ------------------------------
   procedure Rollback (Database : in out Master_Session) is
   begin
      Log.Info ("Rollback transaction");

      Check_Session (Database);
      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
         Object.Impl.Counter := Object.Impl.Counter + 1;
      end if;
   end Adjust;

   overriding
   procedure Finalize (Object : in out Session) is
   begin
      if Object.Impl /= null then
         if Object.Impl.Counter = 1 then
            Object.Close;
         else
            Object.Impl.Counter := Object.Impl.Counter - 1;
         end if;
      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;

   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 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.Sequences;
package body ADO.Sessions is

   use Util.Log;

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

   procedure Check_Session (Database : in Session'Class) is
   begin
      if Database.Impl = null then
         Log.Error ("Session is closed or not initialized");
         raise NOT_OPEN;
      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);

   begin
      Log.Info ("Closing session");
      if Database.Impl /= null then
         Database.Impl.Database.Close;
         Database.Impl.Counter := Database.Impl.Counter - 1;
         if Database.Impl.Counter = 0 then
            Free (Database.Impl);
         end if;
--
--           if Database.Impl.Proxy /= null then
--              Database.Impl.Proxy.Counter := Database.Impl.Proxy.Counter - 1;
--           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;

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

   --  ------------------------------
   --  Start a transaction.
   --  ------------------------------
   procedure Begin_Transaction (Database : in out Master_Session) is
   begin
      Log.Info ("Begin transaction");

      Check_Session (Database);
      Database.Impl.Database.Begin_Transaction;
   end Begin_Transaction;

   --  ------------------------------
   --  Commit the current transaction.
   --  ------------------------------
   procedure Commit (Database : in out Master_Session) is
   begin
      Log.Info ("Commit transaction");

      Check_Session (Database);
      Database.Impl.Database.Commit;
   end Commit;

   --  ------------------------------
   --  Rollback the current transaction.
   --  ------------------------------
   procedure Rollback (Database : in out Master_Session) is
   begin
      Log.Info ("Rollback transaction");

      Check_Session (Database);
      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
         Object.Impl.Counter := Object.Impl.Counter + 1;
      end if;
   end Adjust;

   overriding
   procedure Finalize (Object : in out Session) is
   begin
      if Object.Impl /= null then
         if Object.Impl.Counter = 1 then
            Object.Close;
         else
            Object.Impl.Counter := Object.Impl.Counter - 1;
         end if;
      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;

   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;

Fix parameters for XML queries - Set the query parameters for the XML query


-----------------------------------------------------------------------
--  mat-types -- Global types
--  Copyright (C) 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 Interfaces;
package MAT.Types is

   pragma Preelaborate;

   subtype Uint8 is Interfaces.Unsigned_8;

   subtype Uint16 is Interfaces.Unsigned_16;

   subtype Uint32 is Interfaces.Unsigned_32;

   subtype Uint64 is Interfaces.Unsigned_64;

   subtype Target_Addr is Interfaces.Unsigned_64;

   subtype Target_Size is Interfaces.Unsigned_64;

   subtype Target_Offset is Interfaces.Unsigned_64;

   type Target_Tick_Ref is new Uint64;

   type Target_Thread_Ref is new Uint32;

   subtype Target_Process_Ref is Uint32;

   subtype Target_Time is Target_Tick_Ref;

   --  Return an hexadecimal string representation of the value.
   function Hex_Image (Value : in Uint32;
                       Length : in Positive := 8) return String;

   --  Return an hexadecimal string representation of the value.
   function Hex_Image (Value  : in Uint64;
                       Length : in Positive := 16) return String;

   --  Format the target time to a printable representation.
   function Tick_Image (Value : in Target_Tick_Ref) return String;

   --  Convert the string in the form NN.MM into a tick value.
   function Tick_Value (Value : in String) return Target_Tick_Ref;

   --  Convert the hexadecimal string into an unsigned integer.
   function Hex_Value (Value : in String) return Uint64;

end MAT.Types;

-----------------------------------------------------------------------
--  mat-types -- Global types
--  Copyright (C) 2014, 2015, 2021 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 Interfaces;
package MAT.Types is

   subtype Uint8 is Interfaces.Unsigned_8;

   subtype Uint16 is Interfaces.Unsigned_16;

   subtype Uint32 is Interfaces.Unsigned_32;

   subtype Uint64 is Interfaces.Unsigned_64;

   subtype Target_Addr is Interfaces.Unsigned_64;

   subtype Target_Size is Interfaces.Unsigned_64;

   subtype Target_Offset is Interfaces.Unsigned_64;

   type Target_Tick_Ref is new Uint64;

   type Target_Thread_Ref is new Uint32;

   subtype Target_Process_Ref is Uint32;

   subtype Target_Time is Target_Tick_Ref;

   --  Return an hexadecimal string representation of the value.
   function Hex_Image (Value : in Uint32;
                       Length : in Positive := 8) return String;

   --  Return an hexadecimal string representation of the value.
   function Hex_Image (Value  : in Uint64;
                       Length : in Positive := 16) return String;

   --  Format the target time to a printable representation.
   function Tick_Image (Value : in Target_Tick_Ref) return String;

   --  Convert the string in the form NN.MM into a tick value.
   function Tick_Value (Value : in String) return Target_Tick_Ref;

   --  Convert the hexadecimal string into an unsigned integer.
   function Hex_Value (Value : in String) return Uint64;

end MAT.Types;

Remove pragma Preelaborate

Remove pragma Preelaborate


-----------------------------------------------------------------------
--  awa-settings-modules-tests -- Unit tests for settings module
--  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 Util.Test_Caller;
with Util.Measures;

with Security.Contexts;

with AWA.Tests.Helpers.Users;
with AWA.Tests.Helpers.Contexts;
package body AWA.Settings.Modules.Tests is

   use Util.Tests;

   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.Settings.Get_User_Setting",
                       Test_Get_User_Setting'Access);
      Caller.Add_Test (Suite, "Test AWA.Settings.Set_User_Setting",
                       Test_Set_User_Setting'Access);
      Caller.Add_Test (Suite, "Test AWA.Settings.Get_User_Setting (perf)",
                       Test_Perf_User_Setting'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test getting a user setting.
   --  ------------------------------
   procedure Test_Get_User_Setting (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Tests.Helpers.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-setting@test.com");

      for I in 1 .. 10 loop
         declare
            Name : constant String  := "setting-" & Natural'Image (I);
            R    : constant Integer := AWA.Settings.Get_User_Setting (Name, I);
         begin
            Util.Tests.Assert_Equals (T, I, R, "Invalid Get_User_Setting result");
         end;
      end loop;
   end Test_Get_User_Setting;

   --  ------------------------------
   --  Test saving a user setting.
   --  ------------------------------
   procedure Test_Set_User_Setting (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Tests.Helpers.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-setting@test.com");

      for I in 1 .. 10 loop
         declare
            Name : constant String  := "setting-" & Natural'Image (I);
            R    : Integer;
         begin
            AWA.Settings.Set_User_Setting (Name, I);

            R := AWA.Settings.Get_User_Setting (Name, 0);
            Util.Tests.Assert_Equals (T, I, R, "Invalid Set_User_Setting result");
         end;
      end loop;
   end Test_Set_User_Setting;

   --  ------------------------------
   --  Test performance on user setting.
   --  ------------------------------
   procedure Test_Perf_User_Setting (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Tests.Helpers.Contexts.Service_Context;
      Ident     : constant String := Util.Tests.Get_Uuid;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-setting@test.com");

      --  First pass has to look in the database for the user setting.
      --  Second pass finds the setting in the cache.
      for Pass in 1 .. 2 loop
         declare
            Value : Integer;
            Stamp : Util.Measures.Stamp;
         begin
            for I in 1 .. 100 loop
               Value := AWA.Settings.Get_User_Setting ("perf-" & Integer'Image (I) & Ident, I);
               Util.Tests.Assert_Equals (T, I, Value, "Invalid setting returned");
            end loop;
            Util.Measures.Report (Stamp, "Getting a user setting (100 times) pass"
                                  & Integer'Image (Pass));
         end;
      end loop;

      declare
         Stamp : Util.Measures.Stamp;
      begin
         for I in 1 .. 100 loop
            AWA.Settings.Set_User_Setting ("perf-" & Integer'Image (I) & Ident, I);
         end loop;
         Util.Measures.Report (Stamp, "Saving and creating user setting (100 times)");
      end;

      --  Erase the session cache.
      Context.Session_Attributes.Clear;

      --  Get the user setting that have been created.
      declare
         Value : Integer;
         Stamp : Util.Measures.Stamp;
      begin
         for I in 1 .. 100 loop
            Value := AWA.Settings.Get_User_Setting ("perf-" & Integer'Image (I) & Ident, -1);
            Util.Tests.Assert_Equals (T, I, Value, "Invalid setting returned");
         end loop;
         Util.Measures.Report (Stamp, "Getting a user setting (100 times) load from DB");
      end;
   end Test_Perf_User_Setting;

end AWA.Settings.Modules.Tests;

-----------------------------------------------------------------------
--  awa-settings-modules-tests -- Unit tests for settings module
--  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 Util.Test_Caller;
with Util.Measures;

with Security.Contexts;

with AWA.Tests.Helpers.Users;
with AWA.Tests.Helpers.Contexts;
package body AWA.Settings.Modules.Tests is

   use Util.Tests;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Settings.Get_User_Setting",
                       Test_Get_User_Setting'Access);
      Caller.Add_Test (Suite, "Test AWA.Settings.Set_User_Setting",
                       Test_Set_User_Setting'Access);
      Caller.Add_Test (Suite, "Test AWA.Settings.Get_User_Setting (perf)",
                       Test_Perf_User_Setting'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test getting a user setting.
   --  ------------------------------
   procedure Test_Get_User_Setting (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Tests.Helpers.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-setting@test.com");

      for I in 1 .. 10 loop
         declare
            Name : constant String  := "setting-" & Natural'Image (I);
            R    : constant Integer := AWA.Settings.Get_User_Setting (Name, I);
         begin
            Util.Tests.Assert_Equals (T, I, R, "Invalid Get_User_Setting result");
         end;
      end loop;
   end Test_Get_User_Setting;

   --  ------------------------------
   --  Test saving a user setting.
   --  ------------------------------
   procedure Test_Set_User_Setting (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Tests.Helpers.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-setting@test.com");

      for I in 1 .. 10 loop
         declare
            Name : constant String  := "setting-" & Natural'Image (I);
            R    : Integer;
         begin
            AWA.Settings.Set_User_Setting (Name, I);

            R := AWA.Settings.Get_User_Setting (Name, 0);
            Util.Tests.Assert_Equals (T, I, R, "Invalid Set_User_Setting result");
         end;
      end loop;
   end Test_Set_User_Setting;

   --  ------------------------------
   --  Test performance on user setting.
   --  ------------------------------
   procedure Test_Perf_User_Setting (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Tests.Helpers.Contexts.Service_Context;
      Ident     : constant String := Util.Tests.Get_Uuid;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-setting@test.com");

      --  First pass has to look in the database for the user setting.
      --  Second pass finds the setting in the cache.
      for Pass in 1 .. 2 loop
         declare
            Value : Integer;
            Stamp : Util.Measures.Stamp;
         begin
            for I in 1 .. 100 loop
               Value := AWA.Settings.Get_User_Setting ("perf-" & Integer'Image (I) & Ident, I);
               Util.Tests.Assert_Equals (T, I, Value, "Invalid setting returned");
            end loop;
            Util.Measures.Report (Stamp, "Getting a user setting (100 times) pass"
                                  & Integer'Image (Pass));
         end;
      end loop;

      declare
         Stamp : Util.Measures.Stamp;
      begin
         for I in 1 .. 100 loop
            AWA.Settings.Set_User_Setting ("perf-" & Integer'Image (I) & Ident, I);
         end loop;
         Util.Measures.Report (Stamp, "Saving and creating user setting (100 times)");
      end;

      --  Erase the session cache.
      Context.Session_Attributes.Clear;

      --  Get the user setting that have been created.
      declare
         Value : Integer;
         Stamp : Util.Measures.Stamp;
      begin
         for I in 1 .. 100 loop
            Value := AWA.Settings.Get_User_Setting ("perf-" & Integer'Image (I) & Ident, -1);
            Util.Tests.Assert_Equals (T, I, Value, "Invalid setting returned");
         end loop;
         Util.Measures.Report (Stamp, "Getting a user setting (100 times) load from DB");
      end;
   end Test_Perf_User_Setting;

end AWA.Settings.Modules.Tests;

Fix the unit test name

Fix the unit test name


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

with Util.Strings;

with Text;
with Yaml.Source.File;
with Yaml.Parser;

with Gen.Configs;
with Gen.Model.Tables;
with Gen.Model.Queries;
with Gen.Model.Mappings;
with Gen.Model.Operations;

with Util.Log.Loggers;
with Util.Encoders.HMAC.SHA1;
with Util.Stacks;

use Yaml;

package body Gen.Artifacts.Yaml is

   use Ada.Strings.Unbounded;
   use Gen.Model;
   use Gen.Model.Tables;
   use Gen.Model.Queries;
   use Gen.Configs;

   use Util.Log;

   use type Text.Reference;

   Log : constant Loggers.Logger := Loggers.Create ("Gen.Artifacts.Yaml");

   type State_Type is (IN_ROOT,
                       IN_TABLE,
                       IN_COLUMNS,
                       IN_KEYS,
                       IN_COLUMN,
                       IN_KEY,
                       IN_UNKOWN);

   type Node_Info is record
      State    : State_Type := IN_UNKOWN;
      Name     : Text.Reference;
      Has_Name : Boolean := False;
      Table    : Gen.Model.Tables.Table_Definition_Access;
      Col      : Gen.Model.Tables.Column_Definition_Access;
   end record;

   type Node_Info_Access is access all Node_Info;

   package Node_Stack is new Util.Stacks (Element_Type        => Node_Info,
                                          Element_Type_Access => Node_Info_Access);

   procedure Read_Scalar (Node  : in Node_Info_Access;
                          Name  : in String;
                          Value : in String) is
   begin
      case Node.State is
         when IN_TABLE =>
            if Node.Table = null then
               return;
            end if;

            Log.Debug ("Set table {0} attribute {1}={2}", Node.Table.Name, Name, Value);
            if Name = "table" then
               Node.Table.Table_Name := To_Unbounded_String (Value);
            elsif Name = "description" then
               Node.Table.Set_Comment (Value);
            end if;

         when IN_COLUMN | IN_KEY =>
            if Node.Col = null then
               return;
            end if;

            Log.Debug ("Set table column {0} attribute {1}={2}", Node.Col.Name, Name, Value);
            if Name = "type" then
               Node.Col.Set_Type (Value);
            elsif Name = "length" then
               Node.Col.Sql_Length := Natural'Value (Value);
            elsif Name = "column" then
               Node.Col.Sql_Name := To_Unbounded_String (Value);
            elsif Name = "unique" then
               Node.Col.Unique := Value = "true" or Value = "yes";
            elsif Name = "nullable" or Name = "optional" then
               Node.Col.Not_Null := Value = "false" or Value = "no";
            elsif Name = "not-null" or Name = "required" then
               Node.Col.Not_Null := Value = "true" or Value = "yes";
            elsif Name = "description" then
               Node.Col.Set_Comment (Value);
            end if;

         when others =>
            Log.Error ("Scalar {0}: {1} not handled", Name, Value);
      end case;
   end Read_Scalar;

   procedure Process_Mapping (Model : in out Gen.Model.Packages.Model_Definition;
                              Stack : in out Node_Stack.Stack) is
      Node     : Node_Info_Access;
      New_Node : Node_Info_Access;
   begin
      Node := Node_Stack.Current (Stack);
      if Node.Has_Name then
         Node.Has_Name := False;
         case Node.State is
            when IN_ROOT =>
               Node_Stack.Push (Stack);
               New_Node := Node_Stack.Current (Stack);
               New_Node.Table := Gen.Model.Tables.Create_Table (To_Unbounded_String (Node.Name & ""));
               New_Node.State := IN_TABLE;
               Model.Register_Table (New_Node.Table);

            when IN_TABLE =>
               if Node.Name = "fields" or Node.Name = "properties" then
                  Node_Stack.Push (Stack);
                  New_Node := Node_Stack.Current (Stack);
                  New_Node.Table := Node.Table;
                  New_Node.State := IN_COLUMNS;

               elsif Node.Name = "id" then
                  Node_Stack.Push (Stack);
                  New_Node := Node_Stack.Current (Stack);
                  New_Node.Table := Node.Table;
                  New_Node.State := IN_KEYS;

               else
                  Node_Stack.Push (Stack);
                  New_Node := Node_Stack.Current (Stack);
                  New_Node.Table := Node.Table;
                  New_Node.State := IN_TABLE;
               end if;

            when IN_COLUMNS =>
               Node.Table.Add_Column (To_Unbounded_String (Node.Name & ""), Node.Col);
               Node_Stack.Push (Stack);
               New_Node := Node_Stack.Current (Stack);
               New_Node.Table := Node.Table;
               New_Node.State := IN_COLUMN;

            when IN_KEYS =>
               Node.Table.Add_Column (To_Unbounded_String (Node.Name & ""), Node.Col);
               Node.Col.Is_Key := True;
               Node_Stack.Push (Stack);
               New_Node := Node_Stack.Current (Stack);
               New_Node.Table := Node.Table;
               New_Node.State := IN_KEY;

            when others =>
               Node_Stack.Push (Stack);
               New_Node := Node_Stack.Current (Stack);
               New_Node.State := IN_UNKOWN;

         end case;
      else
         Node_Stack.Push (Stack);

      end if;
   end Process_Mapping;

   --  Read the UML/XMI model file.
   procedure Read_Model (Handler       : in out Artifact;
                         File          : in String;
                         Model         : in out Gen.Model.Packages.Model_Definition;
                         Context       : in out Generator'Class;
                         Is_Predefined : in Boolean := False) is
      Input : Source.Pointer;
      P     : Parser.Instance;
      Cur   : Event;
      Stack : Node_Stack.Stack;
      Node  : Node_Info_Access;
      Loc   : Mark;
   begin
      Log.Info ("Reading YAML file {0}", File);

      Input := Source.File.As_Source (File);
      P.Set_Input (Input);
      loop
         Cur := P.Next;
         exit when Cur.Kind = Stream_End;
         case Cur.Kind is
            when Stream_Start | Document_Start =>
               Node_Stack.Push (Stack);
               Node := Node_Stack.Current (Stack);
               Node.State := IN_ROOT;

            when Stream_End | Document_End =>
               Node_Stack.Pop (Stack);

            when Alias =>
               null;

            when Scalar =>
               Node := Node_Stack.Current (Stack);
               if Node.Has_Name then
                  Read_Scalar (Node, Node.Name & "", Cur.Content & "");
                  Node.Has_Name := False;
               else
                  Node.Name := Cur.Content;
                  Node.Has_Name := True;
               end if;

            when Sequence_Start =>
               Node_Stack.Push (Stack);

            when Sequence_End =>
               Node_Stack.Pop (Stack);

            when Mapping_Start =>
               Process_Mapping (Model, Stack);

            when Mapping_End =>
               Node_Stack.Pop (Stack);

            when Annotation_Start =>
               null;

            when Annotation_End =>
               null;

         end case;
      end loop;

   exception
      when E : others =>
         Loc := P.Current_Lexer_Token_Start;
         Context.Error ("{0}: {1}", Util.Strings.Image (Loc.Line) & ":"
                        & Util.Strings.Image (Loc.Column) & ": ",
                        Ada.Exceptions.Exception_Message (E));
   end Read_Model;

   --  ------------------------------
   --  Prepare the generation of the package:
   --  o identify the column types which are used
   --  o build a list of package for the with clauses.
   --  ------------------------------
   overriding
   procedure Prepare (Handler : in out Artifact;
                      Model   : in out Gen.Model.Packages.Model_Definition'Class;
                      Context : in out Generator'Class) is
      pragma Unreferenced (Handler);
   begin
      Log.Debug ("Preparing the model for query");

      if Model.Has_Packages then
         Context.Add_Generation (Name => GEN_PACKAGE_SPEC, Mode => ITERATION_PACKAGE,
                                 Mapping => Gen.Model.Mappings.ADA_MAPPING);
         Context.Add_Generation (Name => GEN_PACKAGE_BODY, Mode => ITERATION_PACKAGE,
                                 Mapping => Gen.Model.Mappings.ADA_MAPPING);
      end if;
   end Prepare;

end Gen.Artifacts.Yaml;

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

with Util.Strings;

with Text;
with Yaml.Source.File;
with Yaml.Parser;

with Gen.Configs;
with Gen.Model.Tables;
with Gen.Model.Mappings;
with Gen.Model.Operations;

with Util.Log.Loggers;
with Util.Encoders.HMAC.SHA1;
with Util.Stacks;

use Yaml;

package body Gen.Artifacts.Yaml is

   use Ada.Strings.Unbounded;
   use Gen.Model;
   use Gen.Model.Tables;
   use Gen.Configs;

   use Util.Log;

   use type Text.Reference;

   Log : constant Loggers.Logger := Loggers.Create ("Gen.Artifacts.Yaml");

   type State_Type is (IN_ROOT,
                       IN_TABLE,
                       IN_COLUMNS,
                       IN_KEYS,
                       IN_COLUMN,
                       IN_KEY,
                       IN_UNKOWN);

   type Node_Info is record
      State    : State_Type := IN_UNKOWN;
      Name     : Text.Reference;
      Has_Name : Boolean := False;
      Table    : Gen.Model.Tables.Table_Definition_Access;
      Col      : Gen.Model.Tables.Column_Definition_Access;
   end record;

   type Node_Info_Access is access all Node_Info;

   package Node_Stack is new Util.Stacks (Element_Type        => Node_Info,
                                          Element_Type_Access => Node_Info_Access);

   procedure Read_Scalar (Node  : in Node_Info_Access;
                          Name  : in String;
                          Value : in String) is
   begin
      case Node.State is
         when IN_TABLE =>
            if Node.Table = null then
               return;
            end if;

            Log.Debug ("Set table {0} attribute {1}={2}", Node.Table.Name, Name, Value);
            if Name = "table" then
               Node.Table.Table_Name := To_Unbounded_String (Value);
            elsif Name = "description" or name = "comment" then
               Node.Table.Set_Comment (Value);
            end if;

         when IN_COLUMN | IN_KEY =>
            if Node.Col = null then
               return;
            end if;

            Log.Debug ("Set table column {0} attribute {1}={2}", Node.Col.Name, Name, Value);
            if Name = "type" then
               Node.Col.Set_Type (Value);
            elsif Name = "length" then
               Node.Col.Sql_Length := Natural'Value (Value);
            elsif Name = "column" then
               Node.Col.Sql_Name := To_Unbounded_String (Value);
            elsif Name = "unique" then
               Node.Col.Unique := Value = "true" or Value = "yes";
            elsif Name = "nullable" or Name = "optional" then
               Node.Col.Not_Null := Value = "false" or Value = "no";
            elsif Name = "not-null" or Name = "required" then
               Node.Col.Not_Null := Value = "true" or Value = "yes";
            elsif Name = "description" or name = "comment" then
               Node.Col.Set_Comment (Value);
            end if;

         when others =>
            Log.Error ("Scalar {0}: {1} not handled", Name, Value);
      end case;
   end Read_Scalar;

   procedure Process_Mapping (Model : in out Gen.Model.Packages.Model_Definition;
                              Stack : in out Node_Stack.Stack) is
      Node     : Node_Info_Access;
      New_Node : Node_Info_Access;
   begin
      Node := Node_Stack.Current (Stack);
      if Node.Has_Name then
         Node.Has_Name := False;
         case Node.State is
            when IN_ROOT =>
               Node_Stack.Push (Stack);
               New_Node := Node_Stack.Current (Stack);
               New_Node.Table := Gen.Model.Tables.Create_Table (To_Unbounded_String (Node.Name & ""));
               New_Node.State := IN_TABLE;
               Model.Register_Table (New_Node.Table);

            when IN_TABLE =>
               if Node.Name = "fields" or Node.Name = "properties" then
                  Node_Stack.Push (Stack);
                  New_Node := Node_Stack.Current (Stack);
                  New_Node.Table := Node.Table;
                  New_Node.State := IN_COLUMNS;

               elsif Node.Name = "id" then
                  Node_Stack.Push (Stack);
                  New_Node := Node_Stack.Current (Stack);
                  New_Node.Table := Node.Table;
                  New_Node.State := IN_KEYS;

               else
                  Node_Stack.Push (Stack);
                  New_Node := Node_Stack.Current (Stack);
                  New_Node.Table := Node.Table;
                  New_Node.State := IN_TABLE;
               end if;

            when IN_COLUMNS =>
               Node.Table.Add_Column (To_Unbounded_String (Node.Name & ""), Node.Col);
               Node_Stack.Push (Stack);
               New_Node := Node_Stack.Current (Stack);
               New_Node.Table := Node.Table;
               New_Node.State := IN_COLUMN;

            when IN_KEYS =>
               Node.Table.Add_Column (To_Unbounded_String (Node.Name & ""), Node.Col);
               Node.Col.Is_Key := True;
               Node_Stack.Push (Stack);
               New_Node := Node_Stack.Current (Stack);
               New_Node.Table := Node.Table;
               New_Node.State := IN_KEY;

            when others =>
               Node_Stack.Push (Stack);
               New_Node := Node_Stack.Current (Stack);
               New_Node.State := IN_UNKOWN;

         end case;
      else
         Node_Stack.Push (Stack);

      end if;
   end Process_Mapping;

   --  Read the UML/XMI model file.
   procedure Read_Model (Handler       : in out Artifact;
                         File          : in String;
                         Model         : in out Gen.Model.Packages.Model_Definition;
                         Context       : in out Generator'Class) is
      Input : Source.Pointer;
      P     : Parser.Instance;
      Cur   : Event;
      Stack : Node_Stack.Stack;
      Node  : Node_Info_Access;
      Loc   : Mark;
   begin
      Log.Info ("Reading YAML file {0}", File);

      Input := Source.File.As_Source (File);
      P.Set_Input (Input);
      loop
         Cur := P.Next;
         exit when Cur.Kind = Stream_End;
         case Cur.Kind is
            when Stream_Start | Document_Start =>
               Node_Stack.Push (Stack);
               Node := Node_Stack.Current (Stack);
               Node.State := IN_ROOT;

            when Stream_End | Document_End =>
               Node_Stack.Pop (Stack);

            when Alias =>
               null;

            when Scalar =>
               Node := Node_Stack.Current (Stack);
               if Node.Has_Name then
                  Read_Scalar (Node, Node.Name & "", Cur.Content & "");
                  Node.Has_Name := False;
               else
                  Node.Name := Cur.Content;
                  Node.Has_Name := True;
               end if;

            when Sequence_Start =>
               Node_Stack.Push (Stack);

            when Sequence_End =>
               Node_Stack.Pop (Stack);

            when Mapping_Start =>
               Process_Mapping (Model, Stack);

            when Mapping_End =>
               Node_Stack.Pop (Stack);

            when Annotation_Start =>
               null;

            when Annotation_End =>
               null;

         end case;
      end loop;

   exception
      when E : others =>
         Loc := P.Current_Lexer_Token_Start;
         Context.Error ("{0}: {1}", Util.Strings.Image (Loc.Line) & ":"
                        & Util.Strings.Image (Loc.Column) & ": ",
                        Ada.Exceptions.Exception_Message (E));
   end Read_Model;

   --  ------------------------------
   --  Prepare the generation of the package:
   --  o identify the column types which are used
   --  o build a list of package for the with clauses.
   --  ------------------------------
   overriding
   procedure Prepare (Handler : in out Artifact;
                      Model   : in out Gen.Model.Packages.Model_Definition'Class;
                      Context : in out Generator'Class) is
      pragma Unreferenced (Handler);
   begin
      Log.Debug ("Preparing the model for query");

      if Model.Has_Packages then
         Context.Add_Generation (Name => GEN_PACKAGE_SPEC, Mode => ITERATION_PACKAGE,
                                 Mapping => Gen.Model.Mappings.ADA_MAPPING);
         Context.Add_Generation (Name => GEN_PACKAGE_BODY, Mode => ITERATION_PACKAGE,
                                 Mapping => Gen.Model.Mappings.ADA_MAPPING);
      end if;
   end Prepare;

end Gen.Artifacts.Yaml;

Fix compilation warnings

Fix compilation warnings