-----------------------------------------------------------------------
--  wiki-filters-variables -- Expand variables in text and links
--  Copyright (C) 2020 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.
-----------------------------------------------------------------------

private with Ada.Containers.Indefinite_Hashed_Maps;

--  === Variables Filters ===
--  The `Wiki.Filters.Variables` package defines a filter that replaces variables
--  in the text, links, quotes.  Variables are represented as `$name`, `$(name)`
--  or `${name}`.  When a variable is not found, the original string is not modified.
--  The list of variables is either configured programatically through the
--  `Add_Variable` procedures but it can also be set from the Wiki text by using
--  the `Wiki.Plugins.Variables` plugin.
package Wiki.Filters.Variables is

   pragma Preelaborate;

   type Variable_Filter is new Filter_Type with private;
   type Variable_Filter_Access is access all Variable_Filter'Class;

   --  Add a variable to replace the given name by its value.
   procedure Add_Variable (Filter : in out Variable_Filter;
                           Name   : in Wiki.Strings.WString;
                           Value  : in Wiki.Strings.WString);

   procedure Add_Variable (Filter : in out Variable_Filter;
                           Name   : in String;
                           Value  : in Wiki.Strings.WString);

   procedure Add_Variable (Chain : in Wiki.Filters.Filter_Chain;
                           Name  : in Wiki.Strings.WString;
                           Value : in Wiki.Strings.WString);

   --  Add a section header with the given level in the document.
   overriding
   procedure Add_Header (Filter    : in out Variable_Filter;
                         Document  : in out Wiki.Documents.Document;
                         Header    : in Wiki.Strings.WString;
                         Level     : in Natural);

   --  Add a text content with the given format to the document.  Replace variables
   --  that are contained in the text.
   overriding
   procedure Add_Text (Filter    : in out Variable_Filter;
                       Document  : in out Wiki.Documents.Document;
                       Text      : in Wiki.Strings.WString;
                       Format    : in Wiki.Format_Map);

   --  Add a link.
   overriding
   procedure Add_Link (Filter     : in out Variable_Filter;
                       Document   : in out Wiki.Documents.Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List);

   --  Add a quote.
   overriding
   procedure Add_Quote (Filter     : in out Variable_Filter;
                        Document   : in out Wiki.Documents.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List);

   --  Expand the variables contained in the text.
   function Expand (Filter : in Variable_Filter;
                    Text   : in Wiki.Strings.WString) return Wiki.Strings.WString;

   --  Iterate over the filter variables.
   procedure Iterate (Filter  : in Variable_Filter;
                      Process : not null
                        access procedure (Name, Value : in Strings.WString));

private

   package Variable_Maps is
     new Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => Strings.WString,
                                                Element_Type    => Strings.WString,
                                                Hash            => Strings.Hash,
                                                Equivalent_Keys => "=",
                                                "="             => "=");

   subtype Variable_Map is Variable_Maps.Map;
   subtype Variable_Cursor is Variable_Maps.Cursor;

   type Variable_Filter is new Filter_Type with record
      Variables : Variable_Map;
   end record;

end Wiki.Filters.Variables;

-----------------------------------------------------------------------
--  wiki-filters-variables -- Expand variables in text and links
--  Copyright (C) 2020 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.
-----------------------------------------------------------------------

private with Ada.Containers.Indefinite_Ordered_Maps;

--  === Variables Filters ===
--  The `Wiki.Filters.Variables` package defines a filter that replaces variables
--  in the text, links, quotes.  Variables are represented as `$name`, `$(name)`
--  or `${name}`.  When a variable is not found, the original string is not modified.
--  The list of variables is either configured programatically through the
--  `Add_Variable` procedures but it can also be set from the Wiki text by using
--  the `Wiki.Plugins.Variables` plugin.
package Wiki.Filters.Variables is

   pragma Preelaborate;

   type Variable_Filter is new Filter_Type with private;
   type Variable_Filter_Access is access all Variable_Filter'Class;

   --  Add a variable to replace the given name by its value.
   procedure Add_Variable (Filter : in out Variable_Filter;
                           Name   : in Wiki.Strings.WString;
                           Value  : in Wiki.Strings.WString);

   procedure Add_Variable (Filter : in out Variable_Filter;
                           Name   : in String;
                           Value  : in Wiki.Strings.WString);

   procedure Add_Variable (Chain : in Wiki.Filters.Filter_Chain;
                           Name  : in Wiki.Strings.WString;
                           Value : in Wiki.Strings.WString);

   --  Add a section header with the given level in the document.
   overriding
   procedure Add_Header (Filter    : in out Variable_Filter;
                         Document  : in out Wiki.Documents.Document;
                         Header    : in Wiki.Strings.WString;
                         Level     : in Natural);

   --  Add a text content with the given format to the document.  Replace variables
   --  that are contained in the text.
   overriding
   procedure Add_Text (Filter    : in out Variable_Filter;
                       Document  : in out Wiki.Documents.Document;
                       Text      : in Wiki.Strings.WString;
                       Format    : in Wiki.Format_Map);

   --  Add a link.
   overriding
   procedure Add_Link (Filter     : in out Variable_Filter;
                       Document   : in out Wiki.Documents.Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List);

   --  Add a quote.
   overriding
   procedure Add_Quote (Filter     : in out Variable_Filter;
                        Document   : in out Wiki.Documents.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List);

   --  Expand the variables contained in the text.
   function Expand (Filter : in Variable_Filter;
                    Text   : in Wiki.Strings.WString) return Wiki.Strings.WString;

   --  Iterate over the filter variables.
   procedure Iterate (Filter  : in Variable_Filter;
                      Process : not null
                        access procedure (Name, Value : in Strings.WString));

   procedure Iterate (Chain   : in Wiki.Filters.Filter_Chain;
                      Process : not null
                        access procedure (Name, Value : in Strings.WString));

private

   package Variable_Maps is
     new Ada.Containers.Indefinite_Ordered_Maps (Key_Type        => Strings.WString,
                                                 Element_Type    => Strings.WString);

   subtype Variable_Map is Variable_Maps.Map;
   subtype Variable_Cursor is Variable_Maps.Cursor;

   type Variable_Filter is new Filter_Type with record
      Variables : Variable_Map;
   end record;

end Wiki.Filters.Variables;

Add Iterate procedure with a Filter_Chain and change the map to use an Ordered_Maps so that listing the variables is sorted on their name


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

with ADO.Databases;
with ADO.Schemas.Entities;
with ADO.Sequences;

--  === Session Factory ===
--  The session factory is the entry point to obtain a database session.
--  The <b>ADO.Sessions.Factory</b> package defines the factory for creating
--  sessions.
--
--    with ADO.Sessions.Factory;
--    ...
--    Sess_Factory : ADO.Sessions.Factory;
--
--  The session factory can be initialized by using the <tt>Create</tt> operation and
--  by giving a URI string that identifies the driver and the information to connect
--  to the database.  The session factory is created only once when the application starts.
--
--    ADO.Sessions.Factory.Create (Sess_Factory, "mysql://localhost:3306/ado_test?user=test");
--
--  Having a session factory, one can get a database by using the <tt>Get_Session</tt> or
--  <tt>Get_Master_Session</tt> function.  Each time this operation is called, a new session
--  is returned.  The session is released when the session variable is finalized.
--
--    DB : ADO.Sessions.Session := Sess_Factory.Get_Session;
--
package ADO.Sessions.Factory is

   pragma Elaborate_Body;

   --  ------------------------------
   --  Session factory
   --  ------------------------------
   type Session_Factory is tagged limited private;
   type Session_Factory_Access is access all Session_Factory'Class;

   --  Get a read-only session from the factory.
   function Get_Session (Factory : in Session_Factory) return Session;

   --  Get a read-write session from the factory.
   function Get_Master_Session (Factory : in Session_Factory) return Master_Session;

   --  Open a session
   procedure Open_Session (Factory : in out Session_Factory;
                           Database : out Session);

   --  Open a session
   procedure Open_Session (Factory : in Session_Factory;
                           Database : out Master_Session);

   --  Create the session factory to connect to the database represented
   --  by the data source.
   procedure Create (Factory : out Session_Factory;
                     Source  : in ADO.Databases.DataSource);

   --  Create the session factory to connect to the database identified
   --  by the URI.
   procedure Create (Factory : out Session_Factory;
                     URI     : in String);

   --  Get a read-only session from the session proxy.
   --  If the session has been invalidated, raise the SESSION_EXPIRED exception.
   function Get_Session (Proxy : in Session_Record_Access) return Session;
private

   --  The session factory holds the necessary information to obtain a master or slave
   --  database connection.  The sequence factory is shared by all sessions of the same
   --  factory (implementation is thread-safe).  The factory also contains the entity type
   --  cache which is initialized when the factory is created.
   type Session_Factory is tagged limited record
      Source       : ADO.Databases.DataSource;
      Sequences    : Factory_Access := null;
      Seq_Factory  : aliased ADO.Sequences.Factory;
      Entity_Cache : aliased ADO.Schemas.Entities.Entity_Cache;
      Entities     : ADO.Sessions.Entity_Cache_Access := null;
   end record;

   --  Initialize the sequence factory associated with the session factory.
   procedure Initialize_Sequences (Factory : in out Session_Factory);

end ADO.Sessions.Factory;

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

with ADO.Databases;
with ADO.Schemas.Entities;
with ADO.Sequences;
with ADO.Caches;

