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

with Util.Properties.Factories;
with Ada.IO_Exceptions;
with Ada.Strings.Unbounded.Text_IO;
with Interfaces.C.Strings;
package body Util.Properties is

   use Ada.Text_IO;
   use Ada.Strings.Unbounded.Text_IO;
   use Interface_P;

   procedure Load_Property (Name   : out Unbounded_String;
                            Value  : out Unbounded_String;
                            File   : in File_Type;
                            Prefix : in String := "";
                            Strip  : in Boolean := False);

   function Exists (Self : in Manager'Class;
                    Name : in String) return Boolean is
   begin
      --  There is not yet an implementation, no property
      if Self.Impl = null then
         return False;
      end if;

      return Exists (Self.Impl.all, +Name);
   end Exists;

   function Exists (Self : in Manager'Class;
                    Name : in Value) return Boolean is
   begin
      --  There is not yet an implementation, no property
      if Self.Impl = null then
         return False;
      end if;

      return Exists (Self.Impl.all, Name);
   end Exists;

   function Get (Self : in Manager'Class;
                 Name : in String) return Value is
   begin
      if Self.Impl = null then
         raise NO_PROPERTY with "No property: '" & Name & "'";
      end if;

      return Get (Self.Impl.all, +Name);
   end Get;

   function Get (Self : in Manager'Class;
                 Name : in Value) return Value is
   begin
      if Self.Impl = null then
         raise NO_PROPERTY with "No property: '" & To_String (Name) & "'";
      end if;

      return Get (Self.Impl.all, Name);
   end Get;

   function Get (Self : in Manager'Class;
                 Name : in String) return String is
   begin
      if Self.Impl = null then
         raise NO_PROPERTY with "No property: '" & Name & "'";
      end if;

      return -Get (Self.Impl.all, +Name);
   end Get;

   function Get (Self : in Manager'Class;
                 Name : in Value) return String is
   begin
      if Self.Impl = null then
         raise NO_PROPERTY;
      end if;

      return -Get (Self.Impl.all, Name);
   end Get;

   function Get (Self : in Manager'Class;
                 Name : in String;
                 Default : in String) return String is
      Prop_Name : constant Value := +Name;
   begin
      if Exists (Self, Prop_Name) then
         return Get (Self, Prop_Name);
      else
         return Default;
      end if;
   end Get;

   procedure Check_And_Create_Impl (Self : in out Manager) is
   begin
      if Self.Impl = null then
         Util.Properties.Factories.Initialize (Self);
      elsif Util.Concurrent.Counters.Value (Self.Impl.Count) > 1 then
         declare
            Old     : Interface_P.Manager_Access := Self.Impl;
            Is_Zero : Boolean;
         begin
            Self.Impl := Create_Copy (Self.Impl.all);
            Util.Concurrent.Counters.Increment (Self.Impl.Count);
            Util.Concurrent.Counters.Decrement (Old.Count, Is_Zero);
            if Is_Zero then
               Delete (Old.all, Old);
            end if;
         end;
      end if;
   end Check_And_Create_Impl;

   procedure Insert (Self : in out Manager'Class;
                     Name : in String;
                     Item : in String) is
   begin
      Check_And_Create_Impl (Self);
      Insert (Self.Impl.all, +Name, +Item);
   end Insert;

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

   --  ------------------------------
   --  Set the value of the property.  The property is created if it
   --  does not exists.
   --  ------------------------------
   procedure Set (Self : in out Manager'Class;
                  Name : in String;
                  Item : in Value) is
   begin
      Check_And_Create_Impl (Self);
      Set (Self.Impl.all, +Name, Item);
   end Set;

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

   --  ------------------------------
   --  Remove the property given its name.
   --  ------------------------------
   procedure Remove (Self : in out Manager'Class;
                     Name : in String) is
   begin
      if Self.Impl = null then
         raise NO_PROPERTY;
      end if;
      Check_And_Create_Impl (Self);
      Remove (Self.Impl.all, +Name);
   end Remove;

   --  ------------------------------
   --  Remove the property given its name.
   --  ------------------------------
   procedure Remove (Self : in out Manager'Class;
                     Name : in Value) is
   begin
      if Self.Impl = null then
         raise NO_PROPERTY;
      end if;
      Check_And_Create_Impl (Self);
      Remove (Self.Impl.all, Name);
   end Remove;

   --  ------------------------------
   --  Iterate over the properties and execute the given procedure passing the
   --  property name and its value.
   --  ------------------------------
   procedure Iterate (Self    : in Manager'Class;
                      Process : access procedure (Name, Item : Value)) is
   begin
      if Self.Impl /= null then
         Self.Impl.Iterate (Process);
      end if;
   end Iterate;

   --  ------------------------------
   --  Return the name of the properties defined in the manager.
   --  When a prefix is specified, only the properties starting with
   --  the prefix are returned.
   --  ------------------------------
   function Get_Names (Self  : in Manager;
                       Prefix : in String := "") return Name_Array is
   begin
      if Self.Impl = null then
         declare
            Empty : Name_Array (1 .. 0);
         begin
            return Empty;
         end;
      else
         return Get_Names (Self.Impl.all, Prefix);
      end if;
   end Get_Names;

   procedure Adjust (Object : in out Manager) is
   begin
      if Object.Impl /= null then
         Util.Concurrent.Counters.Increment (Object.Impl.Count);
      end if;
   end Adjust;

   procedure Finalize (Object : in out Manager) is
      Is_Zero : Boolean;
   begin
      if Object.Impl /= null then
         Util.Concurrent.Counters.Decrement (Object.Impl.Count, Is_Zero);
         if Is_Zero then
            Delete (Object.Impl.all, Object.Impl);
         end if;
      end if;
   end Finalize;

   procedure Set_Property_Implementation (Self : in out Manager;
                                          Impl : in Interface_P.Manager_Access) is
   begin
      if Self.Impl = null then
         Self.Impl := Impl;
