-----------------------------------------------------------------------
--  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 AWA.Services.Contexts;
with AWA.Questions.Services;
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
   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
   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,
                                   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
   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);
      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
            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;
         begin
            Query.Set_Query (AWA.Questions.Models.Query_Question_Info);
            Query.Bind_Param ("question_id", Util.Beans.Objects.To_Integer (Value));
            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.Set_Query (AWA.Questions.Models.Query_Answer_List);
            Query.Bind_Param ("question_id", Util.Beans.Objects.To_Integer (Value));
            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;
with AWA.Questions.Services;
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
   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
   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,
                                   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
   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
            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;
         begin
            Query.Set_Query (AWA.Questions.Models.Query_Question_Info);
            Query.Bind_Param ("question_id", Util.Beans.Objects.To_Integer (Value));
            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.Set_Query (AWA.Questions.Models.Query_Answer_List);
            Query.Bind_Param ("question_id", Util.Beans.Objects.To_Integer (Value));
            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;

Add the question table entity type to queries


-----------------------------------------------------------------------
--  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 Ada.Strings.Unbounded;

with Util.Beans.Basic;
with Util.Beans.Objects;
with AWA.Questions.Modules;
with AWA.Questions.Models;
with AWA.Questions.Services;
package AWA.Questions.Beans is

   type Question_Bean is new AWA.Questions.Models.Question_Bean with record
      Service : Services.Question_Service_Access := null;
   end record;
   type Question_Bean_Access is access all Question_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Question_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

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

   --  Create or save the question.
   procedure Save (Bean    : in out Question_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the question.
   procedure Delete (Bean : in out Question_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Questions_Bean bean instance.
   function Create_Question_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                  return Util.Beans.Basic.Readonly_Bean_Access;

   type Answer_Bean is new AWA.Questions.Models.Answer_Bean with record
      Service  : Services.Question_Service_Access := null;
      Question : AWA.Questions.Models.Question_Ref;
   end record;
   type Answer_Bean_Access is access all Answer_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Answer_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

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

   --  Create or save the answer.
   procedure Save (Bean    : in out Answer_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the question.
   procedure Delete (Bean    : in out Answer_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the answer bean instance.
   function Create_Answer_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                       return Util.Beans.Basic.Readonly_Bean_Access;

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

   type Question_Display_Bean is new Util.Beans.Basic.Bean with record
      Service          : Services.Question_Service_Access := null;

      Answer_List      : aliased AWA.Questions.Models.Answer_Info_List_Bean;
      Answer_List_Bean : AWA.Questions.Models.Answer_Info_List_Bean_Access;

      Question         : aliased AWA.Questions.Models.Question_Display_Info;
      Question_Bean    : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Question_Display_Bean_Access is access all Question_Display_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Question_Display_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

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

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

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 Ada.Strings.Unbounded;

with Util.Beans.Basic;
with Util.Beans.Objects;
with AWA.Questions.Modules;
with AWA.Questions.Models;
package AWA.Questions.Beans is

   type Question_Bean is new AWA.Questions.Models.Question_Bean with record
      Service : Modules.Question_Module_Access := null;
   end record;
   type Question_Bean_Access is access all Question_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Question_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

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

   --  Create or save the question.
   procedure Save (Bean    : in out Question_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the question.
   procedure Delete (Bean : in out Question_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Questions_Bean bean instance.
   function Create_Question_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                  return Util.Beans.Basic.Readonly_Bean_Access;

   type Answer_Bean is new AWA.Questions.Models.Answer_Bean with record
      Service  : Modules.Question_Module_Access := null;
      Question : AWA.Questions.Models.Question_Ref;
   end record;
   type Answer_Bean_Access is access all Answer_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Answer_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

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

   --  Create or save the answer.
   procedure Save (Bean    : in out Answer_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the question.
   procedure Delete (Bean    : in out Answer_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the answer bean instance.
   function Create_Answer_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                       return Util.Beans.Basic.Readonly_Bean_Access;

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

   type Question_Display_Bean is new Util.Beans.Basic.Bean with record
      Service          : Modules.Question_Module_Access := null;

      Answer_List      : aliased AWA.Questions.Models.Answer_Info_List_Bean;
      Answer_List_Bean : AWA.Questions.Models.Answer_Info_List_Bean_Access;

      Question         : aliased AWA.Questions.Models.Question_Display_Info;
      Question_Bean    : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Question_Display_Bean_Access is access all Question_Display_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Question_Display_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

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

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

end AWA.Questions.Beans;

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


-----------------------------------------------------------------------
--  security-policies -- Security Policies
--  Copyright (C) 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.Unchecked_Deallocation;

with Util.Log.Loggers;

with Security.Controllers;
with Security.Contexts;

package body Security.Policies is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Security.Policies");

   procedure Free is
     new Ada.Unchecked_Deallocation (Security.Controllers.Controller'Class,
                                     Controller_Access);

   --  ------------------------------
   --  Get the policy index.
   --  ------------------------------
   function Get_Policy_Index (From : in Policy'Class) return Policy_Index is
   begin
      return From.Index;
   end Get_Policy_Index;

   --  ------------------------------
   --  Add a permission under the given permission name and associated with the controller.
   --  To verify the permission, the controller will be called.
   --  ------------------------------
   procedure Add_Permission (Manager    : in out Policy;
                             Name       : in String;
                             Permission : in Controller_Access) is
   begin
      Manager.Manager.Add_Permission (Name, Permission);
   end Add_Permission;

   --  ------------------------------
   --  Get the policy with the name Name registered in the policy manager.
   --  Returns null if there is no such policy.
   --  ------------------------------
   function Get_Policy (Manager : in Policy_Manager;
                        Name    : in String) return Policy_Access is
   begin
      for I in Manager.Policies'Range loop
         if Manager.Policies (I) = null then
            return null;
         elsif Manager.Policies (I).Get_Name = Name then
            return Manager.Policies (I);
         end if;
      end loop;
      return null;
   end Get_Policy;

   --  ------------------------------
   --  Add the policy to the policy manager.  After a policy is added in the manager,
   --  it can participate in the security policy.
   --  Raises Policy_Error if the policy table is full.
   --  ------------------------------
   procedure Add_Policy (Manager : in out Policy_Manager;
                         Policy  : in Policy_Access) is
      Name : constant String := Policy.Get_Name;
   begin
      Log.Info ("Adding policy {0}", Name);

      for I in Manager.Policies'Range loop
         if Manager.Policies (I) = null then
            Manager.Policies (I) := Policy;
            Policy.Manager := Manager'Unchecked_Access;
            Policy.Index   := I;
            return;
         end if;
      end loop;
      Log.Error ("Policy table is full, increase policy manager table to {0} to add policy {1}",
                 Policy_Index'Image (Manager.Max_Policies + 1), Name);
      raise Policy_Error;
   end Add_Policy;

   --  ------------------------------
   --  Add a permission under the given permission name and associated with the controller.
   --  To verify the permission, the controller will be called.
   --  ------------------------------
   procedure Add_Permission (Manager    : in out Policy_Manager;
                             Name       : in String;
                             Permission : in Controller_Access) is
      use type Permissions.Permission_Index;

      Index : Permission_Index;
   begin
      Log.Info ("Adding permission {0}", Name);

      Permissions.Add_Permission (Name, Index);
      if Index >= Manager.Last_Index then
         declare
            Count : constant Permission_Index := Index + 32;
            Perms : constant Controller_Access_Array_Access
              := new Controller_Access_Array (0 .. Count);
         begin
            if Manager.Permissions /= null then
               Perms (Manager.Permissions'Range) := Manager.Permissions.all;
            end if;
            Manager.Permissions := Perms;
            Manager.Last_Index := Count;
         end;
      end if;

      --  If the permission has a controller, release it.
      if Manager.Permissions (Index) /= null then
         Log.Warn ("Permission {0} is redefined", Name);
         Free (Manager.Permissions (Index));
      end if;

      Manager.Permissions (Index) := Permission;
   end Add_Permission;

   --  ------------------------------
   --  Checks whether the permission defined by the Permission is granted
   --  for the security context passed in Context.
   --  Returns true if such permission is granted.
   --  ------------------------------
   function Has_Permission (Manager    : in Policy_Manager;
                            Context    : in Security.Contexts.Security_Context'Class;
                            Permission : in Security.Permissions.Permission'Class)
                            return Boolean is
      use type Permissions.Permission_Index;
   begin
      if Permission.Id >= Manager.Last_Index then
         return False;
      end if;
      declare
         C : constant Controller_Access := Manager.Permissions (Permission.Id);
      begin
         if C = null then
            return False;
         else
            return C.Has_Permission (Context, Permission);
         end if;
      end;
   end Has_Permission;

   --  ------------------------------
   --  Create the policy contexts to be associated with the security context.
   --  ------------------------------
   function Create_Policy_Contexts (Manager : in Policy_Manager)
                                    return Policy_Context_Array_Access is
   begin
      return new Policy_Context_Array (1 .. Manager.Max_Policies);
   end Create_Policy_Contexts;

   --  ------------------------------
   --  Prepare the XML parser to read the policy configuration.
   --  ------------------------------
   procedure Prepare_Config (Manager : in out Policy_Manager;
                             Reader  : in out Util.Serialize.IO.XML.Parser) is
   begin
      --  Prepare the reader to parse the policy configuration.
      for I in Manager.Policies'Range loop
         exit when Manager.Policies (I) = null;
         Manager.Policies (I).Prepare_Config (Reader);
      end loop;
   end Prepare_Config;

   --  ------------------------------
   --  Finish reading the XML policy configuration.  The security policy implementation can use
   --  this procedure to perform any configuration setup after the configuration is parsed.
   --  ------------------------------
   procedure Finish_Config (Manager : in out Policy_Manager;
                            Reader  : in out Util.Serialize.IO.XML.Parser) is
   begin
      --  Finish the policy configuration.
      for I in Manager.Policies'Range loop
         exit when Manager.Policies (I) = null;
         Manager.Policies (I).Finish_Config (Reader);
      end loop;
   end Finish_Config;

   --  Read the policy file
   procedure Read_Policy (Manager : in out Policy_Manager;
                          File    : in String) is

      use Util;

      Reader : Util.Serialize.IO.XML.Parser;

      package Policy_Config is
        new Reader_Config (Reader, Manager'Unchecked_Access);
      pragma Warnings (Off, Policy_Config);
   begin
      Log.Info ("Reading policy file {0}", File);

      Manager.Prepare_Config (Reader);

      --  Read the configuration file.
      Reader.Parse (File);

      Manager.Finish_Config (Reader);
   end Read_Policy;

   --  ------------------------------
   --  Initialize the policy manager.
   --  ------------------------------
   overriding
   procedure Initialize (Manager : in out Policy_Manager) is
   begin
      null;
   end Initialize;

   --  ------------------------------
   --  Finalize the policy manager.
   --  ------------------------------
   overriding
   procedure Finalize (Manager : in out Policy_Manager) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Controller_Access_Array,
                                        Controller_Access_Array_Access);
      procedure Free is
        new Ada.Unchecked_Deallocation (Policy'Class,
                                        Policy_Access);

   begin
      --  Release the security controllers.
      if Manager.Permissions /= null then
         for I in Manager.Permissions.all'Range loop
            if Manager.Permissions (I) /= null then
               --  SCz 2011-12-03: GNAT 2011 reports a compilation error:
               --  'missing "with" clause on package "Security.Controllers"'
               --  if we use the 'Security.Controller_Access' type, even if this "with"
               --  clause exist.
               --  gcc 4.4.3 under Ubuntu does not have this issue.
               --  We use the 'Security.Controllers.Controller_Access' type to avoid the compiler
               --  bug but we have to use a temporary variable and do some type conversion...
               declare
                  P : Controller_Access := Manager.Permissions (I).all'Access;
               begin
                  Free (P);
                  Manager.Permissions (I) := null;
               end;
            end if;
         end loop;
         Free (Manager.Permissions);
      end if;

      --  Release the policy instances.
      for I in Manager.Policies'Range loop
         exit when Manager.Policies (I) = null;
         Free (Manager.Policies (I));
      end loop;

   end Finalize;

end Security.Policies;

-----------------------------------------------------------------------
--  security-policies -- Security Policies
--  Copyright (C) 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.Unchecked_Deallocation;

with Util.Log.Loggers;

with Security.Controllers;
with Security.Contexts;

package body Security.Policies is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Security.Policies");

   procedure Free is
     new Ada.Unchecked_Deallocation (Security.Controllers.Controller'Class,
                                     Security.Controllers.Controller_Access);

   --  ------------------------------
   --  Get the policy index.
   --  ------------------------------
   function Get_Policy_Index (From : in Policy'Class) return Policy_Index is
   begin
      return From.Index;
   end Get_Policy_Index;

   --  ------------------------------
   --  Add a permission under the given permission name and associated with the controller.
   --  To verify the permission, the controller will be called.
   --  ------------------------------
   procedure Add_Permission (Manager    : in out Policy;
                             Name       : in String;
                             Permission : in Controller_Access) is
   begin
      Manager.Manager.Add_Permission (Name, Permission);
   end Add_Permission;

   --  ------------------------------
   --  Get the policy with the name Name registered in the policy manager.
   --  Returns null if there is no such policy.
   --  ------------------------------
   function Get_Policy (Manager : in Policy_Manager;
                        Name    : in String) return Policy_Access is
   begin
      for I in Manager.Policies'Range loop
         if Manager.Policies (I) = null then
            return null;
         elsif Manager.Policies (I).Get_Name = Name then
            return Manager.Policies (I);
         end if;
      end loop;
      return null;
   end Get_Policy;

   --  ------------------------------
   --  Add the policy to the policy manager.  After a policy is added in the manager,
   --  it can participate in the security policy.
   --  Raises Policy_Error if the policy table is full.
   --  ------------------------------
   procedure Add_Policy (Manager : in out Policy_Manager;
                         Policy  : in Policy_Access) is
      Name : constant String := Policy.Get_Name;
   begin
      Log.Info ("Adding policy {0}", Name);

      for I in Manager.Policies'Range loop
         if Manager.Policies (I) = null then
            Manager.Policies (I) := Policy;
            Policy.Manager := Manager'Unchecked_Access;
            Policy.Index   := I;
            return;
         end if;
      end loop;
      Log.Error ("Policy table is full, increase policy manager table to {0} to add policy {1}",
                 Policy_Index'Image (Manager.Max_Policies + 1), Name);
      raise Policy_Error;
   end Add_Policy;

   --  ------------------------------
   --  Add a permission under the given permission name and associated with the controller.
   --  To verify the permission, the controller will be called.
   --  ------------------------------
   procedure Add_Permission (Manager    : in out Policy_Manager;
                             Name       : in String;
                             Permission : in Controller_Access) is
      use type Permissions.Permission_Index;

      Index : Permission_Index;
   begin
      Log.Info ("Adding permission {0}", Name);

      Permissions.Add_Permission (Name, Index);
      if Index >= Manager.Last_Index then
         declare
            Count : constant Permission_Index := Index + 32;
            Perms : constant Controller_Access_Array_Access
              := new Controller_Access_Array (0 .. Count);
         begin
            if Manager.Permissions /= null then
               Perms (Manager.Permissions'Range) := Manager.Permissions.all;
            end if;
            Manager.Permissions := Perms;
            Manager.Last_Index := Count;
         end;
      end if;

      --  If the permission has a controller, release it.
      if Manager.Permissions (Index) /= null then
         Log.Warn ("Permission {0} is redefined", Name);

         --  SCz 2011-12-03: GNAT 2011 reports a compilation error:
         --  'missing "with" clause on package "Security.Controllers"'
         --  if we use the 'Security.Controller_Access' type, even if this "with"
         --  clause exist.
         --  gcc 4.4.3 under Ubuntu does not have this issue.
         --  We use the 'Security.Controllers.Controller_Access' type to avoid the compiler
         --  bug but we have to use a temporary variable and do some type conversion...
         declare
            P : Security.Controllers.Controller_Access := Manager.Permissions (Index).all'Access;
         begin
            Free (P);
         end;
      end if;

      Manager.Permissions (Index) := Permission;
   end Add_Permission;

   --  ------------------------------
   --  Checks whether the permission defined by the Permission is granted
   --  for the security context passed in Context.
   --  Returns true if such permission is granted.
   --  ------------------------------
   function Has_Permission (Manager    : in Policy_Manager;
                            Context    : in Security.Contexts.Security_Context'Class;
                            Permission : in Security.Permissions.Permission'Class)
                            return Boolean is
      use type Permissions.Permission_Index;
   begin
      if Permission.Id >= Manager.Last_Index then
         return False;
      end if;
      declare
         C : constant Controller_Access := Manager.Permissions (Permission.Id);
      begin
         if C = null then
            return False;
         else
            return C.Has_Permission (Context, Permission);
         end if;
      end;
   end Has_Permission;

   --  ------------------------------
   --  Create the policy contexts to be associated with the security context.
   --  ------------------------------
   function Create_Policy_Contexts (Manager : in Policy_Manager)
                                    return Policy_Context_Array_Access is
   begin
      return new Policy_Context_Array (1 .. Manager.Max_Policies);
   end Create_Policy_Contexts;

   --  ------------------------------
   --  Prepare the XML parser to read the policy configuration.
   --  ------------------------------
   procedure Prepare_Config (Manager : in out Policy_Manager;
                             Reader  : in out Util.Serialize.IO.XML.Parser) is
   begin
      --  Prepare the reader to parse the policy configuration.
      for I in Manager.Policies'Range loop
         exit when Manager.Policies (I) = null;
         Manager.Policies (I).Prepare_Config (Reader);
      end loop;
   end Prepare_Config;

   --  ------------------------------
   --  Finish reading the XML policy configuration.  The security policy implementation can use
   --  this procedure to perform any configuration setup after the configuration is parsed.
   --  ------------------------------
   procedure Finish_Config (Manager : in out Policy_Manager;
                            Reader  : in out Util.Serialize.IO.XML.Parser) is
   begin
      --  Finish the policy configuration.
      for I in Manager.Policies'Range loop
         exit when Manager.Policies (I) = null;
         Manager.Policies (I).Finish_Config (Reader);
      end loop;
   end Finish_Config;

   --  Read the policy file
   procedure Read_Policy (Manager : in out Policy_Manager;
                          File    : in String) is

      use Util;

      Reader : Util.Serialize.IO.XML.Parser;

      package Policy_Config is
        new Reader_Config (Reader, Manager'Unchecked_Access);
      pragma Warnings (Off, Policy_Config);
   begin
      Log.Info ("Reading policy file {0}", File);

      Manager.Prepare_Config (Reader);

      --  Read the configuration file.
      Reader.Parse (File);

      Manager.Finish_Config (Reader);
   end Read_Policy;

   --  ------------------------------
   --  Initialize the policy manager.
   --  ------------------------------
   overriding
   procedure Initialize (Manager : in out Policy_Manager) is
   begin
      null;
   end Initialize;

   --  ------------------------------
   --  Finalize the policy manager.
   --  ------------------------------
   overriding
   procedure Finalize (Manager : in out Policy_Manager) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Controller_Access_Array,
                                        Controller_Access_Array_Access);
      procedure Free is
        new Ada.Unchecked_Deallocation (Policy'Class,
                                        Policy_Access);

   begin
      --  Release the security controllers.
      if Manager.Permissions /= null then
         for I in Manager.Permissions.all'Range loop
            if Manager.Permissions (I) /= null then
               --  SCz 2011-12-03: GNAT 2011 reports a compilation error:
               --  'missing "with" clause on package "Security.Controllers"'
               --  if we use the 'Security.Controller_Access' type, even if this "with"
               --  clause exist.
               --  gcc 4.4.3 under Ubuntu does not have this issue.
               --  We use the 'Security.Controllers.Controller_Access' type to avoid the compiler
               --  bug but we have to use a temporary variable and do some type conversion...
               declare
                  P : Security.Controllers.Controller_Access := Manager.Permissions (I).all'Access;
               begin
                  Free (P);
                  Manager.Permissions (I) := null;
               end;
            end if;
         end loop;
         Free (Manager.Permissions);
      end if;

      --  Release the policy instances.
      for I in Manager.Policies'Range loop
         exit when Manager.Policies (I) = null;
         Free (Manager.Policies (I));
      end loop;

   end Finalize;

end Security.Policies;

Fix compilation on Windows with GNAT 2011


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

with ADO;
with AWA.Modules;
with AWA.Modules.Get;
with AWA.Modules.Lifecycles;
with AWA.Comments.Models;

--  == Integration ==
--  The <tt>Comment_Module</tt> manages the comments associated with entities.  It provides
--  operations that are used by the comment beans to manage the comments.
--  An instance of the <tt>Comment_Module</tt> must be declared and registered in the
--  AWA application.  The module instance can be defined as follows:
--
--    type Application is new AWA.Applications.Application with record
--       Comment_Module : aliased AWA.Comments.Modules.Comment_Module;
--    end record;
--
--  And registered in the `Initialize_Modules` procedure by using:
--
--    Register (App    => App.Self.all'Access,
--              Name   => AWA.Comments.Modules.NAME,
--              URI    => "comments",
--              Module => App.Comment_Module'Access);
--
package AWA.Comments.Modules is

   NAME : constant String := "comments";

   Not_Found : exception;

   --  The <tt>Comment_Lifecycle</tt> package allows to receive life cycle events related
   --  to the <tt>Comment</tt> object.
   package Comment_Lifecycle is
     new AWA.Modules.Lifecycles (Element_Type => AWA.Comments.Models.Comment_Ref'Class);

   type Comment_Module is new AWA.Modules.Module with null record;
   type Comment_Module_Access is access all Comment_Module'Class;

   overriding
   procedure Initialize (Plugin : in out Comment_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Load the comment identified by the given identifier.
   procedure Load_Comment (Model   : in Comment_Module;
                           Comment : in out AWA.Comments.Models.Comment_Ref'Class;
                           Id      : in ADO.Identifier);

   --  Create a new comment for the associated database entity.
   procedure Create_Comment (Model       : in Comment_Module;
                             Permission  : in String;
                             Entity_Type : in String;
                             Comment     : in out AWA.Comments.Models.Comment_Ref'Class);

   --  Update the comment represented by <tt>Comment</tt> if the current user has the
   --  permission identified by <tt>Permission</tt>.
   procedure Update_Comment (Model       : in Comment_Module;
                             Permission  : in String;
                             Comment     : in out AWA.Comments.Models.Comment_Ref'Class);

   --  Delete the comment represented by <tt>Comment</tt> if the current user has the
   --  permission identified by <tt>Permission</tt>.
   procedure Delete_Comment (Model       : in Comment_Module;
                             Permission  : in String;
                             Comment     : in out AWA.Comments.Models.Comment_Ref'Class);

   --  Set the publication status of the comment represented by <tt>Comment</tt>
   --  if the current user has the permission identified by <tt>Permission</tt>.
   procedure Publish_Comment (Model       : in Comment_Module;
                              Permission  : in String;
                              Id          : in ADO.Identifier;
                              Status      : in AWA.Comments.Models.Status_Type;
                              Comment     : in out AWA.Comments.Models.Comment_Ref'Class);

   function Get_Comment_Module is
     new AWA.Modules.Get (Comment_Module, Comment_Module_Access, NAME);

end AWA.Comments.Modules;

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

with ADO;
with AWA.Modules;
with AWA.Modules.Get;
with AWA.Modules.Lifecycles;
with AWA.Comments.Models;

--  == Integration ==
--  The <tt>Comment_Module</tt> manages the comments associated with entities.  It provides
--  operations that are used by the comment beans to manage the comments.
--  An instance of the <tt>Comment_Module</tt> must be declared and registered in the
--  AWA application.  The module instance can be defined as follows:
--
--    type Application is new AWA.Applications.Application with record
--       Comment_Module : aliased AWA.Comments.Modules.Comment_Module;
--    end record;
--
--  And registered in the `Initialize_Modules` procedure by using:
--
--    Register (App    => App.Self.all'Access,
--              Name   => AWA.Comments.Modules.NAME,
--              URI    => "comments",
--              Module => App.Comment_Module'Access);
--
package AWA.Comments.Modules is

   NAME : constant String := "comments";

   Not_Found : exception;

   --  The <tt>Comment_Lifecycle</tt> package allows to receive life cycle events related
   --  to the <tt>Comment</tt> object.
   package Comment_Lifecycle is
     new AWA.Modules.Lifecycles (Element_Type => AWA.Comments.Models.Comment_Ref'Class);

   subtype Listener is Comment_Lifecycle.Listener;

   type Comment_Module is new AWA.Modules.Module with null record;
   type Comment_Module_Access is access all Comment_Module'Class;

   overriding
   procedure Initialize (Plugin : in out Comment_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Load the comment identified by the given identifier.
   procedure Load_Comment (Model   : in Comment_Module;
                           Comment : in out AWA.Comments.Models.Comment_Ref'Class;
                           Id      : in ADO.Identifier);

   --  Create a new comment for the associated database entity.
   procedure Create_Comment (Model       : in Comment_Module;
                             Permission  : in String;
                             Entity_Type : in String;
                             Comment     : in out AWA.Comments.Models.Comment_Ref'Class);

   --  Update the comment represented by <tt>Comment</tt> if the current user has the
   --  permission identified by <tt>Permission</tt>.
   procedure Update_Comment (Model       : in Comment_Module;
                             Permission  : in String;
                             Comment     : in out AWA.Comments.Models.Comment_Ref'Class);

   --  Delete the comment represented by <tt>Comment</tt> if the current user has the
   --  permission identified by <tt>Permission</tt>.
   procedure Delete_Comment (Model       : in Comment_Module;
                             Permission  : in String;
                             Comment     : in out AWA.Comments.Models.Comment_Ref'Class);

   --  Set the publication status of the comment represented by <tt>Comment</tt>
   --  if the current user has the permission identified by <tt>Permission</tt>.
   procedure Publish_Comment (Model       : in Comment_Module;
                              Permission  : in String;
                              Id          : in ADO.Identifier;
                              Status      : in AWA.Comments.Models.Status_Type;
                              Comment     : in out AWA.Comments.Models.Comment_Ref'Class);

   function Get_Comment_Module is
     new AWA.Modules.Get (Comment_Module, Comment_Module_Access, NAME);

end AWA.Comments.Modules;

Define the subtype Listener

Define the subtype Listener


------------------------------------------------------------------------------
--                                                                          --
--                        Copyright (C) 2016, AdaCore                       --
--                                                                          --
--  Redistribution and use in source and binary forms, with or without      --
--  modification, are permitted provided that the following conditions are  --
--  met:                                                                    --
--     1. Redistributions of source code must retain the above copyright    --
--        notice, this list of conditions and the following disclaimer.     --
--     2. Redistributions in binary form must reproduce the above copyright --
--        notice, this list of conditions and the following disclaimer in   --
--        the documentation and/or other materials provided with the        --
--        distribution.                                                     --
--     3. Neither the name of the copyright holder nor the names of its     --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
--                                                                          --
------------------------------------------------------------------------------

with nRF51.Tasks;
with nRF51.Events;
with nRF51.Radio;     use nRF51.Radio;
with NRF51_SVD.RADIO; use NRF51_SVD.RADIO;
with nRF51.Clock;     use nRF51.Clock;

with Bluetooth_Low_Energy.Packets; use Bluetooth_Low_Energy.Packets;
with Bluetooth_Low_Energy;         use Bluetooth_Low_Energy;
with Bluetooth_Low_Energy.Beacon;  use Bluetooth_Low_Energy.Beacon;

with HAL; use HAL;

package body Beacon is

   Current_Adv_Channel : BLE_Advertising_Channel_Number := 37;
   Beacon_Packet       : BLE_Packet;

   ----------------------
   -- Initialize_Radio --
   ----------------------

   procedure Initialize_Radio is
      Beacon_UUID : constant BLE_UUID :=
        Make_UUID ((1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16));
   begin

      Beacon_Packet := Make_Beacon_Packet (UUID  => Beacon_UUID,
                                           Major => 0,
                                           Minor => 0,
                                           Power => 0);

      --  Setup high frequency clock for BLE transmission
      Set_High_Freq_Source (HFCLK_RC);
      Start_High_Freq;
      while not High_Freq_Running loop
         null;
      end loop;

      --  Setup radio module for BLE
      Setup_For_Bluetooth_Low_Energy;

      --  Set BLE advertising address
      Set_Logic_Addresses (Base0 => 16#89_BE_D6_00#,
                           Base1 => 16#00_00_00_00#,
                           Base_Length_In_Byte => 3,
                           AP0   => 16#8E#,
                           AP1   => 16#00#,
                           AP2   => 16#00#,
                           AP3   => 16#00#,
                           AP4   => 16#00#,
                           AP5   => 16#00#,
                           AP6   => 16#00#,
                           AP7   => 16#00#);

      --  Select logic address
      Set_TX_Address (0);

      --  Transmission power
      Set_Power (Zero_Dbm);

      --  Enable shortcuts for easier radio operation
      Enable_Shortcut (Ready_To_Start);
      Enable_Shortcut (End_To_Disable);
   end Initialize_Radio;

   ------------------------
   -- Send_Beacon_Packet --
   ------------------------

   procedure Send_Beacon_Packet is
   begin
      Configure_Whitening (True, UInt6 (Current_Adv_Channel));

      Set_Frequency
        (Radio_Frequency_MHz (Channel_Frequency (Current_Adv_Channel)));

      if Current_Adv_Channel /= BLE_Advertising_Channel_Number'Last then
         Current_Adv_Channel := Current_Adv_Channel + 1;
      else
         Current_Adv_Channel := BLE_Advertising_Channel_Number'First;
      end if;

      --  Set TX packet address
      Set_Packet (Get_Address (Beacon_Packet));

      --  Clear all events
      nRF51.Events.Clear (nRF51.Events.Radio_DISABLED);
      nRF51.Events.Clear (nRF51.Events.Radio_ADDRESS);
      nRF51.Events.Clear (nRF51.Events.Radio_PAYLOAD);
      nRF51.Events.Clear (nRF51.Events.Radio_END);

      --  Start transmission
      nRF51.Tasks.Trigger (nRF51.Tasks.Radio_TXEN);

      --  Wait for end of transmission
      while not nRF51.Events.Triggered (nRF51.Events.Radio_DISABLED) loop
         null;
      end loop;
   end Send_Beacon_Packet;

end Beacon;

------------------------------------------------------------------------------
--                                                                          --
--                        Copyright (C) 2016, AdaCore                       --
--                                                                          --
--  Redistribution and use in source and binary forms, with or without      --
--  modification, are permitted provided that the following conditions are  --
--  met:                                                                    --
--     1. Redistributions of source code must retain the above copyright    --
--        notice, this list of conditions and the following disclaimer.     --
--     2. Redistributions in binary form must reproduce the above copyright --
--        notice, this list of conditions and the following disclaimer in   --
--        the documentation and/or other materials provided with the        --
--        distribution.                                                     --
--     3. Neither the name of the copyright holder nor the names of its     --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
--                                                                          --
------------------------------------------------------------------------------

with nRF51.Tasks;
with nRF51.Events;
with nRF51.Radio;     use nRF51.Radio;
with NRF51_SVD.RADIO; use NRF51_SVD.RADIO;
with nRF51.Clock;     use nRF51.Clock;

with Bluetooth_Low_Energy.Packets; use Bluetooth_Low_Energy.Packets;
with Bluetooth_Low_Energy;         use Bluetooth_Low_Energy;
with Bluetooth_Low_Energy.Beacon;  use Bluetooth_Low_Energy.Beacon;

with HAL; use HAL;

package body Beacon is

   Current_Adv_Channel : BLE_Advertising_Channel_Number := 37;
   Beacon_Packet       : BLE_Packet;

   ----------------------
   -- Initialize_Radio --
   ----------------------

   procedure Initialize_Radio is
      Beacon_UUID : constant BLE_UUID :=
        Make_UUID ((1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16));
   begin

      Beacon_Packet := Make_Beacon_Packet (UUID  => Beacon_UUID,
                                           Major => 0,
                                           Minor => 0,
                                           Power => 0);

      --  Setup high frequency clock for BLE transmission
      Set_High_Freq_Source (HFCLK_RC);
      Start_High_Freq;
      while not High_Freq_Running loop
         null;
      end loop;

      --  Setup radio module for BLE
      Setup_For_Bluetooth_Low_Energy;

      --  Set BLE advertising address
      Set_Logic_Addresses (Base0 => 16#89_BE_D6_00#,
                           Base1 => 16#00_00_00_00#,
                           Base_Length_In_Byte => 3,
                           AP0   => 16#8E#,
                           AP1   => 16#00#,
                           AP2   => 16#00#,
                           AP3   => 16#00#,
                           AP4   => 16#00#,
                           AP5   => 16#00#,
                           AP6   => 16#00#,
                           AP7   => 16#00#);

      --  Select logic address
      Set_TX_Address (0);

      --  Transmission power
      Set_Power (Zero_Dbm);

      --  Enable shortcuts for easier radio operation
      Enable_Shortcut (Ready_To_Start);
      Enable_Shortcut (End_To_Disable);
   end Initialize_Radio;

   ------------------------
   -- Send_Beacon_Packet --
   ------------------------

   procedure Send_Beacon_Packet is
   begin
      Configure_Whitening (True, UInt6 (Current_Adv_Channel));

      Set_Frequency
        (Radio_Frequency_MHz (Channel_Frequency (Current_Adv_Channel)));

      if Current_Adv_Channel /= BLE_Advertising_Channel_Number'Last then
         Current_Adv_Channel := Current_Adv_Channel + 1;
      else
         Current_Adv_Channel := BLE_Advertising_Channel_Number'First;
      end if;

      --  Set TX packet address
      Set_Packet (Memory_Address (Beacon_Packet));

      --  Clear all events
      nRF51.Events.Clear (nRF51.Events.Radio_DISABLED);
      nRF51.Events.Clear (nRF51.Events.Radio_ADDRESS);
      nRF51.Events.Clear (nRF51.Events.Radio_PAYLOAD);
      nRF51.Events.Clear (nRF51.Events.Radio_END);

      --  Start transmission
      nRF51.Tasks.Trigger (nRF51.Tasks.Radio_TXEN);

      --  Wait for end of transmission
      while not nRF51.Events.Triggered (nRF51.Events.Radio_DISABLED) loop
         null;
      end loop;
   end Send_Beacon_Packet;

end Beacon;

Fix compilation error

MicroBit: Fix compilation error


-----------------------------------------------------------------------
--  asf-rest -- REST Support
--  Copyright (C) 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with ASF.Routes;
with ASF.Routes.Servlets.Rest;
with ASF.Servlets.Rest;
with EL.Contexts.Default;
with Util.Log.Loggers;
package body ASF.Rest is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ASF.Rest");

   --  ------------------------------
   --  Get the permission index associated with the REST operation.
   --  ------------------------------
   function Get_Permission (Handler : in Descriptor)
                            return Security.Permissions.Permission_Index is
   begin
      return Handler.Permission;
   end Get_Permission;

   --  ------------------------------
   --  Register the API descriptor in a list.
   --  ------------------------------
   procedure Register (List : in out Descriptor_Access;
                       Item : in Descriptor_Access) is
   begin
      Item.Next := List;
      List := Item;
   end Register;

   --  ------------------------------
   --  Register the list of API descriptors for a given servlet and a root path.
   --  ------------------------------
   procedure Register (Registry  : in out ASF.Servlets.Servlet_Registry;
                       Name      : in String;
                       URI       : in String;
                       ELContext : in EL.Contexts.ELContext'Class;
                       List      : in Descriptor_Access) is
      procedure Insert (Route : in out ASF.Routes.Route_Type_Ref);
      use type ASF.Routes.Route_Type_Access;
      Item : Descriptor_Access := List;

      procedure Insert (Route : in out ASF.Routes.Route_Type_Ref) is
         R : constant ASF.Routes.Route_Type_Access := Route.Value;
         D : ASF.Routes.Servlets.Rest.API_Route_Type_Access;
      begin
         if R /= null then
            if not (R.all in ASF.Routes.Servlets.Rest.API_Route_Type'Class) then
               Log.Error ("Route API for {0}/{1} already used by another page",
                          URI, Item.Pattern.all);
               return;
            end if;
            D := ASF.Routes.Servlets.Rest.API_Route_Type (R.all)'Access;
         else
            D := ASF.Servlets.Rest.Create_Route (Registry, Name);
            Route := ASF.Routes.Route_Type_Refs.Create (D.all'Access);
         end if;
         if D.Descriptors (Item.Method) /= null then
            Log.Error ("Route API for {0}/{1} is already used", URI, Item.Pattern.all);
         end if;
         D.Descriptors (Item.Method) := Item;
      end Insert;

   begin
      Log.Info ("Adding API route {0}", URI);
      while Item /= null loop
         Log.Debug ("Adding API route {0}/{1}", URI, Item.Pattern.all);
         Registry.Add_Route (URI & "/" & Item.Pattern.all, ELContext, Insert'Access);
         Item := Item.Next;
      end loop;
   end Register;

   --  Dispatch the request to the API handler.
   overriding
   procedure Dispatch (Handler : in Static_Descriptor;
                       Req     : in out ASF.Rest.Request'Class;
                       Reply   : in out ASF.Rest.Response'Class;
                       Stream  : in out Output_Stream'Class) is
   begin
      Handler.Handler (Req, Reply, Stream);
   end Dispatch;

   --  Register the API definition in the servlet registry.
   procedure Register (Registry   : in out ASF.Servlets.Servlet_Registry'Class;
                       Definition : in Descriptor_Access) is
      use type ASF.Routes.Route_Type_Access;
      use type ASF.Servlets.Servlet_Access;

      Dispatcher : constant ASF.Servlets.Request_Dispatcher
         := Registry.Get_Request_Dispatcher (Definition.Pattern.all);
      Servlet    : ASF.Servlets.Servlet_Access := ASF.Servlets.Get_Servlet (Dispatcher);

      procedure Insert (Route : in out ASF.Routes.Route_Type_Ref) is
         R : constant ASF.Routes.Route_Type_Access := Route.Value;
         D : ASF.Routes.Servlets.Rest.API_Route_Type_Access;
      begin
         if R /= null then
            if not (R.all in ASF.Routes.Servlets.Rest.API_Route_Type'Class) then
               Log.Error ("Route API for {0} already used by another page",
                          Definition.Pattern.all);
               return;
            end if;
            D := ASF.Routes.Servlets.Rest.API_Route_Type (R.all)'Access;
         else
            D := ASF.Servlets.Rest.Create_Route (Servlet);
            Route := ASF.Routes.Route_Type_Refs.Create (D.all'Access);
         end if;
         if D.Descriptors (Definition.Method) /= null then
            Log.Error ("Route API for {0} is already used", Definition.Pattern.all);
         end if;
         D.Descriptors (Definition.Method) := Definition;
      end Insert;

      Ctx     : EL.Contexts.Default.Default_Context;
   begin
      if Servlet = null then
         Log.Error ("Cannot register REST operation {0}: no REST servlet",
                    Definition.Pattern.all);
         return;
      end if;
      Registry.Add_Route (Definition.Pattern.all, Ctx, Insert'Access);
   end Register;

end ASF.Rest;

-----------------------------------------------------------------------
--  asf-rest -- REST Support
--  Copyright (C) 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with ASF.Routes;
with ASF.Routes.Servlets.Rest;
with ASF.Servlets.Rest;
with EL.Contexts.Default;
with Util.Log.Loggers;
package body ASF.Rest is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ASF.Rest");

   --  ------------------------------
   --  Get the permission index associated with the REST operation.
   --  ------------------------------
   function Get_Permission (Handler : in Descriptor)
                            return Security.Permissions.Permission_Index is
   begin
      return Handler.Permission;
   end Get_Permission;

   --  ------------------------------
   --  Register the API descriptor in a list.
   --  ------------------------------
   procedure Register (List : in out Descriptor_Access;
                       Item : in Descriptor_Access) is
   begin
      Item.Next := List;
      List := Item;
   end Register;

   --  ------------------------------
   --  Register the list of API descriptors for a given servlet and a root path.
   --  ------------------------------
   procedure Register (Registry  : in out ASF.Servlets.Servlet_Registry;
                       Name      : in String;
                       URI       : in String;
                       ELContext : in EL.Contexts.ELContext'Class;
                       List      : in Descriptor_Access) is
      procedure Insert (Route : in out ASF.Routes.Route_Type_Ref);
      use type ASF.Routes.Route_Type_Access;
      Item : Descriptor_Access := List;

      procedure Insert (Route : in out ASF.Routes.Route_Type_Ref) is
         R : constant ASF.Routes.Route_Type_Access := Route.Value;
         D : ASF.Routes.Servlets.Rest.API_Route_Type_Access;
      begin
         if R /= null then
            if not (R.all in ASF.Routes.Servlets.Rest.API_Route_Type'Class) then
               Log.Error ("Route API for {0}/{1} already used by another page",
                          URI, Item.Pattern.all);
               return;
            end if;
            D := ASF.Routes.Servlets.Rest.API_Route_Type (R.all)'Access;
         else
            D := ASF.Servlets.Rest.Create_Route (Registry, Name);
            Route := ASF.Routes.Route_Type_Refs.Create (D.all'Access);
         end if;
         if D.Descriptors (Item.Method) /= null then
            Log.Error ("Route API for {0}/{1} is already used", URI, Item.Pattern.all);
         end if;
         D.Descriptors (Item.Method) := Item;
      end Insert;

   begin
      Log.Info ("Adding API route {0}", URI);
      while Item /= null loop
         Log.Debug ("Adding API route {0}/{1}", URI, Item.Pattern.all);
         Registry.Add_Route (URI & "/" & Item.Pattern.all, ELContext, Insert'Access);
         Item := Item.Next;
      end loop;
   end Register;

   --  Dispatch the request to the API handler.
   overriding
   procedure Dispatch (Handler : in Static_Descriptor;
                       Req     : in out ASF.Rest.Request'Class;
                       Reply   : in out ASF.Rest.Response'Class;
                       Stream  : in out Output_Stream'Class) is
   begin
      Handler.Handler (Req, Reply, Stream);
   end Dispatch;

   --  Register the API definition in the servlet registry.
   procedure Register (Registry   : in out ASF.Servlets.Servlet_Registry'Class;
                       Definition : in Descriptor_Access) is
      use type ASF.Routes.Route_Type_Access;
      use type ASF.Servlets.Servlet_Access;

      Dispatcher : constant ASF.Servlets.Request_Dispatcher
         := Registry.Get_Request_Dispatcher (Definition.Pattern.all);
      Servlet    : ASF.Servlets.Servlet_Access := ASF.Servlets.Get_Servlet (Dispatcher);

      procedure Insert (Route : in out ASF.Routes.Route_Type_Ref) is
         R : constant ASF.Routes.Route_Type_Access := Route.Value;
         D : ASF.Routes.Servlets.Rest.API_Route_Type_Access;
      begin
         if R /= null then
            if not (R.all in ASF.Routes.Servlets.Rest.API_Route_Type'Class) then
               Log.Error ("Route API for {0} already used by another page",
                          Definition.Pattern.all);
               D := ASF.Servlets.Rest.Create_Route (Servlet);
               Route := ASF.Routes.Route_Type_Refs.Create (D.all'Access);
            else
               D := ASF.Routes.Servlets.Rest.API_Route_Type (R.all)'Access;
            end if;
         else
            D := ASF.Servlets.Rest.Create_Route (Servlet);
            Route := ASF.Routes.Route_Type_Refs.Create (D.all'Access);
         end if;
         if D.Descriptors (Definition.Method) /= null then
            Log.Error ("Route API for {0} is already used", Definition.Pattern.all);
         end if;
         D.Descriptors (Definition.Method) := Definition;
      end Insert;

      Ctx     : EL.Contexts.Default.Default_Context;
   begin
      if Servlet = null then
         Log.Error ("Cannot register REST operation {0}: no REST servlet",
                    Definition.Pattern.all);
         return;
      end if;
      Registry.Add_Route (Definition.Pattern.all, Ctx, Insert'Access);
   end Register;

end ASF.Rest;

Allow to override the route mapping

Allow to override the route mapping


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

with EL.Objects;

package EL.Beans is

   --  Exception raised when the value identified by a name is not
   --  recognized.
   No_Value : exception;

   --  ------------------------------
   --  Read-only Bean interface.
   --  ------------------------------
   --  The ''Readonly_Bean'' interface allows to plug a complex
   --  runtime object to the expression resolver.  This interface
   --  must be implemented by any tagged record that should be
   --  accessed as a variable for an expression.
   --
   --  For example, if 'foo' is bound to an object implementing that
   --  interface, expressions like 'foo.name' will resolve to 'foo'
   --  and the 'Get_Value' method will be called with 'name'.
   --
   type Readonly_Bean is limited interface;
   type Readonly_Bean_Access is access all Readonly_Bean'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   function Get_Value (From : Readonly_Bean;
                       Name : String) return EL.Objects.Object is abstract;

   --  ------------------------------
   --  Bean interface.
   --  ------------------------------
   --  The ''Bean'' interface allows to modify a property value.
   type Bean is limited interface and Readonly_Bean;

   --  Set the value identified by the name.
   --  If the name cannot be found, the method should raise the No_Value
   --  exception.
   procedure Set_Value (From  : in out Bean;
                        Name  : in String;
                        Value : in EL.Objects.Object) is abstract;

   --  ------------------------------
   --  List of objects
   --  ------------------------------
   --  The <b>List_Bean</b> interface gives access to a list of objects.
   type List_Bean is limited interface and Readonly_Bean;
   type List_Bean_Access is access all List_Bean'Class;

   --  Get the number of elements in the list.
   function Get_Count (From : List_Bean) return Natural is abstract;

   --  Set the current row index.  Valid row indexes start at 1.
   procedure Set_Row_Index (From  : in out List_Bean;
                            Index : in Natural) is abstract;

   --  Get the element at the current row index.
   function Get_Row (From  : List_Bean) return EL.Objects.Object is abstract;

end EL.Beans;

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

with EL.Objects;

package EL.Beans is

   pragma Preelaborate;

   --  Exception raised when the value identified by a name is not
   --  recognized.
   No_Value : exception;

   --  ------------------------------
   --  Read-only Bean interface.
   --  ------------------------------
   --  The ''Readonly_Bean'' interface allows to plug a complex
   --  runtime object to the expression resolver.  This interface
   --  must be implemented by any tagged record that should be
   --  accessed as a variable for an expression.
   --
   --  For example, if 'foo' is bound to an object implementing that
   --  interface, expressions like 'foo.name' will resolve to 'foo'
   --  and the 'Get_Value' method will be called with 'name'.
   --
   type Readonly_Bean is limited interface;
   type Readonly_Bean_Access is access all Readonly_Bean'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   function Get_Value (From : Readonly_Bean;
                       Name : String) return EL.Objects.Object is abstract;

   --  ------------------------------
   --  Bean interface.
   --  ------------------------------
   --  The ''Bean'' interface allows to modify a property value.
   type Bean is limited interface and Readonly_Bean;

   --  Set the value identified by the name.
   --  If the name cannot be found, the method should raise the No_Value
   --  exception.
   procedure Set_Value (From  : in out Bean;
                        Name  : in String;
                        Value : in EL.Objects.Object) is abstract;

   --  ------------------------------
   --  List of objects
   --  ------------------------------
   --  The <b>List_Bean</b> interface gives access to a list of objects.
   type List_Bean is limited interface and Readonly_Bean;
   type List_Bean_Access is access all List_Bean'Class;

   --  Get the number of elements in the list.
   function Get_Count (From : List_Bean) return Natural is abstract;

   --  Set the current row index.  Valid row indexes start at 1.
   procedure Set_Row_Index (From  : in out List_Bean;
                            Index : in Natural) is abstract;

   --  Get the element at the current row index.
   function Get_Row (From  : List_Bean) return EL.Objects.Object is abstract;

end EL.Beans;

Add preelaborate pragma

Add preelaborate pragma


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

with Util.Test_Caller;

with ADO;

with Security.Contexts;

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

   use Util.Tests;
   use ADO;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Blogs.Services.Create_Blog",
                       Test_Create_Blog'Access);
      Caller.Add_Test (Suite, "Test AWA.Blogs.Services.Create_Post",
                       Test_Create_Post'Access);

   end Add_Tests;

   --  ------------------------------
   --  Test creation of a blog
   --  ------------------------------
   procedure Test_Create_Blog (T : in out Test) is
      Manager   : AWA.Blogs.Modules.Blog_Module_Access;
      Blog_Id   : ADO.Identifier;
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-blog@test.com");

      Manager := AWA.Blogs.Modules.Get_Blog_Module;
      Manager.Create_Blog (Workspace_Id => 0,
                           Title        => "My blog",
                           Result       => Blog_Id);
      T.Assert (Blog_Id > 0, "Invalid blog identifier");
   end Test_Create_Blog;

   --  ------------------------------
   --  Test creating and updating of a blog post
   --  ------------------------------
   procedure Test_Create_Post (T : in out Test) is
      Manager   : AWA.Blogs.Modules.Blog_Module_Access;
      Blog_Id   : ADO.Identifier;
      Post_Id   : ADO.Identifier;
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-blog-post@test.com");

      Manager := AWA.Blogs.Modules.Get_Blog_Module;
      Manager.Create_Blog (Workspace_Id => 0,
                           Title        => "My blog post",
                           Result       => Blog_Id);
      T.Assert (Blog_Id > 0, "Invalid blog identifier");

      for I in 1 .. 5 loop
         Manager.Create_Post (Blog_Id => Blog_Id,
                              Title   => "Testing blog title",
                              URI     => "testing-blog-title",
                              Text    => "The blog content",
                              Status  => AWA.Blogs.Models.POST_DRAFT,
                              Result  => Post_Id);
         T.Assert (Post_Id > 0, "Invalid post identifier");

         Manager.Update_Post (Post_Id => Post_Id,
                              Title   => "New blog post title",
                              URI     => "testing-blog-title",
                              Text    => "The new post content",
                              Status  => AWA.Blogs.Models.POST_DRAFT);

         --  Keep the last post in the database.
         exit when I = 5;

         Manager.Delete_Post (Post_Id => Post_Id);

         --  Verify that a Not_Found exception is raised if the post was deleted.
         begin
            Manager.Update_Post (Post_Id => Post_Id,
                                 Title   => "Something",
                                 Text    => "Content",
                                 URI     => "testing-blog-title",
                                 Status  => AWA.Blogs.Models.POST_DRAFT);
            T.Assert (False, "Exception Not_Found was not raised");
         exception
            when Not_Found =>
               null;
         end;

         --  Verify that a Not_Found exception is raised if the post was deleted.
         begin
            Manager.Delete_Post (Post_Id => Post_Id);
            T.Assert (False, "Exception Not_Found was not raised");
         exception
            when Not_Found =>
               null;
         end;
      end loop;

   end Test_Create_Post;

end AWA.Blogs.Modules.Tests;

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

with Util.Test_Caller;

with ADO;

with Security.Contexts;

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

   use Util.Tests;
   use ADO;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Blogs.Services.Create_Blog",
                       Test_Create_Blog'Access);
      Caller.Add_Test (Suite, "Test AWA.Blogs.Services.Create_Post",
                       Test_Create_Post'Access);

   end Add_Tests;

   --  ------------------------------
   --  Test creation of a blog
   --  ------------------------------
   procedure Test_Create_Blog (T : in out Test) is
      Manager   : AWA.Blogs.Modules.Blog_Module_Access;
      Blog_Id   : ADO.Identifier;
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-blog@test.com");

      Manager := AWA.Blogs.Modules.Get_Blog_Module;
      Manager.Create_Blog (Workspace_Id => 0,
                           Title        => "My blog",
                           Result       => Blog_Id);
      T.Assert (Blog_Id > 0, "Invalid blog identifier");
   end Test_Create_Blog;

   --  ------------------------------
   --  Test creating and updating of a blog post
   --  ------------------------------
   procedure Test_Create_Post (T : in out Test) is
      Manager   : AWA.Blogs.Modules.Blog_Module_Access;
      Blog_Id   : ADO.Identifier;
      Post_Id   : ADO.Identifier;
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-blog-post@test.com");

      Manager := AWA.Blogs.Modules.Get_Blog_Module;
      Manager.Create_Blog (Workspace_Id => 0,
                           Title        => "My blog post",
                           Result       => Blog_Id);
      T.Assert (Blog_Id > 0, "Invalid blog identifier");

      for I in 1 .. 5 loop
         Manager.Create_Post (Blog_Id => Blog_Id,
                              Title   => "Testing blog title",
                              URI     => "testing-blog-title",
                              Text    => "The blog content",
                              Comment => False,
                              Status  => AWA.Blogs.Models.POST_DRAFT,
                              Result  => Post_Id);
         T.Assert (Post_Id > 0, "Invalid post identifier");

         Manager.Update_Post (Post_Id => Post_Id,
                              Title   => "New blog post title",
                              URI     => "testing-blog-title",
                              Text    => "The new post content",
                              Comment => True,
                              Status  => AWA.Blogs.Models.POST_DRAFT);

         --  Keep the last post in the database.
         exit when I = 5;

         Manager.Delete_Post (Post_Id => Post_Id);

         --  Verify that a Not_Found exception is raised if the post was deleted.
         begin
            Manager.Update_Post (Post_Id => Post_Id,
                                 Title   => "Something",
                                 Text    => "Content",
                                 URI     => "testing-blog-title",
                                 Comment => True,
                                 Status  => AWA.Blogs.Models.POST_DRAFT);
            T.Assert (False, "Exception Not_Found was not raised");
         exception
            when Not_Found =>
               null;
         end;

         --  Verify that a Not_Found exception is raised if the post was deleted.
         begin
            Manager.Delete_Post (Post_Id => Post_Id);
            T.Assert (False, "Exception Not_Found was not raised");
         exception
            when Not_Found =>
               null;
         end;
      end loop;

   end Test_Create_Post;

end AWA.Blogs.Modules.Tests;

Update the unit tests

Update the unit tests