-----------------------------------------------------------------------
--  util-properties -- Generic name/value property management
--  Copyright (C) 2001 - 2019 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Finalization;
with Ada.Text_IO;
with Util.Beans.Objects;
with Util.Beans.Basic;
with Util.Strings.Vectors;
private with Util.Concurrent.Counters;

--  = Property Files =
--  The `Util.Properties` package and children implements support to read, write and use
--  property files either in the Java property file format or the Windows INI configuration file.
--  Each property is assigned a key and a value.  The list of properties are stored in the
--  `Util.Properties.Manager` tagged record and they are indexed by the key name.  A property
--  is therefore unique in the list.  Properties can be grouped together in sub-properties so
--  that a key can represent another list of properties.  To use the packages described here,
--  use the following GNAT project:
--
--    with "utilada_base";
--
--  == File formats ==
--  The property file consists of a simple name and value pair separated by the `=` sign.
--  Thanks to the Windows INI file format, list of properties can be grouped together
--  in sections by using the `[section-name]` notation.
--
--    test.count=20
--    test.repeat=5
--    [FileTest]
--    test.count=5
--    test.repeat=2
--
--  == Using property files ==
--  An instance of the `Util.Properties.Manager` tagged record must be declared and it provides
--  various operations that can be used.  When created, the property manager is empty.  One way
--  to fill it is by using the `Load_Properties` procedure to read the property file.  Another
--  way is by using the `Set` procedure to insert or change a property by giving its name
--  and its value.
--
--  In this example, the property file `test.properties` is loaded and assuming that it contains
--  the above configuration example, the `Get ("test.count")` will return the string `"20"`.
--  The property `test.repeat` is then modified to have the value `"23"` and the properties are
--  then saved in the file.
--
--    with Util.Properties;
--    ...
--       Props : Util.Properties.Manager;
--       ...
--          Props.Load_Properties (Path => "test.properties");
--          Ada.Text_IO.Put_Line ("Count: " & Props.Get ("test.count");
--          Props.Set ("test.repeat", "23");
--          Props.Save_Properties (Path => "test.properties");
--
--  To be able to access a section from the property manager, it is necessary to retrieve it
--  by using the `Get` function and giving the section name.  For example, to retrieve the
--  `test.count` property of the `FileTest` section, the following code is used:
--
--       FileTest : Util.Properties.Manager := Props.Get ("FileTest");
--       ...
--          Ada.Text_IO.Put_Line ("[FileTest] Count: "
--                                & FileTest.Get ("test.count");
--
--  When getting or removing a property, the `NO_PROPERTY` exception is raised if the property
--  name was not found in the map.  To avoid that exception, it is possible to check whether
--  the name is known by using the `Exists` function.
--
--       if Props.Exists ("test.old_count") then
--          ... --  Property exist
--       end if;
--
--  @include util-properties-json.ads
--  @include util-properties-bundles.ads
--
--  == Advance usage of properties ==
--  The property manager holds the name and value pairs by using an Ada Bean object.
--
--  It is possible to iterate over the properties by using the `Iterate` procedure that
--  accepts as parameter a `Process` procedure that gets the property name as well as the
--  property value.  The value itself is passed as an `Util.Beans.Objects.Object` type.
--
package Util.Properties is

   NO_PROPERTY : exception;

   use Ada.Strings.Unbounded;

   subtype Value is Util.Beans.Objects.Object;

   function "+" (S : String) return Unbounded_String renames To_Unbounded_String;

   function "-" (S : Unbounded_String) return String renames To_String;

   function To_String (V : in Value) return String
     renames Util.Beans.Objects.To_String;

   --  The manager holding the name/value pairs and providing the operations
   --  to get and set the properties.
   type Manager is new Ada.Finalization.Controlled and Util.Beans.Basic.Bean with private;
   type Manager_Access is access all Manager'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in Manager;
                       Name : in String) return Util.Beans.Objects.Object;

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

   --  Returns TRUE if the property manager is empty.
   function Is_Empty (Self : in Manager'Class) return Boolean;

   --  Returns TRUE if the property exists.
   function Exists (Self : in Manager'Class;
                    Name : in Unbounded_String) return Boolean;

   --  Returns TRUE if the property exists.
   function Exists (Self : in Manager'Class;
                    Name : in String) return Boolean;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in String) return String;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in String) return Unbounded_String;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in Unbounded_String) return Unbounded_String;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in Unbounded_String) return String;

   --  Returns the property value or Default if it does not exist.
   function Get (Self : in Manager'Class;
                 Name : in String;
                 Default : in String) return String;

   --  Returns a property manager that is associated with the given name.
   --  Raises NO_PROPERTY if there is no such property manager or if a property exists
   --  but is not a property manager.
   function Get (Self : in Manager'Class;
                 Name : in String) return Manager;

   --  Create a property manager and associated it with the given name.
   function Create (Self : in out Manager'Class;
                    Name : in String) return Manager;

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

   --  Set the value of the property.  The property is created if it
   --  does not exists.
   procedure Set (Self : in out Manager'Class;
                  Name : in String;
                  Item : in Unbounded_String);

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

   --  Remove the property given its name.  If the property does not
   --  exist, raises NO_PROPERTY exception.
   procedure Remove (Self : in out Manager'Class;
                     Name : in String);

   --  Remove the property given its name.  If the property does not
   --  exist, raises NO_PROPERTY exception.
   procedure Remove (Self : in out Manager'Class;
                     Name : in Unbounded_String);

   --  Iterate over the properties and execute the given procedure passing the
   --  property name and its value.
   procedure Iterate (Self    : in Manager'Class;
                      Process : access procedure (Name : in String;
                                                  Item : in Value));

   --  Collect the name of the properties defined in the manager.
   --  When a prefix is specified, only the properties starting with the prefix are
   --  returned.
   procedure Get_Names (Self   : in Manager;
                        Into   : in out Util.Strings.Vectors.Vector;
                        Prefix : in String := "");

   --  Load the properties from the file input stream.  The file must follow
   --  the definition of Java property files.  When a prefix is specified, keep
   --  only the properties that starts with the prefix.  When Strip is True,
   --  the prefix part is removed from the property name.
   procedure Load_Properties (Self   : in out Manager'Class;
                              File   : in Ada.Text_IO.File_Type;
                              Prefix : in String := "";
                              Strip  : in Boolean := False);

   --  Load the properties from the file.  The file must follow the
   --  definition of Java property files.  When a prefix is specified, keep
   --  only the properties that starts with the prefix.  When Strip is True,
   --  the prefix part is removed from the property name.
   --  Raises NAME_ERROR if the file does not exist.
   procedure Load_Properties (Self   : in out Manager'Class;
                              Path   : in String;
                              Prefix : in String := "";
                              Strip  : in Boolean := False);

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

   --  Copy the properties from FROM which start with a given prefix.
   --  If the prefix is empty, all properties are copied.  When Strip is True,
   --  the prefix part is removed from the property name.
   procedure Copy (Self   : in out Manager'Class;
                   From   : in Manager'Class;
                   Prefix : in String := "";
                   Strip  : in Boolean := False);

   --  Get the property manager represented by the item value.
   --  Raise the Conversion_Error exception if the value is not a property manager.
   function To_Manager (Item : in Value) return Manager;

   --  Returns True if the item value represents a property manager.
   function Is_Manager (Item : in Value) return Boolean;