--           Self.Impl.Count := 1;
      end if;
   end Set_Property_Implementation;

   procedure Load_Property (Name   : out Unbounded_String;
                            Value  : out Unbounded_String;
                            File   : in File_Type;
                            Prefix : in String := "";
                            Strip  : in Boolean := False) is
      pragma Unreferenced (Strip);

      Line : Unbounded_String;
      Pos  : Natural;
      Len  : Natural;
   begin
      while not End_Of_File (File) loop
         Line := Get_Line (File);
         Len  := Length (Line);
         if Len /= 0 and then Element (Line, 1) /= '#' then
            Pos := Index (Line, "=");
            if Pos > 0 and then Prefix'Length > 0 and then Index (Line, Prefix) = 1 then
               Name  := Unbounded_Slice (Line, Prefix'Length + 1, Pos - 1);
               Value := Tail (Line, Len - Pos);
               return;

            elsif Pos > 0 and Prefix'Length = 0 then
               Name  := Head (Line, Pos - 1);
               Value := Tail (Line, Len - Pos);
               return;

            end if;
         end if;
      end loop;
      Name := Null_Unbounded_String;
      Value := Null_Unbounded_String;
   end Load_Property;

   procedure Load_Properties (Self   : in out Manager'Class;
                              File   : in File_Type;
                              Prefix : in String := "";
                              Strip  : in Boolean := False) is
      Name, Value : Unbounded_String;
   begin
      loop
         Load_Property (Name, Value, File, Prefix, Strip);
         exit when Name = Null_Unbounded_String;
         Set (Self, Name, Value);
      end loop;

   exception
      when End_Error =>
         return;
   end Load_Properties;

   procedure Load_Properties (Self   : in out Manager'Class;
                              Path   : in String;
                              Prefix : in String := "";
                              Strip  : in Boolean := False) is
      F : File_Type;
   begin
      Open (F, In_File, Path);
      Load_Properties (Self, F, Prefix, Strip);
      Close (F);
   end Load_Properties;

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

      Tmp : constant String := Path & ".tmp";
      F : File_Type;

      procedure Save_Property (Name, Item : in Value) is
      begin
         Put (F, Name);
         Put (F, "=");
         Put (F, Item);
         New_Line (F);
      end Save_Property;

      --  Rename a file (the Ada.Directories.Rename does not allow to use the Unix atomic file rename!)
      function Sys_Rename (Oldpath  : in Interfaces.C.Strings.chars_ptr;
                           Newpath  : in Interfaces.C.Strings.chars_ptr) return Integer;
      pragma Import (C, Sys_Rename, "rename");

      Old_Path : Interfaces.C.Strings.chars_ptr;
      New_Path : Interfaces.C.Strings.chars_ptr;
      Result   : Integer;
   begin
      Create (File => F, Name => Tmp);
      Self.Iterate (Save_Property'Access);
      Close (File => F);

      --  Do a system atomic rename of old file in the new file.
      --  Ada.Directories.Rename does not allow this.
      Old_Path := Interfaces.C.Strings.New_String (Tmp);
      New_Path := Interfaces.C.Strings.New_String (Path);
      Result := Sys_Rename (Old_Path, New_Path);
      Interfaces.C.Strings.Free (Old_Path);
      Interfaces.C.Strings.Free (New_Path);
      if Result /= 0 then
         raise Ada.IO_Exceptions.Use_Error with "Cannot rename file";
      end if;
   end Save_Properties;

   --  ------------------------------
   --  Copy the properties from FROM which start with a given prefix.
   --  If the prefix is empty, all properties are copied.  When <b>Strip</b> is True,
   --  the prefix part is removed from the property name.
   --  ------------------------------
   procedure Copy (Self   : in out Manager'Class;
                   From   : in Manager'Class;
                   Prefix : in String := "";
                   Strip  : in Boolean := False) is
      Names : constant Name_Array := From.Get_Names;
   begin
      for I in Names'Range loop
         declare
            Name : Unbounded_String renames Names (I);
         begin
            if Prefix'Length = 0 or else Index (Name, Prefix) = 1 then
               if Strip and Prefix'Length > 0 then
                  declare
                     S : constant String := Slice (Name, Prefix'Length + 1, Length (Name));
                  begin
                     Self.Set (+(S), From.Get (Name));
                  end;
               else
                  Self.Set (Name, From.Get (Name));
               end if;
            end if;
         end;
      end loop;

   end Copy;

end Util.Properties;

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

with Util.Properties.Factories;
with Ada.IO_Exceptions;
with Ada.Strings.Unbounded.Text_IO;
with Interfaces.C.Strings;
package body Util.Properties is

   use Ada.Text_IO;
   use Ada.Strings.Unbounded.Text_IO;
   use Interface_P;

   procedure Load_Property (Name   : out Unbounded_String;
                            Value  : out Unbounded_String;
                            File   : in File_Type;
                            Prefix : in String := "";
                            Strip  : in Boolean := False);
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in Manager;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      return Util.Beans.Objects.Null_Object;
   end Get_Value;

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

   function Exists (Self : in Manager'Class;
                    Name : in String) return Boolean is
   begin
      --  There is not yet an implementation, no property
      if Self.Impl = null then
         return False;
      end if;

      return Exists (Self.Impl.all, +Name);
   end Exists;

   function Exists (Self : in Manager'Class;
                    Name : in Value) return Boolean is
   begin
      --  There is not yet an implementation, no property
      if Self.Impl = null then
         return False;
      end if;

      return Exists (Self.Impl.all, Name);
   end Exists;

   function Get (Self : in Manager'Class;
                 Name : in String) return Value is
   begin
      if Self.Impl = null then
         raise NO_PROPERTY with "No property: '" & Name & "'";
      end if;

      return Get (Self.Impl.all, +Name);
   end Get;

   function Get (Self : in Manager'Class;
                 Name : in Value) return Value is
   begin
      if Self.Impl = null then
         raise NO_PROPERTY with "No property: '" & To_String (Name) & "'";
      end if;

      return Get (Self.Impl.all, Name);
   end Get;

   function Get (Self : in Manager'Class;
                 Name : in String) return String is
   begin
      if Self.Impl = null then
         raise NO_PROPERTY with "No property: '" & Name & "'";
      end if;

      return -Get (Self.Impl.all, +Name);
   end Get;

   function Get (Self : in Manager'Class;
                 Name : in Value) return String is
   begin
      if Self.Impl = null then
         raise NO_PROPERTY;
      end if;

      return -Get (Self.Impl.all, Name);
   end Get;

   function Get (Self : in Manager'Class;
                 Name : in String;
                 Default : in String) return String is
      Prop_Name : constant Value := +Name;
   begin
      if Exists (Self, Prop_Name) then
         return Get (Self, Prop_Name);
      else
         return Default;
      end if;
   end Get;

   procedure Check_And_Create_Impl (Self : in out Manager) is
   begin
      if Self.Impl = null then
         Util.Properties.Factories.Initialize (Self);
      elsif Util.Concurrent.Counters.Value (Self.Impl.Count) > 1 then
         declare
            Old     : Interface_P.Manager_Access := Self.Impl;
            Is_Zero : Boolean;
         begin
            Self.Impl := Create_Copy (Self.Impl.all);
            Util.Concurrent.Counters.Increment (Self.Impl.Count);
            Util.Concurrent.Counters.Decrement (Old.Count, Is_Zero);
            if Is_Zero then
               Delete (Old.all, Old);
            end if;
         end;
      end if;
   end Check_And_Create_Impl;

   procedure Insert (Self : in out Manager'Class;
                     Name : in String;
                     Item : in String) is
   begin
      Check_And_Create_Impl (Self);
      Insert (Self.Impl.all, +Name, +Item);
   end Insert;

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

   --  ------------------------------
   --  Set the value of the property.  The property is created if it
   --  does not exists.
   --  ------------------------------
   procedure Set (Self : in out Manager'Class;
                  Name : in String;
                  Item : in Value) is
   begin
      Check_And_Create_Impl (Self);
      Set (Self.Impl.all, +Name, Item);
   end Set;

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

   --  ------------------------------
   --  Remove the property given its name.
   --  ------------------------------
   procedure Remove (Self : in out Manager'Class;
                     Name : in String) is
   begin
      if Self.Impl = null then
         raise NO_PROPERTY;
      end if;
      Check_And_Create_Impl (Self);
      Remove (Self.Impl.all, +Name);
   end Remove;

   --  ------------------------------
   --  Remove the property given its name.
   --  ------------------------------
   procedure Remove (Self : in out Manager'Class;
                     Name : in Value) is
   begin
      if Self.Impl = null then
         raise NO_PROPERTY;
      end if;
      Check_And_Create_Impl (Self);
      Remove (Self.Impl.all, Name);
   end Remove;

   --  ------------------------------
   --  Iterate over the properties and execute the given procedure passing the
   --  property name and its value.
   --  ------------------------------
   procedure Iterate (Self    : in Manager'Class;
                      Process : access procedure (Name, Item : Value)) is
   begin
      if Self.Impl /= null then
         Self.Impl.Iterate (Process);
      end if;
   end Iterate;

   --  ------------------------------
   --  Return the name of the properties defined in the manager.
   --  When a prefix is specified, only the properties starting with
   --  the prefix are returned.
   --  ------------------------------
   function Get_Names (Self  : in Manager;
                       Prefix : in String := "") return Name_Array is
   begin
      if Self.Impl = null then
         declare
            Empty : Name_Array (1 .. 0);
         begin
            return Empty;
         end;
      else
         return Get_Names (Self.Impl.all, Prefix);
      end if;
   end Get_Names;

   procedure Adjust (Object : in out Manager) is
   begin
      if Object.Impl /= null then
         Util.Concurrent.Counters.Increment (Object.Impl.Count);
      end if;
   end Adjust;

   procedure Finalize (Object : in out Manager) is
      Is_Zero : Boolean;
   begin
      if Object.Impl /= null then
         Util.Concurrent.Counters.Decrement (Object.Impl.Count, Is_Zero);
         if Is_Zero then
            Delete (Object.Impl.all, Object.Impl);
         end if;
      end if;
   end Finalize;

   procedure Set_Property_Implementation (Self : in out Manager;
                                          Impl : in Interface_P.Manager_Access) is
   begin
      if Self.Impl = null then
         Self.Impl := Impl;
--           Self.Impl.Count := 1;
      end if;
   end Set_Property_Implementation;

   procedure Load_Property (Name   : out Unbounded_String;
                            Value  : out Unbounded_String;
                            File   : in File_Type;
                            Prefix : in String := "";
                            Strip  : in Boolean := False) is
      pragma Unreferenced (Strip);

      Line : Unbounded_String;
      Pos  : Natural;
      Len  : Natural;
   begin
      while not End_Of_File (File) loop
         Line := Get_Line (File);
         Len  := Length (Line);
         if Len /= 0 and then Element (Line, 1) /= '#' then
            Pos := Index (Line, "=");
            if Pos > 0 and then Prefix'Length > 0 and then Index (Line, Prefix) = 1 then
               Name  := Unbounded_Slice (Line, Prefix'Length + 1, Pos - 1);
               Value := Tail (Line, Len - Pos);
               return;

            elsif Pos > 0 and Prefix'Length = 0 then
               Name  := Head (Line, Pos - 1);
               Value := Tail (Line, Len - Pos);
               return;

            end if;
         end if;
      end loop;
      Name := Null_Unbounded_String;
      Value := Null_Unbounded_String;
   end Load_Property;

   procedure Load_Properties (Self   : in out Manager'Class;
                              File   : in File_Type;
                              Prefix : in String := "";
                              Strip  : in Boolean := False) is
      Name, Value : Unbounded_String;
   begin
      loop
         Load_Property (Name, Value, File, Prefix, Strip);
         exit when Name = Null_Unbounded_String;
         Set (Self, Name, Value);
      end loop;

   exception
      when End_Error =>
         return;
   end Load_Properties;

   procedure Load_Properties (Self   : in out Manager'Class;
                              Path   : in String;
                              Prefix : in String := "";
                              Strip  : in Boolean := False) is
      F : File_Type;
   begin
      Open (F, In_File, Path);
      Load_Properties (Self, F, Prefix, Strip);
      Close (F);
   end Load_Properties;

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

      Tmp : constant String := Path & ".tmp";
      F : File_Type;

      procedure Save_Property (Name, Item : in Value) is
      begin
         Put (F, Name);
         Put (F, "=");
         Put (F, Item);
         New_Line (F);
      end Save_Property;

      --  Rename a file (the Ada.Directories.Rename does not allow to use the Unix atomic file rename!)
      function Sys_Rename (Oldpath  : in Interfaces.C.Strings.chars_ptr;
                           Newpath  : in Interfaces.C.Strings.chars_ptr) return Integer;
      pragma Import (C, Sys_Rename, "rename");

      Old_Path : Interfaces.C.Strings.chars_ptr;
      New_Path : Interfaces.C.Strings.chars_ptr;
      Result   : Integer;
   begin
      Create (File => F, Name => Tmp);
      Self.Iterate (Save_Property'Access);
      Close (File => F);

      --  Do a system atomic rename of old file in the new file.
      --  Ada.Directories.Rename does not allow this.
      Old_Path := Interfaces.C.Strings.New_String (Tmp);
      New_Path := Interfaces.C.Strings.New_String (Path);
      Result := Sys_Rename (Old_Path, New_Path);
      Interfaces.C.Strings.Free (Old_Path);
      Interfaces.C.Strings.Free (New_Path);
      if Result /= 0 then
         raise Ada.IO_Exceptions.Use_Error with "Cannot rename file";
      end if;
   end Save_Properties;

   --  ------------------------------
   --  Copy the properties from FROM which start with a given prefix.
   --  If the prefix is empty, all properties are copied.  When <b>Strip</b> is True,
   --  the prefix part is removed from the property name.
   --  ------------------------------
   procedure Copy (Self   : in out Manager'Class;
                   From   : in Manager'Class;
                   Prefix : in String := "";
                   Strip  : in Boolean := False) is
      Names : constant Name_Array := From.Get_Names;
   begin
      for I in Names'Range loop
         declare
            Name : Unbounded_String renames Names (I);
         begin
            if Prefix'Length = 0 or else Index (Name, Prefix) = 1 then
               if Strip and Prefix'Length > 0 then
                  declare
                     S : constant String := Slice (Name, Prefix'Length + 1, Length (Name));
                  begin
                     Self.Set (+(S), From.Get (Name));
                  end;
               else
                  Self.Set (Name, From.Get (Name));
               end if;
            end if;
         end;
      end loop;

   end Copy;

end Util.Properties;

Implement stubs for the Get_Value and Set_Value operations


--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2017 onox <denkpadje@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 Orka.Atomics is
   pragma Pure;

   protected type Counter (Initial_Value : Natural) is
      procedure Add (Addition : Natural);

      procedure Increment;

      procedure Decrement (Zero : out Boolean);

      procedure Reset;

      function Count return Natural;
   private
      Value : Natural := Initial_Value;
   end Counter;

end Orka.Atomics;

--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2017 onox <denkpadje@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 Orka.Atomics is
   pragma Pure;

   protected type Counter (Initial_Value : Natural) is
      pragma Lock_Free;

      procedure Add (Addition : Natural);

      procedure Increment;

      procedure Decrement (Zero : out Boolean);

      procedure Reset;

      function Count return Natural;
   private
      Value : Natural := Initial_Value;
   end Counter;

end Orka.Atomics;

Make protected type Counter lock free

orka: Make protected type Counter lock free

Signed-off-by: onox <34c1d3d2d1347bea60a26f46574de21a7a79b6d5@gmail.com>


-----------------------------------------------------------------------
--  wiki-utils -- Wiki utility operations
--  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 Wiki.Render.Text;
with Wiki.Render.Html;
with Wiki.Writers.Builders;
package body Wiki.Utils is

   --  ------------------------------
   --  Render the wiki text according to the wiki syntax in HTML into a string.
   --  ------------------------------
   function To_Html (Text   : in Wide_Wide_String;
                     Syntax : in Wiki.Parsers.Wiki_Syntax_Type) return String is
      Writer   : aliased Wiki.Writers.Builders.Html_Writer_Type;
      Renderer : aliased Wiki.Render.Html.Html_Renderer;
   begin
      Renderer.Set_Writer (Writer'Unchecked_Access);
      Wiki.Parsers.Parse (Renderer'Unchecked_Access, Text, Syntax);
      return Writer.To_String;
   end To_Html;

   --  ------------------------------
   --  Render the wiki text according to the wiki syntax in text into a string.
   --  Wiki formatting and decoration are removed.
   --  ------------------------------
   function To_Text (Text   : in Wide_Wide_String;
                     Syntax : in Wiki.Parsers.Wiki_Syntax_Type) return String is
      Writer   : aliased Wiki.Writers.Builders.Writer_Builder_Type;
      Renderer : aliased Wiki.Render.Text.Text_Renderer;
   begin
      Renderer.Set_Writer (Writer'Unchecked_Access);
      Wiki.Parsers.Parse (Renderer'Unchecked_Access, Text, Syntax);
      return Writer.To_String;
   end To_Text;

end Wiki.Utils;

-----------------------------------------------------------------------
--  wiki-utils -- Wiki utility operations
--  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 Wiki.Render.Text;
with Wiki.Render.Html;
with Wiki.Filters.Html;
with Wiki.Writers.Builders;
package body Wiki.Utils is

   --  ------------------------------
   --  Render the wiki text according to the wiki syntax in HTML into a string.
   --  ------------------------------
   function To_Html (Text   : in Wide_Wide_String;
                     Syntax : in Wiki.Parsers.Wiki_Syntax_Type) return String is
      Writer   : aliased Wiki.Writers.Builders.Html_Writer_Type;
      Renderer : aliased Wiki.Render.Html.Html_Renderer;
      Filter   : aliased Wiki.Filters.Html.Html_Filter_Type;
   begin
      Renderer.Set_Writer (Writer'Unchecked_Access);
      Filter.Set_Document (Renderer'Unchecked_Access);
      Wiki.Parsers.Parse (Filter'Unchecked_Access, Text, Syntax);
      return Writer.To_String;
   end To_Html;

   --  ------------------------------
   --  Render the wiki text according to the wiki syntax in text into a string.
   --  Wiki formatting and decoration are removed.
   --  ------------------------------
   function To_Text (Text   : in Wide_Wide_String;
                     Syntax : in Wiki.Parsers.Wiki_Syntax_Type) return String is
      Writer   : aliased Wiki.Writers.Builders.Writer_Builder_Type;
      Renderer : aliased Wiki.Render.Text.Text_Renderer;
   begin
      Renderer.Set_Writer (Writer'Unchecked_Access);
      Wiki.Parsers.Parse (Renderer'Unchecked_Access, Text, Syntax);
      return Writer.To_String;
   end To_Text;

end Wiki.Utils;

Add the HTML filter in the chain

Add the HTML filter in the chain


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

with ASF.Requests;
with ASF.Responses;
with ASF.Server;
with Ada.IO_Exceptions;

with Util.Files;

with EL.Contexts.Default;

with AWA.Modules.Reader;
with AWA.Applications;
package body AWA.Modules is

   --  ------------------------------
   --  Get the module name
   --  ------------------------------
   function Get_Name (Plugin : in Module) return String is
   begin
      return To_String (Plugin.Name);
   end Get_Name;

   --  ------------------------------
   --  Get the base URI for this module
   --  ------------------------------
   function Get_URI (Plugin : in Module) return String is
   begin
      return To_String (Plugin.URI);
   end Get_URI;

   --  ------------------------------
   --  Get the application in which this module is registered.
   --  ------------------------------
   function Get_Application (Plugin : in Module) return Application_Access is
   begin
      return Plugin.App;
   end Get_Application;

   --  ------------------------------
   --  Get the module configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   --  ------------------------------
   function Get_Config (Plugin  : Module;
                        Name    : String;
                        Default : String := "") return String is
   begin
      return Plugin.Config.Get (Name, Default);
   end Get_Config;

   --  ------------------------------
   --  Get the module configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   --  ------------------------------
   function Get_Config (Plugin  : in Module;
                        Name    : in String;
                        Default : in Integer := -1) return Integer is
      Value : constant String := Plugin.Config.Get (Name, Integer'Image (Default));
   begin
      return Integer'Value (Value);

   exception
      when Constraint_Error =>
         return Default;
   end Get_Config;

   --  ------------------------------
   --  Send the event to the module
   --  ------------------------------
   procedure Send_Event (Plugin  : in Module;
                         Content : in AWA.Events.Module_Event'Class) is
   begin
      Plugin.App.Send_Event (Content);
   end Send_Event;

   --  ------------------------------
   --  Find the module with the given name
   --  ------------------------------
   function Find_Module (Plugin : Module;
                         Name   : String) return Module_Access is
   begin
      if Plugin.Registry = null then
         return null;
      end if;
      return Find_By_Name (Plugin.Registry.all, Name);
   end Find_Module;

   --  ------------------------------
   --  Register under the given name a function to create the bean instance when
   --  it is accessed for a first time.  The scope defines the scope of the bean.
   --  bean
   --  ------------------------------
   procedure Register (Plugin : in out Module;
                       Name    : in String;
                       Bind    : in ASF.Beans.Class_Binding_Access) is
   begin
      Plugin.App.Register_Class (Name, Bind);
   end Register;

   --  ------------------------------
   --  Finalize the module.
   --  ------------------------------
   overriding
   procedure Finalize (Plugin : in out Module) is
   begin
      null;
   end Finalize;

   procedure Initialize (Manager : in out Module_Manager;
                         Module  : in AWA.Modules.Module'Class) is
   begin
      Manager.Module := Module.Self;
   end Initialize;

   function Get_Value (Manager : in Module_Manager;
                       Name    : in String) return Util.Beans.Objects.Object is
      pragma Unreferenced (Manager, Name);
   begin
      return Util.Beans.Objects.Null_Object;
   end Get_Value;

   --  Module manager
   --
   --  ------------------------------
   --  Get the database connection for reading
   --  ------------------------------
   function Get_Session (Manager : Module_Manager)
                            return ADO.Sessions.Session is
   begin
      return Manager.Module.Get_Session;
   end Get_Session;

   --  ------------------------------
   --  Get the database connection for writing
   --  ------------------------------
   function Get_Master_Session (Manager : Module_Manager)
                                   return ADO.Sessions.Master_Session is
   begin
      return Manager.Module.Get_Master_Session;
   end Get_Master_Session;

   --  ------------------------------
   --  Send the event to the module.  The module identified by <b>To</b> is
   --  found and the event is posted on its event channel.
   --  ------------------------------
   procedure Send_Event (Manager : in Module_Manager;
                         Content : in AWA.Events.Module_Event'Class) is
   begin
      Manager.Module.Send_Event (Content);
   end Send_Event;

   procedure Initialize (Plugin : in out Module;
                         App    : in Application_Access;
                         Props  : in ASF.Applications.Config) is
      pragma Unreferenced (Props);
   begin
      Plugin.Self := Plugin'Unchecked_Access;
      Plugin.App := App;
   end Initialize;

   --  ------------------------------
   --  Initialize the registry
   --  ------------------------------
   procedure Initialize (Registry : in out Module_Registry;
                         Config   : in ASF.Applications.Config) is
   begin
      Registry.Config := Config;
   end Initialize;

   --  ------------------------------
   --  Register the module in the registry.
   --  ------------------------------
   procedure Register (Registry : in Module_Registry_Access;
                       App      : in Application_Access;
                       Plugin   : in Module_Access;
                       Name     : in String;
                       URI      : in String) is
      Paths : constant String := Registry.Config.Get ("app.modules.dir", "./config");
   begin
      Log.Info ("Register module '{0}' under URI '{1}'", Name, URI);

      if Plugin.Registry /= null then
         Log.Error ("Module '{0}' is already attached to a registry", Name);

         raise Program_Error with "Module '" & Name & "' already registered";
      end if;
      Plugin.App      := App;
      Plugin.Registry := Registry;
      Plugin.Name     := To_Unbounded_String (Name);
      Plugin.URI      := To_Unbounded_String (URI);
      Plugin.Registry.Name_Map.Insert (Name, Plugin);
      if URI /= "" then
         Plugin.Registry.URI_Map.Insert (URI, Plugin);
      end if;

      --  Load the module configuration file
      Log.Debug ("Module search path: {0}", Paths);
      declare
         Base  : constant String := Name & ".properties";
         Path  : constant String := Util.Files.Find_File_Path (Base, Paths);
      begin
         Plugin.Config.Load_Properties (Path => Path, Prefix => Name & ".", Strip => True);

      exception
         when Ada.IO_Exceptions.Name_Error =>
            Log.Warn ("Module configuration file '{0}' does not exist", Path);
      end;

      --  Override the module configuration with the application configuration
      Plugin.Config.Copy (From => Registry.Config, Prefix => Name & ".", Strip => True);

      Plugin.Initialize (App, Plugin.Config);

      --  Read the module XML configuration file if there is one.
      declare
         Base : constant String := Plugin.Config.Get ("config", Name & ".xml");
         Path : constant String := Util.Files.Find_File_Path (Base, Paths);
         Ctx  : aliased EL.Contexts.Default.Default_Context;
      begin
         AWA.Modules.Reader.Read_Configuration (Plugin.all, Path, Ctx'Unchecked_Access);

      exception
         when Ada.IO_Exceptions.Name_Error =>
            Log.Warn ("Module configuration file '{0}' does not exist", Path);
      end;

   exception
      when Constraint_Error =>
         Log.Error ("Another module is already registered "
                    & "under name '{0}' or URI '{1}'", Name, URI);
         raise;
   end Register;

   --  ------------------------------
   --  Find the module with the given name
   --  ------------------------------
   function Find_By_Name (Registry : Module_Registry;
                          Name     : String) return Module_Access is
      Pos : constant Module_Maps.Cursor := Module_Maps.Find (Registry.Name_Map, Name);
   begin
      if Module_Maps.Has_Element (Pos) then
         return Module_Maps.Element (Pos);
      end if;
      return null;
   end Find_By_Name;

   --  ------------------------------
   --  Find the module mapped to a given URI
   --  ------------------------------
   function Find_By_URI (Registry : Module_Registry;
                         URI      : String) return Module_Access is
      Pos : constant Module_Maps.Cursor := Module_Maps.Find (Registry.URI_Map, URI);
   begin
      if Module_Maps.Has_Element (Pos) then
         return Module_Maps.Element (Pos);
      end if;
      return null;
   end Find_By_URI;

   --  ------------------------------
   --  Get the database connection for reading
   --  ------------------------------
   function Get_Session (Manager : Module)
                            return ADO.Sessions.Session is
   begin
      return Manager.App.Get_Session;
   end Get_Session;

   --  ------------------------------
   --  Get the database connection for writing
   --  ------------------------------
   function Get_Master_Session (Manager : Module)
                                return ADO.Sessions.Master_Session is
   begin
      return Manager.App.Get_Master_Session;
   end Get_Master_Session;

   --  Get per request manager => look in Request
   --  Get per session manager => look in Request.Get_Session
   --  Get per application manager => look in Application
   --  Get per pool manager => look in pool attached to Application
   function Get_Manager return Manager_Type_Access is

      procedure Process (Request  : in out ASF.Requests.Request'Class;
                         Response : in out ASF.Responses.Response'Class);

      Value : Util.Beans.Objects.Object;

      procedure Process (Request  : in out ASF.Requests.Request'Class;
                         Response : in out ASF.Responses.Response'Class) is
         pragma Unreferenced (Response);
      begin
         Value := Request.Get_Attribute (Name);
         if Util.Beans.Objects.Is_Null (Value) then
            declare
               M : constant Manager_Type_Access := new Manager_Type;
            begin
               Value := Util.Beans.Objects.To_Object (M.all'Access);
               Request.Set_Attribute (Name, Value);
            end;
         end if;
      end Process;

   begin
      ASF.Server.Update_Context (Process'Access);
      if Util.Beans.Objects.Is_Null (Value) then
         return null;
      end if;
      declare
         B : constant access Util.Beans.Basic.Readonly_Bean'Class
           := Util.Beans.Objects.To_Bean (Value);
      begin
         if not (B.all in Manager_Type'Class) then
            return null;
         end if;
         return Manager_Type'Class (B.all)'Unchecked_Access;
      end;
   end Get_Manager;

end AWA.Modules;

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

with ASF.Requests;
with ASF.Responses;
with ASF.Server;
with Ada.IO_Exceptions;

with Util.Files;

with EL.Contexts.Default;

with AWA.Modules.Reader;
with AWA.Applications;
package body AWA.Modules is

   --  ------------------------------
   --  Get the module name
   --  ------------------------------
   function Get_Name (Plugin : in Module) return String is
   begin
      return To_String (Plugin.Name);
   end Get_Name;

   --  ------------------------------
   --  Get the base URI for this module
   --  ------------------------------
   function Get_URI (Plugin : in Module) return String is
   begin
      return To_String (Plugin.URI);
   end Get_URI;

   --  ------------------------------
   --  Get the application in which this module is registered.
   --  ------------------------------
   function Get_Application (Plugin : in Module) return Application_Access is
   begin
      return Plugin.App;
   end Get_Application;

   --  ------------------------------
   --  Get the module configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   --  ------------------------------
   function Get_Config (Plugin  : Module;
                        Name    : String;
                        Default : String := "") return String is
   begin
      return Plugin.Config.Get (Name, Default);
   end Get_Config;

   --  ------------------------------
   --  Get the module configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   --  ------------------------------
   function Get_Config (Plugin  : in Module;
                        Name    : in String;
                        Default : in Integer := -1) return Integer is
      Value : constant String := Plugin.Config.Get (Name, Integer'Image (Default));
   begin
      return Integer'Value (Value);

   exception
      when Constraint_Error =>
         return Default;
   end Get_Config;

   --  ------------------------------
   --  Send the event to the module
   --  ------------------------------
   procedure Send_Event (Plugin  : in Module;
                         Content : in AWA.Events.Module_Event'Class) is
   begin
      Plugin.App.Send_Event (Content);
   end Send_Event;

   --  ------------------------------
   --  Find the module with the given name
   --  ------------------------------
   function Find_Module (Plugin : Module;
                         Name   : String) return Module_Access is
   begin
      if Plugin.Registry = null then
         return null;
      end if;
      return Find_By_Name (Plugin.Registry.all, Name);
   end Find_Module;

   --  ------------------------------
   --  Register under the given name a function to create the bean instance when
   --  it is accessed for a first time.  The scope defines the scope of the bean.
   --  bean
   --  ------------------------------
   procedure Register (Plugin : in out Module;
                       Name    : in String;
                       Bind    : in ASF.Beans.Class_Binding_Access) is
   begin
      Plugin.App.Register_Class (Name, Bind);
   end Register;

   --  ------------------------------
   --  Finalize the module.
   --  ------------------------------
   overriding
   procedure Finalize (Plugin : in out Module) is
   begin
      null;
   end Finalize;

   procedure Initialize (Manager : in out Module_Manager;
                         Module  : in AWA.Modules.Module'Class) is
   begin
      Manager.Module := Module.Self;
   end Initialize;

   function Get_Value (Manager : in Module_Manager;
                       Name    : in String) return Util.Beans.Objects.Object is
      pragma Unreferenced (Manager, Name);
   begin
      return Util.Beans.Objects.Null_Object;
   end Get_Value;

   --  Module manager
   --
   --  ------------------------------
   --  Get the database connection for reading
   --  ------------------------------
   function Get_Session (Manager : Module_Manager)
                            return ADO.Sessions.Session is
   begin
      return Manager.Module.Get_Session;
   end Get_Session;

   --  ------------------------------
   --  Get the database connection for writing
   --  ------------------------------
   function Get_Master_Session (Manager : Module_Manager)
                                   return ADO.Sessions.Master_Session is
   begin
      return Manager.Module.Get_Master_Session;
   end Get_Master_Session;

   --  ------------------------------
   --  Send the event to the module.  The module identified by <b>To</b> is
   --  found and the event is posted on its event channel.
   --  ------------------------------
   procedure Send_Event (Manager : in Module_Manager;
                         Content : in AWA.Events.Module_Event'Class) is
   begin
      Manager.Module.Send_Event (Content);
   end Send_Event;

   procedure Initialize (Plugin : in out Module;
                         App    : in Application_Access;
                         Props  : in ASF.Applications.Config) is
      pragma Unreferenced (Props);
   begin
      Plugin.Self := Plugin'Unchecked_Access;
      Plugin.App := App;
   end Initialize;

   --  ------------------------------
   --  Initialize the registry
   --  ------------------------------
   procedure Initialize (Registry : in out Module_Registry;
                         Config   : in ASF.Applications.Config) is
   begin
      Registry.Config := Config;
   end Initialize;

   --  ------------------------------
   --  Register the module in the registry.
   --  ------------------------------
   procedure Register (Registry : in Module_Registry_Access;
                       App      : in Application_Access;
                       Plugin   : in Module_Access;
                       Name     : in String;
                       URI      : in String) is
      Paths : constant String := Registry.Config.Get (Applications.P_Module_Dir.P);
   begin
      Log.Info ("Register module '{0}' under URI '{1}'", Name, URI);

      if Plugin.Registry /= null then
         Log.Error ("Module '{0}' is already attached to a registry", Name);

         raise Program_Error with "Module '" & Name & "' already registered";
      end if;
      Plugin.App      := App;
      Plugin.Registry := Registry;
      Plugin.Name     := To_Unbounded_String (Name);
      Plugin.URI      := To_Unbounded_String (URI);
      Plugin.Registry.Name_Map.Insert (Name, Plugin);
      if URI /= "" then
         Plugin.Registry.URI_Map.Insert (URI, Plugin);
      end if;

      --  Load the module configuration file
      Log.Debug ("Module search path: {0}", Paths);
      declare
         Base  : constant String := Name & ".properties";
         Path  : constant String := Util.Files.Find_File_Path (Base, Paths);
      begin
         Plugin.Config.Load_Properties (Path => Path, Prefix => Name & ".", Strip => True);

      exception
         when Ada.IO_Exceptions.Name_Error =>
            Log.Warn ("Module configuration file '{0}' does not exist", Path);
      end;

      --  Override the module configuration with the application configuration
      Plugin.Config.Copy (From => Registry.Config, Prefix => Name & ".", Strip => True);

      Plugin.Initialize (App, Plugin.Config);

      --  Read the module XML configuration file if there is one.
      declare
         Base : constant String := Plugin.Config.Get ("config", Name & ".xml");
         Path : constant String := Util.Files.Find_File_Path (Base, Paths);
         Ctx  : aliased EL.Contexts.Default.Default_Context;
      begin
         AWA.Modules.Reader.Read_Configuration (Plugin.all, Path, Ctx'Unchecked_Access);

      exception
         when Ada.IO_Exceptions.Name_Error =>
            Log.Warn ("Module configuration file '{0}' does not exist", Path);
      end;

   exception
      when Constraint_Error =>
         Log.Error ("Another module is already registered "
                    & "under name '{0}' or URI '{1}'", Name, URI);
         raise;
   end Register;

   --  ------------------------------
   --  Find the module with the given name
   --  ------------------------------
   function Find_By_Name (Registry : Module_Registry;
                          Name     : String) return Module_Access is
      Pos : constant Module_Maps.Cursor := Module_Maps.Find (Registry.Name_Map, Name);
   begin
      if Module_Maps.Has_Element (Pos) then
         return Module_Maps.Element (Pos);
      end if;
      return null;
   end Find_By_Name;

   --  ------------------------------
   --  Find the module mapped to a given URI
   --  ------------------------------
   function Find_By_URI (Registry : Module_Registry;
                         URI      : String) return Module_Access is
      Pos : constant Module_Maps.Cursor := Module_Maps.Find (Registry.URI_Map, URI);
   begin
      if Module_Maps.Has_Element (Pos) then
         return Module_Maps.Element (Pos);
      end if;
      return null;
   end Find_By_URI;

   --  ------------------------------
   --  Get the database connection for reading
   --  ------------------------------
   function Get_Session (Manager : Module)
                            return ADO.Sessions.Session is
   begin
      return Manager.App.Get_Session;
   end Get_Session;

   --  ------------------------------
   --  Get the database connection for writing
   --  ------------------------------
   function Get_Master_Session (Manager : Module)
                                return ADO.Sessions.Master_Session is
   begin
      return Manager.App.Get_Master_Session;
   end Get_Master_Session;

   --  Get per request manager => look in Request
   --  Get per session manager => look in Request.Get_Session
   --  Get per application manager => look in Application
   --  Get per pool manager => look in pool attached to Application
   function Get_Manager return Manager_Type_Access is

      procedure Process (Request  : in out ASF.Requests.Request'Class;
                         Response : in out ASF.Responses.Response'Class);

      Value : Util.Beans.Objects.Object;

      procedure Process (Request  : in out ASF.Requests.Request'Class;
                         Response : in out ASF.Responses.Response'Class) is
         pragma Unreferenced (Response);
      begin
         Value := Request.Get_Attribute (Name);
         if Util.Beans.Objects.Is_Null (Value) then
            declare
               M : constant Manager_Type_Access := new Manager_Type;
            begin
               Value := Util.Beans.Objects.To_Object (M.all'Access);
               Request.Set_Attribute (Name, Value);
            end;
         end if;
      end Process;

   begin
      ASF.Server.Update_Context (Process'Access);
      if Util.Beans.Objects.Is_Null (Value) then
         return null;
      end if;
      declare
         B : constant access Util.Beans.Basic.Readonly_Bean'Class
           := Util.Beans.Objects.To_Bean (Value);
      begin
         if not (B.all in Manager_Type'Class) then
            return null;
         end if;
         return Manager_Type'Class (B.all)'Unchecked_Access;
      end;
   end Get_Manager;

end AWA.Modules;

Use Applications.P_Module_Dir.P variable instead of hard coded value


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

   --  ------------------------------
   --  Get the user setting identified by the given name.
   --  If the user does not have such setting, return the default value.
   --  ------------------------------
   function Get_User_Setting (Name    : in String;
                              Default : in String) return String is
      Mgr   : constant AWA.Settings.Modules.Setting_Manager_Access := AWA.Settings.Modules.Current;
      Value : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Mgr.Get (Name, Default, Value);
      return Ada.Strings.Unbounded.To_String (Value);
   end Get_User_Setting;

   --  ------------------------------
   --  Get the user setting identified by the given name.
   --  If the user does not have such setting, return the default value.
   --  ------------------------------
   function Get_User_Setting (Name    : in String;
                              Default : in Integer) return Integer is
   begin
      return Default;
   end Get_User_Setting;

   --  ------------------------------
   --  Set the user setting identified by the given name.  If the user
   --  does not have such setting, it is created and set to the given value.
   --  Otherwise, the user setting is updated to hold the new value.
   --  ------------------------------
   procedure Set_User_Setting (Name   : in String;
                               Value  : in String) is
      Mgr : constant AWA.Settings.Modules.Setting_Manager_Access := AWA.Settings.Modules.Current;
   begin
      Mgr.Set (Name, Value);
   end Set_User_Setting;

   --  ------------------------------
   --  Set the user setting identified by the given name.  If the user
   --  does not have such setting, it is created and set to the given value.
   --  Otherwise, the user setting is updated to hold the new value.
   --  ------------------------------
   procedure Set_User_Setting (Name   : in String;
                               Value  : in Integer) is
      Mgr : constant AWA.Settings.Modules.Setting_Manager_Access := AWA.Settings.Modules.Current;
   begin
      Mgr.Set (Name, Util.Strings.Image (Value));
   end Set_User_Setting;

end AWA.Settings;

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

   --  ------------------------------
   --  Get the user setting identified by the given name.
   --  If the user does not have such setting, return the default value.
   --  ------------------------------
   function Get_User_Setting (Name    : in String;
                              Default : in String) return String is
      Mgr   : constant AWA.Settings.Modules.Setting_Manager_Access := AWA.Settings.Modules.Current;
      Value : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Mgr.Get (Name, Default, Value);
      return Ada.Strings.Unbounded.To_String (Value);
   end Get_User_Setting;

   --  ------------------------------
   --  Get the user setting identified by the given name.
   --  If the user does not have such setting, return the default value.
   --  ------------------------------
   function Get_User_Setting (Name    : in String;
                              Default : in Integer) return Integer is
      Mgr   : constant AWA.Settings.Modules.Setting_Manager_Access := AWA.Settings.Modules.Current;
      Value : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Mgr.Get (Name, Integer'Image (Default), Value);
      return Integer'Value (Ada.Strings.Unbounded.To_String (Value));
   end Get_User_Setting;

   --  ------------------------------
   --  Set the user setting identified by the given name.  If the user
   --  does not have such setting, it is created and set to the given value.
   --  Otherwise, the user setting is updated to hold the new value.
   --  ------------------------------
   procedure Set_User_Setting (Name   : in String;
                               Value  : in String) is
      Mgr : constant AWA.Settings.Modules.Setting_Manager_Access := AWA.Settings.Modules.Current;
   begin
      Mgr.Set (Name, Value);
   end Set_User_Setting;

   --  ------------------------------
   --  Set the user setting identified by the given name.  If the user
   --  does not have such setting, it is created and set to the given value.
   --  Otherwise, the user setting is updated to hold the new value.
   --  ------------------------------
   procedure Set_User_Setting (Name   : in String;
                               Value  : in Integer) is
      Mgr : constant AWA.Settings.Modules.Setting_Manager_Access := AWA.Settings.Modules.Current;
   begin
      Mgr.Set (Name, Util.Strings.Image (Value));
   end Set_User_Setting;

end AWA.Settings;

Implement Get_User_Setting for integer

Implement Get_User_Setting for integer


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

with Security.Permissions;
with Security.Policies;

with Util.Serialize.IO.XML;

with ADO;
with ADO.Objects;

--  == Introduction ==
--  The *AWA.Permissions* framework defines and controls the permissions used by an application
--  to verify and grant access to the data and application service.  The framework provides a
--  set of services and API that helps an application in enforcing its specific permissions.
--  Permissions are verified by a permission controller which uses the service context to
--  have information about the user and other context.  The framework allows to use different
--  kinds of permission controllers.  The `Entity_Controller` is the default permission
--  controller which uses the database and an XML configuration to verify a permission.
--
--  === Declaration ===
--  To be used in the application, the first step is to declare the permission.
--  This is a static definition of the permission that will be used to ask to verify the
--  permission.  The permission is given a unique name that will be used in configuration files:
--
--    package ACL_Create_Post is new Security.Permissions.Definition ("blog-create-post");
--
--  === Checking for a permission ===
--  A permission can be checked in Ada as well as in the presentation pages.
--  This is done by using the `Check` procedure and the permission definition.  This operation
--  acts as a barrier: it does not return anything but returns normally if the permission is
--  granted.  If the permission is denied, it raises the `NO_PERMISSION` exception.
--
--  Several `Check` operation exists.  Some require no argument and some others need a context
--  such as some entity identifier to perform the check.
--
--    AWA.Permissions.Check (Permission => ACL_Create_Post.Permission,
--                           Entity     => Blog_Id);
--
--  === Configuring a permission ===
--  The *AWA.Permissions* framework supports a simple permission model
--  The application configuration file must provide some information to help in checking the
--  permission.  The permission name is referenced by the `name` XML entity.  The `entity-type`
--  refers to the database entity (ie, the table) that the permission concerns.
--  The `sql` XML entity represents the SQL statement that must be used to verify the permission.
--
--    <entity-permission>
--      <name>blog-create-post</name>
--      <entity-type>blog</entity-type>
--      <description>Permission to create a new post.</description>
--      <sql>
--        SELECT acl.id FROM acl
--        WHERE acl.entity_type = :entity_type
--        AND acl.user_id = :user_id
--        AND acl.entity_id = :entity_id
--      </sql>
--    </entity-permission>
--
--  === Adding a permission ===
--  Adding a permission means to create an `ACL` database record that links a given database
--  entity to the user.  This is done easily with the `Add_Permission` procedure:
--
--    AWA.Permissions.Services.Add_Permission (Session => DB,
--                                             User    => User,
--                                             Entity  => Blog);
--
--  == Data Model ==
--  @include Permission.hbm.xml
--
--  == Queries ==
--  @include permissions.xml
--
package AWA.Permissions is

   NAME : constant String := "Entity-Policy";

   --  Exception raised by the Check procedure if the user does not have
   --  the permission.
   NO_PERMISSION : exception;

   --  Maximum number of entity types that can be defined in the XML entity-permission.
   --  Most permission need only one entity type.  Keep that number small.
   MAX_ENTITY_TYPES : constant Positive := 5;

   type Entity_Type_Array is array (1 .. MAX_ENTITY_TYPES) of ADO.Entity_Type;

   type Permission_Type is (READ, WRITE);

   type Entity_Permission is new Security.Permissions.Permission with private;

   --  Verify that the permission represented by Permission is granted.
   --
   procedure Check (Permission : in Security.Permissions.Permission_Index);

   --  Verify that the permission represented by Permission is granted to access the
   --  database entity represented by Entity.
   procedure Check (Permission : in Security.Permissions.Permission_Index;
                    Entity     : in ADO.Identifier);

   --  Verify that the permission represented by Permission is granted to access the
   --  database entity represented by Entity.
   procedure Check (Permission : in Security.Permissions.Permission_Index;
                    Entity     : in ADO.Objects.Object_Ref'Class);

private

   type Entity_Permission is new Security.Permissions.Permission with record
      Entity : ADO.Identifier;
   end record;

   type Entity_Policy is new Security.Policies.Policy with null record;
   type Entity_Policy_Access is access all Entity_Policy'Class;

   --  Get the policy name.
   overriding
   function Get_Name (From : in Entity_Policy) return String;

   --  Setup the XML parser to read the policy description.
   overriding
   procedure Prepare_Config (Policy : in out Entity_Policy;
                             Reader : in out Util.Serialize.IO.XML.Parser);

end AWA.Permissions;

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

with Security.Permissions;
with Security.Policies;

with Util.Serialize.IO.XML;

with ADO;
with ADO.Objects;

--  == Introduction ==
--  The *AWA.Permissions* framework defines and controls the permissions used by an application
--  to verify and grant access to the data and application service.  The framework provides a
--  set of services and API that helps an application in enforcing its specific permissions.
--  Permissions are verified by a permission controller which uses the service context to
--  have information about the user and other context.  The framework allows to use different
--  kinds of permission controllers.  The `Entity_Controller` is the default permission
--  controller which uses the database and an XML configuration to verify a permission.
--
--  === Declaration ===
--  To be used in the application, the first step is to declare the permission.
--  This is a static definition of the permission that will be used to ask to verify the
--  permission.  The permission is given a unique name that will be used in configuration files:
--
--    with Security.Permissions;
--    ...
--    package ACL_Create_Post is new Security.Permissions.Definition ("blog-create-post");
--
--  === Checking for a permission ===
--  A permission can be checked in Ada as well as in the presentation pages.
--  This is done by using the `Check` procedure and the permission definition.  This operation
--  acts as a barrier: it does not return anything but returns normally if the permission is
--  granted.  If the permission is denied, it raises the `NO_PERMISSION` exception.
--
--  Several `Check` operation exists.  Some require no argument and some others need a context
--  such as some entity identifier to perform the check.
--
--    with AWA.Permissions;
--    ...
--    AWA.Permissions.Check (Permission => ACL_Create_Post.Permission,
--                           Entity     => Blog_Id);
--
--  === Configuring a permission ===
--  The *AWA.Permissions* framework supports a simple permission model
--  The application configuration file must provide some information to help in checking the
--  permission.  The permission name is referenced by the `name` XML entity.  The `entity-type`
--  refers to the database entity (ie, the table) that the permission concerns.
--  The `sql` XML entity represents the SQL statement that must be used to verify the permission.
--
--    <entity-permission>
--      <name>blog-create-post</name>
--      <entity-type>blog</entity-type>
--      <description>Permission to create a new post.</description>
--      <sql>
--        SELECT acl.id FROM acl
--        WHERE acl.entity_type = :entity_type
--        AND acl.user_id = :user_id
--        AND acl.entity_id = :entity_id
--      </sql>
--    </entity-permission>
--
--  === Adding a permission ===
--  Adding a permission means to create an `ACL` database record that links a given database
--  entity to the user.  This is done easily with the `Add_Permission` procedure:
--
--    with AWA.Permissions.Services;
--    ...
--    AWA.Permissions.Services.Add_Permission (Session => DB,
--                                             User    => User,
--                                             Entity  => Blog);
--
--  == Data Model ==
--  [images/awa_permissions_model.png]
--
--  == Queries ==
--  @include permissions.xml
--
package AWA.Permissions is

   NAME : constant String := "Entity-Policy";

   --  Exception raised by the Check procedure if the user does not have
   --  the permission.
   NO_PERMISSION : exception;

   --  Maximum number of entity types that can be defined in the XML entity-permission.
   --  Most permission need only one entity type.  Keep that number small.
   MAX_ENTITY_TYPES : constant Positive := 5;

   type Entity_Type_Array is array (1 .. MAX_ENTITY_TYPES) of ADO.Entity_Type;

   type Permission_Type is (READ, WRITE);

   type Entity_Permission is new Security.Permissions.Permission with private;

   --  Verify that the permission represented by Permission is granted.
   --
   procedure Check (Permission : in Security.Permissions.Permission_Index);

   --  Verify that the permission represented by Permission is granted to access the
   --  database entity represented by Entity.
   procedure Check (Permission : in Security.Permissions.Permission_Index;
                    Entity     : in ADO.Identifier);

   --  Verify that the permission represented by Permission is granted to access the
   --  database entity represented by Entity.
   procedure Check (Permission : in Security.Permissions.Permission_Index;
                    Entity     : in ADO.Objects.Object_Ref'Class);

private

   type Entity_Permission is new Security.Permissions.Permission with record
      Entity : ADO.Identifier;
   end record;

   type Entity_Policy is new Security.Policies.Policy with null record;
   type Entity_Policy_Access is access all Entity_Policy'Class;

   --  Get the policy name.
   overriding
   function Get_Name (From : in Entity_Policy) return String;

   --  Setup the XML parser to read the policy description.
   overriding
   procedure Prepare_Config (Policy : in out Entity_Policy;
                             Reader : in out Util.Serialize.IO.XML.Parser);

end AWA.Permissions;

Update the documentation

Update the documentation