-----------------------------------------------------------------------
--  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

   --  ------------------------------
   --  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 (",");
      end if;
      Stream.Column := Stream.Column + 1;
      Stream.Write ('"');
      for I in Value'Range loop
         if Value (I) = '"' then
            Stream.Write ("""""");
         else
            Stream.Write (Value (I));
         end if;
      end loop;
      Stream.Write ('"');
   end Write_Cell;

   procedure Write_Cell (Stream : in out Output_Stream;
                         Value  : in Integer) is
   begin
      if Stream.Column > 1 then
         Stream.Write (",");
      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 (",");
      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 (",");
            end if;
            Stream.Column := Stream.Column + 1;
            Stream.Write ("""null""");

         when TYPE_BOOLEAN =>
            if Stream.Column > 1 then
               Stream.Write (",");
            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 (",");
            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.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;

   --  ------------------------------
   --  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
                  Parser'Class (Handler).Finish_Object ("");
               end if;
               Parser'Class (Handler).Start_Object ("");
            end if;
            Handler.Row := Row;
            Parser'Class (Handler).Set_Member (Name, Util.Beans.Objects.To_Object (Value));
         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) 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;
      Context        : Element_Context_Access;
   begin
      Context_Stack.Push (Handler.Stack);
      Context := Context_Stack.Current (Handler.Stack);
      Context.Active_Nodes (1) := Handler.Mapping_Tree'Unchecked_Access;
      if Handler.Use_Default_Headers then
         Row := 1;
      end if;
      Handler.Headers.Clear;
      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);
         Context_Stack.Pop (Handler.Stack);
         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;

   --  ------------------------------
   --  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
                  Parser'Class (Handler).Finish_Object ("");
               end if;
               Parser'Class (Handler).Start_Object ("");
            end if;
            Handler.Row := Row;
            Parser'Class (Handler).Set_Member (Name, Util.Beans.Objects.To_Object (Value));
         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) 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;
      Context        : Element_Context_Access;
   begin
      Context_Stack.Push (Handler.Stack);
      Context := Context_Stack.Current (Handler.Stack);
      Context.Active_Nodes (1) := Handler.Mapping_Tree'Unchecked_Access;
      if Handler.Use_Default_Headers then
         Row := 1;
      end if;
      Handler.Headers.Clear;
      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);
         Context_Stack.Pop (Handler.Stack);
         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;

Implement Set_Field_Separator and Set_Quotes Update the CSV output stream to quote or not the strings and use the separator that was configured


-----------------------------------------------------------------------
--  facebook - Use Facebook Graph API
--  Copyright (C) 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.Log.Loggers;
with Util.Http.Clients;
with Util.Http.Rest;
with Util.Serialize.Mappers.Record_Mapper;
with Util.Serialize.Mappers.Vector_Mapper;

with ASF.Sessions;
with ASF.Contexts.Faces;
with ASF.Events.Faces.Actions;

