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

with Ada.Calendar;
with Ada.Calendar.Formatting;

with Util.Beans.Objects;
with Util.Beans.Objects.Enums;
with Util.Beans.Objects.Time;
with Util.Beans.Objects.Discrete_Tests;
package body Util.Beans.Objects.Discretes is

   use Ada.Calendar;

   function "-" (Left, Right : Ada.Calendar.Time) return Ada.Calendar.Time;
   function "+" (Left, Right : Ada.Calendar.Time) return Ada.Calendar.Time;
   function Time_Value (S : String) return Ada.Calendar.Time;

   function "-" (Left, Right : Boolean) return Boolean;
   function "+" (Left, Right : Boolean) return Boolean;

   package Test_Integer is new
     Util.Beans.Objects.Discrete_Tests (Test_Type      => Integer,
                                        To_Type        => Util.Beans.Objects.To_Integer,
                                        To_Object_Test => Util.Beans.Objects.To_Object,
                                        Value          => Integer'Value,
                                        Test_Name      => "Integer",
                                        Test_Values    => "-100,1,0,1,1000");

   package Test_Long_Integer is new
     Util.Beans.Objects.Discrete_Tests (Test_Type      => Long_Integer,
                                To_Type        => Util.Beans.Objects.To_Long_Integer,
                                To_Object_Test => Util.Beans.Objects.To_Object,
                                Value          => Long_Integer'Value,
                                Test_Name      => "Long_Integer",
                                Test_Values    => "-100,1,0,1,1000");

   package Test_Long_Long_Integer is new
     Util.Beans.Objects.Discrete_Tests (Test_Type      => Long_Long_Integer,
                                To_Type        => Util.Beans.Objects.To_Long_Long_Integer,
                                To_Object_Test => Util.Beans.Objects.To_Object,
                                Value          => Long_Long_Integer'Value,
                                Test_Name      => "Long_Long_Integer",
                                Test_Values => "-10000000000000,1,0,1,1000_000_000_000");

   function "-" (Left, Right : Boolean) return Boolean is
   begin
      return Left and Right;
   end "-";

   function "+" (Left, Right : Boolean) return Boolean is
   begin
      return Left or Right;
   end "+";

   package Test_Boolean is new
     Util.Beans.Objects.Discrete_Tests (Test_Type      => Boolean,
                                To_Type        => Util.Beans.Objects.To_Boolean,
                                To_Object_Test => Util.Beans.Objects.To_Object,
                                Value          => Boolean'Value,
                                Test_Name      => "Boolean",
                                Test_Values    => "false,true");

   type Color is (WHITE, BLACK, RED, GREEN, BLUE, YELLOW);

   package Color_Object is new Util.Beans.Objects.Enums (Color, ROUND_VALUE => True);
   function "-" (Left, Right : Color) return Color;
   function "+" (Left, Right : Color) return Color;

   function "-" (Left, Right : Color) return Color is
      N : constant Integer := Color'Pos (Left) - Color'Pos (Right);
   begin
      if N >= 0 then
         return Color'Val ((Color'Pos (WHITE) + N) mod 6);
      else
         return Color'Val ((Color'Pos (WHITE) - N) mod 6);
      end if;
   end "-";

   function "+" (Left, Right : Color) return Color is
      N : constant Integer := Color'Pos (Left) + Color'Pos (Right);
   begin
      return Color'Val ((Color'Pos (WHITE) + N) mod 6);
   end "+";

   package Test_Enum is new
     Util.Beans.Objects.Discrete_Tests (Test_Type      => Color,
                                To_Type        => Color_Object.To_Value,
                                To_Object_Test => Color_Object.To_Object,
                                Value          => Color'Value,
                                Test_Name      => "Color",
                                Test_Values    => "BLACK,RED,GREEN,BLUE,YELLOW");

   Epoch : constant Ada.Calendar.Time :=
     Ada.Calendar.Time_Of (Year    => Year_Number'First,
                           Month   => 1,
                           Day     => 1,
                           Seconds => 12 * 3600.0);

   function Time_Value (S : String) return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Formatting.Value (S);
   end Time_Value;

   --  For the purpose of the time unit test, we need Time + Time operation even
   --  if this does not really makes sense.
   function "+" (Left, Right : Ada.Calendar.Time) return Ada.Calendar.Time is
      T1 : constant Duration := Left - Epoch;
      T2 : constant Duration := Right - Epoch;
   begin
      return (T1 + T2) + Epoch;
   end "+";

   function "-" (Left, Right : Ada.Calendar.Time) return Ada.Calendar.Time is
      T1 : constant Duration := Left - Epoch;
      T2 : constant Duration := Right - Epoch;
   begin
      return (T1 - T2) + Epoch;
   end "-";

   package Test_Time is new
     Util.Beans.Objects.Discrete_Tests (Test_Type      => Ada.Calendar.Time,
                                To_Type        => Util.Beans.Objects.Time.To_Time,
                                To_Object_Test => Util.Beans.Objects.Time.To_Object,
                                Value          => Time_Value,
                                Test_Name      => "Time",
                                Test_Values => "1970-03-04 12:12:00,1975-05-04 13:13:10");

   package Test_Float is new
     Util.Beans.Objects.Discrete_Tests (Test_Type      => Float,
                                To_Type        => Util.Beans.Objects.To_Float,
                                To_Object_Test => Util.Beans.Objects.To_Object,
                                Value          => Float'Value,
                                Test_Name      => "Float",
                                Test_Values    => "1.2,3.3,-3.3");

   package Test_Long_Float is new
     Util.Beans.Objects.Discrete_Tests (Test_Type      => Long_Float,
                                To_Type        => Util.Beans.Objects.To_Long_Float,
                                To_Object_Test => Util.Beans.Objects.To_Object,
                                Value          => Long_Float'Value,
                                Test_Name      => "Long_Float",
                                Test_Values    => "1.2,3.3,-3.3");

   package Test_Long_Long_Float is new
     Util.Beans.Objects.Discrete_Tests (Test_Type      => Long_Long_Float,
                                To_Type        => Util.Beans.Objects.To_Long_Long_Float,
                                To_Object_Test => Util.Beans.Objects.To_Object,
                                Value          => Long_Long_Float'Value,
                                Test_Name      => "Long_Long_Float",
                                Test_Values    => "1.2,3.3,-3.3");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Test_Boolean.Add_Tests (Suite);
      Test_Integer.Add_Tests (Suite);
      Test_Long_Integer.Add_Tests (Suite);
      Test_Long_Long_Integer.Add_Tests (Suite);
      Test_Time.Add_Tests (Suite);
      Test_Float.Add_Tests (Suite);
      Test_Long_Float.Add_Tests (Suite);
      Test_Long_Long_Float.Add_Tests (Suite);
      Test_Enum.Add_Tests (Suite);
   end Add_Tests;

end Util.Beans.Objects.Discretes;

-----------------------------------------------------------------------
--  Util.Beans.Objects.Discretes -- Unit tests for concurrency package
--  Copyright (C) 2009, 2010, 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 Ada.Calendar;
with Ada.Calendar.Formatting;

