-----------------------------------------------------------------------
--  util-serialize-io-csv -- CSV Serialization Driver
--  Copyright (C) 2011, 2015, 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.Strings.Unbounded;
with Ada.Characters.Latin_1;
with Ada.IO_Exceptions;

with Util.Strings;
with Util.Dates.ISO8601;

package body Util.Serialize.IO.CSV is

   --  ------------------------------
   --  Set the field separator.  The default field separator is the comma (',').
   --  ------------------------------
   procedure Set_Field_Separator (Stream    : in out Output_Stream;
                                  Separator : in Character) is
   begin
      Stream.Separator := Separator;
   end Set_Field_Separator;

   --  ------------------------------
   --  Enable or disable the double quotes by default for strings.
   --  ------------------------------
   procedure Set_Quotes (Stream : in out Output_Stream;
                         Enable : in Boolean) is
   begin
      Stream.Quote := Enable;
   end Set_Quotes;

   --  ------------------------------
   --  Write the value as a CSV cell.  Special characters are escaped using the CSV
   --  escape rules.
   --  ------------------------------
   procedure Write_Cell (Stream : in out Output_Stream;
                         Value  : in String) is
   begin
      if Stream.Column > 1 then
         Stream.Write (Stream.Separator);
      end if;
      Stream.Column := Stream.Column + 1;
      if Stream.Quote then
         Stream.Write ('"');
      end if;
      for I in Value'Range loop
         if Value (I) = '"' then
            Stream.Write ("""""");
         else
            Stream.Write (Value (I));
         end if;
      end loop;
      if Stream.Quote then
         Stream.Write ('"');
      end if;
   end Write_Cell;

   procedure Write_Cell (Stream : in out Output_Stream;
                         Value  : in Integer) is
   begin
      if Stream.Column > 1 then
         Stream.Write (Stream.Separator);
      end if;
      Stream.Column := Stream.Column + 1;
      Stream.Write (Util.Strings.Image (Value));
   end Write_Cell;

   procedure Write_Cell (Stream : in out Output_Stream;
                         Value  : in Boolean) is
   begin
      if Stream.Column > 1 then
         Stream.Write (Stream.Separator);
      end if;
      Stream.Column := Stream.Column + 1;
      if Value then
         Stream.Write ("true");
      else
         Stream.Write ("false");
      end if;
   end Write_Cell;

   procedure Write_Cell (Stream : in out Output_Stream;
                         Value  : in Util.Beans.Objects.Object) is
      use Util.Beans.Objects;
   begin
      case Util.Beans.Objects.Get_Type (Value) is
         when TYPE_NULL =>
            if Stream.Column > 1 then
               Stream.Write (Stream.Separator);
            end if;
            Stream.Column := Stream.Column + 1;
            if Stream.Quote then
               Stream.Write ("""null""");
            else
               Stream.Write ("null");
            end if;

         when TYPE_BOOLEAN =>
            if Stream.Column > 1 then
               Stream.Write (Stream.Separator);
            end if;
            Stream.Column := Stream.Column + 1;
            if Util.Beans.Objects.To_Boolean (Value) then
               Stream.Write ("true");
            else
               Stream.Write ("false");
            end if;

         when TYPE_INTEGER =>
            if Stream.Column > 1 then
               Stream.Write (Stream.Separator);
            end if;
            Stream.Column := Stream.Column + 1;
            --  Stream.Write ('"');
            Stream.Write (Util.Beans.Objects.To_Long_Long_Integer (Value));
            --  Stream.Write ('"');

         when others =>
            Stream.Write_Cell (Util.Beans.Objects.To_String (Value));

      end case;
   end Write_Cell;

   --  ------------------------------
   --  Start a new row.
   --  ------------------------------
   procedure New_Row (Stream : in out Output_Stream) is
   begin
      while Stream.Column < Stream.Max_Columns loop
         Stream.Write (Stream.Separator);
         Stream.Column := Stream.Column + 1;
      end loop;
      Stream.Write (ASCII.CR);
      Stream.Write (ASCII.LF);
      Stream.Column := 1;
      Stream.Row := Stream.Row + 1;
   end New_Row;

   --  -----------------------
   --  Write the attribute name/value pair.
   --  -----------------------
   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in String) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Attribute;

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Util.Nullables.Nullable_String) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Ada.Strings.Unbounded.To_String (Value.Value));
   end Write_Attribute;

   overriding
   procedure Write_Wide_Attribute (Stream : in out Output_Stream;
                                   Name   : in String;
                                   Value  : in Wide_Wide_String) is
   begin
      null;
   end Write_Wide_Attribute;

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Integer) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Attribute;

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Boolean) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Attribute;

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Util.Beans.Objects.Object) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Attribute;

   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Util.Beans.Objects.Object) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Entity;

   --  -----------------------
   --  Write the entity value.
   --  -----------------------
   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in String) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Entity;

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Util.Nullables.Nullable_String) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Ada.Strings.Unbounded.To_String (Value.Value));
   end Write_Entity;

   overriding
   procedure Write_Wide_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in Wide_Wide_String) is
   begin
      null;
   end Write_Wide_Entity;

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Boolean) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Entity;

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Integer) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Entity;

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Ada.Calendar.Time) is
   begin
      Stream.Write_Entity (Name, Util.Dates.ISO8601.Image (Value, Util.Dates.ISO8601.SUBSECOND));
   end Write_Entity;

   overriding
   procedure Write_Long_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in Long_Long_Integer) is
   begin
      null;
   end Write_Long_Entity;

   overriding
   procedure Write_Enum_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in String) is
   begin
      Stream.Write_Entity (Name, Value);
   end Write_Enum_Entity;

   --  ------------------------------
   --  Write the attribute with a null value.
   --  ------------------------------
   overriding
   procedure Write_Null_Attribute (Stream : in out Output_Stream;
                                   Name   : in String) is
   begin
      Stream.Write_Entity (Name, "");
   end Write_Null_Attribute;

   --  ------------------------------
   --  Write an entity with a null value.
   --  ------------------------------
   procedure Write_Null_Entity (Stream : in out Output_Stream;
                                Name   : in String) is
   begin
      Stream.Write_Null_Attribute (Name);
   end Write_Null_Entity;

   --  ------------------------------
   --  Get the header name for the given column.
   --  If there was no header line, build a default header for the column.
   --  ------------------------------
   function Get_Header_Name (Handler : in Parser;
                             Column  : in Column_Type) return String is
      use type Ada.Containers.Count_Type;

      Default_Header : constant String := "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
      Result : String (1 .. 10);
      N, R   : Natural;
      Pos    : Positive := Result'Last;
   begin
      if Handler.Headers.Length >= Ada.Containers.Count_Type (Column) then
         return Handler.Headers.Element (Positive (Column));
      end if;
      N := Natural (Column - 1);
      loop
         R := N mod 26;
         N := N / 26;
         Result (Pos) := Default_Header (R + 1);
         exit when N = 0;
         Pos := Pos - 1;
      end loop;
      return Result (Pos .. Result'Last);
   end Get_Header_Name;

   --  ------------------------------
   --  Set the cell value at the given row and column.
   --  The default implementation finds the column header name and
   --  invokes Write_Entity with the header name and the value.
   --  ------------------------------
   procedure Set_Cell (Handler : in out Parser;
                       Value   : in String;
                       Row     : in Row_Type;
                       Column  : in Column_Type) is
      use Ada.Containers;
   begin
      if Row = 0 then
         --  Build the headers table.
         declare
            Missing : constant Integer := Integer (Column) - Integer (Handler.Headers.Length);
         begin
            if Missing > 0 then
               Handler.Headers.Set_Length (Handler.Headers.Length + Count_Type (Missing));
            end if;
            Handler.Headers.Replace_Element (Positive (Column), Value);
         end;
      else
         declare
            Name : constant String := Handler.Get_Header_Name (Column);
         begin
            --  Detect a new row.  Close the current object and start a new one.
            if Handler.Row /= Row then
               if Row > 1 then
                  Handler.Sink.Finish_Object ("", Handler);
               else
                  Handler.Sink.Start_Array ("", Handler);
               end if;
               Handler.Sink.Start_Object ("", Handler);
            end if;
            Handler.Row := Row;
            Handler.Sink.Set_Member (Name, Util.Beans.Objects.To_Object (Value), Handler);
         end;
      end if;
   end Set_Cell;

   --  ------------------------------
   --  Set the field separator.  The default field separator is the comma (',').
   --  ------------------------------
   procedure Set_Field_Separator (Handler   : in out Parser;
                                  Separator : in Character) is
   begin
      Handler.Separator := Separator;
   end Set_Field_Separator;

   --  ------------------------------
   --  Get the field separator.
   --  ------------------------------
   function Get_Field_Separator (Handler : in Parser) return Character is
   begin
      return Handler.Separator;
   end Get_Field_Separator;

   --  ------------------------------
   --  Set the comment separator.  When a comment separator is defined, a line which starts
   --  with the comment separator will be ignored.  The row number will not be incremented.
   --  ------------------------------
   procedure Set_Comment_Separator (Handler   : in out Parser;
                                    Separator : in Character) is
   begin
      Handler.Comment := Separator;
   end Set_Comment_Separator;

   --  ------------------------------
   --  Get the comment separator.  Returns ASCII.NUL if comments are not supported.
   --  ------------------------------
   function Get_Comment_Separator (Handler : in Parser) return Character is
   begin
      return Handler.Comment;
   end Get_Comment_Separator;

   --  ------------------------------
   --  Setup the CSV parser and mapper to use the default column header names.
   --  When activated, the first row is assumed to contain the first item to de-serialize.
   --  ------------------------------
   procedure Set_Default_Headers (Handler : in out Parser;
                                  Mode    : in Boolean := True) is
   begin
      Handler.Use_Default_Headers := Mode;
   end Set_Default_Headers;

   --  ------------------------------
   --  Parse the stream using the CSV parser.
   --  Call Set_Cell for each cell that has been parsed indicating the row and
   --  column numbers as well as the cell value.
   --  ------------------------------
   overriding
   procedure Parse (Handler : in out Parser;
                    Stream  : in out Util.Streams.Buffered.Buffered_Stream'Class;
                    Sink    : in out Reader'Class) is
      use Ada.Strings.Unbounded;

      C              : Character;
      Token          : Unbounded_String;
      Column         : Column_Type := 1;
      Row            : Row_Type  := 0;
      In_Quote_Token : Boolean := False;
      In_Escape      : Boolean := False;
      Ignore_Row     : Boolean := False;
   begin
      if Handler.Use_Default_Headers then
         Row := 1;
      end if;
      Handler.Headers.Clear;
      Handler.Sink := Sink'Unchecked_Access;
      loop
         Stream.Read (Char => C);

         if C = Ada.Characters.Latin_1.CR  or C = Ada.Characters.Latin_1.LF then
            if C = Ada.Characters.Latin_1.LF then
               Handler.Line_Number := Handler.Line_Number + 1;
            end if;
            if not Ignore_Row then
               if In_Quote_Token and not In_Escape then
                  Append (Token, C);

               elsif Column > 1 or else Length (Token) > 0 then
                  Parser'Class (Handler).Set_Cell (To_String (Token), Row, Column);
                  Set_Unbounded_String (Token, "");
                  Row            := Row + 1;
                  Column         := 1;
                  In_Quote_Token := False;
                  In_Escape      := False;
               end if;
            else
               Ignore_Row := False;
            end if;

         elsif C = Handler.Separator and not Ignore_Row then
            if In_Quote_Token and not In_Escape then
               Append (Token, C);

            else
               Parser'Class (Handler).Set_Cell (To_String (Token), Row, Column);
               Set_Unbounded_String (Token, "");
               Column         := Column + 1;
               In_Quote_Token := False;
               In_Escape      := False;
            end if;

         elsif C = '"' and not Ignore_Row then
            if In_Quote_Token then
               In_Escape := True;

            elsif In_Escape then
               Append (Token, C);
               In_Escape := False;

            elsif Ada.Strings.Unbounded.Length (Token) = 0 then
               In_Quote_Token := True;

            else
               Append (Token, C);
            end if;

         elsif C = Handler.Comment and Handler.Comment /= ASCII.NUL
           and Column = 1 and Length (Token) = 0
         then
            Ignore_Row := True;

         elsif not Ignore_Row then
            Append (Token, C);
            In_Escape := False;

         end if;

      end loop;

   exception
      when Ada.IO_Exceptions.Data_Error =>
         Parser'Class (Handler).Set_Cell (To_String (Token), Row, Column);
         Handler.Sink := null;
         return;
   end Parse;

   --  ------------------------------
   --  Get the current location (file and line) to report an error message.
   --  ------------------------------
   overriding
   function Get_Location (Handler : in Parser) return String is
   begin
      return Util.Strings.Image (Handler.Line_Number);
   end Get_Location;

end Util.Serialize.IO.CSV;

-----------------------------------------------------------------------
--  util-serialize-io-csv -- CSV Serialization Driver
--  Copyright (C) 2011, 2015, 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.Strings.Unbounded;
with Ada.Characters.Latin_1;
with Ada.IO_Exceptions;

with Util.Strings;
with Util.Dates.ISO8601;

package body Util.Serialize.IO.CSV is

   --  ------------------------------
   --  Set the field separator.  The default field separator is the comma (',').
   --  ------------------------------
   procedure Set_Field_Separator (Stream    : in out Output_Stream;
                                  Separator : in Character) is
   begin
      Stream.Separator := Separator;
   end Set_Field_Separator;

   --  ------------------------------
   --  Enable or disable the double quotes by default for strings.
   --  ------------------------------
   procedure Set_Quotes (Stream : in out Output_Stream;
                         Enable : in Boolean) is
   begin
      Stream.Quote := Enable;
   end Set_Quotes;

   --  ------------------------------
   --  Write the value as a CSV cell.  Special characters are escaped using the CSV
   --  escape rules.
   --  ------------------------------
   procedure Write_Cell (Stream : in out Output_Stream;
                         Value  : in String) is
   begin
      if Stream.Column > 1 then
         Stream.Write (Stream.Separator);
      end if;
      Stream.Column := Stream.Column + 1;
      if Stream.Quote then
         Stream.Write ('"');
      end if;
      for I in Value'Range loop
         if Value (I) = '"' then
            Stream.Write ("""""");
         else
            Stream.Write (Value (I));
         end if;
      end loop;
      if Stream.Quote then
         Stream.Write ('"');
      end if;
   end Write_Cell;

   procedure Write_Cell (Stream : in out Output_Stream;
                         Value  : in Integer) is
   begin
      if Stream.Column > 1 then
         Stream.Write (Stream.Separator);
      end if;
      Stream.Column := Stream.Column + 1;
      Stream.Write (Util.Strings.Image (Value));
   end Write_Cell;

   procedure Write_Cell (Stream : in out Output_Stream;
                         Value  : in Boolean) is
   begin
      if Stream.Column > 1 then
         Stream.Write (Stream.Separator);
      end if;
      Stream.Column := Stream.Column + 1;
      if Value then
         Stream.Write ("true");
      else
         Stream.Write ("false");
      end if;
   end Write_Cell;

   procedure Write_Cell (Stream : in out Output_Stream;
                         Value  : in Util.Beans.Objects.Object) is
      use Util.Beans.Objects;
   begin
      case Util.Beans.Objects.Get_Type (Value) is
         when TYPE_NULL =>
            if Stream.Column > 1 then
               Stream.Write (Stream.Separator);
            end if;
            Stream.Column := Stream.Column + 1;
            if Stream.Quote then
               Stream.Write ("""null""");
            else
               Stream.Write ("null");
            end if;

         when TYPE_BOOLEAN =>
            if Stream.Column > 1 then
               Stream.Write (Stream.Separator);
            end if;
            Stream.Column := Stream.Column + 1;
            if Util.Beans.Objects.To_Boolean (Value) then
               Stream.Write ("true");
            else
               Stream.Write ("false");
            end if;

         when TYPE_INTEGER =>
            if Stream.Column > 1 then
               Stream.Write (Stream.Separator);
            end if;
            Stream.Column := Stream.Column + 1;
            --  Stream.Write ('"');
            Stream.Write (Util.Beans.Objects.To_Long_Long_Integer (Value));
            --  Stream.Write ('"');

         when others =>
            Stream.Write_Cell (Util.Beans.Objects.To_String (Value));

      end case;
   end Write_Cell;

   --  ------------------------------
   --  Start a new row.
   --  ------------------------------
   procedure New_Row (Stream : in out Output_Stream) is
   begin
      while Stream.Column < Stream.Max_Columns loop
         Stream.Write (Stream.Separator);
         Stream.Column := Stream.Column + 1;
      end loop;
      Stream.Write (ASCII.CR);
      Stream.Write (ASCII.LF);
      Stream.Column := 1;
      Stream.Row := Stream.Row + 1;
   end New_Row;

   --  -----------------------
   --  Write the attribute name/value pair.
   --  -----------------------
   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in String) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Attribute;

   overriding
   procedure Write_Wide_Attribute (Stream : in out Output_Stream;
                                   Name   : in String;
                                   Value  : in Wide_Wide_String) is
   begin
      null;
   end Write_Wide_Attribute;

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Integer) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Attribute;

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Boolean) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Attribute;

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Util.Beans.Objects.Object) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Attribute;

   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Util.Beans.Objects.Object) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Entity;

   --  -----------------------
   --  Write the entity value.
   --  -----------------------
   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in String) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Entity;

   overriding
   procedure Write_Wide_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in Wide_Wide_String) is
   begin
      null;
   end Write_Wide_Entity;

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Boolean) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Entity;

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Integer) is
      pragma Unreferenced (Name);
   begin
      Stream.Write_Cell (Value);
   end Write_Entity;

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Ada.Calendar.Time) is
   begin
      Stream.Write_Entity (Name, Util.Dates.ISO8601.Image (Value, Util.Dates.ISO8601.SUBSECOND));
   end Write_Entity;

   overriding
   procedure Write_Long_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in Long_Long_Integer) is
   begin
      null;
   end Write_Long_Entity;

   overriding
   procedure Write_Enum_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in String) is
   begin
      Stream.Write_Entity (Name, Value);
   end Write_Enum_Entity;

   --  ------------------------------
   --  Write the attribute with a null value.
   --  ------------------------------
   overriding
   procedure Write_Null_Attribute (Stream : in out Output_Stream;
                                   Name   : in String) is
   begin
      Stream.Write_Entity (Name, "");
   end Write_Null_Attribute;

   --  ------------------------------
   --  Write an entity with a null value.
   --  ------------------------------
   procedure Write_Null_Entity (Stream : in out Output_Stream;
                                Name   : in String) is
   begin
      Stream.Write_Null_Attribute (Name);
   end Write_Null_Entity;

   --  ------------------------------
   --  Get the header name for the given column.
   --  If there was no header line, build a default header for the column.
   --  ------------------------------
   function Get_Header_Name (Handler : in Parser;
                             Column  : in Column_Type) return String is
      use type Ada.Containers.Count_Type;

      Default_Header : constant String := "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
      Result : String (1 .. 10);
      N, R   : Natural;
      Pos    : Positive := Result'Last;
   begin
      if Handler.Headers.Length >= Ada.Containers.Count_Type (Column) then
         return Handler.Headers.Element (Positive (Column));
      end if;
      N := Natural (Column - 1);
      loop
         R := N mod 26;
         N := N / 26;
         Result (Pos) := Default_Header (R + 1);
         exit when N = 0;
         Pos := Pos - 1;
      end loop;
      return Result (Pos .. Result'Last);
   end Get_Header_Name;

   --  ------------------------------
   --  Set the cell value at the given row and column.
   --  The default implementation finds the column header name and
   --  invokes Write_Entity with the header name and the value.
   --  ------------------------------
   procedure Set_Cell (Handler : in out Parser;
                       Value   : in String;
                       Row     : in Row_Type;
                       Column  : in Column_Type) is
      use Ada.Containers;
   begin
      if Row = 0 then
         --  Build the headers table.
         declare
            Missing : constant Integer := Integer (Column) - Integer (Handler.Headers.Length);
         begin
            if Missing > 0 then
               Handler.Headers.Set_Length (Handler.Headers.Length + Count_Type (Missing));
            end if;
            Handler.Headers.Replace_Element (Positive (Column), Value);
         end;
      else
         declare
            Name : constant String := Handler.Get_Header_Name (Column);
         begin
            --  Detect a new row.  Close the current object and start a new one.
            if Handler.Row /= Row then
               if Row > 1 then
                  Handler.Sink.Finish_Object ("", Handler);
               else
                  Handler.Sink.Start_Array ("", Handler);
               end if;
               Handler.Sink.Start_Object ("", Handler);
            end if;
            Handler.Row := Row;
            Handler.Sink.Set_Member (Name, Util.Beans.Objects.To_Object (Value), Handler);
         end;
      end if;
   end Set_Cell;

   --  ------------------------------
   --  Set the field separator.  The default field separator is the comma (',').
   --  ------------------------------
   procedure Set_Field_Separator (Handler   : in out Parser;
                                  Separator : in Character) is
   begin
      Handler.Separator := Separator;
   end Set_Field_Separator;

   --  ------------------------------
   --  Get the field separator.
   --  ------------------------------
   function Get_Field_Separator (Handler : in Parser) return Character is
   begin
      return Handler.Separator;
   end Get_Field_Separator;

   --  ------------------------------
   --  Set the comment separator.  When a comment separator is defined, a line which starts
   --  with the comment separator will be ignored.  The row number will not be incremented.
   --  ------------------------------
   procedure Set_Comment_Separator (Handler   : in out Parser;
                                    Separator : in Character) is
   begin
      Handler.Comment := Separator;
   end Set_Comment_Separator;

   --  ------------------------------
   --  Get the comment separator.  Returns ASCII.NUL if comments are not supported.
   --  ------------------------------
   function Get_Comment_Separator (Handler : in Parser) return Character is
   begin
      return Handler.Comment;
   end Get_Comment_Separator;

   --  ------------------------------
   --  Setup the CSV parser and mapper to use the default column header names.
   --  When activated, the first row is assumed to contain the first item to de-serialize.
   --  ------------------------------
   procedure Set_Default_Headers (Handler : in out Parser;
                                  Mode    : in Boolean := True) is
   begin
      Handler.Use_Default_Headers := Mode;
   end Set_Default_Headers;

   --  ------------------------------
   --  Parse the stream using the CSV parser.
   --  Call Set_Cell for each cell that has been parsed indicating the row and
   --  column numbers as well as the cell value.
   --  ------------------------------
   overriding
   procedure Parse (Handler : in out Parser;
                    Stream  : in out Util.Streams.Buffered.Buffered_Stream'Class;
                    Sink    : in out Reader'Class) is
      use Ada.Strings.Unbounded;

      C              : Character;
      Token          : Unbounded_String;
      Column         : Column_Type := 1;
      Row            : Row_Type  := 0;
      In_Quote_Token : Boolean := False;
      In_Escape      : Boolean := False;
      Ignore_Row     : Boolean := False;
   begin
      if Handler.Use_Default_Headers then
         Row := 1;
      end if;
      Handler.Headers.Clear;
      Handler.Sink := Sink'Unchecked_Access;
      loop
         Stream.Read (Char => C);

         if C = Ada.Characters.Latin_1.CR  or C = Ada.Characters.Latin_1.LF then
            if C = Ada.Characters.Latin_1.LF then
               Handler.Line_Number := Handler.Line_Number + 1;
            end if;
            if not Ignore_Row then
               if In_Quote_Token and not In_Escape then
                  Append (Token, C);

               elsif Column > 1 or else Length (Token) > 0 then
                  Parser'Class (Handler).Set_Cell (To_String (Token), Row, Column);
                  Set_Unbounded_String (Token, "");
                  Row            := Row + 1;
                  Column         := 1;
                  In_Quote_Token := False;
                  In_Escape      := False;
               end if;
            else
               Ignore_Row := False;
            end if;

         elsif C = Handler.Separator and not Ignore_Row then
            if In_Quote_Token and not In_Escape then
               Append (Token, C);

            else
               Parser'Class (Handler).Set_Cell (To_String (Token), Row, Column);
               Set_Unbounded_String (Token, "");
               Column         := Column + 1;
               In_Quote_Token := False;
               In_Escape      := False;
            end if;

         elsif C = '"' and not Ignore_Row then
            if In_Quote_Token then
               In_Escape := True;

            elsif In_Escape then
               Append (Token, C);
               In_Escape := False;

            elsif Ada.Strings.Unbounded.Length (Token) = 0 then
               In_Quote_Token := True;

            else
               Append (Token, C);
            end if;

         elsif C = Handler.Comment and Handler.Comment /= ASCII.NUL
           and Column = 1 and Length (Token) = 0
         then
            Ignore_Row := True;

         elsif not Ignore_Row then
            Append (Token, C);
            In_Escape := False;

         end if;

      end loop;

   exception
      when Ada.IO_Exceptions.Data_Error =>
         Parser'Class (Handler).Set_Cell (To_String (Token), Row, Column);
         Handler.Sink := null;
         return;
   end Parse;

   --  ------------------------------
   --  Get the current location (file and line) to report an error message.
   --  ------------------------------
   overriding
   function Get_Location (Handler : in Parser) return String is
   begin
      return Util.Strings.Image (Handler.Line_Number);
   end Get_Location;

end Util.Serialize.IO.CSV;

Remove Write_Entity and Write_Attribute on Nullable_String


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

package Gen is

   --  Library SVN identification
   SVN_URL : constant String := "https://ada-gen.googlecode.com/svn/trunk";

   --  Revision used (must run 'make version' to update)
   SVN_REV : constant Positive := 1095;

end Gen;

-----------------------------------------------------------------------
--  gen -- Code Generator
--  Copyright (C) 2009, 2010, 2011, 2021 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;
package Gen is

   --  Library SVN identification
   SVN_URL : constant String := "https://ada-gen.googlecode.com/svn/trunk";

   --  Revision used (must run 'make version' to update)
   SVN_REV : constant Positive := 1095;

   subtype UString is Ada.Strings.Unbounded.Unbounded_String;

   function To_UString (Value : in String) return UString
     renames Ada.Strings.Unbounded.To_Unbounded_String;

   function To_String (Value : in UString) return String
     renames Ada.Strings.Unbounded.To_String;

   function Length (Value : in UString) return Natural
     renames Ada.Strings.Unbounded.Length;

   function "=" (Left, Right : in UString) return Boolean
     renames Ada.Strings.Unbounded."=";
   function "=" (Left : in UString; Right : in String) return Boolean
     renames Ada.Strings.Unbounded."=";

end Gen;

Declare the UString subtype to simplify the implementation and use of Unbounded_String


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

with Util.Strings;

with Ada.Strings.Unbounded;

with Util.Texts.Formats;
with Util.Beans.Objects;

package ASF.Utils is

   --  Add in the names set, the basic text attributes that can be set
   --  on HTML elements (dir, lang, style, title).
   procedure Set_Text_Attributes (Names : in out Util.Strings.String_Set.Set);

   --  Add in the names set, the onXXX attributes that can be set
   --  on HTML elements (accesskey, tabindex, onXXX).
   procedure Set_Interactive_Attributes (Names : in out Util.Strings.String_Set.Set);

   --  Add in the names set, the size attributes that can be set
   --  on HTML elements.
   procedure Set_Input_Attributes (Names : in out Util.Strings.String_Set.Set);

   --  Add in the names set, the size attributes that can be set
   --  on <textarea> elements.
   procedure Set_Textarea_Attributes (Names : in out Util.Strings.String_Set.Set);

   --  Add in the names set, the online and onunload attributes that can be set
   --  on  elements.
   procedure Set_Body_Attributes (Names : in out Util.Strings.String_Set.Set);

   --  Add in the names set, the dir, lang attributes that can be set
   --  on  elements.
   procedure Set_Head_Attributes (Names : in out Util.Strings.String_Set.Set);

   --  Add in the names set, the onreset and onsubmit attributes that can be set
   --  on <form> elements.
   procedure Set_Form_Attributes (Names : in out Util.Strings.String_Set.Set);

   --  Add in the names set, the attributes which are specific to a link.
   procedure Set_Link_Attributes (Names : in out Util.Strings.String_Set.Set);

   --  Add in the names set, the attributes which are specific to an input file.
   procedure Set_File_Attributes (Names : in out Util.Strings.String_Set.Set);

   type Object_Array is array (Positive range <>) of Util.Beans.Objects.Object;

   package Formats is
     new Util.Texts.Formats (Stream     => Ada.Strings.Unbounded.Unbounded_String,
                             Char       => Character,
                             Input      => String,
                             Value      => Util.Beans.Objects.Object,
                             Value_List => Object_Array,
                             Put        => Ada.Strings.Unbounded.Append,
                             To_Input   => Util.Beans.Objects.To_String);

end ASF.Utils;

-----------------------------------------------------------------------
--  asf-utils -- Various utility operations for ASF
--  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.Strings;

with Ada.Strings.Unbounded;

with Util.Texts.Formats;
with Util.Beans.Objects;

package ASF.Utils is

   pragma Preelaborate;

   --  Add in the names set, the basic text attributes that can be set
   --  on HTML elements (dir, lang, style, title).
   procedure Set_Text_Attributes (Names : in out Util.Strings.String_Set.Set);

   --  Add in the names set, the onXXX attributes that can be set
   --  on HTML elements (accesskey, tabindex, onXXX).
   procedure Set_Interactive_Attributes (Names : in out Util.Strings.String_Set.Set);

   --  Add in the names set, the size attributes that can be set
   --  on HTML elements.
   procedure Set_Input_Attributes (Names : in out Util.Strings.String_Set.Set);

   --  Add in the names set, the size attributes that can be set
   --  on <textarea> elements.
   procedure Set_Textarea_Attributes (Names : in out Util.Strings.String_Set.Set);

   --  Add in the names set, the online and onunload attributes that can be set
   --  on  elements.
   procedure Set_Body_Attributes (Names : in out Util.Strings.String_Set.Set);

   --  Add in the names set, the dir, lang attributes that can be set
   --  on  elements.
   procedure Set_Head_Attributes (Names : in out Util.Strings.String_Set.Set);

   --  Add in the names set, the onreset and onsubmit attributes that can be set
   --  on <form> elements.
   procedure Set_Form_Attributes (Names : in out Util.Strings.String_Set.Set);

   --  Add in the names set, the attributes which are specific to a link.
   procedure Set_Link_Attributes (Names : in out Util.Strings.String_Set.Set);

   --  Add in the names set, the attributes which are specific to an input file.
   procedure Set_File_Attributes (Names : in out Util.Strings.String_Set.Set);

   type Object_Array is array (Positive range <>) of Util.Beans.Objects.Object;

   package Formats is
     new Util.Texts.Formats (Stream     => Ada.Strings.Unbounded.Unbounded_String,
                             Char       => Character,
                             Input      => String,
                             Value      => Util.Beans.Objects.Object,
                             Value_List => Object_Array,
                             Put        => Ada.Strings.Unbounded.Append,
                             To_Input   => Util.Beans.Objects.To_String);

end ASF.Utils;

Add Preelaborate pragma

Add Preelaborate pragma


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

package Definitions is

   pragma Pure;

   synth_version_major : constant String := "1";
   synth_version_minor : constant String := "61";
   copyright_years     : constant String := "2015-2016";
   host_localbase      : constant String := "/usr/local";
   host_pkg8           : constant String := host_localbase & "/sbin/pkg";
   jobs_per_cpu        : constant := 2;

   type cpu_range is range 1 .. 32;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;

end Definitions;

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

package Definitions is

   pragma Pure;

   synth_version_major : constant String := "1";
   synth_version_minor : constant String := "62";
   copyright_years     : constant String := "2015-2016";
   host_localbase      : constant String := "/usr/local";
   host_pkg8           : constant String := host_localbase & "/sbin/pkg";
   jobs_per_cpu        : constant := 2;

   type cpu_range is range 1 .. 32;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;

end Definitions;

Bump version

Bump version


-----------------------------------------------------------------------
--  serialize-io-csv-tests -- Unit tests for CSV parser
--  Copyright (C) 2011, 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.Streams.Stream_IO;
with Util.Test_Caller;
with Util.Streams.Files;
with Util.Serialize.Mappers.Tests;
with Util.Serialize.IO.JSON.Tests;
package body Util.Serialize.IO.CSV.Tests is

   package Caller is new Util.Test_Caller (Test, "Serialize.IO.CSV");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.CSV.Parse (parse Ok)",
                       Test_Parser'Access);
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.CSV.Write",
                       Test_Output'Access);
   end Add_Tests;

   --  ------------------------------
   --  Check various (basic) JSON valid strings (no mapper).
   --  ------------------------------
   procedure Test_Parser (T : in out Test) is
      use Util.Serialize.Mappers.Tests;

      procedure Check_Parse (Content : in String;
                             Expect   : in Integer);

      Mapping : aliased Util.Serialize.Mappers.Tests.Map_Test_Mapper.Mapper;

      Mapper  : aliased Util.Serialize.Mappers.Tests.Map_Test_Vector_Mapper.Mapper;

      procedure Check_Parse (Content : in String;
                             Expect : in Integer) is
         P : Parser;

         Value   : aliased Map_Test_Vector.Vector;
      begin
         P.Add_Mapping ("", Mapper'Unchecked_Access);
         Map_Test_Vector_Mapper.Set_Context (P, Value'Unchecked_Access);

         P.Parse_String (Content);

         T.Assert (not P.Has_Error, "Parse error for: " & Content);
         Util.Tests.Assert_Equals (T, 1, Integer (Value.Length), "Invalid result length");

         Util.Tests.Assert_Equals (T, Expect, Integer (Value.Element (1).Value), "Invalid value");
      end Check_Parse;

      HDR : constant String := "name,status,value,bool" & ASCII.CR & ASCII.LF;
   begin
      Mapping.Add_Mapping ("name", FIELD_NAME);
      Mapping.Add_Mapping ("value", FIELD_VALUE);
      Mapping.Add_Mapping ("status", FIELD_BOOL);
      Mapping.Add_Mapping ("bool", FIELD_BOOL);
      Mapper.Set_Mapping (Mapping'Unchecked_Access);

      Check_Parse (HDR & "joe,false,23,true", 23);
      Check_Parse (HDR & "billy,false,""12"",true", 12);
      Check_Parse (HDR & """John Potter"",false,""1234"",true", 1234);
      Check_Parse (HDR & """John" & ASCII.CR & "Potter"",False,""3234"",True", 3234);
      Check_Parse (HDR & """John" & ASCII.LF & "Potter"",False,""3234"",True", 3234);
   end Test_Parser;

   --  ------------------------------
   --  Test the CSV output stream generation.
   --  ------------------------------
   procedure Test_Output (T : in out Test) is
      File   : aliased Util.Streams.Files.File_Stream;
      Stream : Util.Serialize.IO.CSV.Output_Stream;
      Expect : constant String := Util.Tests.Get_Path ("regtests/expect/test-stream.csv");
      Path   : constant String := Util.Tests.Get_Test_Path ("regtests/result/test-stream.csv");
   begin
      File.Create (Mode => Ada.Streams.Stream_IO.Out_File, Name => Path);
      Stream.Initialize (Output => File'Unchecked_Access, Input => null, Size => 10000);
      Util.Serialize.IO.JSON.Tests.Write_Stream (Stream);
      Stream.Close;
      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => Expect,
                                     Test    => Path,
                                     Message => "CSV output serialization");
   end Test_Output;

end Util.Serialize.IO.CSV.Tests;

-----------------------------------------------------------------------
--  serialize-io-csv-tests -- Unit tests for CSV parser
--  Copyright (C) 2011, 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.Streams.Stream_IO;
with Util.Test_Caller;
with Util.Streams.Files;
with Util.Serialize.Mappers.Tests;
with Util.Serialize.IO.JSON.Tests;
package body Util.Serialize.IO.CSV.Tests is

   package Caller is new Util.Test_Caller (Test, "Serialize.IO.CSV");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.CSV.Parse (parse Ok)",
                       Test_Parser'Access);
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.CSV.Write",
                       Test_Output'Access);
   end Add_Tests;

   --  ------------------------------
   --  Check various (basic) JSON valid strings (no mapper).
   --  ------------------------------
   procedure Test_Parser (T : in out Test) is
      use Util.Serialize.Mappers.Tests;

      procedure Check_Parse (Content : in String;
                             Expect   : in Integer);

      Mapping        : aliased Util.Serialize.Mappers.Tests.Map_Test_Mapper.Mapper;
      Vector_Mapper  : aliased Util.Serialize.Mappers.Tests.Map_Test_Vector_Mapper.Mapper;

      procedure Check_Parse (Content : in String;
                             Expect : in Integer) is
         P : Parser;

         Value   : aliased Map_Test_Vector.Vector;
         Mapper  : Util.Serialize.Mappers.Processing;
      begin
         Mapper.Add_Mapping ("", Vector_Mapper'Unchecked_Access);
         Map_Test_Vector_Mapper.Set_Context (Mapper, Value'Unchecked_Access);

         P.Parse_String (Content, Mapper);

         T.Assert (not P.Has_Error, "Parse error for: " & Content);
         Util.Tests.Assert_Equals (T, 1, Integer (Value.Length), "Invalid result length");

         Util.Tests.Assert_Equals (T, Expect, Integer (Value.Element (1).Value), "Invalid value");
      end Check_Parse;

      HDR : constant String := "name,status,value,bool" & ASCII.CR & ASCII.LF;
   begin
      Mapping.Add_Mapping ("name", FIELD_NAME);
      Mapping.Add_Mapping ("value", FIELD_VALUE);
      Mapping.Add_Mapping ("status", FIELD_BOOL);
      Mapping.Add_Mapping ("bool", FIELD_BOOL);
      Vector_Mapper.Set_Mapping (Mapping'Unchecked_Access);

      Check_Parse (HDR & "joe,false,23,true", 23);
      Check_Parse (HDR & "billy,false,""12"",true", 12);
      Check_Parse (HDR & """John Potter"",false,""1234"",true", 1234);
      Check_Parse (HDR & """John" & ASCII.CR & "Potter"",False,""3234"",True", 3234);
      Check_Parse (HDR & """John" & ASCII.LF & "Potter"",False,""3234"",True", 3234);
   end Test_Parser;

   --  ------------------------------
   --  Test the CSV output stream generation.
   --  ------------------------------
   procedure Test_Output (T : in out Test) is
      File   : aliased Util.Streams.Files.File_Stream;
      Stream : Util.Serialize.IO.CSV.Output_Stream;
      Expect : constant String := Util.Tests.Get_Path ("regtests/expect/test-stream.csv");
      Path   : constant String := Util.Tests.Get_Test_Path ("regtests/result/test-stream.csv");
   begin
      File.Create (Mode => Ada.Streams.Stream_IO.Out_File, Name => Path);
      Stream.Initialize (Output => File'Unchecked_Access, Input => null, Size => 10000);
      Util.Serialize.IO.JSON.Tests.Write_Stream (Stream);
      Stream.Close;
      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => Expect,
                                     Test    => Path,
                                     Message => "CSV output serialization");
   end Test_Output;

end Util.Serialize.IO.CSV.Tests;

Update the unit tests for the new parser/reader interfaces


-----------------------------------------------------------------------
--  util-commands-drivers -- Support to make command line tools
--  Copyright (C) 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 Util.Log.Loggers;
package body Util.Commands.Drivers is

   --  The logger
   Logs : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create (Driver_Name);

   --  ------------------------------
   --  Write the command usage.
   --  ------------------------------
   procedure Usage (Command : in Command_Type) is
   begin
      null;
   end Usage;

   --  ------------------------------
   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   --  The <tt>Log</tt> operation is redirected to the driver's <tt>Log</tt> procedure.
   --  ------------------------------
   procedure Log (Command : in Command_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String) is
   begin
      Command.Driver.Log (Level, Name, Message);
   end Log;

   --  ------------------------------
    --  Register the command under the given name.
   --  ------------------------------
   procedure Add_Command (Driver  : in out Driver_Type;
                          Name    : in String;
                          Command : in Command_Access) is
   begin
      Command.Driver := Driver'Unchecked_Access;
      Driver.List.Include (Name, Command);
   end Add_Command;

   --  ------------------------------
   --  Register the command under the given name.
   --  ------------------------------
   procedure Add_Command (Driver  : in out Driver_Type;
                          Name    : in String;
                          Handler : in Command_Handler) is
   begin
      Driver.List.Include (Name, new Handler_Command_Type '(Driver  => Driver'Unchecked_Access,
                                                            Handler => Handler));
   end Add_Command;

   --  ------------------------------
   --  Find the command having the given name.
   --  Returns null if the command was not found.
   --  ------------------------------
   function Find_Command (Driver : in Driver_Type;
                          Name   : in String) return Command_Access is
      Pos : constant Command_Maps.Cursor := Driver.List.Find (Name);
   begin
      if Command_Maps.Has_Element (Pos) then
         return Command_Maps.Element (Pos);
      else
         return null;
      end if;
   end Find_Command;

   --  ------------------------------
   --  Execute the command registered under the given name.
   --  ------------------------------
   procedure Execute (Driver  : in Driver_Type;
                      Name    : in String;
                      Args    : in out Argument_List;
                      Context : in out Context_Type) is
      Command : constant Command_Access := Driver.Find_Command (Name);
   begin
      if Command /= null then
         Command.Execute (Name, Args, Context);
      end if;
   end Execute;

   --  ------------------------------
   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   --  ------------------------------
   procedure Log (Driver  : in Driver_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String) is
   begin
      Logs.Print (Level, "{0}: {1}", Name, Message);
   end Log;

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Command   : in Handler_Command_Type;
                      Name      : in String;
                      Args      : in out Argument_List;
                      Context   : in out Context_Type) is
   begin
      Command.Handler (Name, Args, Context);
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Command   : in Handler_Command_Type;
                   Context   : in out Context_Type) is
   begin
      null;
   end Help;

end Util.Commands.Drivers;

-----------------------------------------------------------------------
--  util-commands-drivers -- Support to make command line tools
--  Copyright (C) 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 Util.Log.Loggers;
with Ada.Text_IO; use Ada.Text_IO;
package body Util.Commands.Drivers is

   --  The logger
   Logs : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create (Driver_Name);

   --  ------------------------------
   --  Write the command usage.
   --  ------------------------------
   procedure Usage (Command : in Command_Type) is
   begin
      null;
   end Usage;

   --  ------------------------------
   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   --  The <tt>Log</tt> operation is redirected to the driver's <tt>Log</tt> procedure.
   --  ------------------------------
   procedure Log (Command : in Command_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String) is
   begin
      Command.Driver.Log (Level, Name, Message);
   end Log;

   --  ------------------------------
   --  Execute the help command with the arguments.
   --  Print the help for every registered command.
   --  ------------------------------
   overriding
   procedure Execute (Command   : in Help_Command_Type;
                      Name      : in String;
                      Args      : in out Argument_List;
                      Context   : in out Context_Type) is
     procedure Print (Position : in Command_Maps.Cursor);

      procedure Print (Position : in Command_Maps.Cursor) is
         Name : constant String := Command_Maps.Key (Position);
      begin
         Put_Line ("   " & Name);
      end Print;

   begin
      Logs.Debug ("Execute command {0}", Name);

      if Name'Length = 0 then
         --  Usage;
         New_Line;
         Put ("Type '");
         --  Put (Ada.Command_Line.Command_Name);
         Put_Line (" help {command}' for help on a specific command.");
         New_Line;
         Put_Line ("Available subcommands:");

         Command.Driver.List.Iterate (Process => Print'Access);
      else
         declare
            Target_Cmd : constant Command_Access := Command.Driver.Find_Command (Name);
         begin
            if Target_Cmd = null then
               Logs.Error ("Unknown command {0}", Name);
            else
               Target_Cmd.Help (Context);
            end if;
         end;
      end if;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Command   : in Help_Command_Type;
                   Context   : in out Context_Type) is
   begin
      null;
   end Help;

   --  ------------------------------
    --  Register the command under the given name.
   --  ------------------------------
   procedure Add_Command (Driver  : in out Driver_Type;
                          Name    : in String;
                          Command : in Command_Access) is
   begin
      Command.Driver := Driver'Unchecked_Access;
      Driver.List.Include (Name, Command);
   end Add_Command;

   --  ------------------------------
   --  Register the command under the given name.
   --  ------------------------------
   procedure Add_Command (Driver  : in out Driver_Type;
                          Name    : in String;
                          Handler : in Command_Handler) is
   begin
      Driver.List.Include (Name, new Handler_Command_Type '(Driver  => Driver'Unchecked_Access,
                                                            Handler => Handler));
   end Add_Command;

   --  ------------------------------
   --  Find the command having the given name.
   --  Returns null if the command was not found.
   --  ------------------------------
   function Find_Command (Driver : in Driver_Type;
                          Name   : in String) return Command_Access is
      Pos : constant Command_Maps.Cursor := Driver.List.Find (Name);
   begin
      if Command_Maps.Has_Element (Pos) then
         return Command_Maps.Element (Pos);
      else
         return null;
      end if;
   end Find_Command;

   --  ------------------------------
   --  Execute the command registered under the given name.
   --  ------------------------------
   procedure Execute (Driver  : in Driver_Type;
                      Name    : in String;
                      Args    : in out Argument_List;
                      Context : in out Context_Type) is
      Command : constant Command_Access := Driver.Find_Command (Name);
   begin
      if Command /= null then
         Command.Execute (Name, Args, Context);
      end if;
   end Execute;

   --  ------------------------------
   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   --  ------------------------------
   procedure Log (Driver  : in Driver_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String) is
   begin
      Logs.Print (Level, "{0}: {1}", Name, Message);
   end Log;

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Command   : in Handler_Command_Type;
                      Name      : in String;
                      Args      : in out Argument_List;
                      Context   : in out Context_Type) is
   begin
      Command.Handler (Name, Args, Context);
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Command   : in Handler_Command_Type;
                   Context   : in out Context_Type) is
   begin
      null;
   end Help;

end Util.Commands.Drivers;

Implement the Execute and Help procedures for the Help_Command_Type


-----------------------------------------------------------------------
--  util-properties-bundles -- Generic name/value property management
--  Copyright (C) 2001 - 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 Ada.Unchecked_Conversion;
with Ada.Directories;
with Ada.Containers.Vectors;
with Ada.Strings.Fixed;
with Util.Log.Loggers;
with Util.Files;
package body Util.Properties.Bundles is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Properties.Bundles");

   use type Util.Properties.Manager_Access;

   procedure Free is
     new Ada.Unchecked_Deallocation (Manager'Class,
                                     Bundle_Manager_Access);

   --  Implementation of the Bundle
   --  (this allows to decouples the implementation from the API)
   package Interface_P is

      type Manager is new Util.Properties.Interface_P.Manager with private;

      --  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 exists.
      overriding
      function Exists (Self : in Manager;
                       Name : in String)
                       return Boolean;

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

      --  Iterate over the properties and execute the given procedure passing the
      --  property name and its value.
      overriding
      procedure Iterate (Self    : in Manager;
                         Process : access procedure (Name : in String;
                                                     Item : in Util.Beans.Objects.Object));

      procedure Load_Properties (Self : in out Manager;
                                 File : in String);

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

      procedure Add_Bundle (Self : in out Manager;
                            Props : in Util.Properties.Manager_Access);
   private

      package PropertyList is new Ada.Containers.Vectors
        (Element_Type => Util.Properties.Manager_Access,
         Index_Type => Natural,
           "=" => "=");

      type Manager is new Util.Properties.Interface_P.Manager with record
         List  : PropertyList.Vector;
         Props : aliased Util.Properties.Manager;
      end record;

   end Interface_P;

   procedure Add_Bundle (Self  : in out Manager;
                         Props : in Manager_Access) is
   begin
      Interface_P.Manager'Class (Self.Impl.all).Add_Bundle (Props);
   end Add_Bundle;

   procedure Initialize (Object : in out Manager) is
      use Util.Properties.Interface_P;
   begin
      Object.Impl := new Util.Properties.Bundles.Interface_P.Manager;
      Util.Concurrent.Counters.Increment (Object.Impl.Count);
   end Initialize;

   procedure Adjust (Object : in out Manager) is
      use Util.Properties.Interface_P;
   begin
      if Object.Impl = null then
         Object.Impl := new Util.Properties.Bundles.Interface_P.Manager;
      end if;
      Util.Concurrent.Counters.Increment (Object.Impl.Count);
   end Adjust;

   --  ------------------------------
   --  Initialize the bundle factory and specify where the property files are stored.
   --  ------------------------------
   procedure Initialize (Factory : in out Loader;
                         Path    : in String) is
   begin
      Log.Info ("Initialize bundle factory to load from {0}", Path);

      Factory.Path := To_Unbounded_String (Path);
   end Initialize;

   --  ------------------------------
   --  Load the bundle with the given name and for the given locale name.
   --  ------------------------------
   procedure Load_Bundle (Factory : in out Loader;
                          Name    : in String;
                          Locale  : in String;
                          Bundle  : out Manager'Class) is
      Found : Boolean := False;
   begin
      Log.Info ("Load bundle {0} for language {1}", Name, Locale);

      Find_Bundle (Factory, Name, Locale, Bundle, Found);
      if not Found then
         Load_Bundle (Factory, Name, Found);
         if not Found then
            Log.Error ("Bundle {0} not found", Name);
            raise NO_BUNDLE with "No bundle '" & Name & "'";
         end if;
         Find_Bundle (Factory, Name, Locale, Bundle, Found);
         if not Found then
            Log.Error ("Bundle {0} not found", Name);
            raise NO_BUNDLE with "No bundle '" & Name & "'";
         end if;
      end if;
   end Load_Bundle;

   --  ------------------------------
   --  Find the bundle with the given name and for the given locale name.
   --  ------------------------------
   procedure Find_Bundle (Factory : in out Loader;
                          Name    : in String;
                          Locale  : in String;
                          Bundle  : out Manager'Class;
                          Found   : out Boolean) is
      use Ada.Strings;

      Loc_Name : constant String := '_' & Locale;
      Last_Pos : Integer := Loc_Name'Last;
   begin
      Log.Debug ("Looking for bundle {0} and language {1}", Name, Locale);

      Found := False;
      Factory.Lock.Read;
      declare
         Pos : Bundle_Map.Cursor;
      begin
         while Last_Pos + 1 >= Loc_Name'First loop
            declare
               Bundle_Name : aliased constant String
                 := Name & Loc_Name (Loc_Name'First .. Last_Pos);
            begin
               Log.Debug ("Searching for {0}", Bundle_Name);
               Pos := Factory.Bundles.Find (Bundle_Name'Unrestricted_Access);
               if Bundle_Map.Has_Element (Pos) then
                  Bundle.Finalize;
                  Bundle.Impl := Bundle_Map.Element (Pos).Impl;
                  Util.Concurrent.Counters.Increment (Bundle.Impl.Count);
                  Found := True;
                  exit;
               end if;
            end;
            if Last_Pos > Loc_Name'First then
               Last_Pos := Fixed.Index (Loc_Name, "_", Last_Pos - 1, Backward) - 1;
            else
               Last_Pos := Last_Pos - 1;
            end if;
         end loop;
      exception
         when others =>
            Factory.Lock.Release_Read;
            raise;
      end;
      Factory.Lock.Release_Read;
   end Find_Bundle;

   --  ------------------------------
   --  Load the bundle with the given name and for the given locale name.
   --  ------------------------------
   procedure Load_Bundle (Factory : in out Loader;
                          Name    : in String;
                          Found   : out Boolean) is
      use Ada.Directories;
      use Ada.Strings;
      use Util.Strings;
      use Ada.Containers;
      use Util.Strings.String_Set;
      use Bundle_Map;

      procedure Process_File (Name      : in String;
                              File_Path : in String;
                              Done      : out Boolean);

      Path    : constant String := To_String (Factory.Path);
      Pattern : constant String := Name & "*.properties";
      Names   : Util.Strings.String_Set.Set;

      procedure Process_File (Name      : in String;
                              File_Path : in String;
                              Done      : out Boolean) is
         subtype Cursor is Bundle_Map.Cursor;

         Base_Name   : aliased constant String := Name (Name'First .. Name'Last - 11);
         Pos         : constant Cursor := Factory.Bundles.Find (Base_Name'Unchecked_Access);
         Bundle_Name : Name_Access;
         Bundle      : Bundle_Manager_Access;
      begin
         Log.Info ("Loading file {0}", File_Path);

         if Bundle_Map.Has_Element (Pos) then
            Bundle := Bundle_Map.Element (Pos);
         else
            Bundle := new Manager;
            Bundle_Name := new String '(Base_Name);
            Factory.Bundles.Include (Key => Bundle_Name, New_Item => Bundle);
            Names.Insert (Bundle_Name);
         end if;
         Interface_P.Manager'Class (Bundle.Impl.all).Load_Properties (File_Path);
         Found := True;
         Done := False;
      end Process_File;

   begin
      Log.Info ("Reading bundle {1} in directory {0}", Path, Name);

      Found := False;
      Factory.Lock.Write;

      begin
         Util.Files.Iterate_Files_Path (Pattern => Pattern,
                                        Path    => Path,
                                        Process => Process_File'Access,
                                        Going   => Ada.Strings.Backward);

         --  Link the property files to implement the localization default rules.
         while Names.Length > 0 loop
            declare
               Name_Pos    : String_Set.Cursor := Names.First;
               Bundle_Name : constant Name_Access := String_Set.Element (Name_Pos);
               Idx         : Natural := Fixed.Index (Bundle_Name.all, "_", Backward);
               Bundle_Pos  : constant Bundle_Map.Cursor := Factory.Bundles.Find (Bundle_Name);
               Bundle      : constant Bundle_Manager_Access := Element (Bundle_Pos);
            begin
               Names.Delete (Name_Pos);

               --  Associate the property bundle to the first existing parent
               --  Ex:  message_fr_CA -> message_fr
               --       message_fr_CA -> message
               while Idx > 0 loop
                  declare
                     Name : aliased constant String
                       := Bundle_Name (Bundle_Name'First .. Idx - 1);
                     Pos : constant Bundle_Map.Cursor
                       := Factory.Bundles.Find (Name'Unchecked_Access);
                  begin
                     if Bundle_Map.Has_Element (Pos) then
                        Bundle.Add_Bundle (Bundle_Map.Element (Pos).all'Access);
                        Idx := 0;
                     else
                        Idx := Fixed.Index (Bundle_Name.all, "_", Idx - 1, Backward);
                     end if;
                  end;
               end loop;
            end;
         end loop;

      exception
         when others =>
            Factory.Lock.Release_Write;
            raise;
      end;
      Factory.Lock.Release_Write;

   exception
      when Name_Error =>
         Log.Error ("Cannot read directory: {0}", Path);

   end Load_Bundle;

   --  Implementation of the Bundle
   --  (this allows to decouples the implementation from the API)
   package body Interface_P is
      use PropertyList;

      --  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 is
         Result : Util.Beans.Objects.Object := From.Props.Get_Value (Name);
      begin
         if Util.Beans.Objects.Is_Null (Result) then
            declare
               Iter : Cursor := From.List.First;
            begin
               while Has_Element (Iter) loop
                  Result := Element (Iter).all.Get_Value (Name);
                  exit when not Util.Beans.Objects.Is_Null (Result);
                  Iter := Next (Iter);
               end loop;
            end;
         end if;
         return Result;
      end Get_Value;

      --  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) is
      begin
         raise NOT_WRITEABLE with "Bundle is readonly";
      end Set_Value;

      --  ------------------------------
      --  Returns TRUE if the property exists.
      --  ------------------------------
      function Exists (Self : in Manager; Name : in String)
                      return Boolean is
         Iter : Cursor := Self.List.First;
      begin
         if Self.Props.Exists (Name) then
            return True;
         end if;
         while Has_Element (Iter) loop
            if Element (Iter).Exists (Name) then
               return True;
            end if;
            Iter := Next (Iter);
         end loop;
         return False;
      end Exists;

      procedure Load_Properties (Self : in out Manager;
                                 File : in String) is
      begin
         Self.Props.Load_Properties (File);
      end Load_Properties;

      --  ------------------------------
      --  Remove the property given its name.
      --  ------------------------------
      procedure Remove (Self : in out Manager;
                        Name : in String) is
      begin
         raise NOT_WRITEABLE with "Bundle is readonly";
      end Remove;

      --  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 Util.Beans.Objects.Object)) is
      begin
         raise Program_Error with "Iterate is not implemented on Bundle";
      end Iterate;

      --  ------------------------------
      --  Deep copy of properties stored in 'From' to 'To'.
      --  ------------------------------
      function Create_Copy (Self : in Manager)
                            return Util.Properties.Interface_P.Manager_Access is
         pragma Unreferenced (Self);
      begin
         return null;
      end Create_Copy;

      procedure Add_Bundle (Self  : in out Manager;
                            Props : in Util.Properties.Manager_Access) is
      begin
         Self.List.Append (Props);
      end Add_Bundle;

   end Interface_P;

   --  ------------------------------
   --  Clear the bundle cache
   --  ------------------------------
   procedure Clear_Cache (Factory : in out Loader) is
      use Util.Strings;
      use Bundle_Map;

      function To_String_Access is
        new Ada.Unchecked_Conversion (Source => Util.Strings.Name_Access,
                                      Target => Ada.Strings.Unbounded.String_Access);

   begin
      Log.Info ("Clearing bundle cache");

      Factory.Lock.Write;
      loop
         declare
            Pos  : Bundle_Map.Cursor := Factory.Bundles.First;
            Name : Ada.Strings.Unbounded.String_Access;
            Node : Bundle_Manager_Access;
         begin
            exit when not Has_Element (Pos);
            Node := Element (Pos);
            Name := To_String_Access (Key (Pos));
            Factory.Bundles.Delete (Pos);
            Free (Node);
            Free (Name);
         end;
      end loop;
      Factory.Lock.Release_Write;
   end Clear_Cache;

   --  ------------------------------
   --  Finalize the bundle loader and clear the cache
   --  ------------------------------
   procedure Finalize (Factory : in out Loader) is
   begin
      Clear_Cache (Factory);
   end Finalize;

end Util.Properties.Bundles;

-----------------------------------------------------------------------
--  util-properties-bundles -- Generic name/value property management
--  Copyright (C) 2001 - 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 Ada.Unchecked_Conversion;
with Ada.Directories;
with Ada.Containers.Vectors;
with Ada.Strings.Fixed;
with Util.Log.Loggers;
with Util.Files;
package body Util.Properties.Bundles is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Properties.Bundles");

   procedure Free is
     new Ada.Unchecked_Deallocation (Manager'Class,
                                     Bundle_Manager_Access);

   --  Implementation of the Bundle
   --  (this allows to decouples the implementation from the API)
   package Interface_P is

      type Manager is new Util.Properties.Interface_P.Manager with private;

      --  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 exists.
      overriding
      function Exists (Self : in Manager;
                       Name : in String)
                       return Boolean;

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

      --  Iterate over the properties and execute the given procedure passing the
      --  property name and its value.
      overriding
      procedure Iterate (Self    : in Manager;
                         Process : access procedure (Name : in String;
                                                     Item : in Util.Beans.Objects.Object));

      procedure Load_Properties (Self : in out Manager;
                                 File : in String);

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

      procedure Add_Bundle (Self : in out Manager;
                            Props : in Util.Properties.Manager_Access);
   private

      package PropertyList is new Ada.Containers.Vectors
        (Element_Type => Util.Properties.Manager_Access,
         Index_Type => Natural,
           "=" => "=");

      type Manager is new Util.Properties.Interface_P.Manager with record
         List  : PropertyList.Vector;
         Props : aliased Util.Properties.Manager;
      end record;

   end Interface_P;

   procedure Add_Bundle (Self  : in out Manager;
                         Props : in Manager_Access) is
   begin
      Interface_P.Manager'Class (Self.Impl.all).Add_Bundle (Props);
   end Add_Bundle;

   procedure Initialize (Object : in out Manager) is
      use Util.Properties.Interface_P;
   begin
      Object.Impl := new Util.Properties.Bundles.Interface_P.Manager;
      Util.Concurrent.Counters.Increment (Object.Impl.Count);
   end Initialize;

   procedure Adjust (Object : in out Manager) is
      use Util.Properties.Interface_P;
   begin
      if Object.Impl = null then
         Object.Impl := new Util.Properties.Bundles.Interface_P.Manager;
      end if;
      Util.Concurrent.Counters.Increment (Object.Impl.Count);
   end Adjust;

   --  ------------------------------
   --  Initialize the bundle factory and specify where the property files are stored.
   --  ------------------------------
   procedure Initialize (Factory : in out Loader;
                         Path    : in String) is
   begin
      Log.Info ("Initialize bundle factory to load from {0}", Path);

      Factory.Path := To_Unbounded_String (Path);
   end Initialize;

   --  ------------------------------
   --  Load the bundle with the given name and for the given locale name.
   --  ------------------------------
   procedure Load_Bundle (Factory : in out Loader;
                          Name    : in String;
                          Locale  : in String;
                          Bundle  : out Manager'Class) is
      Found : Boolean := False;
   begin
      Log.Info ("Load bundle {0} for language {1}", Name, Locale);

      Find_Bundle (Factory, Name, Locale, Bundle, Found);
      if not Found then
         Load_Bundle (Factory, Name, Found);
         if not Found then
            Log.Error ("Bundle {0} not found", Name);
            raise NO_BUNDLE with "No bundle '" & Name & "'";
         end if;
         Find_Bundle (Factory, Name, Locale, Bundle, Found);
         if not Found then
            Log.Error ("Bundle {0} not found", Name);
            raise NO_BUNDLE with "No bundle '" & Name & "'";
         end if;
      end if;
   end Load_Bundle;

   --  ------------------------------
   --  Find the bundle with the given name and for the given locale name.
   --  ------------------------------
   procedure Find_Bundle (Factory : in out Loader;
                          Name    : in String;
                          Locale  : in String;
                          Bundle  : out Manager'Class;
                          Found   : out Boolean) is
      use Ada.Strings;

      Loc_Name : constant String := '_' & Locale;
      Last_Pos : Integer := Loc_Name'Last;
   begin
      Log.Debug ("Looking for bundle {0} and language {1}", Name, Locale);

      Found := False;
      Factory.Lock.Read;
      declare
         Pos : Bundle_Map.Cursor;
      begin
         while Last_Pos + 1 >= Loc_Name'First loop
            declare
               Bundle_Name : aliased constant String
                 := Name & Loc_Name (Loc_Name'First .. Last_Pos);
            begin
               Log.Debug ("Searching for {0}", Bundle_Name);
               Pos := Factory.Bundles.Find (Bundle_Name'Unrestricted_Access);
               if Bundle_Map.Has_Element (Pos) then
                  Bundle.Finalize;
                  Bundle.Impl := Bundle_Map.Element (Pos).Impl;
                  Util.Concurrent.Counters.Increment (Bundle.Impl.Count);
                  Found := True;
                  exit;
               end if;
            end;
            if Last_Pos > Loc_Name'First then
               Last_Pos := Fixed.Index (Loc_Name, "_", Last_Pos - 1, Backward) - 1;
            else
               Last_Pos := Last_Pos - 1;
            end if;
         end loop;
      exception
         when others =>
            Factory.Lock.Release_Read;
            raise;
      end;
      Factory.Lock.Release_Read;
   end Find_Bundle;

   --  ------------------------------
   --  Load the bundle with the given name and for the given locale name.
   --  ------------------------------
   procedure Load_Bundle (Factory : in out Loader;
                          Name    : in String;
                          Found   : out Boolean) is
      use Ada.Directories;
      use Ada.Strings;
      use Util.Strings;
      use Ada.Containers;
      use Util.Strings.String_Set;
      use Bundle_Map;

      procedure Process_File (Name      : in String;
                              File_Path : in String;
                              Done      : out Boolean);

      Path    : constant String := To_String (Factory.Path);
      Pattern : constant String := Name & "*.properties";
      Names   : Util.Strings.String_Set.Set;

      procedure Process_File (Name      : in String;
                              File_Path : in String;
                              Done      : out Boolean) is
         subtype Cursor is Bundle_Map.Cursor;

         Base_Name   : aliased constant String := Name (Name'First .. Name'Last - 11);
         Pos         : constant Cursor := Factory.Bundles.Find (Base_Name'Unchecked_Access);
         Bundle_Name : Name_Access;
         Bundle      : Bundle_Manager_Access;
      begin
         Log.Info ("Loading file {0}", File_Path);

         if Bundle_Map.Has_Element (Pos) then
            Bundle := Bundle_Map.Element (Pos);
         else
            Bundle := new Manager;
            Bundle_Name := new String '(Base_Name);
            Factory.Bundles.Include (Key => Bundle_Name, New_Item => Bundle);
            Names.Insert (Bundle_Name);
         end if;
         Interface_P.Manager'Class (Bundle.Impl.all).Load_Properties (File_Path);
         Found := True;
         Done := False;
      end Process_File;

   begin
      Log.Info ("Reading bundle {1} in directory {0}", Path, Name);

      Found := False;
      Factory.Lock.Write;

      begin
         Util.Files.Iterate_Files_Path (Pattern => Pattern,
                                        Path    => Path,
                                        Process => Process_File'Access,
                                        Going   => Ada.Strings.Backward);

         --  Link the property files to implement the localization default rules.
         while Names.Length > 0 loop
            declare
               Name_Pos    : String_Set.Cursor := Names.First;
               Bundle_Name : constant Name_Access := String_Set.Element (Name_Pos);
               Idx         : Natural := Fixed.Index (Bundle_Name.all, "_", Backward);
               Bundle_Pos  : constant Bundle_Map.Cursor := Factory.Bundles.Find (Bundle_Name);
               Bundle      : constant Bundle_Manager_Access := Element (Bundle_Pos);
            begin
               Names.Delete (Name_Pos);

               --  Associate the property bundle to the first existing parent
               --  Ex:  message_fr_CA -> message_fr
               --       message_fr_CA -> message
               while Idx > 0 loop
                  declare
                     Name : aliased constant String
                       := Bundle_Name (Bundle_Name'First .. Idx - 1);
                     Pos : constant Bundle_Map.Cursor
                       := Factory.Bundles.Find (Name'Unchecked_Access);
                  begin
                     if Bundle_Map.Has_Element (Pos) then
                        Bundle.Add_Bundle (Bundle_Map.Element (Pos).all'Access);
                        Idx := 0;
                     else
                        Idx := Fixed.Index (Bundle_Name.all, "_", Idx - 1, Backward);
                     end if;
                  end;
               end loop;
            end;
         end loop;

      exception
         when others =>
            Factory.Lock.Release_Write;
            raise;
      end;
      Factory.Lock.Release_Write;

   exception
      when Name_Error =>
         Log.Error ("Cannot read directory: {0}", Path);

   end Load_Bundle;

   --  Implementation of the Bundle
   --  (this allows to decouples the implementation from the API)
   package body Interface_P is
      use PropertyList;

      --  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 is
         Result : Util.Beans.Objects.Object := From.Props.Get_Value (Name);
      begin
         if Util.Beans.Objects.Is_Null (Result) then
            declare
               Iter : Cursor := From.List.First;
            begin
               while Has_Element (Iter) loop
                  Result := Element (Iter).all.Get_Value (Name);
                  exit when not Util.Beans.Objects.Is_Null (Result);
                  Iter := Next (Iter);
               end loop;
            end;
         end if;
         return Result;
      end Get_Value;

      --  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) is
      begin
         raise NOT_WRITEABLE with "Bundle is readonly";
      end Set_Value;

      --  ------------------------------
      --  Returns TRUE if the property exists.
      --  ------------------------------
      function Exists (Self : in Manager; Name : in String)
                      return Boolean is
         Iter : Cursor := Self.List.First;
      begin
         if Self.Props.Exists (Name) then
            return True;
         end if;
         while Has_Element (Iter) loop
            if Element (Iter).Exists (Name) then
               return True;
            end if;
            Iter := Next (Iter);
         end loop;
         return False;
      end Exists;

      procedure Load_Properties (Self : in out Manager;
                                 File : in String) is
      begin
         Self.Props.Load_Properties (File);
      end Load_Properties;

      --  ------------------------------
      --  Remove the property given its name.
      --  ------------------------------
      procedure Remove (Self : in out Manager;
                        Name : in String) is
      begin
         raise NOT_WRITEABLE with "Bundle is readonly";
      end Remove;

      --  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 Util.Beans.Objects.Object)) is
      begin
         raise Program_Error with "Iterate is not implemented on Bundle";
      end Iterate;

      --  ------------------------------
      --  Deep copy of properties stored in 'From' to 'To'.
      --  ------------------------------
      function Create_Copy (Self : in Manager)
                            return Util.Properties.Interface_P.Manager_Access is
         pragma Unreferenced (Self);
      begin
         return null;
      end Create_Copy;

      procedure Add_Bundle (Self  : in out Manager;
                            Props : in Util.Properties.Manager_Access) is
      begin
         Self.List.Append (Props);
      end Add_Bundle;

   end Interface_P;

   --  ------------------------------
   --  Clear the bundle cache
   --  ------------------------------
   procedure Clear_Cache (Factory : in out Loader) is
      use Util.Strings;
      use Bundle_Map;

      function To_String_Access is
        new Ada.Unchecked_Conversion (Source => Util.Strings.Name_Access,
                                      Target => Ada.Strings.Unbounded.String_Access);

   begin
      Log.Info ("Clearing bundle cache");

      Factory.Lock.Write;
      loop
         declare
            Pos  : Bundle_Map.Cursor := Factory.Bundles.First;
            Name : Ada.Strings.Unbounded.String_Access;
            Node : Bundle_Manager_Access;
         begin
            exit when not Has_Element (Pos);
            Node := Element (Pos);
            Name := To_String_Access (Key (Pos));
            Factory.Bundles.Delete (Pos);
            Free (Node);
            Free (Name);
         end;
      end loop;
      Factory.Lock.Release_Write;
   end Clear_Cache;

   --  ------------------------------
   --  Finalize the bundle loader and clear the cache
   --  ------------------------------
   procedure Finalize (Factory : in out Loader) is
   begin
      Clear_Cache (Factory);
   end Finalize;

end Util.Properties.Bundles;

Remove unecessary use type clause

Remove unecessary use type clause