--  === Session Factory ===
--  The session factory is the entry point to obtain a database session.
--  The <b>ADO.Sessions.Factory</b> package defines the factory for creating
--  sessions.
--
--    with ADO.Sessions.Factory;
--    ...
--    Sess_Factory : ADO.Sessions.Factory;
--
--  The session factory can be initialized by using the <tt>Create</tt> operation and
--  by giving a URI string that identifies the driver and the information to connect
--  to the database.  The session factory is created only once when the application starts.
--
--    ADO.Sessions.Factory.Create (Sess_Factory, "mysql://localhost:3306/ado_test?user=test");
--
--  Having a session factory, one can get a database by using the <tt>Get_Session</tt> or
--  <tt>Get_Master_Session</tt> function.  Each time this operation is called, a new session
--  is returned.  The session is released when the session variable is finalized.
--
--    DB : ADO.Sessions.Session := Sess_Factory.Get_Session;
--
package ADO.Sessions.Factory is

   pragma Elaborate_Body;

   ENTITY_CACHE_NAME : constant String := "entity_type";

   --  ------------------------------
   --  Session factory
   --  ------------------------------
   type Session_Factory is tagged limited private;
   type Session_Factory_Access is access all Session_Factory'Class;

   --  Get a read-only session from the factory.
   function Get_Session (Factory : in Session_Factory) return Session;

   --  Get a read-write session from the factory.
   function Get_Master_Session (Factory : in Session_Factory) return Master_Session;

   --  Open a session
   procedure Open_Session (Factory : in out Session_Factory;
                           Database : out Session);

   --  Open a session
   procedure Open_Session (Factory : in Session_Factory;
                           Database : out Master_Session);

   --  Create the session factory to connect to the database represented
   --  by the data source.
   procedure Create (Factory : out Session_Factory;
                     Source  : in ADO.Databases.DataSource);

   --  Create the session factory to connect to the database identified
   --  by the URI.
   procedure Create (Factory : out Session_Factory;
                     URI     : in String);

   --  Get a read-only session from the session proxy.
   --  If the session has been invalidated, raise the SESSION_EXPIRED exception.
   function Get_Session (Proxy : in Session_Record_Access) return Session;
private

   --  The session factory holds the necessary information to obtain a master or slave
   --  database connection.  The sequence factory is shared by all sessions of the same
   --  factory (implementation is thread-safe).  The factory also contains the entity type
   --  cache which is initialized when the factory is created.
   type Session_Factory is tagged limited record
      Source       : ADO.Databases.DataSource;
      Sequences    : Factory_Access := null;
      Seq_Factory  : aliased ADO.Sequences.Factory;
      --  Entity_Cache : aliased ADO.Schemas.Entities.Entity_Cache;
      Entities     : ADO.Sessions.Entity_Cache_Access := null;
      Cache        : aliased ADO.Caches.Cache_Manager;
      Cache_Values : ADO.Caches.Cache_Manager_Access;
   end record;

   --  Initialize the sequence factory associated with the session factory.
   procedure Initialize_Sequences (Factory : in out Session_Factory);

end ADO.Sessions.Factory;

Add a cache to the factory object Define the entity_type cache group name


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

with Security.Permissions;

with AWA.Modules.Beans;
with AWA.Modules.Get;
with AWA.Votes.Beans;
with AWA.Permissions;
with AWA.Services.Contexts;
with AWA.Votes.Models;

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