package body Facebook is

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

   type Friend_Field_Type is (FIELD_NAME, FIELD_ID);
   type Feed_Field_Type is (FIELD_ID, FIELD_NAME, FIELD_FROM, FIELD_MESSAGE,
                            FIELD_PICTURE, FIELD_LINK, FIELD_DESCRIPTION, FIELD_ICON);

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

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

   procedure Set_Member (Into : in out Friend_Info;
                         Field : in Friend_Field_Type;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when FIELD_ID =>
            Into.Id := Value;

         when FIELD_NAME =>
            Into.Name := Value;

      end case;
   end Set_Member;

   procedure Set_Member (Into : in out Feed_Info;
                         Field : in Feed_Field_Type;
                         Value : in Util.Beans.Objects.Object) is
   begin
      Log.Info ("Set field {0} to {1}", Feed_Field_Type'Image (Field),
                Util.Beans.Objects.To_String (Value));

      case Field is
         when FIELD_ID =>
            Into.Id := Value;

         when FIELD_NAME =>
            Into.Name := Value;

         when FIELD_FROM =>
            Into.From := Value;

         when FIELD_MESSAGE =>
            Into.Message := Value;

         when FIELD_LINK =>
            Into.Link := Value;

         when FIELD_PICTURE =>
            Into.Picture := Value;

         when FIELD_ICON =>
            Into.Icon := Value;

         when FIELD_DESCRIPTION =>
            Into.Description := Value;

      end case;
   end Set_Member;

   package Friend_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Friend_Info,
                                               Element_Type_Access => Friend_Info_Access,
                                               Fields              => Friend_Field_Type,
                                               Set_Member          => Set_Member);

   package Friend_Vector_Mapper is
      new Util.Serialize.Mappers.Vector_Mapper (Vectors        => Friend_List.Vectors,
                                                Element_Mapper => Friend_Mapper);

   package Feed_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Feed_Info,
                                               Element_Type_Access => Feed_Info_Access,
                                               Fields              => Feed_Field_Type,
                                               Set_Member          => Set_Member);

   package Feed_Vector_Mapper is
     new Util.Serialize.Mappers.Vector_Mapper (Vectors        => Feed_List.Vectors,
                                               Element_Mapper => Feed_Mapper);

   Friend_Map        : aliased Friend_Mapper.Mapper;
   Friend_Vector_Map : aliased Friend_Vector_Mapper.Mapper;
   Feed_Map          : aliased Feed_Mapper.Mapper;
   Feed_Vector_Map   : aliased Feed_Vector_Mapper.Mapper;

   procedure Get_Friends is
     new Util.Http.Rest.Rest_Get_Vector (Vector_Mapper => Friend_Vector_Mapper);

   procedure Get_Feeds is
     new Util.Http.Rest.Rest_Get_Vector (Vector_Mapper => Feed_Vector_Mapper);

   --  ------------------------------
   --  Get the access token from the user session.
   --  ------------------------------
   function Get_Access_Token return String is
      use type ASF.Contexts.Faces.Faces_Context_Access;

      Context : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
   begin
      if Context = null then
         return "";
      end if;
      declare
         S : ASF.Sessions.Session := Context.Get_Session;
      begin
         if not S.Is_Valid then
            return "";
         end if;
         declare
            Token : Util.Beans.Objects.Object := S.Get_Attribute ("access_token");
         begin
            if Util.Beans.Objects.Is_Null (Token) then
               return "";
            else
               return Util.Beans.Objects.To_String (Token);
            end if;
         end;
      end;
   end Get_Access_Token;

   --  ------------------------------
   --  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 Friend_Info;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "name" then
         return From.Name;
      elsif Name = "id" then
         return From.Id;
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  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 Feed_Info;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "id" then
         return From.Id;
      elsif Name = "name" then
         return From.Name;
      elsif Name = "from" then
         return From.From;
      elsif Name = "message" then
         return From.Message;
      elsif Name = "picture" then
         return From.Picture;
      elsif Name = "link" then
         return From.Link;
      elsif Name = "description" then
         return From.Description;
      elsif Name = "icon" then
         return From.Icon;
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  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 Friend_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "hasAccessToken" then
         return Util.Beans.Objects.To_Object (False);
      end if;
      return Friend_List.List_Bean (From).Get_Value (Name);
   end Get_Value;

   --  ------------------------------
   --  Create a Friend_List bean instance.
   --  ------------------------------
   function Create_Friends_Bean return Util.Beans.Basic.Readonly_Bean_Access is
      List  : Friend_List_Bean_Access := new Friend_List_Bean;
      Token : constant String := Get_Access_Token;
   begin
      if Token'Length > 0 then
         declare
            C : Util.Http.Rest.Client;
         begin
            Log.Info ("Getting the Facebook friends");

            Get_Friends ("https://graph.facebook.com/me/friends?access_token="
                         & Token,
                         Friend_Vector_Map'Access,
                         "/data",
                         List.List'Access);
         end;
      end if;

      return List.all'Access;
   end Create_Friends_Bean;

   --  ------------------------------
   --  Build and return a Facebook feed list.
   --  ------------------------------
   function Create_Feed_List_Bean return Util.Beans.Basic.Readonly_Bean_Access is
      List  : Feed_List.List_Bean_Access := new Feed_List.List_Bean;
      Token : constant String := Get_Access_Token;
   begin
      if Token'Length > 0 then
         declare
            C : Util.Http.Rest.Client;
         begin
            Log.Info ("Getting the Facebook feeds");

            Get_Feeds ("https://graph.facebook.com/me/home?access_token="
                       & Token,
                       Feed_Vector_Map'Access,
                       "/data",
                       List.List'Access);
         end;
      end if;

      return List.all'Access;
   end Create_Feed_List_Bean;

   --  ------------------------------
   --  Get the user information identified by the given name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Facebook_Auth;
                       Name : in String) return Util.Beans.Objects.Object is
      use type ASF.Contexts.Faces.Faces_Context_Access;

      F    : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
   begin
      if F /= null and Name = "authenticate_url" then
         declare
            S      : ASF.Sessions.Session := F.Get_Session (True);
            Id     : constant String := S.Get_Id;
            State  : constant String := From.Get_State (Id);
            Params : constant String := From.Get_Auth_Params (State, "read_stream");
         begin
            Log.Info ("OAuth params: {0}", Params);

            return Util.Beans.Objects.To_Object ("https://www.facebook.com/dialog/oauth?"
                                                 & Params);
         end;
      elsif F /= null and Name = "isAuthenticated" then
         declare
            S      : ASF.Sessions.Session := F.Get_Session (False);
         begin
            if S.Is_Valid and
            then not Util.Beans.Objects.Is_Null (S.Get_Attribute ("access_token")) then
               return Util.Beans.Objects.To_Object (True);
            else
               return Util.Beans.Objects.To_Object (False);
            end if;
         end;
      end if;
      return Util.Beans.Objects.Null_Object;
   end Get_Value;

   --  ------------------------------
   --  Authenticate result from Facebook.
   --  ------------------------------
   procedure Authenticate (From    : in out Facebook_Auth;
                           Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      use type Security.OAuth.Clients.Access_Token_Access;

      F       : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Session : ASF.Sessions.Session := F.Get_Session;
      State   : constant String := F.Get_Parameter (Security.OAuth.State);
      Code    : constant String := F.Get_Parameter (Security.OAuth.Code);
   begin
      Log.Info ("Auth code {0} for state {1}", Code, State);
      if Session.Is_Valid then
         if From.Is_Valid_State (Session.Get_Id, State) then
            declare
               Acc : Security.OAuth.Clients.Access_Token_Access
                 := From.Request_Access_Token (Code);
            begin
               if Acc /= null then
                  Log.Info ("Access token is {0}", Acc.Get_Name);
                  Session.Set_Attribute ("access_token",
                                         Util.Beans.Objects.To_Object (Acc.Get_Name));
               end if;
            end;
         end if;
      end if;
   end Authenticate;

   package Authenticate_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Facebook_Auth,
                                                      Method => Authenticate,
                                                      Name   => "authenticate");

   Binding_Array : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (1 => Authenticate_Binding.Proxy'Unchecked_Access);

   --  ------------------------------
   --  This bean provides some methods that can be used in a Method_Expression
   --  ------------------------------
   overriding
   function Get_Method_Bindings (From : in Facebook_Auth)
                                 return Util.Beans.Methods.Method_Binding_Array_Access is
   begin
      return Binding_Array'Access;
   end Get_Method_Bindings;

begin
   Friend_Map.Add_Default_Mapping;
   Friend_Vector_Map.Set_Mapping (Friend_Map'Access);

   Feed_Map.Add_Mapping ("id", FIELD_ID);
   Feed_Map.Add_Mapping ("name", FIELD_NAME);
   Feed_Map.Add_Mapping ("message", FIELD_MESSAGE);
   Feed_Map.Add_Mapping ("description", FIELD_DESCRIPTION);
   Feed_Map.Add_Mapping ("from/name", FIELD_FROM);
   Feed_Map.Add_Mapping ("picture", FIELD_PICTURE);
   Feed_Map.Add_Mapping ("link", FIELD_LINK);
   Feed_Map.Add_Mapping ("icon", FIELD_ICON);
   Feed_Vector_Map.Set_Mapping (Feed_Map'Access);
end Facebook;

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

with ASF.Sessions;
with ASF.Contexts.Faces;
with ASF.Events.Faces.Actions;

package body Facebook is

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

   type Friend_Field_Type is (FIELD_NAME, FIELD_ID);
   type Feed_Field_Type is (FIELD_ID, FIELD_NAME, FIELD_FROM, FIELD_MESSAGE,
                            FIELD_PICTURE, FIELD_LINK, FIELD_DESCRIPTION, FIELD_ICON);

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

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

   procedure Set_Member (Into : in out Friend_Info;
                         Field : in Friend_Field_Type;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when FIELD_ID =>
            Into.Id := Value;

         when FIELD_NAME =>
            Into.Name := Value;

      end case;
   end Set_Member;

   procedure Set_Member (Into : in out Feed_Info;
                         Field : in Feed_Field_Type;
                         Value : in Util.Beans.Objects.Object) is
   begin
      Log.Info ("Set field {0} to {1}", Feed_Field_Type'Image (Field),
                Util.Beans.Objects.To_String (Value));

      case Field is
         when FIELD_ID =>
            Into.Id := Value;

         when FIELD_NAME =>
            Into.Name := Value;

         when FIELD_FROM =>
            Into.From := Value;

         when FIELD_MESSAGE =>
            Into.Message := Value;

         when FIELD_LINK =>
            Into.Link := Value;

         when FIELD_PICTURE =>
            Into.Picture := Value;

         when FIELD_ICON =>
            Into.Icon := Value;

         when FIELD_DESCRIPTION =>
            Into.Description := Value;

      end case;
   end Set_Member;

   package Friend_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Friend_Info,
                                               Element_Type_Access => Friend_Info_Access,
                                               Fields              => Friend_Field_Type,
                                               Set_Member          => Set_Member);

   package Friend_Vector_Mapper is
      new Util.Serialize.Mappers.Vector_Mapper (Vectors        => Friend_List.Vectors,
                                                Element_Mapper => Friend_Mapper);

   package Feed_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Feed_Info,
                                               Element_Type_Access => Feed_Info_Access,
                                               Fields              => Feed_Field_Type,
                                               Set_Member          => Set_Member);

   package Feed_Vector_Mapper is
     new Util.Serialize.Mappers.Vector_Mapper (Vectors        => Feed_List.Vectors,
                                               Element_Mapper => Feed_Mapper);

   Friend_Map        : aliased Friend_Mapper.Mapper;
   Friend_Vector_Map : aliased Friend_Vector_Mapper.Mapper;
   Feed_Map          : aliased Feed_Mapper.Mapper;
   Feed_Vector_Map   : aliased Feed_Vector_Mapper.Mapper;

   procedure Get_Friends is
     new Util.Http.Rest.Rest_Get_Vector (Vector_Mapper => Friend_Vector_Mapper);

   procedure Get_Feeds is
     new Util.Http.Rest.Rest_Get_Vector (Vector_Mapper => Feed_Vector_Mapper);

   --  ------------------------------
   --  Get the access token from the user session.
   --  ------------------------------
   function Get_Access_Token return String is
      use type ASF.Contexts.Faces.Faces_Context_Access;

      Context : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
   begin
      if Context = null then
         return "";
      end if;
      declare
         S : constant ASF.Sessions.Session := Context.Get_Session;
      begin
         if not S.Is_Valid then
            return "";
         end if;
         declare
            Token : constant Util.Beans.Objects.Object := S.Get_Attribute ("access_token");
         begin
            if Util.Beans.Objects.Is_Null (Token) then
               return "";
            else
               return Util.Beans.Objects.To_String (Token);
            end if;
         end;
      end;
   end Get_Access_Token;

   --  ------------------------------
   --  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 Friend_Info;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "name" then
         return From.Name;
      elsif Name = "id" then
         return From.Id;
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  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 Feed_Info;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "id" then
         return From.Id;
      elsif Name = "name" then
         return From.Name;
      elsif Name = "from" then
         return From.From;
      elsif Name = "message" then
         return From.Message;
      elsif Name = "picture" then
         return From.Picture;
      elsif Name = "link" then
         return From.Link;
      elsif Name = "description" then
         return From.Description;
      elsif Name = "icon" then
         return From.Icon;
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  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 Friend_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "hasAccessToken" then
         return Util.Beans.Objects.To_Object (False);
      end if;
      return Friend_List.List_Bean (From).Get_Value (Name);
   end Get_Value;

   --  ------------------------------
   --  Create a Friend_List bean instance.
   --  ------------------------------
   function Create_Friends_Bean return Util.Beans.Basic.Readonly_Bean_Access is
      List  : Friend_List_Bean_Access := new Friend_List_Bean;
      Token : constant String := Get_Access_Token;
   begin
      if Token'Length > 0 then
         Log.Info ("Getting the Facebook friends");

         Get_Friends ("https://graph.facebook.com/me/friends?access_token="
                      & Token,
                      Friend_Vector_Map'Access,
                      "/data",
                      List.List'Access);
      end if;

      return List.all'Access;
   end Create_Friends_Bean;

   --  ------------------------------
   --  Build and return a Facebook feed list.
   --  ------------------------------
   function Create_Feed_List_Bean return Util.Beans.Basic.Readonly_Bean_Access is
      List  : Feed_List.List_Bean_Access := new Feed_List.List_Bean;
      Token : constant String := Get_Access_Token;
   begin
      if Token'Length > 0 then
         Log.Info ("Getting the Facebook feeds");

         Get_Feeds ("https://graph.facebook.com/me/home?access_token="
                    & Token,
                    Feed_Vector_Map'Access,
                    "/data",
                    List.List'Access);
      end if;

      return List.all'Access;
   end Create_Feed_List_Bean;

   --  ------------------------------
   --  Get the user information identified by the given name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Facebook_Auth;
                       Name : in String) return Util.Beans.Objects.Object is
      use type ASF.Contexts.Faces.Faces_Context_Access;

      F    : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
   begin
      if F /= null and Name = "authenticate_url" then
         declare
            S      : constant ASF.Sessions.Session := F.Get_Session (True);
            Id     : constant String := S.Get_Id;
            State  : constant String := From.Get_State (Id);
            Params : constant String := From.Get_Auth_Params (State, "read_stream");
         begin
            Log.Info ("OAuth params: {0}", Params);

            return Util.Beans.Objects.To_Object ("https://www.facebook.com/dialog/oauth?"
                                                 & Params);
         end;
      elsif F /= null and Name = "isAuthenticated" then
         declare
            S      : constant ASF.Sessions.Session := F.Get_Session (False);
         begin
            if S.Is_Valid and
            then not Util.Beans.Objects.Is_Null (S.Get_Attribute ("access_token")) then
               return Util.Beans.Objects.To_Object (True);
            else
               return Util.Beans.Objects.To_Object (False);
            end if;
         end;
      end if;
      return Util.Beans.Objects.Null_Object;
   end Get_Value;

   --  ------------------------------
   --  Authenticate result from Facebook.
   --  ------------------------------
   procedure Authenticate (From    : in out Facebook_Auth;
                           Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);

      use type Security.OAuth.Clients.Access_Token_Access;

      F       : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Session : ASF.Sessions.Session := F.Get_Session;
      State   : constant String := F.Get_Parameter (Security.OAuth.State);
      Code    : constant String := F.Get_Parameter (Security.OAuth.Code);
   begin
      Log.Info ("Auth code {0} for state {1}", Code, State);
      if Session.Is_Valid then
         if From.Is_Valid_State (Session.Get_Id, State) then
            declare
               Acc : constant Security.OAuth.Clients.Access_Token_Access
                 := From.Request_Access_Token (Code);
            begin
               if Acc /= null then
                  Log.Info ("Access token is {0}", Acc.Get_Name);
                  Session.Set_Attribute ("access_token",
                                         Util.Beans.Objects.To_Object (Acc.Get_Name));
               end if;
            end;
         end if;
      end if;
   end Authenticate;

   package Authenticate_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Facebook_Auth,
                                                      Method => Authenticate,
                                                      Name   => "authenticate");

   Binding_Array : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (1 => Authenticate_Binding.Proxy'Unchecked_Access);

   --  ------------------------------
   --  This bean provides some methods that can be used in a Method_Expression
   --  ------------------------------
   overriding
   function Get_Method_Bindings (From : in Facebook_Auth)
                                 return Util.Beans.Methods.Method_Binding_Array_Access is
      pragma Unreferenced (From);
   begin
      return Binding_Array'Access;
   end Get_Method_Bindings;

begin
   Friend_Map.Add_Default_Mapping;
   Friend_Vector_Map.Set_Mapping (Friend_Map'Access);

   Feed_Map.Add_Mapping ("id", FIELD_ID);
   Feed_Map.Add_Mapping ("name", FIELD_NAME);
   Feed_Map.Add_Mapping ("message", FIELD_MESSAGE);
   Feed_Map.Add_Mapping ("description", FIELD_DESCRIPTION);
   Feed_Map.Add_Mapping ("from/name", FIELD_FROM);
   Feed_Map.Add_Mapping ("picture", FIELD_PICTURE);
   Feed_Map.Add_Mapping ("link", FIELD_LINK);
   Feed_Map.Add_Mapping ("icon", FIELD_ICON);
   Feed_Vector_Map.Set_Mapping (Feed_Map'Access);
end Facebook;

Fix compilation warning

Fix compilation warning


-----------------------------------------------------------------------
--  util-dates-formats -- Date Format ala strftime
--  Copyright (C) 2011, 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.Strings.Unbounded;
with Util.Properties;

--  == Localized date formatting ==
--  The `Util.Dates.Formats` provides a date formatting operation similar to the
--  Unix `strftime` or the `GNAT.Calendar.Time_IO`.  The localization of month
--  and day labels is however handled through `Util.Properties.Bundle` (similar to
--  the Java world).  Unlike `strftime`, this allows to have a multi-threaded application
--  that reports dates in several languages.  The `GNAT.Calendar.Time_IO` only supports
--  English and this is the reason why it is not used here.
--
--  The date pattern recognizes the following formats:
--
--  | Format | Description |
--  | --- | ---------- |
--  | %a  | The abbreviated weekday name according to the current locale.
--  | %A  | The full weekday name according to the current locale.
--  | %b  | The abbreviated month name according to the current locale.
--  | %h  | Equivalent to %b. (SU)
--  | %B  | The full month name according to the current locale.
--  | %c  | The preferred date and time representation for the current locale.
--  | %C  | The century number (year/100) as a 2-digit integer. (SU)
--  | %d  | The day of the month as a decimal number (range 01 to 31).
--  | %D  | Equivalent to %m/%d/%y
--  | %e  | Like %d, the day of the month as a decimal number,
--  |     | but a leading zero is replaced by a space. (SU)
--  | %F  | Equivalent to %Y\-%m\-%d (the ISO 8601 date format). (C99)
--  | %G  | The ISO 8601 week-based year
--  | %H  | The hour as a decimal number using a 24-hour clock (range 00 to 23).
--  | %I  | The hour as a decimal number using a 12-hour clock (range 01 to 12).
--  | %j  | The day of the year as a decimal number (range 001 to 366).
--  | %k  | The hour (24 hour clock) as a decimal number (range 0 to 23);
--  | %l  | The hour (12 hour clock) as a decimal number (range 1 to 12);
--  | %m  | The month as a decimal number (range 01 to 12).
--  | %M  | The minute as a decimal number (range 00 to 59).
--  | %n  | A newline character. (SU)
--  | %p  | Either "AM" or "PM"
--  | %P  | Like %p but in lowercase: "am" or "pm"
--  | %r  | The time in a.m. or p.m. notation.
--  |     | In the POSIX locale this is equivalent to %I:%M:%S %p. (SU)
--  | %R  | The time in 24 hour notation (%H:%M).
--  | %s  | The number of seconds since the Epoch, that is,
--  |     | since 1970\-01\-01 00:00:00 UTC. (TZ)
--  | %S  | The second as a decimal number (range 00 to 60).
--  | %t  | A tab character. (SU)
--  | %T  | The time in 24 hour notation (%H:%M:%S). (SU)
--  | %u  | The day of the week as a decimal, range 1 to 7,
--  |     | Monday being 1. See also %w. (SU)
--  | %U  | The week number of the current year as a decimal
--  |     | number, range 00 to 53
--  | %V  | The ISO 8601 week number
--  | %w  | The day of the week as a decimal, range 0 to 6,
--  |     | Sunday being 0. See also %u.
--  | %W  | The week number of the current year as a decimal number,
--  |     | range 00 to 53
--  | %x  | The preferred date representation for the current locale
--  |     | without the time.
--  | %X  | The preferred time representation for the current locale
--  |     | without the date.
--  | %y  | The year as a decimal number without a century (range 00 to 99).
--  | %Y  | The year as a decimal number including the century.
--  | %z  | The timezone as hour offset from GMT.
--  | %Z  | The timezone or name or abbreviation.
--
--  The following strftime flags are ignored:
--
--  | Format | Description |
--  | --- | ---------- |
--  | %E  |  Modifier: use alternative format, see below. (SU)
--  | %O  |  Modifier: use alternative format, see below. (SU)
--
--  SU:  Single Unix Specification
--  C99: C99 standard, POSIX.1-2001
--
--  See strftime (3) manual page
--
--  To format and use the localize date, it is first necessary to get a bundle
--  for the `dates` so that date elements are translated into the given locale.
--
--     Factory     : Util.Properties.Bundles.Loader;
--     Bundle      : Util.Properties.Bundles.Manager;
--     ...
--        Load_Bundle (Factory, "dates", "fr", Bundle);
--
--  The date is formatted according to the pattern string described above.
--  The bundle is used by the formatter to use the day and month names in the
--  expected locale.
--
--     Date : String := Util.Dates.Formats.Format (Pattern => Pattern,
--                                                 Date    => Ada.Calendar.Clock,
--                                                 Bundle  => Bundle);
package Util.Dates.Formats is

   --  Month labels.
   MONTH_NAME_PREFIX         : constant String := "util.month";

   --  Day labels.
   DAY_NAME_PREFIX           : constant String := "util.day";

   --  Short month/day suffix.
   SHORT_SUFFIX              : constant String := ".short";

   --  Long month/day suffix.
   LONG_SUFFIX               : constant String := ".long";

   --  The date time pattern name to be used for the %x representation.
   --  This property name is searched in the bundle to find the localized date time pattern.
   DATE_TIME_LOCALE_NAME     : constant String := "util.datetime.pattern";

   --  The default date pattern for %c (English).
   DATE_TIME_DEFAULT_PATTERN : constant String := "%a %b %_d %T %Y";

   --  The date pattern to be used for the %x representation.
   --  This property name is searched in the bundle to find the localized date pattern.
   DATE_LOCALE_NAME          : constant String := "util.date.pattern";

   --  The default date pattern for %x (English).
   DATE_DEFAULT_PATTERN      : constant String := "%m/%d/%y";

   --  The time pattern to be used for the %X representation.
   --  This property name is searched in the bundle to find the localized time pattern.
   TIME_LOCALE_NAME          : constant String := "util.time.pattern";

   --  The default time pattern for %X (English).
   TIME_DEFAULT_PATTERN      : constant String := "%T %Y";

   AM_NAME                   : constant String := "util.date.am";
   PM_NAME                   : constant String := "util.date.pm";

   AM_DEFAULT                : constant String := "AM";
   PM_DEFAULT                : constant String := "PM";

   --  Format the date passed in Date using the date pattern specified in Pattern.
   --  The date pattern is similar to the Unix strftime operation.
   --
   --  For month and day of week strings, use the resource bundle passed in Bundle.
   --  Append the formatted date in the Into string.
   procedure Format (Into      : in out Ada.Strings.Unbounded.Unbounded_String;
                     Pattern   : in String;
                     Date      : in Date_Record;
                     Bundle    : in Util.Properties.Manager'Class);

   --  Format the date passed in Date using the date pattern specified in Pattern.
   --  For month and day of week strings, use the resource bundle passed in Bundle.
   --  Append the formatted date in the Into string.
   procedure Format (Into      : in out Ada.Strings.Unbounded.Unbounded_String;
                     Pattern   : in String;
                     Date      : in Ada.Calendar.Time;
                     Bundle    : in Util.Properties.Manager'Class);

   function Format (Pattern   : in String;
                    Date      : in Ada.Calendar.Time;
                    Bundle    : in Util.Properties.Manager'Class) return String;

   --  Append the localized month string in the Into string.
   --  The month string is found in the resource bundle under the name:
   --    util.month<month number>.short
   --    util.month<month number>.long
   --  If the month string is not found, the month is displayed as a number.
   procedure Append_Month (Into   : in out Ada.Strings.Unbounded.Unbounded_String;
                           Month  : in Ada.Calendar.Month_Number;
                           Bundle : in Util.Properties.Manager'Class;
                           Short  : in Boolean := True);

   --  Append the localized month string in the Into string.
   --  The month string is found in the resource bundle under the name:
   --    util.month<month number>.short
   --    util.month<month number>.long
   --  If the month string is not found, the month is displayed as a number.
   procedure Append_Day (Into   : in out Ada.Strings.Unbounded.Unbounded_String;
                         Day    : in Ada.Calendar.Formatting.Day_Name;
                         Bundle : in Util.Properties.Manager'Class;
                         Short  : in Boolean := True);

   --  Append a number with padding if necessary
   procedure Append_Number (Into    : in out Ada.Strings.Unbounded.Unbounded_String;
                            Value   : in Natural;
                            Padding : in Character;
                            Length  : in Natural := 2);

   --  Append the timezone offset
   procedure Append_Time_Offset (Into      : in out Ada.Strings.Unbounded.Unbounded_String;
                                 Offset    : in Ada.Calendar.Time_Zones.Time_Offset);

end Util.Dates.Formats;

-----------------------------------------------------------------------
--  util-dates-formats -- Date Format ala strftime
--  Copyright (C) 2011, 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.Strings.Unbounded;
with Util.Properties;

--  == Localized date formatting ==
--  The `Util.Dates.Formats` provides a date formatting and parsing operation similar to the
--  Unix `strftime`, `strptime` or the `GNAT.Calendar.Time_IO`.  The localization of month
--  and day labels is however handled through `Util.Properties.Bundle` (similar to
--  the Java world).  Unlike `strftime` and `strptime`, this allows to have a multi-threaded
--  application that reports dates in several languages.  The `GNAT.Calendar.Time_IO` only
--  supports English and this is the reason why it is not used here.
--
--  The date pattern recognizes the following formats:
--
--  | Format | Description |
--  | --- | ---------- |
--  | %a  | The abbreviated weekday name according to the current locale.
--  | %A  | The full weekday name according to the current locale.
--  | %b  | The abbreviated month name according to the current locale.
--  | %h  | Equivalent to %b. (SU)
--  | %B  | The full month name according to the current locale.
--  | %c  | The preferred date and time representation for the current locale.
--  | %C  | The century number (year/100) as a 2-digit integer. (SU)
--  | %d  | The day of the month as a decimal number (range 01 to 31).
--  | %D  | Equivalent to %m/%d/%y
--  | %e  | Like %d, the day of the month as a decimal number,
--  |     | but a leading zero is replaced by a space. (SU)
--  | %F  | Equivalent to %Y\-%m\-%d (the ISO 8601 date format). (C99)
--  | %G  | The ISO 8601 week-based year
--  | %H  | The hour as a decimal number using a 24-hour clock (range 00 to 23).
--  | %I  | The hour as a decimal number using a 12-hour clock (range 01 to 12).
--  | %j  | The day of the year as a decimal number (range 001 to 366).
--  | %k  | The hour (24 hour clock) as a decimal number (range 0 to 23);
--  | %l  | The hour (12 hour clock) as a decimal number (range 1 to 12);
--  | %m  | The month as a decimal number (range 01 to 12).
--  | %M  | The minute as a decimal number (range 00 to 59).
--  | %n  | A newline character. (SU)
--  | %p  | Either "AM" or "PM"
--  | %P  | Like %p but in lowercase: "am" or "pm"
--  | %r  | The time in a.m. or p.m. notation.
--  |     | In the POSIX locale this is equivalent to %I:%M:%S %p. (SU)
--  | %R  | The time in 24 hour notation (%H:%M).
--  | %s  | The number of seconds since the Epoch, that is,
--  |     | since 1970\-01\-01 00:00:00 UTC. (TZ)
--  | %S  | The second as a decimal number (range 00 to 60).
--  | %t  | A tab character. (SU)
--  | %T  | The time in 24 hour notation (%H:%M:%S). (SU)
--  | %u  | The day of the week as a decimal, range 1 to 7,
--  |     | Monday being 1. See also %w. (SU)
--  | %U  | The week number of the current year as a decimal
--  |     | number, range 00 to 53
--  | %V  | The ISO 8601 week number
--  | %w  | The day of the week as a decimal, range 0 to 6,
--  |     | Sunday being 0. See also %u.
--  | %W  | The week number of the current year as a decimal number,
--  |     | range 00 to 53
--  | %x  | The preferred date representation for the current locale
--  |     | without the time.
--  | %X  | The preferred time representation for the current locale
--  |     | without the date.
--  | %y  | The year as a decimal number without a century (range 00 to 99).
--  | %Y  | The year as a decimal number including the century.
--  | %z  | The timezone as hour offset from GMT.
--  | %Z  | The timezone or name or abbreviation.
--
--  The following strftime flags are ignored:
--
--  | Format | Description |
--  | --- | ---------- |
--  | %E  |  Modifier: use alternative format, see below. (SU)
--  | %O  |  Modifier: use alternative format, see below. (SU)
--
--  SU:  Single Unix Specification
--  C99: C99 standard, POSIX.1-2001
--
--  See strftime (3) and strptime (3) manual page
--
--  To format and use the localize date, it is first necessary to get a bundle
--  for the `dates` so that date elements are translated into the given locale.
--
--     Factory     : Util.Properties.Bundles.Loader;
--     Bundle      : Util.Properties.Bundles.Manager;
--     ...
--        Load_Bundle (Factory, "dates", "fr", Bundle);
--
--  The date is formatted according to the pattern string described above.
--  The bundle is used by the formatter to use the day and month names in the
--  expected locale.
--
--     Date : String := Util.Dates.Formats.Format (Pattern => Pattern,
--                                                 Date    => Ada.Calendar.Clock,
--                                                 Bundle  => Bundle);
--
--  To parse a date according to a pattern and a localization, the same pattern string
--  and bundle can be used and the `Parse` function will return the date in split format.
--
--     Result : Date_Record := Util.Dates.Formats.Parse (Date    => Date,
--                                                       Pattern => Pattern,
--                                                       Bundle  => Bundle);
--
package Util.Dates.Formats is

   --  Month labels.
   MONTH_NAME_PREFIX         : constant String := "util.month";

   --  Day labels.
   DAY_NAME_PREFIX           : constant String := "util.day";

   --  Short month/day suffix.
   SHORT_SUFFIX              : constant String := ".short";

   --  Long month/day suffix.
   LONG_SUFFIX               : constant String := ".long";

   --  The date time pattern name to be used for the %x representation.
   --  This property name is searched in the bundle to find the localized date time pattern.
   DATE_TIME_LOCALE_NAME     : constant String := "util.datetime.pattern";

   --  The default date pattern for %c (English).
   DATE_TIME_DEFAULT_PATTERN : constant String := "%a %b %_d %T %Y";

   --  The date pattern to be used for the %x representation.
   --  This property name is searched in the bundle to find the localized date pattern.
   DATE_LOCALE_NAME          : constant String := "util.date.pattern";

   --  The default date pattern for %x (English).
   DATE_DEFAULT_PATTERN      : constant String := "%m/%d/%y";

   --  The time pattern to be used for the %X representation.
   --  This property name is searched in the bundle to find the localized time pattern.
   TIME_LOCALE_NAME          : constant String := "util.time.pattern";

   --  The default time pattern for %X (English).
   TIME_DEFAULT_PATTERN      : constant String := "%T %Y";

   AM_NAME                   : constant String := "util.date.am";
   PM_NAME                   : constant String := "util.date.pm";

   AM_DEFAULT                : constant String := "AM";
   PM_DEFAULT                : constant String := "PM";

   --  Format the date passed in Date using the date pattern specified in Pattern.
   --  The date pattern is similar to the Unix strftime operation.
   --
   --  For month and day of week strings, use the resource bundle passed in Bundle.
   --  Append the formatted date in the Into string.
   procedure Format (Into      : in out Ada.Strings.Unbounded.Unbounded_String;
                     Pattern   : in String;
                     Date      : in Date_Record;
                     Bundle    : in Util.Properties.Manager'Class);

   --  Format the date passed in Date using the date pattern specified in Pattern.
   --  For month and day of week strings, use the resource bundle passed in Bundle.
   --  Append the formatted date in the Into string.
   procedure Format (Into      : in out Ada.Strings.Unbounded.Unbounded_String;
                     Pattern   : in String;
                     Date      : in Ada.Calendar.Time;
                     Bundle    : in Util.Properties.Manager'Class);

   function Format (Pattern   : in String;
                    Date      : in Ada.Calendar.Time;
                    Bundle    : in Util.Properties.Manager'Class) return String;

   --  Append the localized month string in the Into string.
   --  The month string is found in the resource bundle under the name:
   --    util.month<month number>.short
   --    util.month<month number>.long
   --  If the month string is not found, the month is displayed as a number.
   procedure Append_Month (Into   : in out Ada.Strings.Unbounded.Unbounded_String;
                           Month  : in Ada.Calendar.Month_Number;
                           Bundle : in Util.Properties.Manager'Class;
                           Short  : in Boolean := True);

   --  Append the localized month string in the Into string.
   --  The month string is found in the resource bundle under the name:
   --    util.month<month number>.short
   --    util.month<month number>.long
   --  If the month string is not found, the month is displayed as a number.
   procedure Append_Day (Into   : in out Ada.Strings.Unbounded.Unbounded_String;
                         Day    : in Ada.Calendar.Formatting.Day_Name;
                         Bundle : in Util.Properties.Manager'Class;
                         Short  : in Boolean := True);

   --  Append a number with padding if necessary
   procedure Append_Number (Into    : in out Ada.Strings.Unbounded.Unbounded_String;
                            Value   : in Natural;
                            Padding : in Character;
                            Length  : in Natural := 2);

   --  Append the timezone offset
   procedure Append_Time_Offset (Into      : in out Ada.Strings.Unbounded.Unbounded_String;
                                 Offset    : in Ada.Calendar.Time_Zones.Time_Offset);

   --  Parse the date according to the pattern and the given locale bundle and
   --  return the data split record.
   --  A `Constraint_Error` exception is raised if the date string is not in the correct format.
   function Parse (Date      : in String;
                   Pattern   : in String;
                   Bundle    : in Util.Properties.Manager'Class) return Date_Record;

end Util.Dates.Formats;

Declare the Parse function to parse a date using a pattern and a locale


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

with AWA.Users.Services.Tests;
with AWA.Users.Tests;
with AWA.Blogs.Modules.Tests;
with AWA.Wikis.Parsers.Tests;
with AWA.Wikis.Writers.Tests;
with AWA.Helpers.Selectors.Tests;
with AWA.Storages.Services.Tests;
with AWA.Events.Services.Tests;
with AWA.Mail.Clients.Tests;
with AWA.Mail.Modules.Tests;
with AWA.Images.Services.Tests;
with AWA.Votes.Modules.Tests;
with AWA.Tags.Modules.Tests;
with AWA.Questions.Modules.Tests;
with AWA.Counters.Modules.Tests;
with AWA.Modules.Tests;

with ASF.Converters.Dates;

with AWA.Users.Modules;
with AWA.Mail.Modules;
with AWA.Blogs.Modules;
with AWA.Workspaces.Modules;
with AWA.Storages.Modules;
with AWA.Images.Modules;
with AWA.Questions.Modules;
with AWA.Votes.Modules;
with AWA.Tags.Modules;
with AWA.Changelogs.Modules;
with AWA.Counters.Modules;

with AWA.Converters.Dates;
with AWA.Tests;
with AWA.Services.Contexts;
with AWA.Jobs.Services.Tests;
with AWA.Jobs.Modules.Tests;
with AWA.Settings.Modules.Tests;
with AWA.Comments.Modules.Tests;
with AWA.Changelogs.Modules.Tests;
with AWA.Wikis.Modules.Tests;

with ASF.Server.Web;
with ASF.Server.Tests;
package body AWA.Testsuite is
   Users          : aliased AWA.Users.Modules.User_Module;

   Workspaces     : aliased AWA.Workspaces.Modules.Workspace_Module;

   Mail           : aliased AWA.Mail.Modules.Mail_Module;

   Jobs           : aliased AWA.Jobs.Modules.Job_Module;

   Comments       : aliased AWA.Comments.Modules.Comment_Module;

   Blogs          : aliased AWA.Blogs.Modules.Blog_Module;

   Storages       : aliased AWA.Storages.Modules.Storage_Module;

   Images         : aliased AWA.Images.Modules.Image_Module;

   Questions      : aliased AWA.Questions.Modules.Question_Module;

   Votes          : aliased AWA.Votes.Modules.Vote_Module;

   Tags           : aliased AWA.Tags.Modules.Tag_Module;

   Settings       : aliased AWA.Settings.Modules.Setting_Module;

   Changelogs     : aliased AWA.Changelogs.Modules.Changelog_Module;

   Wikis          : aliased AWA.Wikis.Modules.Wiki_Module;

   Counters       : aliased AWA.Counters.Modules.Counter_Module;

   Date_Converter : aliased ASF.Converters.Dates.Date_Converter;

   Rel_Date_Converter : aliased AWA.Converters.Dates.Relative_Date_Converter;

   Tests : aliased Util.Tests.Test_Suite;

   function Suite return Util.Tests.Access_Test_Suite is
      Ret : constant Util.Tests.Access_Test_Suite := Tests'Access;
   begin
      AWA.Modules.Tests.Add_Tests (Ret);
      AWA.Events.Services.Tests.Add_Tests (Ret);
      AWA.Mail.Clients.Tests.Add_Tests (Ret);
      AWA.Mail.Modules.Tests.Add_Tests (Ret);
      AWA.Users.Services.Tests.Add_Tests (Ret);
      AWA.Users.Tests.Add_Tests (Ret);
      AWA.Counters.Modules.Tests.Add_Tests (Ret);
      AWA.Wikis.Parsers.Tests.Add_Tests (Ret);
      AWA.Wikis.Writers.Tests.Add_Tests (Ret);
      AWA.Helpers.Selectors.Tests.Add_Tests (Ret);
      AWA.Jobs.Modules.Tests.Add_Tests (Ret);
      AWA.Jobs.Services.Tests.Add_Tests (Ret);
      AWA.Settings.Modules.Tests.Add_Tests (Ret);
      AWA.Comments.Modules.Tests.Add_Tests (Ret);
      AWA.Blogs.Modules.Tests.Add_Tests (Ret);
      AWA.Storages.Services.Tests.Add_Tests (Ret);
      AWA.Images.Services.Tests.Add_Tests (Ret);
      AWA.Changelogs.Modules.Tests.Add_Tests (Ret);
      AWA.Votes.Modules.Tests.Add_Tests (Ret);
      AWA.Tags.Modules.Tests.Add_Tests (Ret);
      AWA.Questions.Modules.Tests.Add_Tests (Ret);
      AWA.Wikis.Modules.Tests.Add_Tests (Ret);
      return Ret;
   end Suite;

   procedure Initialize (Props : in Util.Properties.Manager) is
   begin
      Initialize (null, Props, True);
   end Initialize;

   --  ------------------------------
   --  Initialize the AWA test framework mockup.
   --  ------------------------------
   procedure Initialize (App         : in AWA.Applications.Application_Access;
                         Props       : in Util.Properties.Manager;
                         Add_Modules : in Boolean) is
      use AWA.Applications;
   begin
      AWA.Tests.Initialize (App, Props, Add_Modules);

      if Add_Modules then
         declare
            Application : constant Applications.Application_Access := AWA.Tests.Get_Application;
            Ctx         : AWA.Services.Contexts.Service_Context;
            Users  : constant AWA.Users.Modules.User_Module_Access := AWA.Testsuite.Users'Access;
         begin
            Ctx.Set_Context (Application, null);
            Register (App    => Application.all'Access,
                      Name   => AWA.Users.Modules.NAME,
                      URI    => "user",
                      Module => Users.all'Access);

            Register (App    => Application.all'Access,
                      Name   => "mail",
                      URI    => "mail",
                      Module => Mail'Access);

            Register (App    => Application.all'Access,
                      Name   => "workspaces",
                      URI    => "workspaces",
                      Module => Workspaces'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Counters.Modules.NAME,
                      URI    => "counters",
                      Module => Counters'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Comments.Modules.NAME,
                      URI    => "comments",
                      Module => Comments'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Storages.Modules.NAME,
                      URI    => "storages",
                      Module => Storages'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Images.Modules.NAME,
                      URI    => "images",
                      Module => Images'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Jobs.Modules.NAME,
                      URI    => "jobs",
                      Module => Jobs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Settings.Modules.NAME,
                      URI    => "settings",
                      Module => Settings'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Votes.Modules.NAME,
                      URI    => "votes",
                      Module => Votes'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Changelogs.Modules.NAME,
                      URI    => "changelogs",
                      Module => Changelogs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Tags.Modules.NAME,
                      URI    => "tags",
                      Module => Tags'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Blogs.Modules.NAME,
                      URI    => "blogs",
                      Module => Blogs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Questions.Modules.NAME,
                      URI    => "questions",
                      Module => Questions'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Wikis.Modules.NAME,
                      URI    => "wikis",
                      Module => Wikis'Access);

            Application.Start;
            if Props.Exists ("test.server") then
               declare
                  WS : ASF.Server.Web.AWS_Container;
               begin
                  Application.Add_Converter (Name      => "dateConverter",
                                             Converter => Date_Converter'Access);
                  Application.Add_Converter (Name      => "smartDateConverter",
                                             Converter => Rel_Date_Converter'Access);

                  WS.Register_Application ("/asfunit", Application.all'Access);

                  WS.Start;
                  delay 6000.0;
               end;
            end if;
            ASF.Server.Tests.Set_Context (Application.all'Access);
         end;
      end if;
   end Initialize;

end AWA.Testsuite;

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

with AWA.Users.Services.Tests;
with AWA.Users.Tests;
with AWA.Blogs.Modules.Tests;
with AWA.Helpers.Selectors.Tests;
with AWA.Storages.Services.Tests;
with AWA.Events.Services.Tests;
with AWA.Mail.Clients.Tests;
with AWA.Mail.Modules.Tests;
with AWA.Images.Services.Tests;
with AWA.Votes.Modules.Tests;
with AWA.Tags.Modules.Tests;
with AWA.Questions.Modules.Tests;
with AWA.Counters.Modules.Tests;
with AWA.Modules.Tests;

with ASF.Converters.Dates;

with AWA.Users.Modules;
with AWA.Mail.Modules;
with AWA.Blogs.Modules;
with AWA.Workspaces.Modules;
with AWA.Storages.Modules;
with AWA.Images.Modules;
with AWA.Questions.Modules;
with AWA.Votes.Modules;
with AWA.Tags.Modules;
with AWA.Changelogs.Modules;
with AWA.Counters.Modules;

with AWA.Converters.Dates;
with AWA.Tests;
with AWA.Services.Contexts;
with AWA.Jobs.Services.Tests;
with AWA.Jobs.Modules.Tests;
with AWA.Settings.Modules.Tests;
with AWA.Comments.Modules.Tests;
with AWA.Changelogs.Modules.Tests;
with AWA.Wikis.Modules.Tests;

with ASF.Server.Web;
with ASF.Server.Tests;
package body AWA.Testsuite is
   Users          : aliased AWA.Users.Modules.User_Module;

   Workspaces     : aliased AWA.Workspaces.Modules.Workspace_Module;

   Mail           : aliased AWA.Mail.Modules.Mail_Module;

   Jobs           : aliased AWA.Jobs.Modules.Job_Module;

   Comments       : aliased AWA.Comments.Modules.Comment_Module;

   Blogs          : aliased AWA.Blogs.Modules.Blog_Module;

   Storages       : aliased AWA.Storages.Modules.Storage_Module;

   Images         : aliased AWA.Images.Modules.Image_Module;

   Questions      : aliased AWA.Questions.Modules.Question_Module;

   Votes          : aliased AWA.Votes.Modules.Vote_Module;

   Tags           : aliased AWA.Tags.Modules.Tag_Module;

   Settings       : aliased AWA.Settings.Modules.Setting_Module;

   Changelogs     : aliased AWA.Changelogs.Modules.Changelog_Module;

   Wikis          : aliased AWA.Wikis.Modules.Wiki_Module;

   Counters       : aliased AWA.Counters.Modules.Counter_Module;

   Date_Converter : aliased ASF.Converters.Dates.Date_Converter;

   Rel_Date_Converter : aliased AWA.Converters.Dates.Relative_Date_Converter;

   Tests : aliased Util.Tests.Test_Suite;

   function Suite return Util.Tests.Access_Test_Suite is
      Ret : constant Util.Tests.Access_Test_Suite := Tests'Access;
   begin
      AWA.Modules.Tests.Add_Tests (Ret);
      AWA.Events.Services.Tests.Add_Tests (Ret);
      AWA.Mail.Clients.Tests.Add_Tests (Ret);
      AWA.Mail.Modules.Tests.Add_Tests (Ret);
      AWA.Users.Services.Tests.Add_Tests (Ret);
      AWA.Users.Tests.Add_Tests (Ret);
      AWA.Counters.Modules.Tests.Add_Tests (Ret);
      AWA.Helpers.Selectors.Tests.Add_Tests (Ret);
      AWA.Jobs.Modules.Tests.Add_Tests (Ret);
      AWA.Jobs.Services.Tests.Add_Tests (Ret);
      AWA.Settings.Modules.Tests.Add_Tests (Ret);
      AWA.Comments.Modules.Tests.Add_Tests (Ret);
      AWA.Blogs.Modules.Tests.Add_Tests (Ret);
      AWA.Storages.Services.Tests.Add_Tests (Ret);
      AWA.Images.Services.Tests.Add_Tests (Ret);
      AWA.Changelogs.Modules.Tests.Add_Tests (Ret);
      AWA.Votes.Modules.Tests.Add_Tests (Ret);
      AWA.Tags.Modules.Tests.Add_Tests (Ret);
      AWA.Questions.Modules.Tests.Add_Tests (Ret);
      AWA.Wikis.Modules.Tests.Add_Tests (Ret);
      return Ret;
   end Suite;

   procedure Initialize (Props : in Util.Properties.Manager) is
   begin
      Initialize (null, Props, True);
   end Initialize;

   --  ------------------------------
   --  Initialize the AWA test framework mockup.
   --  ------------------------------
   procedure Initialize (App         : in AWA.Applications.Application_Access;
                         Props       : in Util.Properties.Manager;
                         Add_Modules : in Boolean) is
      use AWA.Applications;
   begin
      AWA.Tests.Initialize (App, Props, Add_Modules);

      if Add_Modules then
         declare
            Application : constant Applications.Application_Access := AWA.Tests.Get_Application;
            Ctx         : AWA.Services.Contexts.Service_Context;
            Users  : constant AWA.Users.Modules.User_Module_Access := AWA.Testsuite.Users'Access;
         begin
            Ctx.Set_Context (Application, null);
            Register (App    => Application.all'Access,
                      Name   => AWA.Users.Modules.NAME,
                      URI    => "user",
                      Module => Users.all'Access);

            Register (App    => Application.all'Access,
                      Name   => "mail",
                      URI    => "mail",
                      Module => Mail'Access);

            Register (App    => Application.all'Access,
                      Name   => "workspaces",
                      URI    => "workspaces",
                      Module => Workspaces'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Counters.Modules.NAME,
                      URI    => "counters",
                      Module => Counters'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Comments.Modules.NAME,
                      URI    => "comments",
                      Module => Comments'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Storages.Modules.NAME,
                      URI    => "storages",
                      Module => Storages'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Images.Modules.NAME,
                      URI    => "images",
                      Module => Images'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Jobs.Modules.NAME,
                      URI    => "jobs",
                      Module => Jobs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Settings.Modules.NAME,
                      URI    => "settings",
                      Module => Settings'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Votes.Modules.NAME,
                      URI    => "votes",
                      Module => Votes'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Changelogs.Modules.NAME,
                      URI    => "changelogs",
                      Module => Changelogs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Tags.Modules.NAME,
                      URI    => "tags",
                      Module => Tags'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Blogs.Modules.NAME,
                      URI    => "blogs",
                      Module => Blogs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Questions.Modules.NAME,
                      URI    => "questions",
                      Module => Questions'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Wikis.Modules.NAME,
                      URI    => "wikis",
                      Module => Wikis'Access);

            Application.Start;
            if Props.Exists ("test.server") then
               declare
                  WS : ASF.Server.Web.AWS_Container;
               begin
                  Application.Add_Converter (Name      => "dateConverter",
                                             Converter => Date_Converter'Access);
                  Application.Add_Converter (Name      => "smartDateConverter",
                                             Converter => Rel_Date_Converter'Access);

                  WS.Register_Application ("/asfunit", Application.all'Access);

                  WS.Start;
                  delay 6000.0;
               end;
            end if;
            ASF.Server.Tests.Set_Context (Application.all'Access);
         end;
      end if;
   end Initialize;

end AWA.Testsuite;

Remove the wiki unit tests that have been moved to Ada Wiki