with Util.Beans.Objects;
with Util.Beans.Objects.Enums;
with Util.Beans.Objects.Time;
with Util.Beans.Objects.Discrete_Tests;
package body Util.Beans.Objects.Discretes is

   use Ada.Calendar;

   function "-" (Left, Right : Ada.Calendar.Time) return Ada.Calendar.Time;
   function "+" (Left, Right : Ada.Calendar.Time) return Ada.Calendar.Time;
   function Time_Value (S : String) return Ada.Calendar.Time;

   function "-" (Left, Right : Boolean) return Boolean;
   function "+" (Left, Right : Boolean) return Boolean;

   package Test_Integer is new
     Util.Beans.Objects.Discrete_Tests (Test_Type      => Integer,
                                        To_Type        => Util.Beans.Objects.To_Integer,
                                        To_Object_Test => Util.Beans.Objects.To_Object,
                                        Value          => Integer'Value,
                                        Test_Name      => "Integer",
                                        Test_Values    => "-100,1,0,1,1000");

   package Test_Duration is new
     Util.Beans.Objects.Discrete_Tests (Test_Type      => Duration,
                                        To_Type        => Util.Beans.Objects.To_Duration,
                                        To_Object_Test => Util.Beans.Objects.To_Object,
                                        Value          => Duration'Value,
                                        Test_Name      => "Duration",
                                        Test_Values    => "-100,1,0,1,1000");

   package Test_Long_Integer is new
     Util.Beans.Objects.Discrete_Tests (Test_Type      => Long_Integer,
                                To_Type        => Util.Beans.Objects.To_Long_Integer,
                                To_Object_Test => Util.Beans.Objects.To_Object,
                                Value          => Long_Integer'Value,
                                Test_Name      => "Long_Integer",
                                Test_Values    => "-100,1,0,1,1000");

   package Test_Long_Long_Integer is new
     Util.Beans.Objects.Discrete_Tests (Test_Type      => Long_Long_Integer,
                                To_Type        => Util.Beans.Objects.To_Long_Long_Integer,
                                To_Object_Test => Util.Beans.Objects.To_Object,
                                Value          => Long_Long_Integer'Value,
                                Test_Name      => "Long_Long_Integer",
                                Test_Values => "-10000000000000,1,0,1,1000_000_000_000");

   function "-" (Left, Right : Boolean) return Boolean is
   begin
      return Left and Right;
   end "-";

   function "+" (Left, Right : Boolean) return Boolean is
   begin
      return Left or Right;
   end "+";

   package Test_Boolean is new
     Util.Beans.Objects.Discrete_Tests (Test_Type      => Boolean,
                                To_Type        => Util.Beans.Objects.To_Boolean,
                                To_Object_Test => Util.Beans.Objects.To_Object,
                                Value          => Boolean'Value,
                                Test_Name      => "Boolean",
                                Test_Values    => "false,true");

   type Color is (WHITE, BLACK, RED, GREEN, BLUE, YELLOW);

   package Color_Object is new Util.Beans.Objects.Enums (Color, ROUND_VALUE => True);
   function "-" (Left, Right : Color) return Color;
   function "+" (Left, Right : Color) return Color;

   function "-" (Left, Right : Color) return Color is
      N : constant Integer := Color'Pos (Left) - Color'Pos (Right);
   begin
      if N >= 0 then
         return Color'Val ((Color'Pos (WHITE) + N) mod 6);
      else
         return Color'Val ((Color'Pos (WHITE) - N) mod 6);
      end if;
   end "-";

   function "+" (Left, Right : Color) return Color is
      N : constant Integer := Color'Pos (Left) + Color'Pos (Right);
   begin
      return Color'Val ((Color'Pos (WHITE) + N) mod 6);
   end "+";

   package Test_Enum is new
     Util.Beans.Objects.Discrete_Tests (Test_Type      => Color,
                                To_Type        => Color_Object.To_Value,
                                To_Object_Test => Color_Object.To_Object,
                                Value          => Color'Value,
                                Test_Name      => "Color",
                                Test_Values    => "BLACK,RED,GREEN,BLUE,YELLOW");

   Epoch : constant Ada.Calendar.Time :=
     Ada.Calendar.Time_Of (Year    => Year_Number'First,
                           Month   => 1,
                           Day     => 1,
                           Seconds => 12 * 3600.0);

   function Time_Value (S : String) return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Formatting.Value (S);
   end Time_Value;

   --  For the purpose of the time unit test, we need Time + Time operation even
   --  if this does not really makes sense.
   function "+" (Left, Right : Ada.Calendar.Time) return Ada.Calendar.Time is
      T1 : constant Duration := Left - Epoch;
      T2 : constant Duration := Right - Epoch;
   begin
      return (T1 + T2) + Epoch;
   end "+";

   function "-" (Left, Right : Ada.Calendar.Time) return Ada.Calendar.Time is
      T1 : constant Duration := Left - Epoch;
      T2 : constant Duration := Right - Epoch;
   begin
      return (T1 - T2) + Epoch;
   end "-";

   package Test_Time is new
     Util.Beans.Objects.Discrete_Tests (Test_Type      => Ada.Calendar.Time,
                                To_Type        => Util.Beans.Objects.Time.To_Time,
                                To_Object_Test => Util.Beans.Objects.Time.To_Object,
                                Value          => Time_Value,
                                Test_Name      => "Time",
                                Test_Values => "1970-03-04 12:12:00,1975-05-04 13:13:10");

   package Test_Float is new
     Util.Beans.Objects.Discrete_Tests (Test_Type      => Float,
                                To_Type        => Util.Beans.Objects.To_Float,
                                To_Object_Test => Util.Beans.Objects.To_Object,
                                Value          => Float'Value,
                                Test_Name      => "Float",
                                Test_Values    => "1.2,3.3,-3.3");

   package Test_Long_Float is new
     Util.Beans.Objects.Discrete_Tests (Test_Type      => Long_Float,
                                To_Type        => Util.Beans.Objects.To_Long_Float,
                                To_Object_Test => Util.Beans.Objects.To_Object,
                                Value          => Long_Float'Value,
                                Test_Name      => "Long_Float",
                                Test_Values    => "1.2,3.3,-3.3");

   package Test_Long_Long_Float is new
     Util.Beans.Objects.Discrete_Tests (Test_Type      => Long_Long_Float,
                                To_Type        => Util.Beans.Objects.To_Long_Long_Float,
                                To_Object_Test => Util.Beans.Objects.To_Object,
                                Value          => Long_Long_Float'Value,
                                Test_Name      => "Long_Long_Float",
                                Test_Values    => "1.2,3.3,-3.3");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Test_Boolean.Add_Tests (Suite);
      Test_Integer.Add_Tests (Suite);
      Test_Long_Integer.Add_Tests (Suite);
      Test_Duration.Add_Tests (Suite);
      Test_Long_Long_Integer.Add_Tests (Suite);
      Test_Time.Add_Tests (Suite);
      Test_Float.Add_Tests (Suite);
      Test_Long_Float.Add_Tests (Suite);
      Test_Long_Long_Float.Add_Tests (Suite);
      Test_Enum.Add_Tests (Suite);
   end Add_Tests;

end Util.Beans.Objects.Discretes;

Add Test_Duration to check Duration types


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

with ASF.Server.Web;
with ASF.Servlets;
with ASF.Servlets.Faces;
with ASF.Servlets.Files;
with ASF.Filters.Dump;
with ASF.Applications;
with ASF.Applications.Main;
with EL.Objects;

with Volume;
procedure Asf_Volume_Server is

   CONTEXT_PATH : constant String := "/volume";

   Factory : ASF.Applications.Main.Application_Factory;
   App     : aliased ASF.Applications.Main.Application;
   Faces   : aliased ASF.Servlets.Faces.Faces_Servlet;
   Files   : aliased ASF.Servlets.Files.File_Servlet;
   Dump    : aliased ASF.Filters.Dump.Dump_Filter;
   Bean    : aliased Volume.Compute_Bean;
   Conv    : constant access Volume.Float_Converter := new Volume.Float_Converter;
   WS      : ASF.Server.Web.AWS_Container;
   C       : ASF.Applications.Config;
