-----------------------------------------------------------------------
--  wiki-parsers-html -- Wiki HTML parser
--  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.Characters.Conversions;

with Wiki.Parsers.Html.Entities;
package body Wiki.Parsers.Html is

   --  Parse a HTML/XML comment to strip it.
   procedure Parse_Comment (P : in out Parser);

   --  Parse a simple DOCTYPE declaration and ignore it.
   procedure Parse_Doctype (P : in out Parser);

   procedure Collect_Attributes (P     : in out Parser);
   function Is_Space (C : in Wide_Wide_Character) return Boolean;
   function Is_Letter (C : in Wide_Wide_Character) return Boolean;
   procedure Collect_Attribute_Value (P     : in out Parser;
                                      Value : in out Unbounded_Wide_Wide_String);

   function Is_Space (C : in Wide_Wide_Character) return Boolean is
   begin
      return C = ' ' or C = LF or C = CR;
   end Is_Space;

   function Is_Letter (C : in Wide_Wide_Character) return Boolean is
   begin
      return C > ' ' and C /= ':' and C /= '>' and C /= ''' and C /= '"'
        and C /= '/' and C /= '=' and C /= '<';
   end Is_Letter;

   procedure Skip_Spaces (P : in out Parser) is
      C : Wide_Wide_Character;
   begin
      while not P.Is_Eof loop
         Peek (P, C);
         if not Is_Space (C) then
            Put_Back (P, C);
            return;
         end if;
      end loop;
   end Skip_Spaces;

   --  ------------------------------
   --  Parse an HTML attribute
   --  ------------------------------
   procedure Parse_Attribute_Name (P    : in out Parser;
                                   Name : in out Unbounded_Wide_Wide_String) is
      C : Wide_Wide_Character;
   begin
      Name := To_Unbounded_Wide_Wide_String ("");
      Skip_Spaces (P);
      while not P.Is_Eof loop
         Peek (P, C);
         if not Is_Letter (C) then
            Put_Back (P, C);
            return;
         end if;
         Ada.Strings.Wide_Wide_Unbounded.Append (Name, C);
      end loop;
   end Parse_Attribute_Name;

   procedure Collect_Attribute_Value (P     : in out Parser;
                                      Value : in out Unbounded_Wide_Wide_String) is
      C     : Wide_Wide_Character;
      Token : Wide_Wide_Character;
   begin
      Value := To_Unbounded_Wide_Wide_String ("");
      Peek (P, Token);
      if Is_Space (Token) then
         return;
      elsif Token = '>' then
         Put_Back (P, Token);
         return;
      elsif Token /= ''' and Token /= '"' then
         Append (Value, Token);
         while not P.Is_Eof loop
            Peek (P, C);
            if C = ''' or C = '"' or C = ' ' or C = '=' or C = '>' or C = '<' or C = '`' then
               Put_Back (P, C);
               return;
            end if;
            Append (Value, C);
         end loop;
      else
         while not P.Is_Eof loop
            Peek (P, C);
            if C = Token then
               return;
            end if;
            Append (Value, C);
         end loop;
      end if;
   end Collect_Attribute_Value;

   --  ------------------------------
   --  Parse a list of HTML attributes up to the first '>'.
   --  attr-name
   --  attr-name=
   --  attr-name=value
   --  attr-name='value'
   --  attr-name="value"
   --  <name name='value' ...>
   --  ------------------------------
   procedure Collect_Attributes (P     : in out Parser) is
      C     : Wide_Wide_Character;
      Name  : Unbounded_Wide_Wide_String;
      Value : Unbounded_Wide_Wide_String;
   begin
      Wiki.Attributes.Clear (P.Attributes);
      while not P.Is_Eof loop
         Parse_Attribute_Name (P, Name);
         Skip_Spaces (P);
         Peek (P, C);
         if C = '>' or C = '<' or C = '/' then
            Put_Back (P, C);
            exit;
         end if;
         if C = '=' then
            Collect_Attribute_Value (P, Value);
            Attributes.Append (P.Attributes, Name, Value);
         elsif Is_Space (C) and Length (Name) > 0 then
            Attributes.Append (P.Attributes, Name, Null_Unbounded_Wide_Wide_String);
         end if;
      end loop;
      --  Peek (P, C);

      --  Add any pending attribute.
      if Length (Name) > 0 then
         Attributes.Append (P.Attributes, Name, Null_Unbounded_Wide_Wide_String);
      end if;
   end Collect_Attributes;

   --  ------------------------------
   --  Parse a HTML/XML comment to strip it.
   --  ------------------------------
   procedure Parse_Comment (P : in out Parser) is
      C     : Wide_Wide_Character;
   begin
      Peek (P, C);
      while not P.Is_Eof loop
         Peek (P, C);
         if C = '-' then
            declare
               Count : Natural := 1;
            begin
               Peek (P, C);
               while not P.Is_Eof and C = '-' loop
                  Peek (P, C);
                  Count := Count + 1;
               end loop;
               exit when C = '>' and Count >= 2;
            end;
         end if;
      end loop;
   end Parse_Comment;

   --  ------------------------------
   --  Parse a simple DOCTYPE declaration and ignore it.
   --  ------------------------------
   procedure Parse_Doctype (P : in out Parser) is
      C : Wide_Wide_Character;
   begin
      while not P.Is_Eof loop
         Peek (P, C);
         exit when C = '>';
      end loop;
   end Parse_Doctype;

   --  ------------------------------
   --  Parse a HTML element <XXX attributes>
   --  or parse an end of HTML element </XXX>
   --  ------------------------------
   procedure Parse_Element (P : in out Parser) is
      Name : Unbounded_Wide_Wide_String;
      C    : Wide_Wide_Character;
   begin
      Peek (P, C);
      if C = '!' then
         Peek (P, C);
         if C = '-' then
            Parse_Comment (P);
         else
            Parse_Doctype (P);
         end if;
         return;
      end if;
      if C /= '/' then
         Put_Back (P, C);
      end if;
      Parse_Attribute_Name (P, Name);
      if C = '/' then
         Skip_Spaces (P);
         Peek (P, C);
         if C /= '>' then
            Put_Back (P, C);
         end if;
         Flush_Text (P);
         End_Element (P, Name);
      else
         Collect_Attributes (P);
         Peek (P, C);
         if C = '/' then
            Peek (P, C);
            if C = '>' then
               Start_Element (P, Name, P.Attributes);
               End_Element (P, Name);
               return;
            end if;
         elsif C /= '>' then
            Put_Back (P, C);
         end if;
         Start_Element (P, Name, P.Attributes);
      end if;
   end Parse_Element;

   --  ------------------------------
   --  Parse an HTML entity such as   and replace it with the corresponding code.
   --  ------------------------------
   procedure Parse_Entity (P     : in out Parser;
                           Token : in Wide_Wide_Character) is
      Name : String (1 .. 10);
      Len  : Natural := 0;
      High : Natural := Wiki.Parsers.Html.Entities.Keywords'Last;
      Low  : Natural := Wiki.Parsers.Html.Entities.Keywords'First;
      Pos  : Natural;
      C    : Wide_Wide_Character;
   begin
      loop
         Peek (P, C);
         exit when C = ';';
         if Len < Name'Last then
            Len := Len + 1;
         end if;
         Name (Len) := Ada.Characters.Conversions.To_Character (C);
      end loop;
      while Low <= High loop
         Pos := (Low + High) / 2;
         if Wiki.Parsers.Html.Entities.Keywords (Pos).all = Name (1 .. Len) then
            Parse_Text (P, Entities.Mapping (Pos));
            return;
         elsif Entities.Keywords (Pos).all < Name (1 .. Len) then
            Low := Pos + 1;
         else
            High := Pos - 1;
         end if;
      end loop;
   end Parse_Entity;

end Wiki.Parsers.Html;

-----------------------------------------------------------------------
--  wiki-parsers-html -- Wiki HTML parser
--  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.Characters.Conversions;

with Wiki.Parsers.Html.Entities;
package body Wiki.Parsers.Html is

   --  Parse a HTML/XML comment to strip it.
   procedure Parse_Comment (P : in out Parser);

   --  Parse a simple DOCTYPE declaration and ignore it.
   procedure Parse_Doctype (P : in out Parser);

   procedure Collect_Attributes (P     : in out Parser);
   function Is_Space (C : in Wide_Wide_Character) return Boolean;
   function Is_Letter (C : in Wide_Wide_Character) return Boolean;
   procedure Collect_Attribute_Value (P     : in out Parser;
                                      Value : in out Unbounded_Wide_Wide_String);

   function Is_Space (C : in Wide_Wide_Character) return Boolean is
   begin
      return C = ' ' or C = LF or C = CR;
   end Is_Space;

   function Is_Letter (C : in Wide_Wide_Character) return Boolean is
   begin
      return C > ' ' and C /= ':' and C /= '>' and C /= ''' and C /= '"'
        and C /= '/' and C /= '=' and C /= '<';
   end Is_Letter;

   procedure Skip_Spaces (P : in out Parser) is
      C : Wide_Wide_Character;
   begin
      while not P.Is_Eof loop
         Peek (P, C);
         if not Is_Space (C) then
            Put_Back (P, C);
            return;
         end if;
      end loop;
   end Skip_Spaces;

   --  ------------------------------
   --  Parse an HTML attribute
   --  ------------------------------
   procedure Parse_Attribute_Name (P    : in out Parser;
                                   Name : in out Unbounded_Wide_Wide_String) is
      C : Wide_Wide_Character;
   begin
      Name := To_Unbounded_Wide_Wide_String ("");
      Skip_Spaces (P);
      while not P.Is_Eof loop
         Peek (P, C);
         if not Is_Letter (C) then
            Put_Back (P, C);
            return;
         end if;
         Ada.Strings.Wide_Wide_Unbounded.Append (Name, C);
      end loop;
   end Parse_Attribute_Name;

   procedure Collect_Attribute_Value (P     : in out Parser;
                                      Value : in out Unbounded_Wide_Wide_String) is
      C     : Wide_Wide_Character;
      Token : Wide_Wide_Character;
   begin
      Value := To_Unbounded_Wide_Wide_String ("");
      Peek (P, Token);
      if Is_Space (Token) then
         return;
      elsif Token = '>' then
         Put_Back (P, Token);
         return;
      elsif Token /= ''' and Token /= '"' then
         Append (Value, Token);
         while not P.Is_Eof loop
            Peek (P, C);
            if C = ''' or C = '"' or C = ' ' or C = '=' or C = '>' or C = '<' or C = '`' then
               Put_Back (P, C);
               return;
            end if;
            Append (Value, C);
         end loop;
      else
         while not P.Is_Eof loop
            Peek (P, C);
            if C = Token then
               return;
            end if;
            Append (Value, C);
         end loop;
      end if;
   end Collect_Attribute_Value;

   --  ------------------------------
   --  Parse a list of HTML attributes up to the first '>'.
   --  attr-name
   --  attr-name=
   --  attr-name=value
   --  attr-name='value'
   --  attr-name="value"
   --  <name name='value' ...>
   --  ------------------------------
   procedure Collect_Attributes (P     : in out Parser) is
      C     : Wide_Wide_Character;
      Name  : Unbounded_Wide_Wide_String;
      Value : Unbounded_Wide_Wide_String;
   begin
      Wiki.Attributes.Clear (P.Attributes);
      while not P.Is_Eof loop
         Parse_Attribute_Name (P, Name);
         Skip_Spaces (P);
         Peek (P, C);
         if C = '>' or C = '<' or C = '/' then
            Put_Back (P, C);
            exit;
         end if;
         if C = '=' then
            Collect_Attribute_Value (P, Value);
            Attributes.Append (P.Attributes, Name, Value);
         elsif Is_Space (C) and Length (Name) > 0 then
            Attributes.Append (P.Attributes, Name, Null_Unbounded_Wide_Wide_String);
         end if;
      end loop;
      --  Peek (P, C);

      --  Add any pending attribute.
      if Length (Name) > 0 then
         Attributes.Append (P.Attributes, Name, Null_Unbounded_Wide_Wide_String);
      end if;
   end Collect_Attributes;

   --  ------------------------------
   --  Parse a HTML/XML comment to strip it.
   --  ------------------------------
   procedure Parse_Comment (P : in out Parser) is
      C     : Wide_Wide_Character;
   begin
      Peek (P, C);
      while not P.Is_Eof loop
         Peek (P, C);
         if C = '-' then
            declare
               Count : Natural := 1;
            begin
               Peek (P, C);
               while not P.Is_Eof and C = '-' loop
                  Peek (P, C);
                  Count := Count + 1;
               end loop;
               exit when C = '>' and Count >= 2;
            end;
         end if;
      end loop;
   end Parse_Comment;

   --  ------------------------------
   --  Parse a simple DOCTYPE declaration and ignore it.
   --  ------------------------------
   procedure Parse_Doctype (P : in out Parser) is
      C : Wide_Wide_Character;
   begin
      while not P.Is_Eof loop
         Peek (P, C);
         exit when C = '>';
      end loop;
   end Parse_Doctype;

   --  ------------------------------
   --  Parse a HTML element <XXX attributes>
   --  or parse an end of HTML element </XXX>
   --  ------------------------------
   procedure Parse_Element (P : in out Parser) is
      Name : Unbounded_Wide_Wide_String;
      C    : Wide_Wide_Character;
   begin
      Peek (P, C);
      if C = '!' then
         Peek (P, C);
         if C = '-' then
            Parse_Comment (P);
         else
            Parse_Doctype (P);
         end if;
         return;
      end if;
      if C /= '/' then
         Put_Back (P, C);
      end if;
      Parse_Attribute_Name (P, Name);
      if C = '/' then
         Skip_Spaces (P);
         Peek (P, C);
         if C /= '>' then
            Put_Back (P, C);
         end if;
         Flush_Text (P);
         End_Element (P, Name);
      else
         Collect_Attributes (P);
         Peek (P, C);
         if C = '/' then
            Peek (P, C);
            if C = '>' then
               Start_Element (P, Name, P.Attributes);
               End_Element (P, Name);
               return;
            end if;
         elsif C /= '>' then
            Put_Back (P, C);
         end if;
         Start_Element (P, Name, P.Attributes);
      end if;
   end Parse_Element;

   --  ------------------------------
   --  Parse an HTML entity such as   and replace it with the corresponding code.
   --  ------------------------------
   procedure Parse_Entity (P     : in out Parser;
                           Token : in Wide_Wide_Character) is
      Name : String (1 .. 10);
      Len  : Natural := 0;
      High : Natural := Wiki.Parsers.Html.Entities.Keywords'Last;
      Low  : Natural := Wiki.Parsers.Html.Entities.Keywords'First;
      Pos  : Natural;
      C    : Wide_Wide_Character;
   begin
      while Len < Name'Last loop
         Peek (P, C);
         exit when C = ';' or else P.Is_Eof;
         Len := Len + 1;
         Name (Len) := Ada.Characters.Conversions.To_Character (C);
      end loop;
      while Low <= High loop
         Pos := (Low + High) / 2;
         if Wiki.Parsers.Html.Entities.Keywords (Pos).all = Name (1 .. Len) then
            Parse_Text (P, Entities.Mapping (Pos));
            return;
         elsif Entities.Keywords (Pos).all < Name (1 .. Len) then
            Low := Pos + 1;
         else
            High := Pos - 1;
         end if;
      end loop;

      --  The HTML entity is not recognized: we must treat it as plain wiki text.
      Parse_Text (P, '&');
      for I in 1 .. Len loop
         Parse_Text (P, Ada.Characters.Conversions.To_Wide_Wide_Character (Name (I)));
      end loop;
   end Parse_Entity;