package body AWA.Votes.Modules is

   use AWA.Services;
   use ADO.Sessions;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Votes.Module");

   package Register is new AWA.Modules.Beans (Module => Vote_Module,
                                              Module_Access => Vote_Module_Access);

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

      --  Register here any bean class, servlet, filter.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Votes.Beans.Votes_Bean",
                         Handler => AWA.Votes.Beans.Create_Vote_Bean'Access);

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

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

   --  ------------------------------
   --  Get the votes module.
   --  ------------------------------
   function Get_Vote_Module return Vote_Module_Access is
      function Get is new AWA.Modules.Get (Vote_Module, Vote_Module_Access, NAME);
   begin
      return Get;
   end Get_Vote_Module;

   --  ------------------------------
   --  Vote for the given element.
   --  ------------------------------
   procedure Vote_For (Model       : in Vote_Module;
                       Id          : in ADO.Identifier;
                       Entity_Type : in String;
                       Permission  : in String;
                       Rating      : in Integer) is
      pragma Unreferenced (Model);

      Ctx   : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : constant Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Kind  : ADO.Entity_Type;
   begin
      Log.Info ("User {0} votes for {1} rating {2}",
                ADO.Identifier'Image (User), Entity_Type & ADO.Identifier'Image (Id),
                Integer'Image (Rating));

      Ctx.Start;

      Kind := ADO.Sessions.Entities.Find_Entity_Type (DB, Entity_Type);

      --  Check that the user has the vote permission on the given object.
      AWA.Permissions.Check (Permission => Security.Permissions.Get_Permission_Index (Permission),
                             Entity     => Id);

      declare
         Stmt   : ADO.Statements.Insert_Statement
           := DB.Create_Statement (AWA.Votes.Models.VOTE_TABLE);
         Result : Integer;
      begin
         Stmt.Save_Field (Name  => "for_entity_id",
                          Value => Id);
         Stmt.Save_Field (Name  => "user_id",
                          Value => User);
         Stmt.Save_Field (Name  => "rating",
                          Value => Rating);
         Stmt.Save_Field (Name  => "for_entity_type",
                          Value => Kind);
         Stmt.Execute (Result);
         if Result /= 1 then
            declare
               Update : ADO.Statements.Update_Statement
                 := DB.Create_Statement (AWA.Votes.Models.VOTE_TABLE);
            begin
               Update.Save_Field (Name => "rating", Value => Rating);
               Update.Set_Filter ("for_entity_id = :id and user_id = :user "
                                  & "and for_entity_type = :type");
               Update.Bind_Param ("id", Id);
               Update.Bind_Param ("user", User);
               Update.Bind_Param ("type", Kind);
               Update.Execute (Result);
            end;
         end if;
      end;
      Ctx.Commit;
   end Vote_For;

end AWA.Votes.Modules;

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

with Security.Permissions;

with AWA.Modules.Beans;
with AWA.Modules.Get;
with AWA.Votes.Beans;
with AWA.Permissions;
with AWA.Services.Contexts;
with AWA.Users.Models;
with AWA.Votes.Models;

with ADO.SQL;
with ADO.Sessions;
with ADO.Statements;
with ADO.Sessions.Entities;

package body AWA.Votes.Modules is

   use AWA.Services;
   use ADO.Sessions;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Votes.Module");

   package Register is new AWA.Modules.Beans (Module => Vote_Module,
                                              Module_Access => Vote_Module_Access);

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

      --  Register here any bean class, servlet, filter.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Votes.Beans.Votes_Bean",
                         Handler => AWA.Votes.Beans.Create_Vote_Bean'Access);

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

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

   --  ------------------------------
   --  Get the votes module.
   --  ------------------------------
   function Get_Vote_Module return Vote_Module_Access is
      function Get is new AWA.Modules.Get (Vote_Module, Vote_Module_Access, NAME);
   begin
      return Get;
   end Get_Vote_Module;

   --  ------------------------------
   --  Vote for the given element and return the total vote for that element.
   --  ------------------------------
   procedure Vote_For (Model       : in Vote_Module;
                       Id          : in ADO.Identifier;
                       Entity_Type : in String;
                       Permission  : in String;
                       Value       : in Integer;
                       Total       : out Integer) is
      pragma Unreferenced (Model);

      Ctx    : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User   : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      DB     : Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Kind   : ADO.Entity_Type;
      Rating : AWA.Votes.Models.Rating_Ref;
      Vote   : AWA.Votes.Models.Vote_Ref;
      Query  : ADO.SQL.Query;
      Found  : Boolean;
   begin
      Log.Info ("User {0} votes for {1} rating {2}",
                ADO.Identifier'Image (User.Get_Id), Entity_Type & ADO.Identifier'Image (Id),
                Integer'Image (Value));

      Ctx.Start;
      Kind := ADO.Sessions.Entities.Find_Entity_Type (DB, Entity_Type);

      --  Check that the user has the vote permission on the given object.
      AWA.Permissions.Check (Permission => Security.Permissions.Get_Permission_Index (Permission),
                             Entity     => Id);

      --  Get the vote associated with the object for the user.
      Query.Set_Join ("INNER JOIN awa_rating r ON r.id = o.entity_id");
      Query.Set_Filter ("r.for_entity_id = :id and r.for_entity_type = :type "
                        & "and o.user_id = :user_id");
      Query.Bind_Param ("id", Id);
      Query.Bind_Param ("type", Kind);
      Query.Bind_Param ("user_id", User.Get_Id);
      Vote.Find (DB, Query, Found);
      if not Found then
         Query.Clear;

         --  Get the rating associated with the object.
         Query.Set_Filter ("for_entity_id = :id and for_entity_type = :type");
         Query.Bind_Param ("id", Id);
         Query.Bind_Param ("type", Kind);
         Rating.Find (DB, Query, Found);

         --  Create it if it does not exist.
         if not Found then
            Rating.Set_For_Entity_Id (Id);
            Rating.Set_For_Entity_Type (Kind);
            Rating.Set_Rating (Value);
            Rating.Set_Vote_Count (1);
         else
            Rating.Set_Vote_Count (Rating.Get_Vote_Count + 1);
            Rating.Set_Rating (Value + Rating.Get_Rating);
         end if;
         Rating.Save (DB);

         Vote.Set_User (User);
         Vote.Set_Entity (Rating);
      else
         Rating := AWA.Votes.Models.Rating_Ref (Vote.Get_Entity);
         Rating.Set_Rating (Rating.Get_Rating + Value - Vote.Get_Rating);
         Rating.Save (DB);
      end if;
      Vote.Set_Rating (Value);
      Vote.Save (DB);

      --  Return the total rating for the element.
      Total := Rating.Get_Rating;
      Ctx.Commit;
   end Vote_For;

end AWA.Votes.Modules;

Update the vote and the rating table associated with the vote


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

--  The Util.Encodes.Base64 packages encodes and decodes streams
--  in Base64 (See rfc4648: The Base16, Base32, and Base64 Data Encodings).
package Util.Encoders.Base64 is

   --  ------------------------------
   --  Base64 encoder
   --  ------------------------------
   --  This Encoder translates the (binary) input stream into
   --  a Base64 ascii stream.
   type Encoder is new Util.Encoders.Transformer with private;

   --  Encodes the binary input stream represented by Data into
   --  the a base64 output stream Into.
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   overriding
   procedure Transform (E       : in Encoder;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset);

   --  Delete the encoder object.
   overriding
   procedure Delete (E : access Encoder);

   --  ------------------------------
   --  Base64 decoder
   --  ------------------------------
   --  The Decoder decodes a Base64 ascii stream into a binary stream.
   type Decoder is new Util.Encoders.Transformer with private;

   --  Decodes the base64 input stream represented by Data into
   --  the binary output stream Into.
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   overriding
   procedure Transform (E       : in Decoder;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset);

   --  Delete the decoder object.
   overriding
   procedure Delete (E : access Decoder);

private

   type Alphabet is
     array (Interfaces.Unsigned_8 range 0 .. 63) of Ada.Streams.Stream_Element;

   type Alphabet_Access is not null access constant Alphabet;

   BASE64_ALPHABET : aliased constant Alphabet :=
     (Character'Pos ('A'), Character'Pos ('B'), Character'Pos ('C'), Character'Pos ('D'),
      Character'Pos ('E'), Character'Pos ('F'), Character'Pos ('G'), Character'Pos ('H'),
      Character'Pos ('I'), Character'Pos ('J'), Character'Pos ('K'), Character'Pos ('L'),
      Character'Pos ('M'), Character'Pos ('N'), Character'Pos ('O'), Character'Pos ('P'),
      Character'Pos ('Q'), Character'Pos ('R'), Character'Pos ('S'), Character'Pos ('T'),
      Character'Pos ('U'), Character'Pos ('V'), Character'Pos ('W'), Character'Pos ('X'),
      Character'Pos ('Y'), Character'Pos ('Z'), Character'Pos ('a'), Character'Pos ('b'),
      Character'Pos ('c'), Character'Pos ('d'), Character'Pos ('e'), Character'Pos ('f'),
      Character'Pos ('g'), Character'Pos ('h'), Character'Pos ('i'), Character'Pos ('j'),
      Character'Pos ('k'), Character'Pos ('l'), Character'Pos ('m'), Character'Pos ('n'),
      Character'Pos ('o'), Character'Pos ('p'), Character'Pos ('q'), Character'Pos ('r'),
      Character'Pos ('s'), Character'Pos ('t'), Character'Pos ('u'), Character'Pos ('v'),
      Character'Pos ('w'), Character'Pos ('x'), Character'Pos ('y'), Character'Pos ('z'),
      Character'Pos ('0'), Character'Pos ('1'), Character'Pos ('2'), Character'Pos ('3'),
      Character'Pos ('4'), Character'Pos ('5'), Character'Pos ('6'), Character'Pos ('7'),
      Character'Pos ('8'), Character'Pos ('9'), Character'Pos ('+'), Character'Pos ('/'));

   BASE64_URL_ALPHABET : aliased constant Alphabet :=
     (Character'Pos ('A'), Character'Pos ('B'), Character'Pos ('C'), Character'Pos ('D'),
      Character'Pos ('E'), Character'Pos ('F'), Character'Pos ('G'), Character'Pos ('H'),
      Character'Pos ('I'), Character'Pos ('J'), Character'Pos ('K'), Character'Pos ('L'),
      Character'Pos ('M'), Character'Pos ('N'), Character'Pos ('O'), Character'Pos ('P'),
      Character'Pos ('Q'), Character'Pos ('R'), Character'Pos ('S'), Character'Pos ('T'),
      Character'Pos ('U'), Character'Pos ('V'), Character'Pos ('W'), Character'Pos ('X'),
      Character'Pos ('Y'), Character'Pos ('Z'), Character'Pos ('a'), Character'Pos ('b'),
      Character'Pos ('c'), Character'Pos ('d'), Character'Pos ('e'), Character'Pos ('f'),
      Character'Pos ('g'), Character'Pos ('h'), Character'Pos ('i'), Character'Pos ('j'),
      Character'Pos ('k'), Character'Pos ('l'), Character'Pos ('m'), Character'Pos ('n'),
      Character'Pos ('o'), Character'Pos ('p'), Character'Pos ('q'), Character'Pos ('r'),
      Character'Pos ('s'), Character'Pos ('t'), Character'Pos ('u'), Character'Pos ('v'),
      Character'Pos ('w'), Character'Pos ('x'), Character'Pos ('y'), Character'Pos ('z'),
      Character'Pos ('0'), Character'Pos ('1'), Character'Pos ('2'), Character'Pos ('3'),
      Character'Pos ('4'), Character'Pos ('5'), Character'Pos ('6'), Character'Pos ('7'),
      Character'Pos ('8'), Character'Pos ('9'), Character'Pos ('+'), Character'Pos ('/'));

   type Encoder is new Util.Encoders.Transformer with record
      Alphabet : Alphabet_Access := BASE64_ALPHABET'Access;
   end record;

   type Alphabet_Values is array (Ada.Streams.Stream_Element) of Interfaces.Unsigned_8;
   type Alphabet_Values_Access is not null access constant Alphabet_Values;

   BASE64_VALUES : aliased constant Alphabet_Values :=
     (Character'Pos ('A') => 0,  Character'Pos ('B') => 1,
      Character'Pos ('C') => 2,  Character'Pos ('D') => 3,
      Character'Pos ('E') => 4,  Character'Pos ('F') => 5,
      Character'Pos ('G') => 6,  Character'Pos ('H') => 7,
      Character'Pos ('I') => 8,  Character'Pos ('J') => 9,
      Character'Pos ('K') => 10, Character'Pos ('L') => 11,
      Character'Pos ('M') => 12, Character'Pos ('N') => 13,
      Character'Pos ('O') => 14, Character'Pos ('P') => 15,
      Character'Pos ('Q') => 16, Character'Pos ('R') => 17,
      Character'Pos ('S') => 18, Character'Pos ('T') => 19,
      Character'Pos ('U') => 20, Character'Pos ('V') => 21,
      Character'Pos ('W') => 22, Character'Pos ('X') => 23,
      Character'Pos ('Y') => 24, Character'Pos ('Z') => 25,
      Character'Pos ('a') => 26, Character'Pos ('b') => 27,
      Character'Pos ('c') => 28, Character'Pos ('d') => 29,
      Character'Pos ('e') => 30, Character'Pos ('f') => 31,
      Character'Pos ('g') => 32, Character'Pos ('h') => 33,
      Character'Pos ('i') => 34, Character'Pos ('j') => 35,
      Character'Pos ('k') => 35, Character'Pos ('l') => 37,
      Character'Pos ('m') => 38, Character'Pos ('n') => 39,
      Character'Pos ('o') => 40, Character'Pos ('p') => 41,
      Character'Pos ('q') => 42, Character'Pos ('r') => 43,
      Character'Pos ('s') => 44, Character'Pos ('t') => 45,
      Character'Pos ('u') => 46, Character'Pos ('v') => 47,
      Character'Pos ('w') => 48, Character'Pos ('x') => 49,
      Character'Pos ('y') => 50, Character'Pos ('z') => 51,
      Character'Pos ('0') => 52, Character'Pos ('1') => 53,
      Character'Pos ('2') => 54, Character'Pos ('3') => 55,
      Character'Pos ('4') => 56, Character'Pos ('5') => 57,
      Character'Pos ('6') => 58, Character'Pos ('7') => 59,
      Character'Pos ('8') => 60, Character'Pos ('9') => 61,
      Character'Pos ('+') => 62, Character'Pos ('/') => 63,
     others => 16#FF#);

   BASE64_URL_VALUES : aliased constant Alphabet_Values :=
     (Character'Pos ('A') => 0,  Character'Pos ('B') => 1,
      Character'Pos ('C') => 2,  Character'Pos ('D') => 3,
      Character'Pos ('E') => 4,  Character'Pos ('F') => 5,
      Character'Pos ('G') => 6,  Character'Pos ('H') => 7,
      Character'Pos ('I') => 8,  Character'Pos ('J') => 9,
      Character'Pos ('K') => 10, Character'Pos ('L') => 11,
      Character'Pos ('M') => 12, Character'Pos ('N') => 13,
      Character'Pos ('O') => 14, Character'Pos ('P') => 15,
      Character'Pos ('Q') => 16, Character'Pos ('R') => 17,
      Character'Pos ('S') => 18, Character'Pos ('T') => 19,
      Character'Pos ('U') => 20, Character'Pos ('V') => 21,
      Character'Pos ('W') => 22, Character'Pos ('X') => 23,
      Character'Pos ('Y') => 24, Character'Pos ('Z') => 25,
      Character'Pos ('a') => 26, Character'Pos ('b') => 27,
      Character'Pos ('c') => 28, Character'Pos ('d') => 29,
      Character'Pos ('e') => 30, Character'Pos ('f') => 31,
      Character'Pos ('g') => 32, Character'Pos ('h') => 33,
      Character'Pos ('i') => 34, Character'Pos ('j') => 35,
      Character'Pos ('k') => 35, Character'Pos ('l') => 37,
      Character'Pos ('m') => 38, Character'Pos ('n') => 39,
      Character'Pos ('o') => 40, Character'Pos ('p') => 41,
      Character'Pos ('q') => 42, Character'Pos ('r') => 43,
      Character'Pos ('s') => 44, Character'Pos ('t') => 45,
      Character'Pos ('u') => 46, Character'Pos ('v') => 47,
      Character'Pos ('w') => 48, Character'Pos ('x') => 49,
      Character'Pos ('y') => 50, Character'Pos ('z') => 51,
      Character'Pos ('0') => 52, Character'Pos ('1') => 53,
      Character'Pos ('2') => 54, Character'Pos ('3') => 55,
      Character'Pos ('4') => 56, Character'Pos ('5') => 57,
      Character'Pos ('6') => 58, Character'Pos ('7') => 59,
      Character'Pos ('8') => 60, Character'Pos ('9') => 61,
      Character'Pos ('-') => 62, Character'Pos ('_') => 63,
      others => 16#FF#);

   type Decoder is new Util.Encoders.Transformer with record
      Values : Alphabet_Values_Access := BASE64_VALUES'Access;
   end record;

end Util.Encoders.Base64;

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

--  The Util.Encodes.Base64 packages encodes and decodes streams
--  in Base64 (See rfc4648: The Base16, Base32, and Base64 Data Encodings).
package Util.Encoders.Base64 is

   --  ------------------------------
   --  Base64 encoder
   --  ------------------------------
   --  This Encoder translates the (binary) input stream into
   --  a Base64 ascii stream.
   type Encoder is new Util.Encoders.Transformer with private;

   --  Encodes the binary input stream represented by Data into
   --  the a base64 output stream Into.
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   overriding
   procedure Transform (E       : in Encoder;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset);

   --  Delete the encoder object.
   overriding
   procedure Delete (E : access Encoder);

   --  ------------------------------
   --  Base64 decoder
   --  ------------------------------
   --  The Decoder decodes a Base64 ascii stream into a binary stream.
   type Decoder is new Util.Encoders.Transformer with private;

   --  Decodes the base64 input stream represented by Data into
   --  the binary output stream Into.
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   overriding
   procedure Transform (E       : in Decoder;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset);

   --  Delete the decoder object.
   overriding
   procedure Delete (E : access Decoder);

private

   type Alphabet is
     array (Interfaces.Unsigned_8 range 0 .. 63) of Ada.Streams.Stream_Element;

   type Alphabet_Access is not null access constant Alphabet;

   BASE64_ALPHABET : aliased constant Alphabet :=
     (Character'Pos ('A'), Character'Pos ('B'), Character'Pos ('C'), Character'Pos ('D'),
      Character'Pos ('E'), Character'Pos ('F'), Character'Pos ('G'), Character'Pos ('H'),
      Character'Pos ('I'), Character'Pos ('J'), Character'Pos ('K'), Character'Pos ('L'),
      Character'Pos ('M'), Character'Pos ('N'), Character'Pos ('O'), Character'Pos ('P'),
      Character'Pos ('Q'), Character'Pos ('R'), Character'Pos ('S'), Character'Pos ('T'),
      Character'Pos ('U'), Character'Pos ('V'), Character'Pos ('W'), Character'Pos ('X'),
      Character'Pos ('Y'), Character'Pos ('Z'), Character'Pos ('a'), Character'Pos ('b'),
      Character'Pos ('c'), Character'Pos ('d'), Character'Pos ('e'), Character'Pos ('f'),
      Character'Pos ('g'), Character'Pos ('h'), Character'Pos ('i'), Character'Pos ('j'),
      Character'Pos ('k'), Character'Pos ('l'), Character'Pos ('m'), Character'Pos ('n'),
      Character'Pos ('o'), Character'Pos ('p'), Character'Pos ('q'), Character'Pos ('r'),
      Character'Pos ('s'), Character'Pos ('t'), Character'Pos ('u'), Character'Pos ('v'),
      Character'Pos ('w'), Character'Pos ('x'), Character'Pos ('y'), Character'Pos ('z'),
      Character'Pos ('0'), Character'Pos ('1'), Character'Pos ('2'), Character'Pos ('3'),
      Character'Pos ('4'), Character'Pos ('5'), Character'Pos ('6'), Character'Pos ('7'),
      Character'Pos ('8'), Character'Pos ('9'), Character'Pos ('+'), Character'Pos ('/'));

   BASE64_URL_ALPHABET : aliased constant Alphabet :=
     (Character'Pos ('A'), Character'Pos ('B'), Character'Pos ('C'), Character'Pos ('D'),
      Character'Pos ('E'), Character'Pos ('F'), Character'Pos ('G'), Character'Pos ('H'),
      Character'Pos ('I'), Character'Pos ('J'), Character'Pos ('K'), Character'Pos ('L'),
      Character'Pos ('M'), Character'Pos ('N'), Character'Pos ('O'), Character'Pos ('P'),
      Character'Pos ('Q'), Character'Pos ('R'), Character'Pos ('S'), Character'Pos ('T'),
      Character'Pos ('U'), Character'Pos ('V'), Character'Pos ('W'), Character'Pos ('X'),
      Character'Pos ('Y'), Character'Pos ('Z'), Character'Pos ('a'), Character'Pos ('b'),
      Character'Pos ('c'), Character'Pos ('d'), Character'Pos ('e'), Character'Pos ('f'),
      Character'Pos ('g'), Character'Pos ('h'), Character'Pos ('i'), Character'Pos ('j'),
      Character'Pos ('k'), Character'Pos ('l'), Character'Pos ('m'), Character'Pos ('n'),
      Character'Pos ('o'), Character'Pos ('p'), Character'Pos ('q'), Character'Pos ('r'),
      Character'Pos ('s'), Character'Pos ('t'), Character'Pos ('u'), Character'Pos ('v'),
      Character'Pos ('w'), Character'Pos ('x'), Character'Pos ('y'), Character'Pos ('z'),
      Character'Pos ('0'), Character'Pos ('1'), Character'Pos ('2'), Character'Pos ('3'),
      Character'Pos ('4'), Character'Pos ('5'), Character'Pos ('6'), Character'Pos ('7'),
      Character'Pos ('8'), Character'Pos ('9'), Character'Pos ('+'), Character'Pos ('/'));

   type Encoder is new Util.Encoders.Transformer with record
      Alphabet : Alphabet_Access := BASE64_ALPHABET'Access;
   end record;

   type Alphabet_Values is array (Ada.Streams.Stream_Element) of Interfaces.Unsigned_8;
   type Alphabet_Values_Access is not null access constant Alphabet_Values;

   BASE64_VALUES : aliased constant Alphabet_Values :=
     (Character'Pos ('A') => 0,  Character'Pos ('B') => 1,
      Character'Pos ('C') => 2,  Character'Pos ('D') => 3,
      Character'Pos ('E') => 4,  Character'Pos ('F') => 5,
      Character'Pos ('G') => 6,  Character'Pos ('H') => 7,
      Character'Pos ('I') => 8,  Character'Pos ('J') => 9,
      Character'Pos ('K') => 10, Character'Pos ('L') => 11,
      Character'Pos ('M') => 12, Character'Pos ('N') => 13,
      Character'Pos ('O') => 14, Character'Pos ('P') => 15,
      Character'Pos ('Q') => 16, Character'Pos ('R') => 17,
      Character'Pos ('S') => 18, Character'Pos ('T') => 19,
      Character'Pos ('U') => 20, Character'Pos ('V') => 21,
      Character'Pos ('W') => 22, Character'Pos ('X') => 23,
      Character'Pos ('Y') => 24, Character'Pos ('Z') => 25,
      Character'Pos ('a') => 26, Character'Pos ('b') => 27,
      Character'Pos ('c') => 28, Character'Pos ('d') => 29,
      Character'Pos ('e') => 30, Character'Pos ('f') => 31,
      Character'Pos ('g') => 32, Character'Pos ('h') => 33,
      Character'Pos ('i') => 34, Character'Pos ('j') => 35,
      Character'Pos ('k') => 36, Character'Pos ('l') => 37,
      Character'Pos ('m') => 38, Character'Pos ('n') => 39,
      Character'Pos ('o') => 40, Character'Pos ('p') => 41,
      Character'Pos ('q') => 42, Character'Pos ('r') => 43,
      Character'Pos ('s') => 44, Character'Pos ('t') => 45,
      Character'Pos ('u') => 46, Character'Pos ('v') => 47,
      Character'Pos ('w') => 48, Character'Pos ('x') => 49,
      Character'Pos ('y') => 50, Character'Pos ('z') => 51,
      Character'Pos ('0') => 52, Character'Pos ('1') => 53,
      Character'Pos ('2') => 54, Character'Pos ('3') => 55,
      Character'Pos ('4') => 56, Character'Pos ('5') => 57,
      Character'Pos ('6') => 58, Character'Pos ('7') => 59,
      Character'Pos ('8') => 60, Character'Pos ('9') => 61,
      Character'Pos ('+') => 62, Character'Pos ('/') => 63,
     others => 16#FF#);

   BASE64_URL_VALUES : aliased constant Alphabet_Values :=
     (Character'Pos ('A') => 0,  Character'Pos ('B') => 1,
      Character'Pos ('C') => 2,  Character'Pos ('D') => 3,
      Character'Pos ('E') => 4,  Character'Pos ('F') => 5,
      Character'Pos ('G') => 6,  Character'Pos ('H') => 7,
      Character'Pos ('I') => 8,  Character'Pos ('J') => 9,
      Character'Pos ('K') => 10, Character'Pos ('L') => 11,
      Character'Pos ('M') => 12, Character'Pos ('N') => 13,
      Character'Pos ('O') => 14, Character'Pos ('P') => 15,
      Character'Pos ('Q') => 16, Character'Pos ('R') => 17,
      Character'Pos ('S') => 18, Character'Pos ('T') => 19,
      Character'Pos ('U') => 20, Character'Pos ('V') => 21,
      Character'Pos ('W') => 22, Character'Pos ('X') => 23,
      Character'Pos ('Y') => 24, Character'Pos ('Z') => 25,
      Character'Pos ('a') => 26, Character'Pos ('b') => 27,
      Character'Pos ('c') => 28, Character'Pos ('d') => 29,
      Character'Pos ('e') => 30, Character'Pos ('f') => 31,
      Character'Pos ('g') => 32, Character'Pos ('h') => 33,
      Character'Pos ('i') => 34, Character'Pos ('j') => 35,
      Character'Pos ('k') => 35, Character'Pos ('l') => 37,
      Character'Pos ('m') => 38, Character'Pos ('n') => 39,
      Character'Pos ('o') => 40, Character'Pos ('p') => 41,
      Character'Pos ('q') => 42, Character'Pos ('r') => 43,
      Character'Pos ('s') => 44, Character'Pos ('t') => 45,
      Character'Pos ('u') => 46, Character'Pos ('v') => 47,
      Character'Pos ('w') => 48, Character'Pos ('x') => 49,
      Character'Pos ('y') => 50, Character'Pos ('z') => 51,
      Character'Pos ('0') => 52, Character'Pos ('1') => 53,
      Character'Pos ('2') => 54, Character'Pos ('3') => 55,
      Character'Pos ('4') => 56, Character'Pos ('5') => 57,
      Character'Pos ('6') => 58, Character'Pos ('7') => 59,
      Character'Pos ('8') => 60, Character'Pos ('9') => 61,
      Character'Pos ('-') => 62, Character'Pos ('_') => 63,
      others => 16#FF#);

   type Decoder is new Util.Encoders.Transformer with record
      Values : Alphabet_Values_Access := BASE64_VALUES'Access;
   end record;

end Util.Encoders.Base64;

Fix the base64 alphabet

Fix the base64 alphabet


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

with Ada.Finalization;
with Ada.Strings.Unbounded;

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

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

with GNAT.Regexp;

limited with Security.Controllers;
limited with Security.Contexts;

--  == Permissions ==
--  The Security.Permissions package defines the different permissions that can be
--  checked by the access control manager.
--
--  === Principal ===
--  The <tt>Principal</tt> is the entity that can be authenticated.  A principal is obtained
--  after successful authentication of a user or of a system through an authorization process.
--  The OpenID or OAuth authentication processes generate such security principal.
--
--  === Permission ===
--  The <tt>Permission</tt> represents an access to a system or application resource.
--  A permission is checked by using the security manager.  The security manager uses a
--  security controller to enforce the permission.
--
package Security.Permissions is

   Invalid_Name : exception;

   type Security_Context_Access is access all Contexts.Security_Context'Class;

   type Permission_Index is new Natural;

   type Controller_Access is access all Security.Controllers.Controller'Class;

   type Controller_Access_Array is array (Permission_Index range <>) of Controller_Access;

   --  Get the permission index associated with the name.
   function Get_Permission_Index (Name : in String) return Permission_Index;

   --  Get the last permission index registered in the global permission map.
   function Get_Last_Permission_Index return Permission_Index;

   --  Add the permission name and allocate a unique permission index.
   procedure Add_Permission (Name  : in String;
                             Index : out Permission_Index);

   --  The permission root class.
   type Permission is abstract tagged limited null record;

   --  Each permission is represented by a Permission_Type number to provide a fast
   --  and efficient permission check.
   type Permission_Type is new Natural range 0 .. 63;

   --  The Permission_Map represents a set of permissions which are granted to a user.
   --  Each permission is represented by a boolean in the map.  The implementation is limited
   --  to 64 permissions.
   type Permission_Map is array (Permission_Type'Range) of Boolean;
   pragma Pack (Permission_Map);

   generic
      Name : String;
   package Permission_ACL is
      function Permission return Permission_Index;
      pragma Inline_Always (Permission);
   end Permission_ACL;

private

   use Util.Strings;

   type Permission_Type_Array is array (1 .. 10) of Permission_Type;

   type Permission_Index_Array is array (Positive range <>) of Permission_Index;

   --  The Access_Rule represents a list of permissions to verify to grant
   --  access to the resource.  To make it simple, the user must have one of the
   --  permission from the list.  Each permission will refer to a specific permission
   --  controller.
   type Access_Rule (Count : Natural) is new Util.Refs.Ref_Entity with record
      Permissions : Permission_Index_Array (1 .. Count);
   end record;
   type Access_Rule_Access is access all Access_Rule;

   package Access_Rule_Refs is
     new Util.Refs.Indefinite_References (Element_Type   => Access_Rule,
                                          Element_Access => Access_Rule_Access);
   subtype Access_Rule_Ref is Access_Rule_Refs.Ref;

   --  The Policy defines the access rules that are applied on a given
   --  URL, set of URLs or files.
   type Policy is record
      Id      : Natural;
      Pattern : GNAT.Regexp.Regexp;
      Rule    : Access_Rule_Ref;
   end record;

   --  The Policy_Vector represents the whole permission policy.  The order of
   --  policy in the list is important as policies can override each other.
   package Policy_Vector is new Ada.Containers.Vectors (Index_Type   => Positive,
                                                        Element_Type => Policy);

   package Rules_Maps is new Ada.Containers.Hashed_Maps (Key_Type        => String_Ref,
                                                         Element_Type    => Access_Rule_Ref,
                                                         Hash            => Hash,
                                                         Equivalent_Keys => Equivalent_Keys,
                                                         "="             => Access_Rule_Refs."=");

   type Rules is new Util.Refs.Ref_Entity with record
      Map : Rules_Maps.Map;
   end record;
   type Rules_Access is access all Rules;

   package Rules_Ref is new Util.Refs.References (Rules, Rules_Access);

   type Rules_Ref_Access is access Rules_Ref.Atomic_Ref;

   type Controller_Access_Array_Access is access all Controller_Access_Array;

end Security.Permissions;

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

with Ada.Finalization;
with Ada.Strings.Unbounded;

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

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

with GNAT.Regexp;

limited with Security.Controllers;
limited with Security.Contexts;

--  == Permissions ==
--  The Security.Permissions package defines the different permissions that can be
--  checked by the access control manager.
--
--  === Principal ===
--  The <tt>Principal</tt> is the entity that can be authenticated.  A principal is obtained
--  after successful authentication of a user or of a system through an authorization process.
--  The OpenID or OAuth authentication processes generate such security principal.
--
--  === Permission ===
--  The <tt>Permission</tt> represents an access to a system or application resource.
--  A permission is checked by using the security manager.  The security manager uses a
--  security controller to enforce the permission.
--
package Security.Permissions is

   Invalid_Name : exception;

   type Security_Context_Access is access all Contexts.Security_Context'Class;

   type Permission_Index is new Natural;

   type Controller_Access is access all Security.Controllers.Controller'Class;

   type Controller_Access_Array is array (Permission_Index range <>) of Controller_Access;

   --  Get the permission index associated with the name.
   function Get_Permission_Index (Name : in String) return Permission_Index;

   --  Get the last permission index registered in the global permission map.
   function Get_Last_Permission_Index return Permission_Index;

   --  Add the permission name and allocate a unique permission index.
   procedure Add_Permission (Name  : in String;
                             Index : out Permission_Index);

   --  The permission root class.
   type Permission is abstract tagged limited null record;

   --  Each permission is represented by a Permission_Type number to provide a fast
   --  and efficient permission check.
   type Permission_Type is new Natural range 0 .. 63;

   --  The Permission_Map represents a set of permissions which are granted to a user.
   --  Each permission is represented by a boolean in the map.  The implementation is limited
   --  to 64 permissions.
   type Permission_Map is array (Permission_Type'Range) of Boolean;
   pragma Pack (Permission_Map);

   generic
      Name : String;
   package Permission_ACL is
      function Permission return Permission_Index;
      pragma Inline_Always (Permission);
   end Permission_ACL;

private

   use Util.Strings;

   type Permission_Type_Array is array (1 .. 10) of Permission_Type;

   type Permission_Index_Array is array (Positive range <>) of Permission_Index;

   type Controller_Access_Array_Access is access all Controller_Access_Array;

end Security.Permissions;

Remove the unused types and operations

Remove the unused types and operations


------------------------------------------------------------------------------
-- Copyright (c) 2014, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

package body Natools.Cron.Tests is

   --------------------
   -- Test Callbacks --
   --------------------

   overriding procedure Run (Self : in out Test_Callback) is
   begin
      Append (Self.Backend.all, Self.Symbol);
   end Run;

   overriding procedure Run (Self : in out Long_Callback) is
   begin
      Append (Self.Backend.all, Self.Open);
      delay Self.Wait;
      Append (Self.Backend.all, Self.Close);
   end Run;

   --------------------
   -- Bounded String --
   --------------------

   procedure Append (S : in out Bounded_String; C : Character) is
   begin
      S.Size := S.Size + 1;
      S.Data (S.Size) := C;
   end Append;

   function Get (S : Bounded_String) return String is
   begin
      return S.Data (1 .. S.Size);
   end Get;

   procedure Reset (S : in out Bounded_String) is
   begin
      S.Size := 0;
   end Reset;

   -----------------
   -- Test Helper --
   -----------------

   function Quote (Data : String) return String
     is ('"' & Data & '"');

   procedure Check is new NT.Generic_Check (String, "=", Quote, False);

   -------------------------
   -- Complete Test Suite --
   -------------------------

   procedure All_Tests (Report : in out NT.Reporter'Class) is
   begin
      Basic_Usage (Report);
      Delete_While_Busy (Report);
      Insert_While_Busy (Report);
      Time_Collision (Report);
   end All_Tests;

   -----------------------
   -- Inidividual Tests --
   -----------------------

   procedure Basic_Usage (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Basic black-box usage");
      Total : constant Duration := 1.0;
      Tick : constant Duration := Total / 10;
      Half_Tick : constant Duration := Tick / 2;
      Log : aliased Bounded_String (256);
   begin
      declare
         Beat : constant Cron_Entry := Create
           (Tick, Test_Callback'(Backend => Log'Access, Symbol => '.'));
         pragma Unreferenced (Beat);

         Test_Entry : Cron_Entry;
      begin
         delay Half_Tick;
         Test_Entry.Set
           (Tick, Test_Callback'(Backend => Log'Access, Symbol => '1'));
         delay 3 * Tick + Half_Tick;
         Test_Entry.Reset;
         delay Half_Tick;
      end;

      Append (Log, '|');
      delay Tick / 10;

      declare
         use type Ada.Calendar.Time;

         Beat : constant Cron_Entry := Create
           ((Origin => Ada.Calendar.Clock + Half_Tick,
             Period => Tick),
            Test_Callback'(Backend => Log'Access, Symbol => '.'));
         pragma Unreferenced (Beat);

         Slow, Fast : Cron_Entry;
      begin
         Slow.Set
           (2 * Tick,
            Test_Callback'(Backend => Log'Access, Symbol => 's'));
         delay 2 * Tick;
         Fast.Set
           (Tick / 5,
            Test_Callback'(Backend => Log'Access, Symbol => 'f'));
         delay Tick + Half_Tick;
         Fast.Reset;
         delay Tick + Half_Tick;
      end;

      --  Timeline, in ticks:
      --  Beat: set at 0.0, finalized at 4.5, run at 1.0, 2.0, 3.0, 4.0.
      --  Test_Entry: set at 0.5, reset at 4.0, run at 1.5, 2.5, 3.5.
      --  Beat: set at 4.5, finalized at 9.5, run at 5.0, 6.0, 7.0, 8.0, 9.0.
      --  Slow: set at 4.5, finalized at 9.5, run at 6.5, 8.5.
      --  Fast: set at 6.5, reset at 8.0,
      --        run at 6.7, 6.9, 7.1, 7.3, 7.5, 7.7, 7.9

      Check (Test, Get (Log), ".1.1.1.|..sff.fffff.s.");
   exception
      when Error : others => Test.Report_Exception (Error);
   end Basic_Usage;

   procedure Delete_While_Busy (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Delete entry while callback is running");
      Total : constant Duration := 0.01;
      Log : aliased Bounded_String (256);
   begin
      declare
         Test_Entry : Cron_Entry;
      begin
         Test_Entry.Set (Total / 8, Long_Callback'
           (Backend => Log'Access,
            Open => '(',
            Close => ')',
            Wait => Total / 4));
         delay Total / 4;
      end;

      Check (Test, Get (Log), "(", "Before wait");
      delay Total / 2;
      Check (Test, Get (Log), "()", "After wait");
   exception
      when Error : others => Test.Report_Exception (Error);
   end Delete_While_Busy;

   procedure Insert_While_Busy (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Insert entry while callback is running");
      Total : constant Duration := 0.1;
      Log : aliased Bounded_String (256);
   begin
      declare
         Long, Short : Cron_Entry;
      begin
         Long.Set
           (Total / 8,
            Long_Callback'
              (Backend => Log'Access,
               Open => '(',
               Close => ')',
               Wait => Total / 5));

         delay Total / 8 + Total / 16;

         Short.Set
           (Total / 8,
            Test_Callback'(Backend => Log'Access, Symbol => '.'));

         delay Total / 2 + Total / 8;
      end;

      --  Timeline: 0 . 1/8 . 1/4 .   3/8 . 1/2 .   5/8 . 3/4 . 7/8 . 1
      --  Set:      L       S
      --  Finalize:                                        *
      --  Ticks:         L     L  S    L  S  L  S    L  S  L
      --  Run:           <----L---->S  <----L---->S  <----L---->

      delay Total / 8;
      Check (Test, Get (Log), "().().()");
   exception
      when Error : others => Test.Report_Exception (Error);
   end Insert_While_Busy;

   procedure Time_Collision (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Simultaneous activation of events");
      Total : constant Duration := 0.01;
      Tick : constant Duration := Total / 4;
      Log : aliased Bounded_String (256);
   begin
      declare
         use type Ada.Calendar.Time;
         Common : constant Periodic_Time := (Ada.Calendar.Clock + Tick, Tick);
         First, Second, Third : Cron_Entry;
      begin
         First.Set
           (Common, Test_Callback'(Backend => Log'Access, Symbol => '1'));
         Second.Set
           (Common, Test_Callback'(Backend => Log'Access, Symbol => '2'));
         Third.Set
           ((Origin => Common.Origin, Period => 2 * Common.Period),
            Test_Callback'(Backend => Log'Access, Symbol => '3'));
         delay Total - Tick / 2;
      end;

      Check (Test, Get (Log), "12312123");
   exception
      when Error : others => Test.Report_Exception (Error);
   end Time_Collision;

end Natools.Cron.Tests;

------------------------------------------------------------------------------
-- Copyright (c) 2014-2016, Natacha Porté                                   --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

package body Natools.Cron.Tests is

   --------------------
   -- Test Callbacks --
   --------------------

   overriding procedure Run (Self : in out Test_Callback) is
   begin
      Append (Self.Backend.all, Self.Symbol);
   end Run;

   overriding procedure Run (Self : in out Long_Callback) is
   begin
      Append (Self.Backend.all, Self.Open);
      delay Self.Wait;
      Append (Self.Backend.all, Self.Close);
   end Run;

   --------------------
   -- Bounded String --
   --------------------

   procedure Append (S : in out Bounded_String; C : Character) is
   begin
      S.Size := S.Size + 1;
      S.Data (S.Size) := C;
   end Append;

   function Get (S : Bounded_String) return String is
   begin
      return S.Data (1 .. S.Size);
   end Get;

   procedure Reset (S : in out Bounded_String) is
   begin
      S.Size := 0;
   end Reset;

   -----------------
   -- Test Helper --
   -----------------

   function Quote (Data : String) return String
     is ('"' & Data & '"');

   procedure Check is new NT.Generic_Check (String, "=", Quote, False);

   -------------------------
   -- Complete Test Suite --
   -------------------------

   procedure All_Tests (Report : in out NT.Reporter'Class) is
   begin
      Basic_Usage (Report);
      Delete_While_Busy (Report);
      Insert_While_Busy (Report);
      Time_Collision (Report);
   end All_Tests;

   -----------------------
   -- Inidividual Tests --
   -----------------------

   procedure Basic_Usage (Report : in out NT.Reporter'Class) is
      use type Ada.Calendar.Time;

      Test : NT.Test := Report.Item ("Basic black-box usage");
      Total : constant Duration := 10.0;
      Tick : constant Duration := Total / 10;
      Half_Tick : constant Duration := Tick / 2;
      Log : aliased Bounded_String (256);
   begin
      declare
         Beat : constant Cron_Entry := Create
           (Tick, Test_Callback'(Backend => Log'Access, Symbol => '.'));
         pragma Unreferenced (Beat);

         One_Time_Entry : constant Cron_Entry := Create
           (Ada.Calendar.Clock + Half_Tick,
            Test_Callback'(Backend => Log'Access, Symbol => 'o'));
         pragma Unreferenced (One_Time_Entry);

         Test_Entry : Cron_Entry;
      begin
         delay Half_Tick;
         Test_Entry.Set
           (Tick, Test_Callback'(Backend => Log'Access, Symbol => '1'));
         delay 3 * Tick + Half_Tick;
         Test_Entry.Reset;
         delay Half_Tick;
      end;

      Append (Log, '|');
      delay Tick / 10;

      declare
         Beat : constant Cron_Entry := Create
           ((Origin => Ada.Calendar.Clock + Half_Tick,
             Period => Tick),
            Test_Callback'(Backend => Log'Access, Symbol => '.'));
         pragma Unreferenced (Beat);

         One_Time_Entry : constant Cron_Entry := Create
           ((Origin => Ada.Calendar.Clock + Tick,
             Period => -Half_Tick),
            Test_Callback'(Backend => Log'Access, Symbol => 'O'));
         pragma Unreferenced (One_Time_Entry);

         Slow, Fast : Cron_Entry;
      begin
         Slow.Set
           (2 * Tick,
            Test_Callback'(Backend => Log'Access, Symbol => 's'));
         delay 2 * Tick;
         Fast.Set
           (Tick / 5,
            Test_Callback'(Backend => Log'Access, Symbol => 'f'));
         delay Tick + Half_Tick;
         Fast.Reset;
         delay Tick + Half_Tick;
      end;

      --  Timeline, in ticks:
      --  Beat: set at 0.0, finalized at 4.5, run at 1.0, 2.0, 3.0, 4.0.
      --  Test_Entry: set at 0.5, reset at 4.0, run at 1.5, 2.5, 3.5.
      --  Beat: set at 4.5, finalized at 9.5, run at 5.0, 6.0, 7.0, 8.0, 9.0.
      --  Slow: set at 4.5, finalized at 9.5, run at 6.5, 8.5.
      --  Fast: set at 6.5, reset at 8.0,
      --        run at 6.7, 6.9, 7.1, 7.3, 7.5, 7.7, 7.9

      Check (Test, Get (Log), "o.1.1.1.|.O.sff.fffff.s.");
   exception
      when Error : others => Test.Report_Exception (Error);
   end Basic_Usage;

   procedure Delete_While_Busy (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Delete entry while callback is running");
      Total : constant Duration := 0.01;
      Log : aliased Bounded_String (256);
   begin
      declare
         Test_Entry : Cron_Entry;
      begin
         Test_Entry.Set (Total / 8, Long_Callback'
           (Backend => Log'Access,
            Open => '(',
            Close => ')',
            Wait => Total / 4));
         delay Total / 4;
      end;

      Check (Test, Get (Log), "(", "Before wait");
      delay Total / 2;
      Check (Test, Get (Log), "()", "After wait");
   exception
      when Error : others => Test.Report_Exception (Error);
   end Delete_While_Busy;

   procedure Insert_While_Busy (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Insert entry while callback is running");
      Total : constant Duration := 0.1;
      Log : aliased Bounded_String (256);
   begin
      declare
         Long, Short : Cron_Entry;
      begin
         Long.Set
           (Total / 8,
            Long_Callback'
              (Backend => Log'Access,
               Open => '(',
               Close => ')',
               Wait => Total / 5));

         delay Total / 8 + Total / 16;

         Short.Set
           (Total / 8,
            Test_Callback'(Backend => Log'Access, Symbol => '.'));

         delay Total / 2 + Total / 8;
      end;

      --  Timeline: 0 . 1/8 . 1/4 .   3/8 . 1/2 .   5/8 . 3/4 . 7/8 . 1
      --  Set:      L       S
      --  Finalize:                                        *
      --  Ticks:         L     L  S    L  S  L  S    L  S  L
      --  Run:           <----L---->S  <----L---->S  <----L---->

      delay Total / 8;
      Check (Test, Get (Log), "().().()");
   exception
      when Error : others => Test.Report_Exception (Error);
   end Insert_While_Busy;

   procedure Time_Collision (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Simultaneous activation of events");
      Total : constant Duration := 0.01;
      Tick : constant Duration := Total / 4;
      Log : aliased Bounded_String (256);
   begin
      declare
         use type Ada.Calendar.Time;
         Common : constant Periodic_Time := (Ada.Calendar.Clock + Tick, Tick);
         First, Second, Third : Cron_Entry;
      begin
         First.Set
           (Common, Test_Callback'(Backend => Log'Access, Symbol => '1'));
         Second.Set
           (Common, Test_Callback'(Backend => Log'Access, Symbol => '2'));
         Third.Set
           ((Origin => Common.Origin, Period => 2 * Common.Period),
            Test_Callback'(Backend => Log'Access, Symbol => '3'));
         delay Total - Tick / 2;
      end;

      Check (Test, Get (Log), "12312123");
   exception
      when Error : others => Test.Report_Exception (Error);
   end Time_Collision;