private

   --  Abstract interface for the implementation of Properties
   --  (this allows to decouples the implementation from the API)
   package Interface_P is

      type Manager is abstract limited new Util.Beans.Basic.Bean with record
         Count  : Util.Concurrent.Counters.Counter;
         Shared : Boolean := False;
      end record;
      type Manager_Access is access all Manager'Class;

      --  Returns TRUE if the property exists.
      function Exists (Self : in Manager;
                       Name : in String)
                       return Boolean is abstract;

      --  Remove the property given its name.
      procedure Remove (Self : in out Manager;
                        Name : in String) is abstract;

      --  Iterate over the properties and execute the given procedure passing the
      --  property name and its value.
      procedure Iterate (Self    : in Manager;
                         Process : access procedure (Name : in String;
                                                     Item : in Value))
      is abstract;

      --  Deep copy of properties stored in 'From' to 'To'.
      function Create_Copy (Self : in Manager)
                            return Manager_Access is abstract;

   end Interface_P;

   --  Create a property implementation if there is none yet.
   procedure Check_And_Create_Impl (Self : in out Manager);

   type Manager is new Ada.Finalization.Controlled and Util.Beans.Basic.Bean with record
      Impl : Interface_P.Manager_Access := null;
   end record;

   overriding
   procedure Adjust   (Object : in out Manager);

   overriding
   procedure Finalize (Object : in out Manager);

end Util.Properties;

-----------------------------------------------------------------------
--  util-properties -- Generic name/value property management
--  Copyright (C) 2001 - 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.Strings.Unbounded;
with Ada.Finalization;
with Ada.Text_IO;
with Util.Beans.Objects;
with Util.Beans.Basic;
with Util.Strings.Vectors;
private with Util.Concurrent.Counters;

