-----------------------------------------------------------------------
--  properties -- Generic name/value property management
--  Copyright (C) 2001, 2002, 2003, 2006, 2008, 2009, 2010, 2014, 2017, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Finalization;
with Ada.Text_IO;
with Util.Beans.Objects;
with Util.Beans.Basic;
with Util.Strings.Vectors;
private with Util.Concurrent.Counters;

--  = Property Files =
--  The `Util.Properties` package and children implements support to read, write and use
--  property files either in the Java property file format or the Windows INI configuration file.
--  Each property is assigned a key and a value.  The list of properties are stored in the
--  `Util.Properties.Manager` tagged record and they are indexed by the key name.  A property
--  is therefore unique in the list.  Properties can be grouped together in sub-properties so
--  that a key can represent another list of properties.
--
--  == File formats ==
--  The property file consists of a simple name and value pair separated by the `=` sign.
--  Thanks to the Windows INI file format, list of properties can be grouped together
--  in sections by using the `[section-name`] notation.
--
--    test.count=20
--    test.repeat=5
--    [FileTest]
--    test.count=5
--    test.repeat=2
--
--  == Using property files ==
--  An instance of the `Util.Properties.Manager` tagged record must be declared and it provides
--  various operations that can be used.  When created, the property manager is empty.  One way
--  to fill it is by using the `Load_Properties` procedure to read the property file.  Another
--  way is by using the `Set` procedure to insert or change a property by giving its name
--  and its value.
--
--  In this example, the property file `test.properties` is loaded and assuming that it contains
--  the above configuration example, the `Get ("test.count")` will return the string `"20"`.
--
--    with Util.Properties;
--    ...
--       Props : Util.Properties.Manager;
--       ...
--          Props.Load_Properties (Path => "test.properties");
--          Ada.Text_IO.Put_Line ("Count: " & Props.Get ("test.count");
--          Props.Set ("test.repeat", "23");
--          Props.Save_Properties (Path => "test.properties");
--
--  To be able to access a section from the property manager, it is necessary to retrieve it
--  by using the `Get` function and giving the section name.  For example, to retrieve the
--  `test.count` property of the `FileTest` section, the following code is used:
--
--       FileTest : Util.Properties.Manager := Props.Get ("FileTest");
--       ...
--          Ada.Text_IO.Put_Line ("[FileTest] Count: " & FileTest.Get ("test.count");
--
--  @include util-properties-json.ads
--  @include util-properties-bundles.ads
package Util.Properties is

   NO_PROPERTY : exception;

   use Ada.Strings.Unbounded;

   subtype Value is Util.Beans.Objects.Object;

   function "+" (S : String) return Unbounded_String renames To_Unbounded_String;

   function "-" (S : Unbounded_String) return String renames To_String;

   function To_String (V : in Value) return String
     renames Util.Beans.Objects.To_String;

   --  The manager holding the name/value pairs and providing the operations
   --  to get and set the properties.
   type Manager is new Ada.Finalization.Controlled and Util.Beans.Basic.Bean with private;
   type Manager_Access is access all Manager'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in Manager;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   --  If the map contains the given name, the value changed.
   --  Otherwise name is added to the map and the value associated with it.
   overriding
   procedure Set_Value (From  : in out Manager;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Returns TRUE if the property exists.
   function Exists (Self : in Manager'Class;
                    Name : in Unbounded_String) return Boolean;

   --  Returns TRUE if the property exists.
   function Exists (Self : in Manager'Class;
                    Name : in String) return Boolean;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in String) return String;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in String) return Unbounded_String;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in Unbounded_String) return Unbounded_String;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in Unbounded_String) return String;

   --  Returns the property value or Default if it does not exist.
   function Get (Self : in Manager'Class;
                 Name : in String;
                 Default : in String) return String;

   --  Returns a property manager that is associated with the given name.
   --  Raises NO_PROPERTY if there is no such property manager or if a property exists
   --  but is not a property manager.
   function Get (Self : in Manager'Class;
                 Name : in String) return Manager;

   --  Create a property manager and associated it with the given name.
   function Create (Self : in out Manager'Class;
                    Name : in String) return Manager;

   --  Set the value of the property.  The property is created if it
   --  does not exists.
   procedure Set (Self : in out Manager'Class;
                  Name : in String;
                  Item : in String);

   --  Set the value of the property.  The property is created if it
   --  does not exists.
   procedure Set (Self : in out Manager'Class;
                  Name : in String;
                  Item : in Unbounded_String);

   --  Set the value of the property.  The property is created if it
   --  does not exists.
   procedure Set (Self : in out Manager'Class;
                  Name : in Unbounded_String;
                  Item : in Unbounded_String);

   --  Remove the property given its name.  If the property does not
   --  exist, raises NO_PROPERTY exception.
   procedure Remove (Self : in out Manager'Class;
                     Name : in String);

   --  Remove the property given its name.  If the property does not
   --  exist, raises NO_PROPERTY exception.
   procedure Remove (Self : in out Manager'Class;
                     Name : in Unbounded_String);

   --  Iterate over the properties and execute the given procedure passing the
   --  property name and its value.
   procedure Iterate (Self    : in Manager'Class;
                      Process : access procedure (Name : in String;
                                                  Item : in Value));

   --  Collect the name of the properties defined in the manager.
   --  When a prefix is specified, only the properties starting with the prefix are
   --  returned.
   procedure Get_Names (Self   : in Manager;
                        Into   : in out Util.Strings.Vectors.Vector;
                        Prefix : in String := "");

   --  Load the properties from the file input stream.  The file must follow
   --  the definition of Java property files.  When a prefix is specified, keep
   --  only the properties that starts with the prefix.  When Strip is True,
   --  the prefix part is removed from the property name.
   procedure Load_Properties (Self   : in out Manager'Class;
                              File   : in Ada.Text_IO.File_Type;
                              Prefix : in String := "";
                              Strip  : in Boolean := False);

   --  Load the properties from the file.  The file must follow the
   --  definition of Java property files.  When a prefix is specified, keep
   --  only the properties that starts with the prefix.  When Strip is True,
   --  the prefix part is removed from the property name.
   --  Raises NAME_ERROR if the file does not exist.
   procedure Load_Properties (Self   : in out Manager'Class;
                              Path   : in String;
                              Prefix : in String := "";
                              Strip  : in Boolean := False);

   --  Save the properties in the given file path.
   procedure Save_Properties (Self   : in out Manager'Class;
                              Path   : in String;
                              Prefix : in String := "");

   --  Copy the properties from FROM which start with a given prefix.
   --  If the prefix is empty, all properties are copied.  When Strip is True,
   --  the prefix part is removed from the property name.
   procedure Copy (Self   : in out Manager'Class;
                   From   : in Manager'Class;
                   Prefix : in String := "";
                   Strip  : in Boolean := False);

   --  Get the property manager represented by the item value.
   --  Raise the Conversion_Error exception if the value is not a property manager.
   function To_Manager (Item : in Value) return Manager;

   --  Returns True if the item value represents a property manager.
   function Is_Manager (Item : in Value) return Boolean;

private

   --  Abstract interface for the implementation of Properties
   --  (this allows to decouples the implementation from the API)
   package Interface_P is

      type Manager is abstract limited new Util.Beans.Basic.Bean with record
         Count  : Util.Concurrent.Counters.Counter;
         Shared : Boolean := False;
      end record;
      type Manager_Access is access all Manager'Class;

      --  Returns TRUE if the property exists.
      function Exists (Self : in Manager;
                       Name : in String)
                       return Boolean is abstract;

      --  Remove the property given its name.
      procedure Remove (Self : in out Manager;
                        Name : in String) is abstract;

      --  Iterate over the properties and execute the given procedure passing the
      --  property name and its value.
      procedure Iterate (Self    : in Manager;
                         Process : access procedure (Name : in String;
                                                     Item : in Value))
      is abstract;

      --  Deep copy of properties stored in 'From' to 'To'.
      function Create_Copy (Self : in Manager)
                            return Manager_Access is abstract;

   end Interface_P;

   --  Create a property implementation if there is none yet.
   procedure Check_And_Create_Impl (Self : in out Manager);

   type Manager is new Ada.Finalization.Controlled and Util.Beans.Basic.Bean with record
      Impl : Interface_P.Manager_Access := null;
   end record;

   overriding
   procedure Adjust   (Object : in out Manager);

   overriding
   procedure Finalize (Object : in out Manager);

end Util.Properties;

-----------------------------------------------------------------------
--  util-properties -- Generic name/value property management
--  Copyright (C) 2001, 2002, 2003, 2006, 2008, 2009, 2010, 2014, 2017, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Finalization;
with Ada.Text_IO;
with Util.Beans.Objects;
with Util.Beans.Basic;
with Util.Strings.Vectors;
private with Util.Concurrent.Counters;