end Natools.Cron.Tests;

test the new one-time events

cron-tests: test the new one-time events


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

with Ada.Strings.Fixed;
with Ada.Directories;

with Util.Test_Caller;

with Util.Log;
with Util.Log.Loggers;
with Util.Properties;
with Util.Measures;
package body Util.Log.Tests is

   use Util;

   Log : constant Loggers.Logger := Loggers.Create ("util.log.test");

   procedure Test_Log (T : in out Test) is
      pragma Unreferenced (T);

      L : Loggers.Logger := Loggers.Create ("util.log.test.debug");
   begin
      L.Set_Level (DEBUG_LEVEL);
      Log.Info ("My log message");
      Log.Error ("My error message");
      Log.Debug ("A debug message Not printed");

      L.Info ("An info message");
      L.Debug ("A debug message on logger 'L'");
   end Test_Log;

   --  Test configuration and creation of file
   procedure Test_File_Appender (T : in out Test) is
      pragma Unreferenced (T);

      Props : Util.Properties.Manager;
   begin
      Props.Set ("log4j.appender.test", "File");
      Props.Set ("log4j.appender.test.File", "test.log");
      Props.Set ("log4j.logger.util.log.test.file", "DEBUG,test");
      Util.Log.Loggers.Initialize (Props);

      declare
         L : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
      begin
         L.Debug ("Writing a debug message");
         L.Debug ("{0}: {1}", "Parameter", "Value");
      end;
   end Test_File_Appender;

   procedure Test_Log_Perf (T : in out Test) is
      pragma Unreferenced (T);

      Props : Util.Properties.Manager;
   begin
      Props.Set ("log4j.appender.test", "File");
      Props.Set ("log4j.appender.test.File", "test.log");
      Props.Set ("log4j.logger.util.log.test.perf", "DEBUG,test");
      Util.Log.Loggers.Initialize (Props);

      for I in 1 .. 1000 loop
         declare
            S : Util.Measures.Stamp;
         begin
            Util.Measures.Report (S, "Util.Measures.Report", 1000);
         end;
      end loop;

      declare
         L : Loggers.Logger := Loggers.Create ("util.log.test.perf");
         S : Util.Measures.Stamp;
      begin
         L.Set_Level (DEBUG_LEVEL);
         for I in 1 .. 1000 loop
            L.Info ("My log message: {0}: {1}", "A message",
                    "A second parameter");
         end loop;
         Util.Measures.Report (S, "Log.Info message (output)", 1000);

         L.Set_Level (INFO_LEVEL);
         for I in 1 .. 10_000 loop
            L.Debug ("My log message: {0}: {1}", "A message",
                     "A second parameter");
         end loop;
         Util.Measures.Report (S, "Log.Debug message (no output)", 10_000);
      end;
   end Test_Log_Perf;

   --  ------------------------------
   --  Test appending the log on several log files
   --  ------------------------------
   procedure Test_List_Appender (T : in out Test) is
      use Ada.Strings;
      use Ada.Directories;
      Props : Util.Properties.Manager;
   begin
      for I in 1 .. 10 loop
         declare
            Id   : constant String := Fixed.Trim (Integer'Image (I), Both);
            Name : constant String := "log4j.appender.test" & Id;
         begin
            Props.Set (Name, "File");
            Props.Set (Name & ".File", "test" & Id & ".log");
            Props.Set (Name & ".layout", "date-level-message");
            if I > 5 then
               Props.Set (Name & ".level", "INFO");
            end if;
         end;
      end loop;
      Props.Set ("log4j.rootCategory", "DEBUG, test.log");
      Props.Set ("log4j.logger.util.log.test.file",
                 "DEBUG,test4,test1 , test2,test3, test4, test5 ,  test6 , test7,test8,");
      Util.Log.Loggers.Initialize (Props);

      declare
         L : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
      begin
         L.Debug ("Writing a debug message");
         L.Debug ("{0}: {1}", "Parameter", "Value");
         L.Debug ("Done");
      end;

      --  Check that we have non empty log files (up to test8.log).
      for I in 1 .. 8 loop
         declare
            Id   : constant String := Fixed.Trim (Integer'Image (I), Both);
            Path : constant String := "test" & Id & ".log";
         begin
            T.Assert (Ada.Directories.Exists (Path), "Log file " & Path & " not found");
            if I > 5 then
               T.Assert (Ada.Directories.Size (Path) < 100, "Log file "
                         & Path & " should be empty");
            else
               T.Assert (Ada.Directories.Size (Path) > 100, "Log file " & Path & " is empty");
            end if;
         end;
      end loop;
   end Test_List_Appender;

   --  ------------------------------
   --  Test file appender with different modes.
   --  ------------------------------
   procedure Test_File_Appender_Modes (T : in out Test) is
      use Ada.Directories;

      Props : Util.Properties.Manager;
   begin
      Props.Set ("log4j.appender.test", "File");
      Props.Set ("log4j.appender.test.File", "test-append.log");
      Props.Set ("log4j.appender.test.append", "true");
      Props.Set ("log4j.appender.test.immediateFlush", "true");
      Props.Set ("log4j.appender.test_global", "File");
      Props.Set ("log4j.appender.test_global.File", "test-append-global.log");
      Props.Set ("log4j.appender.test_global.append", "false");
      Props.Set ("log4j.appender.test_global.immediateFlush", "false");
      Props.Set ("log4j.logger.util.log.test.file", "DEBUG");
      Props.Set ("log4j.rootCategory", "DEBUG,test_global,test");
      Util.Log.Loggers.Initialize (Props);

      declare
         L : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
      begin
         L.Debug ("Writing a debug message");
         L.Debug ("{0}: {1}", "Parameter", "Value");
         L.Debug ("Done");
         L.Error ("This is the error test message");
      end;

      Props.Set ("log4j.appender.test_append", "File");
      Props.Set ("log4j.appender.test_append.File", "test-append2.log");
      Props.Set ("log4j.appender.test_append.append", "true");
      Props.Set ("log4j.appender.test_append.immediateFlush", "true");
      Props.Set ("log4j.logger.util.log.test2.file", "DEBUG,test_append,test_global");
      Util.Log.Loggers.Initialize (Props);

      declare
         L1 : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
         L2 : constant Loggers.Logger := Loggers.Create ("util.log.test2.file");
      begin
         L1.Info ("L1-1 Writing a info message");
         L2.Info ("L2-2 {0}: {1}", "Parameter", "Value");
         L1.Info ("L1-3 Done");
         L2.Error ("L2-4 This is the error test2 message");
      end;

      Props.Set ("log4j.appender.test_append.append", "plop");
      Props.Set ("log4j.appender.test_append.immediateFlush", "falsex");
      Props.Set ("log4j.rootCategory", "DEBUG, test.log");
      Util.Log.Loggers.Initialize (Props);

      T.Assert (Ada.Directories.Size ("test-append.log") > 100,
                "Log file test-append.log is empty");
      T.Assert (Ada.Directories.Size ("test-append2.log") > 100,
                "Log file test-append2.log is empty");
      T.Assert (Ada.Directories.Size ("test-append-global.log") > 100,
                "Log file test-append.log is empty");
   end Test_File_Appender_Modes;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Info",
                       Test_Log'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Debug",
                       Test_Log'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Set_Level",
                       Test_Log'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Appenders.File_Appender",
                       Test_File_Appender'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Appenders.File_Appender (append)",
                       Test_File_Appender_Modes'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Appenders.List_Appender",
                       Test_List_Appender'Access);

      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Log (Perf)",
                       Test_Log_Perf'Access);
   end Add_Tests;

end Util.Log.Tests;

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

with Ada.Strings.Fixed;
with Ada.Directories;

with Util.Test_Caller;

with Util.Log;
with Util.Log.Loggers;
with Util.Properties;
with Util.Measures;
package body Util.Log.Tests is

   Log : constant Loggers.Logger := Loggers.Create ("util.log.test");

   procedure Test_Log (T : in out Test) is
      pragma Unreferenced (T);

      L : Loggers.Logger := Loggers.Create ("util.log.test.debug");
   begin
      L.Set_Level (DEBUG_LEVEL);
      Log.Info ("My log message");
      Log.Error ("My error message");
      Log.Debug ("A debug message Not printed");

      L.Info ("An info message");
      L.Debug ("A debug message on logger 'L'");
   end Test_Log;

   --  Test configuration and creation of file
   procedure Test_File_Appender (T : in out Test) is
      pragma Unreferenced (T);

      Props : Util.Properties.Manager;
   begin
      Props.Set ("log4j.appender.test", "File");
      Props.Set ("log4j.appender.test.File", "test.log");
      Props.Set ("log4j.logger.util.log.test.file", "DEBUG,test");
      Util.Log.Loggers.Initialize (Props);

      declare
         L : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
      begin
         L.Debug ("Writing a debug message");
         L.Debug ("{0}: {1}", "Parameter", "Value");
      end;
   end Test_File_Appender;

   procedure Test_Log_Perf (T : in out Test) is
      pragma Unreferenced (T);

      Props : Util.Properties.Manager;
   begin
      Props.Set ("log4j.appender.test", "File");
      Props.Set ("log4j.appender.test.File", "test.log");
      Props.Set ("log4j.logger.util.log.test.perf", "DEBUG,test");
      Util.Log.Loggers.Initialize (Props);

      for I in 1 .. 1000 loop
         declare
            S : Util.Measures.Stamp;
         begin
            Util.Measures.Report (S, "Util.Measures.Report", 1000);
         end;
      end loop;

      declare
         L : Loggers.Logger := Loggers.Create ("util.log.test.perf");
         S : Util.Measures.Stamp;
      begin
         L.Set_Level (DEBUG_LEVEL);
         for I in 1 .. 1000 loop
            L.Info ("My log message: {0}: {1}", "A message",
                    "A second parameter");
         end loop;
         Util.Measures.Report (S, "Log.Info message (output)", 1000);

         L.Set_Level (INFO_LEVEL);
         for I in 1 .. 10_000 loop
            L.Debug ("My log message: {0}: {1}", "A message",
                     "A second parameter");
         end loop;
         Util.Measures.Report (S, "Log.Debug message (no output)", 10_000);
      end;
   end Test_Log_Perf;

   --  ------------------------------
   --  Test appending the log on several log files
   --  ------------------------------
   procedure Test_List_Appender (T : in out Test) is
      use Ada.Strings;
      use Ada.Directories;
      Props : Util.Properties.Manager;
   begin
      for I in 1 .. 10 loop
         declare
            Id   : constant String := Fixed.Trim (Integer'Image (I), Both);
            Name : constant String := "log4j.appender.test" & Id;
         begin
            Props.Set (Name, "File");
            Props.Set (Name & ".File", "test" & Id & ".log");
            Props.Set (Name & ".layout", "date-level-message");
            if I > 5 then
               Props.Set (Name & ".level", "INFO");
            end if;
         end;
      end loop;
      Props.Set ("log4j.rootCategory", "DEBUG, test.log");
      Props.Set ("log4j.logger.util.log.test.file",
                 "DEBUG,test4,test1 , test2,test3, test4, test5 ,  test6 , test7,test8,");
      Util.Log.Loggers.Initialize (Props);

      declare
         L : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
      begin
         L.Debug ("Writing a debug message");
         L.Debug ("{0}: {1}", "Parameter", "Value");
         L.Debug ("Done");
      end;

      --  Check that we have non empty log files (up to test8.log).
      for I in 1 .. 8 loop
         declare
            Id   : constant String := Fixed.Trim (Integer'Image (I), Both);
            Path : constant String := "test" & Id & ".log";
         begin
            T.Assert (Ada.Directories.Exists (Path), "Log file " & Path & " not found");
            if I > 5 then
               T.Assert (Ada.Directories.Size (Path) < 100, "Log file "
                         & Path & " should be empty");
            else
               T.Assert (Ada.Directories.Size (Path) > 100, "Log file " & Path & " is empty");
            end if;
         end;
      end loop;
   end Test_List_Appender;

   --  ------------------------------
   --  Test file appender with different modes.
   --  ------------------------------
   procedure Test_File_Appender_Modes (T : in out Test) is
      use Ada.Directories;

      Props : Util.Properties.Manager;
   begin
      Props.Set ("log4j.appender.test", "File");
      Props.Set ("log4j.appender.test.File", "test-append.log");
      Props.Set ("log4j.appender.test.append", "true");
      Props.Set ("log4j.appender.test.immediateFlush", "true");
      Props.Set ("log4j.appender.test_global", "File");
      Props.Set ("log4j.appender.test_global.File", "test-append-global.log");
      Props.Set ("log4j.appender.test_global.append", "false");
      Props.Set ("log4j.appender.test_global.immediateFlush", "false");
      Props.Set ("log4j.logger.util.log.test.file", "DEBUG");
      Props.Set ("log4j.rootCategory", "DEBUG,test_global,test");
      Util.Log.Loggers.Initialize (Props);

      declare
         L : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
      begin
         L.Debug ("Writing a debug message");
         L.Debug ("{0}: {1}", "Parameter", "Value");
         L.Debug ("Done");
         L.Error ("This is the error test message");
      end;

      Props.Set ("log4j.appender.test_append", "File");
      Props.Set ("log4j.appender.test_append.File", "test-append2.log");
      Props.Set ("log4j.appender.test_append.append", "true");
      Props.Set ("log4j.appender.test_append.immediateFlush", "true");
      Props.Set ("log4j.logger.util.log.test2.file", "DEBUG,test_append,test_global");
      Util.Log.Loggers.Initialize (Props);

      declare
         L1 : constant Loggers.Logger := Loggers.Create ("util.log.test.file");
         L2 : constant Loggers.Logger := Loggers.Create ("util.log.test2.file");
      begin
         L1.Info ("L1-1 Writing a info message");
         L2.Info ("L2-2 {0}: {1}", "Parameter", "Value");
         L1.Info ("L1-3 Done");
         L2.Error ("L2-4 This is the error test2 message");
      end;

      Props.Set ("log4j.appender.test_append.append", "plop");
      Props.Set ("log4j.appender.test_append.immediateFlush", "falsex");
      Props.Set ("log4j.rootCategory", "DEBUG, test.log");
      Util.Log.Loggers.Initialize (Props);

      T.Assert (Ada.Directories.Size ("test-append.log") > 100,
                "Log file test-append.log is empty");
      T.Assert (Ada.Directories.Size ("test-append2.log") > 100,
                "Log file test-append2.log is empty");
      T.Assert (Ada.Directories.Size ("test-append-global.log") > 100,
                "Log file test-append.log is empty");
   end Test_File_Appender_Modes;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Info",
                       Test_Log'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Debug",
                       Test_Log'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Set_Level",
                       Test_Log'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Appenders.File_Appender",
                       Test_File_Appender'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Appenders.File_Appender (append)",
                       Test_File_Appender_Modes'Access);
      Caller.Add_Test (Suite, "Test Util.Log.Appenders.List_Appender",
                       Test_List_Appender'Access);

      Caller.Add_Test (Suite, "Test Util.Log.Loggers.Log (Perf)",
                       Test_Log_Perf'Access);
   end Add_Tests;

end Util.Log.Tests;

Remove unused use clause

Remove unused use clause


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

with Util.Tests;
with Util.Test_Caller;

with Security.Contexts;
with AWA.Services.Contexts;
with AWA.Users.Models;
with AWA.Tests.Helpers.Users;
package body AWA.Changelogs.Modules.Tests is

   package Caller is new Util.Test_Caller (Test, "AWA.Changelogs");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Changelogs.Add_Log",
                       Test_Add_Log'Access);
   end Add_Tests;

   procedure Test_Add_Log (T : in out Test) is
      Sec_Ctx      : Security.Contexts.Security_Context;
      Context      : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-changelog@test.com");
      declare
         Change_Manager : constant Changelog_Module_Access := Get_Changelog_Module;
         User           : constant AWA.Users.Models.User_Ref := Context.Get_User;
         Total        : Integer;
      begin
         T.Assert (Change_Manager /= null, "There is no changelog module");

         Change_Manager.Add_Log (User.Get_Id, "awa_user", "A first changelog for the user");
      end;
   end Test_Add_Log;

end AWA.Changelogs.Modules.Tests;

-----------------------------------------------------------------------
--  awa-changelogs-tests -- Tests for changelogs
--  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.
-----------------------------------------------------------------------

with Util.Test_Caller;

with Security.Contexts;
with AWA.Services.Contexts;
with AWA.Users.Models;
with AWA.Tests.Helpers.Users;
package body AWA.Changelogs.Modules.Tests is

   package Caller is new Util.Test_Caller (Test, "AWA.Changelogs");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Changelogs.Add_Log",
                       Test_Add_Log'Access);
   end Add_Tests;

   procedure Test_Add_Log (T : in out Test) is
      Sec_Ctx      : Security.Contexts.Security_Context;
      Context      : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-changelog@test.com");
      declare
         Change_Manager : constant Changelog_Module_Access := Get_Changelog_Module;
         User           : constant AWA.Users.Models.User_Ref := Context.Get_User;
      begin
         T.Assert (Change_Manager /= null, "There is no changelog module");

         Change_Manager.Add_Log (User.Get_Id, "awa_user", "A first changelog for the user");
      end;
   end Test_Add_Log;

end AWA.Changelogs.Modules.Tests;

Fix compilation warnings

Fix compilation warnings