begin
   Bean.Radius := 1.2;
   Bean.Height := 2.0;
   C.Set (ASF.Applications.VIEW_EXT, ".html");
   C.Set (ASF.Applications.VIEW_DIR, "samples/web");
   C.Set ("web.dir", "samples/web");

   App.Initialize (C, Factory);
   App.Set_Global ("contextPath", CONTEXT_PATH);
   App.Set_Global ("compute", EL.Objects.To_Object (Bean'Unchecked_Access));

   --  Register the servlets and filters
   App.Add_Servlet (Name => "compute", Server => Faces'Unchecked_Access);
   App.Add_Servlet (Name => "files", Server => Files'Unchecked_Access);
   App.Add_Filter (Name => "dump", Filter => Dump'Unchecked_Access);

   --  Define servlet mappings
   App.Add_Mapping (Name => "compute", Pattern => "*.html");
   App.Add_Mapping (Name => "files", Pattern => "*.css");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "*.html");

   App.Add_Converter (Name => "float", Converter => Conv.all'Unchecked_Access);

   WS.Register_Application (CONTEXT_PATH, App'Unchecked_Access);

   WS.Start;

   delay 600.0;

end Asf_Volume_Server;

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

with ASF.Server.Web;
with ASF.Servlets;
with ASF.Servlets.Faces;
with ASF.Servlets.Files;
with ASF.Filters.Dump;
with ASF.Applications;
with ASF.Applications.Main;
with Util.Beans.Objects;

with Volume;
procedure Asf_Volume_Server is

   CONTEXT_PATH : constant String := "/volume";

   Factory : ASF.Applications.Main.Application_Factory;
   App     : aliased ASF.Applications.Main.Application;
   Faces   : aliased ASF.Servlets.Faces.Faces_Servlet;
   Files   : aliased ASF.Servlets.Files.File_Servlet;
   Dump    : aliased ASF.Filters.Dump.Dump_Filter;
   Bean    : aliased Volume.Compute_Bean;
   Conv    : constant access Volume.Float_Converter := new Volume.Float_Converter;
   WS      : ASF.Server.Web.AWS_Container;
   C       : ASF.Applications.Config;
begin
   Bean.Radius := 1.2;
   Bean.Height := 2.0;
   C.Set (ASF.Applications.VIEW_EXT, ".html");
   C.Set (ASF.Applications.VIEW_DIR, "samples/web");
   C.Set ("web.dir", "samples/web");

   App.Initialize (C, Factory);
   App.Set_Global ("contextPath", CONTEXT_PATH);
   App.Set_Global ("faces", Util.Beans.Objects.To_Object (Bean'Unchecked_Access));

   --  Register the servlets and filters
   App.Add_Servlet (Name => "faces", Server => Faces'Unchecked_Access);
   App.Add_Servlet (Name => "files", Server => Files'Unchecked_Access);
   App.Add_Filter (Name => "dump", Filter => Dump'Unchecked_Access);

   --  Define servlet mappings
   App.Add_Mapping (Name => "faces", Pattern => "*.html");
   App.Add_Mapping (Name => "files", Pattern => "*.css");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "*.html");

   App.Add_Converter (Name => "float", Converter => Conv.all'Unchecked_Access);

   WS.Register_Application (CONTEXT_PATH, App'Unchecked_Access);

   WS.Start;

   delay 600.0;

end Asf_Volume_Server;

Rename servlet and cleanup

Rename servlet and cleanup


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

with Interfaces;

with Ada.IO_Exceptions;
with Ada.Directories;
with Ada.Unchecked_Deallocation;

with ADO.Drivers.Connections;

with Util.Files;
with Util.Log.Loggers;
with Util.Beans.Objects;
with Util.Serialize.IO.XML;
with Util.Serialize.Mappers.Record_Mapper;
package body ADO.Queries.Loaders is

   use Util.Log;
   use ADO.Drivers.Connections;
   use Interfaces;
   use Ada.Calendar;

   Log : constant Loggers.Logger := Loggers.Create ("ADO.Queries.Loaders");

   Base_Time : constant Ada.Calendar.Time := Ada.Calendar.Time_Of (Year  => 1970,
                                                                   Month => 1,
                                                                   Day   => 1);

   --  Check for file modification time at most every 60 seconds.
   FILE_CHECK_DELTA_TIME : constant Unsigned_32 := 60;

   --  The list of query files defined by the application.
   Query_Files : Query_File_Access := null;

--     Query_List  : Query_Definition_Access := null;

   --  Convert a Time to an Unsigned_32.
   function To_Unsigned_32 (T : in Ada.Calendar.Time) return Unsigned_32;
   pragma Inline_Always (To_Unsigned_32);

   --  Get the modification time of the XML query file associated with the query.
   function Modification_Time (Query : in Query_Definition_Access) return Unsigned_32;

   --  Initialize the query SQL pattern with the value
   procedure Set_Query_Pattern (Into  : in out Query_Pattern;
                                Value : in Util.Beans.Objects.Object);

   --  ------------------------------
   --  Register the query definition in the query file.  Registration is done
   --  in the package elaboration phase.
   --  ------------------------------
   procedure Register (File  : in Query_File_Access;
                       Query : in Query_Definition_Access) is
   begin
      Query.File   := File;
      Query.Next   := File.Queries;
      File.Queries := Query;
      if File.Next = null and then Query_Files /= File then
         File.Next := Query_Files;
         Query_Files := File;
      end if;
   end Register;

   function Find_Driver (Name : in String) return Integer;

   function Find_Driver (Name : in String) return Integer is
   begin
      if Name'Length = 0 then
         return 0;
      end if;
      declare
         Driver : constant Drivers.Connections.Driver_Access
           := Drivers.Connections.Get_Driver (Name);
      begin
         if Driver = null then
            --  There is no problem to have an SQL query for unsupported drivers, but still
            --  report some warning.
            Log.Warn ("Database driver {0} not found", Name);
            return -1;
         end if;
         return Integer (Driver.Get_Driver_Index);
      end;
   end Find_Driver;

   --  ------------------------------
   --  Convert a Time to an Unsigned_32.
   --  ------------------------------
   function To_Unsigned_32 (T : in Ada.Calendar.Time) return Unsigned_32 is
      D : constant Duration := Duration '(T - Base_Time);
   begin
      return Unsigned_32 (D);
   end To_Unsigned_32;

   --  ------------------------------
   --  Get the modification time of the XML query file associated with the query.
   --  ------------------------------
   function Modification_Time (Query : in Query_Definition_Access) return Unsigned_32 is
   begin
      return To_Unsigned_32 (Ada.Directories.Modification_Time (Query.File.Path.all));

   exception
      when Ada.IO_Exceptions.Name_Error =>
         Log.Error ("XML query file '{0}' does not exist", Query.File.Path.all);
         return 0;
   end Modification_Time;

   --  ------------------------------
   --  Returns True if the XML query file must be reloaded.
   --  ------------------------------
   function Is_Modified (Query : in Query_Definition_Access) return Boolean is
      Now : constant Unsigned_32 := To_Unsigned_32 (Ada.Calendar.Clock);
   begin
      --  Have we passed the next check time?
      if Query.File.Next_Check > Now then
         return False;
      end if;

      --  Next check in N seconds (60 by default).
      Query.File.Next_Check := Now + FILE_CHECK_DELTA_TIME;

      --  See if the file was changed.
      declare
         M : constant Unsigned_32 := Modification_Time (Query);
      begin
         if Query.File.Last_Modified = M then
            return False;
         end if;
         Query.File.Last_Modified := M;
         return True;
      end;
   end Is_Modified;

   --  ------------------------------
   --  Initialize the query SQL pattern with the value
   --  ------------------------------
   procedure Set_Query_Pattern (Into  : in out Query_Pattern;
                                Value : in Util.Beans.Objects.Object) is
   begin
      Into.SQL := Util.Beans.Objects.To_Unbounded_String (Value);
   end Set_Query_Pattern;

   procedure Read_Query (Into : in Query_File_Access) is

      type Query_Info_Fields is (FIELD_CLASS_NAME, FIELD_PROPERTY_TYPE,
                                 FIELD_PROPERTY_NAME, FIELD_QUERY_NAME,
                                 FIELD_SQL_DRIVER,
                                 FIELD_SQL, FIELD_SQL_COUNT);

      --  The Query_Loader holds context and state information for loading
      --  the XML query file and initializing the Query_Definition.
      type Query_Loader is record
         File       : Query_File_Access;
         Hash_Value : Unbounded_String;
         Query_Def  : Query_Definition_Access;
         Query      : Query_Info_Access;
         Driver     : Integer;
      end record;
      type Query_Loader_Access is access all Query_Loader;

      procedure Set_Member (Into  : in out Query_Loader;
                            Field : in Query_Info_Fields;
                            Value : in Util.Beans.Objects.Object);

      --  ------------------------------
      --  Called by the de-serialization when a given field is recognized.
      --  ------------------------------
      procedure Set_Member (Into  : in out Query_Loader;
                            Field : in Query_Info_Fields;
                            Value : in Util.Beans.Objects.Object) is
      begin
         case Field is
         when FIELD_CLASS_NAME =>
            Append (Into.Hash_Value, " class=");
            Append (Into.Hash_Value, Util.Beans.Objects.To_Unbounded_String (Value));

         when FIELD_PROPERTY_TYPE =>
            Append (Into.Hash_Value, " type=");
            Append (Into.Hash_Value, Util.Beans.Objects.To_Unbounded_String (Value));

         when FIELD_PROPERTY_NAME =>
            Append (Into.Hash_Value, " name=");
            Append (Into.Hash_Value, Util.Beans.Objects.To_Unbounded_String (Value));

         when FIELD_QUERY_NAME =>
            Into.Query_Def  := Find_Query (Into.File.all, Util.Beans.Objects.To_String (Value));
            Into.Driver := 0;
            Into.Query := null;
            if Into.Query_Def /= null then
               Into.Query := new Query_Info;
               Into.Query_Def.Query := Into.Query;
            end if;

         when FIELD_SQL_DRIVER =>
            Into.Driver := Find_Driver (Util.Beans.Objects.To_String (Value));

         when FIELD_SQL =>
            if Into.Query /= null and Into.Driver >= 0 then
               Set_Query_Pattern (Into.Query.Main_Query (ADO.Drivers.Driver_Index (Into.Driver)),
                                  Value);
            end if;
            Into.Driver := 0;

         when FIELD_SQL_COUNT =>
            if Into.Query /= null and Into.Driver >= 0 then
               Set_Query_Pattern (Into.Query.Count_Query (ADO.Drivers.Driver_Index (Into.Driver)),
                                  Value);
            end if;
            Into.Driver := 0;

         end case;
      end Set_Member;

      package Query_Mapper is
        new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Query_Loader,
                                                  Element_Type_Access => Query_Loader_Access,
                                                  Fields              => Query_Info_Fields,
                                                  Set_Member          => Set_Member);

      Loader     : aliased Query_Loader;
      Sql_Mapper : aliased Query_Mapper.Mapper;
      Reader     : Util.Serialize.IO.XML.Parser;
   begin
      Log.Info ("Reading XML query {0}", Into.Path.all);
      Loader.File   := Into;
      Loader.Driver := 0;

      --  Create the mapping to load the XML query file.
      Sql_Mapper.Add_Mapping ("class/@name", FIELD_CLASS_NAME);
      Sql_Mapper.Add_Mapping ("class/property/@type", FIELD_PROPERTY_TYPE);
      Sql_Mapper.Add_Mapping ("class/property/@name", FIELD_PROPERTY_NAME);
      Sql_Mapper.Add_Mapping ("query/@name", FIELD_QUERY_NAME);
      Sql_Mapper.Add_Mapping ("query/sql", FIELD_SQL);
      Sql_Mapper.Add_Mapping ("query/sql/@driver", FIELD_SQL_DRIVER);
      Sql_Mapper.Add_Mapping ("query/sql-count", FIELD_SQL_COUNT);
      Reader.Add_Mapping ("query-mapping", Sql_Mapper'Unchecked_Access);

      --  Set the context for Set_Member.
      Query_Mapper.Set_Context (Reader, Loader'Access);

      --  Read the XML query file.
      Reader.Parse (Into.Path.all);

      Into.Next_Check := To_Unsigned_32 (Ada.Calendar.Clock) + FILE_CHECK_DELTA_TIME;

   exception
      when Ada.IO_Exceptions.Name_Error =>
         Log.Error ("XML query file '{0}' does not exist", Into.Path.all);

   end Read_Query;

   --  ------------------------------
   --  Read the query definition.
   --  ------------------------------
   procedure Read_Query (Into : in Query_Definition_Access) is
   begin
      if Into.Query = null or else Is_Modified (Into)  then
         Read_Query (Into.File);
      end if;
   end Read_Query;

   --  ------------------------------
   --  Initialize the queries to look in the list of directories specified by Paths.
   --  Each search directory is separated by ';' (yes, even on Unix).
   --  When Load is true, read the XML query file and initialize the query
   --  definitions from that file.
   --  ------------------------------
   procedure Initialize (Paths : in String;
                         Load  : in Boolean) is
      procedure Free is
         new Ada.Unchecked_Deallocation (Object => String,
                                         Name   => Ada.Strings.Unbounded.String_Access);

      File : Query_File_Access := Query_Files;
   begin
      Log.Info ("Initializing query search paths to {0}", Paths);

      while File /= null loop
         declare
            Path : constant String := Util.Files.Find_File_Path (Name  => File.Name.all,
                                                                 Paths => Paths);
         begin
            Free (File.Path);
            File.Path := new String '(Path);
            if Load then
               Read_Query (File);
            end if;
         end;
         File := File.Next;
      end loop;
   end Initialize;

   --  ------------------------------
   --  Find the query identified by the given name.
   --  ------------------------------
   function Find_Query (Name : in String) return Query_Definition_Access is
      File : Query_File_Access := Query_Files;
   begin
      while File /= null loop
         declare
            Query : Query_Definition_Access := File.Queries;
         begin
            while Query /= null loop
               if Query.Name.all = Name then
                  return Query;
               end if;
               Query := Query.Next;
            end loop;
         end;
         File := File.Next;
      end loop;
      Log.Warn ("Query {0} not found", Name);
      return null;
   end Find_Query;

   package body Query is
   begin
      Register (File  => File, Query => Query'Access);
   end Query;

end ADO.Queries.Loaders;

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

with Interfaces;

with Ada.IO_Exceptions;
with Ada.Directories;
with Ada.Unchecked_Deallocation;

with ADO.Drivers.Connections;

with Util.Files;
with Util.Log.Loggers;
with Util.Beans.Objects;
with Util.Serialize.IO.XML;
with Util.Serialize.Mappers.Record_Mapper;
package body ADO.Queries.Loaders is

   use Util.Log;
   use ADO.Drivers.Connections;
   use Interfaces;
   use Ada.Calendar;

   Log : constant Loggers.Logger := Loggers.Create ("ADO.Queries.Loaders");

   Base_Time : constant Ada.Calendar.Time := Ada.Calendar.Time_Of (Year  => 1970,
                                                                   Month => 1,
                                                                   Day   => 1);

   --  Check for file modification time at most every 60 seconds.
   FILE_CHECK_DELTA_TIME : constant Unsigned_32 := 60;

   --  The list of query files defined by the application.
   Query_Files : Query_File_Access := null;

   --  Convert a Time to an Unsigned_32.
   function To_Unsigned_32 (T : in Ada.Calendar.Time) return Unsigned_32;
   pragma Inline_Always (To_Unsigned_32);

   --  Get the modification time of the XML query file associated with the query.
   function Modification_Time (Query : in Query_Definition_Access) return Unsigned_32;

   --  Initialize the query SQL pattern with the value
   procedure Set_Query_Pattern (Into  : in out Query_Pattern;
                                Value : in Util.Beans.Objects.Object);

   --  ------------------------------
   --  Register the query definition in the query file.  Registration is done
   --  in the package elaboration phase.
   --  ------------------------------
   procedure Register (File  : in Query_File_Access;
                       Query : in Query_Definition_Access) is
   begin
      Query.File   := File;
      Query.Next   := File.Queries;
      File.Queries := Query;
      if File.Next = null and then Query_Files /= File then
         File.Next := Query_Files;
         Query_Files := File;
      end if;
   end Register;

   function Find_Driver (Name : in String) return Integer;

   function Find_Driver (Name : in String) return Integer is
   begin
      if Name'Length = 0 then
         return 0;
      end if;
      declare
         Driver : constant Drivers.Connections.Driver_Access
           := Drivers.Connections.Get_Driver (Name);
      begin
         if Driver = null then
            --  There is no problem to have an SQL query for unsupported drivers, but still
            --  report some warning.
            Log.Warn ("Database driver {0} not found", Name);
            return -1;
         end if;
         return Integer (Driver.Get_Driver_Index);
      end;
   end Find_Driver;

   --  ------------------------------
   --  Convert a Time to an Unsigned_32.
   --  ------------------------------
   function To_Unsigned_32 (T : in Ada.Calendar.Time) return Unsigned_32 is
      D : constant Duration := Duration '(T - Base_Time);
   begin
      return Unsigned_32 (D);
   end To_Unsigned_32;

   --  ------------------------------
   --  Get the modification time of the XML query file associated with the query.
   --  ------------------------------
   function Modification_Time (Query : in Query_Definition_Access) return Unsigned_32 is
   begin
      return To_Unsigned_32 (Ada.Directories.Modification_Time (Query.File.Path.all));

   exception
      when Ada.IO_Exceptions.Name_Error =>
         Log.Error ("XML query file '{0}' does not exist", Query.File.Path.all);
         return 0;
   end Modification_Time;

   --  ------------------------------
   --  Returns True if the XML query file must be reloaded.
   --  ------------------------------
   function Is_Modified (Query : in Query_Definition_Access) return Boolean is
      Now : constant Unsigned_32 := To_Unsigned_32 (Ada.Calendar.Clock);
   begin
      --  Have we passed the next check time?
      if Query.File.Next_Check > Now then
         return False;
      end if;

      --  Next check in N seconds (60 by default).
      Query.File.Next_Check := Now + FILE_CHECK_DELTA_TIME;

      --  See if the file was changed.
      declare
         M : constant Unsigned_32 := Modification_Time (Query);
      begin
         if Query.File.Last_Modified = M then
            return False;
         end if;
         Query.File.Last_Modified := M;
         return True;
      end;
   end Is_Modified;

   --  ------------------------------
   --  Initialize the query SQL pattern with the value
   --  ------------------------------
   procedure Set_Query_Pattern (Into  : in out Query_Pattern;
                                Value : in Util.Beans.Objects.Object) is
   begin
      Into.SQL := Util.Beans.Objects.To_Unbounded_String (Value);
   end Set_Query_Pattern;

   procedure Read_Query (Into : in Query_File_Access) is

      type Query_Info_Fields is (FIELD_CLASS_NAME, FIELD_PROPERTY_TYPE,
                                 FIELD_PROPERTY_NAME, FIELD_QUERY_NAME,
                                 FIELD_SQL_DRIVER,
                                 FIELD_SQL, FIELD_SQL_COUNT);

      --  The Query_Loader holds context and state information for loading
      --  the XML query file and initializing the Query_Definition.
      type Query_Loader is record
         File       : Query_File_Access;
         Hash_Value : Unbounded_String;
         Query_Def  : Query_Definition_Access;
         Query      : Query_Info_Access;
         Driver     : Integer;
      end record;
      type Query_Loader_Access is access all Query_Loader;

      procedure Set_Member (Into  : in out Query_Loader;
                            Field : in Query_Info_Fields;
                            Value : in Util.Beans.Objects.Object);

      --  ------------------------------
      --  Called by the de-serialization when a given field is recognized.
      --  ------------------------------
      procedure Set_Member (Into  : in out Query_Loader;
                            Field : in Query_Info_Fields;
                            Value : in Util.Beans.Objects.Object) is
      begin
         case Field is
         when FIELD_CLASS_NAME =>
            Append (Into.Hash_Value, " class=");
            Append (Into.Hash_Value, Util.Beans.Objects.To_Unbounded_String (Value));

         when FIELD_PROPERTY_TYPE =>
            Append (Into.Hash_Value, " type=");
            Append (Into.Hash_Value, Util.Beans.Objects.To_Unbounded_String (Value));

         when FIELD_PROPERTY_NAME =>
            Append (Into.Hash_Value, " name=");
            Append (Into.Hash_Value, Util.Beans.Objects.To_Unbounded_String (Value));

         when FIELD_QUERY_NAME =>
            Into.Query_Def  := Find_Query (Into.File.all, Util.Beans.Objects.To_String (Value));
            Into.Driver := 0;
            Into.Query := null;
            if Into.Query_Def /= null then
               Into.Query := new Query_Info;
               Into.Query_Def.Query := Into.Query;
            end if;

         when FIELD_SQL_DRIVER =>
            Into.Driver := Find_Driver (Util.Beans.Objects.To_String (Value));

         when FIELD_SQL =>
            if Into.Query /= null and Into.Driver >= 0 then
               Set_Query_Pattern (Into.Query.Main_Query (ADO.Drivers.Driver_Index (Into.Driver)),
                                  Value);
            end if;
            Into.Driver := 0;

         when FIELD_SQL_COUNT =>
            if Into.Query /= null and Into.Driver >= 0 then
               Set_Query_Pattern (Into.Query.Count_Query (ADO.Drivers.Driver_Index (Into.Driver)),
                                  Value);
            end if;
            Into.Driver := 0;

         end case;
      end Set_Member;

      package Query_Mapper is
        new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Query_Loader,
                                                  Element_Type_Access => Query_Loader_Access,
                                                  Fields              => Query_Info_Fields,
                                                  Set_Member          => Set_Member);

      Loader     : aliased Query_Loader;
      Sql_Mapper : aliased Query_Mapper.Mapper;
      Reader     : Util.Serialize.IO.XML.Parser;
   begin
      Log.Info ("Reading XML query {0}", Into.Path.all);
      Loader.File   := Into;
      Loader.Driver := 0;

      --  Create the mapping to load the XML query file.
      Sql_Mapper.Add_Mapping ("class/@name", FIELD_CLASS_NAME);
      Sql_Mapper.Add_Mapping ("class/property/@type", FIELD_PROPERTY_TYPE);
      Sql_Mapper.Add_Mapping ("class/property/@name", FIELD_PROPERTY_NAME);
      Sql_Mapper.Add_Mapping ("query/@name", FIELD_QUERY_NAME);
      Sql_Mapper.Add_Mapping ("query/sql", FIELD_SQL);
      Sql_Mapper.Add_Mapping ("query/sql/@driver", FIELD_SQL_DRIVER);
      Sql_Mapper.Add_Mapping ("query/sql-count", FIELD_SQL_COUNT);
      Reader.Add_Mapping ("query-mapping", Sql_Mapper'Unchecked_Access);

      --  Set the context for Set_Member.
      Query_Mapper.Set_Context (Reader, Loader'Access);

      --  Read the XML query file.
      Reader.Parse (Into.Path.all);

      Into.Next_Check := To_Unsigned_32 (Ada.Calendar.Clock) + FILE_CHECK_DELTA_TIME;

   exception
      when Ada.IO_Exceptions.Name_Error =>
         Log.Error ("XML query file '{0}' does not exist", Into.Path.all);

   end Read_Query;

   --  ------------------------------
   --  Read the query definition.
   --  ------------------------------
   procedure Read_Query (Into : in Query_Definition_Access) is
   begin
      if Into.Query = null or else Is_Modified (Into)  then
         Read_Query (Into.File);
      end if;
   end Read_Query;

   --  ------------------------------
   --  Initialize the queries to look in the list of directories specified by Paths.
   --  Each search directory is separated by ';' (yes, even on Unix).
   --  When Load is true, read the XML query file and initialize the query
   --  definitions from that file.
   --  ------------------------------
   procedure Initialize (Paths : in String;
                         Load  : in Boolean) is
      procedure Free is
         new Ada.Unchecked_Deallocation (Object => String,
                                         Name   => Ada.Strings.Unbounded.String_Access);

      File : Query_File_Access := Query_Files;
   begin
      Log.Info ("Initializing query search paths to {0}", Paths);

      while File /= null loop
         declare
            Path : constant String := Util.Files.Find_File_Path (Name  => File.Name.all,
                                                                 Paths => Paths);
         begin
            Free (File.Path);
            File.Path := new String '(Path);
            if Load then
               Read_Query (File);
            end if;
         end;
         File := File.Next;
      end loop;
   end Initialize;

   --  ------------------------------
   --  Find the query identified by the given name.
   --  ------------------------------
   function Find_Query (Name : in String) return Query_Definition_Access is
      File : Query_File_Access := Query_Files;
   begin
      while File /= null loop
         declare
            Query : Query_Definition_Access := File.Queries;
         begin
            while Query /= null loop
               if Query.Name.all = Name then
                  return Query;
               end if;
               Query := Query.Next;
            end loop;
         end;
         File := File.Next;
      end loop;
      Log.Warn ("Query {0} not found", Name);
      return null;
   end Find_Query;

   package body Query is
   begin
      Register (File  => File, Query => Query'Access);
   end Query;

end ADO.Queries.Loaders;

Remove unused code

Remove unused code


-----------------------------------------------------------------------
--  ado-queries-loaders -- Loader for Database Queries
--  Copyright (C) 2011, 2012, 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 Interfaces;

with Ada.IO_Exceptions;
with Ada.Directories;
with Ada.Unchecked_Deallocation;

with ADO.Drivers.Connections;

with Util.Files;
with Util.Log.Loggers;
with Util.Beans.Objects;
with Util.Serialize.IO.XML;
with Util.Serialize.Mappers.Record_Mapper;
package body ADO.Queries.Loaders is

   use Util.Log;
   use ADO.Drivers.Connections;
   use Interfaces;
   use Ada.Calendar;

   Log : constant Loggers.Logger := Loggers.Create ("ADO.Queries.Loaders");

   Base_Time : constant Ada.Calendar.Time := Ada.Calendar.Time_Of (Year  => 1970,
                                                                   Month => 1,
                                                                   Day   => 1);

   --  Check for file modification time at most every 60 seconds.
   FILE_CHECK_DELTA_TIME : constant Unsigned_32 := 60;

   --  The list of query files defined by the application.
   Query_Files : Query_File_Access := null;

   --  Convert a Time to an Unsigned_32.
   function To_Unsigned_32 (T : in Ada.Calendar.Time) return Unsigned_32;
   pragma Inline_Always (To_Unsigned_32);

   --  Get the modification time of the XML query file associated with the query.
   function Modification_Time (Query : in Query_Definition_Access) return Unsigned_32;

   --  Initialize the query SQL pattern with the value
   procedure Set_Query_Pattern (Into  : in out Query_Pattern;
                                Value : in Util.Beans.Objects.Object);

   --  ------------------------------
   --  Register the query definition in the query file.  Registration is done
   --  in the package elaboration phase.
   --  ------------------------------
   procedure Register (File  : in Query_File_Access;
                       Query : in Query_Definition_Access) is
   begin
      Query.File   := File;
      Query.Next   := File.Queries;
      File.Queries := Query;
      if File.Next = null and then Query_Files /= File then
         File.Next := Query_Files;
         Query_Files := File;
      end if;
   end Register;

   function Find_Driver (Name : in String) return Integer;

   function Find_Driver (Name : in String) return Integer is
   begin
      if Name'Length = 0 then
         return 0;
      end if;
      declare
         Driver : constant Drivers.Connections.Driver_Access
           := Drivers.Connections.Get_Driver (Name);
      begin
         if Driver = null then
            --  There is no problem to have an SQL query for unsupported drivers, but still
            --  report some warning.
            Log.Warn ("Database driver {0} not found", Name);
            return -1;
         end if;
         return Integer (Driver.Get_Driver_Index);
      end;
   end Find_Driver;

   --  ------------------------------
   --  Convert a Time to an Unsigned_32.
   --  ------------------------------
   function To_Unsigned_32 (T : in Ada.Calendar.Time) return Unsigned_32 is
      D : constant Duration := Duration '(T - Base_Time);
   begin
      return Unsigned_32 (D);
   end To_Unsigned_32;

   --  ------------------------------
   --  Get the modification time of the XML query file associated with the query.
   --  ------------------------------
   function Modification_Time (Query : in Query_Definition_Access) return Unsigned_32 is
   begin
      return To_Unsigned_32 (Ada.Directories.Modification_Time (Query.File.Path.all));

   exception
      when Ada.IO_Exceptions.Name_Error =>
         Log.Error ("XML query file '{0}' does not exist", Query.File.Path.all);
         return 0;
   end Modification_Time;

   --  ------------------------------
   --  Returns True if the XML query file must be reloaded.
   --  ------------------------------
   function Is_Modified (Query : in Query_Definition_Access) return Boolean is
      Now : constant Unsigned_32 := To_Unsigned_32 (Ada.Calendar.Clock);
   begin
      --  Have we passed the next check time?
      if Query.File.Next_Check > Now then
         return False;
      end if;

      --  Next check in N seconds (60 by default).
      Query.File.Next_Check := Now + FILE_CHECK_DELTA_TIME;

      --  See if the file was changed.
      declare
         M : constant Unsigned_32 := Modification_Time (Query);
      begin
         if Query.File.Last_Modified = M then
            return False;
         end if;
         Query.File.Last_Modified := M;
         return True;
      end;
   end Is_Modified;

   --  ------------------------------
   --  Initialize the query SQL pattern with the value
   --  ------------------------------
   procedure Set_Query_Pattern (Into  : in out Query_Pattern;
                                Value : in Util.Beans.Objects.Object) is
   begin
      Into.SQL := Util.Beans.Objects.To_Unbounded_String (Value);
   end Set_Query_Pattern;

   procedure Read_Query (Into : in Query_File_Access) is

      type Query_Info_Fields is (FIELD_CLASS_NAME, FIELD_PROPERTY_TYPE,
                                 FIELD_PROPERTY_NAME, FIELD_QUERY_NAME,
                                 FIELD_SQL_DRIVER,
                                 FIELD_SQL, FIELD_SQL_COUNT, FIELD_QUERY);

      --  The Query_Loader holds context and state information for loading
      --  the XML query file and initializing the Query_Definition.
      type Query_Loader is record
         File       : Query_File_Access;
         Hash_Value : Unbounded_String;
         Query_Def  : Query_Definition_Access;
         Query      : Query_Info_Ref.Ref;
         Driver     : Integer;
      end record;
      type Query_Loader_Access is access all Query_Loader;

      procedure Set_Member (Into  : in out Query_Loader;
                            Field : in Query_Info_Fields;
                            Value : in Util.Beans.Objects.Object);

      --  ------------------------------
      --  Called by the de-serialization when a given field is recognized.
      --  ------------------------------
      procedure Set_Member (Into  : in out Query_Loader;
                            Field : in Query_Info_Fields;
                            Value : in Util.Beans.Objects.Object) is
         use ADO.Drivers;
      begin
         case Field is
         when FIELD_CLASS_NAME =>
            Append (Into.Hash_Value, " class=");
            Append (Into.Hash_Value, Util.Beans.Objects.To_Unbounded_String (Value));

         when FIELD_PROPERTY_TYPE =>
            Append (Into.Hash_Value, " type=");
            Append (Into.Hash_Value, Util.Beans.Objects.To_Unbounded_String (Value));

         when FIELD_PROPERTY_NAME =>
            Append (Into.Hash_Value, " name=");
            Append (Into.Hash_Value, Util.Beans.Objects.To_Unbounded_String (Value));

         when FIELD_QUERY_NAME =>
            Into.Query_Def  := Find_Query (Into.File.all, Util.Beans.Objects.To_String (Value));
            Into.Driver := 0;
            if Into.Query_Def /= null then
               Into.Query := Query_Info_Ref.Create;
            end if;

         when FIELD_SQL_DRIVER =>
            Into.Driver := Find_Driver (Util.Beans.Objects.To_String (Value));

         when FIELD_SQL =>
            if not Into.Query.Is_Null and Into.Driver >= 0 and Into.Query_Def /= null then
               Set_Query_Pattern (Into.Query.Value.Main_Query (Driver_Index (Into.Driver)),
                                  Value);
            end if;
            Into.Driver := 0;

         when FIELD_SQL_COUNT =>
            if not Into.Query.Is_Null and Into.Driver >= 0 and Into.Query_Def /= null then
               Set_Query_Pattern (Into.Query.Value.Count_Query (Driver_Index (Into.Driver)),
                                  Value);
            end if;
            Into.Driver := 0;

         when FIELD_QUERY =>
            if Into.Query_Def /= null then
               --  Now we can safely setup the query info associated with the query definition.
               Into.Query_Def.Query.Set (Into.Query);
            end if;
            Into.Query_Def := null;

         end case;
      end Set_Member;

      package Query_Mapper is
        new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Query_Loader,
                                                  Element_Type_Access => Query_Loader_Access,
                                                  Fields              => Query_Info_Fields,
                                                  Set_Member          => Set_Member);

      Loader     : aliased Query_Loader;
      Sql_Mapper : aliased Query_Mapper.Mapper;
      Reader     : Util.Serialize.IO.XML.Parser;
   begin
      Log.Info ("Reading XML query {0}", Into.Path.all);
      Loader.File   := Into;
      Loader.Driver := 0;

      --  Create the mapping to load the XML query file.
      Sql_Mapper.Add_Mapping ("class/@name", FIELD_CLASS_NAME);
      Sql_Mapper.Add_Mapping ("class/property/@type", FIELD_PROPERTY_TYPE);
      Sql_Mapper.Add_Mapping ("class/property/@name", FIELD_PROPERTY_NAME);
      Sql_Mapper.Add_Mapping ("query/@name", FIELD_QUERY_NAME);
      Sql_Mapper.Add_Mapping ("query/sql", FIELD_SQL);
      Sql_Mapper.Add_Mapping ("query/sql/@driver", FIELD_SQL_DRIVER);
      Sql_Mapper.Add_Mapping ("query/sql-count", FIELD_SQL_COUNT);
      Sql_Mapper.Add_Mapping ("query", FIELD_QUERY);
      Reader.Add_Mapping ("query-mapping", Sql_Mapper'Unchecked_Access);

      --  Set the context for Set_Member.
      Query_Mapper.Set_Context (Reader, Loader'Access);

      --  Read the XML query file.
      Reader.Parse (Into.Path.all);

      Into.Next_Check := To_Unsigned_32 (Ada.Calendar.Clock) + FILE_CHECK_DELTA_TIME;

   exception
      when Ada.IO_Exceptions.Name_Error =>
         Log.Error ("XML query file '{0}' does not exist", Into.Path.all);

   end Read_Query;

   --  ------------------------------
   --  Read the query definition.
   --  ------------------------------
   procedure Read_Query (Into : in Query_Definition_Access) is
   begin
      if Into.Query = null or else Is_Modified (Into)  then
         Read_Query (Into.File);
      end if;
   end Read_Query;

   --  ------------------------------
   --  Initialize the queries to look in the list of directories specified by Paths.
   --  Each search directory is separated by ';' (yes, even on Unix).
   --  When Load is true, read the XML query file and initialize the query
   --  definitions from that file.
   --  ------------------------------
   procedure Initialize (Paths : in String;
                         Load  : in Boolean) is
      procedure Free is
         new Ada.Unchecked_Deallocation (Object => String,
                                         Name   => Ada.Strings.Unbounded.String_Access);

      File : Query_File_Access := Query_Files;
   begin
      Log.Info ("Initializing query search paths to {0}", Paths);

      while File /= null loop
         declare
            Path : constant String := Util.Files.Find_File_Path (Name  => File.Name.all,
                                                                 Paths => Paths);
            Query : Query_Definition_Access := File.Queries;
         begin
            Free (File.Path);
            File.Path := new String '(Path);

            --  Allocate the atomic reference for each query.
            while Query /= null loop
               if Query.Query = null then
                  Query.Query := new Query_Info_Ref.Atomic_Ref;
               end if;
               Query := Query.Next;
            end loop;
            if Load then
               Read_Query (File);
            end if;
         end;
         File := File.Next;
      end loop;
   end Initialize;

   --  ------------------------------
   --  Find the query identified by the given name.
   --  ------------------------------
   function Find_Query (Name : in String) return Query_Definition_Access is
      File : Query_File_Access := Query_Files;
   begin
      while File /= null loop
         declare
            Query : Query_Definition_Access := File.Queries;
         begin
            while Query /= null loop
               if Query.Name.all = Name then
                  return Query;
               end if;
               Query := Query.Next;
            end loop;
         end;
         File := File.Next;
      end loop;
      Log.Warn ("Query {0} not found", Name);
      return null;
   end Find_Query;

   package body Query is
   begin
      Register (File  => File, Query => Query'Access);
   end Query;

end ADO.Queries.Loaders;

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

with Interfaces;

with Ada.IO_Exceptions;
with Ada.Directories;
with Ada.Unchecked_Deallocation;

with ADO.Drivers.Connections;

with Util.Files;
with Util.Log.Loggers;
with Util.Beans.Objects;
with Util.Serialize.IO.XML;
with Util.Serialize.Mappers.Record_Mapper;
package body ADO.Queries.Loaders is

   use Util.Log;
   use ADO.Drivers.Connections;
   use Interfaces;
   use Ada.Calendar;

   Log : constant Loggers.Logger := Loggers.Create ("ADO.Queries.Loaders");

   Base_Time : constant Ada.Calendar.Time := Ada.Calendar.Time_Of (Year  => 1970,
                                                                   Month => 1,
                                                                   Day   => 1);

   --  Check for file modification time at most every 60 seconds.
   FILE_CHECK_DELTA_TIME : constant Unsigned_32 := 60;

   --  The list of query files defined by the application.
   Query_Files : Query_File_Access := null;

   --  Convert a Time to an Unsigned_32.
   function To_Unsigned_32 (T : in Ada.Calendar.Time) return Unsigned_32;
   pragma Inline_Always (To_Unsigned_32);

   --  Get the modification time of the XML query file associated with the query.
   function Modification_Time (Query : in Query_Definition_Access) return Unsigned_32;

   --  Initialize the query SQL pattern with the value
   procedure Set_Query_Pattern (Into  : in out Query_Pattern;
                                Value : in Util.Beans.Objects.Object);

   --  ------------------------------
   --  Register the query definition in the query file.  Registration is done
   --  in the package elaboration phase.
   --  ------------------------------
   procedure Register (File  : in Query_File_Access;
                       Query : in Query_Definition_Access) is
   begin
      Query.File   := File;
      Query.Next   := File.Queries;
      File.Queries := Query;
      if File.Next = null and then Query_Files /= File then
         File.Next := Query_Files;
         Query_Files := File;
      end if;
   end Register;

   function Find_Driver (Name : in String) return Integer;

   function Find_Driver (Name : in String) return Integer is
   begin
      if Name'Length = 0 then
         return 0;
      end if;
      declare
         Driver : constant Drivers.Connections.Driver_Access
           := Drivers.Connections.Get_Driver (Name);
      begin
         if Driver = null then
            --  There is no problem to have an SQL query for unsupported drivers, but still
            --  report some warning.
            Log.Warn ("Database driver {0} not found", Name);
            return -1;
         end if;
         return Integer (Driver.Get_Driver_Index);
      end;
   end Find_Driver;

   --  ------------------------------
   --  Convert a Time to an Unsigned_32.
   --  ------------------------------
   function To_Unsigned_32 (T : in Ada.Calendar.Time) return Unsigned_32 is
      D : constant Duration := Duration '(T - Base_Time);
   begin
      return Unsigned_32 (D);
   end To_Unsigned_32;

   --  ------------------------------
   --  Get the modification time of the XML query file associated with the query.
   --  ------------------------------
   function Modification_Time (Query : in Query_Definition_Access) return Unsigned_32 is
   begin
      return To_Unsigned_32 (Ada.Directories.Modification_Time (Query.File.Path.all));

   exception
      when Ada.IO_Exceptions.Name_Error =>
         Log.Error ("XML query file '{0}' does not exist", Query.File.Path.all);
         return 0;
   end Modification_Time;

   --  ------------------------------
   --  Returns True if the XML query file must be reloaded.
   --  ------------------------------
   function Is_Modified (Query : in Query_Definition_Access) return Boolean is
      Now : constant Unsigned_32 := To_Unsigned_32 (Ada.Calendar.Clock);
   begin
      --  Have we passed the next check time?
      if Query.File.Next_Check > Now then
         return False;
      end if;

      --  Next check in N seconds (60 by default).
      Query.File.Next_Check := Now + FILE_CHECK_DELTA_TIME;

      --  See if the file was changed.
      declare
         M : constant Unsigned_32 := Modification_Time (Query);
      begin
         if Query.File.Last_Modified = M then
            return False;
         end if;
         Query.File.Last_Modified := M;
         return True;
      end;
   end Is_Modified;

   --  ------------------------------
   --  Initialize the query SQL pattern with the value
   --  ------------------------------
   procedure Set_Query_Pattern (Into  : in out Query_Pattern;
                                Value : in Util.Beans.Objects.Object) is
   begin
      Into.SQL := Util.Beans.Objects.To_Unbounded_String (Value);
   end Set_Query_Pattern;

   procedure Read_Query (Into : in Query_File_Access) is

      type Query_Info_Fields is (FIELD_CLASS_NAME, FIELD_PROPERTY_TYPE,
                                 FIELD_PROPERTY_NAME, FIELD_QUERY_NAME,
                                 FIELD_SQL_DRIVER,
                                 FIELD_SQL, FIELD_SQL_COUNT, FIELD_QUERY);

      --  The Query_Loader holds context and state information for loading
      --  the XML query file and initializing the Query_Definition.
      type Query_Loader is record
         File       : Query_File_Access;
         Hash_Value : Unbounded_String;
         Query_Def  : Query_Definition_Access;
         Query      : Query_Info_Ref.Ref;
         Driver     : Integer;
      end record;
      type Query_Loader_Access is access all Query_Loader;

      procedure Set_Member (Into  : in out Query_Loader;
                            Field : in Query_Info_Fields;
                            Value : in Util.Beans.Objects.Object);

      --  ------------------------------
      --  Called by the de-serialization when a given field is recognized.
      --  ------------------------------
      procedure Set_Member (Into  : in out Query_Loader;
                            Field : in Query_Info_Fields;
                            Value : in Util.Beans.Objects.Object) is
         use ADO.Drivers;
      begin
         case Field is
         when FIELD_CLASS_NAME =>
            Append (Into.Hash_Value, " class=");
            Append (Into.Hash_Value, Util.Beans.Objects.To_Unbounded_String (Value));

         when FIELD_PROPERTY_TYPE =>
            Append (Into.Hash_Value, " type=");
            Append (Into.Hash_Value, Util.Beans.Objects.To_Unbounded_String (Value));

         when FIELD_PROPERTY_NAME =>
            Append (Into.Hash_Value, " name=");
            Append (Into.Hash_Value, Util.Beans.Objects.To_Unbounded_String (Value));

         when FIELD_QUERY_NAME =>
            Into.Query_Def  := Find_Query (Into.File.all, Util.Beans.Objects.To_String (Value));
            Into.Driver := 0;
            if Into.Query_Def /= null then
               Into.Query := Query_Info_Ref.Create;
            end if;

         when FIELD_SQL_DRIVER =>
            Into.Driver := Find_Driver (Util.Beans.Objects.To_String (Value));

         when FIELD_SQL =>
            if not Into.Query.Is_Null and Into.Driver >= 0 and Into.Query_Def /= null then
               Set_Query_Pattern (Into.Query.Value.Main_Query (Driver_Index (Into.Driver)),
                                  Value);
            end if;
            Into.Driver := 0;

         when FIELD_SQL_COUNT =>
            if not Into.Query.Is_Null and Into.Driver >= 0 and Into.Query_Def /= null then
               Set_Query_Pattern (Into.Query.Value.Count_Query (Driver_Index (Into.Driver)),
                                  Value);
            end if;
            Into.Driver := 0;

         when FIELD_QUERY =>
            if Into.Query_Def /= null then
               --  Now we can safely setup the query info associated with the query definition.
               Into.Query_Def.Query.Set (Into.Query);
            end if;
            Into.Query_Def := null;

         end case;
      end Set_Member;

      package Query_Mapper is
        new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Query_Loader,
                                                  Element_Type_Access => Query_Loader_Access,
                                                  Fields              => Query_Info_Fields,
                                                  Set_Member          => Set_Member);

      Loader     : aliased Query_Loader;
      Sql_Mapper : aliased Query_Mapper.Mapper;
      Reader     : Util.Serialize.IO.XML.Parser;
      Mapper     : Util.Serialize.Mappers.Processing;
   begin
      Log.Info ("Reading XML query {0}", Into.Path.all);
      Loader.File   := Into;
      Loader.Driver := 0;

      --  Create the mapping to load the XML query file.
      Sql_Mapper.Add_Mapping ("class/@name", FIELD_CLASS_NAME);
      Sql_Mapper.Add_Mapping ("class/property/@type", FIELD_PROPERTY_TYPE);
      Sql_Mapper.Add_Mapping ("class/property/@name", FIELD_PROPERTY_NAME);
      Sql_Mapper.Add_Mapping ("query/@name", FIELD_QUERY_NAME);
      Sql_Mapper.Add_Mapping ("query/sql", FIELD_SQL);
      Sql_Mapper.Add_Mapping ("query/sql/@driver", FIELD_SQL_DRIVER);
      Sql_Mapper.Add_Mapping ("query/sql-count", FIELD_SQL_COUNT);
      Sql_Mapper.Add_Mapping ("query", FIELD_QUERY);
      Mapper.Add_Mapping ("query-mapping", Sql_Mapper'Unchecked_Access);

      --  Set the context for Set_Member.
      Query_Mapper.Set_Context (Mapper, Loader'Access);

      --  Read the XML query file.
      Reader.Parse (Into.Path.all, Mapper);

      Into.Next_Check := To_Unsigned_32 (Ada.Calendar.Clock) + FILE_CHECK_DELTA_TIME;

   exception
      when Ada.IO_Exceptions.Name_Error =>
         Log.Error ("XML query file '{0}' does not exist", Into.Path.all);

   end Read_Query;

   --  ------------------------------
   --  Read the query definition.
   --  ------------------------------
   procedure Read_Query (Into : in Query_Definition_Access) is
   begin
      if Into.Query = null or else Is_Modified (Into)  then
         Read_Query (Into.File);
      end if;
   end Read_Query;

   --  ------------------------------
   --  Initialize the queries to look in the list of directories specified by Paths.
   --  Each search directory is separated by ';' (yes, even on Unix).
   --  When Load is true, read the XML query file and initialize the query
   --  definitions from that file.
   --  ------------------------------
   procedure Initialize (Paths : in String;
                         Load  : in Boolean) is
      procedure Free is
         new Ada.Unchecked_Deallocation (Object => String,
                                         Name   => Ada.Strings.Unbounded.String_Access);

      File : Query_File_Access := Query_Files;
   begin
      Log.Info ("Initializing query search paths to {0}", Paths);

      while File /= null loop
         declare
            Path : constant String := Util.Files.Find_File_Path (Name  => File.Name.all,
                                                                 Paths => Paths);
            Query : Query_Definition_Access := File.Queries;
         begin
            Free (File.Path);
            File.Path := new String '(Path);

            --  Allocate the atomic reference for each query.
            while Query /= null loop
               if Query.Query = null then
                  Query.Query := new Query_Info_Ref.Atomic_Ref;
               end if;
               Query := Query.Next;
            end loop;
            if Load then
               Read_Query (File);
            end if;
         end;
         File := File.Next;
      end loop;
   end Initialize;

   --  ------------------------------
   --  Find the query identified by the given name.
   --  ------------------------------
   function Find_Query (Name : in String) return Query_Definition_Access is
      File : Query_File_Access := Query_Files;
   begin
      while File /= null loop
         declare
            Query : Query_Definition_Access := File.Queries;
         begin
            while Query /= null loop
               if Query.Name.all = Name then
                  return Query;
               end if;
               Query := Query.Next;
            end loop;
         end;
         File := File.Next;
      end loop;
      Log.Warn ("Query {0} not found", Name);
      return null;
   end Find_Query;

   package body Query is
   begin
      Register (File  => File, Query => Query'Access);
   end Query;

end ADO.Queries.Loaders;

Update parsing the XML query to use the new parser/mapper interfaces


-----------------------------------------------------------------------
--  asf-beans-resolvers -- Resolver to create and give access to managed beans
--  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.Sessions;
with ASF.Beans.Params;
with ASF.Beans.Flash;
with ASF.Beans.Globals;
with ASF.Beans.Headers;
package body ASF.Beans.Resolvers is

   --  ------------------------------
   --  Resolve the name represented by <tt>Name</tt> according to a base object <tt>Base</tt>.
   --  The resolver tries to look first in pre-defined objects (params, flash, headers, initParam).
   --  It then looks in the request and session attributes for the value.  If the value was
   --  not in the request or session, it uses the application bean factory to create the
   --  new managed bean and adds it to the request or session.
   --  ------------------------------
   overriding
   function Get_Value (Resolver : in ELResolver;
                       Context  : in EL.Contexts.ELContext'Class;
                       Base     : access Util.Beans.Basic.Readonly_Bean'Class;
                       Name     : in Ada.Strings.Unbounded.Unbounded_String)
                       return Util.Beans.Objects.Object is
      use type Util.Beans.Basic.Readonly_Bean_Access;
      use type ASF.Requests.Request_Access;

      Key    : constant String := To_String (Name);
   begin
      if Base /= null then
         return Base.Get_Value (Key);

      elsif Key = ASF.Beans.Params.PARAM_ATTRIBUTE_NAME then
         return ASF.Beans.Params.Instance;

      elsif Key = ASF.Beans.Headers.HEADER_ATTRIBUTE_NAME then
         return ASF.Beans.Headers.Instance;

      elsif Key = ASF.Beans.Flash.FLASH_ATTRIBUTE_NAME then
         return ASF.Beans.Flash.Instance;

      elsif Key = ASF.Beans.Globals.INIT_PARAM_ATTRIBUTE_NAME then
         return ASF.Beans.Globals.Instance;
      end if;
      declare
         Result : Util.Beans.Objects.Object;
         Scope  : Scope_Type;
         Bean   : Util.Beans.Basic.Readonly_Bean_Access;

         --  Look in the resolver's attributes first.
         Pos    : constant Util.Beans.Objects.Maps.Cursor := Resolver.Attributes.Find (Key);
      begin
         if Util.Beans.Objects.Maps.Has_Element (Pos) then
            return Util.Beans.Objects.Maps.Element (Pos);

         elsif Resolver.Request /= null then
            Result := Resolver.Request.Get_Attribute (Key);
            if not Util.Beans.Objects.Is_Null (Result) then
               return Result;
            end if;

            --  If there is a session, look if the attribute is defined there.
            declare
               Session : ASF.Sessions.Session := Resolver.Request.Get_Session;
            begin
               if Session.Is_Valid then
                  Result := Session.Get_Attribute (Key);
                  if not Util.Beans.Objects.Is_Null (Result) then
                     return Result;
                  end if;
               end if;

               Resolver.Application.Create (Name, Context, Bean, Scope);
               if Bean = null then
                  return Resolver.Application.Get_Global (Name, Context);
               end if;
               Result := Util.Beans.Objects.To_Object (Bean);
               if Scope = SESSION_SCOPE then
                  Session.Set_Attribute (Name  => Key,
                                         Value => Result);
               else
                  Resolver.Request.Set_Attribute (Name  => Key,
                                                  Value => Result);
               end if;
               return Result;
            end;
         else
            Resolver.Application.Create (Name, Context, Bean, Scope);
            if Bean = null then
               return Resolver.Application.Get_Global (Name, Context);
            end if;
            Result := Util.Beans.Objects.To_Object (Bean);
            Resolver.Attributes_Access.Include (Key, Result);
            return Result;
         end if;
      end;
   end Get_Value;

   --  ------------------------------
   --  Sets the value represented by the <tt>Name</tt> in the base object <tt>Base</tt>.
   --  If there is no <tt>Base</tt> object, the request attribute with the given name is
   --  updated to the given value.
   --  ------------------------------
   overriding
   procedure Set_Value (Resolver : in out ELResolver;
                        Context  : in EL.Contexts.ELContext'Class;
                        Base     : access Util.Beans.Basic.Bean'Class;
                        Name     : in Ada.Strings.Unbounded.Unbounded_String;
                        Value    : in Util.Beans.Objects.Object) is
      pragma Unreferenced (Context);

      Key : constant String := To_String (Name);
   begin
      if Base /= null then
         Base.Set_Value (Name => Key, Value => Value);
      else
         Resolver.Request.Set_Attribute (Name => Key, Value => Value);
      end if;
   end Set_Value;

   --  ------------------------------
   --  Initialize the resolver.
   --  ------------------------------
   overriding
   procedure Initialize (Resolver : in out ELResolver) is
   begin
      Resolver.Attributes_Access := Resolver.Attributes'Unchecked_Access;
   end Initialize;

end ASF.Beans.Resolvers;

-----------------------------------------------------------------------
--  asf-beans-resolvers -- Resolver to create and give access to managed beans
--  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.Sessions;
with ASF.Beans.Params;
with ASF.Beans.Flash;
with ASF.Beans.Globals;
with ASF.Beans.Headers;
package body ASF.Beans.Resolvers is

   --  ------------------------------
   --  Initialize the EL resolver to use the application bean factory and the given request.
   --  ------------------------------
   procedure Initialize (Resolver : in out ELResolver;
                         App      : in ASF.Applications.Main.Application_Access;
                         Request  : in ASF.Requests.Request_Access) is
   begin
      Resolver.Application       := App;
      Resolver.Request           := Request;
      Resolver.Attributes_Access := Resolver.Attributes'Unchecked_Access;
   end Initialize;

   --  ------------------------------
   --  Resolve the name represented by <tt>Name</tt> according to a base object <tt>Base</tt>.
   --  The resolver tries to look first in pre-defined objects (params, flash, headers, initParam).
   --  It then looks in the request and session attributes for the value.  If the value was
   --  not in the request or session, it uses the application bean factory to create the
   --  new managed bean and adds it to the request or session.
   --  ------------------------------
   overriding
   function Get_Value (Resolver : in ELResolver;
                       Context  : in EL.Contexts.ELContext'Class;
                       Base     : access Util.Beans.Basic.Readonly_Bean'Class;
                       Name     : in Ada.Strings.Unbounded.Unbounded_String)
                       return Util.Beans.Objects.Object is
      use type Util.Beans.Basic.Readonly_Bean_Access;
      use type ASF.Requests.Request_Access;

      Key    : constant String := To_String (Name);
   begin
      if Base /= null then
         return Base.Get_Value (Key);

      elsif Key = ASF.Beans.Params.PARAM_ATTRIBUTE_NAME then
         return ASF.Beans.Params.Instance;

      elsif Key = ASF.Beans.Headers.HEADER_ATTRIBUTE_NAME then
         return ASF.Beans.Headers.Instance;

      elsif Key = ASF.Beans.Flash.FLASH_ATTRIBUTE_NAME then
         return ASF.Beans.Flash.Instance;

      elsif Key = ASF.Beans.Globals.INIT_PARAM_ATTRIBUTE_NAME then
         return ASF.Beans.Globals.Instance;
      end if;
      declare
         Result : Util.Beans.Objects.Object;
         Scope  : Scope_Type;
         Bean   : Util.Beans.Basic.Readonly_Bean_Access;

         --  Look in the resolver's attributes first.
         Pos    : constant Util.Beans.Objects.Maps.Cursor := Resolver.Attributes.Find (Key);
      begin
         if Util.Beans.Objects.Maps.Has_Element (Pos) then
            return Util.Beans.Objects.Maps.Element (Pos);

         elsif Resolver.Request /= null then
            Result := Resolver.Request.Get_Attribute (Key);
            if not Util.Beans.Objects.Is_Null (Result) then
               return Result;
            end if;

            --  If there is a session, look if the attribute is defined there.
            declare
               Session : ASF.Sessions.Session := Resolver.Request.Get_Session;
            begin
               if Session.Is_Valid then
                  Result := Session.Get_Attribute (Key);
                  if not Util.Beans.Objects.Is_Null (Result) then
                     return Result;
                  end if;
               end if;

               Resolver.Application.Create (Name, Context, Bean, Scope);
               if Bean = null then
                  return Resolver.Application.Get_Global (Name, Context);
               end if;
               Result := Util.Beans.Objects.To_Object (Bean);
               if Scope = SESSION_SCOPE then
                  Session.Set_Attribute (Name  => Key,
                                         Value => Result);
               else
                  Resolver.Request.Set_Attribute (Name  => Key,
                                                  Value => Result);
               end if;
               return Result;
            end;
         else
            Resolver.Application.Create (Name, Context, Bean, Scope);
            if Bean = null then
               return Resolver.Application.Get_Global (Name, Context);
            end if;
            Result := Util.Beans.Objects.To_Object (Bean);
            Resolver.Attributes_Access.Include (Key, Result);
            return Result;
         end if;
      end;
   end Get_Value;

   --  ------------------------------
   --  Sets the value represented by the <tt>Name</tt> in the base object <tt>Base</tt>.
   --  If there is no <tt>Base</tt> object, the request attribute with the given name is
   --  updated to the given value.
   --  ------------------------------
   overriding
   procedure Set_Value (Resolver : in out ELResolver;
                        Context  : in EL.Contexts.ELContext'Class;
                        Base     : access Util.Beans.Basic.Bean'Class;
                        Name     : in Ada.Strings.Unbounded.Unbounded_String;
                        Value    : in Util.Beans.Objects.Object) is
      pragma Unreferenced (Context);

      Key : constant String := To_String (Name);
   begin
      if Base /= null then
         Base.Set_Value (Name => Key, Value => Value);
      else
         Resolver.Request.Set_Attribute (Name => Key, Value => Value);
      end if;
   end Set_Value;

   --  ------------------------------
   --  Initialize the resolver.
   --  ------------------------------
   overriding
   procedure Initialize (Resolver : in out ELResolver) is
   begin
      Resolver.Attributes_Access := Resolver.Attributes'Unchecked_Access;
   end Initialize;

end ASF.Beans.Resolvers;


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

private with Util.Streams.Raw;

--  == Local Files Stream ==
--  The <tt>Babel.Streams.Files</tt> package provides the streams support to read and write
--  local files.
package Babel.Streams.Files is

   type Stream_Type is new Babel.Streams.Stream_Type with private;
   type Stream_Access is access all Stream_Type'Class;

   --  Open the local file for reading and use the given buffer for the Read operation.
   procedure Open (Stream : in out Stream_Type;
                   Path   : in String;
                   Buffer : in Babel.Files.Buffers.Buffer_Access);

   --  Create a file and prepare for the Write operation.
   procedure Create (Stream : in out Stream_Type;
                     Path   : in String;
                     Mode   : in Util.Systems.Types.mode_t);

   --  Read the data stream as much as possible and return the result in a buffer.
   --  The buffer is owned by the stream and need not be released.  The same buffer may
   --  or may not be returned by the next <tt>Read</tt> operation.
   --  A null buffer is returned when the end of the data stream is reached.
   overriding
   procedure Read (Stream : in out Stream_Type;
                   Buffer : out Babel.Files.Buffers.Buffer_Access);

   --  Write the buffer in the data stream.
   overriding
   procedure Write (Stream : in out Stream_Type;
                    Buffer : in Babel.Files.Buffers.Buffer_Access);

   --  Close the data stream.
   overriding
   procedure Close (Stream : in out Stream_Type);

   --  Prepare to read again the data stream from the beginning.
   overriding
   procedure Rewind (Stream : in out Stream_Type);

   --  Set the internal buffer that the stream can use.
   overriding
   procedure Set_Buffer (Stream : in out Stream_Type;
                         Buffer : in Babel.Files.Buffers.Buffer_Access);

private

   type Stream_Type is new Babel.Streams.Stream_Type with record
      File    : Util.Streams.Raw.Raw_Stream;
      Buffer  : Babel.Files.Buffers.Buffer_Access;
      Eof     : Boolean := False;
   end record;

end Babel.Streams.Files;

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

private with Util.Streams.Raw;

--  == Local Files Stream ==
--  The <tt>Babel.Streams.Files</tt> package provides the streams support to read and write
--  local files.
package Babel.Streams.Files is

   type Stream_Type is new Babel.Streams.Stream_Type with private;
   type Stream_Access is access all Stream_Type'Class;

   --  Open the local file for reading and use the given buffer for the Read operation.
   procedure Open (Stream : in out Stream_Type;
                   Path   : in String;
                   Buffer : in Babel.Files.Buffers.Buffer_Access);

   --  Create a file and prepare for the Write operation.
   procedure Create (Stream : in out Stream_Type;
                     Path   : in String;
                     Mode   : in Util.Systems.Types.mode_t);

   --  Read the data stream as much as possible and return the result in a buffer.
   --  The buffer is owned by the stream and need not be released.  The same buffer may
   --  or may not be returned by the next <tt>Read</tt> operation.
   --  A null buffer is returned when the end of the data stream is reached.
   overriding
   procedure Read (Stream : in out Stream_Type;
                   Buffer : out Babel.Files.Buffers.Buffer_Access);

   --  Write the buffer in the data stream.
   overriding
   procedure Write (Stream : in out Stream_Type;
                    Buffer : in Babel.Files.Buffers.Buffer_Access);

   --  Close the data stream.
   overriding
   procedure Close (Stream : in out Stream_Type);

   --  Prepare to read again the data stream from the beginning.
   overriding
   procedure Rewind (Stream : in out Stream_Type);

private

   type Stream_Type is new Babel.Streams.Stream_Type with record
      File    : Util.Streams.Raw.Raw_Stream;
      Eof     : Boolean := False;
   end record;

end Babel.Streams.Files;

Remove the buffer from the Stream_Type record to use the root buffer


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

with AWT.Inputs;

package AWT.Drag_And_Drop is

   type Receive_Callback is access protected procedure (Value : SU.Unbounded_String);

   use all type AWT.Inputs.Action_Kind;

   function Supported_Actions return AWT.Inputs.Actions;

   function Valid_Action return AWT.Inputs.Action_Kind;
   --  Return the used action for the drag'n'drop operation
   --
   --  May be called in overriding procedure On_Drag of Window.
   --
   --  If the returned value is not None, then procedure Get can be called
   --  or a signal can be set via a protected object, followed by a call
   --  to function Get in the environment task.

   procedure Set_Action (Action : AWT.Inputs.Action_Kind);
   --  Set the requested action that must happen when the user
   --  drops something on the current focused window
   --
   --  Should be called in the overriding procedure On_Drag of Window.

   procedure Finish (Action : AWT.Inputs.Action_Kind)
     with Pre => Action /= Ask and Valid_Action /= None;
   --  Finish the current drag-and-drop operation.
   --
   --  To accept the operation, use Copy or Move. If the last set
   --  action was Ask, then the value may either be Copy or Move,
   --  otherwise it must match the last set action.
   --
   --  To reject the operation, use None.

   procedure Get (Callback : not null Receive_Callback)
     with Pre => Valid_Action /= None;
   --  Receive data from a drag-and-drop operation
   --
   --  Before calling this procedure, call function Valid_Actions
   --  to determine what kind of operation needs to take place. If "Ask" is
   --  true, then the application may want to show menu to let the user
   --  choose.
   --
   --  After the given callback has been executed, finish the operation
   --  by calling Finish to accept or reject the received data.

   function Get return String;

end AWT.Drag_And_Drop;

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

with AWT.Inputs;

package AWT.Drag_And_Drop is

   type Receive_Callback is access protected procedure (Value : SU.Unbounded_String);

   use all type AWT.Inputs.Action_Kind;

   function Supported_Actions return AWT.Inputs.Actions;

   function Valid_Action return AWT.Inputs.Action_Kind;
   --  Return the used action for the drag'n'drop operation
   --
   --  May be called in overriding procedure On_Drop of Window.
   --
   --  If the returned value is not None, then procedure Get can be called
   --  or a signal can be set via a protected object, followed by a call
   --  to function Get in the environment task.

   procedure Set_Action (Action : AWT.Inputs.Action_Kind);
   --  Set the requested action that must happen when the user
   --  drops something on the current focused window
   --
   --  Should be called in the overriding procedure On_Drag of Window.

   procedure Finish (Action : AWT.Inputs.Action_Kind)
     with Pre => Action /= Ask and Valid_Action /= None;
   --  Finish the current drag-and-drop operation.
   --
   --  To accept the operation, use Copy or Move. If the last set
   --  action was Ask, then the value may either be Copy or Move,
   --  otherwise it must match the last set action.
   --
   --  To reject the operation, use None.

   procedure Get (Callback : not null Receive_Callback)
     with Pre => Valid_Action /= None;
   --  Receive data from a drag-and-drop operation
   --
   --  Before calling this procedure, call function Supported_Actions
   --  to determine what kind of operation needs to take place. If "Ask" is
   --  true, then the application may want to show a menu to let the user
   --  choose.
   --
   --  After the given callback has been executed, finish the operation
   --  by calling Finish to accept or reject the received data.

   function Get return String;

end AWT.Drag_And_Drop;

awt: Fix some typos in comments in package AWT.Drag_And_Drop

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