--  = Property Files =
--  The `Util.Properties` package and children implements support to read, write and use
--  property files either in the Java property file format or the Windows INI configuration file.
--  Each property is assigned a key and a value.  The list of properties are stored in the
--  `Util.Properties.Manager` tagged record and they are indexed by the key name.  A property
--  is therefore unique in the list.  Properties can be grouped together in sub-properties so
--  that a key can represent another list of properties.
--
--  == File formats ==
--  The property file consists of a simple name and value pair separated by the `=` sign.
--  Thanks to the Windows INI file format, list of properties can be grouped together
--  in sections by using the `[section-name`] notation.
--
--    test.count=20
--    test.repeat=5
--    [FileTest]
--    test.count=5
--    test.repeat=2
--
--  == Using property files ==
--  An instance of the `Util.Properties.Manager` tagged record must be declared and it provides
--  various operations that can be used.  When created, the property manager is empty.  One way
--  to fill it is by using the `Load_Properties` procedure to read the property file.  Another
--  way is by using the `Set` procedure to insert or change a property by giving its name
--  and its value.
--
--  In this example, the property file `test.properties` is loaded and assuming that it contains
--  the above configuration example, the `Get ("test.count")` will return the string `"20"`.
--
--    with Util.Properties;
--    ...
--       Props : Util.Properties.Manager;
--       ...
--          Props.Load_Properties (Path => "test.properties");
--          Ada.Text_IO.Put_Line ("Count: " & Props.Get ("test.count");
--          Props.Set ("test.repeat", "23");
--          Props.Save_Properties (Path => "test.properties");
--
--  To be able to access a section from the property manager, it is necessary to retrieve it
--  by using the `Get` function and giving the section name.  For example, to retrieve the
--  `test.count` property of the `FileTest` section, the following code is used:
--
--       FileTest : Util.Properties.Manager := Props.Get ("FileTest");
--       ...
--          Ada.Text_IO.Put_Line ("[FileTest] Count: " & FileTest.Get ("test.count");
--
--  @include util-properties-json.ads
--  @include util-properties-bundles.ads
package Util.Properties is

   NO_PROPERTY : exception;

   use Ada.Strings.Unbounded;

   subtype Value is Util.Beans.Objects.Object;

   function "+" (S : String) return Unbounded_String renames To_Unbounded_String;

   function "-" (S : Unbounded_String) return String renames To_String;

   function To_String (V : in Value) return String
     renames Util.Beans.Objects.To_String;

   --  The manager holding the name/value pairs and providing the operations
   --  to get and set the properties.
   type Manager is new Ada.Finalization.Controlled and Util.Beans.Basic.Bean with private;
   type Manager_Access is access all Manager'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in Manager;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   --  If the map contains the given name, the value changed.
   --  Otherwise name is added to the map and the value associated with it.
   overriding
   procedure Set_Value (From  : in out Manager;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Returns TRUE if the property exists.
   function Exists (Self : in Manager'Class;
                    Name : in Unbounded_String) return Boolean;

   --  Returns TRUE if the property exists.
   function Exists (Self : in Manager'Class;
                    Name : in String) return Boolean;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in String) return String;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in String) return Unbounded_String;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in Unbounded_String) return Unbounded_String;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in Unbounded_String) return String;

   --  Returns the property value or Default if it does not exist.
   function Get (Self : in Manager'Class;
                 Name : in String;
                 Default : in String) return String;

   --  Returns a property manager that is associated with the given name.
   --  Raises NO_PROPERTY if there is no such property manager or if a property exists
   --  but is not a property manager.
   function Get (Self : in Manager'Class;
                 Name : in String) return Manager;

   --  Create a property manager and associated it with the given name.
   function Create (Self : in out Manager'Class;
                    Name : in String) return Manager;

   --  Set the value of the property.  The property is created if it
   --  does not exists.
   procedure Set (Self : in out Manager'Class;
                  Name : in String;
                  Item : in String);

   --  Set the value of the property.  The property is created if it
   --  does not exists.
   procedure Set (Self : in out Manager'Class;
                  Name : in String;
                  Item : in Unbounded_String);

   --  Set the value of the property.  The property is created if it
   --  does not exists.
   procedure Set (Self : in out Manager'Class;
                  Name : in Unbounded_String;
                  Item : in Unbounded_String);

   --  Remove the property given its name.  If the property does not
   --  exist, raises NO_PROPERTY exception.
   procedure Remove (Self : in out Manager'Class;
                     Name : in String);

   --  Remove the property given its name.  If the property does not
   --  exist, raises NO_PROPERTY exception.
   procedure Remove (Self : in out Manager'Class;
                     Name : in Unbounded_String);

   --  Iterate over the properties and execute the given procedure passing the
   --  property name and its value.
   procedure Iterate (Self    : in Manager'Class;
                      Process : access procedure (Name : in String;
                                                  Item : in Value));

   --  Collect the name of the properties defined in the manager.
   --  When a prefix is specified, only the properties starting with the prefix are
   --  returned.
   procedure Get_Names (Self   : in Manager;
                        Into   : in out Util.Strings.Vectors.Vector;
                        Prefix : in String := "");

   --  Load the properties from the file input stream.  The file must follow
   --  the definition of Java property files.  When a prefix is specified, keep
   --  only the properties that starts with the prefix.  When Strip is True,
   --  the prefix part is removed from the property name.
   procedure Load_Properties (Self   : in out Manager'Class;
                              File   : in Ada.Text_IO.File_Type;
                              Prefix : in String := "";
                              Strip  : in Boolean := False);

   --  Load the properties from the file.  The file must follow the
   --  definition of Java property files.  When a prefix is specified, keep
   --  only the properties that starts with the prefix.  When Strip is True,
   --  the prefix part is removed from the property name.
   --  Raises NAME_ERROR if the file does not exist.
   procedure Load_Properties (Self   : in out Manager'Class;
                              Path   : in String;
                              Prefix : in String := "";
                              Strip  : in Boolean := False);

   --  Save the properties in the given file path.
   procedure Save_Properties (Self   : in out Manager'Class;
                              Path   : in String;
                              Prefix : in String := "");

   --  Copy the properties from FROM which start with a given prefix.
   --  If the prefix is empty, all properties are copied.  When Strip is True,
   --  the prefix part is removed from the property name.
   procedure Copy (Self   : in out Manager'Class;
                   From   : in Manager'Class;
                   Prefix : in String := "";
                   Strip  : in Boolean := False);

   --  Get the property manager represented by the item value.
   --  Raise the Conversion_Error exception if the value is not a property manager.
   function To_Manager (Item : in Value) return Manager;

   --  Returns True if the item value represents a property manager.
   function Is_Manager (Item : in Value) return Boolean;

private

   --  Abstract interface for the implementation of Properties
   --  (this allows to decouples the implementation from the API)
   package Interface_P is

      type Manager is abstract limited new Util.Beans.Basic.Bean with record
         Count  : Util.Concurrent.Counters.Counter;
         Shared : Boolean := False;
      end record;
      type Manager_Access is access all Manager'Class;

      --  Returns TRUE if the property exists.
      function Exists (Self : in Manager;
                       Name : in String)
                       return Boolean is abstract;

      --  Remove the property given its name.
      procedure Remove (Self : in out Manager;
                        Name : in String) is abstract;

      --  Iterate over the properties and execute the given procedure passing the
      --  property name and its value.
      procedure Iterate (Self    : in Manager;
                         Process : access procedure (Name : in String;
                                                     Item : in Value))
      is abstract;

      --  Deep copy of properties stored in 'From' to 'To'.
      function Create_Copy (Self : in Manager)
                            return Manager_Access is abstract;

   end Interface_P;

   --  Create a property implementation if there is none yet.
   procedure Check_And_Create_Impl (Self : in out Manager);

   type Manager is new Ada.Finalization.Controlled and Util.Beans.Basic.Bean with record
      Impl : Interface_P.Manager_Access := null;
   end record;

   overriding
   procedure Adjust   (Object : in out Manager);

   overriding
   procedure Finalize (Object : in out Manager);

end Util.Properties;

Fix header style

Fix header style


-----------------------------------------------------------------------
--  wiki-attributes -- Wiki document attributes
--  Copyright (C) 2015, 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 Ada.Strings.Wide_Wide_Unbounded;
private with Ada.Containers.Vectors;
private with Ada.Finalization;