end Wiki.Parsers.Html;

Fix infinite loop when parsing invalid HTML entities. Treat these invalid entities as plain wiki text so that & character can be printed easily in Mediawiki wiki content


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

with Ada.Strings.Unbounded;

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

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

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

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

   procedure Save (Bean : in out Question_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

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

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

end AWA.Questions.Beans;

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

with Ada.Strings.Unbounded;

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

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

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

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

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

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

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

end AWA.Questions.Beans;

Document the bean operations

Document the bean operations


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

with AWA.Services.Contexts;
with AWA.Modules.Get;
with Util.Log.Loggers;
with Util.Beans.Objects;
with Util.Beans.Basic;
package body AWA.Settings.Modules is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Awa.Awa-settings.Module");

   package ASC renames AWA.Services.Contexts;

   --  Set the user setting with the given name in the setting manager cache
   --  and in the database.
   procedure Set (Manager : in out Setting_Manager;
                  Name    : in String;
                  Value   : in String) is
   begin
      Manager.Data.Set (Name, Value);
   end Set;

   --  Get the user setting with the given name from the setting manager cache.
   --  Load the user setting from the database if necessary.
   procedure Get (Manager : in out Setting_Manager;
                  Name    : in String;
                  Default : in String;
                  Value   : out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Manager.Data.Get (Name, Default, Value);
   end Get;

   function Current return Setting_Manager_Access is
      Ctx : ASC.Service_Context_Access := ASC.Current;
      Obj : Util.Beans.Objects.Object := Ctx.Get_Session_Attribute ("AWA.Settings");
      Bean : access Util.Beans.Basic.Readonly_Bean'Class := Util.Beans.Objects.To_Bean (Obj);
   begin
      if Bean = null or else not (Bean.all in Setting_Manager'Class) then
         declare
            Mgr : Setting_Manager_Access := new Setting_Manager;
         begin
            Obj := Util.Beans.Objects.To_Object (Mgr.all'Access);
            Ctx.Set_Session_Attribute ("AWA.Settings", Obj);
            return Mgr;
         end;
      else
         return Setting_Manager'Class (Bean.all)'Access;
      end if;
   end Current;

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

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

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

   --  ------------------------------
   --  Get the awa-settings module.
   --  ------------------------------
   function Get_Setting_Module return Setting_Module_Access is
      function Get is new AWA.Modules.Get (Setting_Module, Setting_Module_Access, NAME);
   begin
      return Get;
   end Get_Setting_Module;

   procedure Free is new Ada.Unchecked_Deallocation (Object => Setting_Data,
                                                     Name   => Setting_Data_Access);

   use Ada.Strings.Unbounded;

   protected body Settings is

      procedure Get (Name    : in String;
                     Default : in String;
                     Value   : out Ada.Strings.Unbounded.Unbounded_String) is
         Item     : Setting_Data_Access := First;
         Previous : Setting_Data_Access := null;
      begin
         while Item /= null loop
            if Item.Name = Name then
               Value := Item.Value;
               if Previous /= null then
                  Previous.Next_Setting := Item.Next_Setting;
                  First := Item;
               end if;
               return;
            end if;
            Previous := Item;
            Item := Item.Next_Setting;
         end loop;
         Value := Ada.Strings.Unbounded.To_Unbounded_String (Default);
      end Get;

      procedure Set (Name  : in String;
                     Value : in String) is
         Item     : Setting_Data_Access := First;
         Previous : Setting_Data_Access := null;
      begin
         while Item /= null loop
            if Item.Name = Name then
               if Previous /= null then
                  Previous.Next_Setting := Item.Next_Setting;
                  First := Item;
               end if;
               if Item.Value = Value then
                  return;
               end if;
               Item.Value := Ada.Strings.Unbounded.To_Unbounded_String (Value);
               return;
            end if;
            Previous := Item;
            Item := Item.Next_Setting;
         end loop;
      end Set;

      procedure Clear is
      begin
         while First /= null loop
            declare
               Item : Setting_Data_Access := First;
            begin
               First := Item.Next_Setting;
               Free (Item);
            end;
         end loop;
      end Clear;

   end Settings;

end AWA.Settings.Modules;

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

with AWA.Services.Contexts;
with AWA.Modules.Get;
with Util.Log.Loggers;
with Util.Beans.Objects;
with Util.Beans.Basic;
package body AWA.Settings.Modules is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Awa.Awa-settings.Module");

   package ASC renames AWA.Services.Contexts;

   --  Set the user setting with the given name in the setting manager cache
   --  and in the database.
   procedure Set (Manager : in out Setting_Manager;
                  Name    : in String;
                  Value   : in String) is
   begin
      Manager.Data.Set (Name, Value);
   end Set;

   --  Get the user setting with the given name from the setting manager cache.
   --  Load the user setting from the database if necessary.
   procedure Get (Manager : in out Setting_Manager;
                  Name    : in String;
                  Default : in String;
                  Value   : out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Manager.Data.Get (Name, Default, Value);
   end Get;

   function Current return Setting_Manager_Access is
      Ctx : ASC.Service_Context_Access := ASC.Current;
      Obj : Util.Beans.Objects.Object := Ctx.Get_Session_Attribute ("AWA.Settings");
      Bean : access Util.Beans.Basic.Readonly_Bean'Class := Util.Beans.Objects.To_Bean (Obj);
   begin
      if Bean = null or else not (Bean.all in Setting_Manager'Class) then
         declare
            Mgr : Setting_Manager_Access := new Setting_Manager;
         begin
            Obj := Util.Beans.Objects.To_Object (Mgr.all'Access);
            Ctx.Set_Session_Attribute ("AWA.Settings", Obj);
            return Mgr;
         end;
      else
         return Setting_Manager'Class (Bean.all)'Access;
      end if;
   end Current;

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

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

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

   --  ------------------------------
   --  Get the awa-settings module.
   --  ------------------------------
   function Get_Setting_Module return Setting_Module_Access is
      function Get is new AWA.Modules.Get (Setting_Module, Setting_Module_Access, NAME);
   begin
      return Get;
   end Get_Setting_Module;

   procedure Free is new Ada.Unchecked_Deallocation (Object => Setting_Data,
                                                     Name   => Setting_Data_Access);

   use Ada.Strings.Unbounded;

   protected body Settings is

      procedure Get (Name    : in String;
                     Default : in String;
                     Value   : out Ada.Strings.Unbounded.Unbounded_String) is
         Item     : Setting_Data_Access := First;
         Previous : Setting_Data_Access := null;
      begin
         while Item /= null loop
            if Item.Name = Name then
               Value := Item.Value;
               if Previous /= null then
                  Previous.Next_Setting := Item.Next_Setting;
                  First := Item;
               end if;
               return;
            end if;
            Previous := Item;
            Item := Item.Next_Setting;
         end loop;
         Value := Ada.Strings.Unbounded.To_Unbounded_String (Default);
      end Get;

      procedure Set (Name  : in String;
                     Value : in String) is
         Item     : Setting_Data_Access := First;
         Previous : Setting_Data_Access := null;
      begin
         while Item /= null loop
            if Item.Name = Name then
               if Previous /= null then
                  Previous.Next_Setting := Item.Next_Setting;
                  First := Item;
               end if;
               if Item.Value = Value then
                  return;
               end if;
               Item.Value := Ada.Strings.Unbounded.To_Unbounded_String (Value);
               return;
            end if;
            Previous := Item;
            Item := Item.Next_Setting;
         end loop;
         Item := new Setting_Data;
         Item.Name  := Ada.Strings.Unbounded.To_Unbounded_String (Name);
         Item.Value := Ada.Strings.Unbounded.To_Unbounded_String (Value);
         Item.Next_Setting := First;
         First := Item;
      end Set;

      procedure Clear is
      begin
         while First /= null loop
            declare
               Item : Setting_Data_Access := First;
            begin
               First := Item.Next_Setting;
               Free (Item);
            end;
         end loop;
      end Clear;

   end Settings;

end AWA.Settings.Modules;

Create the user setting if it does not exist


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

with ASF.Components.Base;
with ASF.Views.Nodes;
with ASF.Components.Ajax.Includes;
package body ASF.Components.Ajax.Factory is

   function Create_Include return Base.UIComponent_Access;

   --  ------------------------------
   --  Create an UIInclude component
   --  ------------------------------
   function Create_Include return Base.UIComponent_Access is
   begin
      return new ASF.Components.Ajax.Includes.UIInclude;
   end Create_Include;

   use ASF.Views.Nodes;

   URI                     : aliased constant String := "http://code.google.com/p/ada-asf/ajax";
   INCLUDE_TAG             : aliased constant String := "include";

   Ajax_Bindings : aliased constant ASF.Factory.Binding_Array
     := (1 => (Name      => INCLUDE_TAG'Access,
               Component => Create_Include'Access,
               Tag       => Create_Component_Node'Access)
        );

   Ajax_Factory : aliased constant ASF.Factory.Factory_Bindings
     := (URI => URI'Access, Bindings => Ajax_Bindings'Access);

   --  ------------------------------
   --  Get the Ajax component factory.
   --  ------------------------------
   function Definition return ASF.Factory.Factory_Bindings_Access is
   begin
      return Ajax_Factory'Access;
   end Definition;

end ASF.Components.Ajax.Factory;

-----------------------------------------------------------------------
--  components-ajax-factory -- Factory for AJAX Components
--  Copyright (C) 2011, 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 ASF.Components.Base;
with ASF.Views.Nodes;
with ASF.Components.Ajax.Includes;
package body ASF.Components.Ajax.Factory is

   function Create_Include return Base.UIComponent_Access;

   --  ------------------------------
   --  Create an UIInclude component
   --  ------------------------------
   function Create_Include return Base.UIComponent_Access is
   begin
      return new ASF.Components.Ajax.Includes.UIInclude;
   end Create_Include;

   use ASF.Views.Nodes;

   URI                     : aliased constant String := "http://code.google.com/p/ada-asf/ajax";
   INCLUDE_TAG             : aliased constant String := "include";

   --  ------------------------------
   --  Register the Ajax component factory.
   --  ------------------------------
   procedure Register (Factory : in out ASF.Factory.Component_Factory) is
   begin
      null;
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => INCLUDE_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Include'Access);
   end Register;

end ASF.Components.Ajax.Factory;

Change the Definition function into a Register procedure


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

package body MAT.Events.Targets is

   --  ------------------------------
   --  Add the event in the list of events and increment the event counter.
   --  ------------------------------
   procedure Insert (Target : in out Target_Events;
                     Event  : in Probe_Event_Type) is
   begin
      Target.Events.Insert (Event);
      Util.Concurrent.Counters.Increment (Target.Event_Count);
   end Insert;

   procedure Get_Events (Target : in out Target_Events;
                         Start  : in MAT.Types.Target_Time;
                         Finish : in MAT.Types.Target_Time;
                         Into   : in out Target_Event_Vector) is
   begin
      Target.Events.Get_Events (Start, Finish, Into);
   end Get_Events;

   --  ------------------------------
   --  Get the start and finish time for the events that have been received.
   --  ------------------------------
   procedure Get_Time_Range (Target : in out Target_Events;
                             Start  : out MAT.Types.Target_Time;
                             Finish : out MAT.Types.Target_Time) is
   begin
      Target.Events.Get_Time_Range (Start, Finish);
   end Get_Time_Range;

   --  ------------------------------
   --  Get the probe event with the given allocated unique id.
   --  ------------------------------
   function Get_Event (Target : in Target_Events;
                       Id     : in Event_Id_Type) return Probe_Event_Type is
   begin
      return Target.Events.Get_Event (Id);
   end Get_Event;

   --  ------------------------------
   --  Get the current event counter.
   --  ------------------------------
   function Get_Event_Counter (Target : in Target_Events) return Integer is
   begin
      return Util.Concurrent.Counters.Value (Target.Event_Count);
   end Get_Event_Counter;

   protected body Event_Collector is

      --  ------------------------------
      --  Add the event in the list of events.
      --  ------------------------------
      procedure Insert (Event : in Probe_Event_Type) is
         Info : Target_Event;
      begin
         if Current = null then
            Current := new Event_Block;
            Current.Start := Event.Time;
            Events.Insert (Event.Time, Current);
            Ids.Insert (Last_Id + 1, Current);
         end if;
         Current.Count := Current.Count + 1;
         Current.Events (Current.Count) := Event;
         Current.Events (Current.Count).Id := Last_Id;
         Last_Id := Last_Id + 1;
         Current.Finish := Event.Time;
         if Current.Count = Current.Events'Last then
            Current := null;
         end if;
      end Insert;

      procedure Get_Events (Start  : in MAT.Types.Target_Time;
                            Finish : in MAT.Types.Target_Time;
                            Into   : in out Target_Event_Vector) is
         Iter  : Event_Cursor := Events.Floor (Start);
         Block : Event_Block_Access;
      begin
         while Event_Maps.Has_Element (Iter) loop
            Block := Event_Maps.Element (Iter);
            exit when Block.Start > Finish;
            for I in Block.Events'First .. Block.Count loop
               exit when Block.Events (I).Time > Finish;
               if Block.Events (I).Time >= Start then
                  Into.Append (Block.Events (I));
               end if;
            end loop;
            Event_Maps.Next (Iter);
         end loop;
      end Get_Events;

      --  ------------------------------
      --  Get the start and finish time for the events that have been received.
      --  ------------------------------
      procedure Get_Time_Range (Start  : out MAT.Types.Target_Time;
                                Finish : out MAT.Types.Target_Time) is
         First : constant Event_Block_Access := Events.First_Element;
         Last  : constant Event_Block_Access := Events.Last_Element;
      begin
         Start  := First.Events (First.Events'First).Time;
         Finish := Last.Events (Last.Count).Time;
      end Get_Time_Range;

      --  ------------------------------
      --  Get the probe event with the given allocated unique id.
      --  ------------------------------
      function Get_Event (Id : in Event_Id_Type) return Probe_Event_Type is
         Iter  : Event_Id_Cursor := Ids.Floor (Id);
         Block : Event_Block_Access;
         Pos   : Event_Id_Type;
      begin
         while Event_Id_Maps.Has_Element (Iter) loop
            Block := Event_Id_Maps.Element (Iter);
            exit when Id < Block.Events (Block.Events'First).Id;
            Pos := Id - Block.Events (Block.Events'First).Id;
            if Pos < Block.Count then
               return Block.Events (Pos);
            end if;
            Event_Id_Maps.Next (Iter);
         end loop;
         raise Not_Found;
      end Get_Event;

      --  ------------------------------
      --  Iterate over the events starting from the <tt>Start</tt> event and until the
      --  <tt>Finish</tt> event is found (inclusive).  Execute the <tt>Process</tt> procedure
      --  with each event instance.
      --  ------------------------------
      procedure Iterate (Start   : in Event_Id_Type;
                         Finish  : in Event_Id_Type;
                         Process : access procedure (Event : in Probe_Event_Type)) is
         Iter  : Event_Id_Cursor := Ids.Floor (Start);
         Block : Event_Block_Access;
         Pos   : Event_Id_Type;
         Id    : Event_Id_Type := Start;
      begin
         --  First, find the block and position of the first event.
         while Event_Id_Maps.Has_Element (Iter) loop
            Block := Event_Id_Maps.Element (Iter);
            exit when Id < Block.Events (Block.Events'First).Id;
            Pos := Id - Block.Events (Block.Events'First).Id;
            if Pos < Block.Count then

               --  Second, iterate over the events moving to the next event block
               --  until we reach the last event.
               loop
                  Process (Block.Events (Pos));
                  exit when Id > Finish;
                  Pos := Pos + 1;
                  Id := Id + 1;
                  if Pos = Block.Count then
                     Event_Id_Maps.Next (Iter);
                     exit when not Event_Id_Maps.Has_Element (Iter);
                     Block := Event_Id_Maps.Element (Iter);
                     Pos := Block.Events'First;
                  end if;
               end loop;
            end if;
            Event_Id_Maps.Next (Iter);
         end loop;
      end Iterate;

   end Event_Collector;

end MAT.Events.Targets;

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

package body MAT.Events.Targets is

   --  ------------------------------
   --  Add the event in the list of events and increment the event counter.
   --  ------------------------------
   procedure Insert (Target : in out Target_Events;
                     Event  : in Probe_Event_Type) is
   begin
      Target.Events.Insert (Event);
      Util.Concurrent.Counters.Increment (Target.Event_Count);
   end Insert;

   procedure Get_Events (Target : in out Target_Events;
                         Start  : in MAT.Types.Target_Time;
                         Finish : in MAT.Types.Target_Time;
                         Into   : in out Target_Event_Vector) is
   begin
      Target.Events.Get_Events (Start, Finish, Into);
   end Get_Events;

   --  ------------------------------
   --  Get the start and finish time for the events that have been received.
   --  ------------------------------
   procedure Get_Time_Range (Target : in out Target_Events;
                             Start  : out MAT.Types.Target_Time;
                             Finish : out MAT.Types.Target_Time) is
   begin
      Target.Events.Get_Time_Range (Start, Finish);
   end Get_Time_Range;

   --  ------------------------------
   --  Get the probe event with the given allocated unique id.
   --  ------------------------------
   function Get_Event (Target : in Target_Events;
                       Id     : in Event_Id_Type) return Probe_Event_Type is
   begin
      return Target.Events.Get_Event (Id);
   end Get_Event;

   --  ------------------------------
   --  Get the current event counter.
   --  ------------------------------
   function Get_Event_Counter (Target : in Target_Events) return Integer is
   begin
      return Util.Concurrent.Counters.Value (Target.Event_Count);
   end Get_Event_Counter;

   --  ------------------------------
   --  Iterate over the events starting from the <tt>Start</tt> event and until the
   --  <tt>Finish</tt> event is found (inclusive).  Execute the <tt>Process</tt> procedure
   --  with each event instance.
   --  ------------------------------
   procedure Iterate (Target  : in out Target_Events;
                      Start   : in Event_Id_Type;
                      Finish  : in Event_Id_Type;
                      Process : access procedure (Event : in Probe_Event_Type)) is
   begin
      Target.Events.Iterate (Start, Finish, Process);
   end Iterate;

   protected body Event_Collector is

      --  ------------------------------
      --  Add the event in the list of events.
      --  ------------------------------
      procedure Insert (Event : in Probe_Event_Type) is
         Info : Target_Event;
      begin
         if Current = null then
            Current := new Event_Block;
            Current.Start := Event.Time;
            Events.Insert (Event.Time, Current);
            Ids.Insert (Last_Id + 1, Current);
         end if;
         Current.Count := Current.Count + 1;
         Current.Events (Current.Count) := Event;
         Current.Events (Current.Count).Id := Last_Id;
         Last_Id := Last_Id + 1;
         Current.Finish := Event.Time;
         if Current.Count = Current.Events'Last then
            Current := null;
         end if;
      end Insert;

      procedure Get_Events (Start  : in MAT.Types.Target_Time;
                            Finish : in MAT.Types.Target_Time;
                            Into   : in out Target_Event_Vector) is
         Iter  : Event_Cursor := Events.Floor (Start);
         Block : Event_Block_Access;
      begin
         while Event_Maps.Has_Element (Iter) loop
            Block := Event_Maps.Element (Iter);
            exit when Block.Start > Finish;
            for I in Block.Events'First .. Block.Count loop
               exit when Block.Events (I).Time > Finish;
               if Block.Events (I).Time >= Start then
                  Into.Append (Block.Events (I));
               end if;
            end loop;
            Event_Maps.Next (Iter);
         end loop;
      end Get_Events;

      --  ------------------------------
      --  Get the start and finish time for the events that have been received.
      --  ------------------------------
      procedure Get_Time_Range (Start  : out MAT.Types.Target_Time;
                                Finish : out MAT.Types.Target_Time) is
         First : constant Event_Block_Access := Events.First_Element;
         Last  : constant Event_Block_Access := Events.Last_Element;
      begin
         Start  := First.Events (First.Events'First).Time;
         Finish := Last.Events (Last.Count).Time;
      end Get_Time_Range;

      --  ------------------------------
      --  Get the probe event with the given allocated unique id.
      --  ------------------------------
      function Get_Event (Id : in Event_Id_Type) return Probe_Event_Type is
         Iter  : Event_Id_Cursor := Ids.Floor (Id);
         Block : Event_Block_Access;
         Pos   : Event_Id_Type;
      begin
         while Event_Id_Maps.Has_Element (Iter) loop
            Block := Event_Id_Maps.Element (Iter);
            exit when Id < Block.Events (Block.Events'First).Id;
            Pos := Id - Block.Events (Block.Events'First).Id;
            if Pos < Block.Count then
               return Block.Events (Pos);
            end if;
            Event_Id_Maps.Next (Iter);
         end loop;
         raise Not_Found;
      end Get_Event;

      --  ------------------------------
      --  Iterate over the events starting from the <tt>Start</tt> event and until the
      --  <tt>Finish</tt> event is found (inclusive).  Execute the <tt>Process</tt> procedure
      --  with each event instance.
      --  ------------------------------
      procedure Iterate (Start   : in Event_Id_Type;
                         Finish  : in Event_Id_Type;
                         Process : access procedure (Event : in Probe_Event_Type)) is
         Iter  : Event_Id_Cursor := Ids.Floor (Start);
         Block : Event_Block_Access;
         Pos   : Event_Id_Type;
         Id    : Event_Id_Type := Start;
      begin
         --  First, find the block and position of the first event.
         while Event_Id_Maps.Has_Element (Iter) loop
            Block := Event_Id_Maps.Element (Iter);
            exit when Id < Block.Events (Block.Events'First).Id;
            Pos := Id - Block.Events (Block.Events'First).Id;
            if Pos < Block.Count then

               --  Second, iterate over the events moving to the next event block
               --  until we reach the last event.
               loop
                  Process (Block.Events (Pos));
                  exit when Id > Finish;
                  Pos := Pos + 1;
                  Id := Id + 1;
                  if Pos = Block.Count then
                     Event_Id_Maps.Next (Iter);
                     exit when not Event_Id_Maps.Has_Element (Iter);
                     Block := Event_Id_Maps.Element (Iter);
                     Pos := Block.Events'First;
                  end if;
               end loop;
            end if;
            Event_Id_Maps.Next (Iter);
         end loop;
      end Iterate;

   end Event_Collector;

end MAT.Events.Targets;

Implement the Iterate procedure

Implement the Iterate procedure


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

with ADO.Queries;
with ADO.Statements;
with ADO.Sessions.Entities;

package body AWA.Tags.Beans is

   --  ------------------------------
   --  Compare two tags on their count and name.
   --  ------------------------------
   function "<" (Left, Right : in AWA.Tags.Models.Tag_Info) return Boolean is
      use type Ada.Strings.Unbounded.Unbounded_String;
   begin
      if Left.Count = Right.Count then
         return Left.Tag < Right.Tag;
      else
         return Left.Count < Right.Count;
      end if;
   end "<";

   --  ------------------------------
   --  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 Tag_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);
      end if;
   end Set_Value;

   --  ------------------------------
   --  Set the entity type (database table) onto which the tags are associated.
   --  ------------------------------
   procedure Set_Entity_Type (Into  : in out Tag_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 tag on the entity.
   --  ------------------------------
   procedure Set_Permission (Into       : in out Tag_List_Bean;
                             Permission : in String) is
   begin
      Into.Permission := Ada.Strings.Unbounded.To_Unbounded_String (Permission);
   end Set_Permission;

   --  ------------------------------
   --  Load the tags associated with the given database identifier.
   --  ------------------------------
   procedure Load_Tags (Into          : in out Tag_List_Bean;
                        Session       : in 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
      Query.Set_Query (AWA.Tags.Models.Query_Tag_List);
      Query.Bind_Param ("entity_type", Kind);
      Query.Bind_Param ("entity_id", For_Entity_Id);
      declare
         Stmt : ADO.Statements.Query_Statement := Session.Create_Statement (Query);
      begin
         Stmt.Execute;

         while Stmt.Has_Elements loop
            Into.List.Append (Util.Beans.Objects.To_Object (Stmt.Get_String (0)));
            Stmt.Next;
         end loop;
      end;
   end Load_Tags;

   --  ------------------------------
   --  Set the list of tags to add.
   --  ------------------------------
   procedure Set_Added (Into  : in out Tag_List_Bean;
                        Tags  : in Util.Strings.Vectors.Vector) is
   begin
      Into.Added := Tags;
   end Set_Added;

   --  ------------------------------
   --  Set the list of tags to remove.
   --  ------------------------------
   procedure Set_Deleted (Into : in out Tag_List_Bean;
                          Tags : in Util.Strings.Vectors.Vector) is
   begin
      Into.Deleted := Tags;
   end Set_Deleted;

   --  ------------------------------
   --  Update the tags associated with the tag entity represented by <tt>For_Entity_Id</tt>.
   --  The list of tags defined by <tt>Set_Deleted</tt> are removed first and the list of
   --  tags defined by <tt>Set_Added</tt> are associated with the database entity.
   --  ------------------------------
   procedure Update_Tags (From          : in Tag_List_Bean;
                          For_Entity_Id : in ADO.Identifier) is
      use type AWA.Tags.Modules.Tag_Module_Access;

      Entity_Type : constant String := Ada.Strings.Unbounded.To_String (From.Entity_Type);
      Service     : AWA.Tags.Modules.Tag_Module_Access := From.Module;
   begin
      if Service = null then
         Service := AWA.Tags.Modules.Get_Tag_Module;
      end if;
      Service.Update_Tags (Id          => For_Entity_Id,
                           Entity_Type => Entity_Type,
                           Permission  => Ada.Strings.Unbounded.To_String (From.Permission),
                           Added       => From.Added,
                           Deleted     => From.Deleted);
   end Update_Tags;

   --  ------------------------------
   --  Create the tag list bean instance.
   --  ------------------------------
   function Create_Tag_List_Bean (Module : in AWA.Tags.Modules.Tag_Module_Access)
                                  return Util.Beans.Basic.Readonly_Bean_Access is
      Result : constant Tag_List_Bean_Access := new Tag_List_Bean;
   begin
      Result.Module := Module;
      return Result.all'Access;
   end Create_Tag_List_Bean;

   --  ------------------------------
   --  Search the tags that match the search string.
   --  ------------------------------
   procedure Search_Tags (Into    : in out Tag_Search_Bean;
                          Session : in ADO.Sessions.Session;
                          Search  : in String) 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
      Query.Set_Query (AWA.Tags.Models.Query_Tag_Search);
      Query.Bind_Param ("entity_type", Kind);
      Query.Bind_Param ("search", Search & "%");
      declare
         Stmt : ADO.Statements.Query_Statement := Session.Create_Statement (Query);
      begin
         Stmt.Execute;

         while Stmt.Has_Elements loop
            Into.List.Append (Util.Beans.Objects.To_Object (Stmt.Get_String (0)));
            Stmt.Next;
         end loop;
      end;
   end Search_Tags;

   --  ------------------------------
   --  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 Tag_Search_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 = "search" then
         declare
            Session : constant ADO.Sessions.Session := From.Module.Get_Session;
         begin
            From.Search_Tags (Session, Util.Beans.Objects.To_String (Value));
         end;
      end if;
   end Set_Value;

   --  ------------------------------
   --  Set the entity type (database table) onto which the tags are associated.
   --  ------------------------------
   procedure Set_Entity_Type (Into  : in out Tag_Search_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;

   --  ------------------------------
   --  Create the tag search bean instance.
   --  ------------------------------
   function Create_Tag_Search_Bean (Module : in AWA.Tags.Modules.Tag_Module_Access)
                                  return Util.Beans.Basic.Readonly_Bean_Access is
      Result : constant Tag_Search_Bean_Access := new Tag_Search_Bean;
   begin
      Result.Module := Module;
      return Result.all'Access;
   end Create_Tag_Search_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 Tag_Info_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);
         declare
            Session : ADO.Sessions.Session := From.Module.Get_Session;
         begin
            From.Load_Tags (Session);
         end;
      end if;
   end Set_Value;

   --  ------------------------------
   --  Load the list of tags.
   --  ------------------------------
   procedure Load_Tags (Into    : in out Tag_Info_List_Bean;
                        Session : in out ADO.Sessions.Session) 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
      Query.Set_Query (AWA.Tags.Models.Query_Tag_List_All);
      Query.Bind_Param ("entity_type", Kind);
      AWA.Tags.Models.List (Into, Session, Query);
   end Load_Tags;

   --  ------------------------------
   --  Create the tag info list bean instance.
   --  ------------------------------
   function Create_Tag_Info_List_Bean (Module : in AWA.Tags.Modules.Tag_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access is
      Result : constant Tag_Info_List_Bean_Access := new Tag_Info_List_Bean;
   begin
      Result.Module := Module;
      return Result.all'Access;
   end Create_Tag_Info_List_Bean;

   --  ------------------------------
   --  Get the list of tags associated with the given entity.
   --  Returns null if the entity does not have any tag.
   --  ------------------------------
   function Get_Tags (From       : in Entity_Tag_Map;
                      For_Entity : in ADO.Identifier)
                      return Util.Beans.Lists.Strings.List_Bean_Access is
      Pos : constant Entity_Tag_Maps.Cursor := From.Tags.Find (For_Entity);
   begin
      if Entity_Tag_Maps.Has_Element (Pos) then
         return Entity_Tag_Maps.Element (Pos);
      else
         return null;
      end if;
   end Get_Tags;

   --  ------------------------------
   --  Get the list of tags associated with the given entity.
   --  Returns a null object if the entity does not have any tag.
   --  ------------------------------
   function Get_Tags (From       : in Entity_Tag_Map;
                      For_Entity : in ADO.Identifier)
                      return Util.Beans.Objects.Object is
      Pos : constant Entity_Tag_Maps.Cursor := From.Tags.Find (For_Entity);
   begin
      if Entity_Tag_Maps.Has_Element (Pos) then
         return Util.Beans.Objects.To_Object (Value   => Entity_Tag_Maps.Element (Pos).all'Access,
                                              Storage => Util.Beans.Objects.STATIC);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Tags;

   --  ------------------------------
   --  Load the list of tags associated with a list of entities.
   --  ------------------------------
   procedure Load_Tags (Into        : in out Entity_Tag_Map;
                        Session     : in out ADO.Sessions.Session'Class;
                        Entity_Type : in String;
                        List        : in ADO.Utils.Identifier_Vector) is
      Query : ADO.Queries.Context;
      Kind  : ADO.Entity_Type;
   begin
      Into.Clear;
      if List.Is_Empty then
         return;
      end if;
      Kind := ADO.Sessions.Entities.Find_Entity_Type (Session, Entity_Type);
      Query.Set_Query (AWA.Tags.Models.Query_Tag_List_For_Entities);
      Query.Bind_Param ("entity_id_list", List);
      Query.Bind_Param ("entity_type", Kind);
      declare
         Stmt  : ADO.Statements.Query_Statement := Session.Create_Statement (Query);
         Id    : ADO.Identifier;
         List  : Util.Beans.Lists.Strings.List_Bean_Access;
         Pos   : Entity_Tag_Maps.Cursor;
      begin
         Stmt.Execute;
         while Stmt.Has_Elements loop
            Id := Stmt.Get_Identifier (0);
            Pos := Into.Tags.Find (Id);
            if not Entity_Tag_Maps.Has_Element (Pos) then
               List := new Util.Beans.Lists.Strings.List_Bean;
               Into.Tags.Insert (Id, List);
            else
               List := Entity_Tag_Maps.Element (Pos);
            end if;
            List.List.Append (Stmt.Get_String (1));
            Stmt.Next;
         end loop;
      end;
   end Load_Tags;

   --  ------------------------------
   --  Release the list of tags.
   --  ------------------------------
   procedure Clear (List : in out Entity_Tag_Map) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => Util.Beans.Lists.Strings.List_Bean'Class,
                                        Name   => Util.Beans.Lists.Strings.List_Bean_Access);

      Pos  : Entity_Tag_Maps.Cursor;
      Tags : Util.Beans.Lists.Strings.List_Bean_Access;
   begin
      loop
         Pos := List.Tags.First;
         exit when not Entity_Tag_Maps.Has_Element (Pos);
         Tags := Entity_Tag_Maps.Element (Pos);
         List.Tags.Delete (Pos);
         Free (Tags);
      end loop;
   end Clear;

   --  ------------------------------
   --  Release the list of tags.
   --  ------------------------------
   overriding
   procedure Finalize (List : in out Entity_Tag_Map) is
   begin
      List.Clear;
   end Finalize;

end AWA.Tags.Beans;

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

with ADO.Queries;
with ADO.Statements;
with ADO.Sessions.Entities;

package body AWA.Tags.Beans is

   --  ------------------------------
   --  Compare two tags on their count and name.
   --  ------------------------------
   function "<" (Left, Right : in AWA.Tags.Models.Tag_Info) return Boolean is
      use type Ada.Strings.Unbounded.Unbounded_String;
   begin
      if Left.Count = Right.Count then
         return Left.Tag < Right.Tag;
      else
         return Left.Count > Right.Count;
      end if;
   end "<";

   --  ------------------------------
   --  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 Tag_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);
      end if;
   end Set_Value;

   --  ------------------------------
   --  Set the entity type (database table) onto which the tags are associated.
   --  ------------------------------
   procedure Set_Entity_Type (Into  : in out Tag_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 tag on the entity.
   --  ------------------------------
   procedure Set_Permission (Into       : in out Tag_List_Bean;
                             Permission : in String) is
   begin
      Into.Permission := Ada.Strings.Unbounded.To_Unbounded_String (Permission);
   end Set_Permission;

   --  ------------------------------
   --  Load the tags associated with the given database identifier.
   --  ------------------------------
   procedure Load_Tags (Into          : in out Tag_List_Bean;
                        Session       : in 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
      Query.Set_Query (AWA.Tags.Models.Query_Tag_List);
      Query.Bind_Param ("entity_type", Kind);
      Query.Bind_Param ("entity_id", For_Entity_Id);
      declare
         Stmt : ADO.Statements.Query_Statement := Session.Create_Statement (Query);
      begin
         Stmt.Execute;

         while Stmt.Has_Elements loop
            Into.List.Append (Util.Beans.Objects.To_Object (Stmt.Get_String (0)));
            Stmt.Next;
         end loop;
      end;
   end Load_Tags;

   --  ------------------------------
   --  Set the list of tags to add.
   --  ------------------------------
   procedure Set_Added (Into  : in out Tag_List_Bean;
                        Tags  : in Util.Strings.Vectors.Vector) is
   begin
      Into.Added := Tags;
   end Set_Added;

   --  ------------------------------
   --  Set the list of tags to remove.
   --  ------------------------------
   procedure Set_Deleted (Into : in out Tag_List_Bean;
                          Tags : in Util.Strings.Vectors.Vector) is
   begin
      Into.Deleted := Tags;
   end Set_Deleted;

   --  ------------------------------
   --  Update the tags associated with the tag entity represented by <tt>For_Entity_Id</tt>.
   --  The list of tags defined by <tt>Set_Deleted</tt> are removed first and the list of
   --  tags defined by <tt>Set_Added</tt> are associated with the database entity.
   --  ------------------------------
   procedure Update_Tags (From          : in Tag_List_Bean;
                          For_Entity_Id : in ADO.Identifier) is
      use type AWA.Tags.Modules.Tag_Module_Access;

      Entity_Type : constant String := Ada.Strings.Unbounded.To_String (From.Entity_Type);
      Service     : AWA.Tags.Modules.Tag_Module_Access := From.Module;
   begin
      if Service = null then
         Service := AWA.Tags.Modules.Get_Tag_Module;
      end if;
      Service.Update_Tags (Id          => For_Entity_Id,
                           Entity_Type => Entity_Type,
                           Permission  => Ada.Strings.Unbounded.To_String (From.Permission),
                           Added       => From.Added,
                           Deleted     => From.Deleted);
   end Update_Tags;

   --  ------------------------------
   --  Create the tag list bean instance.
   --  ------------------------------
   function Create_Tag_List_Bean (Module : in AWA.Tags.Modules.Tag_Module_Access)
                                  return Util.Beans.Basic.Readonly_Bean_Access is
      Result : constant Tag_List_Bean_Access := new Tag_List_Bean;
   begin
      Result.Module := Module;
      return Result.all'Access;
   end Create_Tag_List_Bean;

   --  ------------------------------
   --  Search the tags that match the search string.
   --  ------------------------------
   procedure Search_Tags (Into    : in out Tag_Search_Bean;
                          Session : in ADO.Sessions.Session;
                          Search  : in String) 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
      Query.Set_Query (AWA.Tags.Models.Query_Tag_Search);
      Query.Bind_Param ("entity_type", Kind);
      Query.Bind_Param ("search", Search & "%");
      declare
         Stmt : ADO.Statements.Query_Statement := Session.Create_Statement (Query);
      begin
         Stmt.Execute;

         while Stmt.Has_Elements loop
            Into.List.Append (Util.Beans.Objects.To_Object (Stmt.Get_String (0)));
            Stmt.Next;
         end loop;
      end;
   end Search_Tags;

   --  ------------------------------
   --  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 Tag_Search_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 = "search" then
         declare
            Session : constant ADO.Sessions.Session := From.Module.Get_Session;
         begin
            From.Search_Tags (Session, Util.Beans.Objects.To_String (Value));
         end;
      end if;
   end Set_Value;

   --  ------------------------------
   --  Set the entity type (database table) onto which the tags are associated.
   --  ------------------------------
   procedure Set_Entity_Type (Into  : in out Tag_Search_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;

   --  ------------------------------
   --  Create the tag search bean instance.
   --  ------------------------------
   function Create_Tag_Search_Bean (Module : in AWA.Tags.Modules.Tag_Module_Access)
                                  return Util.Beans.Basic.Readonly_Bean_Access is
      Result : constant Tag_Search_Bean_Access := new Tag_Search_Bean;
   begin
      Result.Module := Module;
      return Result.all'Access;
   end Create_Tag_Search_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 Tag_Info_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);
         declare
            Session : ADO.Sessions.Session := From.Module.Get_Session;
         begin
            From.Load_Tags (Session);
         end;
      end if;
   end Set_Value;

   --  ------------------------------
   --  Load the list of tags.
   --  ------------------------------
   procedure Load_Tags (Into    : in out Tag_Info_List_Bean;
                        Session : in out ADO.Sessions.Session) 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
      Query.Set_Query (AWA.Tags.Models.Query_Tag_List_All);
      Query.Bind_Param ("entity_type", Kind);
      AWA.Tags.Models.List (Into, Session, Query);
   end Load_Tags;

   --  ------------------------------
   --  Create the tag info list bean instance.
   --  ------------------------------
   function Create_Tag_Info_List_Bean (Module : in AWA.Tags.Modules.Tag_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access is
      Result : constant Tag_Info_List_Bean_Access := new Tag_Info_List_Bean;
   begin
      Result.Module := Module;
      return Result.all'Access;
   end Create_Tag_Info_List_Bean;

   --  ------------------------------
   --  Get the list of tags associated with the given entity.
   --  Returns null if the entity does not have any tag.
   --  ------------------------------
   function Get_Tags (From       : in Entity_Tag_Map;
                      For_Entity : in ADO.Identifier)
                      return Util.Beans.Lists.Strings.List_Bean_Access is
      Pos : constant Entity_Tag_Maps.Cursor := From.Tags.Find (For_Entity);
   begin
      if Entity_Tag_Maps.Has_Element (Pos) then
         return Entity_Tag_Maps.Element (Pos);
      else
         return null;
      end if;
   end Get_Tags;

   --  ------------------------------
   --  Get the list of tags associated with the given entity.
   --  Returns a null object if the entity does not have any tag.
   --  ------------------------------
   function Get_Tags (From       : in Entity_Tag_Map;
                      For_Entity : in ADO.Identifier)
                      return Util.Beans.Objects.Object is
      Pos : constant Entity_Tag_Maps.Cursor := From.Tags.Find (For_Entity);
   begin
      if Entity_Tag_Maps.Has_Element (Pos) then
         return Util.Beans.Objects.To_Object (Value   => Entity_Tag_Maps.Element (Pos).all'Access,
                                              Storage => Util.Beans.Objects.STATIC);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Tags;

   --  ------------------------------
   --  Load the list of tags associated with a list of entities.
   --  ------------------------------
   procedure Load_Tags (Into        : in out Entity_Tag_Map;
                        Session     : in out ADO.Sessions.Session'Class;
                        Entity_Type : in String;
                        List        : in ADO.Utils.Identifier_Vector) is
      Query : ADO.Queries.Context;
      Kind  : ADO.Entity_Type;
   begin
      Into.Clear;
      if List.Is_Empty then
         return;
      end if;
      Kind := ADO.Sessions.Entities.Find_Entity_Type (Session, Entity_Type);
      Query.Set_Query (AWA.Tags.Models.Query_Tag_List_For_Entities);
      Query.Bind_Param ("entity_id_list", List);
      Query.Bind_Param ("entity_type", Kind);
      declare
         Stmt  : ADO.Statements.Query_Statement := Session.Create_Statement (Query);
         Id    : ADO.Identifier;
         List  : Util.Beans.Lists.Strings.List_Bean_Access;
         Pos   : Entity_Tag_Maps.Cursor;
      begin
         Stmt.Execute;
         while Stmt.Has_Elements loop
            Id := Stmt.Get_Identifier (0);
            Pos := Into.Tags.Find (Id);
            if not Entity_Tag_Maps.Has_Element (Pos) then
               List := new Util.Beans.Lists.Strings.List_Bean;
               Into.Tags.Insert (Id, List);
            else
               List := Entity_Tag_Maps.Element (Pos);
            end if;
            List.List.Append (Stmt.Get_String (1));
            Stmt.Next;
         end loop;
      end;
   end Load_Tags;

   --  ------------------------------
   --  Release the list of tags.
   --  ------------------------------
   procedure Clear (List : in out Entity_Tag_Map) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => Util.Beans.Lists.Strings.List_Bean'Class,
                                        Name   => Util.Beans.Lists.Strings.List_Bean_Access);

      Pos  : Entity_Tag_Maps.Cursor;
      Tags : Util.Beans.Lists.Strings.List_Bean_Access;
   begin
      loop
         Pos := List.Tags.First;
         exit when not Entity_Tag_Maps.Has_Element (Pos);
         Tags := Entity_Tag_Maps.Element (Pos);
         List.Tags.Delete (Pos);
         Free (Tags);
      end loop;
   end Clear;

   --  ------------------------------
   --  Release the list of tags.
   --  ------------------------------
   overriding
   procedure Finalize (List : in out Entity_Tag_Map) is
   begin
      List.Clear;
   end Finalize;

end AWA.Tags.Beans;

Fix sorting the tags to get the most used tags first


-----------------------------------------------------------------------
--  awa-wikis-previews -- Wiki preview management
--  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 ASF.Applications;

with AWA.Modules;
with AWA.Jobs.Services;
with AWA.Wikis.Modules;
with AWA.Wikis.Models;

--  == Wiki Preview Module ==
--  The <tt>AWA.Wikis.Previews</tt> package implements a preview image generation for a wiki page.
--  This module is optional, it is possible to use the wikis without preview support.  When the
--  module is registered, it listens to wiki page lifecycle events.  When a new wiki content is
--  changed, it triggers a job to make the preview.  The preview job uses the
--  <tt>wkhtmotoimage</tt> external program to make the preview image.
package AWA.Wikis.Previews is

   --  The name under which the module is registered.
   NAME : constant String := "wiki-previews";

   --  The worker procedure that performs the preview job.
   procedure Preview_Worker (Job : in out AWA.Jobs.Services.Abstract_Job_Type'Class);

   --  Preview job definition.
   package Preview_Job_Definition is new AWA.Jobs.Services.Work_Definition (Preview_Worker'Access);

   --  ------------------------------
   --  Preview wiki module
   --  ------------------------------
   type Preview_Module is new AWA.Modules.Module
     and AWA.Wikis.Modules.Wiki_Lifecycle.Listener with private;
   type Preview_Module_Access is access all Preview_Module'Class;

   --  Initialize the preview wiki module.
   overriding
   procedure Initialize (Plugin : in out Preview_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  The `On_Create` procedure is called by `Notify_Create` to notify the creation of the page.
   overriding
   procedure On_Create (Instance : in Preview_Module;
                        Item     : in AWA.Wikis.Models.Wiki_Page_Ref'Class);

   --  The `On_Update` procedure is called by `Notify_Update` to notify the update of the page.
   overriding
   procedure On_Update (Instance : in Preview_Module;
                        Item     : in AWA.Wikis.Models.Wiki_Page_Ref'Class);

   --  The `On_Delete` procedure is called by `Notify_Delete` to notify the deletion of the page.
   overriding
   procedure On_Delete (Instance : in Preview_Module;
                        Item     : in AWA.Wikis.Models.Wiki_Page_Ref'Class);

private

   type Preview_Module is new AWA.Modules.Module
     and AWA.Wikis.Modules.Wiki_Lifecycle.Listener with null record;

end AWA.Wikis.Previews;

-----------------------------------------------------------------------
--  awa-wikis-previews -- Wiki preview management
--  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 ASF.Applications;

with AWA.Modules;
with AWA.Jobs.Services;
with AWA.Jobs.Modules;
with AWA.Wikis.Modules;
with AWA.Wikis.Models;

--  == Wiki Preview Module ==
--  The <tt>AWA.Wikis.Previews</tt> package implements a preview image generation for a wiki page.
--  This module is optional, it is possible to use the wikis without preview support.  When the
--  module is registered, it listens to wiki page lifecycle events.  When a new wiki content is
--  changed, it triggers a job to make the preview.  The preview job uses the
--  <tt>wkhtmotoimage</tt> external program to make the preview image.
package AWA.Wikis.Previews is

   --  The name under which the module is registered.
   NAME : constant String := "wiki-previews";

   --  The worker procedure that performs the preview job.
   procedure Preview_Worker (Job : in out AWA.Jobs.Services.Abstract_Job_Type'Class);

   --  Preview job definition.
   package Preview_Job_Definition is new AWA.Jobs.Services.Work_Definition (Preview_Worker'Access);

   --  ------------------------------
   --  Preview wiki module
   --  ------------------------------
   type Preview_Module is new AWA.Modules.Module
     and AWA.Wikis.Modules.Wiki_Lifecycle.Listener with private;
   type Preview_Module_Access is access all Preview_Module'Class;

   --  Initialize the preview wiki module.
   overriding
   procedure Initialize (Plugin : in out Preview_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  The `On_Create` procedure is called by `Notify_Create` to notify the creation of the page.
   overriding
   procedure On_Create (Instance : in Preview_Module;
                        Item     : in AWA.Wikis.Models.Wiki_Page_Ref'Class);

   --  The `On_Update` procedure is called by `Notify_Update` to notify the update of the page.
   overriding
   procedure On_Update (Instance : in Preview_Module;
                        Item     : in AWA.Wikis.Models.Wiki_Page_Ref'Class);

   --  The `On_Delete` procedure is called by `Notify_Delete` to notify the deletion of the page.
   overriding
   procedure On_Delete (Instance : in Preview_Module;
                        Item     : in AWA.Wikis.Models.Wiki_Page_Ref'Class);

   --  Create a preview job and schedule the job to generate a new thumbnail preview for the page.
   procedure Make_Preview_Job (Plugin : in Preview_Module;
                               Page   : in AWA.Wikis.Models.Wiki_Page_Ref'Class);

private

   type Preview_Module is new AWA.Modules.Module
     and AWA.Wikis.Modules.Wiki_Lifecycle.Listener with record
      Job_Module : AWA.Jobs.Modules.Job_Module_Access;
   end record;

end AWA.Wikis.Previews;

Declare the Make_Preview_Job procedure

Declare the Make_Preview_Job procedure


-----------------------------------------------------------------------
--  util-encoders-hmac-sha1 -- Compute HMAC-SHA1 authentication code
--  Copyright (C) 2011, 2012, 2017, 2019, 2022 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Streams;
with Ada.Finalization;
with Util.Encoders.SHA1;

--  The Util.Encodes.HMAC.SHA1 package generates HMAC-SHA1 authentication
--  (See RFC 2104 - HMAC: Keyed-Hashing for Message Authentication).
package Util.Encoders.HMAC.SHA1 is

   pragma Preelaborate;

   --  Sign the data string with the key and return the HMAC-SHA1 code in binary.
   function Sign (Key  : in String;
                  Data : in String) return Util.Encoders.SHA1.Hash_Array;

   --  Sign the data string with the key and return the HMAC-SHA1 code as hexadecimal string.
   function Sign (Key  : in String;
                  Data : in String) return Util.Encoders.SHA1.Digest;

   --  Sign the data array with the key and return the HMAC-SHA256 code in the result.
   procedure Sign (Key    : in Ada.Streams.Stream_Element_Array;
                   Data   : in Ada.Streams.Stream_Element_Array;
                   Result : out Util.Encoders.SHA1.Hash_Array);

   --  Sign the data string with the key and return the HMAC-SHA1 code as base64 string.
   --  When URL is True, use the base64 URL alphabet to encode in base64.
   function Sign_Base64 (Key  : in String;
                         Data : in String;
                         URL  : in Boolean := False) return Util.Encoders.SHA1.Base64_Digest;

   --  ------------------------------
   --  HMAC-SHA1 Context
   --  ------------------------------
   type Context is limited private;

   --  Set the hmac private key.  The key must be set before calling any Update
   --  procedure.
   procedure Set_Key (E   : in out Context;
                      Key : in String);

   --  Set the hmac private key.  The key must be set before calling any Update
   --  procedure.
   procedure Set_Key (E   : in out Context;
                      Key : in Ada.Streams.Stream_Element_Array);

   --  Update the hash with the string.
   procedure Update (E : in out Context;
                     S : in String);

   --  Update the hash with the string.
   procedure Update (E : in out Context;
                     S : in Ada.Streams.Stream_Element_Array);

   --  Computes the HMAC-SHA1 with the private key and the data collected by
   --  the Update procedures.  Returns the raw binary hash in Hash.
   procedure Finish (E    : in out Context;
                     Hash : out Util.Encoders.SHA1.Hash_Array);

   --  Computes the HMAC-SHA1 with the private key and the data collected by
   --  the Update procedures.  Returns the hexadecimal hash in Hash.
   procedure Finish (E    : in out Context;
                     Hash : out Util.Encoders.SHA1.Digest);

   --  Computes the HMAC-SHA1 with the private key and the data collected by
   --  the Update procedures.  Returns the base64 hash in Hash.
   --  When URL is True, use the base64 URL alphabet to encode in base64.
   procedure Finish_Base64 (E    : in out Context;
                            Hash : out Util.Encoders.SHA1.Base64_Digest;
                            URL  : in Boolean := False);

private

   type Encoder is new Util.Encoders.Transformer with null record;

   type Context is new Ada.Finalization.Limited_Controlled with record
      SHA     : Util.Encoders.SHA1.Context;
      Key     : Ada.Streams.Stream_Element_Array (0 .. 63);
      Key_Len : Ada.Streams.Stream_Element_Offset;
   end record;

   --  Initialize the SHA-1 context.
   overriding
   procedure Initialize (E : in out Context);

end Util.Encoders.HMAC.SHA1;

-----------------------------------------------------------------------
--  util-encoders-hmac-sha1 -- Compute HMAC-SHA1 authentication code
--  Copyright (C) 2011, 2012, 2017, 2019, 2022 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Streams;
with Ada.Finalization;
with Util.Encoders.SHA1;

--  The Util.Encodes.HMAC.SHA1 package generates HMAC-SHA1 authentication
--  (See RFC 2104 - HMAC: Keyed-Hashing for Message Authentication).
package Util.Encoders.HMAC.SHA1 is

   pragma Preelaborate;

   --  Sign the data string with the key and return the HMAC-SHA1 code in binary.
   function Sign (Key  : in String;
                  Data : in String) return Util.Encoders.SHA1.Hash_Array;

   --  Sign the data string with the key and return the HMAC-SHA1 code as hexadecimal string.
   function Sign (Key  : in String;
                  Data : in String) return Util.Encoders.SHA1.Digest;

   --  Sign the data array with the key and return the HMAC-SHA256 code in the result.
   procedure Sign (Key    : in Ada.Streams.Stream_Element_Array;
                   Data   : in Ada.Streams.Stream_Element_Array;
                   Result : out Util.Encoders.SHA1.Hash_Array);

   --  Sign the data string with the key and return the HMAC-SHA1 code as base64 string.
   --  When URL is True, use the base64 URL alphabet to encode in base64.
   function Sign_Base64 (Key  : in String;
                         Data : in String;
                         URL  : in Boolean := False) return Util.Encoders.SHA1.Base64_Digest;

   --  ------------------------------
   --  HMAC-SHA1 Context
   --  ------------------------------
   type Context is limited private;

   --  Set the hmac private key.  The key must be set before calling any Update
   --  procedure.
   procedure Set_Key (E   : in out Context;
                      Key : in String);

   --  Set the hmac private key.  The key must be set before calling any Update
   --  procedure.
   procedure Set_Key (E   : in out Context;
                      Key : in Ada.Streams.Stream_Element_Array);

   --  Update the hash with the string.
   procedure Update (E : in out Context;
                     S : in String);

   --  Update the hash with the string.
   procedure Update (E : in out Context;
                     S : in Ada.Streams.Stream_Element_Array);

   --  Computes the HMAC-SHA1 with the private key and the data collected by
   --  the Update procedures.  Returns the raw binary hash in Hash.
   procedure Finish (E    : in out Context;
                     Hash : out Util.Encoders.SHA1.Hash_Array);

   --  Computes the HMAC-SHA1 with the private key and the data collected by
   --  the Update procedures.  Returns the hexadecimal hash in Hash.
   procedure Finish (E    : in out Context;
                     Hash : out Util.Encoders.SHA1.Digest);

   --  Computes the HMAC-SHA1 with the private key and the data collected by
   --  the Update procedures.  Returns the base64 hash in Hash.
   --  When URL is True, use the base64 URL alphabet to encode in base64.
   procedure Finish_Base64 (E    : in out Context;
                            Hash : out Util.Encoders.SHA1.Base64_Digest;
                            URL  : in Boolean := False);

private

   type Context is new Ada.Finalization.Limited_Controlled with record
      SHA     : Util.Encoders.SHA1.Context;
      Key     : Ada.Streams.Stream_Element_Array (0 .. 63);
      Key_Len : Ada.Streams.Stream_Element_Offset;
   end record;

   --  Initialize the SHA-1 context.
   overriding
   procedure Initialize (E : in out Context);

end Util.Encoders.HMAC.SHA1;

Remove private type Encoder definition

Remove private type Encoder definition