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

--  == Writer interfaces ==
--  The <tt>Wiki.Writers</tt> package defines the interfaces used by the renderer to write
--  their outputs.
--
package Wiki.Writers is

   use Ada.Strings.Wide_Wide_Unbounded;

   type Writer_Type is limited interface;
   type Writer_Type_Access is access all Writer_Type'Class;

   procedure Write (Writer  : in out Writer_Type;
                    Content : in Wide_Wide_String) is abstract;

   --  Write a single character to the string builder.
   procedure Write (Writer : in out Writer_Type;
                    Char   : in Wide_Wide_Character) is abstract;

   procedure Write (Writer  : in out Writer_Type;
                    Content : in Unbounded_Wide_Wide_String) is abstract;

   type Html_Writer_Type is limited interface and Writer_Type;
   type Html_Writer_Type_Access is access all Html_Writer_Type'Class;

   --  Write an XML element using the given name and with the content.
   --  This is similar to calling Start_Element, Write_Text
   --  and End_Element.
   procedure Write_Wide_Element (Writer  : in out Html_writer_Type;
                                 Name    : in String;
                                 Content : in Unbounded_Wide_Wide_String) is abstract;

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   procedure Write_Wide_Attribute (Writer  : in out Html_writer_Type;
                                   Name    : in String;
                                   Content : in Unbounded_Wide_Wide_String) is abstract;

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   procedure Write_Wide_Attribute (Writer  : in out Html_writer_Type;
                                   Name    : in String;
                                   Content : in Wide_Wide_String) is abstract;

   --  Start an XML element with the given name.
   procedure Start_Element (Writer : in out Html_Writer_Type;
                            Name   : in String) is abstract;

   --  Closes an XML element of the given name.
   procedure End_Element (Writer : in out Html_Writer_Type;
                          Name   : in String) is abstract;

   --  Write a text escaping any character as necessary.
   procedure Write_Wide_Text (Writer  : in out Html_Writer_Type;
                              Content : in Unbounded_Wide_Wide_String) is abstract;

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   procedure Write_Attribute (Writer  : in out Html_writer_Type'Class;
                              Name    : in String;
                              Content : in String);

end Wiki.Writers;

-----------------------------------------------------------------------
--  wiki-writers -- Wiki writers
--  Copyright (C) 2011, 2012, 2013, 2015, 2016 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.Wide_Wide_Unbounded;

--  == Writer interfaces ==
--  The <tt>Wiki.Writers</tt> package defines the interfaces used by the renderer to write
--  their outputs.
--
package Wiki.Writers is

   use Ada.Strings.Wide_Wide_Unbounded;

   type Writer_Type is limited interface;
   type Writer_Type_Access is access all Writer_Type'Class;

   procedure Write (Writer  : in out Writer_Type;
                    Content : in Wide_Wide_String) is abstract;

   --  Write a single character to the string builder.
   procedure Write (Writer : in out Writer_Type;
                    Char   : in Wide_Wide_Character) is abstract;

   procedure Write (Writer  : in out Writer_Type;
                    Content : in Unbounded_Wide_Wide_String) is abstract;

   type Html_Writer_Type is limited interface and Writer_Type;
   type Html_Writer_Type_Access is access all Html_Writer_Type'Class;

   --  Write an XML element using the given name and with the content.
   --  This is similar to calling Start_Element, Write_Text
   --  and End_Element.
   procedure Write_Wide_Element (Writer  : in out Html_Writer_Type;
                                 Name    : in String;
                                 Content : in Unbounded_Wide_Wide_String) is abstract;

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   procedure Write_Wide_Attribute (Writer  : in out Html_Writer_Type;
                                   Name    : in String;
                                   Content : in Unbounded_Wide_Wide_String) is abstract;

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   procedure Write_Wide_Attribute (Writer  : in out Html_Writer_Type;
                                   Name    : in String;
                                   Content : in Wide_Wide_String) is abstract;

   --  Start an XML element with the given name.
   procedure Start_Element (Writer : in out Html_Writer_Type;
                            Name   : in String) is abstract;

   --  Closes an XML element of the given name.
   procedure End_Element (Writer : in out Html_Writer_Type;
                          Name   : in String) is abstract;

   --  Write a text escaping any character as necessary.
   procedure Write_Wide_Text (Writer  : in out Html_Writer_Type;
                              Content : in Unbounded_Wide_Wide_String) is abstract;

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   procedure Write_Attribute (Writer  : in out Html_Writer_Type'Class;
                              Name    : in String;
                              Content : in String);

end Wiki.Writers;

Fix compilation style warnings

Fix compilation style warnings


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

