-------------------------------------------------------------------------------
--  Copyright (c) 2016 Daniel King
--
--  Permission is hereby granted, free of charge, to any person obtaining a
--  copy of this software and associated documentation files (the "Software"),
--  to deal in the Software without restriction, including without limitation
--  the rights to use, copy, modify, merge, publish, distribute, sublicense,
--  and/or sell copies of the Software, and to permit persons to whom the
--  Software is furnished to do so, subject to the following conditions:
--
--  The above copyright notice and this permission notice shall be included in
--  all copies or substantial portions of the Software.
--
--  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
--  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
--  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
--  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
--  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
--  FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
--  DEALINGS IN THE SOFTWARE.
-------------------------------------------------------------------------------

with DW1000.Types;

--  This package defines low-level procedures for interfacing with the DW1000
--  at the physical layer.
--
--  The body for this package is not included in this project as it is very
--  specific to the target hardware. Therefore, the body for this package
--  must be implemented by the user for their target board.
package DW1000.BSP
with SPARK_Mode => On,
  Abstract_State => (Device_State with External),
  Initializes    => Device_State
is

   procedure Reset_DW1000
     with Global => (Output => Device_State),
     Depends => (Device_State => null);
   --  Resets the DW1000 via the RSTn line.

   procedure Acknowledge_DW1000_IRQ
     with Global => (In_Out => Device_State);
   --  Acknowledge the IRQ request from the DW1000.
   --
   --  This should be called from the interrupt handler of the DW1000 IRQ line
   --  to acknowledge the interrupt.
   --
   --- Failure to call this procedure from the interrupt handler may result in
   --  an infinite interrupt loop.

   procedure Disable_DW1000_IRQ
     with Global => (In_Out => Device_State);
   --  Disables the DW1000 IRQ to prevent the DW1000 interrupt from being
   --  triggered.
   --
   --  Any IRQs requested after calling this function should be held pending
   --  until Enable_DW1000_IRQ is called.

   procedure Enable_DW1000_IRQ
     with Global => (In_Out => Device_State);
   --  Enables the DW1000 IRQ.

   procedure Use_Slow_SPI_Clock;
   --  Switch the BSP to use a slow SPI clock speed (no faster than 3 MHz).
   --
   --  The slow SPI clock speed should be used when the DW1000 is in the INIT
   --  state.

   procedure Use_Fast_SPI_Clock;
   --  Switch the BSP to use a faster SPI clock speed (no faster than 20 MHz).
   --
   --  The fast SPI clock speed can be used when the DW1000 has left the INIT
   --  state.

   procedure Write_Transaction(Header : in DW1000.Types.Byte_Array;
                               Data   : in DW1000.Types.Byte_Array)
     with Global => (In_Out => Device_State),
     Depends => (Device_State => + (Header, Data)),
     Pre => (Header'Length in 1 .. 3
             and Data'Length > 0);
   --  Perform a "write" transaction to the DW1000.
   --
   --  This procedure executes a write transaction by performing the following
   --  steps:z
   --     1. Select the DW1000 on the SPI bus.
   --     2. Send the transaction header bytes (1 .. 3 bytes) via the SPI
   --        interface.
   --     3. Send the transaction data (variable length) to the DW1000 via the
   --        SPI interface.
   --     4. Deselect the DW1000 on the SPI bus.
   --
   --  Note: This procedure must not block. I.e. the procedure must not use
   --  the 'delay until' statement, nor call any protected entries.

   procedure Read_Transaction(Header : in     DW1000.Types.Byte_Array;
                              Data   :    out DW1000.Types.Byte_Array)
     with Global => (In_Out => Device_State),
     Depends => (Device_State => + (Header, Data),
                 Data         => (Header, Device_State)),
     Pre => (Header'Length in 1 .. 3
             and Data'Length > 0);
   --  Perform a "read" transaction from the DW1000.
   --
   --  This procedure executes a write transaction by performing the following
   --  steps:
   --     1. Select the DW1000 on the SPI bus.
   --     2. Send the transaction header bytes (1 .. 3 bytes) via the SPI
   --        interface.
   --     3. Read the transaction data (variable length) from the DW1000 via
   --        the SPI interface, and write the received bytes to the 'Data' byte
   --        array.
   --     4. Deselect the DW1000 on the SPI bus.
   --
   --  Note: This procedure must not block. I.e. the procedure must not use
   --  the 'delay until' statement, nor call any protected entries.

end DW1000.BSP;

-------------------------------------------------------------------------------
--  Copyright (c) 2016 Daniel King
--
--  Permission is hereby granted, free of charge, to any person obtaining a
--  copy of this software and associated documentation files (the "Software"),
--  to deal in the Software without restriction, including without limitation
--  the rights to use, copy, modify, merge, publish, distribute, sublicense,
--  and/or sell copies of the Software, and to permit persons to whom the
--  Software is furnished to do so, subject to the following conditions:
--
--  The above copyright notice and this permission notice shall be included in
--  all copies or substantial portions of the Software.
--
--  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
--  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
--  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
--  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
--  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
--  FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
--  DEALINGS IN THE SOFTWARE.
-------------------------------------------------------------------------------

with DW1000.Types;

--  This package defines low-level procedures for interfacing with the DW1000
--  at the physical layer.
--
--  The body for this package is not included in this project as it is very
--  specific to the target hardware. Therefore, the body for this package
--  must be implemented by the user for their target board.
package DW1000.BSP
with SPARK_Mode => On,
  Abstract_State => (Device_State with External),
  Initializes    => Device_State
is

   procedure Reset_DW1000
     with Global => (Output => Device_State),
     Depends => (Device_State => null);
   --  Resets the DW1000 via the RSTn line.

   procedure Acknowledge_DW1000_IRQ
     with Global => (In_Out => Device_State);
   --  Acknowledge the IRQ request from the DW1000.
   --
   --  This should be called from the interrupt handler of the DW1000 IRQ line
   --  to acknowledge the interrupt.
   --
   --- Failure to call this procedure from the interrupt handler may result in
   --  an infinite interrupt loop.

   procedure Disable_DW1000_IRQ
     with Global => (In_Out => Device_State);
   --  Disables the DW1000 IRQ to prevent the DW1000 interrupt from being
   --  triggered.
   --
   --  Any IRQs requested after calling this function should be held pending
   --  until Enable_DW1000_IRQ is called.

   procedure Enable_DW1000_IRQ
     with Global => (In_Out => Device_State);
   --  Enables the DW1000 IRQ.

   procedure Use_Slow_SPI_Clock
     with Global => (In_Out => Device_State);
   --  Switch the BSP to use a slow SPI clock speed (no faster than 3 MHz).
   --
   --  The slow SPI clock speed should be used when the DW1000 is in the INIT
   --  state.

   procedure Use_Fast_SPI_Clock
     with Global => (In_Out => Device_State);
   --  Switch the BSP to use a faster SPI clock speed (no faster than 20 MHz).
   --
   --  The fast SPI clock speed can be used when the DW1000 has left the INIT
   --  state.

   procedure Write_Transaction(Header : in DW1000.Types.Byte_Array;
                               Data   : in DW1000.Types.Byte_Array)
     with Global => (In_Out => Device_State),
     Depends => (Device_State => + (Header, Data)),
     Pre => (Header'Length in 1 .. 3
             and Data'Length > 0);
   --  Perform a "write" transaction to the DW1000.
   --
   --  This procedure executes a write transaction by performing the following
   --  steps:z
   --     1. Select the DW1000 on the SPI bus.
   --     2. Send the transaction header bytes (1 .. 3 bytes) via the SPI
   --        interface.
   --     3. Send the transaction data (variable length) to the DW1000 via the
   --        SPI interface.
   --     4. Deselect the DW1000 on the SPI bus.
   --
   --  Note: This procedure must not block. I.e. the procedure must not use
   --  the 'delay until' statement, nor call any protected entries.

   procedure Read_Transaction(Header : in     DW1000.Types.Byte_Array;
                              Data   :    out DW1000.Types.Byte_Array)
     with Global => (In_Out => Device_State),
     Depends => (Device_State => + (Header, Data),
                 Data         => (Header, Device_State)),
     Pre => (Header'Length in 1 .. 3
             and Data'Length > 0);
   --  Perform a "read" transaction from the DW1000.
   --
   --  This procedure executes a write transaction by performing the following
   --  steps:
   --     1. Select the DW1000 on the SPI bus.
   --     2. Send the transaction header bytes (1 .. 3 bytes) via the SPI
   --        interface.
   --     3. Read the transaction data (variable length) from the DW1000 via
   --        the SPI interface, and write the received bytes to the 'Data' byte
   --        array.
   --     4. Deselect the DW1000 on the SPI bus.
   --
   --  Note: This procedure must not block. I.e. the procedure must not use
   --  the 'delay until' statement, nor call any protected entries.

end DW1000.BSP;

Add globals annotation to new BSP procedures


-----------------------------------------------------------------------
--  html -- ASF HTML Components
--  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;
with ASF.Components.Core;
with Util.Strings;
package body ASF.Components.Html.Text is

   use EL.Objects;

   TEXT_ATTRIBUTE_NAMES  : Util.Strings.String_Set.Set;

   LABEL_ATTRIBUTE_NAMES : Util.Strings.String_Set.Set;

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

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

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

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

   procedure Encode_Begin (UI      : in UILabel;
                           Context : in out Faces_Context'Class) is
      Writer : ResponseWriter_Access;
   begin
      if UI.Is_Rendered (Context) then
         Writer := Context.Get_Response_Writer;
         Writer.Start_Element ("label");
         UI.Render_Attributes (Context, TEXT_ATTRIBUTE_NAMES, Writer);
      end if;
   end Encode_Begin;

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

   type Object_Array is array (Positive range <>) of EL.Objects.Object;

   package Formats is
     new Util.Strings.Formats (Stream => Ada.Strings.Unbounded.Unbounded_String,
                               Char   => Character,
                               Input  => String,
                               Value  => EL.Objects.Object,
                               Value_List => Object_Array,
                               Put        => Ada.Strings.Unbounded.Append,
                               To_Input   => EL.Objects.To_String);

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

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

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

-----------------------------------------------------------------------
--  html -- ASF HTML Components
--  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;
with ASF.Components.Core;
with Util.Texts.Formats;
package body ASF.Components.Html.Text is

   use EL.Objects;

   TEXT_ATTRIBUTE_NAMES  : Util.Strings.String_Set.Set;

   LABEL_ATTRIBUTE_NAMES : Util.Strings.String_Set.Set;

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

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

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

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

   procedure Encode_Begin (UI      : in UILabel;
                           Context : in out Faces_Context'Class) is
      Writer : ResponseWriter_Access;
   begin
      if UI.Is_Rendered (Context) then
         Writer := Context.Get_Response_Writer;
         Writer.Start_Element ("label");
         UI.Render_Attributes (Context, TEXT_ATTRIBUTE_NAMES, Writer);
      end if;
   end Encode_Begin;

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

   type Object_Array is array (Positive range <>) of EL.Objects.Object;

   package Formats is
     new Util.Texts.Formats (Stream => Ada.Strings.Unbounded.Unbounded_String,
                               Char   => Character,
                               Input  => String,
                               Value  => EL.Objects.Object,
                               Value_List => Object_Array,
                               Put        => Ada.Strings.Unbounded.Append,
                               To_Input   => EL.Objects.To_String);

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

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

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

Update to use the Utils.Texts.Formats generic package


-----------------------------------------------------------------------
--  gen-integration-tests -- Tests for integration
--  Copyright (C) 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 Ada.Strings.Unbounded;
with Util.Tests;
package Gen.Integration.Tests is

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

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

   --  Change the working directory before running dynamo.
   overriding
   procedure Set_Up (T : in out Test);

   --  Restore the working directory after running dynamo.
   overriding
   procedure Tear_Down (T : in out Test);

   --  Execute the command and get the output in a string.
   procedure Execute (T       : in out Test;
                      Command : in String;
                      Result  : out Ada.Strings.Unbounded.Unbounded_String;
                      Status  : in Natural := 0);

   --  Test dynamo create-project command.
   procedure Test_Create_Project (T : in out Test);

   --  Test dynamo create-project command --ado.
   procedure Test_Create_ADO_Project (T : in out Test);

   --  Test project configure.
   procedure Test_Configure (T : in out Test);

   --  Test propset command.
   procedure Test_Change_Property (T : in out Test);

   --  Test add-module command.
   procedure Test_Add_Module (T : in out Test);

   --  Test add-model command.
   procedure Test_Add_Model (T : in out Test);

   --  Test add-module-operation command.
   procedure Test_Add_Module_Operation (T : in out Test);

   --  Test add-service command.
   procedure Test_Add_Service (T : in out Test);

   --  Test add-query command.
   procedure Test_Add_Query (T : in out Test);

   --  Test add-page command.
   procedure Test_Add_Page (T : in out Test);

   --  Test add-layout command.
   procedure Test_Add_Layout (T : in out Test);

   --  Test add-ajax-form command.
   procedure Test_Add_Ajax_Form (T : in out Test);

   --  Test generate command.
   procedure Test_Generate (T : in out Test);

   --  Test help command.
   procedure Test_Help (T : in out Test);

   --  Test dist command.
   procedure Test_Dist (T : in out Test);

   --  Test dist command.
   procedure Test_Info (T : in out Test);

   --  Test build-doc command.
   procedure Test_Build_Doc (T : in out Test);

   --  Test generate command with Hibernate XML mapping files.
   procedure Test_Generate_Hibernate (T : in out Test);

   --  Test generate command (XMI enum).
   procedure Test_Generate_XMI_Enum (T : in out Test);

   --  Test generate command (XMI Ada Bean).
   procedure Test_Generate_XMI_Bean (T : in out Test);

   --  Test generate command (XMI Ada Bean with inheritance).
   procedure Test_Generate_XMI_Bean_Table (T : in out Test);

   --  Test generate command (XMI Ada Table).
   procedure Test_Generate_XMI_Table (T : in out Test);

   --  Test generate command (XMI Associations between Tables).
   procedure Test_Generate_XMI_Association (T : in out Test);

   --  Test generate command using the ArgoUML file directly (runs unzip -cq and parse the output).
   procedure Test_Generate_Zargo_Association (T : in out Test);

   --  Test UML with several tables that have dependencies between each of them (non circular).
   procedure Test_Generate_Zargo_Dependencies (T : in out Test);

   --  Test UML with several tables in several packages (non circular).
   procedure Test_Generate_Zargo_Packages (T : in out Test);

   --  Test UML with several errors in the UML model.
   procedure Test_Generate_Zargo_Errors (T : in out Test);

   --  Test GNAT compilation of the final project.
   procedure Test_Build (T : in out Test);

   --  Test GNAT compilation of the generated model files.
   procedure Test_Build_Model (T : in out Test);

end Gen.Integration.Tests;

-----------------------------------------------------------------------
--  gen-integration-tests -- Tests for integration
--  Copyright (C) 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 Ada.Strings.Unbounded;
with Util.Tests;
package Gen.Integration.Tests is

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

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

   --  Change the working directory before running dynamo.
   overriding
   procedure Set_Up (T : in out Test);

   --  Restore the working directory after running dynamo.
   overriding
   procedure Tear_Down (T : in out Test);

   --  Execute the command and get the output in a string.
   procedure Execute (T       : in out Test;
                      Command : in String;
                      Result  : out Ada.Strings.Unbounded.Unbounded_String;
                      Status  : in Natural := 0);

   --  Test dynamo create-project command.
   procedure Test_Create_Project (T : in out Test);

   --  Test dynamo create-project command --ado.
   procedure Test_Create_ADO_Project (T : in out Test);

   --  Test dynamo create-project command --gtk.
   procedure Test_Create_GTK_Project (T : in out Test);

   --  Test project configure.
   procedure Test_Configure (T : in out Test);

   --  Test propset command.
   procedure Test_Change_Property (T : in out Test);

   --  Test add-module command.
   procedure Test_Add_Module (T : in out Test);

   --  Test add-model command.
   procedure Test_Add_Model (T : in out Test);

   --  Test add-module-operation command.
   procedure Test_Add_Module_Operation (T : in out Test);

   --  Test add-service command.
   procedure Test_Add_Service (T : in out Test);

   --  Test add-query command.
   procedure Test_Add_Query (T : in out Test);

   --  Test add-page command.
   procedure Test_Add_Page (T : in out Test);

   --  Test add-layout command.
   procedure Test_Add_Layout (T : in out Test);

   --  Test add-ajax-form command.
   procedure Test_Add_Ajax_Form (T : in out Test);

   --  Test generate command.
   procedure Test_Generate (T : in out Test);

   --  Test help command.
   procedure Test_Help (T : in out Test);

   --  Test dist command.
   procedure Test_Dist (T : in out Test);

   --  Test dist command.
   procedure Test_Info (T : in out Test);

   --  Test build-doc command.
   procedure Test_Build_Doc (T : in out Test);

   --  Test generate command with Hibernate XML mapping files.
   procedure Test_Generate_Hibernate (T : in out Test);

   --  Test generate command (XMI enum).
   procedure Test_Generate_XMI_Enum (T : in out Test);

   --  Test generate command (XMI Ada Bean).
   procedure Test_Generate_XMI_Bean (T : in out Test);

   --  Test generate command (XMI Ada Bean with inheritance).
   procedure Test_Generate_XMI_Bean_Table (T : in out Test);

   --  Test generate command (XMI Ada Table).
   procedure Test_Generate_XMI_Table (T : in out Test);

   --  Test generate command (XMI Associations between Tables).
   procedure Test_Generate_XMI_Association (T : in out Test);

   --  Test generate command using the ArgoUML file directly (runs unzip -cq and parse the output).
   procedure Test_Generate_Zargo_Association (T : in out Test);

   --  Test UML with several tables that have dependencies between each of them (non circular).
   procedure Test_Generate_Zargo_Dependencies (T : in out Test);

   --  Test UML with several tables in several packages (non circular).
   procedure Test_Generate_Zargo_Packages (T : in out Test);

   --  Test UML with several errors in the UML model.
   procedure Test_Generate_Zargo_Errors (T : in out Test);

   --  Test GNAT compilation of the final project.
   procedure Test_Build (T : in out Test);

   --  Test GNAT compilation of the generated model files.
   procedure Test_Build_Model (T : in out Test);

end Gen.Integration.Tests;

Add a simple test for gtk project generation


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

   --  Get the policy name.
   function Get_Name (From : in Policy) return String is
   begin
      return "";
   end Get_Name;

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

   --  ------------------------------
   --  Permission Manager
   --  ------------------------------

   --  ------------------------------
   --  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;
      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
   begin
      return False;
   end Has_Permission;

   --  ------------------------------
   --  Get the security controller associated with the permission index Index.
   --  Returns null if there is no such controller.
   --  ------------------------------
   function Get_Controller (Manager : in Policy_Manager'Class;
                            Index   : in Permissions.Permission_Index) return Controller_Access is
      use type Permissions.Permission_Index;
   begin
      if Index >= Manager.Last_Index then
         return null;
      else
         return Manager.Permissions (Index);
      end if;
   end Get_Controller;

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

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

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

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

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

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

   --  Finalize the permission manager.
   overriding
   procedure Finalize (Manager : in out Policy_Manager) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Security.Controllers.Controller'Class,
                                        Controller_Access);

      procedure Free is
        new Ada.Unchecked_Deallocation (Controller_Access_Array,
                                        Controller_Access_Array_Access);

   begin
      if Manager.Permissions /= null then
         for I in Manager.Permissions.all'Range loop
            exit when Manager.Permissions (I) = null;

            --  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 loop;
         Free (Manager.Permissions);
      end if;
   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");

   --  Get the policy name.
   function Get_Name (From : in Policy) return String is
   begin
      return "";
   end Get_Name;

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

   --  ------------------------------
   --  Permission Manager
   --  ------------------------------

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

   --  ------------------------------
   --  Get the security controller associated with the permission index Index.
   --  Returns null if there is no such controller.
   --  ------------------------------
   function Get_Controller (Manager : in Policy_Manager'Class;
                            Index   : in Permissions.Permission_Index) return Controller_Access is
      use type Permissions.Permission_Index;
   begin
      if Index >= Manager.Last_Index then
         return null;
      else
         return Manager.Permissions (Index);
      end if;
   end Get_Controller;

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

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

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

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

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

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

   --  Finalize the permission manager.
   overriding
   procedure Finalize (Manager : in out Policy_Manager) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Security.Controllers.Controller'Class,
                                        Controller_Access);

      procedure Free is
        new Ada.Unchecked_Deallocation (Controller_Access_Array,
                                        Controller_Access_Array_Access);

   begin
      if Manager.Permissions /= null then
         for I in Manager.Permissions.all'Range loop
            exit when Manager.Permissions (I) = null;

            --  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 loop;
         Free (Manager.Permissions);
      end if;
   end Finalize;

end Security.Policies;

Implement Has_Permission

Implement Has_Permission


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

with Ada.Containers.Hashed_Maps;
with Ada.Containers.Vectors;

with Util.Log.Loggers;
with Util.Strings;
with Util.Refs;
with Util.Beans.Objects;
with Util.Beans.Objects.Vectors;
with Util.Serialize.IO.XML;

with GNAT.Regexp;

with Security.Permissions;

package body Security.Policies is

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

   --  Get the policy name.
   function Get_Name (From : in Policy) return String is
   begin
      return "";
   end Get_Name;

   --  ------------------------------
   --  Permission Manager
   --  ------------------------------

   --  Add the policy to the policy manager.  After a policy is added in the manager,
   --  it can participate in the security policy.
   procedure Add_Policy (Manager : in out Policy_Manager;
                         Policy  : in Policy_Access) is
   begin
      null;
   end Add_Policy;

   procedure Add_Permission (Manager    : in out Policy_Manager;
                             Name       : in String;
                             Permission : in Controller_Access) is
   begin
      null;
   end Add_Permission;

   --  Get the security controller associated with the permission index <b>Index</b>.
   --  Returns null if there is no such controller.
   function Get_Controller (Manager : in Policy_Manager'Class;
                            Index   : in Permissions.Permission_Index) return Controller_Access is
      use type Permissions.Permission_Index;
   begin
      if Index >= Manager.Last_Index then
         return null;
      else
         return Manager.Permissions (Index);
      end if;
   end Get_Controller;

   --  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);
      package Role_Config is
        new Security.Controllers.Roles.Reader_Config (Reader, Manager'Unchecked_Access);
      pragma Warnings (Off, Policy_Config);
      pragma Warnings (Off, Role_Config);
   begin
      Log.Info ("Reading policy file {0}", File);

      Reader.Parse (File);

   end Read_Policy;

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

   --  Finalize the permission manager.
   overriding
   procedure Finalize (Manager : in out Policy_Manager) is
   begin
      null;
   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.Finalization;
with Ada.Strings.Unbounded;

with Ada.Containers.Hashed_Maps;
with Ada.Containers.Vectors;

with Util.Log.Loggers;
with Util.Strings;
with Util.Refs;
with Util.Beans.Objects;
with Util.Beans.Objects.Vectors;
with Util.Serialize.IO.XML;

with GNAT.Regexp;

with Security.Permissions;

package body Security.Policies is

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

   --  Get the policy name.
   function Get_Name (From : in Policy) return String is
   begin
      return "";
   end Get_Name;

   --  ------------------------------
   --  Permission Manager
   --  ------------------------------

   --  Add the policy to the policy manager.  After a policy is added in the manager,
   --  it can participate in the security policy.
   procedure Add_Policy (Manager : in out Policy_Manager;
                         Policy  : in Policy_Access) is
   begin
      null;
   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;
      Manager.Permissions (Index) := Permission;
   end Add_Permission;

   --  Get the security controller associated with the permission index <b>Index</b>.
   --  Returns null if there is no such controller.
   function Get_Controller (Manager : in Policy_Manager'Class;
                            Index   : in Permissions.Permission_Index) return Controller_Access is
      use type Permissions.Permission_Index;
   begin
      if Index >= Manager.Last_Index then
         return null;
      else
         return Manager.Permissions (Index);
      end if;
   end Get_Controller;

   --  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);
--        package Role_Config is
--          new Security.Controllers.Roles.Reader_Config (Reader, Manager'Unchecked_Access);
      pragma Warnings (Off, Policy_Config);
--        pragma Warnings (Off, Role_Config);
   begin
      Log.Info ("Reading policy file {0}", File);

      Reader.Parse (File);

   end Read_Policy;

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

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

end Security.Policies;

Implement Add_Permission

Implement Add_Permission


-----------------------------------------------------------------------
--  util-processes-os -- System specific and low level operations
--  Copyright (C) 2011, 2012, 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 Util.Streams.Raw;
with Util.Systems.Os;
with Interfaces.C;
with Interfaces.C.Strings;

private package Util.Processes.Os is

   SHELL : constant String := "/bin/sh";

   type System_Process is new Util.Processes.System_Process with record
      Argv       : Util.Systems.Os.Ptr_Ptr_Array := null;
      Argc       : Interfaces.C.size_t := 0;
      In_File    : Util.Systems.Os.Ptr := Interfaces.C.Strings.Null_Ptr;
      Out_File   : Util.Systems.Os.Ptr := Interfaces.C.Strings.Null_Ptr;
      Err_File   : Util.Systems.Os.Ptr := Interfaces.C.Strings.Null_Ptr;
      Out_Append : Boolean := False;
      Err_Append : Boolean := False;
   end record;

   --  Wait for the process to exit.
   overriding
   procedure Wait (Sys     : in out System_Process;
                   Proc    : in out Process'Class;
                   Timeout : in Duration);

   --  Terminate the process by sending a signal on Unix and exiting the process on Windows.
   --  This operation is not portable and has a different behavior between Unix and Windows.
   --  Its intent is to stop the process.
   overriding
   procedure Stop (Sys    : in out System_Process;
                   Proc   : in out Process'Class;
                   Signal : in Positive := 15);

   --  Spawn a new process.
   overriding
   procedure Spawn (Sys  : in out System_Process;
                    Proc : in out Process'Class;
                    Mode : in Pipe_Mode := NONE);

   --  Append the argument to the process argument list.
   overriding
   procedure Append_Argument (Sys : in out System_Process;
                              Arg : in String);

   --  Set the process input, output and error streams to redirect and use specified files.
   overriding
   procedure Set_Streams (Sys           : in out System_Process;
                          Input         : in String;
                          Output        : in String;
                          Error         : in String;
                          Append_Output : in Boolean;
                          Append_Error  : in Boolean);

   --  Deletes the storage held by the system process.
   overriding
   procedure Finalize (Sys : in out System_Process);

private

   --  Create the output stream to read/write on the process input/output.
   --  Setup the file to be closed on exec.
   function Create_Stream (File : in Util.Systems.Os.File_Type)
                           return Util.Streams.Raw.Raw_Stream_Access;

end Util.Processes.Os;

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

with Util.Streams.Raw;
with Util.Systems.Os;
with Interfaces.C;
with Interfaces.C.Strings;

private package Util.Processes.Os is

   SHELL : constant String := "/bin/sh";

   type System_Process is new Util.Processes.System_Process with record
      Argv       : Util.Systems.Os.Ptr_Ptr_Array := null;
      Argc       : Interfaces.C.size_t := 0;
      In_File    : Util.Systems.Os.Ptr := Interfaces.C.Strings.Null_Ptr;
      Out_File   : Util.Systems.Os.Ptr := Interfaces.C.Strings.Null_Ptr;
      Err_File   : Util.Systems.Os.Ptr := Interfaces.C.Strings.Null_Ptr;
      To_Close   : File_Type_Array_Access;
      Out_Append : Boolean := False;
      Err_Append : Boolean := False;
   end record;

   --  Wait for the process to exit.
   overriding
   procedure Wait (Sys     : in out System_Process;
                   Proc    : in out Process'Class;
                   Timeout : in Duration);

   --  Terminate the process by sending a signal on Unix and exiting the process on Windows.
   --  This operation is not portable and has a different behavior between Unix and Windows.
   --  Its intent is to stop the process.
   overriding
   procedure Stop (Sys    : in out System_Process;
                   Proc   : in out Process'Class;
                   Signal : in Positive := 15);

   --  Spawn a new process.
   overriding
   procedure Spawn (Sys  : in out System_Process;
                    Proc : in out Process'Class;
                    Mode : in Pipe_Mode := NONE);

   --  Append the argument to the process argument list.
   overriding
   procedure Append_Argument (Sys : in out System_Process;
                              Arg : in String);

   --  Set the process input, output and error streams to redirect and use specified files.
   overriding
   procedure Set_Streams (Sys           : in out System_Process;
                          Input         : in String;
                          Output        : in String;
                          Error         : in String;
                          Append_Output : in Boolean;
                          Append_Error  : in Boolean;
                          To_Close      : in File_Type_Array_Access);

   --  Deletes the storage held by the system process.
   overriding
   procedure Finalize (Sys : in out System_Process);

private

   --  Create the output stream to read/write on the process input/output.
   --  Setup the file to be closed on exec.
   function Create_Stream (File : in Util.Systems.Os.File_Type)
                           return Util.Streams.Raw.Raw_Stream_Access;

end Util.Processes.Os;

Add a To_Close parameter to Set_Streams

Add a To_Close parameter to Set_Streams


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

with Util.Log.Loggers;
package body MAT.Events.Gtkmat is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Events.Gtkmat");

   package Event_Cb is
     new Gtk.Handlers.Return_Callback (Gtk.Drawing_Area.Gtk_Drawing_Area_Record,
                                            Boolean);

   Target : Event_Drawing_Type_Access;

   function Redraw (Area : access Gtk.Drawing_Area.Gtk_Drawing_Area_Record'Class;
                    Cr   : in Cairo.Cairo_Context) return Boolean is
   begin
      Draw (Target.all, Cr);
      return False;
   end Redraw;

   procedure Create (Drawing : in out Event_Drawing_Type) is
   begin
      Target := Drawing'Unrestricted_Access;
      Gtk.Drawing_Area.Gtk_New (Drawing.Drawing);
      Event_Cb.Connect (Drawing.Drawing, Gtk.Widget.Signal_Draw,
                        Event_Cb.To_Marshaller (Redraw'Access)); --  , Drawing'Unrestricted_Access);
   end Create;

   procedure Draw (Onto    : in Event_Drawing_Type;
                   Cr : in Cairo.Cairo_Context) is
      use type Glib.Gdouble;

      type Thread_Ref_Array is array (1 .. 10) of MAT.Types.Target_Thread_Ref;

      Iter : MAT.Events.Targets.Target_Event_Cursor;

      Threads : Thread_Ref_Array := (others => 0);
      Start   : MAT.Types.Target_Tick_Ref;
      Finish  : MAT.Types.Target_Tick_Ref;
      Time_F  : Glib.Gdouble;
      Thread_F : Glib.Gdouble;

      function Get_Thread_Index (Thread : in MAT.Types.Target_Thread_Ref) return Natural is
      begin
         for I in Thread_Ref_Array'Range loop
            if Threads (I) = Thread then
               return I;
            end if;
            if Threads (I) = 0 then
               Threads (I) := Thread;
               return I;
            end if;
         end loop;
         return Threads'Last;
      end Get_Thread_Index;

      function Get_Time_Pos (Time : in MAT.Types.Target_Tick_Ref) return Glib.Gdouble is
         Dt : constant MAT.Types.Target_Tick_Ref := Time - Start;
      begin
         return Time_F * Glib.Gdouble (Dt);
      end Get_Time_Pos;

      function Get_Thread_Pos (Thread : in  MAT.Types.Target_Thread_Ref) return Glib.Gdouble is
         Pos : Natural := Get_Thread_Index (Thread);
      begin
         return Thread_F * Glib.Gdouble (Pos);
      end Get_Thread_Pos;

      Width  : Glib.Gint;
      Height : Glib.Gint;
   begin
      Log.Info ("Redraw events window");
      Cairo.Translate (Cr, 10.0, 10.0);
--        Cairo.Scale (Cr, 10.0, 10.0);

      if Onto.List.Is_Empty then
         return;
      end if;

      Width  := Onto.Drawing.Get_Allocated_Width;
      Height := Onto.Drawing.Get_Allocated_Height;
      Start  := Onto.List.First_Element.Time;
      Finish := Onto.List.Last_Element.Time;
      if Start = Finish then
         Time_F := 10.0;
      else
         Time_F := Glib.Gdouble (Width) / Glib.Gdouble (Finish - Start);
      end if;
      Thread_F := Glib.Gdouble (Height) / 10.0;
      Iter := Onto.List.First;
      while MAT.Events.Targets.Target_Event_Vectors.Has_Element (Iter) loop
         declare
            Event : MAT.Events.Targets.Target_Event
              := MAT.Events.Targets.Target_Event_Vectors.Element (Iter);
            Y : Glib.Gdouble := Get_Thread_Pos (Event.Thread);
            X : Glib.Gdouble := Get_Time_Pos (Event.Time);
         begin
            if Event.Event = 4 then
               Cairo.Set_Source_Rgb (Cr, Red => 0.0, Green => 0.0, Blue => 1.0);
            else
               Cairo.Set_Source_Rgb (Cr, Red => 1.0, Green => 0.0, Blue => 0.0);
            end if;
            Cairo.Move_To (Cr, X, Y);
            Cairo.Line_To (Cr, X, Y + 10.0);
            Cairo.Stroke (Cr);
         end;
         MAT.Events.Targets.Target_Event_Vectors.Next (Iter);
      end loop;
--        Cairo.Set_Source_Rgb (Cr, Red => 0.0, Green => 0.0, Blue => 0.0);
--        for I in 1 .. 10 loop
--           Cairo.Move_To (Cr, 10.0 * Glib.Gdouble (I), 0.0);
--           Cairo.Line_To (Cr, 10.0 * Glib.Gdouble (I), 2.0);
--           Cairo.Stroke (Cr);
--        end loop;
   end Draw;

end MAT.Events.Gtkmat;

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

with Util.Log.Loggers;
package body MAT.Events.Gtkmat is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Events.Gtkmat");

   package Event_Cb is
     new Gtk.Handlers.Return_Callback (Gtk.Drawing_Area.Gtk_Drawing_Area_Record,
                                            Boolean);

   Target : Event_Drawing_Type_Access;

   function Redraw (Area : access Gtk.Drawing_Area.Gtk_Drawing_Area_Record'Class;
                    Cr   : in Cairo.Cairo_Context) return Boolean is
   begin
      Draw (Target.all, Cr);
      return False;
   end Redraw;

   procedure Create (Drawing : in out Event_Drawing_Type) is
   begin
      Target := Drawing'Unrestricted_Access;
      Gtk.Drawing_Area.Gtk_New (Drawing.Drawing);
      Event_Cb.Connect (Drawing.Drawing, Gtk.Widget.Signal_Draw,
                        Event_Cb.To_Marshaller (Redraw'Access)); --  , Drawing'Unrestricted_Access);
   end Create;

   procedure Draw (Onto    : in Event_Drawing_Type;
                   Cr : in Cairo.Cairo_Context) is
      use type Glib.Gdouble;
      use type MAT.Types.Target_Tick_Ref;
      use type MAT.Types.Target_Thread_Ref;

      type Thread_Ref_Array is array (1 .. 10) of MAT.Types.Target_Thread_Ref;

      Iter : MAT.Events.Targets.Target_Event_Cursor;

      Threads : Thread_Ref_Array := (others => 0);
      Start   : MAT.Types.Target_Tick_Ref;
      Finish  : MAT.Types.Target_Tick_Ref;
      Time_F  : Glib.Gdouble;
      Thread_F : Glib.Gdouble;

      function Get_Thread_Index (Thread : in MAT.Types.Target_Thread_Ref) return Natural is
      begin
         for I in Thread_Ref_Array'Range loop
            if Threads (I) = Thread then
               return I;
            end if;
            if Threads (I) = 0 then
               Threads (I) := Thread;
               return I;
            end if;
         end loop;
         return Threads'Last;
      end Get_Thread_Index;

      function Get_Time_Pos (Time : in MAT.Types.Target_Tick_Ref) return Glib.Gdouble is
         Dt : constant MAT.Types.Target_Tick_Ref := Time - Start;
      begin
         return Time_F * Glib.Gdouble (Dt);
      end Get_Time_Pos;

      function Get_Thread_Pos (Thread : in  MAT.Types.Target_Thread_Ref) return Glib.Gdouble is
         Pos : Natural := Get_Thread_Index (Thread);
      begin
         return Thread_F * Glib.Gdouble (Pos);
      end Get_Thread_Pos;

      Width  : Glib.Gint;
      Height : Glib.Gint;
   begin
      Log.Info ("Redraw events window");
      Cairo.Translate (Cr, 10.0, 10.0);
--        Cairo.Scale (Cr, 10.0, 10.0);

      if Onto.List.Is_Empty then
         return;
      end if;

      Width  := Onto.Drawing.Get_Allocated_Width;
      Height := Onto.Drawing.Get_Allocated_Height;
      Start  := Onto.List.First_Element.Time;
      Finish := Onto.List.Last_Element.Time;
      if Start = Finish then
         Time_F := 10.0;
      else
         Time_F := Glib.Gdouble (Width) / Glib.Gdouble (Finish - Start);
      end if;
      Thread_F := Glib.Gdouble (Height) / 10.0;
      Iter := Onto.List.First;
      while MAT.Events.Targets.Target_Event_Vectors.Has_Element (Iter) loop
         declare
            Event : MAT.Events.Targets.Target_Event
              := MAT.Events.Targets.Target_Event_Vectors.Element (Iter);
            Y : Glib.Gdouble := Get_Thread_Pos (Event.Thread);
            X : Glib.Gdouble := Get_Time_Pos (Event.Time);
         begin
            if Event.Event = 4 then
               Cairo.Set_Source_Rgb (Cr, Red => 0.0, Green => 0.0, Blue => 1.0);
            else
               Cairo.Set_Source_Rgb (Cr, Red => 1.0, Green => 0.0, Blue => 0.0);
            end if;
            Cairo.Move_To (Cr, X, Y);
            Cairo.Line_To (Cr, X, Y + 10.0);
            Cairo.Stroke (Cr);
         end;
         MAT.Events.Targets.Target_Event_Vectors.Next (Iter);
      end loop;
--        Cairo.Set_Source_Rgb (Cr, Red => 0.0, Green => 0.0, Blue => 0.0);
--        for I in 1 .. 10 loop
--           Cairo.Move_To (Cr, 10.0 * Glib.Gdouble (I), 0.0);
--           Cairo.Line_To (Cr, 10.0 * Glib.Gdouble (I), 2.0);
--           Cairo.Stroke (Cr);
--        end loop;
   end Draw;

end MAT.Events.Gtkmat;

Update to use the MAT.Types.Target_Tick_Ref and Target_Thread_Ref


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

with Util.Strings;
with Util.Events;
with Util.Beans.Objects;
with Util.Beans.Basic;

with ASF.Applications;

--  == Introduction ==
--  The <b>AWA.Jobs</b> plugin defines a batch job framework for modules to perform and execute
--  long running and deferred actions.
--
--
--  == Data Model ==
--  @include jobs.hbm.xml
--
package AWA.Jobs is

end AWA.Jobs;

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

--  == Introduction ==
--  The AWA.Jobs plugin defines a batch job framework for modules to perform and execute
--  long running and deferred actions.  The `Jobs` plugin is intended to help web application
--  designers in implementing end to end asynchronous operation.  A client schedules a job
--  and does not block nor wait for the immediate completion.  Instead, the client asks
--  periodically or uses other mechanisms to check for the job completion.
--
--  === Writing a job ===
--  A new job type is created by implementing the `Execute` operation of the abstract
--  `Job_Type` tagged record.
--
--    type Resize_Job is new AWA.Jobs.Job_Type with ...;
--
--  The `Execute` procedure must be implemented.  It should use the `Get_Parameter` functions
--  to retrieve the job parameters and perform the work.  While the job is being executed,
--  it can save result by using the `Set_Result` operations, save messages by using the
--  `Set_Message` operations and report the progress by using `Set_Progress`.
--  It may report the job status by using `Set_Status`.
--
--    procedure Execute (Job : in out Resize_Job) is
--    begin
--        Job.Set_Result ("done", "ok");
--    end Execute;
--
--  === Registering a job ===
--  The AWA.Jobs plugin must be able to create the job instance when it is going to
--  be executed.  For this, a registration package must be instantiated:
--
--    package Resize_Def is new AWA.Jobs.Definition (Resize_Job);
--
--  === Scheduling a job ===
--  To schedule a job, declare an instance of the job to execute and set the job specific
--  parameters.  The job parameters will be saved in the database.  As soon as parameters
--  are defined, call the `Schedule` procedure to schedule the job in the job queue and
--  obtain a job identifier.
--
--    Resize : Resize_Job;
--    ...
--    Resize.Set_Parameter ("file", "image.png");
--    Resize.Set_Parameter ("width", "32");
--    Resize.Set_Parameter ("height, "32");
--    Resize.Schedule;
--
--  === Checking for job completion ===
--
--
--  == Data Model ==
--  @include jobs.hbm.xml
--
package AWA.Jobs is

end AWA.Jobs;

Document the new AWA jobs plugin

Document the new AWA jobs plugin


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

with Ada.Strings.Unbounded;

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

   type Vote_Bean is new AWA.Votes.Models.Vote_Bean with record
      Service : AWA.Votes.Services.Vote_Service_Access := null;
   end record;
   type Vote_Bean_Access is access all Vote_Bean'Class;

   --  Action to vote up.
   overriding
   procedure Vote_Up (Bean    : in out Vote_Bean;
                      Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Action to vote down.
   overriding
   procedure Vote_Down (Bean    : in out Vote_Bean;
                        Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Votes_Bean bean instance.
   function Create_Vote_Bean (Module : in AWA.Votes.Modules.Vote_Module_Access)
      return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Votes.Beans;

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

with Ada.Strings.Unbounded;

with Util.Beans.Basic;
with AWA.Votes.Modules;
with AWA.Votes.Models;
package AWA.Votes.Beans is

   type Vote_Bean is new AWA.Votes.Models.Vote_Bean with private;
   type Vote_Bean_Access is access all Vote_Bean'Class;

   --  Action to vote up.
   overriding
   procedure Vote_Up (Bean    : in out Vote_Bean;
                      Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Action to vote down.
   overriding
   procedure Vote_Down (Bean    : in out Vote_Bean;
                        Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Votes_Bean bean instance.
   function Create_Vote_Bean (Module : in AWA.Votes.Modules.Vote_Module_Access)
      return Util.Beans.Basic.Readonly_Bean_Access;

private

   type Vote_Bean is new AWA.Votes.Models.Vote_Bean with record
      Module : AWA.Votes.Modules.Vote_Module_Access := null;
   end record;

end AWA.Votes.Beans;

Use the vote module and make the Vote_Bean definition private