--  == Attributes ==
--  The  <tt>Attributes</tt> package defines a simple management of attributes for
--  the wiki document parser.  Attribute lists are described by the <tt>Attribute_List_Type</tt>
--  with some operations to append or query for an attribute.
package Wiki.Attributes is

   pragma Preelaborate;

   use Ada.Strings.Wide_Wide_Unbounded;

   type Cursor is private;

   --  Get the attribute name.
   function Get_Name (Position : in Cursor) return String;

   --  Get the attribute value.
   function Get_Value (Position : in Cursor) return String;

   --  Get the attribute wide value.
   function Get_Wide_Value (Position : in Cursor) return Wide_Wide_String;

   --  Get the attribute wide value.
   function Get_Unbounded_Wide_Value (Position : in Cursor) return Unbounded_Wide_Wide_String;

   --  Returns True if the cursor has a valid attribute.
   function Has_Element (Position : in Cursor) return Boolean;

   --  Move the cursor to the next attribute.
   procedure Next (Position : in out Cursor);

   --  A list of attributes.
   type Attribute_List_Type is private;

   --  Find the attribute with the given name.
   function Find (List : in Attribute_List_Type;
                  Name : in String) return Cursor;

   --  Find the attribute with the given name and return its value.
   function Get_Attribute (List : in Attribute_List_Type;
                           Name : in String) return Unbounded_Wide_Wide_String;

   --  Append the attribute to the attribute list.
   procedure Append (List  : in out Attribute_List_Type;
                     Name  : in Wide_Wide_String;
                     Value : in Wide_Wide_String);

   --  Append the attribute to the attribute list.
   procedure Append (List  : in out Attribute_List_Type;
                     Name  : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String;
                     Value : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String);

   --  Get the cursor to get access to the first attribute.
   function First (List : in Attribute_List_Type) return Cursor;

   --  Get the number of attributes in the list.
   function Length (List : in Attribute_List_Type) return Natural;

   --  Clear the list and remove all existing attributes.
   procedure Clear (List : in out Attribute_List_Type);

   --  Iterate over the list attributes and call the <tt>Process</tt> procedure.
   procedure Iterate (List    : in Attribute_List_Type;
                      Process : not null access procedure (Name : in String;
                                                           Value : in Wide_Wide_String));

private

   type Attribute (Name_Length, Value_Length : Natural) is limited record
      Name   : String (1 .. Name_Length);
      Value  : Wide_Wide_String (1 .. Value_Length);
   end record;
   type Attribute_Access is access all Attribute;

   package Attribute_Vectors is
     new Ada.Containers.Vectors (Index_Type   => Positive,
                                 Element_Type => Attribute_Access);

   subtype Attribute_Vector is Attribute_Vectors.Vector;

   type Cursor is record
      Pos : Attribute_Vectors.Cursor;
   end record;

   type Attribute_List_Type is new Ada.Finalization.Controlled with record
      List    : Attribute_Vector;
   end record;

   --  Finalize the attribute list releasing any storage.
   overriding
   procedure Finalize (List : in out Attribute_List_Type);

end Wiki.Attributes;

-----------------------------------------------------------------------
--  wiki-attributes -- Wiki document attributes
--  Copyright (C) 2015, 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 Ada.Strings.Wide_Wide_Unbounded;
private with Ada.Containers.Vectors;
private with Ada.Finalization;

--  == Attributes ==
--  The  <tt>Attributes</tt> package defines a simple management of attributes for
--  the wiki document parser.  Attribute lists are described by the <tt>Attribute_List_Type</tt>
--  with some operations to append or query for an attribute.
package Wiki.Attributes is

   pragma Preelaborate;

   use Ada.Strings.Wide_Wide_Unbounded;

   type Cursor is private;

   --  Get the attribute name.
   function Get_Name (Position : in Cursor) return String;

   --  Get the attribute value.
   function Get_Value (Position : in Cursor) return String;

   --  Get the attribute wide value.
   function Get_Wide_Value (Position : in Cursor) return Wide_Wide_String;

   --  Get the attribute wide value.
   function Get_Unbounded_Wide_Value (Position : in Cursor) return Unbounded_Wide_Wide_String;

   --  Returns True if the cursor has a valid attribute.
   function Has_Element (Position : in Cursor) return Boolean;

   --  Move the cursor to the next attribute.
   procedure Next (Position : in out Cursor);

   --  A list of attributes.
   type Attribute_List_Type is private;

   --  Find the attribute with the given name.
   function Find (List : in Attribute_List_Type;
                  Name : in String) return Cursor;

   --  Find the attribute with the given name and return its value.
   function Get_Attribute (List : in Attribute_List_Type;
                           Name : in String) return Unbounded_Wide_Wide_String;

   --  Append the attribute to the attribute list.
   procedure Append (List  : in out Attribute_List_Type;
                     Name  : in Wide_Wide_String;
                     Value : in Wide_Wide_String);

   --  Append the attribute to the attribute list.
   procedure Append (List  : in out Attribute_List_Type;
                     Name  : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String;
                     Value : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String);

   --  Append the attribute to the attribute list.
   procedure Append (List  : in out Attribute_List_Type;
                     Name  : in String;
                     Value : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String);

   --  Get the cursor to get access to the first attribute.
   function First (List : in Attribute_List_Type) return Cursor;

   --  Get the number of attributes in the list.
   function Length (List : in Attribute_List_Type) return Natural;

   --  Clear the list and remove all existing attributes.
   procedure Clear (List : in out Attribute_List_Type);

   --  Iterate over the list attributes and call the <tt>Process</tt> procedure.
   procedure Iterate (List    : in Attribute_List_Type;
                      Process : not null access procedure (Name : in String;
                                                           Value : in Wide_Wide_String));

private

   type Attribute (Name_Length, Value_Length : Natural) is limited record
      Name   : String (1 .. Name_Length);
      Value  : Wide_Wide_String (1 .. Value_Length);
   end record;
   type Attribute_Access is access all Attribute;

   package Attribute_Vectors is
     new Ada.Containers.Vectors (Index_Type   => Positive,
                                 Element_Type => Attribute_Access);

   subtype Attribute_Vector is Attribute_Vectors.Vector;

   type Cursor is record
      Pos : Attribute_Vectors.Cursor;
   end record;

   type Attribute_List_Type is new Ada.Finalization.Controlled with record
      List    : Attribute_Vector;
   end record;

   --  Finalize the attribute list releasing any storage.
   overriding
   procedure Finalize (List : in out Attribute_List_Type);

end Wiki.Attributes;

Declare new Append procedure with a String type as the attribute name


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

with Util.Log.Loggers;

with ASF.Cookies;

with AWA.Users.Services;
with AWA.Users.Modules;