with AWA.Counters.Modules;
package body AWA.Counters is

   use type Util.Strings.Name_Access;
   use type ADO.Schemas.Class_Mapping_Access;

   function "&" (Left  : in String;
                 Right : in Counter_Def) return String is
   begin
      if Right.Table = null then
         return Left & "[" & Right.Field.all & "]";
      else
         return Left & "[" & Right.Table.Table.all & ", " & Right.Field.all & "]";
      end if;
   end "&";

   function "=" (Left, Right : in Counter_Def) return Boolean is
   begin
      return Left.Table = Right.Table and Left.Field = Right.Field;
   end "=";

   function "<" (Left, Right : in Counter_Def) return Boolean is
   begin
      if Left.Table = Right.Table then
         return Left.Field.all < Right.Field.all;
      elsif Left.Table = null then
         return False;
      elsif Right.Table = null then
         return True;
      else
         return Left.Table.Table.all < Right.Table.Table.all;
      end if;
   end "<";

   --  ------------------------------
   --  Increment the counter identified by <tt>Counter</tt> and associated with the
   --  database object <tt>Object</tt>.
   --  ------------------------------
   procedure Increment (Counter : in Counter_Index_Type;
                        Object  : in ADO.Objects.Object_Ref'Class) is
      Module : constant AWA.Counters.Modules.Counter_Module_Access
        := AWA.Counters.Modules.Get_Counter_Module;
   begin
      Module.Increment (Counter, Object);
   end Increment;

   --  ------------------------------
   --  Increment the global counter identified by <tt>Counter</tt>.
   --  ------------------------------
   procedure Increment (Counter : in Counter_Index_Type) is
      Module : constant AWA.Counters.Modules.Counter_Module_Access
        := AWA.Counters.Modules.Get_Counter_Module;
   begin
      Module.Increment (Counter);
   end Increment;

end AWA.Counters;

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

with AWA.Counters.Modules;
package body AWA.Counters is

   use type Util.Strings.Name_Access;
   use type ADO.Schemas.Class_Mapping_Access;

   function "&" (Left  : in String;
                 Right : in Counter_Def) return String is
   begin
      if Right.Table = null then
         return Left & "[" & Right.Field.all & "]";
      else
         return Left & "[" & Right.Table.Table.all & ", " & Right.Field.all & "]";
      end if;
   end "&";

   function "=" (Left, Right : in Counter_Def) return Boolean is
   begin
      return Left.Table = Right.Table and Left.Field = Right.Field;
   end "=";

   function "<" (Left, Right : in Counter_Def) return Boolean is
   begin
      if Left.Table = Right.Table then
         return Left.Field.all < Right.Field.all;
      elsif Left.Table = null then
         return False;
      elsif Right.Table = null then
         return True;
      else
         return Left.Table.Table.all < Right.Table.Table.all;
      end if;
   end "<";

   --  ------------------------------
   --  Increment the counter identified by <tt>Counter</tt> and associated with the
   --  database object <tt>Object</tt>.
   --  ------------------------------
   procedure Increment (Counter : in Counter_Index_Type;
                        Object  : in ADO.Objects.Object_Ref'Class) is
      Module : constant AWA.Counters.Modules.Counter_Module_Access
        := AWA.Counters.Modules.Get_Counter_Module;
   begin
      Module.Increment (Counter, Object);
   end Increment;

   --  ------------------------------
   --  Increment the counter identified by <tt>Counter</tt> and associated with the
   --  database object key <tt>Key</tt>.
   --  ------------------------------
   procedure Increment (Counter : in Counter_Index_Type;
                        Key     : in ADO.Objects.Object_Key) is
      Module : constant AWA.Counters.Modules.Counter_Module_Access
        := AWA.Counters.Modules.Get_Counter_Module;
   begin
      Module.Increment (Counter, Key);
   end Increment;

   --  ------------------------------
   --  Increment the global counter identified by <tt>Counter</tt>.
   --  ------------------------------
   procedure Increment (Counter : in Counter_Index_Type) is
      Module : constant AWA.Counters.Modules.Counter_Module_Access
        := AWA.Counters.Modules.Get_Counter_Module;
   begin
      Module.Increment (Counter);
   end Increment;

end AWA.Counters;

Implement the Increment procedure with Object_Key type


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

package body AWA.Votes.Beans is

   --  ------------------------------
   --  Action to vote up.
   --  ------------------------------
   overriding
   procedure Vote_Up (Bean    : in out Vote_Bean;
                      Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      null;
   end Vote_Up;

   --  ------------------------------
   --  Action to vote down.
   --  ------------------------------
   overriding
   procedure Vote_Down (Bean    : in out Vote_Bean;
                        Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      null;
   end Vote_Down;

   --  ------------------------------
   --  Create the Vote_Bean bean instance.
   --  ------------------------------
   function Create_Vote_Bean (Module : in AWA.Votes.Modules.Vote_Module_Access)
      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Vote_Bean_Access := new Vote_Bean;
   begin
--        Object.Module := Module;
      return Object.all'Access;
   end Create_Vote_Bean;

end AWA.Votes.Beans;

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

package body AWA.Votes.Beans is

   --  ------------------------------
   --  Action to vote up.
   --  ------------------------------
   overriding
   procedure Vote_Up (Bean    : in out Vote_Bean;
                      Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Bean.Module.Vote_For (Permission  => Ada.Strings.Unbounded.To_String (Bean.Permission),
                            Entity_Type => Ada.Strings.Unbounded.To_String (Bean.Entity_Type),
                            Id          => Bean.Entity_Id,
                            Rating      => 1);
   end Vote_Up;

   --  ------------------------------
   --  Action to vote down.
   --  ------------------------------
   overriding
   procedure Vote_Down (Bean    : in out Vote_Bean;
                        Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Bean.Module.Vote_For (Permission  => Ada.Strings.Unbounded.To_String (Bean.Permission),
                            Entity_Type => Ada.Strings.Unbounded.To_String (Bean.Entity_Type),
                            Id          => Bean.Entity_Id,
                            Rating      => -1);
   end Vote_Down;

   --  ------------------------------
   --  Create the Vote_Bean bean instance.
   --  ------------------------------
   function Create_Vote_Bean (Module : in AWA.Votes.Modules.Vote_Module_Access)
      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Vote_Bean_Access := new Vote_Bean;
   begin
      Object.Module := Module;
      return Object.all'Access;
   end Create_Vote_Bean;

end AWA.Votes.Beans;

Implement the vote bean using the vote module


-----------------------------------------------------------------------
--  util-encoders -- Encode/Decode streams and strings from one format to another
--  Copyright (C) 2009, 2010, 2011, 2012, 2016, 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.Streams;
with Ada.Finalization;
with Interfaces;

--  The Util.Encoders package defines the Encoder object
--  which represents a mechanism to transform a stream from one format into
--  another format.
package Util.Encoders is

   pragma Preelaborate;

   Not_Supported  : exception;
   Encoding_Error : exception;

   --  Encoder/decoder for Base64 (RFC 4648)
   BASE_64     : constant String := "base64";

   --  Encoder/decoder for Base64 (RFC 4648) using the URL alphabet
   --  (+ and / are replaced by - and _)
   BASE_64_URL : constant String := "base64url";

   --  Encoder/decoder for Base16 (RFC 4648)
   BASE_16     : constant String := "base16";
   HEX         : constant String := "hex";

   --  Encoder for SHA1 (RFC 3174)
   HASH_SHA1   : constant String := "sha1";

   --  ------------------------------
   --  Encoder context object
   --  ------------------------------
   --  The Encoder provides operations to encode and decode
   --  strings or stream of data from one format to another.
   --  The Encoded contains two Transformer
   --  which either encodes or decodes the stream.
   type Encoder is tagged limited private;

   --  Encodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be encoded.
   --  Raises the Not_Supported exception if the encoding is not
   --  supported.
   function Encode (E    : in Encoder;
                    Data : in String) return String;

   --  Decodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be decoded.
   --  Raises the Not_Supported exception if the decoding is not
   --  supported.
   function Decode (E    : in Encoder;
                    Data : in String) return String;

   --  Create the encoder object for the specified encoding format.
   function Create (Name : String) return Encoder;

   --  ------------------------------
   --  Stream Transformation interface
   --  ------------------------------
   --  The Transformer interface defines the operation to transform
   --  a stream from one data format to another.
   type Transformer is limited interface;
   type Transformer_Access is access all Transformer'Class;

   --  Transform the input stream represented by Data into
   --  the output stream Into.  The transformation made by
   --  the object can be of any nature (Hex encoding, Base64 encoding,
   --  Hex decoding, Base64 decoding, ...).
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   procedure Transform (E       : in out Transformer;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset) is abstract;

   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   function Transform (E    : in out Transformer'Class;
                       Data : in String) return String;

   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   function Transform (E    : in out Transformer'Class;
                       Data : in Ada.Streams.Stream_Element_Array) return String;

   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer and return the data in
   --  the Into array, setting Last to the last index.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   procedure Transform (E    : in out Transformer'Class;
                        Data : in String;
                        Into : out Ada.Streams.Stream_Element_Array;
                        Last : out Ada.Streams.Stream_Element_Offset);

   --  Encode the value represented by <tt>Val</tt> in the stream array <tt>Into</tt> starting
   --  at position <tt>Pos</tt> in that array.  The value is encoded using LEB128 format, 7-bits
   --  at a time until all non zero bits are written.  The <tt>Last</tt> parameter is updated
   --  to indicate the position of the last valid byte written in <tt>Into</tt>.
   procedure Encode_LEB128 (Into  : in out Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : in Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset);

   --  Decode from the byte array <tt>From</tt> the value represented as LEB128 format starting
   --  at position <tt>Pos</tt> in that array.  After decoding, the <tt>Last</tt> index is updated
   --  to indicate the last position in the byte array.
   procedure Decode_LEB128 (From  : in Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : out Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset);

private

   type Encoder is new Ada.Finalization.Limited_Controlled with record
      Encode : Transformer_Access := null;
      Decode : Transformer_Access := null;
   end record;

   --  Delete the transformers
   overriding
   procedure Finalize (E : in out Encoder);

end Util.Encoders;

-----------------------------------------------------------------------
--  util-encoders -- Encode/Decode streams and strings from one format to another
--  Copyright (C) 2009, 2010, 2011, 2012, 2016, 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.Streams;
with Ada.Finalization;
with Interfaces;

--  === Encoder and Decoders ===
--  The Util.Encoders package defines the Encoder and Decode objects
--  which provide a mechanism to transform a stream from one format into
--  another format.
--
--  ==== Simple encoding and decoding ====
--
package Util.Encoders is

   pragma Preelaborate;

   Not_Supported  : exception;
   Encoding_Error : exception;

   --  Encoder/decoder for Base64 (RFC 4648)
   BASE_64     : constant String := "base64";

   --  Encoder/decoder for Base64 (RFC 4648) using the URL alphabet
   --  (+ and / are replaced by - and _)
   BASE_64_URL : constant String := "base64url";

   --  Encoder/decoder for Base16 (RFC 4648)
   BASE_16     : constant String := "base16";
   HEX         : constant String := "hex";

   --  Encoder for SHA1 (RFC 3174)
   HASH_SHA1   : constant String := "sha1";

   --  ------------------------------
   --  Encoder context object
   --  ------------------------------
   --  The Encoder provides operations to encode and decode
   --  strings or stream of data from one format to another.
   --  The Encoded contains two Transformer
   --  which either encodes or decodes the stream.
   type Encoder is tagged limited private;

   --  Encodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be encoded.
   --  Raises the Not_Supported exception if the encoding is not
   --  supported.
   function Encode (E    : in Encoder;
                    Data : in String) return String;

   --  Create the encoder object for the specified encoding format.
   function Create (Name : in String) return Encoder;

   type Decoder is tagged limited private;

   --  Decodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be decoded.
   --  Raises the Not_Supported exception if the decoding is not
   --  supported.
   function Decode (E    : in Decoder;
                    Data : in String) return String;

   --  Create the decoder object for the specified encoding format.
   function Create (Name : in String) return Decoder;

   --  ------------------------------
   --  Stream Transformation interface
   --  ------------------------------
   --  The Transformer interface defines the operation to transform
   --  a stream from one data format to another.
   type Transformer is limited interface;
   type Transformer_Access is access all Transformer'Class;

   --  Transform the input array represented by Data into
   --  the output array Into.  The transformation made by
   --  the object can be of any nature (Hex encoding, Base64 encoding,
   --  Hex decoding, Base64 decoding, encryption, compression, ...).
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data array.
   --
   --  The transformer returns in Last the last valid position
   --  in the output array Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  array cannot be transformed.
   procedure Transform (E       : in out Transformer;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset) is abstract;

   --  Finish encoding the input array.
   procedure Finish (E    : in out Transformer;
                     Into : in out Ada.Streams.Stream_Element_Array;
                     Last : in out Ada.Streams.Stream_Element_Offset) is null;

   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   function Transform (E    : in out Transformer'Class;
                       Data : in String) return String;

   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   function Transform (E    : in out Transformer'Class;
                       Data : in Ada.Streams.Stream_Element_Array) return String;

   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer and return the data in
   --  the Into array, setting Last to the last index.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   procedure Transform (E    : in out Transformer'Class;
                        Data : in String;
                        Into : out Ada.Streams.Stream_Element_Array;
                        Last : out Ada.Streams.Stream_Element_Offset);

   --  Encode the value represented by <tt>Val</tt> in the stream array <tt>Into</tt> starting
   --  at position <tt>Pos</tt> in that array.  The value is encoded using LEB128 format, 7-bits
   --  at a time until all non zero bits are written.  The <tt>Last</tt> parameter is updated
   --  to indicate the position of the last valid byte written in <tt>Into</tt>.
   procedure Encode_LEB128 (Into  : in out Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : in Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset);

   --  Decode from the byte array <tt>From</tt> the value represented as LEB128 format starting
   --  at position <tt>Pos</tt> in that array.  After decoding, the <tt>Last</tt> index is updated
   --  to indicate the last position in the byte array.
   procedure Decode_LEB128 (From  : in Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : out Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset);

private

   type Encoder is new Ada.Finalization.Limited_Controlled with record
      Encode : Transformer_Access := null;
   end record;

   --  Delete the transformers
   overriding
   procedure Finalize (E : in out Encoder);

   type Decoder is new Ada.Finalization.Limited_Controlled with record
      Decode : Transformer_Access := null;
   end record;

   --  Delete the transformers
   overriding
   procedure Finalize (E : in out Decoder);

end Util.Encoders;

Refactor the encoders - Declare the Decoder type to separate the Encoder from the Decoder - Declare a Create function for the Decoder - Declare a Finish operation for the Transformer interface


-----------------------------------------------------------------------
--  measure -- Benchmark tools
--  Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 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.Task_Attributes;
with Ada.Strings.Hash;
with Ada.Unchecked_Deallocation;
with GNAT.Calendar.Time_IO;

with Util.Streams.Buffered;
with Util.Streams.Texts.TR;
package body Util.Measures is

   ISO_DATE_TIME : constant GNAT.Calendar.Time_IO.Picture_String := "%Y-%m-%d %H:%M:%S";

   procedure Free is
     new Ada.Unchecked_Deallocation (Buckets_Type, Buckets_Access);

   procedure Free is
     new Ada.Unchecked_Deallocation (Measure, Measure_Access);

   procedure Free is
     new Ada.Unchecked_Deallocation (String, String_Access);

   package Task_Context is new Ada.Task_Attributes
     (Measure_Set_Access, null);

   function Format (D : in Duration) return String;

   --  Format the duration in a time in 'ns', 'us', 'ms' or seconds.
   function Format (D    : in Duration;
                    Unit : in Unit_Type) return String;

   --  ------------------------------
   --  Disable collecting measures on the measure set.
   --  ------------------------------
   procedure Disable (Measures : in out Measure_Set) is
   begin
      Measures.Enabled := False;
   end Disable;

   --  ------------------------------
   --  Enable collecting measures on the measure set.
   --  ------------------------------
   procedure Enable (Measures : in out Measure_Set) is
   begin
      Measures.Enabled := True;
   end Enable;

   --  ------------------------------
   --  Set the per-thread measure set.
   --  ------------------------------
   procedure Set_Current (Measures : in Measure_Set_Access) is
   begin
      Task_Context.Set_Value (Measures);
   end Set_Current;

   --  ------------------------------
   --  Get the per-thread measure set.
   --  ------------------------------
   function Get_Current return Measure_Set_Access is
   begin
      return Task_Context.Value;
   end Get_Current;

   --  ------------------------------
   --  Dump an XML result with the measures collected by the measure set.
   --  When writing the measures, the measure set is cleared.  It is safe
   --  to write measures while other measures are being collected.
   --  ------------------------------
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Stream   : in out Util.Streams.Texts.Print_Stream'Class) is

      use Util.Streams.Buffered;

      procedure Dump_XML (Item : in Measure_Access);

      procedure Dump_XML (Item : in Measure_Access) is
         Total : constant String := Format (Item.Time);
         Time  : constant String := Format (Item.Time / Item.Count);
      begin
         Stream.Write ("<time count=""");
         Stream.Write (Item.Count);
         Stream.Write (""" time=""");
         Stream.Write (Time (Time'First + 1 .. Time'Last));
         if Item.Count > 1 then
            Stream.Write (""" total=""");
            Stream.Write (Total (Total'First + 1 .. Total'Last));
         end if;
         Stream.Write (""" title=""");
         Util.Streams.Texts.TR.Escape_Java_Script (Into => Stream,
                                                   Content => Item.Name.all);
         Stream.Write ("""/>");
         Stream.Write (ASCII.LF);
      end Dump_XML;

      Buckets : Buckets_Access;
      TS, TE  : Ada.Calendar.Time;

   begin
      Measures.Data.Steal_Map (Buckets, TS, TE);
      Stream.Write ("<measures title=""");
      Util.Streams.Texts.TR.Escape_Java_Script (Into    => Stream,
                                                Content => Title);
      Stream.Write (""" start=""");
      Stream.Write (TS, ISO_DATE_TIME);
      Stream.Write (""" end=""");
      Stream.Write (TE, ISO_DATE_TIME);
      Stream.Write (""">");
      if Buckets /= null then
         begin
            for I in Buckets'Range loop
               declare
                  Next : Measure_Access;
                  Node : Measure_Access := Buckets (I);
               begin
                  while Node /= null loop
                     Dump_XML (Node);
                     Free (Node.Name);
                     Next := Node.Next;
                     Free (Node);
                     Node := Next;
                  end loop;
               end;
            end loop;

         exception
            when others =>
               Free (Buckets);
               raise;
         end;
         Free (Buckets);
      end if;
      Stream.Write ("</measures>");
   end Write;

   --  ------------------------------
   --  Dump an XML result with the measures collected by the measure set.
   --  ------------------------------
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Stream   : in Ada.Text_IO.File_Type) is

      Buffer : aliased Util.Streams.Buffered.Buffered_Stream;
      Output : Util.Streams.Texts.Print_Stream;

   begin
      Buffer.Initialize (Size => 128 * 1024);
      Output.Initialize (To => Buffer'Unchecked_Access);
      Write (Measures, Title, Output);
      Output.Flush;
      Ada.Text_IO.Put_Line (Stream, Util.Streams.Texts.To_String (Buffer));
   end Write;

   --  ------------------------------
   --  Dump  an XML result with the measures in a file.
   --  ------------------------------
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Path     : in String) is
      File : Ada.Text_IO.File_Type;
   begin
      Ada.Text_IO.Create (File => File, Name => Path);
      Write (Measures, Title, File);
      Ada.Text_IO.Close (File);
   exception
      when others =>
         if Ada.Text_IO.Is_Open (File) then
            Ada.Text_IO.Close (File);
         end if;
         raise;
   end Write;

   --  ------------------------------
   --  Report the time spent between the stamp creation and this method call.
   --  Collect the result in the per-thread measure set under the given measure
   --  title.
   --  ------------------------------
   procedure Report (S     : in out Stamp;
                     Title : in String;
                     Count : in Positive := 1) is
      Measures : constant Measure_Set_Access := Task_Context.Value;
   begin
      if Measures /= null and then Measures.Enabled then
         Report (Measures.all, S, Title, Count);
      end if;
   end Report;

   --  ------------------------------
   --  Report the time spent between the stamp creation and this method call.
   --  Collect the result in the measure set under the given measure title.
   --  ------------------------------
   procedure Report (Measures : in out Measure_Set;
                     S        : in out Stamp;
                     Title    : in String;
                     Count    : in Positive := 1) is
      use Ada.Calendar;
   begin
      if Measures.Enabled then
         declare
            D : constant Duration := Ada.Calendar.Clock - S.Start;
         begin
            Measures.Data.Add (Title, D, Count);
         end;
         S.Start := Ada.Calendar.Clock;
      end if;
   end Report;

   --  ------------------------------
   --  Report the time spent between the stamp creation and this method call.
   --  The report is written in the file with the given title.  The duration is
   --  expressed in the unit defined in <tt>Unit</tt>.
   --  ------------------------------
   procedure Report (S     : in out Stamp;
                     File  : in out Ada.Text_IO.File_Type;
                     Title : in String;
                     Unit  : in Unit_Type := Microseconds) is
      use Ada.Calendar;

      D : constant Duration := Ada.Calendar.Clock - S.Start;
   begin
      Ada.Text_IO.Put (File, Title);
      Ada.Text_IO.Put (File, Format (D, Unit));
      S.Start := Ada.Calendar.Clock;
   end Report;

   protected body Measure_Data is

      --  ------------------------------
      --  Get the measures and clear to start a new set of measures.
      --  Return in Time_Start and Time_End the period of time.
      --  ------------------------------
      procedure Steal_Map (Result     : out Buckets_Access;
                           Time_Start : out Ada.Calendar.Time;
                           Time_End   : out Ada.Calendar.Time) is
      begin
         Result     := Buckets;
         Time_Start := Start;
         Start      := Ada.Calendar.Clock;
         Time_End   := Start;
         Buckets    := null;
      end Steal_Map;

      --  ------------------------------
      --  Add the measure
      --  ------------------------------
      procedure Add (Title : in String;
                     D     : in Duration;
                     Count : in Positive := 1) is

         use Ada.Containers;
         use Ada.Calendar;

         Pos  : Hash_Type;
         Node : Measure_Access;
      begin
         if Buckets = null then
            Buckets := new Buckets_Type (0 .. 256);
         end if;
         Pos := Ada.Strings.Hash (Title) mod Buckets'Length;
         Node := Buckets (Pos);
         while Node /= null loop
            if Node.Name'Length = Title'Length
              and then Node.Name.all = Title
            then
               Node.Count := Node.Count + Count;
               Node.Time := Node.Time + D;
               return;
            end if;
            Node := Node.Next;
         end loop;
         Buckets (Pos) := new Measure '(Name => new String '(Title),
                                        Time  => D,
                                        Count => Count,
                                        Next  => Buckets (Pos));
      end Add;

   end Measure_Data;

   --  ------------------------------
   --  Format the duration in a time in 'ns', 'us', 'ms' or seconds.
   --  ------------------------------
   function Format (D : in Duration) return String is
   begin
      if D < 0.000_001 then
         return Duration'Image (D * 1_000_000_000) (1 .. 6) & " ns";
      elsif D < 0.001 then
         return Duration'Image (D * 1_000_000) (1 .. 6) & " us";
      elsif D < 1.0 then
         return Duration'Image (D * 1_000) (1 .. 6) & " ms";
      else
         return Duration'Image (D) (1 .. 6) & " s";
      end if;
   end Format;

   --  ------------------------------
   --  Format the duration in a time in 'ns', 'us', 'ms' or seconds.
   --  ------------------------------
   function Format (D    : in Duration;
                    Unit : in Unit_Type) return String is
   begin
      case Unit is
         when Seconds =>
            return Duration'Image (D);

         when Milliseconds =>
            return Duration'Image (D * 1_000);

         when Microseconds =>
            return Duration'Image (D * 1_000_000);

         when Nanoseconds =>
            return Duration'Image (D * 1_000_000_000);

      end case;
   end Format;

   --  ------------------------------
   --  Finalize the measures and release the storage.
   --  ------------------------------
   overriding
   procedure Finalize (Measures : in out Measure_Set) is
      Buckets : Buckets_Access;
      TS, TE  : Ada.Calendar.Time;
   begin
      --  When deleting the measure set, we have to release the buckets and measures
      --  that were allocated.  We could call Write but we don't know where
      --  the measures have to be written.
      Measures.Data.Steal_Map (Buckets, TS, TE);
      if Buckets /= null then
         for I in Buckets'Range loop
            declare
               Next : Measure_Access;
               Node : Measure_Access := Buckets (I);
            begin
               while Node /= null loop
                  Free (Node.Name);
                  Next := Node.Next;
                  Free (Node);
                  Node := Next;
               end loop;
            end;
         end loop;
         Free (Buckets);
      end if;
   end Finalize;

end Util.Measures;

-----------------------------------------------------------------------
--  measure -- Benchmark tools
--  Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 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.Task_Attributes;
with Ada.Strings.Hash;
with Ada.Unchecked_Deallocation;
with GNAT.Calendar.Time_IO;

with Util.Streams.Buffered;
with Util.Streams.Texts.TR;
package body Util.Measures is

   ISO_DATE_TIME : constant GNAT.Calendar.Time_IO.Picture_String := "%Y-%m-%d %H:%M:%S";

   procedure Free is
     new Ada.Unchecked_Deallocation (Buckets_Type, Buckets_Access);

   procedure Free is
     new Ada.Unchecked_Deallocation (Measure, Measure_Access);

   procedure Free is
     new Ada.Unchecked_Deallocation (String, String_Access);

   package Task_Context is new Ada.Task_Attributes
     (Measure_Set_Access, null);

   function Format (D : in Duration) return String;

   --  Format the duration in a time in 'ns', 'us', 'ms' or seconds.
   function Format (D    : in Duration;
                    Unit : in Unit_Type) return String;

   --  ------------------------------
   --  Disable collecting measures on the measure set.
   --  ------------------------------
   procedure Disable (Measures : in out Measure_Set) is
   begin
      Measures.Enabled := False;
   end Disable;

   --  ------------------------------
   --  Enable collecting measures on the measure set.
   --  ------------------------------
   procedure Enable (Measures : in out Measure_Set) is
   begin
      Measures.Enabled := True;
   end Enable;

   --  ------------------------------
   --  Set the per-thread measure set.
   --  ------------------------------
   procedure Set_Current (Measures : in Measure_Set_Access) is
   begin
      Task_Context.Set_Value (Measures);
   end Set_Current;

   --  ------------------------------
   --  Get the per-thread measure set.
   --  ------------------------------
   function Get_Current return Measure_Set_Access is
   begin
      return Task_Context.Value;
   end Get_Current;

   --  ------------------------------
   --  Dump an XML result with the measures collected by the measure set.
   --  When writing the measures, the measure set is cleared.  It is safe
   --  to write measures while other measures are being collected.
   --  ------------------------------
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Stream   : in out Util.Streams.Texts.Print_Stream'Class) is

      use Util.Streams.Buffered;

      procedure Dump_XML (Item : in Measure_Access);

      procedure Dump_XML (Item : in Measure_Access) is
         Total : constant String := Format (Item.Time);
         Time  : constant String := Format (Item.Time / Item.Count);
      begin
         Stream.Write ("<time count=""");
         Stream.Write (Item.Count);
         Stream.Write (""" time=""");
         Stream.Write (Time (Time'First + 1 .. Time'Last));
         if Item.Count > 1 then
            Stream.Write (""" total=""");
            Stream.Write (Total (Total'First + 1 .. Total'Last));
         end if;
         Stream.Write (""" title=""");
         Util.Streams.Texts.TR.Escape_Java_Script (Into => Stream,
                                                   Content => Item.Name.all);
         Stream.Write ("""/>");
         Stream.Write (ASCII.LF);
      end Dump_XML;

      Buckets : Buckets_Access;
      TS, TE  : Ada.Calendar.Time;

   begin
      Measures.Data.Steal_Map (Buckets, TS, TE);
      Stream.Write ("<measures title=""");
      Util.Streams.Texts.TR.Escape_Java_Script (Into    => Stream,
                                                Content => Title);
      Stream.Write (""" start=""");
      Stream.Write (TS, ISO_DATE_TIME);
      Stream.Write (""" end=""");
      Stream.Write (TE, ISO_DATE_TIME);
      Stream.Write (""">");
      if Buckets /= null then
         begin
            for I in Buckets'Range loop
               declare
                  Next : Measure_Access;
                  Node : Measure_Access := Buckets (I);
               begin
                  while Node /= null loop
                     Dump_XML (Node);
                     Free (Node.Name);
                     Next := Node.Next;
                     Free (Node);
                     Node := Next;
                  end loop;
               end;
            end loop;

         exception
            when others =>
               Free (Buckets);
               raise;
         end;
         Free (Buckets);
      end if;
      Stream.Write ("</measures>");
   end Write;

   --  ------------------------------
   --  Dump an XML result with the measures collected by the measure set.
   --  ------------------------------
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Stream   : in Ada.Text_IO.File_Type) is

      Buffer : aliased Util.Streams.Buffered.Output_Buffer_Stream;
      Output : Util.Streams.Texts.Print_Stream;

   begin
      Buffer.Initialize (Size => 128 * 1024);
      Output.Initialize (To => Buffer'Unchecked_Access);
      Write (Measures, Title, Output);
      Output.Flush;
      Ada.Text_IO.Put_Line (Stream, Util.Streams.Texts.To_String (Buffer));
   end Write;

   --  ------------------------------
   --  Dump  an XML result with the measures in a file.
   --  ------------------------------
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Path     : in String) is
      File : Ada.Text_IO.File_Type;
   begin
      Ada.Text_IO.Create (File => File, Name => Path);
      Write (Measures, Title, File);
      Ada.Text_IO.Close (File);
   exception
      when others =>
         if Ada.Text_IO.Is_Open (File) then
            Ada.Text_IO.Close (File);
         end if;
         raise;
   end Write;

   --  ------------------------------
   --  Report the time spent between the stamp creation and this method call.
   --  Collect the result in the per-thread measure set under the given measure
   --  title.
   --  ------------------------------
   procedure Report (S     : in out Stamp;
                     Title : in String;
                     Count : in Positive := 1) is
      Measures : constant Measure_Set_Access := Task_Context.Value;
   begin
      if Measures /= null and then Measures.Enabled then
         Report (Measures.all, S, Title, Count);
      end if;
   end Report;

   --  ------------------------------
   --  Report the time spent between the stamp creation and this method call.
   --  Collect the result in the measure set under the given measure title.
   --  ------------------------------
   procedure Report (Measures : in out Measure_Set;
                     S        : in out Stamp;
                     Title    : in String;
                     Count    : in Positive := 1) is
      use Ada.Calendar;
   begin
      if Measures.Enabled then
         declare
            D : constant Duration := Ada.Calendar.Clock - S.Start;
         begin
            Measures.Data.Add (Title, D, Count);
         end;
         S.Start := Ada.Calendar.Clock;
      end if;
   end Report;

   --  ------------------------------
   --  Report the time spent between the stamp creation and this method call.
   --  The report is written in the file with the given title.  The duration is
   --  expressed in the unit defined in <tt>Unit</tt>.
   --  ------------------------------
   procedure Report (S     : in out Stamp;
                     File  : in out Ada.Text_IO.File_Type;
                     Title : in String;
                     Unit  : in Unit_Type := Microseconds) is
      use Ada.Calendar;

      D : constant Duration := Ada.Calendar.Clock - S.Start;
   begin
      Ada.Text_IO.Put (File, Title);
      Ada.Text_IO.Put (File, Format (D, Unit));
      S.Start := Ada.Calendar.Clock;
   end Report;

   protected body Measure_Data is

      --  ------------------------------
      --  Get the measures and clear to start a new set of measures.
      --  Return in Time_Start and Time_End the period of time.
      --  ------------------------------
      procedure Steal_Map (Result     : out Buckets_Access;
                           Time_Start : out Ada.Calendar.Time;
                           Time_End   : out Ada.Calendar.Time) is
      begin
         Result     := Buckets;
         Time_Start := Start;
         Start      := Ada.Calendar.Clock;
         Time_End   := Start;
         Buckets    := null;
      end Steal_Map;

      --  ------------------------------
      --  Add the measure
      --  ------------------------------
      procedure Add (Title : in String;
                     D     : in Duration;
                     Count : in Positive := 1) is

         use Ada.Containers;
         use Ada.Calendar;

         Pos  : Hash_Type;
         Node : Measure_Access;
      begin
         if Buckets = null then
            Buckets := new Buckets_Type (0 .. 256);
         end if;
         Pos := Ada.Strings.Hash (Title) mod Buckets'Length;
         Node := Buckets (Pos);
         while Node /= null loop
            if Node.Name'Length = Title'Length
              and then Node.Name.all = Title
            then
               Node.Count := Node.Count + Count;
               Node.Time := Node.Time + D;
               return;
            end if;
            Node := Node.Next;
         end loop;
         Buckets (Pos) := new Measure '(Name => new String '(Title),
                                        Time  => D,
                                        Count => Count,
                                        Next  => Buckets (Pos));
      end Add;

   end Measure_Data;

   --  ------------------------------
   --  Format the duration in a time in 'ns', 'us', 'ms' or seconds.
   --  ------------------------------
   function Format (D : in Duration) return String is
   begin
      if D < 0.000_001 then
         return Duration'Image (D * 1_000_000_000) (1 .. 6) & " ns";
      elsif D < 0.001 then
         return Duration'Image (D * 1_000_000) (1 .. 6) & " us";
      elsif D < 1.0 then
         return Duration'Image (D * 1_000) (1 .. 6) & " ms";
      else
         return Duration'Image (D) (1 .. 6) & " s";
      end if;
   end Format;

   --  ------------------------------
   --  Format the duration in a time in 'ns', 'us', 'ms' or seconds.
   --  ------------------------------
   function Format (D    : in Duration;
                    Unit : in Unit_Type) return String is
   begin
      case Unit is
         when Seconds =>
            return Duration'Image (D);

         when Milliseconds =>
            return Duration'Image (D * 1_000);

         when Microseconds =>
            return Duration'Image (D * 1_000_000);

         when Nanoseconds =>
            return Duration'Image (D * 1_000_000_000);

      end case;
   end Format;

   --  ------------------------------
   --  Finalize the measures and release the storage.
   --  ------------------------------
   overriding
   procedure Finalize (Measures : in out Measure_Set) is
      Buckets : Buckets_Access;
      TS, TE  : Ada.Calendar.Time;
   begin
      --  When deleting the measure set, we have to release the buckets and measures
      --  that were allocated.  We could call Write but we don't know where
      --  the measures have to be written.
      Measures.Data.Steal_Map (Buckets, TS, TE);
      if Buckets /= null then
         for I in Buckets'Range loop
            declare
               Next : Measure_Access;
               Node : Measure_Access := Buckets (I);
            begin
               while Node /= null loop
                  Free (Node.Name);
                  Next := Node.Next;
                  Free (Node);
                  Node := Next;
               end loop;
            end;
         end loop;
         Free (Buckets);
      end if;
   end Finalize;

end Util.Measures;

Use the Output_Buffer_Stream instead of the Buffered_Stream


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

   use type Ada.Calendar.Time;
   use type Ada.Directories.File_Size;

   --  ------------------------------
   --  Format the file pattern with the date and index to produce a file path.
   --  ------------------------------
   function Format (Pattern : in String;
                    Date    : in Ada.Calendar.Time;
                    Index   : in Natural) return String is
      Pos    : Natural := Pattern'First;
      Result : Unbounded_String;
      Info   : Util.Dates.Date_Record;
      First  : Natural;
   begin
      Util.Dates.Split (Info, Date);
      while Pos <= Pattern'Last loop
         if Pattern (Pos) /= '%' or else Pos = Pattern'Last then
            Ada.Strings.Unbounded.Append (Result, Pattern (Pos));
            Pos := Pos + 1;
         elsif Pattern (Pos + 1) = 'i' then
            Ada.Strings.Unbounded.Append (Result, Util.Strings.Image (Index));
            Pos := Pos + 2;
         elsif Pos + 3 < Pattern'Last and then Pattern (Pos + 1) = 'd'
           and then Pattern (Pos + 2) = '{'
         then
            Pos := Pos + 3;
            First := Pos;
            while Pos <= Pattern'Last and Pattern (Pos) /= '}' loop
               Pos := Pos + 1;
            end loop;
            Append (Result, Util.Dates.Simple_Format (Pattern (First .. Pos - 1), Date));
            Pos := Pos + 1;
         else
            Ada.Strings.Unbounded.Append (Result, Pattern (Pos));
            Pos := Pos + 1;
         end if;
      end loop;
      return To_String (Result);
   end Format;

   --  ------------------------------
   --  Initialize the file manager to roll the file refered by `Path` by using
   --  the pattern defined in `Pattern`.
   --  ------------------------------
   procedure Initialize (Manager  : in out File_Manager;
                         Path     : in String;
                         Pattern  : in String;
                         Policy   : in Policy_Type;
                         Strategy : in Strategy_Type) is
   begin
      Manager.File_Path := To_Unbounded_String (Path);
      Manager.Pattern := To_Unbounded_String (Pattern);
      Manager.Cur_Index := 0;
      Manager.Policy := Policy.Kind;
      case Policy.Kind is
         when Size_Policy =>
            Manager.Max_Size := Policy.Size;

         when Time_Policy =>
            Manager.Interval := Policy.Interval;

         when others =>
            null;
      end case;
      Manager.Strategy := Strategy.Kind;
      case Strategy.Kind is
         when Ascending_Strategy | Descending_Strategy =>
            Manager.Min_Index := Strategy.Min_Index;
            Manager.Max_Index := Strategy.Max_Index;
            Manager.Max_Files := Manager.Max_Index - Manager.Min_Index;

         when Direct_Strategy =>
            Manager.Max_Files := Strategy.Max_Files;

      end case;
      Manager.Rollover;
   end Initialize;

   --  ------------------------------
   --  Get the current path (it may or may not exist).
   --  ------------------------------
   function Get_Current_Path (Manager : in File_Manager) return String is
   begin
      return To_String (Manager.File_Path);
   end Get_Current_Path;

   --  ------------------------------
   --  Check if a rollover is necessary based on the rolling strategy.
   --  ------------------------------
   function Is_Rollover_Necessary (Manager : in File_Manager) return Boolean is
   begin
      case Manager.Policy is
         when No_Policy =>
            return False;

         when Time_Policy =>
            return Manager.Deadline < Ada.Calendar.Clock;

         when Size_Policy =>
            declare
               Path : constant String := To_String (Manager.File_Path);
            begin
               if not Ada.Directories.Exists (Path) then
                  return False;
               end if;
               return Ada.Directories.Size (Path) >= Manager.Max_Size;

            exception
               when Ada.Directories.Name_Error =>
                  --  Even if we check for file existence, an exception could
                  --  be raised if the file is moved/deleted.
                  return False;
            end;

      end case;
   end Is_Rollover_Necessary;

   --  Perform a rollover according to the strategy that was configured.
   procedure Rollover (Manager : in out File_Manager) is
   begin
      case (Manager.Strategy) is
         when Ascending_Strategy =>
            Manager.Rollover_Ascending;

         when Descending_Strategy =>
            Manager.Rollover_Descending;

         when Direct_Strategy =>
            Manager.Rollover_Direct;

      end case;
   end Rollover;

   procedure Rollover_Ascending (Manager : in out File_Manager) is
      Old   : constant String := Manager.Get_Current_Path;
      Path  : constant String := Format (Pattern => To_String (Manager.Pattern),
                                         Date    => Manager.Deadline,
                                         Index   => Manager.Cur_Index);
      Dir   : constant String := Ada.Directories.Containing_Directory (Path);
      Names : Util.Strings.Vectors.Vector;
      First : Natural := 0;
      Last  : Natural := 0;
   begin
      if Ada.Directories.Exists (Dir) then
         Manager.Elligible_Files (Dir, Names, First, Last);

         while Natural (Names.Length) > Manager.Max_Files loop
            begin
               Ada.Directories.Delete_File (Compose (Dir, Names.First_Element));

            exception
               when Ada.Directories.Name_Error =>
                  null;
            end;
            Names.Delete_First;
         end loop;
      end if;

      Manager.Cur_Index := Last + 1;

      --  Too many files, rename old ones.
      if Manager.Cur_Index > Manager.Max_Index then
         Manager.Cur_Index := Manager.Max_Index - Natural (Names.Length);
         for Name of Names loop
            Manager.Rename (Compose (Dir, Name));
            Manager.Cur_Index := Manager.Cur_Index + 1;
         end loop;
      end if;

      Manager.Rename (Old);
   end Rollover_Ascending;

   procedure Rename (Manager : in File_Manager;
                     Old     : in String) is
      Path  : constant String := Format (Pattern => To_String (Manager.Pattern),
                                         Date    => Manager.Deadline,
                                         Index   => Manager.Cur_Index);
      Dir   : constant String := Ada.Directories.Containing_Directory (Path);
   begin
      if Ada.Directories.Exists (Old) then
         if not Ada.Directories.Exists (Dir) then
            Ada.Directories.Create_Path (Dir);
         end if;

         Util.Files.Rename (Old_Name => Old,
                            New_Name => Path);
      end if;
   end Rename;

   procedure Rollover_Descending (Manager : in out File_Manager) is
      Old   : constant String := Manager.Get_Current_Path;
      Path  : constant String := Format (Pattern => To_String (Manager.Pattern),
                                         Date    => Manager.Deadline,
                                         Index   => Manager.Cur_Index);
      Dir   : constant String := Ada.Directories.Containing_Directory (Path);
      Names : Util.Strings.Vectors.Vector;
      First : Natural := 0;
      Last  : Natural := 0;
   begin
      if Ada.Directories.Exists (Dir) then
         Manager.Elligible_Files (Dir, Names, First, Last);

         while Natural (Names.Length) > Manager.Max_Files loop
            begin
               Ada.Directories.Delete_File (Compose (Dir, Names.Last_Element));

            exception
               when Ada.Directories.Name_Error =>
                  null;
            end;
            Names.Delete_Last;
         end loop;
      end if;

      Manager.Cur_Index := First;

      if not Names.Is_Empty then
         Manager.Cur_Index := Manager.Min_Index + Natural (Names.Length);
         for Name of reverse Names loop
            Manager.Rename (Compose (Dir, Name));
            Manager.Cur_Index := Manager.Cur_Index - 1;
         end loop;
      end if;

      Manager.Rename (Old);
   end Rollover_Descending;

   procedure Rollover_Direct (Manager : in out File_Manager) is
   begin
      null;
   end Rollover_Direct;

   --  ------------------------------
   --  Get the regex pattern to identify a file that must be purged.
   --  The default is to extract the file pattern part of the file manager pattern.
   --  ------------------------------
   function Get_Purge_Pattern (Manager : in File_Manager) return String is
      Full_Pat : constant String := To_String (Manager.Pattern);
      Name_Pat : constant String := Ada.Directories.Simple_Name (Full_Pat);
      Pos      : Natural := Name_Pat'First;
      Result   : Unbounded_String;
      Found    : Boolean := False;
   begin
      while Pos <= Name_Pat'Last loop
         if Name_Pat (Pos) = '%' and then Pos + 1 <= Name_Pat'Last
           and then Name_Pat (Pos + 1) = 'i'
         then
            if not Found then
               Append (Result, "([0-9]+)");
               Found := True;
            else
               Append (Result, "[0-9]+");
            end if;
            Pos := Pos + 2;
         else
            Append (Result, Name_Pat (Pos));
            Pos := Pos + 1;
         end if;
      end loop;
      return To_String (Result);
   end Get_Purge_Pattern;

   --  ------------------------------
   --  Find the files that are elligible to purge in the given directory.
   --  ------------------------------
   procedure Elligible_Files (Manager     : in out File_Manager;
                              Path        : in String;
                              Names       : in out Util.Strings.Vectors.Vector;
                              First_Index : out Natural;
                              Last_Index  : out Natural) is
      function Get_Index (Name : in String) return Natural;
      function Compare (Left, Right : in String) return Boolean;

      Search_Filter : constant Ada.Directories.Filter_Type
        := (Ada.Directories.Ordinary_File => True,
            Ada.Directories.Directory     => False,
            Ada.Directories.Special_File  => False);
      Pattern  : constant String := Manager.Get_Purge_Pattern;
      Regex    : constant GNAT.Regpat.Pattern_Matcher := GNAT.Regpat.Compile (Pattern);
      Glob1    : constant String := Util.Strings.Replace (Pattern, "([0-9]+)", "*", False);
      Glob2    : constant String := Util.Strings.Replace (Glob1, "[0-9]+", "*", False);
      Search   : Ada.Directories.Search_Type;
      Ent      : Ada.Directories.Directory_Entry_Type;

      function Get_Index (Name : in String) return Natural is
         Matches : GNAT.Regpat.Match_Array (0 .. 1);
      begin
         if GNAT.Regpat.Match (Regex, Name) then
            GNAT.Regpat.Match (Regex, Name, Matches);
            return Natural'Value (Name (Matches (1).First .. Matches (1).Last));
         else
            return 0;
         end if;

      exception
         when others =>
            return 0;
      end Get_Index;

      function Compare (Left, Right : in String) return Boolean is
         Left_Index  : constant Natural := Get_Index (Left);
         Right_Index : constant Natural := Get_Index (Right);
      begin
         return Left_Index < Right_Index;
      end Compare;

      package Sort_Names is new Util.Strings.Vectors.Generic_Sorting (Compare);
   begin
      Ada.Directories.Start_Search (Search,
                                    Directory => Path,
                                    Pattern   => Glob2,
                                    Filter    => Search_Filter);
      while Ada.Directories.More_Entries (Search) loop
         Ada.Directories.Get_Next_Entry (Search, Ent);
         declare
            Name    : constant String := Ada.Directories.Simple_Name (Ent);
         begin
            Names.Append (Name);
         end;
      end loop;
      Sort_Names.Sort (Names);
      if not Names.Is_Empty then
         First_Index := Get_Index (Names.First_Element);
         Last_Index := Get_Index (Names.Last_Element);
      else
         First_Index := Manager.Min_Index;
         Last_Index := Manager.Min_Index;
      end if;
   end Elligible_Files;

   procedure Purge (Manager : in out File_Manager;
                    Path    : in String) is
      Search_Filter : constant Ada.Directories.Filter_Type
        := (Ada.Directories.Ordinary_File => True,
            Ada.Directories.Directory     => False,
            Ada.Directories.Special_File  => False);
      Pattern  : constant String := Manager.Get_Purge_Pattern;
      Regex    : constant GNAT.Regpat.Pattern_Matcher := GNAT.Regpat.Compile (Pattern);
      Glob1    : constant String := Util.Strings.Replace (Pattern, "([0-9]+)", "*", False);
      Glob2    : constant String := Util.Strings.Replace (Glob1, "[0-9]+", "*", False);
      Search   : Ada.Directories.Search_Type;
      Ent      : Ada.Directories.Directory_Entry_Type;
      Names    : Util.Strings.Maps.Map;
      Min      : Natural := Natural'Last;
      Max      : Natural := Natural'First;
   begin
      Ada.Directories.Start_Search (Search,
                                    Directory => Path,
                                    Pattern   => Glob2,
                                    Filter    => Search_Filter);
      while Ada.Directories.More_Entries (Search) loop
         Ada.Directories.Get_Next_Entry (Search, Ent);
         declare
            Name    : constant String := Ada.Directories.Simple_Name (Ent);
            Matches : GNAT.Regpat.Match_Array (0 .. 1);
         begin
            if GNAT.Regpat.Match (Regex, Name) then
               GNAT.Regpat.Match (Regex, Name, Matches);
               Names.Include (Name (Matches (1).First .. Matches (1).Last), Name);
            end if;
         end;
      end loop;

      --  Get min and max.
      for Iter in Names.Iterate loop
         declare
            Key : constant String := Util.Strings.Maps.Key (Iter);
            Idx : constant Natural := Natural'Value (Key);
         begin
            if Idx < Min then
               Min := Idx;
            end if;
            if Idx > Max then
               Max := Idx;
            end if;
         end;
      end loop;

      if Manager.Cur_Index = 0 then
         Manager.Cur_Index := Max + 1;
      end if;

      if Natural (Names.Length) < Manager.Max_Files then
         return;
      end if;

   end Purge;

end Util.Files.Rolling;

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

   use type Ada.Calendar.Time;
   use type Ada.Directories.File_Size;

   --  ------------------------------
   --  Format the file pattern with the date and index to produce a file path.
   --  ------------------------------
   function Format (Pattern : in String;
                    Date    : in Ada.Calendar.Time;
                    Index   : in Natural) return String is
      Pos    : Natural := Pattern'First;
      Result : Unbounded_String;
      Info   : Util.Dates.Date_Record;
      First  : Natural;
   begin
      Util.Dates.Split (Info, Date);
      while Pos <= Pattern'Last loop
         if Pattern (Pos) /= '%' or else Pos = Pattern'Last then
            Ada.Strings.Unbounded.Append (Result, Pattern (Pos));
            Pos := Pos + 1;
         elsif Pattern (Pos + 1) = 'i' then
            Ada.Strings.Unbounded.Append (Result, Util.Strings.Image (Index));
            Pos := Pos + 2;
         elsif Pos + 3 < Pattern'Last and then Pattern (Pos + 1) = 'd'
           and then Pattern (Pos + 2) = '{'
         then
            Pos := Pos + 3;
            First := Pos;
            while Pos <= Pattern'Last and Pattern (Pos) /= '}' loop
               Pos := Pos + 1;
            end loop;
            Append (Result, Util.Dates.Simple_Format (Pattern (First .. Pos - 1), Date));
            Pos := Pos + 1;
         else
            Ada.Strings.Unbounded.Append (Result, Pattern (Pos));
            Pos := Pos + 1;
         end if;
      end loop;
      return To_String (Result);
   end Format;

   --  ------------------------------
   --  Initialize the file manager to roll the file refered by `Path` by using
   --  the pattern defined in `Pattern`.
   --  ------------------------------
   procedure Initialize (Manager  : in out File_Manager;
                         Path     : in String;
                         Pattern  : in String;
                         Policy   : in Policy_Type;
                         Strategy : in Strategy_Type) is
   begin
      Manager.Deadline := Ada.Calendar.Clock;
      Manager.File_Path := To_Unbounded_String (Path);
      Manager.Pattern := To_Unbounded_String (Pattern);
      Manager.Cur_Index := 0;
      Manager.Policy := Policy.Kind;
      case Policy.Kind is
         when Size_Policy =>
            Manager.Max_Size := Policy.Size;

         when Time_Policy =>
            Manager.Interval := Policy.Interval;

         when others =>
            null;
      end case;
      Manager.Strategy := Strategy.Kind;
      case Strategy.Kind is
         when Ascending_Strategy | Descending_Strategy =>
            Manager.Min_Index := Strategy.Min_Index;
            Manager.Max_Index := Strategy.Max_Index;
            Manager.Max_Files := Manager.Max_Index - Manager.Min_Index;

         when Direct_Strategy =>
            Manager.Max_Files := Strategy.Max_Files;

      end case;
      Manager.Rollover;
   end Initialize;

   --  ------------------------------
   --  Get the current path (it may or may not exist).
   --  ------------------------------
   function Get_Current_Path (Manager : in File_Manager) return String is
   begin
      return To_String (Manager.File_Path);
   end Get_Current_Path;

   --  ------------------------------
   --  Check if a rollover is necessary based on the rolling strategy.
   --  ------------------------------
   function Is_Rollover_Necessary (Manager : in File_Manager) return Boolean is
   begin
      case Manager.Policy is
         when No_Policy =>
            return False;

         when Time_Policy =>
            return Manager.Deadline < Ada.Calendar.Clock;

         when Size_Policy =>
            declare
               Path : constant String := To_String (Manager.File_Path);
            begin
               if not Ada.Directories.Exists (Path) then
                  return False;
               end if;
               return Ada.Directories.Size (Path) >= Manager.Max_Size;

            exception
               when Ada.Directories.Name_Error =>
                  --  Even if we check for file existence, an exception could
                  --  be raised if the file is moved/deleted.
                  return False;
            end;

      end case;
   end Is_Rollover_Necessary;

   --  Perform a rollover according to the strategy that was configured.
   procedure Rollover (Manager : in out File_Manager) is
   begin
      case (Manager.Strategy) is
         when Ascending_Strategy =>
            Manager.Rollover_Ascending;

         when Descending_Strategy =>
            Manager.Rollover_Descending;

         when Direct_Strategy =>
            Manager.Rollover_Direct;

      end case;
   end Rollover;

   procedure Rollover_Ascending (Manager : in out File_Manager) is
      Old   : constant String := Manager.Get_Current_Path;
      Path  : constant String := Format (Pattern => To_String (Manager.Pattern),
                                         Date    => Manager.Deadline,
                                         Index   => Manager.Cur_Index);
      Dir   : constant String := Ada.Directories.Containing_Directory (Path);
      Names : Util.Strings.Vectors.Vector;
      First : Natural := 0;
      Last  : Natural := 0;
   begin
      if Ada.Directories.Exists (Dir) then
         Manager.Elligible_Files (Dir, Names, First, Last);

         while Natural (Names.Length) > Manager.Max_Files loop
            begin
               Ada.Directories.Delete_File (Compose (Dir, Names.First_Element));

            exception
               when Ada.Directories.Name_Error =>
                  null;
            end;
            Names.Delete_First;
         end loop;
      end if;

      Manager.Cur_Index := Last + 1;

      --  Too many files, rename old ones.
      if Manager.Cur_Index > Manager.Max_Index then
         Manager.Cur_Index := Manager.Max_Index - Natural (Names.Length);
         for Name of Names loop
            Manager.Rename (Compose (Dir, Name));
            Manager.Cur_Index := Manager.Cur_Index + 1;
         end loop;
      end if;

      Manager.Rename (Old);
   end Rollover_Ascending;

   procedure Rename (Manager : in File_Manager;
                     Old     : in String) is
      Path  : constant String := Format (Pattern => To_String (Manager.Pattern),
                                         Date    => Manager.Deadline,
                                         Index   => Manager.Cur_Index);
      Dir   : constant String := Ada.Directories.Containing_Directory (Path);
   begin
      if Ada.Directories.Exists (Old) then
         if not Ada.Directories.Exists (Dir) then
            Ada.Directories.Create_Path (Dir);
         end if;

         Util.Files.Rename (Old_Name => Old,
                            New_Name => Path);
      end if;
   end Rename;

   procedure Rollover_Descending (Manager : in out File_Manager) is
      Old   : constant String := Manager.Get_Current_Path;
      Path  : constant String := Format (Pattern => To_String (Manager.Pattern),
                                         Date    => Manager.Deadline,
                                         Index   => Manager.Cur_Index);
      Dir   : constant String := Ada.Directories.Containing_Directory (Path);
      Names : Util.Strings.Vectors.Vector;
      First : Natural := 0;
      Last  : Natural := 0;
   begin
      if Ada.Directories.Exists (Dir) then
         Manager.Elligible_Files (Dir, Names, First, Last);

         while Natural (Names.Length) > Manager.Max_Files loop
            begin
               Ada.Directories.Delete_File (Compose (Dir, Names.Last_Element));

            exception
               when Ada.Directories.Name_Error =>
                  null;
            end;
            Names.Delete_Last;
         end loop;
      end if;

      Manager.Cur_Index := First;

      if not Names.Is_Empty then
         Manager.Cur_Index := Manager.Min_Index + Natural (Names.Length);
         for Name of reverse Names loop
            Manager.Rename (Compose (Dir, Name));
            Manager.Cur_Index := Manager.Cur_Index - 1;
         end loop;
      end if;

      Manager.Rename (Old);
   end Rollover_Descending;

   procedure Rollover_Direct (Manager : in out File_Manager) is
   begin
      null;
   end Rollover_Direct;

   --  ------------------------------
   --  Get the regex pattern to identify a file that must be purged.
   --  The default is to extract the file pattern part of the file manager pattern.
   --  ------------------------------
   function Get_Purge_Pattern (Manager : in File_Manager) return String is
      Full_Pat : constant String := To_String (Manager.Pattern);
      Name_Pat : constant String := Ada.Directories.Simple_Name (Full_Pat);
      Pos      : Natural := Name_Pat'First;
      Result   : Unbounded_String;
      Found    : Boolean := False;
   begin
      while Pos <= Name_Pat'Last loop
         if Name_Pat (Pos) = '%' and then Pos + 1 <= Name_Pat'Last
           and then Name_Pat (Pos + 1) = 'i'
         then
            if not Found then
               Append (Result, "([0-9]+)");
               Found := True;
            else
               Append (Result, "[0-9]+");
            end if;
            Pos := Pos + 2;
         else
            Append (Result, Name_Pat (Pos));
            Pos := Pos + 1;
         end if;
      end loop;
      return To_String (Result);
   end Get_Purge_Pattern;

   --  ------------------------------
   --  Find the files that are elligible to purge in the given directory.
   --  ------------------------------
   procedure Elligible_Files (Manager     : in out File_Manager;
                              Path        : in String;
                              Names       : in out Util.Strings.Vectors.Vector;
                              First_Index : out Natural;
                              Last_Index  : out Natural) is
      function Get_Index (Name : in String) return Natural;
      function Compare (Left, Right : in String) return Boolean;

      Search_Filter : constant Ada.Directories.Filter_Type
        := (Ada.Directories.Ordinary_File => True,
            Ada.Directories.Directory     => False,
            Ada.Directories.Special_File  => False);
      Pattern  : constant String := Manager.Get_Purge_Pattern;
      Regex    : constant GNAT.Regpat.Pattern_Matcher := GNAT.Regpat.Compile (Pattern);
      Glob1    : constant String := Util.Strings.Replace (Pattern, "([0-9]+)", "*", False);
      Glob2    : constant String := Util.Strings.Replace (Glob1, "[0-9]+", "*", False);
      Search   : Ada.Directories.Search_Type;
      Ent      : Ada.Directories.Directory_Entry_Type;

      function Get_Index (Name : in String) return Natural is
         Matches : GNAT.Regpat.Match_Array (0 .. 1);
      begin
         if GNAT.Regpat.Match (Regex, Name) then
            GNAT.Regpat.Match (Regex, Name, Matches);
            return Natural'Value (Name (Matches (1).First .. Matches (1).Last));
         else
            return 0;
         end if;

      exception
         when others =>
            return 0;
      end Get_Index;

      function Compare (Left, Right : in String) return Boolean is
         Left_Index  : constant Natural := Get_Index (Left);
         Right_Index : constant Natural := Get_Index (Right);
      begin
         return Left_Index < Right_Index;
      end Compare;

      package Sort_Names is new Util.Strings.Vectors.Generic_Sorting (Compare);
   begin
      Ada.Directories.Start_Search (Search,
                                    Directory => Path,
                                    Pattern   => Glob2,
                                    Filter    => Search_Filter);
      while Ada.Directories.More_Entries (Search) loop
         Ada.Directories.Get_Next_Entry (Search, Ent);
         declare
            Name    : constant String := Ada.Directories.Simple_Name (Ent);
         begin
            Names.Append (Name);
         end;
      end loop;
      Sort_Names.Sort (Names);
      if not Names.Is_Empty then
         First_Index := Get_Index (Names.First_Element);
         Last_Index := Get_Index (Names.Last_Element);
      else
         First_Index := Manager.Min_Index;
         Last_Index := Manager.Min_Index;
      end if;
   end Elligible_Files;

end Util.Files.Rolling;

Remove unused Purge procedure

Remove unused Purge procedure


-----------------------------------------------------------------------
--  awa-tags -- Tags management
--  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.
-----------------------------------------------------------------------

--  == Introduction ==
--  The <b>Tags</b> module allows to associate general purpose tags to any database entity.
--
--  == Model ==
--  [http://ada-awa.googlecode.com/svn/wiki/awa_tags_model.png]
--
--  @include awa-tags-modules.ads
package AWA.Tags is

   pragma Pure;

end AWA.Tags;

-----------------------------------------------------------------------
--  awa-tags -- Tags management
--  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.
-----------------------------------------------------------------------

--  == Introduction ==
--  The <b>Tags</b> module allows to associate general purpose tags to any database entity.
--  It provides a JSF component that allows to insert easily a list of tags in a page and
--  in a form.  An application can use the bean types defined in <tt>AWA.Tags.Beans</tt>
--  to define the tags and it will use the <tt>awa:tagList</tt> component to display them.
--
--  == Model ==
--  [http://ada-awa.googlecode.com/svn/wiki/awa_tags_model.png]
--
--  @include awa-tags-modules.ads
--  @include awa-tags-beans.ads
--  @include awa-tags-components.ads
--
package AWA.Tags is

   pragma Pure;

end AWA.Tags;

Document the Tags plugin in AWA

Document the Tags plugin in AWA