--  = Property Files =
--  The `Util.Properties` package and children implements support to read, write and use
--  property files either in the Java property file format or the Windows INI configuration file.
--  Each property is assigned a key and a value.  The list of properties are stored in the
--  `Util.Properties.Manager` tagged record and they are indexed by the key name.  A property
--  is therefore unique in the list.  Properties can be grouped together in sub-properties so
--  that a key can represent another list of properties.  To use the packages described here,
--  use the following GNAT project:
--
--    with "utilada_base";
--
--  == File formats ==
--  The property file consists of a simple name and value pair separated by the `=` sign.
--  Thanks to the Windows INI file format, list of properties can be grouped together
--  in sections by using the `[section-name]` notation.
--
--    test.count=20
--    test.repeat=5
--    [FileTest]
--    test.count=5
--    test.repeat=2
--
--  == Using property files ==
--  An instance of the `Util.Properties.Manager` tagged record must be declared and it provides
--  various operations that can be used.  When created, the property manager is empty.  One way
--  to fill it is by using the `Load_Properties` procedure to read the property file.  Another
--  way is by using the `Set` procedure to insert or change a property by giving its name
--  and its value.
--
--  In this example, the property file `test.properties` is loaded and assuming that it contains
--  the above configuration example, the `Get ("test.count")` will return the string `"20"`.
--  The property `test.repeat` is then modified to have the value `"23"` and the properties are
--  then saved in the file.
--
--    with Util.Properties;
--    ...
--       Props : Util.Properties.Manager;
--       ...
--          Props.Load_Properties (Path => "test.properties");
--          Ada.Text_IO.Put_Line ("Count: " & Props.Get ("test.count");
--          Props.Set ("test.repeat", "23");
--          Props.Save_Properties (Path => "test.properties");
--
--  To be able to access a section from the property manager, it is necessary to retrieve it
--  by using the `Get` function and giving the section name.  For example, to retrieve the
--  `test.count` property of the `FileTest` section, the following code is used:
--
--       FileTest : Util.Properties.Manager := Props.Get ("FileTest");
--       ...
--          Ada.Text_IO.Put_Line ("[FileTest] Count: "
--                                & FileTest.Get ("test.count");
--
--  When getting or removing a property, the `NO_PROPERTY` exception is raised if the property
--  name was not found in the map.  To avoid that exception, it is possible to check whether
--  the name is known by using the `Exists` function.
--
--       if Props.Exists ("test.old_count") then
--          ... --  Property exist
--       end if;
--
--  @include util-properties-json.ads
--  @include util-properties-bundles.ads
--
--  == Advance usage of properties ==
--  The property manager holds the name and value pairs by using an Ada Bean object.
--
--  It is possible to iterate over the properties by using the `Iterate` procedure that
--  accepts as parameter a `Process` procedure that gets the property name as well as the
--  property value.  The value itself is passed as an `Util.Beans.Objects.Object` type.
--
package Util.Properties is

   NO_PROPERTY : exception;

   use Ada.Strings.Unbounded;

   subtype Value is Util.Beans.Objects.Object;

   function "+" (S : String) return Unbounded_String renames To_Unbounded_String;

   function "-" (S : Unbounded_String) return String renames To_String;

   function To_String (V : in Value) return String
     renames Util.Beans.Objects.To_String;

   --  The manager holding the name/value pairs and providing the operations
   --  to get and set the properties.
   type Manager is new Ada.Finalization.Controlled and Util.Beans.Basic.Bean with private;
   type Manager_Access is access all Manager'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in Manager;
                       Name : in String) return Util.Beans.Objects.Object;

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

   --  Returns TRUE if the property manager is empty.
   function Is_Empty (Self : in Manager'Class) return Boolean;

   --  Returns TRUE if the property exists.
   function Exists (Self : in Manager'Class;
                    Name : in Unbounded_String) return Boolean;

   --  Returns TRUE if the property exists.
   function Exists (Self : in Manager'Class;
                    Name : in String) return Boolean;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in String) return String;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in String) return Unbounded_String;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in Unbounded_String) return Unbounded_String;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in Unbounded_String) return String;

   --  Returns the property value or Default if it does not exist.
   function Get (Self : in Manager'Class;
                 Name : in String;
                 Default : in String) return String;

   --  Returns a property manager that is associated with the given name.
   --  Raises NO_PROPERTY if there is no such property manager or if a property exists
   --  but is not a property manager.
   function Get (Self : in Manager'Class;
                 Name : in String) return Manager;

   --  Create a property manager and associated it with the given name.
   function Create (Self : in out Manager'Class;
                    Name : in String) return Manager;

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

   --  Set the value of the property.  The property is created if it
   --  does not exists.
   procedure Set (Self : in out Manager'Class;
                  Name : in String;
                  Item : in Unbounded_String);

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

   --  Remove the property given its name.  If the property does not
   --  exist, raises NO_PROPERTY exception.
   procedure Remove (Self : in out Manager'Class;
                     Name : in String);

   --  Remove the property given its name.  If the property does not
   --  exist, raises NO_PROPERTY exception.
   procedure Remove (Self : in out Manager'Class;
                     Name : in Unbounded_String);

   --  Iterate over the properties and execute the given procedure passing the
   --  property name and its value.
   procedure Iterate (Self    : in Manager'Class;
                      Process : access procedure (Name : in String;
                                                  Item : in Value));

   --  Collect the name of the properties defined in the manager.
   --  When a prefix is specified, only the properties starting with the prefix are
   --  returned.
   procedure Get_Names (Self   : in Manager;
                        Into   : in out Util.Strings.Vectors.Vector;
                        Prefix : in String := "");

   --  Load the properties from the file input stream.  The file must follow
   --  the definition of Java property files.  When a prefix is specified, keep
   --  only the properties that starts with the prefix.  When Strip is True,
   --  the prefix part is removed from the property name.
   procedure Load_Properties (Self   : in out Manager'Class;
                              File   : in Ada.Text_IO.File_Type;
                              Prefix : in String := "";
                              Strip  : in Boolean := False);

   --  Load the properties from the file.  The file must follow the
   --  definition of Java property files.  When a prefix is specified, keep
   --  only the properties that starts with the prefix.  When Strip is True,
   --  the prefix part is removed from the property name.
   --  Raises NAME_ERROR if the file does not exist.
   procedure Load_Properties (Self   : in out Manager'Class;
                              Path   : in String;
                              Prefix : in String := "";
                              Strip  : in Boolean := False);

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

   --  Copy the properties from FROM which start with a given prefix.
   --  If the prefix is empty, all properties are copied.  When Strip is True,
   --  the prefix part is removed from the property name.
   procedure Copy (Self   : in out Manager'Class;
                   From   : in Manager'Class;
                   Prefix : in String := "";
                   Strip  : in Boolean := False);

   --  Get the property manager represented by the item value.
   --  Raise the Conversion_Error exception if the value is not a property manager.
   function To_Manager (Item : in Value) return Manager;

   --  Returns True if the item value represents a property manager.
   function Is_Manager (Item : in Value) return Boolean;

   --  Abstract interface for the implementation of Properties
   --  (this allows to decouples the implementation from the API)
   package Implementation is

      type Manager is limited interface and Util.Beans.Basic.Bean;
      type Manager_Access is access all Manager'Class;

      --  Returns TRUE if the property exists.
      function Exists (Self : in Manager;
                       Name : in String)
                       return Boolean is abstract;

      --  Remove the property given its name.
      procedure Remove (Self : in out Manager;
                        Name : in String) is abstract;

      --  Iterate over the properties and execute the given procedure passing the
      --  property name and its value.
      procedure Iterate
        (Self    : in Manager;
         Process : access procedure (Name : in String;
                                     Item : in Value)) is abstract;

      --  Deep copy of properties stored in 'From' to 'To'.
      function Create_Copy (Self : in Manager)
                            return Manager_Access is abstract;

      type Shared_Manager is limited interface and Manager;
      type Shared_Manager_Access is access all Shared_Manager'Class;

      function Is_Shared (Self : in Shared_Manager) return Boolean is abstract;

      procedure Set_Shared (Self   : in out Shared_Manager;
                            Shared : in Boolean) is abstract;

      procedure Adjust (Self : in out Shared_Manager) is abstract;

      procedure Finalize (Self    : in out Shared_Manager;
                          Release : out Boolean) is abstract;

      generic
         with function Allocator return Shared_Manager_Access;
      procedure Create (Self : in out Util.Properties.Manager'Class);

      generic
         with function Allocator return Shared_Manager_Access;
      procedure Initialize (Self : in out Util.Properties.Manager'Class);

      generic
         type Manager_Type is limited new Manager with private;
      package Shared_Implementation is

         type Manager is limited new Manager_Type and Shared_Manager with private;

         overriding
         function Is_Shared (Self : in Manager) return Boolean;

         overriding
         procedure Set_Shared (Self   : in out Manager;
                               Shared : in Boolean);

         overriding
         procedure Adjust (Self : in out Manager);

         overriding
         procedure Finalize (Self    : in out Manager;
                             Release : out Boolean);

      private

         type Manager is limited new Manager_Type and Shared_Manager with record
            Count  : Util.Concurrent.Counters.Counter := Util.Concurrent.Counters.ONE;
            Shared : Boolean := False;
         end record;

      end Shared_Implementation;

   end Implementation;

private

   type Manager is new Ada.Finalization.Controlled and Util.Beans.Basic.Bean with record
      Impl : Implementation.Shared_Manager_Access := null;
   end record;

   overriding
   procedure Adjust   (Object : in out Manager);

   overriding
   procedure Finalize (Object : in out Manager);

end Util.Properties;

Refactor the implementation to allow an external implementation of the Manager class


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

   --  ------------------------------
   --  Set the query definition which identifies the SQL query to execute.
   --  The query is represented by the <tt>sql</tt> XML entry.
   --  ------------------------------
   procedure Set_Query (Into  : in out Context;
                        Query : in Query_Definition_Access) is
   begin
      Into.Query_Def := Query;
      Into.Is_Count  := False;
   end Set_Query;

   --  ------------------------------
   --  Set the query definition which identifies the SQL query to execute.
   --  The query count is represented by the <tt>sql-count</tt> XML entry.
   --  ------------------------------
   procedure Set_Count_Query (Into  : in out Context;
                              Query : in Query_Definition_Access) is
   begin
      Into.Query_Def := Query;
      Into.Is_Count  := True;
   end Set_Count_Query;

   procedure Set_Query (Into  : in out Context;
                        Name  : in String) is
   begin
      Into.Query_Def := ADO.Queries.Loaders.Find_Query (Name);
   end Set_Query;

   --  ------------------------------
   --  Set the query to execute as SQL statement.
   --  ------------------------------
   procedure Set_SQL (Into : in out Context;
                      SQL  : in String) is
   begin
      ADO.SQL.Clear (Into.SQL);
      ADO.SQL.Append (Into.SQL, SQL);
   end Set_SQL;

   --  ------------------------------
   --  Set the limit for the SQL query.
   --  ------------------------------
   procedure Set_Limit (Into  : in out Context;
                        First : in Natural;
                        Last  : in Natural) is
   begin
      Into.First := First;
      Into.Last  := Last;
   end Set_Limit;

   --  ------------------------------
   --  Get the first row index.
   --  ------------------------------
   function Get_First_Row_Index (From : in Context) return Natural is
   begin
      return From.First;
   end Get_First_Row_Index;

   --  ------------------------------
   --  Get the last row index.
   --  ------------------------------
   function Get_Last_Row_Index (From : in Context) return Natural is
   begin
      return From.Last;
   end Get_Last_Row_Index;

   --  ------------------------------
   --  Get the maximum number of rows that the SQL query can return.
   --  This operation uses the <b>sql-count</b> query.
   --  ------------------------------
   function Get_Max_Row_Count (From : in Context) return Natural is
   begin
      return From.Max_Row_Count;
   end Get_Max_Row_Count;

   --  ------------------------------
   --  Get the SQL query that correspond to the query context.
   --  ------------------------------
   function Get_SQL (From   : in Context;
                     Manager : in Query_Manager'Class) return String is
   begin
      if From.Query_Def = null then
         return ADO.SQL.To_String (From.SQL);
      else
         return Get_SQL (From.Query_Def, Manager, From.Is_Count);
      end if;
   end Get_SQL;

   --  ------------------------------
   --  Find the query with the given name.
   --  Returns the query definition that matches the name or null if there is none
   --  ------------------------------
   function Find_Query (File : in Query_File_Info;
                        Name : in String) return Query_Definition_Access is
      Query : Query_Definition_Access := File.File.Queries;
   begin
      while Query /= null loop
         if Query.Name.all = Name then
            return Query;
         end if;
         Query := Query.Next;
      end loop;
      return null;
   end Find_Query;

   function Get_SQL (From      : in Query_Definition_Access;
                     Manager   : in Query_Manager;
                     Use_Count : in Boolean) return String is
      Query : Query_Info_Ref.Ref;
   begin
      ADO.Queries.Loaders.Read_Query (Manager, From);
      Query := Manager.Queries (From.Query);
      if Query.Is_Null then
         return "";
      end if;
      if Use_Count then
         if Length (Query.Value.Count_Query (Manager.Driver).SQL) > 0 then
            return To_String (Query.Value.Count_Query (Manager.Driver).SQL);
         else
            return To_String (Query.Value.Count_Query (ADO.Drivers.Driver_Index'First).SQL);
         end if;
      elsif Length (Query.Value.Main_Query (Manager.Driver).SQL) > 0 then
         return To_String (Query.Value.Main_Query (Manager.Driver).SQL);
      else
         return To_String (Query.Value.Main_Query (ADO.Drivers.Driver_Index'First).SQL);
      end if;
   end Get_SQL;

   overriding
   procedure Finalize (Manager : in out Query_Manager) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => File_Table,
                                        Name   => File_Table_Access);
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => Query_Table,
                                        Name   => Query_Table_Access);
   begin
      Free (Manager.Queries);
      Free (Manager.Files);
   end Finalize;

end ADO.Queries;

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

   --  ------------------------------
   --  Set the query definition which identifies the SQL query to execute.
   --  The query is represented by the <tt>sql</tt> XML entry.
   --  ------------------------------
   procedure Set_Query (Into  : in out Context;
                        Query : in Query_Definition_Access) is
   begin
      Into.Query_Def := Query;
      Into.Is_Count  := False;
   end Set_Query;

   --  ------------------------------
   --  Set the query definition which identifies the SQL query to execute.
   --  The query count is represented by the <tt>sql-count</tt> XML entry.
   --  ------------------------------
   procedure Set_Count_Query (Into  : in out Context;
                              Query : in Query_Definition_Access) is
   begin
      Into.Query_Def := Query;
      Into.Is_Count  := True;
   end Set_Count_Query;

   procedure Set_Query (Into  : in out Context;
                        Name  : in String) is
   begin
      Into.Query_Def := ADO.Queries.Loaders.Find_Query (Name);
   end Set_Query;

   --  ------------------------------
   --  Set the query to execute as SQL statement.
   --  ------------------------------
   procedure Set_SQL (Into : in out Context;
                      SQL  : in String) is
   begin
      ADO.SQL.Clear (Into.SQL);
      ADO.SQL.Append (Into.SQL, SQL);
   end Set_SQL;

   --  ------------------------------
   --  Set the limit for the SQL query.
   --  ------------------------------
   procedure Set_Limit (Into  : in out Context;
                        First : in Natural;
                        Last  : in Natural) is
   begin
      Into.First := First;
      Into.Last  := Last;
   end Set_Limit;

   --  ------------------------------
   --  Get the first row index.
   --  ------------------------------
   function Get_First_Row_Index (From : in Context) return Natural is
   begin
      return From.First;
   end Get_First_Row_Index;

   --  ------------------------------
   --  Get the last row index.
   --  ------------------------------
   function Get_Last_Row_Index (From : in Context) return Natural is
   begin
      return From.Last;
   end Get_Last_Row_Index;

   --  ------------------------------
   --  Get the maximum number of rows that the SQL query can return.
   --  This operation uses the <b>sql-count</b> query.
   --  ------------------------------
   function Get_Max_Row_Count (From : in Context) return Natural is
   begin
      return From.Max_Row_Count;
   end Get_Max_Row_Count;

   --  ------------------------------
   --  Get the SQL query that correspond to the query context.
   --  ------------------------------
   function Get_SQL (From   : in Context;
                     Manager : in Query_Manager'Class) return String is
   begin
      if From.Query_Def = null then
         return ADO.SQL.To_String (From.SQL);
      else
         return Get_SQL (From.Query_Def, Manager, From.Is_Count);
      end if;
   end Get_SQL;

   --  ------------------------------
   --  Find the query with the given name.
   --  Returns the query definition that matches the name or null if there is none
   --  ------------------------------
   function Find_Query (File : in Query_File_Info;
                        Name : in String) return Query_Definition_Access is
      Query : Query_Definition_Access := File.File.Queries;
   begin
      while Query /= null loop
         if Query.Name.all = Name then
            return Query;
         end if;
         Query := Query.Next;
      end loop;
      return null;
   end Find_Query;

   function Get_SQL (From      : in Query_Definition_Access;
                     Manager   : in Query_Manager;
                     Use_Count : in Boolean) return String is
      Query : Query_Info_Ref.Ref;
   begin
      ADO.Queries.Loaders.Read_Query (Manager, From);
      Query := Manager.Queries (From.Query);
      if Query.Is_Null then
         raise Query_Error with "Query does not exist";
      end if;
      if Use_Count then
         if Length (Query.Value.Count_Query (Manager.Driver).SQL) > 0 then
            return To_String (Query.Value.Count_Query (Manager.Driver).SQL);
         elsif Length (Query.Value.Count_Query (ADO.Drivers.Driver_Index'First).SQL) > 0 then
            return To_String (Query.Value.Count_Query (ADO.Drivers.Driver_Index'First).SQL);
         else
            raise Query_Error with "Default count-query is empty";
         end if;
      elsif Length (Query.Value.Main_Query (Manager.Driver).SQL) > 0 then
         return To_String (Query.Value.Main_Query (Manager.Driver).SQL);
      elsif Length (Query.Value.Main_Query (ADO.Drivers.Driver_Index'First).SQL) > 0 then
         return To_String (Query.Value.Main_Query (ADO.Drivers.Driver_Index'First).SQL);
      else
         raise Query_Error with "Default query is empty";
      end if;
   end Get_SQL;

   overriding
   procedure Finalize (Manager : in out Query_Manager) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => File_Table,
                                        Name   => File_Table_Access);
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => Query_Table,
                                        Name   => Query_Table_Access);
   begin
      Free (Manager.Queries);
      Free (Manager.Files);
   end Finalize;

end ADO.Queries;

Raise the Query_Error exception if we try to get an SQL from a query that does not define the SQL


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

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ASF.Factory");

   --  ------------------------------
   --  Compute a hash for the tag name.
   --  ------------------------------
   function Hash (Key : in Tag_Name) return Ada.Containers.Hash_Type is
      use type Ada.Containers.Hash_Type;

      H1 : constant Ada.Containers.Hash_Type := Ada.Strings.Hash (Key.URI.all);
      H2 : constant Ada.Containers.Hash_Type := Ada.Strings.Hash (Key.Name.all);
   begin
      return H1 xor H2;
   end Hash;

   --  ------------------------------
   --  Returns true if both tag names are identical.
   --  ------------------------------
   function "=" (Left, Right : in Tag_Name) return Boolean is
   begin
      return Left.URI.all = Right.URI.all and Left.Name.all = Right.Name.all;
   end "=";

   --  ------------------------------
   --  Find the create function in bound to the name in the given URI namespace.
   --  Returns null if no such binding exist.
   --  ------------------------------
   function Find (Factory : in Component_Factory;
                  URI     : in String;
                  Name    : in String) return Binding_Access is
      Key : constant Tag_Name := Tag_Name '(URI  => URI'Unrestricted_Access,
                                            Name => Name'Unrestricted_Access);
      Pos : constant Factory_Maps.Cursor := Factory.Map.Find (Key);
   begin
      if Factory_Maps.Has_Element (Pos) then
         return Factory_Maps.Element (Pos);
      else
         return null;
      end if;
   end Find;

   --  ------------------------------
   --  Register a binding library in the factory
   --  ------------------------------
   procedure Register (Factory  : in out Component_Factory;
                       Bindings : in Factory_Bindings_Access) is
   begin
      Log.Info ("Register bindings: {0}", Bindings.URI.all);

      for I in Bindings.Bindings'Range loop
         declare
            Key : constant Tag_Name := Tag_Name '(URI  => Bindings.URI,
                                                  Name => Bindings.Bindings (I).Name);
         begin
            Factory.Map.Include (Key, Bindings.Bindings (I)'Access);
         end;
      end loop;
   end Register;

   --  ------------------------------
   --  Register the converter instance under the given name.
   --  ------------------------------
   procedure Register (Factory   : in out Component_Factory;
                       Name      : in String;
                       Converter : in ASF.Converters.Converter_Access) is
   begin
      Log.Info ("Register converter: {0}", Name);

      Factory.Converters.Include (EL.Objects.To_Object (Name), Converter);
   end Register;

   --  ------------------------------
   --  Find the converter instance that was registered under the given name.
   --  Returns null if no such converter exist.
   --  ------------------------------
   function Find (Factory : in Component_Factory;
                  Name    : in EL.Objects.Object) return ASF.Converters.Converter_Access is
      Pos : constant Converter_Maps.Cursor := Factory.Converters.Find (Name);
   begin
      if Converter_Maps.Has_Element (Pos) then
         return Converter_Maps.Element (Pos);
      else
         return null;
      end if;
   end Find;

   --  ------------------------------
   --  Register the validator instance under the given name.
   --  ------------------------------
   procedure Register (Factory   : in out Component_Factory;
                       Name      : in String;
                       Validator : in ASF.Validators.Validator_Access) is
   begin
      Log.Info ("Register validator: {0}", Name);

      Factory.Validators.Include (EL.Objects.To_Object (Name), Validator);
   end Register;

   --  ------------------------------
   --  Find the validator instance that was registered under the given name.
   --  Returns null if no such validator exist.
   --  ------------------------------
   function Find (Factory : in Component_Factory;
                  Name    : in EL.Objects.Object) return ASF.Validators.Validator_Access is
      Pos : constant Validator_Maps.Cursor := Factory.Validators.Find (Name);
   begin
      if Validator_Maps.Has_Element (Pos) then
         return Validator_Maps.Element (Pos);
      else
         return null;
      end if;
   end Find;

end ASF.Factory;

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

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ASF.Factory");

   --  ------------------------------
   --  Compute a hash for the tag name.
   --  ------------------------------
   function Hash (Key : in Tag_Name) return Ada.Containers.Hash_Type is
      use type Ada.Containers.Hash_Type;

      H1 : constant Ada.Containers.Hash_Type := Ada.Strings.Hash (Key.URI.all);
      H2 : constant Ada.Containers.Hash_Type := Ada.Strings.Hash (Key.Name.all);
   begin
      return H1 xor H2;
   end Hash;

   --  ------------------------------
   --  Returns true if both tag names are identical.
   --  ------------------------------
   function "=" (Left, Right : in Tag_Name) return Boolean is
   begin
      return Left.URI.all = Right.URI.all and Left.Name.all = Right.Name.all;
   end "=";

   --  ------------------------------
   --  Find the create function in bound to the name in the given URI namespace.
   --  Returns null if no such binding exist.
   --  ------------------------------
   function Find (Factory : in Component_Factory;
                  URI     : in String;
                  Name    : in String) return Binding_Type is
      Key : constant Tag_Name := Tag_Name '(URI  => URI'Unrestricted_Access,
                                            Name => Name'Unrestricted_Access);
      Pos : constant Factory_Maps.Cursor := Factory.Map.Find (Key);
   begin
      if Factory_Maps.Has_Element (Pos) then
         return Factory_Maps.Element (Pos);
      else
         return Null_Binding;
      end if;
   end Find;

   --  ------------------------------
   --  Register a binding library in the factory
   --  ------------------------------
   procedure Register (Factory  : in out Component_Factory;
                       Bindings : in Factory_Bindings_Access) is
   begin
      Log.Info ("Register bindings: {0}", Bindings.URI.all);

      for I in Bindings.Bindings'Range loop
         declare
            Key : constant Tag_Name := Tag_Name '(URI  => Bindings.URI,
                                                  Name => Bindings.Bindings (I).Name);
         begin
            Factory.Map.Include (Key, Bindings.Bindings (I));
         end;
      end loop;
   end Register;

   procedure Register (Factory   : in out Component_Factory;
                       URI       : in ASF.Views.Nodes.Name_Access;
                       Name      : in ASF.Views.Nodes.Name_Access;
                       Tag       : in ASF.Views.Nodes.Tag_Node_Create_Access;
                       Create    : in ASF.Views.Nodes.Create_Access) is
      Key  : constant Tag_Name := Tag_Name '(URI  => URI, Name => Name);
      Bind : constant Binding_Type := Binding_Type '(Name      => Name,
                                                     Tag       => Tag,
                                                     Component => Create);
   begin
      Factory.Map.Include (Key, Bind);
   end Register;

   --  ------------------------------
   --  Register the converter instance under the given name.
   --  ------------------------------
   procedure Register (Factory   : in out Component_Factory;
                       Name      : in String;
                       Converter : in ASF.Converters.Converter_Access) is
   begin
      Log.Info ("Register converter: {0}", Name);

      Factory.Converters.Include (EL.Objects.To_Object (Name), Converter);
   end Register;

   --  ------------------------------
   --  Find the converter instance that was registered under the given name.
   --  Returns null if no such converter exist.
   --  ------------------------------
   function Find (Factory : in Component_Factory;
                  Name    : in EL.Objects.Object) return ASF.Converters.Converter_Access is
      Pos : constant Converter_Maps.Cursor := Factory.Converters.Find (Name);
   begin
      if Converter_Maps.Has_Element (Pos) then
         return Converter_Maps.Element (Pos);
      else
         return null;
      end if;
   end Find;

   --  ------------------------------
   --  Register the validator instance under the given name.
   --  ------------------------------
   procedure Register (Factory   : in out Component_Factory;
                       Name      : in String;
                       Validator : in ASF.Validators.Validator_Access) is
   begin
      Log.Info ("Register validator: {0}", Name);

      Factory.Validators.Include (EL.Objects.To_Object (Name), Validator);
   end Register;

   --  ------------------------------
   --  Find the validator instance that was registered under the given name.
   --  Returns null if no such validator exist.
   --  ------------------------------
   function Find (Factory : in Component_Factory;
                  Name    : in EL.Objects.Object) return ASF.Validators.Validator_Access is
      Pos : constant Validator_Maps.Cursor := Factory.Validators.Find (Name);
   begin
      if Validator_Maps.Has_Element (Pos) then
         return Validator_Maps.Element (Pos);
      else
         return null;
      end if;
   end Find;

end ASF.Factory;

Update the Find procedure to return a Binding_Type Implement the Register procedure to register a single binding


--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

package Definitions is

   pragma Pure;

   raven_version_major : constant String := "1";
   raven_version_minor : constant String := "34";
   copyright_years     : constant String := "2015-2019";

   raven_tool        : constant String := "ravenadm";
   variant_standard  : constant String := "standard";
   contact_nobody    : constant String := "nobody";
   contact_automaton : constant String := "automaton";
   dlgroup_main      : constant String := "main";
   dlgroup_none      : constant String := "none";
   options_none      : constant String := "none";
   options_all       : constant String := "all";
   broken_all        : constant String := "all";
   boolean_yes       : constant String := "yes";
   homepage_none     : constant String := "none";
   spkg_complete     : constant String := "complete";
   spkg_docs         : constant String := "docs";
   spkg_examples     : constant String := "examples";
   ports_default     : constant String := "floating";
   default_ssl       : constant String := "libressl";
   default_mysql     : constant String := "oracle-5.7";
   default_lua       : constant String := "5.3";
   default_perl      : constant String := "5.30";
   default_pgsql     : constant String := "11";
   default_php       : constant String := "7.3";
   default_python3   : constant String := "3.7";
   default_ruby      : constant String := "2.5";
   default_tcltk     : constant String := "8.6";
   default_firebird  : constant String := "2.5";
   default_compiler  : constant String := "gcc8";
   compiler_version  : constant String := "8.3.0";
   previous_compiler : constant String := "8.2.0";
   binutils_version  : constant String := "2.33.1";
   previous_binutils : constant String := "2.32";
   arc_ext           : constant String := ".tzst";
   jobs_per_cpu      : constant := 2;

   type supported_opsys is (dragonfly, freebsd, netbsd, openbsd, sunos, linux, macos);
   type supported_arch  is (x86_64, i386, aarch64);

   type cpu_range is range 1 .. 64;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;
   type count_type is (total, success, failure, ignored, skipped);

   --  Modify following with post-patch sed accordingly
   platform_type  : constant supported_opsys := dragonfly;
   host_localbase : constant String := "/raven";
   raven_var      : constant String := "/var/ravenports";
   host_pkg8      : constant String := host_localbase & "/sbin/ravensw";
   ravenexec      : constant String := host_localbase & "/libexec/ravenexec";

end Definitions;

--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

package Definitions is

   pragma Pure;

   raven_version_major : constant String := "1";
   raven_version_minor : constant String := "34";
   copyright_years     : constant String := "2015-2019";

   raven_tool        : constant String := "ravenadm";
   variant_standard  : constant String := "standard";
   contact_nobody    : constant String := "nobody";
   contact_automaton : constant String := "automaton";
   dlgroup_main      : constant String := "main";
   dlgroup_none      : constant String := "none";
   options_none      : constant String := "none";
   options_all       : constant String := "all";
   broken_all        : constant String := "all";
   boolean_yes       : constant String := "yes";
   homepage_none     : constant String := "none";
   spkg_complete     : constant String := "complete";
   spkg_docs         : constant String := "docs";
   spkg_examples     : constant String := "examples";
   ports_default     : constant String := "floating";
   default_ssl       : constant String := "libressl";
   default_mysql     : constant String := "oracle-5.7";
   default_lua       : constant String := "5.3";
   default_perl      : constant String := "5.30";
   default_pgsql     : constant String := "11";
   default_php       : constant String := "7.3";
   default_python3   : constant String := "3.7";
   default_ruby      : constant String := "2.5";
   default_tcltk     : constant String := "8.6";
   default_firebird  : constant String := "2.5";
   default_compiler  : constant String := "gcc9";
   compiler_version  : constant String := "9.2.0";
   previous_compiler : constant String := "8.3.0";
   binutils_version  : constant String := "2.33.1";
   previous_binutils : constant String := "2.32";
   arc_ext           : constant String := ".tzst";
   jobs_per_cpu      : constant := 2;

   type supported_opsys is (dragonfly, freebsd, netbsd, openbsd, sunos, linux, macos);
   type supported_arch  is (x86_64, i386, aarch64);

   type cpu_range is range 1 .. 64;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;
   type count_type is (total, success, failure, ignored, skipped);

   --  Modify following with post-patch sed accordingly
   platform_type  : constant supported_opsys := dragonfly;
   host_localbase : constant String := "/raven";
   raven_var      : constant String := "/var/ravenports";
   host_pkg8      : constant String := host_localbase & "/sbin/ravensw";
   ravenexec      : constant String := host_localbase & "/libexec/ravenexec";

end Definitions;

Move ports compiler to gcc9

Move ports compiler to gcc9


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

with Ada.Strings.Unbounded;
with Ada.Calendar;
with Ada.Exceptions;

with Util.Properties.Bundles;
with Util.Beans.Objects.Time;
with Util.Dates.Formats;
with Util.Log.Loggers;

with ASF.Applications.Main;
with ASF.Locales;
package body ASF.Converters.Dates is

   use Ada.Strings.Unbounded;

   use Util.Log;

   --  The logger
   Log : constant Loggers.Logger := Loggers.Create ("ASF.Converters.Dates");

   --  ------------------------------
   --  Get the date format pattern that must be used for formatting a date on the given component.
   --  ------------------------------
   function Get_Pattern (Convert   : in Date_Converter;
                         Context   : in ASF.Contexts.Faces.Faces_Context'Class;
                         Component : in ASF.Components.Base.UIComponent'Class) return String is
      pragma Unreferenced (Convert);

      Pattern : constant String := Component.Get_Attribute (Context => Context,
                                                            Name    => "format",
                                                            Default => "%x");
   begin
      return Pattern;
   end Get_Pattern;

   --  ------------------------------
   --  Convert the object value into a string.  The object value is associated
   --  with the specified component.
   --  If the string cannot be converted, the Invalid_Conversion exception should be raised.
   --  ------------------------------
   function To_String (Convert   : in Date_Converter;
                       Context   : in ASF.Contexts.Faces.Faces_Context'Class;
                       Component : in ASF.Components.Base.UIComponent'Class;
                       Value     : in Util.Beans.Objects.Object) return String is
      Bundle  : ASF.Locales.Bundle;
      Pattern : constant String := Date_Converter'Class (Convert).Get_Pattern (Context, Component);
   begin
      begin
         Context.Get_Application.Load_Bundle (Name   => "dates",
                                              Locale => "en",
                                              Bundle => Bundle);

      exception
         when E : Util.Properties.Bundles.NO_BUNDLE =>
            Log.Error ("Cannot localize dates: {0}", Ada.Exceptions.Exception_Message (E));
      end;

      --  Convert the value as a date here so that we can raise an Invalid_Conversion exception.
      declare
         Date    : constant Ada.Calendar.Time := Util.Beans.Objects.Time.To_Time (Value);
         Result  : constant String := Util.Dates.Formats.Format (Pattern, Date, Bundle);
      begin
         return Result;
      end;
   exception
      when E : others =>
         raise Invalid_Conversion with Ada.Exceptions.Exception_Message (E);
   end To_String;

   --  ------------------------------
   --  Convert the date string into an object for the specified component.
   --  If the string cannot be converted, the Invalid_Conversion exception should be raised.
   --  ------------------------------
   function To_Object (Convert   : in Date_Converter;
                       Context   : in ASF.Contexts.Faces.Faces_Context'Class;
                       Component : in ASF.Components.Base.UIComponent'Class;
                       Value     : in String) return Util.Beans.Objects.Object is
      pragma Unreferenced (Convert, Context, Component, Value);
   begin
      Log.Error ("String to date conversion is not yet implemented");
      return Util.Beans.Objects.Null_Object;
   end To_Object;

end ASF.Converters.Dates;

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

with Ada.Calendar;
with Ada.Exceptions;

with Util.Properties.Bundles;
with Util.Beans.Objects.Time;
with Util.Dates.Formats;
with Util.Log.Loggers;

with ASF.Applications.Main;
with ASF.Locales;
package body ASF.Converters.Dates is

   use Util.Log;

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ASF.Converters.Dates");

   --  ------------------------------
   --  Get the date format pattern that must be used for formatting a date on the given component.
   --  ------------------------------
   function Get_Pattern (Convert   : in Date_Converter;
                         Context   : in ASF.Contexts.Faces.Faces_Context'Class;
                         Component : in ASF.Components.Base.UIComponent'Class) return String is
      pragma Unreferenced (Convert);

      Pattern : constant String := Component.Get_Attribute (Context => Context,
                                                            Name    => "format",
                                                            Default => "%x");
   begin
      return Pattern;
   end Get_Pattern;

   --  ------------------------------
   --  Convert the object value into a string.  The object value is associated
   --  with the specified component.
   --  If the string cannot be converted, the Invalid_Conversion exception should be raised.
   --  ------------------------------
   function To_String (Convert   : in Date_Converter;
                       Context   : in ASF.Contexts.Faces.Faces_Context'Class;
                       Component : in ASF.Components.Base.UIComponent'Class;
                       Value     : in Util.Beans.Objects.Object) return String is
      Bundle  : ASF.Locales.Bundle;
      Pattern : constant String := Date_Converter'Class (Convert).Get_Pattern (Context, Component);
   begin
      begin
         ASF.Applications.Main.Load_Bundle (Context.Get_Application.all,
                                            Name   => "dates",
                                            Locale => "en",
                                            Bundle => Bundle);

      exception
         when E : Util.Properties.Bundles.NO_BUNDLE =>
            Log.Error ("Cannot localize dates: {0}", Ada.Exceptions.Exception_Message (E));
      end;

      --  Convert the value as a date here so that we can raise an Invalid_Conversion exception.
      declare
         Date    : constant Ada.Calendar.Time := Util.Beans.Objects.Time.To_Time (Value);
         Result  : constant String := Util.Dates.Formats.Format (Pattern, Date, Bundle);
      begin
         return Result;
      end;
   exception
      when E : others =>
         raise Invalid_Conversion with Ada.Exceptions.Exception_Message (E);
   end To_String;

   --  ------------------------------
   --  Convert the date string into an object for the specified component.
   --  If the string cannot be converted, the Invalid_Conversion exception should be raised.
   --  ------------------------------
   function To_Object (Convert   : in Date_Converter;
                       Context   : in ASF.Contexts.Faces.Faces_Context'Class;
                       Component : in ASF.Components.Base.UIComponent'Class;
                       Value     : in String) return Util.Beans.Objects.Object is
      pragma Unreferenced (Convert, Context, Component, Value);
   begin
      Log.Error ("String to date conversion is not yet implemented");
      return Util.Beans.Objects.Null_Object;
   end To_Object;

end ASF.Converters.Dates;

Fix compilation warning

Fix compilation warning


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

--  The ASF.Converters.Dates defines the date converter to format a date object
--  into a localized representation.
--
--  See JSR 314 - JavaServer Faces Specification 9.4.3 <f:convertDateTime>
--  (To_String is the JSF getAsString method and To_Object is the JSF getAsObject method)
package ASF.Converters.Dates is

   --  ------------------------------
   --  Converter
   --  ------------------------------
   --  The Date_Converter translates the object value which holds an Ada.Calendar
   --  into a printable date representation.  It translates a string into an Ada Calendar time.
   --  Unlike the Java implementation, the instance will be shared by multiple
   --  views and requests.
   type Date_Converter is new Converter with null record;
   type Date_Converter_Access is access all Date_Converter'Class;

   --  Convert the object value into a string.  The object value is associated
   --  with the specified component.
   --  If the string cannot be converted, the Invalid_Conversion exception should be raised.
   function To_String (Convert   : in Date_Converter;
                       Context   : in ASF.Contexts.Faces.Faces_Context'Class;
                       Component : in ASF.Components.Base.UIComponent'Class;
                       Value     : in Util.Beans.Objects.Object) return String;

   --  Convert the date string into an object for the specified component.
   --  If the string cannot be converted, the Invalid_Conversion exception should be raised.
   function To_Object (Convert   : in Date_Converter;
                       Context   : in ASF.Contexts.Faces.Faces_Context'Class;
                       Component : in ASF.Components.Base.UIComponent'Class;
                       Value     : in String) return Util.Beans.Objects.Object;

   --  Get the date format pattern that must be used for formatting a date on the given component.
   function Get_Pattern (Convert   : in Date_Converter;
                         Context   : in ASF.Contexts.Faces.Faces_Context'Class;
                         Component : in ASF.Components.Base.UIComponent'Class) return String;

end ASF.Converters.Dates;

-----------------------------------------------------------------------
--  asf-converters-dates -- Date Converters
--  Copyright (C) 2011, 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Util.Beans.Objects;
with Util.Locales;
with ASF.Components.Base;
with ASF.Contexts.Faces;
with ASF.Locales;

--  The ASF.Converters.Dates defines the date converter to format a date object
--  into a localized representation.
--
--  See JSR 314 - JavaServer Faces Specification 9.4.3 <f:convertDateTime>
--  (To_String is the JSF getAsString method and To_Object is the JSF getAsObject method)
package ASF.Converters.Dates is

   type Style_Type is (DEFAULT, SHORT, MEDIUM, LONG, FULL);

   type Format_Type is (DATE, TIME, BOTH, CONVERTER_PATTERN, COMPONENT_FORMAT);

   --  ------------------------------
   --  Converter
   --  ------------------------------
   --  The Date_Converter translates the object value which holds an Ada.Calendar
   --  into a printable date representation.  It translates a string into an Ada Calendar time.
   --  Unlike the Java implementation, the instance will be shared by multiple
   --  views and requests.
   type Date_Converter is new Converter with private;
   type Date_Converter_Access is access all Date_Converter'Class;

   --  Convert the object value into a string.  The object value is associated
   --  with the specified component.
   --  If the string cannot be converted, the Invalid_Conversion exception should be raised.
   function To_String (Convert   : in Date_Converter;
                       Context   : in ASF.Contexts.Faces.Faces_Context'Class;
                       Component : in ASF.Components.Base.UIComponent'Class;
                       Value     : in Util.Beans.Objects.Object) return String;

   --  Convert the date string into an object for the specified component.
   --  If the string cannot be converted, the Invalid_Conversion exception should be raised.
   function To_Object (Convert   : in Date_Converter;
                       Context   : in ASF.Contexts.Faces.Faces_Context'Class;
                       Component : in ASF.Components.Base.UIComponent'Class;
                       Value     : in String) return Util.Beans.Objects.Object;

   --  Get the date format pattern that must be used for formatting a date on the given component.
   function Get_Pattern (Convert   : in Date_Converter;
                         Context   : in ASF.Contexts.Faces.Faces_Context'Class;
                         Bundle    : in ASF.Locales.Bundle;
                         Component : in ASF.Components.Base.UIComponent'Class) return String;

   --  Get the locale that must be used to format the date.
   function Get_Locale (Convert   : in Date_Converter;
                        Context   : in ASF.Contexts.Faces.Faces_Context'Class)
                        return Util.Locales.Locale;

   --  Create a date converter.
   function Create_Date_Converter (Date    : in Style_Type;
                                   Time    : in Style_Type;
                                   Format  : in Format_Type;
                                   Locale  : in String;
                                   Pattern : in String) return Date_Converter_Access;

private

   type Date_Converter is new Converter with record
      Date_Style : Style_Type := DEFAULT;
      Time_Style : Style_Type := DEFAULT;
      Format     : Format_Type;
      Locale     : Util.Locales.Locale;
      Pattern    : Ada.Strings.Unbounded.Unbounded_String;
   end record;

end ASF.Converters.Dates;

Add support for various date conversion formats defined in JSR-314 - new type Style_Type to define the pre-defined date and time formats - new type Format_Type to define the global date+time or pattern format - new operation Get_Locale to return the date conversion target locale - new function Create_Date_Converter to build the date converter instance - define in the Date_Converter instance the date, time, locale and pattern


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

with Util.Encoders.Base64;
package body Util.Streams.Buffered.Lzma is

   --  -----------------------
   --  Initialize the stream to write on the given stream.
   --  An internal buffer is allocated for writing the stream.
   --  -----------------------
   procedure Initialize (Stream  : in out Compress_Stream;
                         Output  : in Output_Stream_Access;
                         Size    : in Natural;
                         Format  : in String) is
   begin
      Stream.Initialize (Output, Size);
      Stream.Transform := new Util.Encoders.Lzma.Compress;
   end Initialize;

   --  -----------------------
   --  Close the sink.
   --  -----------------------
   overriding
   procedure Close (Stream : in out Compress_Stream) is
   begin
      Stream.Flush;
      Stream.Output.Close;
   end Close;

   --  -----------------------
   --  Write the buffer array to the output stream.
   --  -----------------------
   overriding
   procedure Write (Stream : in out Compress_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array) is
      First_Encoded : Ada.Streams.Stream_Element_Offset := Buffer'First;
      Last_Encoded  : Ada.Streams.Stream_Element_Offset;
      Last_Pos      : Ada.Streams.Stream_Element_Offset;
   begin
      while First_Encoded <= Buffer'Last loop
         Stream.Transform.Transform
           (Data    => Buffer (First_Encoded .. Buffer'Last),
            Into    => Stream.Buffer (Stream.Write_Pos .. Stream.Buffer'Last),
            Last    => Last_Pos,
            Encoded => Last_Encoded);
         if Last_Encoded < Buffer'Last then
            Stream.Output.Write (Stream.Buffer (Stream.Buffer'First .. Last_Pos));
            Stream.Write_Pos := Stream.Buffer'First;
         else
            Stream.Write_Pos := Last_Pos + 1;
         end if;
         First_Encoded := Last_Encoded + 1;
      end loop;
   end Write;

   --  -----------------------
   --  Flush the buffer by writing on the output stream.
   --  Raises Data_Error if there is no output stream.
   --  -----------------------
   overriding
   procedure Flush (Stream : in out Compress_Stream) is
      Last_Pos : Ada.Streams.Stream_Element_Offset;
   begin
      loop
         Stream.Transform.Finish (Stream.Buffer (Stream.Write_Pos .. Stream.Buffer'Last),
                                  Last_Pos);
         Stream.Write_Pos := Last_Pos + 1;
         Output_Buffer_Stream (Stream).Flush;
         exit when Stream.Write_Pos < Stream.Buffer'Last;
         Stream.Write_Pos := 1;
      end loop;
   end Flush;

   --  -----------------------
   --  Flush the stream and release the buffer.
   --  -----------------------
   overriding
   procedure Finalize (Object : in out Compress_Stream) is
   begin
      null;
   end Finalize;

end Util.Streams.Buffered.Lzma;

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

with Util.Encoders.Lzma;
package body Util.Streams.Buffered.Lzma is

   --  -----------------------
   --  Initialize the stream to write on the given stream.
   --  An internal buffer is allocated for writing the stream.
   --  -----------------------
   procedure Initialize (Stream  : in out Compress_Stream;
                         Output  : in Output_Stream_Access;
                         Size    : in Natural;
                         Format  : in String) is
   begin
      Stream.Initialize (Output, Size);
      Stream.Transform := new Util.Encoders.Lzma.Compress;
   end Initialize;

   --  -----------------------
   --  Close the sink.
   --  -----------------------
   overriding
   procedure Close (Stream : in out Compress_Stream) is
   begin
      Stream.Flush;
      Stream.Output.Close;
   end Close;

   --  -----------------------
   --  Write the buffer array to the output stream.
   --  -----------------------
   overriding
   procedure Write (Stream : in out Compress_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array) is
      First_Encoded : Ada.Streams.Stream_Element_Offset := Buffer'First;
      Last_Encoded  : Ada.Streams.Stream_Element_Offset;
      Last_Pos      : Ada.Streams.Stream_Element_Offset;
   begin
      while First_Encoded <= Buffer'Last loop
         Stream.Transform.Transform
           (Data    => Buffer (First_Encoded .. Buffer'Last),
            Into    => Stream.Buffer (Stream.Write_Pos .. Stream.Buffer'Last),
            Last    => Last_Pos,
            Encoded => Last_Encoded);
         if Last_Encoded < Buffer'Last then
            Stream.Output.Write (Stream.Buffer (Stream.Buffer'First .. Last_Pos));
            Stream.Write_Pos := Stream.Buffer'First;
         else
            Stream.Write_Pos := Last_Pos + 1;
         end if;
         First_Encoded := Last_Encoded + 1;
      end loop;
   end Write;

   --  -----------------------
   --  Flush the buffer by writing on the output stream.
   --  Raises Data_Error if there is no output stream.
   --  -----------------------
   overriding
   procedure Flush (Stream : in out Compress_Stream) is
      Last_Pos : Ada.Streams.Stream_Element_Offset := Stream.Write_Pos - 1;
   begin
      loop
         Stream.Transform.Finish (Stream.Buffer (Stream.Write_Pos .. Stream.Buffer'Last),
                                  Last_Pos);
         Stream.Write_Pos := Last_Pos + 1;
         Output_Buffer_Stream (Stream).Flush;
         exit when Stream.Write_Pos < Stream.Buffer'Last;
         Stream.Write_Pos := 1;
      end loop;
   end Flush;

   --  -----------------------
   --  Flush the stream and release the buffer.
   --  -----------------------
   overriding
   procedure Finalize (Object : in out Compress_Stream) is
   begin
      null;
   end Finalize;

end Util.Streams.Buffered.Lzma;

Fix compilation warning

Fix compilation warning


-----------------------------------------------------------------------
--  volume_server -- Example of server with a servlet
--  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 Volume_Servlet;

procedure Volume_Server is
   Compute : aliased Volume_Servlet.Servlet;
   App     : aliased ASF.Servlets.Servlet_Registry;
   WS      : ASF.Server.Web.AWS_Container;
begin
   --  Register the servlets and filters
   App.Add_Servlet (Name => "compute", Server => Compute'Unchecked_Access);

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

   WS.Register_Application ("/volume", App'Unchecked_Access);

   WS.Start;

   delay 60.0;

end Volume_Server;

-----------------------------------------------------------------------
--  volume_server -- Example of server with a servlet
--  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 Volume_Servlet;
with Util.Log.Loggers;

procedure Volume_Server is
   Compute : aliased Volume_Servlet.Servlet;
   App     : aliased ASF.Servlets.Servlet_Registry;
   WS      : ASF.Server.Web.AWS_Container;
   Log     : Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Volume_Server");
begin
   --  Register the servlets and filters
   App.Add_Servlet (Name => "compute", Server => Compute'Unchecked_Access);

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

   WS.Register_Application ("/volume", App'Unchecked_Access);

   Log.Info ("Connect you browser to: http://localhost:8080/volume/compute.html");

   WS.Start;

   delay 60.0;

end Volume_Server;

Add a log message to indicate the URL to connect to