package body AWA.Users.Filters is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Users.Filters");

   --  ------------------------------
   --  Set the user principal on the session associated with the ASF request.
   --  ------------------------------
   procedure Set_Session_Principal (Request   : in out ASF.Requests.Request'Class;
                                    Principal : in Principals.Principal_Access) is
      Session   : ASF.Sessions.Session := Request.Get_Session (Create => True);
   begin
      Session.Set_Principal (Principal.all'Access);
   end Set_Session_Principal;

   --  ------------------------------
   --  Initialize the filter and configure the redirection URIs.
   --  ------------------------------
   procedure Initialize (Filter  : in out Auth_Filter;
                         Config  : in ASF.Servlets.Filter_Config) is
      URI : constant String := ASF.Servlets.Get_Init_Parameter (Config, AUTH_FILTER_REDIRECT_PARAM);
   begin
      Log.Info ("Using login URI: {0}", URI);

      if URI = "" then
         Log.Error ("The login URI is empty.  Redirection to the login page will not work.");
      end if;
      Filter.Login_URI := To_Unbounded_String (URI);
      ASF.Security.Filters.Auth_Filter (Filter).Initialize (Config);
   end Initialize;

   procedure Authenticate (F         : in Auth_Filter;
                           Request   : in out ASF.Requests.Request'Class;
                           Response  : in out ASF.Responses.Response'Class;
                           Session   : in ASF.Sessions.Session;
                           Auth_Id   : in String;
                           Principal : out ASF.Principals.Principal_Access) is
      pragma Unreferenced (F, Session);

      use AWA.Users.Modules;
      use AWA.Users.Services;

      Manager : constant User_Service_Access := AWA.Users.Modules.Get_User_Manager;
      P       : AWA.Users.Principals.Principal_Access;
   begin
      Manager.Authenticate (Cookie  => Auth_Id,
                            Ip_Addr => "",
                            Principal => P);
      Principal := P.all'Access;

      --  Setup a new AID cookie with the new connection session.
      declare
         Cookie : constant String := Manager.Get_Authenticate_Cookie (P.Get_Session_Identifier);
         C      : ASF.Cookies.Cookie := ASF.Cookies.Create (ASF.Security.Filters.AID_COOKIE,
                                                            Cookie);
      begin
         ASF.Cookies.Set_Path (C, Request.Get_Context_Path);
         ASF.Cookies.Set_Max_Age (C, 15 * 86400);
         Response.Add_Cookie (Cookie => C);
      end;

   exception
      when Not_Found =>
         Principal := null;
   end Authenticate;

   --  ------------------------------
   --  Display or redirects the user to the login page.  This procedure is called when
   --  the user is not authenticated.
   --  ------------------------------
   overriding
   procedure Do_Login (Filter   : in Auth_Filter;
                       Request  : in out ASF.Requests.Request'Class;
                       Response : in out ASF.Responses.Response'Class) is
      Login_URI : constant String := To_String (Filter.Login_URI);
      Context   : constant String := Request.Get_Context_Path;
      Servlet   : constant String := Request.Get_Servlet_Path;
      URL       : constant String := Context & Servlet & Request.Get_Path_Info;
      C         : ASF.Cookies.Cookie := ASF.Cookies.Create (REDIRECT_COOKIE, URL);
   begin
      Log.Info ("User is not logged, redirecting to {0}", Login_URI);

      ASF.Cookies.Set_Path (C, Request.Get_Context_Path);
      ASF.Cookies.Set_Max_Age (C, 86400);
      Response.Add_Cookie (Cookie => C);
      if Request.Get_Header ("X-Requested-With") = "" then
         Response.Send_Redirect (Location => Login_URI);
      else
         Response.Send_Error (ASF.Responses.SC_UNAUTHORIZED);
      end if;
   end Do_Login;

   --  ------------------------------
   --  Initialize the filter and configure the redirection URIs.
   --  ------------------------------
   overriding
   procedure Initialize (Filter  : in out Verify_Filter;
                         Config  : in ASF.Servlets.Filter_Config) is
      URI : constant String := ASF.Servlets.Get_Init_Parameter (Config, VERIFY_FILTER_REDIRECT_PARAM);
   begin
      Filter.Invalid_Key_URI := To_Unbounded_String (URI);
   end Initialize;

   --  ------------------------------
   --  Filter a request which contains an access key and verify that the
   --  key is valid and identifies a user.  Once the user is known, create
   --  a session and setup the user principal.
   --
   --  If the access key is missing or invalid, redirect to the
   --  <b>Invalid_Key_URI</b> associated with the filter.
   --  ------------------------------
   overriding
   procedure Do_Filter (Filter   : in Verify_Filter;
                        Request  : in out ASF.Requests.Request'Class;
                        Response : in out ASF.Responses.Response'Class;
                        Chain    : in out ASF.Servlets.Filter_Chain) is
      Key       : constant String := Request.Get_Parameter (PARAM_ACCESS_KEY);
      Manager   : constant Users.Services.User_Service_Access := Users.Modules.Get_User_Manager;
      Principal : AWA.Users.Principals.Principal_Access;
   begin
      Log.Info ("Verify access key {0}", Key);

      Manager.Verify_User (Key       => Key,
                           IpAddr    => "",
                           Principal => Principal);

      Set_Session_Principal (Request, Principal);

      --  Request is authorized, proceed to the next filter.
      ASF.Servlets.Do_Filter (Chain    => Chain,
                              Request  => Request,
                              Response => Response);

   exception
      when AWA.Users.Services.Not_Found =>
         declare
            URI : constant String := To_String (Filter.Invalid_Key_URI);
         begin
            Log.Info ("Invalid access key {0}, redirecting to {1}", Key, URI);
            Response.Send_Redirect (Location => URI);
         end;
   end Do_Filter;

end AWA.Users.Filters;

Fix compilation warnings

Fix compilation warnings


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

package body Gen.Model.Enums is

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : Value_Definition;
                       Name : String) return Util.Beans.Objects.Object is
   begin
      if Name = "value" then
         return Util.Beans.Objects.To_Object (From.Number);
      else
         return Definition (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : Enum_Definition;
                       Name : String) return Util.Beans.Objects.Object is
   begin
      if Name = "values" then
         return From.Values_Bean;
      elsif Name = "name" then
         return Util.Beans.Objects.To_Object (From.Type_Name);
      elsif Name = "isEnum" then
         return Util.Beans.Objects.To_Object (True);
      elsif Name = "sqlType" then
         return Util.Beans.Objects.To_Object (From.Sql_Type);
      else
         return Mappings.Mapping_Definition (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Compare two enum literals.
   --  ------------------------------
   function "<" (Left, Right : in Value_Definition_Access) return Boolean is
   begin
      return Left.Number < Right.Number;
   end "<";

   --  ------------------------------
   --  Prepare the generation of the model.
   --  ------------------------------
   overriding
   procedure Prepare (O : in out Enum_Definition) is
   begin
      O.Target := O.Type_Name;
      O.Values.Sort;
   end Prepare;

   --  ------------------------------
   --  Initialize the table definition instance.
   --  ------------------------------
   overriding
   procedure Initialize (O : in out Enum_Definition) is
   begin
      O.Values_Bean := Util.Beans.Objects.To_Object (O.Values'Unchecked_Access,
                                                     Util.Beans.Objects.STATIC);
   end Initialize;

   --  ------------------------------
   --  Add an enum value to this enum definition and return the new value.
   --  ------------------------------
   procedure Add_Value (Enum  : in out Enum_Definition;
                        Name  : in String;
                        Value : out Value_Definition_Access) is
   begin
      Value := new Value_Definition;
      Value.Name   := To_Unbounded_String (Name);
      Value.Number := Enum.Values.Get_Count;
      Enum.Values.Append (Value);
   end Add_Value;

   --  ------------------------------
   --  Create an enum with the given name.
   --  ------------------------------
   function Create_Enum (Name : in Unbounded_String) return Enum_Definition_Access is
      Enum : constant Enum_Definition_Access := new Enum_Definition;
   begin
      Enum.Name := Name;
      declare
         Pos : constant Natural := Index (Enum.Name, ".", Ada.Strings.Backward);
      begin
         if Pos > 0 then
            Enum.Pkg_Name := Unbounded_Slice (Enum.Name, 1, Pos - 1);
            Enum.Type_Name := Unbounded_Slice (Enum.Name, Pos + 1, Length (Enum.Name));
         else
            Enum.Pkg_Name := To_Unbounded_String ("ADO");
            Enum.Type_Name := Enum.Name;
         end if;
      end;
      return Enum;
   end Create_Enum;

end Gen.Model.Enums;

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

package body Gen.Model.Enums is

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : Value_Definition;
                       Name : String) return Util.Beans.Objects.Object is
   begin
      if Name = "value" then
         return Util.Beans.Objects.To_Object (From.Number);
      else
         return Definition (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : Enum_Definition;
                       Name : String) return Util.Beans.Objects.Object is
   begin
      if Name = "values" then
         return From.Values_Bean;
      elsif Name = "name" then
         return Util.Beans.Objects.To_Object (From.Type_Name);
      elsif Name = "isEnum" then
         return Util.Beans.Objects.To_Object (True);
      elsif Name = "sqlType" then
         return Util.Beans.Objects.To_Object (From.Sql_Type);
      else
         return Mappings.Mapping_Definition (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Compare two enum literals.
   --  ------------------------------
   function "<" (Left, Right : in Value_Definition_Access) return Boolean is
   begin
      return Left.Number < Right.Number;
   end "<";

   --  ------------------------------
   --  Prepare the generation of the model.
   --  ------------------------------
   overriding
   procedure Prepare (O : in out Enum_Definition) is
      procedure Sort is new Value_List.Sort_On ("<");
   begin
      O.Target := O.Type_Name;
      Sort (O.Values);
   end Prepare;

   --  ------------------------------
   --  Initialize the table definition instance.
   --  ------------------------------
   overriding
   procedure Initialize (O : in out Enum_Definition) is
   begin
      O.Values_Bean := Util.Beans.Objects.To_Object (O.Values'Unchecked_Access,
                                                     Util.Beans.Objects.STATIC);
   end Initialize;

   --  ------------------------------
   --  Add an enum value to this enum definition and return the new value.
   --  ------------------------------
   procedure Add_Value (Enum  : in out Enum_Definition;
                        Name  : in String;
                        Value : out Value_Definition_Access) is
   begin
      Value := new Value_Definition;
      Value.Name   := To_Unbounded_String (Name);
      Value.Number := Enum.Values.Get_Count;
      Enum.Values.Append (Value);
   end Add_Value;

   --  ------------------------------
   --  Create an enum with the given name.
   --  ------------------------------
   function Create_Enum (Name : in Unbounded_String) return Enum_Definition_Access is
      Enum : constant Enum_Definition_Access := new Enum_Definition;
   begin
      Enum.Name := Name;
      declare
         Pos : constant Natural := Index (Enum.Name, ".", Ada.Strings.Backward);
      begin
         if Pos > 0 then
            Enum.Pkg_Name := Unbounded_Slice (Enum.Name, 1, Pos - 1);
            Enum.Type_Name := Unbounded_Slice (Enum.Name, Pos + 1, Length (Enum.Name));
         else
            Enum.Pkg_Name := To_Unbounded_String ("ADO");
            Enum.Type_Name := Enum.Name;
         end if;
      end;
      return Enum;
   end Create_Enum;

end Gen.Model.Enums;

Fix sorting of enum values

Fix sorting of enum values


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

with Ada.Numerics;
with ASF.Streams;
package body Volume_Servlet is

   --  ------------------------------
   --  Write the volume form page with an optional response message.
   --  ------------------------------
   procedure Write (Response : in out Responses.Response'Class;
                    Message  : in String;
                    Height   : in String;
                    Radius   : in String) is
      Output : ASF.Streams.Print_Stream := Response.Get_Output_Stream;
   begin
      Output.Write ("<title>Volume servlet example</title>"
                    & ""
                    & ""
                    & "
Compute the volume of a cylinder
");

      --  Display the response or some error.
      if Message /= "" then
         Output.Write ("
" & Message & "
");
      end if;

      --  Render the form.  If we have some existing Radius or Height
      --  use them to set the initial values.
      Output.Write ("
Enter the height and radius of the cylinder
"
                    & "<form method='post'>"
                    & "
"
                    & "
Height	"
                    & "<input type='text' size='10' name='height'");
      if Height /= "" then
         Output.Write (" value='" & Height & "'");
      end if;
      Output.Write ("></input>
"
                    & "
Radius	"
                    & "<input type='text' size='10' name='radius'");
      if Radius /= "" then
         Output.Write (" value='" & Radius & "'");
      end if;
      Output.Write ("></input>
"
                    & "
	<input type='submit' value='Compute'></input>
"
                    & "
</form>"
                    & "");
      Response.Set_Status (Responses.SC_OK);
   end Write;

   --  ------------------------------
   --  Called by the servlet container when a GET request is received.
   --  Display the volume form page.
   --  ------------------------------
   procedure Do_Get (Server   : in Servlet;
                     Request  : in out Requests.Request'Class;
                     Response : in out Responses.Response'Class) is
      pragma Unreferenced (Server, Request);
   begin
      Write (Response, "", "", "");
   end Do_Get;

   --  ------------------------------
   --  Called by the servlet container when a POST request is received.
   --  Computes the cylinder volume and display the result page.
   --  ------------------------------
   procedure Do_Post (Server   : in Servlet;
                      Request  : in out Requests.Request'Class;
                      Response : in out Responses.Response'Class) is
      pragma Unreferenced (Server);

      Height : constant String := Request.Get_Parameter ("height");
      Radius : constant String := Request.Get_Parameter ("radius");
   begin
      declare
         H : constant Float := Float'Value (Height);
         R : constant Float := Float'Value (Radius);
         V : constant Float := Ada.Numerics.Pi * R * R * H;
      begin
         Write (Response, "The cylinder volume is: " & Float'Image (V), Height, Radius);
      end;

   exception
      when others =>
         Write (Response, "Invalid height or radius.  Please, enter a number",
                Height, Radius);
   end Do_Post;

end Volume_Servlet;

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

with Ada.Numerics;
with ASF.Streams;
package body Volume_Servlet is

   procedure Write (Response : in out Responses.Response'Class;
                    Message  : in String;
                    Height   : in String;
                    Radius   : in String);

   --  ------------------------------
   --  Write the volume form page with an optional response message.
   --  ------------------------------
   procedure Write (Response : in out Responses.Response'Class;
                    Message  : in String;
                    Height   : in String;
                    Radius   : in String) is
      Output : ASF.Streams.Print_Stream := Response.Get_Output_Stream;
   begin
      Output.Write ("<title>Volume servlet example</title>"
                    & ""
                    & ""
                    & "
Compute the volume of a cylinder
");

      --  Display the response or some error.
      if Message /= "" then
         Output.Write ("
" & Message & "
");
      end if;

      --  Render the form.  If we have some existing Radius or Height
      --  use them to set the initial values.
      Output.Write ("
Enter the height and radius of the cylinder
"
                    & "<form method='post'>"
                    & "
"
                    & "
Height	"
                    & "<input type='text' size='10' name='height'");
      if Height /= "" then
         Output.Write (" value='" & Height & "'");
      end if;
      Output.Write ("></input>
"
                    & "
Radius	"
                    & "<input type='text' size='10' name='radius'");
      if Radius /= "" then
         Output.Write (" value='" & Radius & "'");
      end if;
      Output.Write ("></input>
"
                    & "
	<input type='submit' value='Compute'></input>
"
                    & "
</form>"
                    & "");
      Response.Set_Status (Responses.SC_OK);
   end Write;

   --  ------------------------------
   --  Called by the servlet container when a GET request is received.
   --  Display the volume form page.
   --  ------------------------------
   procedure Do_Get (Server   : in Servlet;
                     Request  : in out Requests.Request'Class;
                     Response : in out Responses.Response'Class) is
      pragma Unreferenced (Server, Request);
   begin
      Write (Response, "", "", "");
   end Do_Get;

   --  ------------------------------
   --  Called by the servlet container when a POST request is received.
   --  Computes the cylinder volume and display the result page.
   --  ------------------------------
   procedure Do_Post (Server   : in Servlet;
                      Request  : in out Requests.Request'Class;
                      Response : in out Responses.Response'Class) is
      pragma Unreferenced (Server);

      Height : constant String := Request.Get_Parameter ("height");
      Radius : constant String := Request.Get_Parameter ("radius");
   begin
      declare
         H : constant Float := Float'Value (Height);
         R : constant Float := Float'Value (Radius);
         V : constant Float := Ada.Numerics.Pi * R * R * H;
      begin
         Write (Response, "The cylinder volume is: " & Float'Image (V), Height, Radius);
      end;

   exception
      when others =>
         Write (Response, "Invalid height or radius.  Please, enter a number",
                Height, Radius);
   end Do_Post;

end Volume_Servlet;

Fix compilation warnings

Fix compilation warnings


-----------------------------------------------------------------------
--  awa-comments-beans -- Beans for the comments module
--  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 ADO.Sessions.Entities;
with ADO.Queries;
with ADO.Utils;
with AWA.Helpers.Requests;
package body AWA.Comments.Beans is

   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Comment_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.Comments.Models.Comment_Bean (From).Get_Value (Name);
      end if;
   end Get_Value;

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

      elsif Name = "entity_type" then
         From.Entity_Type := Util.Beans.Objects.To_Unbounded_String (Value);

      elsif Name = "entity_id" then
         declare
            use type ADO.Identifier;

            Id : constant ADO.Identifier := ADO.Utils.To_Identifier (Value);
         begin
            if Id /= ADO.NO_IDENTIFIER then
               From.Set_Entity_Id (ADO.Utils.To_Identifier (Value));
            end if;
         end;

      elsif Name = "permission" then
         From.Permission := Util.Beans.Objects.To_Unbounded_String (Value);

      elsif Name = "status" then
         From.Set_Status (AWA.Comments.Models.Status_Type_Objects.To_Value (Value));

      elsif Name = "id" and not Util.Beans.Objects.Is_Empty (Value) then
         declare
            Id  : constant ADO.Identifier := ADO.Utils.To_Identifier (Value);
         begin
            From.Module.Load_Comment (From, Id);
         end;
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create the comment.
   --  ------------------------------
   overriding
   procedure Create (Bean    : in out Comment_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   begin
      Bean.Module.Create_Comment (Permission  => To_String (Bean.Permission),
                                  Entity_Type => To_String (Bean.Entity_Type),
                                  Comment     => Bean);
   end Create;

   --  ------------------------------
   --  Save the comment.
   --  ------------------------------
   overriding
   procedure Save (Bean    : in out Comment_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   begin
      Bean.Module.Update_Comment (Permission  => To_String (Bean.Permission),
                                  Comment     => Bean);
   end Save;

   --  ------------------------------
   --  Publish or not the comment.
   --  ------------------------------
   overriding
   procedure Publish (Bean    : in out Comment_Bean;
                      Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);

      Id     : constant ADO.Identifier := Helpers.Requests.Get_Parameter ("id");
      Value  : constant Util.Beans.Objects.Object := Helpers.Requests.Get_Parameter ("status");
   begin
      Bean.Module.Publish_Comment (Permission  => To_String (Bean.Permission),
                                   Id          => Id,
                                   Status      => Models.Status_Type_Objects.To_Value (Value),
                                   Comment     => Bean);
   end Publish;

   --  ------------------------------
   --  Delete the comment.
   --  ------------------------------
   overriding
   procedure Delete (Bean    : in out Comment_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   begin
      Bean.Module.Delete_Comment (Ada.Strings.Unbounded.To_String (Bean.Permission), Bean);
   end Delete;

   --  ------------------------------
   --  Create a new comment bean instance.
   --  ------------------------------
   function Create_Comment_Bean (Module : in AWA.Comments.Modules.Comment_Module_Access)
                                 return Util.Beans.Basic.Readonly_Bean_Access is
      Result : constant Comment_Bean_Access := new Comment_Bean;
   begin
      Result.Module := Module;
      return Result.all'Access;
   end Create_Comment_Bean;

   --  ------------------------------
   --  Set the value identified by the name.
   --  If the name cannot be found, the method should raise the No_Value
   --  exception.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Comment_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "entity_type" then
         From.Entity_Type := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = "permission" then
         From.Permission := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = "entity_id" then
         From.Load_Comments (ADO.Utils.To_Identifier (Value));
      end if;
   end Set_Value;

   --  ------------------------------
   --  Set the entity type (database table) with which the comments are associated.
   --  ------------------------------
   procedure Set_Entity_Type (Into  : in out Comment_List_Bean;
                              Table : in ADO.Schemas.Class_Mapping_Access) is
   begin
      Into.Entity_Type := Ada.Strings.Unbounded.To_Unbounded_String (Table.Table.all);
   end Set_Entity_Type;

   --  ------------------------------
   --  Set the permission to check before removing or adding a comment on the entity.
   --  ------------------------------
   procedure Set_Permission (Into       : in out Comment_List_Bean;
                             Permission : in String) is
   begin
      Into.Permission := Ada.Strings.Unbounded.To_Unbounded_String (Permission);
   end Set_Permission;

   --  ------------------------------
   --  Load the comments associated with the given database identifier.
   --  ------------------------------
   procedure Load_Comments (Into          : in out Comment_List_Bean;
                            For_Entity_Id : in ADO.Identifier) is
      Session : ADO.Sessions.Session := Into.Module.Get_Session;
   begin
      Into.Load_Comments (Session, For_Entity_Id);
   end Load_Comments;

   --  ------------------------------
   --  Load the comments associated with the given database identifier.
   --  ------------------------------
   procedure Load_Comments (Into          : in out Comment_List_Bean;
                            Session       : in out ADO.Sessions.Session;
                            For_Entity_Id : in ADO.Identifier) is
      use ADO.Sessions.Entities;

      Entity_Type : constant String := Ada.Strings.Unbounded.To_String (Into.Entity_Type);
      Kind        : constant ADO.Entity_Type := Find_Entity_Type (Session, Entity_Type);
      Query       : ADO.Queries.Context;
   begin
      Into.Entity_Id := For_Entity_Id;
      Query.Set_Query (AWA.Comments.Models.Query_Comment_List);
      Query.Bind_Param ("entity_type", Kind);
      Query.Bind_Param ("entity_id", For_Entity_Id);
      Query.Bind_Param ("status", Integer (Models.Status_Type'Pos (Models.COMMENT_PUBLISHED)));
      AWA.Comments.Models.List (Into, Session, Query);
   end Load_Comments;

   --  ------------------------------
   --  Create the comment list bean instance.
   --  ------------------------------
   function Create_Comment_List_Bean (Module : in AWA.Comments.Modules.Comment_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access is
      Result : constant Comment_List_Bean_Access := new Comment_List_Bean;
   begin
      Result.Module := Module;
      return Result.all'Access;
   end Create_Comment_List_Bean;

end AWA.Comments.Beans;

-----------------------------------------------------------------------
--  awa-comments-beans -- Beans for the comments module
--  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 ADO.Sessions.Entities;
with ADO.Queries;
with ADO.Utils;
with AWA.Helpers.Requests;
package body AWA.Comments.Beans is

   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Comment_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.Comments.Models.Comment_Bean (From).Get_Value (Name);
      end if;
   end Get_Value;

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

      elsif Name = "entity_type" then
         From.Entity_Type := Util.Beans.Objects.To_Unbounded_String (Value);

      elsif Name = "entity_id" then
         declare
            use type ADO.Identifier;

            Id : constant ADO.Identifier := ADO.Utils.To_Identifier (Value);
         begin
            if Id /= ADO.NO_IDENTIFIER then
               From.Set_Entity_Id (ADO.Utils.To_Identifier (Value));
            end if;
         end;

      elsif Name = "permission" then
         From.Permission := Util.Beans.Objects.To_Unbounded_String (Value);

      elsif Name = "status" then
         From.Set_Status (AWA.Comments.Models.Status_Type_Objects.To_Value (Value));

      elsif Name = "format" then
         From.Set_Format (AWA.Comments.Models.Format_Type_Objects.To_Value (Value));

      elsif Name = "id" and not Util.Beans.Objects.Is_Empty (Value) then
         declare
            Id  : constant ADO.Identifier := ADO.Utils.To_Identifier (Value);
         begin
            From.Module.Load_Comment (From, Id);
         end;
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create the comment.
   --  ------------------------------
   overriding
   procedure Create (Bean    : in out Comment_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   begin
      Bean.Module.Create_Comment (Permission  => To_String (Bean.Permission),
                                  Entity_Type => To_String (Bean.Entity_Type),
                                  Comment     => Bean);
   end Create;

   --  ------------------------------
   --  Save the comment.
   --  ------------------------------
   overriding
   procedure Save (Bean    : in out Comment_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   begin
      Bean.Module.Update_Comment (Permission  => To_String (Bean.Permission),
                                  Comment     => Bean);
   end Save;

   --  ------------------------------
   --  Publish or not the comment.
   --  ------------------------------
   overriding
   procedure Publish (Bean    : in out Comment_Bean;
                      Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);

      Id     : constant ADO.Identifier := Helpers.Requests.Get_Parameter ("id");
      Value  : constant Util.Beans.Objects.Object := Helpers.Requests.Get_Parameter ("status");
   begin
      Bean.Module.Publish_Comment (Permission  => To_String (Bean.Permission),
                                   Id          => Id,
                                   Status      => Models.Status_Type_Objects.To_Value (Value),
                                   Comment     => Bean);
   end Publish;

   --  ------------------------------
   --  Delete the comment.
   --  ------------------------------
   overriding
   procedure Delete (Bean    : in out Comment_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   begin
      Bean.Module.Delete_Comment (Ada.Strings.Unbounded.To_String (Bean.Permission), Bean);
   end Delete;

   --  ------------------------------
   --  Create a new comment bean instance.
   --  ------------------------------
   function Create_Comment_Bean (Module : in AWA.Comments.Modules.Comment_Module_Access)
                                 return Util.Beans.Basic.Readonly_Bean_Access is
      Result : constant Comment_Bean_Access := new Comment_Bean;
   begin
      Result.Module := Module;
      return Result.all'Access;
   end Create_Comment_Bean;

   --  ------------------------------
   --  Set the value identified by the name.
   --  If the name cannot be found, the method should raise the No_Value
   --  exception.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Comment_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "entity_type" then
         From.Entity_Type := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = "permission" then
         From.Permission := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = "entity_id" then
         From.Load_Comments (ADO.Utils.To_Identifier (Value));
      end if;
   end Set_Value;

   --  ------------------------------
   --  Set the entity type (database table) with which the comments are associated.
   --  ------------------------------
   procedure Set_Entity_Type (Into  : in out Comment_List_Bean;
                              Table : in ADO.Schemas.Class_Mapping_Access) is
   begin
      Into.Entity_Type := Ada.Strings.Unbounded.To_Unbounded_String (Table.Table.all);
   end Set_Entity_Type;

   --  ------------------------------
   --  Set the permission to check before removing or adding a comment on the entity.
   --  ------------------------------
   procedure Set_Permission (Into       : in out Comment_List_Bean;
                             Permission : in String) is
   begin
      Into.Permission := Ada.Strings.Unbounded.To_Unbounded_String (Permission);
   end Set_Permission;

   --  ------------------------------
   --  Load the comments associated with the given database identifier.
   --  ------------------------------
   procedure Load_Comments (Into          : in out Comment_List_Bean;
                            For_Entity_Id : in ADO.Identifier) is
      Session : ADO.Sessions.Session := Into.Module.Get_Session;
   begin
      Into.Load_Comments (Session, For_Entity_Id);
   end Load_Comments;

   --  ------------------------------
   --  Load the comments associated with the given database identifier.
   --  ------------------------------
   procedure Load_Comments (Into          : in out Comment_List_Bean;
                            Session       : in out ADO.Sessions.Session;
                            For_Entity_Id : in ADO.Identifier) is
      use ADO.Sessions.Entities;

      Entity_Type : constant String := Ada.Strings.Unbounded.To_String (Into.Entity_Type);
      Kind        : constant ADO.Entity_Type := Find_Entity_Type (Session, Entity_Type);
      Query       : ADO.Queries.Context;
   begin
      Into.Entity_Id := For_Entity_Id;
      Query.Set_Query (AWA.Comments.Models.Query_Comment_List);
      Query.Bind_Param ("entity_type", Kind);
      Query.Bind_Param ("entity_id", For_Entity_Id);
      Query.Bind_Param ("status", Integer (Models.Status_Type'Pos (Models.COMMENT_PUBLISHED)));
      AWA.Comments.Models.List (Into, Session, Query);
   end Load_Comments;

   --  ------------------------------
   --  Create the comment list bean instance.
   --  ------------------------------
   function Create_Comment_List_Bean (Module : in AWA.Comments.Modules.Comment_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access is
      Result : constant Comment_List_Bean_Access := new Comment_List_Bean;
   begin
      Result.Module := Module;
      return Result.all'Access;
   end Create_Comment_List_Bean;

end AWA.Comments.Beans;

Update Set_Value to allow the setting of comment format


-----------------------------------------------------------------------
--  awa-comments-beans -- Beans for the comments module
--  Copyright (C) 2014, 2015, 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 ADO.Sessions.Entities;
with ADO.Queries;
with ADO.Utils;
with ADO.Parameters;
with AWA.Helpers.Requests;
package body AWA.Comments.Beans is

   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Comment_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.Comments.Models.Comment_Bean (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Comment_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "entity_type" then
         From.Entity_Type := Util.Beans.Objects.To_Unbounded_String (Value);

      elsif Name = "entity_id" then
         declare
            use type ADO.Identifier;

            Id : constant ADO.Identifier := ADO.Utils.To_Identifier (Value);
         begin
            if Id /= ADO.NO_IDENTIFIER then
               From.Set_Entity_Id (ADO.Utils.To_Identifier (Value));
            end if;
         end;

      elsif Name = "permission" then
         From.Permission := Util.Beans.Objects.To_Unbounded_String (Value);

      elsif Name = "id" and not Util.Beans.Objects.Is_Empty (Value) then
         declare
            Id  : constant ADO.Identifier := ADO.Utils.To_Identifier (Value);
         begin
            From.Module.Load_Comment (From, Id);
         end;
      else
         AWA.Comments.Models.Comment_Bean (From).Set_Value (Name, Value);
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create the comment.
   --  ------------------------------
   overriding
   procedure Create (Bean    : in out Comment_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   begin
      Bean.Module.Create_Comment (Permission  => To_String (Bean.Permission),
                                  Entity_Type => To_String (Bean.Entity_Type),
                                  Comment     => Bean);
   end Create;

   --  ------------------------------
   --  Save the comment.
   --  ------------------------------
   overriding
   procedure Save (Bean    : in out Comment_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   begin
      Bean.Module.Update_Comment (Permission  => To_String (Bean.Permission),
                                  Comment     => Bean);
   end Save;

   --  ------------------------------
   --  Publish or not the comment.
   --  ------------------------------
   overriding
   procedure Publish (Bean    : in out Comment_Bean;
                      Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);

      Id     : constant ADO.Identifier := Helpers.Requests.Get_Parameter ("id");
      Value  : constant Util.Beans.Objects.Object := Helpers.Requests.Get_Parameter ("status");
   begin
      Bean.Module.Publish_Comment (Permission  => To_String (Bean.Permission),
                                   Id          => Id,
                                   Status      => Models.Status_Type_Objects.To_Value (Value),
                                   Comment     => Bean);
   end Publish;

   --  ------------------------------
   --  Delete the comment.
   --  ------------------------------
   overriding
   procedure Delete (Bean    : in out Comment_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   begin
      Bean.Module.Delete_Comment (Ada.Strings.Unbounded.To_String (Bean.Permission), Bean);
   end Delete;

   --  ------------------------------
   --  Create a new comment bean instance.
   --  ------------------------------
   function Create_Comment_Bean (Module : in AWA.Comments.Modules.Comment_Module_Access)
                                 return Util.Beans.Basic.Readonly_Bean_Access is
      Result : constant Comment_Bean_Access := new Comment_Bean;
   begin
      Result.Module := Module;
      return Result.all'Access;
   end Create_Comment_Bean;

   --  ------------------------------
   --  Set the value identified by the name.
   --  If the name cannot be found, the method should raise the No_Value
   --  exception.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Comment_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "entity_type" then
         From.Entity_Type := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = "permission" then
         From.Permission := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = "entity_id" then
         From.Load_Comments (ADO.Utils.To_Identifier (Value));
      elsif Name = "sort" then
         if Util.Beans.Objects.To_String (Value) = "oldest" then
            From.Oldest_First := True;
         else
            From.Oldest_First := False;
         end if;
      end if;
   end Set_Value;

   --  ------------------------------
   --  Set the entity type (database table) with which the comments are associated.
   --  ------------------------------
   procedure Set_Entity_Type (Into  : in out Comment_List_Bean;
                              Table : in ADO.Schemas.Class_Mapping_Access) is
   begin
      Into.Entity_Type := Ada.Strings.Unbounded.To_Unbounded_String (Table.Table.all);
   end Set_Entity_Type;

   --  ------------------------------
   --  Set the permission to check before removing or adding a comment on the entity.
   --  ------------------------------
   procedure Set_Permission (Into       : in out Comment_List_Bean;
                             Permission : in String) is
   begin
      Into.Permission := Ada.Strings.Unbounded.To_Unbounded_String (Permission);
   end Set_Permission;

   --  ------------------------------
   --  Load the comments associated with the given database identifier.
   --  ------------------------------
   procedure Load_Comments (Into          : in out Comment_List_Bean;
                            For_Entity_Id : in ADO.Identifier) is
      Session : ADO.Sessions.Session := Into.Module.Get_Session;
   begin
      Into.Load_Comments (Session, For_Entity_Id);
   end Load_Comments;

   --  ------------------------------
   --  Load the comments associated with the given database identifier.
   --  ------------------------------
   procedure Load_Comments (Into          : in out Comment_List_Bean;
                            Session       : in out ADO.Sessions.Session;
                            For_Entity_Id : in ADO.Identifier) is
      use ADO.Sessions.Entities;

      Entity_Type : constant String := Ada.Strings.Unbounded.To_String (Into.Entity_Type);
      Kind        : constant ADO.Entity_Type := Find_Entity_Type (Session, Entity_Type);
      Query       : ADO.Queries.Context;
   begin
      Into.Entity_Id := For_Entity_Id;
      Query.Set_Query (AWA.Comments.Models.Query_Comment_List);
      Query.Bind_Param ("entity_type", Kind);
      Query.Bind_Param ("entity_id", For_Entity_Id);
      Query.Bind_Param ("status", Integer (Models.Status_Type'Pos (Models.COMMENT_PUBLISHED)));
      if Into.Oldest_First then
         Query.Bind_Param ("sort", ADO.Parameters.Token '("ASC"));
      else
         Query.Bind_Param ("sort", ADO.Parameters.Token '("DESC"));
      end if;
      AWA.Comments.Models.List (Into, Session, Query);
   end Load_Comments;

   --  ------------------------------
   --  Create the comment list bean instance.
   --  ------------------------------
   function Create_Comment_List_Bean (Module : in AWA.Comments.Modules.Comment_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access is
      Result : constant Comment_List_Bean_Access := new Comment_List_Bean;
   begin
      Result.Module := Module;
      return Result.all'Access;
   end Create_Comment_List_Bean;

end AWA.Comments.Beans;

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

   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Comment_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.Comments.Models.Comment_Bean (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Comment_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "entity_type" then
         From.Entity_Type := Util.Beans.Objects.To_Unbounded_String (Value);

      elsif Name = "entity_id" then
         declare
            use type ADO.Identifier;

            Id : constant ADO.Identifier := ADO.Utils.To_Identifier (Value);
         begin
            if Id /= ADO.NO_IDENTIFIER then
               From.Set_Entity_Id (ADO.Utils.To_Identifier (Value));
            end if;
         end;

      elsif Name = "permission" then
         From.Permission := Util.Beans.Objects.To_Unbounded_String (Value);

      elsif Name = "id" and not Util.Beans.Objects.Is_Empty (Value) then
         declare
            Id  : constant ADO.Identifier := ADO.Utils.To_Identifier (Value);
         begin
            From.Module.Load_Comment (From, Id);
         end;
      else
         AWA.Comments.Models.Comment_Bean (From).Set_Value (Name, Value);
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create the comment.
   --  ------------------------------
   overriding
   procedure Create (Bean    : in out Comment_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   begin
      Bean.Module.Create_Comment (Permission  => To_String (Bean.Permission),
                                  Entity_Type => To_String (Bean.Entity_Type),
                                  Comment     => Bean);
   end Create;

   --  ------------------------------
   --  Save the comment.
   --  ------------------------------
   overriding
   procedure Save (Bean    : in out Comment_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   begin
      Bean.Module.Update_Comment (Permission  => To_String (Bean.Permission),
                                  Comment     => Bean);
   end Save;

   --  ------------------------------
   --  Publish or not the comment.
   --  ------------------------------
   overriding
   procedure Publish (Bean    : in out Comment_Bean;
                      Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);

      Id     : constant ADO.Identifier := Helpers.Requests.Get_Parameter ("id");
      Value  : constant Util.Beans.Objects.Object := Helpers.Requests.Get_Parameter ("status");
   begin
      Bean.Module.Publish_Comment (Permission  => To_String (Bean.Permission),
                                   Id          => Id,
                                   Status      => Models.Status_Type_Objects.To_Value (Value),
                                   Comment     => Bean);
   end Publish;

   --  ------------------------------
   --  Delete the comment.
   --  ------------------------------
   overriding
   procedure Delete (Bean    : in out Comment_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
   begin
      Bean.Module.Delete_Comment (Ada.Strings.Unbounded.To_String (Bean.Permission), Bean);
   end Delete;

   --  ------------------------------
   --  Create a new comment bean instance.
   --  ------------------------------
   function Create_Comment_Bean (Module : in AWA.Comments.Modules.Comment_Module_Access)
                                 return Util.Beans.Basic.Readonly_Bean_Access is
      Result : constant Comment_Bean_Access := new Comment_Bean;
   begin
      Result.Module := Module;
      return Result.all'Access;
   end Create_Comment_Bean;

   --  ------------------------------
   --  Set the value identified by the name.
   --  If the name cannot be found, the method should raise the No_Value
   --  exception.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Comment_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "entity_type" then
         From.Entity_Type := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = "permission" then
         From.Permission := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = "entity_id" then
         From.Load_Comments (ADO.Utils.To_Identifier (Value));
      elsif Name = "sort" then
         if Util.Beans.Objects.To_String (Value) = "oldest" then
            From.Oldest_First := True;
         else
            From.Oldest_First := False;
         end if;
      elsif Name = "status" then
         if Util.Beans.Objects.To_String (Value) = "published" then
            From.Publish_Only := True;
         else
            From.Publish_Only := False;
         end if;
      end if;
   end Set_Value;

   --  ------------------------------
   --  Set the entity type (database table) with which the comments are associated.
   --  ------------------------------
   procedure Set_Entity_Type (Into  : in out Comment_List_Bean;
                              Table : in ADO.Schemas.Class_Mapping_Access) is
   begin
      Into.Entity_Type := Ada.Strings.Unbounded.To_Unbounded_String (Table.Table.all);
   end Set_Entity_Type;

   --  ------------------------------
   --  Set the permission to check before removing or adding a comment on the entity.
   --  ------------------------------
   procedure Set_Permission (Into       : in out Comment_List_Bean;
                             Permission : in String) is
   begin
      Into.Permission := Ada.Strings.Unbounded.To_Unbounded_String (Permission);
   end Set_Permission;

   --  ------------------------------
   --  Load the comments associated with the given database identifier.
   --  ------------------------------
   procedure Load_Comments (Into          : in out Comment_List_Bean;
                            For_Entity_Id : in ADO.Identifier) is
      Session : ADO.Sessions.Session := Into.Module.Get_Session;
   begin
      Into.Load_Comments (Session, For_Entity_Id);
   end Load_Comments;

   --  ------------------------------
   --  Load the comments associated with the given database identifier.
   --  ------------------------------
   procedure Load_Comments (Into          : in out Comment_List_Bean;
                            Session       : in out ADO.Sessions.Session;
                            For_Entity_Id : in ADO.Identifier) is
      use ADO.Sessions.Entities;

      Entity_Type : constant String := Ada.Strings.Unbounded.To_String (Into.Entity_Type);
      Kind        : constant ADO.Entity_Type := Find_Entity_Type (Session, Entity_Type);
      Query       : ADO.Queries.Context;
   begin
      Into.Entity_Id := For_Entity_Id;
      if Into.Publish_Only then
         Query.Set_Query (AWA.Comments.Models.Query_Comment_List);
         Query.Bind_Param ("status", Integer (Models.Status_Type'Pos (Models.COMMENT_PUBLISHED)));
      else
         Query.Set_Query (AWA.Comments.Models.Query_All_Comment_List);
      end if;
      Query.Bind_Param ("entity_type", Kind);
      Query.Bind_Param ("entity_id", For_Entity_Id);
      if Into.Oldest_First then
         Query.Bind_Param ("sort", ADO.Parameters.Token '("ASC"));
      else
         Query.Bind_Param ("sort", ADO.Parameters.Token '("DESC"));
      end if;
      AWA.Comments.Models.List (Into, Session, Query);
   end Load_Comments;

   --  ------------------------------
   --  Create the comment list bean instance.
   --  ------------------------------
   function Create_Comment_List_Bean (Module : in AWA.Comments.Modules.Comment_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access is
      Result : constant Comment_List_Bean_Access := new Comment_List_Bean;
   begin
      Result.Module := Module;
      return Result.all'Access;
   end Create_Comment_List_Bean;

end AWA.Comments.Beans;

Update Get_Value for Comment_List_Bean to take into account the 'status' bean and setup the publish_only flag When loading the list of comments, load all the comments (Publish_Only = False) or only those that are published (Publish_Only = True)


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

--  == Counter Bean ==
--  The <b>Counter_Bean</b> allows to represent a counter associated with some database
--  entity and allows its control by the <awa:counter> component.
--
package AWA.Counters.Beans is

   type Counter_Bean (Of_Type  : ADO.Objects.Object_Key_Type;
                      Of_Class : ADO.Schemas.Class_Mapping_Access) is
     new Util.Beans.Basic.Readonly_Bean with record
      Counter : Counter_Index_Type;
      Value   : Integer := -1;
      Object  : ADO.Objects.Object_Key (Of_Type, Of_Class);
   end record;
   type Counter_Bean_Access is access all Counter_Bean'Class;

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

end AWA.Counters.Beans;

-----------------------------------------------------------------------
--  awa-counters-beans -- Counter bean definition
--  Copyright (C) 2015, 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 Ada.Strings.Unbounded;

with ADO.Objects;
with ADO.Schemas;
with Util.Beans.Objects;
with Util.Beans.Basic;

with AWA.Counters.Modules;
with AWA.Counters.Models;

--  == Counter Bean ==
--  The <b>Counter_Bean</b> allows to represent a counter associated with some database
--  entity and allows its control by the <awa:counter> component.
--
package AWA.Counters.Beans is

   type Counter_Bean (Of_Type  : ADO.Objects.Object_Key_Type;
                      Of_Class : ADO.Schemas.Class_Mapping_Access) is
     new Util.Beans.Basic.Readonly_Bean with record
      Counter : Counter_Index_Type;
      Value   : Integer := -1;
      Object  : ADO.Objects.Object_Key (Of_Type, Of_Class);
   end record;
   type Counter_Bean_Access is access all Counter_Bean'Class;

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

   type Counter_Stat_Bean is new AWA.Counters.Models.Stat_List_Bean with record
      Module           : AWA.Counters.Modules.Counter_Module_Access;

      Stats            : aliased AWA.Counters.Models.Stat_Info_List_Bean;
      Stats_Bean       : AWA.Counters.Models.Stat_Info_List_Bean_Access;
   end record;
   type Counter_Stat_Bean_Access is access all Counter_Stat_Bean'Class;

   overriding
   function Get_Value (List : in Counter_Stat_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Counter_Stat_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the statistics information.
   overriding
   procedure Load (List    : in out Counter_Stat_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Blog_Stat_Bean bean instance.
   function Create_Counter_Stat_Bean (Module : in AWA.Counters.Modules.Counter_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Counters.Beans;

Declare the Counter_Stat_Bean type with Get_Value, Set_Value, Load operations