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

with Util.Log.Loggers;
with Util.Systems.DLLs;

with System;
with Ada.Strings.Fixed;
with Ada.Containers.Doubly_Linked_Lists;
with Ada.Exceptions;

package body ADO.Drivers.Connections is

   use Ada.Strings.Fixed;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ADO.Drivers.Connections");

   --  Load the database driver.
   procedure Load_Driver (Name : in String);

   --  ------------------------------
   --  Set the connection URL to connect to the database.
   --  The driver connection is a string of the form:
   --
   --   driver://[host][:port]/[database][?property1][=value1]...
   --
   --  If the string is invalid or if the driver cannot be found,
   --  the Connection_Error exception is raised.
   --  ------------------------------
   procedure Set_Connection (Controller : in out Configuration;
                             URI        : in String) is

      Pos, Pos2, Slash_Pos, Next : Natural;
   begin
      Log.Info ("Set connection URI: {0}", URI);

      Controller.URI := To_Unbounded_String (URI);
      Pos := Index (URI, "://");
      if Pos <= 1 then
         Log.Error ("Invalid connection URI: {0}", URI);
         raise Connection_Error
           with "Invalid URI: '" & URI & "'";
      end if;
      Controller.Driver := Get_Driver (URI (URI'First .. Pos - 1));
      if Controller.Driver = null then
         Log.Error ("No driver found for connection URI: {0}", URI);
         raise Connection_Error
           with "Driver '" & URI (URI'First .. Pos - 1) & "' not found";
      end if;

      Pos := Pos + 3;
      Slash_Pos := Index (URI, "/", Pos);
      if Slash_Pos < Pos then
         Log.Error ("Invalid connection URI: {0}", URI);
         raise Connection_Error
           with "Invalid connection URI: '" & URI & "'";
      end if;

      --  Extract the server and port.
      Pos2 := Index (URI, ":", Pos);
      if Pos2 > Pos then
         Controller.Server := To_Unbounded_String (URI (Pos .. Pos2 - 1));
         Controller.Port := Integer'Value (URI (Pos2 + 1 .. Slash_Pos - 1));

      else
         Controller.Port := 0;
         Controller.Server := To_Unbounded_String (URI (Pos .. Slash_Pos - 1));
      end if;

      --  Extract the database name.
      Pos := Index (URI, "?", Slash_Pos);
      if Pos - 1 > Slash_Pos + 1 then
         Controller.Database := To_Unbounded_String (URI (Slash_Pos + 1 .. Pos - 1));
      elsif Pos = 0 and Slash_Pos + 1 < URI'Last then
         Controller.Database := To_Unbounded_String (URI (Slash_Pos + 1 .. URI'Last));
      else
         Controller.Database := Null_Unbounded_String;
      end if;

      --  Parse the optional properties
      if Pos > Slash_Pos then
         while Pos < URI'Last loop
            Pos2 := Index (URI, "=", Pos + 1);
            if Pos2 > Pos then
               Next := Index (URI, "&", Pos2 + 1);
               if Next > 0 then
                  Controller.Properties.Set (URI (Pos + 1 .. Pos2 - 1),
                                             URI (Pos2 + 1 .. Next - 1));
                  Pos := Next;
               else
                  Controller.Properties.Set (URI (Pos + 1 .. Pos2 - 1),
                                             URI (Pos2 + 1 .. URI'Last));
                  Pos := URI'Last;
               end if;
            else
               Controller.Properties.Set (URI (Pos + 1 .. URI'Last), "");
               Pos := URI'Last;
            end if;
         end loop;
      end if;
   end Set_Connection;

   --  ------------------------------
   --  Set a property on the datasource for the driver.
   --  The driver can retrieve the property to configure and open
   --  the database connection.
   --  ------------------------------
   procedure Set_Property (Controller : in out Configuration;
                           Name       : in String;
                           Value      : in String) is
   begin
      Controller.Properties.Set (Name, Value);
   end Set_Property;

   --  ------------------------------
   --  Get a property from the datasource configuration.
   --  If the property does not exist, an empty string is returned.
   --  ------------------------------
   function Get_Property (Controller : in Configuration;
                          Name       : in String) return String is
   begin
      return Controller.Properties.Get (Name, "");
   end Get_Property;

   --  ------------------------------
   --  Get the server hostname.
   --  ------------------------------
   function Get_Server (Controller : in Configuration) return String is
   begin
      return To_String (Controller.Server);
   end Get_Server;

   --  ------------------------------
   --  Get the server port.
   --  ------------------------------
   function Get_Port (Controller : in Configuration) return Integer is
   begin
      return Controller.Port;
   end Get_Port;

   --  ------------------------------
   --  Get the database name.
   --  ------------------------------
   function Get_Database (Controller : in Configuration) return String is
   begin
      return To_String (Controller.Database);
   end Get_Database;

   --  ------------------------------
   --  Create a new connection using the configuration parameters.
   --  ------------------------------
   procedure Create_Connection (Config : in Configuration'Class;
                                Result : out Database_Connection_Access) is
   begin
      if Config.Driver = null then
         Log.Error ("No driver found for connection {0}", To_String (Config.URI));
         raise Connection_Error with "Data source is not initialized: driver not found";
      end if;
      Config.Driver.Create_Connection (Config, Result);
      Log.Info ("Created connection to '{0}' -> {1}", Config.URI, Result.Ident);

   exception
      when others =>
         Log.Info ("Failed to create connection to '{0}'", Config.URI);
         raise;

   end Create_Connection;

   package Driver_List is
     new Ada.Containers.Doubly_Linked_Lists (Element_Type => Driver_Access);

   Next_Index : Driver_Index := 1;
   Drivers    : Driver_List.List;

   --  ------------------------------
   --  Get the driver unique index.
   --  ------------------------------
   function Get_Driver_Index (D : in Driver) return Driver_Index is
   begin
      return D.Index;
   end Get_Driver_Index;

   --  ------------------------------
   --  Get the driver name.
   --  ------------------------------
   function Get_Driver_Name (D : in Driver) return String is
   begin
      return D.Name.all;
   end Get_Driver_Name;

   --  ------------------------------
   --  Register a database driver.
   --  ------------------------------
   procedure Register (Driver : in Driver_Access) is
   begin
      Log.Info ("Register driver {0}", Driver.Name.all);

      Driver_List.Prepend (Container => Drivers, New_Item => Driver);
      Driver.Index := Next_Index;
      Next_Index := Next_Index + 1;
   end Register;

   --  ------------------------------
   --  Load the database driver.
   --  ------------------------------
   procedure Load_Driver (Name : in String) is
      Lib    : constant String := "libada_ado_" & Name & Util.Systems.DLLs.Extension;
      Symbol : constant String := "ado__drivers__connections__" & Name & "__initialize";
      Handle : Util.Systems.DLLs.Handle;
      Addr   : System.Address;

   begin
      Log.Info ("Loading driver {0}", Lib);
      Handle := Util.Systems.DLLs.Load (Lib);
      Addr := Util.Systems.DLLs.Get_Symbol (Handle, Symbol);

      declare
         procedure Init;
         pragma Import (C, Init);
         for Init'Address use Addr;
      begin
         Init;
      end;
   exception
      when Util.Systems.DLLs.Not_Found =>
         Log.Error ("Driver for {0} was loaded but does not define the initialization symbol",
                    Name);

      when E : Util.Systems.DLLs.Load_Error =>
         Log.Error ("Driver for {0} was not found: {1}",
                    Name, Ada.Exceptions.Exception_Message (E));

   end Load_Driver;

   --  ------------------------------
   --  Get a database driver given its name.
   --  ------------------------------
   function Get_Driver (Name : in String) return Driver_Access is
   begin
      Log.Info ("Get driver {0}", Name);

      for Retry in 0 .. 1 loop
         if Retry > 0 then
            Load_Driver (Name);
         end if;
         declare
            Iter : Driver_List.Cursor := Driver_List.First (Drivers);
         begin
            while Driver_List.Has_Element (Iter) loop
               declare
                  D : constant Driver_Access := Driver_List.Element (Iter);
               begin
                  if Name = D.Name.all then
                     return D;
                  end if;
               end;
               Driver_List.Next (Iter);
            end loop;
         end;
      end loop;
      return null;
   end Get_Driver;

end ADO.Drivers.Connections;

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

with Util.Log.Loggers;
with Util.Systems.DLLs;

with System;
with Ada.Strings.Fixed;
with Ada.Containers.Doubly_Linked_Lists;
with Ada.Exceptions;

package body ADO.Drivers.Connections is

   use Ada.Strings.Fixed;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ADO.Drivers.Connections");

   --  Load the database driver.
   procedure Load_Driver (Name : in String);

   --  ------------------------------
   --  Set the connection URL to connect to the database.
   --  The driver connection is a string of the form:
   --
   --   driver://[host][:port]/[database][?property1][=value1]...
   --
   --  If the string is invalid or if the driver cannot be found,
   --  the Connection_Error exception is raised.
   --  ------------------------------
   procedure Set_Connection (Controller : in out Configuration;
                             URI        : in String) is

      Pos, Pos2, Slash_Pos, Next : Natural;
   begin
      Log.Info ("Set connection URI: {0}", URI);

      Controller.URI := To_Unbounded_String (URI);
      Pos := Index (URI, "://");
      if Pos <= 1 then
         Log.Error ("Invalid connection URI: {0}", URI);
         raise Connection_Error
           with "Invalid URI: '" & URI & "'";
      end if;
      Controller.Driver := Get_Driver (URI (URI'First .. Pos - 1));
      if Controller.Driver = null then
         Log.Error ("No driver found for connection URI: {0}", URI);
         raise Connection_Error
           with "Driver '" & URI (URI'First .. Pos - 1) & "' not found";
      end if;

      Pos := Pos + 3;
      Slash_Pos := Index (URI, "/", Pos);
      if Slash_Pos < Pos then
         Log.Error ("Invalid connection URI: {0}", URI);
         raise Connection_Error
           with "Invalid connection URI: '" & URI & "'";
      end if;

      --  Extract the server and port.
      Pos2 := Index (URI, ":", Pos);
      if Pos2 >= Pos then
         Controller.Server := To_Unbounded_String (URI (Pos .. Pos2 - 1));
         begin
            Controller.Port := Integer'Value (URI (Pos2 + 1 .. Slash_Pos - 1));

         exception
            when Constraint_Error =>
               Log.Error ("Invalid port in connection URI: {0}", URI);
               raise Connection_Error
                 with "Invalid port in connection URI: '" & URI & "'";
         end;
      else
         Controller.Port := 0;
         Controller.Server := To_Unbounded_String (URI (Pos .. Slash_Pos - 1));
      end if;

      --  Extract the database name.
      Pos := Index (URI, "?", Slash_Pos);
      if Pos - 1 > Slash_Pos + 1 then
         Controller.Database := To_Unbounded_String (URI (Slash_Pos + 1 .. Pos - 1));
      elsif Pos = 0 and Slash_Pos + 1 < URI'Last then
         Controller.Database := To_Unbounded_String (URI (Slash_Pos + 1 .. URI'Last));
      else
         Controller.Database := Null_Unbounded_String;
      end if;

      --  Parse the optional properties
      if Pos > Slash_Pos then
         while Pos < URI'Last loop
            Pos2 := Index (URI, "=", Pos + 1);
            if Pos2 > Pos then
               Next := Index (URI, "&", Pos2 + 1);
               if Next > 0 then
                  Controller.Properties.Set (URI (Pos + 1 .. Pos2 - 1),
                                             URI (Pos2 + 1 .. Next - 1));
                  Pos := Next;
               else
                  Controller.Properties.Set (URI (Pos + 1 .. Pos2 - 1),
                                             URI (Pos2 + 1 .. URI'Last));
                  Pos := URI'Last;
               end if;
            else
               Controller.Properties.Set (URI (Pos + 1 .. URI'Last), "");
               Pos := URI'Last;
            end if;
         end loop;
      end if;
   end Set_Connection;

   --  ------------------------------
   --  Set a property on the datasource for the driver.
   --  The driver can retrieve the property to configure and open
   --  the database connection.
   --  ------------------------------
   procedure Set_Property (Controller : in out Configuration;
                           Name       : in String;
                           Value      : in String) is
   begin
      Controller.Properties.Set (Name, Value);
   end Set_Property;

   --  ------------------------------
   --  Get a property from the datasource configuration.
   --  If the property does not exist, an empty string is returned.
   --  ------------------------------
   function Get_Property (Controller : in Configuration;
                          Name       : in String) return String is
   begin
      return Controller.Properties.Get (Name, "");
   end Get_Property;

   --  ------------------------------
   --  Get the server hostname.
   --  ------------------------------
   function Get_Server (Controller : in Configuration) return String is
   begin
      return To_String (Controller.Server);
   end Get_Server;

   --  ------------------------------
   --  Get the server port.
   --  ------------------------------
   function Get_Port (Controller : in Configuration) return Integer is
   begin
      return Controller.Port;
   end Get_Port;

   --  ------------------------------
   --  Get the database name.
   --  ------------------------------
   function Get_Database (Controller : in Configuration) return String is
   begin
      return To_String (Controller.Database);
   end Get_Database;

   --  ------------------------------
   --  Create a new connection using the configuration parameters.
   --  ------------------------------
   procedure Create_Connection (Config : in Configuration'Class;
                                Result : out Database_Connection_Access) is
   begin
      if Config.Driver = null then
         Log.Error ("No driver found for connection {0}", To_String (Config.URI));
         raise Connection_Error with "Data source is not initialized: driver not found";
      end if;
      Config.Driver.Create_Connection (Config, Result);
      Log.Info ("Created connection to '{0}' -> {1}", Config.URI, Result.Ident);

   exception
      when others =>
         Log.Info ("Failed to create connection to '{0}'", Config.URI);
         raise;

   end Create_Connection;

   package Driver_List is
     new Ada.Containers.Doubly_Linked_Lists (Element_Type => Driver_Access);

   Next_Index : Driver_Index := 1;
   Drivers    : Driver_List.List;

   --  ------------------------------
   --  Get the driver unique index.
   --  ------------------------------
   function Get_Driver_Index (D : in Driver) return Driver_Index is
   begin
      return D.Index;
   end Get_Driver_Index;

   --  ------------------------------
   --  Get the driver name.
   --  ------------------------------
   function Get_Driver_Name (D : in Driver) return String is
   begin
      return D.Name.all;
   end Get_Driver_Name;

   --  ------------------------------
   --  Register a database driver.
   --  ------------------------------
   procedure Register (Driver : in Driver_Access) is
   begin
      Log.Info ("Register driver {0}", Driver.Name.all);

      Driver_List.Prepend (Container => Drivers, New_Item => Driver);
      Driver.Index := Next_Index;
      Next_Index := Next_Index + 1;
   end Register;

   --  ------------------------------
   --  Load the database driver.
   --  ------------------------------
   procedure Load_Driver (Name : in String) is
      Lib    : constant String := "libada_ado_" & Name & Util.Systems.DLLs.Extension;
      Symbol : constant String := "ado__drivers__connections__" & Name & "__initialize";
      Handle : Util.Systems.DLLs.Handle;
      Addr   : System.Address;

   begin
      Log.Info ("Loading driver {0}", Lib);
      Handle := Util.Systems.DLLs.Load (Lib);
      Addr := Util.Systems.DLLs.Get_Symbol (Handle, Symbol);

      declare
         procedure Init;
         pragma Import (C, Init);
         for Init'Address use Addr;
      begin
         Init;
      end;
   exception
      when Util.Systems.DLLs.Not_Found =>
         Log.Error ("Driver for {0} was loaded but does not define the initialization symbol",
                    Name);

      when E : Util.Systems.DLLs.Load_Error =>
         Log.Error ("Driver for {0} was not found: {1}",
                    Name, Ada.Exceptions.Exception_Message (E));

   end Load_Driver;

   --  ------------------------------
   --  Get a database driver given its name.
   --  ------------------------------
   function Get_Driver (Name : in String) return Driver_Access is
   begin
      Log.Info ("Get driver {0}", Name);

      for Retry in 0 .. 1 loop
         if Retry > 0 then
            Load_Driver (Name);
         end if;
         declare
            Iter : Driver_List.Cursor := Driver_List.First (Drivers);
         begin
            while Driver_List.Has_Element (Iter) loop
               declare
                  D : constant Driver_Access := Driver_List.Element (Iter);
               begin
                  if Name = D.Name.all then
                     return D;
                  end if;
               end;
               Driver_List.Next (Iter);
            end loop;
         end;
      end loop;
      return null;
   end Get_Driver;

end ADO.Drivers.Connections;

Raise a Connection_Error exception if the connection port is invalid


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

with Util.Test_Caller;
with Util.Beans.Basic;
with Util.Beans.Objects;

with Security.Contexts;

with AWA.Users.Models;
with AWA.Services.Contexts;
with AWA.Tests.Helpers.Users;
with AWA.Tags.Beans;
package body AWA.Tags.Modules.Tests is

   use Util.Tests;
   use ADO;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Tags.Modules.Add_Tag",
                       Test_Add_Tag'Access);
      Caller.Add_Test (Suite, "Test AWA.Tags.Modules.Remove_Tag",
                       Test_Remove_Tag'Access);
   end Add_Tests;

   function Create_Tag_List_Bean (Module : in Tag_Module_Access)
                                  return AWA.Tags.Beans.Tag_List_Bean_Access is
      Bean : Util.Beans.Basic.Readonly_Bean_Access := AWA.Tags.Beans.Create_Tag_List_Bean (Module);
   begin
      return AWA.Tags.Beans.Tag_List_Bean'Class (Bean.all)'Access;
   end Create_Tag_List_Bean;

   --  ------------------------------
   --  Test tag creation.
   --  ------------------------------
   procedure Test_Add_Tag (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-add-tag@test.com");

      declare
         Tag_Manager  : constant Tag_Module_Access := Get_Tag_Module;
         User         : constant AWA.Users.Models.User_Ref := Context.Get_User;
         List         : AWA.Tags.Beans.Tag_List_Bean_Access;
         Cleanup      : Util.Beans.Objects.Object;
      begin
         T.Assert (Tag_Manager /= null, "There is no tag module");

         List := Create_Tag_List_Bean (Tag_Manager);
         Cleanup := Util.Beans.Objects.To_Object (List.all'Access);
         List.Set_Value ("entity_type", Util.Beans.Objects.To_Object (String '("awa_user")));

         --  Create a tag.
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag");
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag");

         --  Load the list.
         List.Load_Tags (User.Get_Id);

         Util.Tests.Assert_Equals (T, 1, Integer (List.Get_Count), "Invalid number of tags");
      end;
   end Test_Add_Tag;

   --  ------------------------------
   --  Test tag removal.
   --  ------------------------------
   procedure Test_Remove_Tag (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-tag@test.com");

      declare
         Tag_Manager  : constant Tag_Module_Access := Get_Tag_Module;
         User         : constant AWA.Users.Models.User_Ref := Context.Get_User;
         List         : AWA.Tags.Beans.Tag_List_Bean_Access;
         Cleanup      : Util.Beans.Objects.Object;
      begin
         T.Assert (Tag_Manager /= null, "There is no tag module");

         List := Create_Tag_List_Bean (Tag_Manager);
         Cleanup := Util.Beans.Objects.To_Object (List.all'Access);
         List.Set_Value ("entity_type", Util.Beans.Objects.To_Object (String '("awa_user")));

         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-1");
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-2");
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-3");

         Tag_Manager.Remove_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-2");
         Tag_Manager.Remove_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-1");

         --  Load the list.
         List.Load_Tags (User.Get_Id);
         Util.Tests.Assert_Equals (T, 2, Integer (List.Get_Count), "Invalid number of tags");
      end;
   end Test_Remove_Tag;

end AWA.Tags.Modules.Tests;

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

with Util.Test_Caller;
with Util.Beans.Basic;
with Util.Beans.Objects;

with Security.Contexts;

with AWA.Users.Models;
with AWA.Services.Contexts;
with AWA.Tests.Helpers.Users;
with AWA.Tags.Beans;
package body AWA.Tags.Modules.Tests is

   use Util.Tests;
   use ADO;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Tags.Modules.Add_Tag",
                       Test_Add_Tag'Access);
      Caller.Add_Test (Suite, "Test AWA.Tags.Modules.Remove_Tag",
                       Test_Remove_Tag'Access);
   end Add_Tests;

   function Create_Tag_List_Bean (Module : in Tag_Module_Access)
                                  return AWA.Tags.Beans.Tag_List_Bean_Access is
      Bean : Util.Beans.Basic.Readonly_Bean_Access := AWA.Tags.Beans.Create_Tag_List_Bean (Module);
   begin
      return AWA.Tags.Beans.Tag_List_Bean'Class (Bean.all)'Access;
   end Create_Tag_List_Bean;

   --  ------------------------------
   --  Test tag creation.
   --  ------------------------------
   procedure Test_Add_Tag (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-add-tag@test.com");

      declare
         Tag_Manager  : constant Tag_Module_Access := Get_Tag_Module;
         User         : constant AWA.Users.Models.User_Ref := Context.Get_User;
         List         : AWA.Tags.Beans.Tag_List_Bean_Access;
         Cleanup      : Util.Beans.Objects.Object;
      begin
         T.Assert (Tag_Manager /= null, "There is no tag module");

         List := Create_Tag_List_Bean (Tag_Manager);
         Cleanup := Util.Beans.Objects.To_Object (List.all'Access);
         List.Set_Value ("entity_type", Util.Beans.Objects.To_Object (String '("awa_user")));

         --  Create a tag.
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag");
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag");

         --  Load the list.
         List.Load_Tags (Tag_Manager.Get_Session, User.Get_Id);

         Util.Tests.Assert_Equals (T, 1, Integer (List.Get_Count), "Invalid number of tags");
      end;
   end Test_Add_Tag;

   --  ------------------------------
   --  Test tag removal.
   --  ------------------------------
   procedure Test_Remove_Tag (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-tag@test.com");

      declare
         Tag_Manager  : constant Tag_Module_Access := Get_Tag_Module;
         User         : constant AWA.Users.Models.User_Ref := Context.Get_User;
         List         : AWA.Tags.Beans.Tag_List_Bean_Access;
         Cleanup      : Util.Beans.Objects.Object;
      begin
         T.Assert (Tag_Manager /= null, "There is no tag module");

         List := Create_Tag_List_Bean (Tag_Manager);
         Cleanup := Util.Beans.Objects.To_Object (List.all'Access);
         List.Set_Value ("entity_type", Util.Beans.Objects.To_Object (String '("awa_user")));

         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-1");
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-2");
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-3");

         Tag_Manager.Remove_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-2");
         Tag_Manager.Remove_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-1");

         --  Load the list.
         List.Load_Tags (Tag_Manager.Get_Session, User.Get_Id);
         Util.Tests.Assert_Equals (T, 2, Integer (List.Get_Count), "Invalid number of tags");
      end;
   end Test_Remove_Tag;

end AWA.Tags.Modules.Tests;

Update the unit test

Update the unit test


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

with Regtests.Simple.Model;
with ADO.Queries.Loaders;
package body ADO.Datasets.Tests is

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

   package User_List_Query_File is
     new ADO.Queries.Loaders.File (Path => "regtests/files/user-list.xml",
                                   Sha1 => "");

   package User_List_Query is
     new ADO.Queries.Loaders.Query (Name => "user-list",
                                    File => User_List_Query_File.File'Access);

   package User_List_Count_Query is
     new ADO.Queries.Loaders.Query (Name => "user-list-count",
                                    File => User_List_Query_File.File'Access);

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ADO.Datasets.List (from <sql>)",
                       Test_List'Access);
      Caller.Add_Test (Suite, "Test ADO.Datasets.Get_Count (from <sql>)",
                       Test_Count'Access);
      Caller.Add_Test (Suite, "Test ADO.Datasets.Get_Count (from <sql-count>)",
                       Test_Count_Query'Access);
   end Add_Tests;

   procedure Test_List (T : in out Test) is
      DB     : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      Query  : ADO.Queries.Context;
      Count  : Natural;
      Data   : ADO.Datasets.Dataset;
      Props  : constant Util.Properties.Manager := Util.Tests.Get_Properties;
   begin
      --  Configure the XML query loader.
      ADO.Queries.Loaders.Initialize (Props.Get ("ado.queries.paths", ".;db"),
                                      Props.Get ("ado.queries.load", "false") = "true");

      Query.Set_Count_Query (User_List_Query.Query'Access);
      Query.Bind_Param ("filter", String '("test-list"));
      Count := ADO.Datasets.Get_Count (DB, Query);
      for I in 1 .. 100 loop
         declare
            User : Regtests.Simple.Model.User_Ref;
         begin
            User.Set_Name ("John " & Integer'Image (I));
            User.Set_Select_Name ("test-list");
            User.Set_Value (ADO.Identifier (I));
            User.Save (DB);
         end;
      end loop;
      DB.Commit;

      Query.Set_Query (User_List_Query.Query'Access);
      ADO.Datasets.List (Data, DB, Query);
      Util.Tests.Assert_Equals (T, 100 + Count, Data.Get_Count, "Invalid dataset size");
   end Test_List;

   procedure Test_Count (T : in out Test) is
      DB     : constant ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      Query  : ADO.Queries.Context;
      Count  : Natural;
      Props  : constant Util.Properties.Manager := Util.Tests.Get_Properties;
   begin
      --  Configure the XML query loader.
      ADO.Queries.Loaders.Initialize (Props.Get ("ado.queries.paths", ".;db"),
                                      Props.Get ("ado.queries.load", "false") = "true");
      Query.Set_Query (User_List_Count_Query.Query'Access);
      Count := ADO.Datasets.Get_Count (DB, Query);
      T.Assert (Count > 0,
                "The ADO.Datasets.Get_Count query should return a positive count");
   end Test_Count;

   procedure Test_Count_Query (T : in out Test) is
      DB     : constant ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      Query  : ADO.Queries.Context;
      Count  : Natural;
      Props  : constant Util.Properties.Manager := Util.Tests.Get_Properties;
   begin
      --  Configure the XML query loader.
      ADO.Queries.Loaders.Initialize (Props.Get ("ado.queries.paths", ".;db"),
                                      Props.Get ("ado.queries.load", "false") = "true");
      Query.Set_Count_Query (User_List_Query.Query'Access);
      Query.Bind_Param ("filter", String '("test-list"));
      Count := ADO.Datasets.Get_Count (DB, Query);
      T.Assert (Count > 0,
                "The ADO.Datasets.Get_Count query should return a positive count");
   end Test_Count_Query;

end ADO.Datasets.Tests;

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

with Regtests.Simple.Model;
with Regtests.Statements.Model;

with ADO.Queries.Loaders;
package body ADO.Datasets.Tests is

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

   package User_List_Query_File is
     new ADO.Queries.Loaders.File (Path => "regtests/files/user-list.xml",
                                   Sha1 => "");

   package User_List_Query is
     new ADO.Queries.Loaders.Query (Name => "user-list",
                                    File => User_List_Query_File.File'Access);

   package User_List_Count_Query is
     new ADO.Queries.Loaders.Query (Name => "user-list-count",
                                    File => User_List_Query_File.File'Access);

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ADO.Datasets.List (from <sql>)",
                       Test_List'Access);
      Caller.Add_Test (Suite, "Test ADO.Datasets.Get_Count (from <sql>)",
                       Test_Count'Access);
      Caller.Add_Test (Suite, "Test ADO.Datasets.Get_Count (from <sql-count>)",
                       Test_Count_Query'Access);
      Caller.Add_Test (Suite, "Test ADO.Datasets.List (<sql> with null)",
                       Test_List_Nullable'Access);
   end Add_Tests;

   procedure Test_List (T : in out Test) is
      DB     : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      Query  : ADO.Queries.Context;
      Count  : Natural;
      Data   : ADO.Datasets.Dataset;
      Props  : constant Util.Properties.Manager := Util.Tests.Get_Properties;
   begin
      --  Configure the XML query loader.
      ADO.Queries.Loaders.Initialize (Props.Get ("ado.queries.paths", ".;db"),
                                      Props.Get ("ado.queries.load", "false") = "true");

      Query.Set_Count_Query (User_List_Query.Query'Access);
      Query.Bind_Param ("filter", String '("test-list"));
      Count := ADO.Datasets.Get_Count (DB, Query);
      for I in 1 .. 100 loop
         declare
            User : Regtests.Simple.Model.User_Ref;
         begin
            User.Set_Name ("John " & Integer'Image (I));
            User.Set_Select_Name ("test-list");
            User.Set_Value (ADO.Identifier (I));
            User.Save (DB);
         end;
      end loop;
      DB.Commit;

      Query.Set_Query (User_List_Query.Query'Access);
      ADO.Datasets.List (Data, DB, Query);
      Util.Tests.Assert_Equals (T, 100 + Count, Data.Get_Count, "Invalid dataset size");
   end Test_List;

   --  ------------------------------
   --  Test dataset lists with null columns.
   --  ------------------------------
   procedure Test_List_Nullable (T : in out Test) is
      DB     : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      Query  : ADO.Queries.Context;
      Count  : Natural;
      Data   : ADO.Datasets.Dataset;
   begin
      Query.Set_SQL ("SELECT COUNT(*) FROM test_nullable_table");
      Count := ADO.Datasets.Get_Count (DB, Query);

      for I in 1 .. 100 loop
         declare
            Item : Regtests.Statements.Model.Nullable_Table_Ref;
         begin
            Item.Set_Bool_Value (False);
            if (I mod 2) = 0 then
               Item.Set_Int_Value (ADO.Nullable_Integer '(123, False));
            end if;
            if (I mod 4) = 0 then
               Item.Set_Time_Value (ADO.Nullable_Time '(Value => Ada.Calendar.Clock,
                                                        Is_Null => False));
            end if;
            Item.Save (DB);
         end;
      end loop;
      DB.Commit;

      Query.Set_SQL ("SELECT * FROM test_nullable_table");
      ADO.Datasets.List (Data, DB, Query);
      Util.Tests.Assert_Equals (T, 100 + Count, Data.Get_Count, "Invalid dataset size");
   end Test_List_Nullable;

   procedure Test_Count (T : in out Test) is
      DB     : constant ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      Query  : ADO.Queries.Context;
      Count  : Natural;
      Props  : constant Util.Properties.Manager := Util.Tests.Get_Properties;
   begin
      --  Configure the XML query loader.
      ADO.Queries.Loaders.Initialize (Props.Get ("ado.queries.paths", ".;db"),
                                      Props.Get ("ado.queries.load", "false") = "true");
      Query.Set_Query (User_List_Count_Query.Query'Access);
      Count := ADO.Datasets.Get_Count (DB, Query);
      T.Assert (Count > 0,
                "The ADO.Datasets.Get_Count query should return a positive count");
   end Test_Count;

   procedure Test_Count_Query (T : in out Test) is
      DB     : constant ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      Query  : ADO.Queries.Context;
      Count  : Natural;
      Props  : constant Util.Properties.Manager := Util.Tests.Get_Properties;
   begin
      --  Configure the XML query loader.
      ADO.Queries.Loaders.Initialize (Props.Get ("ado.queries.paths", ".;db"),
                                      Props.Get ("ado.queries.load", "false") = "true");
      Query.Set_Count_Query (User_List_Query.Query'Access);
      Query.Bind_Param ("filter", String '("test-list"));
      Count := ADO.Datasets.Get_Count (DB, Query);
      T.Assert (Count > 0,
                "The ADO.Datasets.Get_Count query should return a positive count");
   end Test_Count_Query;

end ADO.Datasets.Tests;

Implement a new test to verify the datasets with null columns and different types (date, boolean, integer, strings)


-----------------------------------------------------------------------
--  widgets-factory -- Factory for widget Components
--  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 ASF.Views.Nodes;
with ASF.Components.Base;
with ASF.Components.Widgets.Inputs;

package body ASF.Components.Widgets.Factory is

   use ASF.Components.Base;

   function Create_Input return UIComponent_Access;
   function Create_Complete return UIComponent_Access;

   --  ------------------------------
   --  Create a UIInput component
   --  ------------------------------
   function Create_Input return UIComponent_Access is
   begin
      return new ASF.Components.Widgets.Inputs.UIInput;
   end Create_Input;

   --  ------------------------------
   --  Create a UIComplete component
   --  ------------------------------
   function Create_Complete return UIComponent_Access is
   begin
      return new ASF.Components.Widgets.Inputs.UIComplete;
   end Create_Complete;

   use ASF.Views.Nodes;

   URI              : aliased constant String := "http://code.google.com/p/ada-asf/widget";
   AUTOCOMPLETE_TAG : aliased constant String := "autocomplete";
   INPUT_TEXT_TAG   : aliased constant String := "inputText";

   Widget_Bindings : aliased constant ASF.Factory.Binding_Array
     := (1 => (Name      => AUTOCOMPLETE_TAG'Access,
               Component => Create_Complete'Access,
               Tag       => Create_Component_Node'Access),
         2 => (Name      => INPUT_TEXT_TAG'Access,
               Component => Create_Input'Access,
               Tag       => Create_Component_Node'Access)
        );

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

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

end ASF.Components.Widgets.Factory;

-----------------------------------------------------------------------
--  widgets-factory -- Factory for widget Components
--  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 ASF.Views.Nodes;
with ASF.Components.Base;
with ASF.Components.Widgets.Inputs;

package body ASF.Components.Widgets.Factory is

   use ASF.Components.Base;

   function Create_Input return UIComponent_Access;
   function Create_Input_Date return UIComponent_Access;
   function Create_Complete return UIComponent_Access;

   --  ------------------------------
   --  Create a UIInput component
   --  ------------------------------
   function Create_Input return UIComponent_Access is
   begin
      return new ASF.Components.Widgets.Inputs.UIInput;
   end Create_Input;

   --  ------------------------------
   --  Create a UIInput component
   --  ------------------------------
   function Create_Input_Date return UIComponent_Access is
   begin
      return new ASF.Components.Widgets.Inputs.UIInputDate;
   end Create_Input_Date;

   --  ------------------------------
   --  Create a UIComplete component
   --  ------------------------------
   function Create_Complete return UIComponent_Access is
   begin
      return new ASF.Components.Widgets.Inputs.UIComplete;
   end Create_Complete;

   use ASF.Views.Nodes;

   URI              : aliased constant String := "http://code.google.com/p/ada-asf/widget";
   AUTOCOMPLETE_TAG : aliased constant String := "autocomplete";
   INPUT_DATE_TAG   : aliased constant String := "inputDate";
   INPUT_TEXT_TAG   : aliased constant String := "inputText";

   Widget_Bindings : aliased constant ASF.Factory.Binding_Array
     := (1 => (Name      => AUTOCOMPLETE_TAG'Access,
               Component => Create_Complete'Access,
               Tag       => Create_Component_Node'Access),
         2 => (Name      => INPUT_DATE_TAG'Access,
               Component => Create_Input_Date'Access,
               Tag       => Create_Component_Node'Access),
         3 => (Name      => INPUT_TEXT_TAG'Access,
               Component => Create_Input'Access,
               Tag       => Create_Component_Node'Access)
        );

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

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

end ASF.Components.Widgets.Factory;

Add the inputDate component in the factory


-----------------------------------------------------------------------
--  Util-texts -- Various Text Transformation Utilities
--  Copyright (C) 2001, 2002, 2003, 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 Util.Texts.Transforms;
with Ada.Strings.Unbounded;
with Ada.Characters.Handling;
package Util.Strings.Transforms is

   pragma Preelaborate;

   use Ada.Strings.Unbounded;

   package TR is
     new Util.Texts.Transforms (Stream => Unbounded_String,
                                Char   => Character,
                                Input  => String,
                                Put    => Ada.Strings.Unbounded.Append,
                                To_Upper => Ada.Characters.Handling.To_Upper,
                                To_Lower => Ada.Characters.Handling.To_Lower,
                                To_Input => Ada.Strings.Unbounded.To_String);

   --  Capitalize the string into the result stream.
   procedure Capitalize (Content : in String;
                         Into    : in out Unbounded_String)
                         renames TR.Capitalize;
   function Capitalize (Content : String) return String
                         renames TR.Capitalize;

   --  Translate the input string into an upper case string in the result stream.
   procedure To_Upper_Case (Content : in String;
                            Into    : in out Unbounded_String)
                            renames TR.To_Upper_Case;
   function To_Upper_Case (Content : String) return String
                           renames TR.To_Upper_Case;

   --  Translate the input string into a lower case string in the result stream.
   procedure To_Lower_Case (Content : in String;
                            Into    : in out Unbounded_String)
                         renames TR.To_Lower_Case;
   function To_Lower_Case (Content : String) return String
                           renames TR.To_Lower_Case;

   --  Write in the output stream the value as a \uNNNN encoding form.
   procedure To_Hex (Into  : in out Unbounded_String;
                     Value : in Character) renames TR.To_Hex;

   --  Escape the content into the result stream using the JavaScript
   --  escape rules.
   procedure Escape_Javascript (Content : in String;
                                Into    : in out Unbounded_String)
                                renames TR.Escape_Java_Script;
   function Escape_Javascript (Content : String) return String
                                renames TR.Escape_Java_Script;

   --  Escape the content into the result stream using the Java
   --  escape rules.
   procedure Escape_Java (Content : in String;
                          Into    : in out Unbounded_String)
                          renames TR.Escape_Java;
   function Escape_Java (Content : String) return String
                          renames TR.Escape_Java;

   --  Escape the content into the result stream using the XML
   --  escape rules:
   --   '<' -> '<'
   --   '>' -> '>'
   --   ''' -> '''
   --   '&' -> '&'
   --       -> '&#nnn;' if Character'Pos >= 128
   procedure Escape_Xml (Content : in String;
                         Into    : in out Unbounded_String)
                          renames TR.Escape_Xml;

   function Escape_Xml (Content : String) return String
                        renames TR.Escape_Xml;

   procedure Translate_Xml_Entity (Entity : in String;
                                   Into   : in out Unbounded_String)
                                   renames TR.Translate_Xml_Entity;

   procedure Unescape_Xml (Content    : in String;
                           Translator : not null access
                             procedure (Entity : in String;
                                        Into   : in out Unbounded_String)
                           := Translate_Xml_Entity'Access;
                           Into       : in out Unbounded_String)
   renames TR.Unescape_Xml;

end Util.Strings.Transforms;

-----------------------------------------------------------------------
--  Util-texts -- Various Text Transformation Utilities
--  Copyright (C) 2001, 2002, 2003, 2009, 2010, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Texts.Transforms;
with Ada.Strings.Unbounded;
with Ada.Characters.Handling;
package Util.Strings.Transforms is

   pragma Preelaborate;

   use Ada.Strings.Unbounded;

   package TR is
     new Util.Texts.Transforms (Stream => Unbounded_String,
                                Char   => Character,
                                Input  => String,
                                Put    => Ada.Strings.Unbounded.Append,
                                To_Upper => Ada.Characters.Handling.To_Upper,
                                To_Lower => Ada.Characters.Handling.To_Lower);

   --  Capitalize the string into the result stream.
   procedure Capitalize (Content : in String;
                         Into    : in out Unbounded_String)
                         renames TR.Capitalize;
   function Capitalize (Content : String) return String
                        renames TR.Capitalize;

   --  Translate the input string into an upper case string in the result stream.
   procedure To_Upper_Case (Content : in String;
                            Into    : in out Unbounded_String)
                            renames TR.To_Upper_Case;
   function To_Upper_Case (Content : String) return String
                           renames TR.To_Upper_Case;

   --  Translate the input string into a lower case string in the result stream.
   procedure To_Lower_Case (Content : in String;
                            Into    : in out Unbounded_String)
                         renames TR.To_Lower_Case;
   function To_Lower_Case (Content : String) return String
                           renames TR.To_Lower_Case;

   --  Write in the output stream the value as a \uNNNN encoding form.
   procedure To_Hex (Into  : in out Unbounded_String;
                     Value : in Character) renames TR.To_Hex;

   --  Escape the content into the result stream using the JavaScript
   --  escape rules.
   procedure Escape_Javascript (Content : in String;
                                Into    : in out Unbounded_String)
                                renames TR.Escape_Java_Script;
   function Escape_Javascript (Content : String) return String;

   --  Escape the content into the result stream using the Java
   --  escape rules.
   procedure Escape_Java (Content : in String;
                          Into    : in out Unbounded_String)
                          renames TR.Escape_Java;
   function Escape_Java (Content : String) return String;

   --  Escape the content into the result stream using the XML
   --  escape rules:
   --   '<' -> '<'
   --   '>' -> '>'
   --   ''' -> '''
   --   '&' -> '&'
   --       -> '&#nnn;' if Character'Pos >= 128
   procedure Escape_Xml (Content : in String;
                         Into    : in out Unbounded_String)
                          renames TR.Escape_Xml;

   function Escape_Xml (Content : String) return String;

   procedure Translate_Xml_Entity (Entity : in String;
                                   Into   : in out Unbounded_String)
                                   renames TR.Translate_Xml_Entity;

   procedure Unescape_Xml (Content    : in String;
                           Translator : not null access
                             procedure (Entity : in String;
                                        Into   : in out Unbounded_String)
                           := Translate_Xml_Entity'Access;
                           Into       : in out Unbounded_String)
   renames TR.Unescape_Xml;

end Util.Strings.Transforms;

Change Escape_Javascript, Escape_Java, Escape_Xml function to real function declaration (instead of renames)


pragma License (Modified_GPL);
------------------------------------------------------------------------------
-- EMAIL: <darkestkhan@gmail.com>                                           --
-- License: Modified GNU GPLv3 or any later as published by Free Software   --
--  Foundation (GMGPL, see COPYING file).                                   --
--                                                                          --
--                    Copyright © 2014 darkestkhan                          --
------------------------------------------------------------------------------
--  This Program is Free Software: You can redistribute it and/or modify    --
--  it under the terms of The GNU General Public License as published by    --
--    the Free Software Foundation: either version 3 of the license, or     --
--                 (at your option) any later version.                      --
--                                                                          --
--      This Program is distributed in the hope that it will be useful,     --
--      but WITHOUT ANY WARRANTY; without even the implied warranty of      --
--      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the        --
--              GNU General Public License for more details.                --
--                                                                          --
--    You should have received a copy of the GNU General Public License     --
--   along with this program.  If not, see <http://www.gnu.org/licenses/>.  --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
------------------------------------------------------------------------------
with System;

with Oto.Binary;
use Oto;
package Oto.ALC is

  ---------------------------------------------------------------------------

                              ---------------
                              -- T Y P E S --
                              ---------------

  ---------------------------------------------------------------------------
  -- Due to the fact that only pointers to device and context are passed
  -- we ar going to use System.Address for them.
  subtype Context is System.Address;
  subtype Device  is System.Address;

  subtype Bool    is Binary.Byte;
  subtype Char    is Binary.S_Byte;
  subtype Double  is Long_Float;
  subtype Enum    is Binary.S_Word;
  subtype Int     is Integer;
  subtype Short   is Binary.S_Short;
  subtype SizeI   is Integer;
  subtype UByte   is Binary.Byte;
  subtype UInt    is Binary.Word;
  subtype UShort  is Binary.Short;

  ---------------------------------------------------------------------------

end OTO.ALC;

pragma License (Modified_GPL);
------------------------------------------------------------------------------
-- EMAIL: <darkestkhan@gmail.com>                                           --
-- License: Modified GNU GPLv3 or any later as published by Free Software   --
--  Foundation (GMGPL, see COPYING file).                                   --
--                                                                          --
--                    Copyright © 2014 darkestkhan                          --
------------------------------------------------------------------------------
--  This Program is Free Software: You can redistribute it and/or modify    --
--  it under the terms of The GNU General Public License as published by    --
--    the Free Software Foundation: either version 3 of the license, or     --
--                 (at your option) any later version.                      --
--                                                                          --
--      This Program is distributed in the hope that it will be useful,     --
--      but WITHOUT ANY WARRANTY; without even the implied warranty of      --
--      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the        --
--              GNU General Public License for more details.                --
--                                                                          --
--    You should have received a copy of the GNU General Public License     --
--   along with this program.  If not, see <http://www.gnu.org/licenses/>.  --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
------------------------------------------------------------------------------
with System;

with Oto.Binary;
use Oto;
package Oto.ALC is

  ---------------------------------------------------------------------------

                              ---------------
                              -- T Y P E S --
                              ---------------

  ---------------------------------------------------------------------------
  -- Due to the fact that only pointers to device and context are passed
  -- we ar going to use System.Address for them.
  subtype Context is System.Address;
  subtype Device  is System.Address;

  subtype Bool    is Binary.Byte;
  subtype Char    is Binary.S_Byte;
  subtype Double  is Long_Float;
  subtype Enum    is Binary.S_Word;
  subtype Int     is Integer;
  subtype Short   is Binary.S_Short;
  subtype SizeI   is Integer;
  subtype UByte   is Binary.Byte;
  subtype UInt    is Binary.Word;
  subtype UShort  is Binary.Short;

  ---------------------------------------------------------------------------

                          -----------------------
                          -- C O N S T A N T S --
                          -----------------------

  ---------------------------------------------------------------------------
  -- Bool constants.
  ALC_FALSE                                : constant Bool := 0;
  ALC_TRUE                                 : constant Bool := 1;

  -- Followed by <Int> Hz
  ALC_FREQUENCY                            : constant Enum := 16#1007#;

  -- Followed by <Int> Hz
  ALC_REFRESH                              : constant Enum := 16#1008#;

  -- Followed by AL_TRUE, AL_FALSE
  ALC_SYNC                                 : constant Enum := 16#1009#;

  -- Followed by <Int> Num of requested Mono (3D) Sources
  ALC_MONO_SOURCES                         : constant Enum := 16#1010#;

  -- Followed by <Int> Num of requested Stereo Sources
  ALC_STEREO_SOURCES                       : constant Enum := 16#1011#;

  -- Errors
  -- No error
  ALC_NO_ERROR                             : constant Enum := 0;

  -- No device
  ALC_INVALID_DEVICE                       : constant Enum := 16#A001#;

  -- Invalid context ID
  ALC_INVALID_CONTEXT                      : constant Enum := 16#A002#;

  -- Bad enum
  ALC_INVALID_ENUM                         : constant Enum := 16#A003#;

  -- Bad value
  ALC_INVALID_VALUE                        : constant Enum := 16#A004#;

  -- Out of memory.
  ALC_OUT_OF_MEMORY                        : constant Enum := 16#A005#;

  -- The Specifier string for default device
  ALC_DEFAULT_DEVICE_SPECIFIER             : constant Enum := 16#1004#;
  ALC_DEVICE_SPECIFIER                     : constant Enum := 16#1005#;
  ALC_EXTENSIONS                           : constant Enum := 16#1006#;

  ALC_MAJOR_VERSION                        : constant Enum := 16#1000#;
  ALC_MINOR_VERSION                        : constant Enum := 16#1001#;

  ALC_ATTRIBUTES_SIZE                      : constant Enum := 16#1002#;
  ALC_ALL_ATTRIBUTES                       : constant Enum := 16#1003#;

  -- Capture extension
  ALC_EXT_CAPTURE                          : constant Enum := 1;
  ALC_CAPTURE_DEVICE_SPECIFIER             : constant Enum := 16#310#;
  ALC_CAPTURE_DEFAULT_DEVICE_SPECIFIER     : constant Enum := 16#311#;
  ALC_CAPTURE_SAMPLES                      : constant Enum := 16#312#;

  -- ALC_ENUMERATE_ALL_EXT enums
  ALC_ENUMERATE_ALL_EXT                    : constant Enum := 1;
  ALC_DEFAULT_ALL_DEVICES_SPECIFIER        : constant Enum := 16#1012#;
  ALC_ALL_DEVICES_SPECIFIER                : constant Enum := 16#1013#;

  ---------------------------------------------------------------------------

end OTO.ALC;

Add constants definitions.

ALC: Add constants definitions.

Signed-off-by: darkestkhan <e9a7a7cf2a6af79e93742343a7a5cac5d90f9bd2@gmail.com>


-----------------------------------------------------------------------
--  Util.Concurrent -- Concurrent Tools
--  Copyright (C) 2001, 2002, 2003, 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.
-----------------------------------------------------------------------
package Util.Concurrent is

   pragma Pure;

end Util.Concurrent;

-----------------------------------------------------------------------
--  util-concurrent -- Concurrent Tools
--  Copyright (C) 2001, 2002, 2003, 2009, 2010, 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.
-----------------------------------------------------------------------
package Util.Concurrent is

   pragma Pure;

end Util.Concurrent;

Update the header

Update the header


------------------------------------------------------------------------------
-- Copyright (c) 2015-2017, 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.           --
------------------------------------------------------------------------------

with Ada.Calendar;
with Natools.S_Expressions.Atom_Refs;
with Natools.S_Expressions.Caches;
with Natools.S_Expressions.Templates.Dates;
with Natools.Static_Maps.Web.Fallback_Render;
with Natools.Web.ACL;
with Natools.Web.Comment_Cookies;
with Natools.Web.Escapes;
with Natools.Web.Filters.Stores;
with Natools.Web.Tags;
with Natools.Web.String_Tables;

procedure Natools.Web.Fallback_Render
  (Exchange : in out Natools.Web.Sites.Exchange;
   Name : in Natools.S_Expressions.Atom;
   Arguments : in out Natools.S_Expressions.Lockable.Descriptor'Class;
   Context : in String := "";
   Re_Enter : access procedure
     (Exchange : in out Natools.Web.Sites.Exchange;
      Expression : in out Natools.S_Expressions.Lockable.Descriptor'Class)
     := null;
   Elements : in Natools.Web.Containers.Expression_Maps.Constant_Map
     := Natools.Web.Containers.Expression_Maps.Empty_Constant_Map;
   Severity : in Severities.Code := Severities.Error)
is
   package Commands renames Natools.Static_Maps.Web.Fallback_Render;
   use type S_Expressions.Events.Event;

   procedure Render_Ref (Ref : in S_Expressions.Atom_Refs.Immutable_Reference);
   procedure Report_Unknown_Command;

   procedure Render_Ref
     (Ref : in S_Expressions.Atom_Refs.Immutable_Reference) is
   begin
      if not Ref.Is_Empty then
         Escapes.Write
           (Exchange,
            S_Expressions.To_String (Ref.Query),
            Escapes.HTML_Attribute);
      elsif Re_Enter /= null then
         Re_Enter (Exchange, Arguments);
      end if;
   end Render_Ref;

   procedure Report_Unknown_Command is
   begin
      if Context /= "" then
         Log (Severity, "Unknown render command """
           & S_Expressions.To_String (Name)
           & """ in "
           & Context);
      end if;
   end Report_Unknown_Command;
begin
   case Commands.To_Command (S_Expressions.To_String (Name)) is
      when Commands.Unknown =>
         Report_Unknown_Command;

      when Commands.Current_Time =>
         S_Expressions.Templates.Dates.Render
           (Exchange, Arguments, Ada.Calendar.Clock);

      when Commands.Cookies =>
         String_Tables.Render
           (Exchange,
            String_Tables.Create (Exchange.Cookie_Table),
            Arguments);

      when Commands.Comment_Cookie_Filter =>
         Render_Ref (Comment_Cookies.Filter (Sites.Comment_Info (Exchange)));

      when Commands.Comment_Cookie_Link =>
         Render_Ref (Comment_Cookies.Link (Sites.Comment_Info (Exchange)));

      when Commands.Comment_Cookie_Mail =>
         Render_Ref (Comment_Cookies.Mail (Sites.Comment_Info (Exchange)));

      when Commands.Comment_Cookie_Name =>
         Render_Ref (Comment_Cookies.Name (Sites.Comment_Info (Exchange)));

      when Commands.Element =>
         if Re_Enter = null then
            Report_Unknown_Command;
         else
            declare
               Template : S_Expressions.Caches.Cursor
                 := Exchange.Site.Get_Template
                    (Elements,
                     Arguments,
                     Lookup_Template => False);
            begin
               Re_Enter (Exchange, Template);
            end;
         end if;

      when Commands.Element_Or_Template =>
         if Re_Enter = null then
            Report_Unknown_Command;
         else
            declare
               Template : S_Expressions.Caches.Cursor
                 := Exchange.Site.Get_Template (Elements, Arguments);
            begin
               Re_Enter (Exchange, Template);
            end;
         end if;

      when Commands.Filter =>
         if Re_Enter = null then
            Report_Unknown_Command;
         elsif Arguments.Current_Event = S_Expressions.Events.Add_Atom then
            begin
               declare
                  Filter : Filters.Filter'Class
                    := Exchange.Site.Get_Filter (Arguments.Current_Atom);
               begin
                  Arguments.Next;
                  Exchange.Insert_Filter (Filter);
                  Re_Enter (Exchange, Arguments);
                  Exchange.Remove_Filter (Filter);
               end;
            exception
               when Filters.Stores.No_Filter => null;
            end;
         end if;

      when Commands.If_Has_Element =>
         if Re_Enter = null then
            Report_Unknown_Command;
         elsif Arguments.Current_Event = S_Expressions.Events.Add_Atom
           and then Elements.Contains (Arguments.Current_Atom)
         then
            Arguments.Next;
            Re_Enter (Exchange, Arguments);
         end if;

      when Commands.If_Has_Not_Element =>
         if Re_Enter = null then
            Report_Unknown_Command;
         elsif Arguments.Current_Event = S_Expressions.Events.Add_Atom
           and then not Elements.Contains (Arguments.Current_Atom)
         then
            Arguments.Next;
            Re_Enter (Exchange, Arguments);
         end if;

      when Commands.If_Parameter_Is =>
         if Re_Enter = null then
            Report_Unknown_Command;
         elsif Arguments.Current_Event = S_Expressions.Events.Add_Atom then
            declare
               Param_Value : constant String := Exchange.Parameter
                 (S_Expressions.To_String (Arguments.Current_Atom));
               Event : S_Expressions.Events.Event;
            begin
               Arguments.Next (Event);
               if Event = S_Expressions.Events.Add_Atom
                 and then Param_Value
                    = S_Expressions.To_String (Arguments.Current_Atom)
               then
                  Arguments.Next;
                  Re_Enter (Exchange, Arguments);
               end if;
            end;
         end if;

      when Commands.Load_Date =>
         S_Expressions.Templates.Dates.Render
           (Exchange, Arguments, Exchange.Site.Load_Date);

      when Commands.Parameter =>
         if Arguments.Current_Event = S_Expressions.Events.Add_Atom then
            Escapes.Write
              (Exchange,
               Exchange.Parameter
                 (S_Expressions.To_String (Arguments.Current_Atom)),
               Escapes.HTML_Attribute);
         end if;

      when Commands.Set_MIME_Type =>
         if Arguments.Current_Event = S_Expressions.Events.Add_Atom then
            Exchange.Set_MIME_Type (Arguments.Current_Atom);
         end if;

      when Commands.Tags =>
         Tags.Render (Exchange, Exchange.Site.Get_Tags, Arguments);

      when Commands.Template =>
         if Re_Enter = null then
            Report_Unknown_Command;
         else
            declare
               Template : S_Expressions.Caches.Cursor
                 := Exchange.Site.Get_Template
                    (Elements,
                     Arguments,
                     Lookup_Element => False);
            begin
               Re_Enter (Exchange, Template);
            end;
         end if;

      when Commands.User =>
         if Re_Enter = null then
            Report_Unknown_Command;
         else
            declare
               Match : Boolean := False;
            begin
               ACL.Match (Sites.Identity (Exchange), Arguments, Match);

               if Match then
                  Arguments.Next;
                  Re_Enter (Exchange, Arguments);
               end if;
            end;
         end if;
   end case;
end Natools.Web.Fallback_Render;

------------------------------------------------------------------------------
-- Copyright (c) 2015-2017, 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.           --
------------------------------------------------------------------------------

with Ada.Calendar;
with Natools.S_Expressions.Atom_Refs;
with Natools.S_Expressions.Caches;
with Natools.S_Expressions.Templates.Dates;
with Natools.Static_Maps.Web.Fallback_Render;
with Natools.Web.ACL;
with Natools.Web.Comment_Cookies;
with Natools.Web.Escapes;
with Natools.Web.Filters.Stores;
with Natools.Web.Tags;
with Natools.Web.String_Tables;

procedure Natools.Web.Fallback_Render
  (Exchange : in out Natools.Web.Sites.Exchange;
   Name : in Natools.S_Expressions.Atom;
   Arguments : in out Natools.S_Expressions.Lockable.Descriptor'Class;
   Context : in String := "";
   Re_Enter : access procedure
     (Exchange : in out Natools.Web.Sites.Exchange;
      Expression : in out Natools.S_Expressions.Lockable.Descriptor'Class)
     := null;
   Elements : in Natools.Web.Containers.Expression_Maps.Constant_Map
     := Natools.Web.Containers.Expression_Maps.Empty_Constant_Map;
   Severity : in Severities.Code := Severities.Error)
is
   package Commands renames Natools.Static_Maps.Web.Fallback_Render;
   use type S_Expressions.Events.Event;

   procedure Render_Ref (Ref : in S_Expressions.Atom_Refs.Immutable_Reference);
   procedure Report_Unknown_Command;

   procedure Render_Ref
     (Ref : in S_Expressions.Atom_Refs.Immutable_Reference) is
   begin
      if not Ref.Is_Empty then
         Escapes.Write
           (Exchange,
            S_Expressions.To_String (Ref.Query),
            Escapes.HTML_Attribute);
      elsif Re_Enter /= null then
         Re_Enter (Exchange, Arguments);
      end if;
   end Render_Ref;

   procedure Report_Unknown_Command is
   begin
      if Context /= "" then
         Log (Severity, "Unknown render command """
           & S_Expressions.To_String (Name)
           & """ in "
           & Context);
      end if;
   end Report_Unknown_Command;
begin
   case Commands.To_Command (S_Expressions.To_String (Name)) is
      when Commands.Unknown =>
         Report_Unknown_Command;

      when Commands.Current_Time =>
         S_Expressions.Templates.Dates.Render
           (Exchange, Arguments, Ada.Calendar.Clock);

      when Commands.Cookies =>
         String_Tables.Render
           (Exchange,
            String_Tables.Create (Exchange.Cookie_Table),
            Arguments);

      when Commands.Comment_Cookie_Filter =>
         Render_Ref (Comment_Cookies.Filter (Sites.Comment_Info (Exchange)));

      when Commands.Comment_Cookie_Link =>
         Render_Ref (Comment_Cookies.Link (Sites.Comment_Info (Exchange)));

      when Commands.Comment_Cookie_Mail =>
         Render_Ref (Comment_Cookies.Mail (Sites.Comment_Info (Exchange)));

      when Commands.Comment_Cookie_Name =>
         Render_Ref (Comment_Cookies.Name (Sites.Comment_Info (Exchange)));

      when Commands.Element =>
         if Re_Enter = null then
            Report_Unknown_Command;
         else
            declare
               Template : S_Expressions.Caches.Cursor
                 := Exchange.Site.Get_Template
                    (Elements,
                     Arguments,
                     Lookup_Template => False);
            begin
               Re_Enter (Exchange, Template);
            end;
         end if;

      when Commands.Element_Or_Template =>
         if Re_Enter = null then
            Report_Unknown_Command;
         else
            declare
               Template : S_Expressions.Caches.Cursor
                 := Exchange.Site.Get_Template (Elements, Arguments);
            begin
               Re_Enter (Exchange, Template);
            end;
         end if;

      when Commands.Filter =>
         if Re_Enter = null then
            Report_Unknown_Command;
         elsif Arguments.Current_Event = S_Expressions.Events.Add_Atom then
            begin
               declare
                  Filter : Filters.Filter'Class
                    := Exchange.Site.Get_Filter (Arguments.Current_Atom);
               begin
                  Arguments.Next;
                  Exchange.Insert_Filter (Filter);
                  Re_Enter (Exchange, Arguments);
                  Exchange.Remove_Filter (Filter);
               end;
            exception
               when Filters.Stores.No_Filter => null;
            end;
         end if;

      when Commands.If_Has_Element =>
         if Re_Enter = null then
            Report_Unknown_Command;
         elsif Arguments.Current_Event = S_Expressions.Events.Add_Atom
           and then Elements.Contains (Arguments.Current_Atom)
         then
            Arguments.Next;
            Re_Enter (Exchange, Arguments);
         end if;

      when Commands.If_Has_Not_Element =>
         if Re_Enter = null then
            Report_Unknown_Command;
         elsif Arguments.Current_Event = S_Expressions.Events.Add_Atom
           and then not Elements.Contains (Arguments.Current_Atom)
         then
            Arguments.Next;
            Re_Enter (Exchange, Arguments);
         end if;

      when Commands.If_Parameter_Is =>
         if Re_Enter = null then
            Report_Unknown_Command;
         elsif Arguments.Current_Event = S_Expressions.Events.Add_Atom then
            declare
               Param_Value : constant String := Exchange.Parameter
                 (S_Expressions.To_String (Arguments.Current_Atom));
               Event : S_Expressions.Events.Event;
            begin
               Arguments.Next (Event);
               if Event = S_Expressions.Events.Add_Atom
                 and then Param_Value
                    = S_Expressions.To_String (Arguments.Current_Atom)
               then
                  Arguments.Next;
                  Re_Enter (Exchange, Arguments);
               end if;
            end;
         end if;

      when Commands.Load_Date =>
         S_Expressions.Templates.Dates.Render
           (Exchange, Arguments, Exchange.Site.Load_Date);

      when Commands.Parameter =>
         if Arguments.Current_Event = S_Expressions.Events.Add_Atom then
            declare
               Parameter_Name : constant String
                 := S_Expressions.To_String (Arguments.Current_Atom);
            begin
               if Exchange.Has_Parameter (Parameter_Name) then
                  Escapes.Write
                    (Exchange,
                     Exchange.Parameter (Parameter_Name),
                     Escapes.HTML_Attribute);
               elsif Re_Enter /= null then
                  Arguments.Next;
                  Re_Enter (Exchange, Arguments);
               end if;
            end;
         end if;

      when Commands.Set_MIME_Type =>
         if Arguments.Current_Event = S_Expressions.Events.Add_Atom then
            Exchange.Set_MIME_Type (Arguments.Current_Atom);
         end if;

      when Commands.Tags =>
         Tags.Render (Exchange, Exchange.Site.Get_Tags, Arguments);

      when Commands.Template =>
         if Re_Enter = null then
            Report_Unknown_Command;
         else
            declare
               Template : S_Expressions.Caches.Cursor
                 := Exchange.Site.Get_Template
                    (Elements,
                     Arguments,
                     Lookup_Element => False);
            begin
               Re_Enter (Exchange, Template);
            end;
         end if;

      when Commands.User =>
         if Re_Enter = null then
            Report_Unknown_Command;
         else
            declare
               Match : Boolean := False;
            begin
               ACL.Match (Sites.Identity (Exchange), Arguments, Match);

               if Match then
                  Arguments.Next;
                  Re_Enter (Exchange, Arguments);
               end if;
            end;
         end if;
   end case;
end Natools.Web.Fallback_Render;

add fallback on non-existing parameters

fallback_render: add fallback on non-existing parameters


-----------------------------------------------------------------------
--  security -- Security
--  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.
-----------------------------------------------------------------------

--  == Introduction ==
--  The <tt>Security</tt> package provides a security framework that allows
--  an application to use OpenID or OAuth security frameworks.  This security
--  framework was first developed within the Ada Server Faces project.
--  This package defines abstractions that are close or similar to Java
--  security package.
--
--  === 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.
--
--  @include security-permissions.ads
--  @include security-openid.ads
--  @include security-oauth.ads
--  @include security-contexts.ads
--  @include security-controllers.ads
package Security is

   --  ------------------------------
   --  Principal
   --  ------------------------------
   type Principal is limited interface;
   type Principal_Access is access all Principal'Class;

   --  Get the principal name.
   function Get_Name (From : in Principal) return String is abstract;

end Security;

-----------------------------------------------------------------------
--  security -- Security
--  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.
-----------------------------------------------------------------------

--  == Introduction ==
--  The <tt>Security</tt> package provides a security framework that allows
--  an application to use OpenID or OAuth security frameworks.  This security
--  framework was first developed within the Ada Server Faces project.
--  This package defines abstractions that are close or similar to Java
--  security package.
--
--  === Policy and policy manager ===
--  The <tt>Policy</tt> defines and implements the set of security rules that specify how to
--  protect the system or resources.  The <tt>Policy_Manager</tt> maintains the security policies.
--
--  === 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 policy manager.  The policy manager uses a
--  security controller to enforce the permission.
--
--  === Security Context ===
--  The <tt>Security_Context</tt> holds the contextual information that the security controller
--  can use to verify the permission.  The security context is associated with a principal and
--  a set of policy context.
--
--
--  [http://ada-security.googlecode.com/svn/wiki/ModelOverview.png]
--
--  @include security-permissions.ads
--  @include security-openid.ads
--  @include security-oauth.ads
--  @include security-contexts.ads
--  @include security-controllers.ads
package Security is

   --  ------------------------------
   --  Principal
   --  ------------------------------
   type Principal is limited interface;
   type Principal_Access is access all Principal'Class;

   --  Get the principal name.
   function Get_Name (From : in Principal) return String is abstract;

end Security;

Document the policy and policy manager

Document the policy and policy manager


-----------------------------------------------------------------------
--  mat-expressions -- Expressions for memory slot selection
--  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 MAT.Types;
with MAT.Memory;
package MAT.Expressions is

   type Context_Type is record
      Addr       : MAT.Types.Target_Addr;
      Allocation : MAT.Memory.Allocation;
   end record;

   type Kind_Type is (N_NOT, N_OR, N_AND, N_TRUE, N_FALSE,
                      N_IN_FILE, N_IN_FILE_DIRECT,
                      N_IN_FUNC, N_IN_FUNC_DIRECT,
                      N_RANGE_SIZE, N_RANGE_ADDR,
                      N_CONDITION, N_THREAD);

   type Expression_Type is tagged private;

   --  Create a new expression node.
   function Create (Kind : in Kind_Type;
                    Expr : in Expression_Type) return Expression_Type;

   --  Evaluate the expression to check if the memory slot described by the
   --  context is selected.  Returns True if the memory slot is selected.
   function Is_Selected (Node    : in Expression_Type;
                         Context : in Context_Type) return Boolean;

private

   type Node_Type (Kind : Kind_Type) is tagged limited record
      N : Natural;
   end record;
   type Node_Type_Access is access all Node_Type'Class;

   function Is_Selected (Node    : in Node_Type;
                         Context : in Context_Type) return Boolean;

   type Expression_Type is tagged record
      Node : Node_Type_Access;
   end record;

end MAT.Expressions;

-----------------------------------------------------------------------
--  mat-expressions -- Expressions for memory slot selection
--  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 Ada.Strings.Unbounded;

with MAT.Types;
with MAT.Memory;
package MAT.Expressions is

   type Context_Type is record
      Addr       : MAT.Types.Target_Addr;
      Allocation : MAT.Memory.Allocation;
   end record;

   type Kind_Type is (N_NOT, N_OR, N_AND, N_TRUE, N_FALSE,
                      N_IN_FILE, N_IN_FILE_DIRECT,
                      N_CALL_ADDR, N_CALL_ADDR_DIRECT,
                      N_IN_FUNC, N_IN_FUNC_DIRECT,
                      N_RANGE_SIZE, N_RANGE_ADDR,
                      N_CONDITION, N_THREAD);

   type Expression_Type is tagged private;

   --  Create a new expression node.
   function Create (Kindx : in Kind_Type;
                    Expr : in Expression_Type) return Expression_Type;

   --  Evaluate the expression to check if the memory slot described by the
   --  context is selected.  Returns True if the memory slot is selected.
   function Is_Selected (Node    : in Expression_Type;
                         Context : in Context_Type) return Boolean;

private

   type Node_Type;
   type Node_Type_Access is access all Node_Type'Class;

   type Node_Type (Kind : Kind_Type) is tagged limited record
      case Kind is
         when N_NOT =>
            Expr : Node_Type_Access;

         when N_OR | N_AND =>
            Left, Right : Node_Type_Access;

         when N_IN_FILE | N_IN_FILE_DIRECT | N_IN_FUNC | N_IN_FUNC_DIRECT =>
            Name : Ada.Strings.Unbounded.Unbounded_String;

         when N_RANGE_SIZE =>
            Min_Size : MAT.Types.Target_Size;
            Max_Size : MAT.Types.Target_Size;

         when N_RANGE_ADDR | N_CALL_ADDR | N_CALL_ADDR_DIRECT =>
            Min_Addr : MAT.Types.Target_Addr;
            Max_Addr : MAT.Types.Target_Addr;

         when N_THREAD =>
            Thread : MAT.Types.Target_Thread_Ref;

         when others =>
            null;
      end case;
   end record;

   function Is_Selected (Node    : in Node_Type;
                         Context : in Context_Type) return Boolean;

   type Expression_Type is tagged record
      Node : Node_Type_Access;
   end record;

end MAT.Expressions;

Define the Node_Type

Define the Node_Type


-----------------------------------------------------------------------
--  awa-commands-start -- Command to start the web server
--  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.
-----------------------------------------------------------------------

with GNAT.Command_Line;
with GNAT.Strings;
with AWA.Commands.Drivers;
generic
   with package Command_Drivers is new AWA.Commands.Drivers (<>);
package AWA.Commands.Start is

   type Command_Type is new Command_Drivers.Command_Type with record
      Management_Port   : aliased Integer := 0;
      Listening_Port    : aliased Integer := 8080;
      Upload_Size_Limit : aliased Integer := 16#500_000#;
      Max_Connection    : aliased Integer := 5;
      TCP_No_Delay      : aliased Boolean := False;
      Upload            : aliased GNAT.Strings.String_Access;
   end record;

   --  Start the server and all the application that have been registered.
   overriding
   procedure Execute (Command   : in out Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type);

   --  Setup the command before parsing the arguments and executing it.
   overriding
   procedure Setup (Command : in out Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Context_Type);

   --  Write the help associated with the command.
   overriding
   procedure Help (Command   : in out Command_Type;
                   Name      : in String;
                   Context   : in out Context_Type);

   Command      : aliased Command_Type;

end AWA.Commands.Start;

-----------------------------------------------------------------------
--  awa-commands-start -- Command to start the web server
--  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.
-----------------------------------------------------------------------

with GNAT.Command_Line;
with GNAT.Strings;
with AWA.Commands.Drivers;
generic
   with package Command_Drivers is new AWA.Commands.Drivers (<>);
package AWA.Commands.Start is

   type Command_Type is new Command_Drivers.Command_Type with record
      Management_Port   : aliased Integer := 0;
      Listening_Port    : aliased Integer := 8080;
      Upload_Size_Limit : aliased Integer := 16#500_000#;
      Max_Connection    : aliased Integer := 5;
      TCP_No_Delay      : aliased Boolean := False;
      Daemon            : aliased Boolean := False;
      Upload            : aliased GNAT.Strings.String_Access;
   end record;

   --  Start the server and all the application that have been registered.
   overriding
   procedure Execute (Command   : in out Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type);

   --  Setup the command before parsing the arguments and executing it.
   overriding
   procedure Setup (Command : in out Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Context_Type);

   --  Write the help associated with the command.
   overriding
   procedure Help (Command   : in out Command_Type;
                   Name      : in String;
                   Context   : in out Context_Type);

   Command      : aliased Command_Type;

end AWA.Commands.Start;

Add Daemon boolean

Add Daemon boolean