------------------------------------------------------------------------------
--                              G N A T L I B                               --
--                                                                          --
--                     Copyright (C) 2006-2015, AdaCore                     --
--                                                                          --
-- This library is free software;  you can redistribute it and/or modify it --
-- under terms of the  GNU General Public License  as published by the Free --
-- Software  Foundation;  either version 3,  or (at your  option) any later --
-- version. This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Calendar;           use Ada.Calendar;
with Ada.Strings.Unbounded;  use Ada.Strings.Unbounded;
with Ada.Text_IO;            use Ada.Text_IO;

with GNAT.Source_Info;

with GNATCOLL.Email.Mailboxes;
with GNATCOLL.Email.Utils;
use  GNATCOLL.Email,
     GNATCOLL.Email.Mailboxes,
     GNATCOLL.Email.Utils;
with GNATCOLL.VFS; use GNATCOLL.VFS;

procedure Test_Email is
   use Address_Set, Charset_String_List;

   type Charset_String_Array is array (Natural range <>)
      of Charset_String;

   function "-" (Str : Unbounded_String) return String
      renames Ada.Strings.Unbounded.To_String;
   function "+" (Str : String) return Unbounded_String
      renames Ada.Strings.Unbounded.To_Unbounded_String;

   procedure Parse_File (Filename : String);
   procedure Dump (Str : String);
   procedure Assert (Expected, Actual : String; Msg : String := "");
   procedure Dump (S : Address_Set.Set; Prefix : String := "");
   procedure Assert (Expected, Actual : Address_Set.Set);
   procedure Test_Get_Param (Initial, Name : String; Expected : String);
   procedure Test_Del_Param (Initial, Name : String; Expected : String);
   procedure Test_Add_Param
    (Initial, Name, Value : String; Expected : String);
   procedure Test_QP_Encode
      (To_Encode, Expected : String;
       Block_Prefix        : String := "";
       Block_Suffix        : String := "";
       Block_Len           : Integer := Integer'Last;
       Where               : Region := Text;
       Location            : String := GNAT.Source_Info.Source_Location);
   procedure Test_Decode
     (To_Decode : String; Expected : Charset_String_Array);
   procedure Assert (B : Boolean; Msg : String);
   procedure Assert
     (S : Charset_String_List.List; Arr : Charset_String_Array);
   procedure Test_Base64_Encode
      (To_Encode, Expected : String;
       Block_Prefix : String := "";
       Block_Suffix : String := "";
       Block_Len    : Integer := Integer'Last);
   procedure Test_Base64_Decode (To_Decode, Expected : String);
   procedure Dump (S : Charset_String_List.List);
   procedure Dump (Arr : Charset_String_Array);
   procedure Test_QP_Decode
     (To_Decode, Expected : String;
      Where    : Region := Text;
      Location : String := GNAT.Source_Info.Source_Location);

   procedure Dump (Str : String) is
   begin
      for S in Str'Range loop
         if Character'Pos (Str (S)) >= 32
            and then Character'Pos (Str (S)) <= 127
         then
            Put (Str (S));
         else
            Put ('[' & Character'Image (Str (S)) & ']');
         end if;
      end loop;
      New_Line;
   end Dump;

   procedure Assert (Expected, Actual : String; Msg : String := "") is
   begin
      if Expected /= Actual then
         New_Line;
         if Msg /= "" then
            Put_Line (Msg);
         end if;
         Dump ("-  " & Expected);
         Dump ("+  " & Actual);
      end if;
   end Assert;

   procedure Dump (S : Address_Set.Set; Prefix : String := "") is
      C : Address_Set.Cursor := First (S);
   begin
      while Has_Element (C) loop
         Put_Line (Prefix & (-Element (C).Real_Name)
                   & " -- " & (-Element (C).Address));
         Next (C);
      end loop;
   end Dump;

   procedure Assert (Expected, Actual : Address_Set.Set) is
   begin
      if Expected /= Actual then
         Put_Line ("Error in Addresses set:");
         Dump (Expected, "- ");
         Dump (Actual, "+ ");
      end if;
   end Assert;

   procedure Test_QP_Encode
      (To_Encode, Expected : String;
       Block_Prefix        : String := "";
       Block_Suffix        : String := "";
       Block_Len           : Integer := Integer'Last;
       Where               : Region := Text;
       Location            : String := GNAT.Source_Info.Source_Location)
   is
      Result : Unbounded_String;
   begin
      Quoted_Printable_Encode
        (To_Encode,
         Result             => Result,
         Block_Prefix       => Block_Prefix,
         Block_Suffix       => Block_Suffix,
         Max_Block_Len      => Block_Len,
         Where              => Where);
      Assert (Expected, -Result, Msg => "Error at " & Location
                & " when encoding '" & To_Encode & "' in " & Where'Img);

      if Block_Prefix = "" and then Block_Suffix = "" then
         Test_QP_Decode
           (To_Decode => Expected,
            Expected  => To_Encode,
            Where     => Where,
            Location  => Location);
      end if;
   end Test_QP_Encode;

   procedure Test_Base64_Encode
      (To_Encode, Expected : String;
       Block_Prefix : String := "";
       Block_Suffix : String := "";
       Block_Len    : Integer := Integer'Last)
   is
      Result : Unbounded_String;
   begin
      Base64_Encode
        (To_Encode, Result => Result,
         Block_Prefix => Block_Prefix, Block_Suffix => Block_Suffix,
         Max_Block_Len => Block_Len);
      Assert (Expected, -Result);
   end Test_Base64_Encode;

   procedure Test_QP_Decode
     (To_Decode, Expected : String;
      Where    : Region := Text;
      Location : String := GNAT.Source_Info.Source_Location)
   is
      Result : Unbounded_String;
   begin
      Quoted_Printable_Decode (To_Decode, Where  => Where, Result => Result);
      Assert (Expected, -Result, Msg => "Error at " & Location
                & " when decoding '" & To_Decode & "' in " & Where'Img);
   end Test_QP_Decode;

   procedure Test_Base64_Decode (To_Decode, Expected : String) is
      Result : Unbounded_String;
   begin
      Base64_Decode (To_Decode, Result => Result);
      Assert (-Result, Expected);
   end Test_Base64_Decode;

   procedure Dump (Arr : Charset_String_Array) is
   begin
      for A in Arr'Range loop
         Put_Line ("Expected: " & (-Arr (A).Contents)
                   & " " & (-Arr (A).Charset));
      end loop;
   end Dump;

   procedure Dump (S : Charset_String_List.List) is
      C : Charset_String_List.Cursor := First (S);
   begin
      while Has_Element (C) loop
         Put_Line ("C=" & (-Element (C).Contents)
                   & " " & (-Element (C).Charset));
         Next (C);
      end loop;
   end Dump;

   procedure Assert
     (S : Charset_String_List.List; Arr : Charset_String_Array)
   is
      C : Charset_String_List.Cursor := First (S);
      Index : Integer := Arr'First;
   begin
      while Has_Element (C) loop
         if Index > Arr'Last or else Element (C) /= Arr (Index) then
            Dump (S);
            Dump (Arr);
         end if;

         Index := Index + 1;
         Next (C);
      end loop;
   end Assert;

   procedure Assert (B : Boolean; Msg : String) is
   begin
      if not B then
         Put_Line ("Error: " & Msg);
      end if;
   end Assert;

   procedure Test_Decode
     (To_Decode : String; Expected : Charset_String_Array)
   is
      Result : Charset_String_List.List;
   begin
      Decode_Header (To_Decode, Result => Result);
      Assert (Result, Expected);
   end Test_Decode;

   procedure Test_Add_Param
     (Initial, Name, Value : String; Expected : String)
   is
      H : Header := Create ("foo", Initial);
      Asc : Unbounded_String;
   begin
      Set_Param (H, Name, Value);
      Flatten (Get_Value (H), Result => Asc);
      Assert (-Asc, Expected);
   end Test_Add_Param;

   procedure Test_Del_Param (Initial, Name : String; Expected : String) is
      H : Header := Create ("foo", Initial);
      Asc : Unbounded_String;
   begin
      Delete_Param (H, Name);
      Flatten (Get_Value (H), Result => Asc);
      Assert (-Asc, Expected);
   end Test_Del_Param;

   procedure Test_Get_Param (Initial, Name : String; Expected : String) is
      H : constant Header := Create ("foo", Initial);
   begin
      Assert (Get_Param (H, Name), Expected);
   end Test_Get_Param;

   procedure Parse_File (Filename : String) is
      Box    : Mbox;
      Msg    : Message;
      Addr   : Address_Set.Set;
      T      : Time;
      pragma Unreferenced (Addr, T);
   begin
      Open (Box, Filename => Create (+Filename));
      declare
         Curs : GNATCOLL.Email.Mailboxes.Cursor'Class := First (Box);
      begin
         while Has_Element (Curs) loop
            Get_Message (Curs, Box, Msg);
            if Msg /= Null_Message then
               Addr := Get_Recipients (Msg);
               T    := Date_From_Envelope (Msg);
            end if;
            Next (Curs, Box);
         end loop;
      end;
   end Parse_File;

   Long   : constant String :=
    "hellohellohellohellohellohellohellohellohellohellohellohello";

begin
   Assert (Legacy_Format_Address ("John Doe", "doe@foo.com"),
           "John Doe <doe@foo.com>");
   Assert (Legacy_Format_Address ("John "" Doe", "doe@foo.com"),
           """John \"" Doe"" <doe@foo.com>");
   Assert (Legacy_Format_Address ("John X. Doe", "doe@foo.com"),
           """John X. Doe"" <doe@foo.com>");
   Assert (Legacy_Format_Address ("", ""), "");
   Assert (Legacy_Format_Address ("", "doe@foo.com"), "doe@foo.com");
   Assert (Legacy_Format_Address ("Arthur \ Foobar", "noone@foo.com"),
           """Arthur \\ Foobar"" <noone@foo.com>");

   Assert (-Parse_Address (" John Doe   <doe@foo.com>").Real_Name, "John Doe");
   Assert (-Parse_Address (" John Doe   <doe@foo.com>").Address,
           "doe@foo.com");
   Assert (-Parse_Address (" ""John X. Doe"" <doe@foo.com>").Real_Name,
           "John X. Doe");
   Assert (-Parse_Address (" ""John X. Doe"" <doe@foo.com>").Address,
           "doe@foo.com");
   Assert (-Parse_Address ("").Real_Name, "");
   Assert (-Parse_Address ("").Address, "");
   Assert (-Parse_Address ("doe@foo.com").Real_Name, "");
   Assert (-Parse_Address ("doe@foo.com").Address, "doe@foo.com");
   Assert (-Parse_Address ("""Arthur \\ Foobar"" <noone@foo.com").Real_Name,
           "Arthur \\ Foobar");
   --  ??? really should be \, but how useful is that
   Assert (-Parse_Address ("""Arthur \\ Foobar"" <noone@foo.com").Address,
           "noone@foo.com");

   --  Not compliant with RFC 2822, but try to parse anyway
   Assert (-Parse_Address (" John X. Doe <doe@foo.com").Real_Name,
           "John X. Doe");

   --  Real name is irrelevant
   Assert (Get_Addresses ("Doe <doe@foo.com>, Foo <bar@foo.com>"),
           Get_Addresses ("Doe2 <doe@foo.com>, Foo2 <bar@foo.com>"));
   Assert (Get_Addresses ("Doe <doe@foo.com>, Foo <bar@foo.com>"),
           Get_Addresses ("doe@foo.com,bar@foo.com"));

   --  Order is irrelevant
   Assert (Get_Addresses ("Doe <doe@foo.com>, Foo <bar@foo.com>"),
           Get_Addresses ("bar@foo.com, Doe <doe@foo.com>"));

   --  Casing is irrelevant
   Assert (Get_Addresses ("Doe <doe@foo.com>, Foo <bar@foo.com>"),
           Get_Addresses ("BAR@foo.COM, Doe <doe@foo.COM>"));

   Assert
     (Get_Addresses
        ("jules@cust.com" & ASCII.LF & ASCII.LF & "jim@cust.com"),
      Get_Addresses ("jules@cust.com, jim@cust.com"));

   Assert
     (Get_Addresses
        ("jules@cust.com jim@cust.com"),
      Get_Addresses ("jules@cust.com, jim@cust.com"));

   --  Sanity check To_Time function just so that we are sure that
   --  checking Format_Date makes sense; generally speaking a
   --  superposition of Format_Date and To_Time should give
   --  enough confidence
   --  We choose winter time here and summer time later on, to
   --  test both cases. Also, check proper advancement of date
   --  into new day/month/year on TZ change
   Assert (To_Time ("Thu, 31 Dec 2006 14:05:44 -0400") =
             Time_Of (2007, 1, 1, 6 * 3600.0 + 5 * 60.0 + 44.0),
           "To_Time produced incorrect time");

   Assert (Format_Date (To_Time ("Fri, 04 May 2001 14:05:44 -0400")),
           "Sat, 05 May 2001 06:05:44 +1200");
   Assert (Format_Date (To_Time ("Fri, 4 May 2001 14:05:44 -0400")),
           "Sat, 05 May 2001 06:05:44 +1200");
   Assert (Format_Date (To_Time ("4 May 2001 14:05:44 -0400")),
           "Sat, 05 May 2001 06:05:44 +1200");
   Assert (Format_Date (To_Time ("4 May 01 14:05:44 -0400")),
           "Sat, 05 May 2001 06:05:44 +1200");
   Assert (Format_Date (To_Time ("4 May 01 14:05 -0400")),
           "Sat, 05 May 2001 06:05:00 +1200");
   Assert (Format_Date (To_Time ("4 May 01 14:05 EDT")),
           "Sat, 05 May 2001 06:05:00 +1200");

   Test_QP_Encode ("", "");
   Test_QP_Encode ("ABCDEFG", "ABCDEFG");
   Test_QP_Encode ("ABC EFG", "ABC EFG");
   Test_QP_Encode ("ABC EFG", "ABC_EFG", Where => Other_Header);
   Test_QP_Encode ("ABC <EFG>", "ABC <EFG>", Where => Text);
   Test_QP_Encode ("ABC <EFG>", "ABC_=3CEFG=3E", Where => Addr_Header);
   Test_QP_Encode ("ABC <EFG>", "ABC_<EFG>", Where => Other_Header);
   Test_QP_Encode ("ABCEFG ", "ABCEFG=20", Where => Text);
   Test_QP_Encode ("ABC" & Character'Val (243), "ABC=F3");
   Test_QP_Encode ("ABC=EFG", "ABC=3DEFG");

   Test_QP_Encode ("ABC=EFG", "=?iso-8859-1?q?ABC?=" & ' '
           & "=?iso-8859-1?q?=3D?=" & ' '
           & "=?iso-8859-1?q?EFG?=",
         "=?iso-8859-1?q?", "?=", 20, Where => Other_Header);
   Test_QP_Encode ("ABC=EFG",
           "=?iso-8859-1?q?ABC?=" & ' '
         & "=?iso-8859-1?q?=3DE?=" & ' '
         & "=?iso-8859-1?q?FG?=",
         Block_Prefix => "=?iso-8859-1?q?",
         Block_Suffix => "?=", Block_Len => 21, Where => Other_Header);

   Test_QP_Decode ("", "");
   Test_QP_Decode ("ABCDEFG", "ABCDEFG");
   Test_QP_Decode ("ABC_EFG", "ABC_EFG");
   Test_QP_Decode ("ABC_EFG", "ABC EFG", Where => Other_Header);
   Test_QP_Decode ("ABC=3DEFG", "ABC=EFG");
   Test_QP_Decode ("ABC=F3", "ABC" & Character'Val (243));
   Test_QP_Decode
     ("=46rom the testing_book, mdi.19:" & ASCII.LF &
      "   Select a window through its title bar, then another. " &
      "The Windows View mu=" & ASCII.LF &
      "st" & ASCII.LF &
      "   reflect the current window at all times." & ASCII.LF &
      "   Likewise if you select the Windows View itself" & ASCII.LF &
      ASCII.LF &
      "This test now fails with the new code for buffer_view.adb." & ASCII.LF &
      ASCII.LF &
      "Assigned to Florian." & ASCII.LF &
      "Comments on this are release critical, but we need to discuss " &
      "whether this=" & ASCII.LF &
      "=20" & ASCII.LF &
      "needs to be fixed or the test modified",
      "From the testing_book, mdi.19:" & ASCII.LF &
      "   Select a window through its title bar, then another. " &
      "The Windows View must" & ASCII.LF &
      "   reflect the current window at all times." & ASCII.LF &
      "   Likewise if you select the Windows View itself" & ASCII.LF &
      ASCII.LF &
      "This test now fails with the new code for buffer_view.adb." & ASCII.LF &
      ASCII.LF &
      "Assigned to Florian." & ASCII.LF &
      "Comments on this are release critical, but we need to discuss " &
      "whether this " & ASCII.LF &
      "needs to be fixed or the test modified");

   Test_Base64_Encode ("", "");
   Test_Base64_Encode ("hello", "aGVsbG8=");
   Test_Base64_Encode ("hello",
           "=?iso-8859-1?b?aGV?=" & ASCII.LF
           & "=?iso-8859-1?b?sbG?=" & ASCII.LF
           & "=?iso-8859-1?b?8=?=",
           "=?iso-8859-1?b?", "?=", 20);
   Test_Base64_Encode
       ("hello" & ASCII.CR & ASCII.LF & "world", "aGVsbG8NCndvcmxk");
   Test_Base64_Encode (Long & Long & Long,
           "aGVsbG9oZWxsb2hlbGxvaGVsbG9oZWxsb2hlbGxvaGVsbG9oZWxsb2hlbGxva"
           & "GVsbG9oZWxsb2hl" & ASCII.LF
           & "bGxvaGVsbG9oZWxsb2hlbGxvaGVsbG9oZWxsb2hlbGxvaGVsbG9oZWxsb2h"
           & "lbGxvaGVsbG9oZWxs" & ASCII.LF
           & "b2hlbGxvaGVsbG9oZWxsb2hlbGxvaGVsbG9oZWxsb2hlbGxvaGVsbG9oZWx"
           & "sb2hlbGxvaGVsbG9o" & ASCII.LF & "ZWxsb2hlbGxv");
   Test_Base64_Decode ("", "");
   Test_Base64_Decode ("aGVsbG8=", "hello");
   Test_Base64_Decode ("aGVsbG8NCndvcmxk" & ASCII.LF,
           "hello" & ASCII.CR & ASCII.LF & "world");
   --  Test_Base64_Encode (Base64_Encode (+Long & Long & Long)),
   --        Long & Long & Long);

   Test_Decode ("", (1 => (+"", +"us-ascii")));
   Test_Decode ("A =?", (1 => (+"A =?", +"us-ascii")));
   Test_Decode ("A =?iso-8859-1",
           (1 => (+"A =?iso-8859-1", +"us-ascii")));
   Test_Decode ("A =?iso-8859-1?",
           (1 => (+"A =?iso-8859-1?", +"us-ascii")));
   Test_Decode ("A =?iso-8859-1?q",
           (1 => (+"A =?iso-8859-1?q", +"us-ascii")));
   Test_Decode ("A =?iso-8859-1?q?",
           (1 => (+"A =?iso-8859-1?q?", +"us-ascii")));
   Test_Decode ("A =?iso-8859-1?q?A",
           (1 => (+"A =?iso-8859-1?q?A", +"us-ascii")));
   Test_Decode ("A =?iso-8859-1?q?A?",
           (1 => (+"A =?iso-8859-1?q?A?", +"us-ascii")));
   Test_Decode ("A =?iso-8859-1?q?A?=",
           ((+"A ", +"us-ascii"), (+"A", +"iso-8859-1")));
   Test_Decode ("A =?iso-8859-1?q?A?= B",
           ((+"A ", +"us-ascii"), (+"A", +"iso-8859-1"),
            (+" B", +"us-ascii")));
   Test_Decode ("A =?iso-8859-1?q?A?= =?ISO-8859-1?q?B?=",
           ((+"A ", +"us-ascii"), (+"AB", +"iso-8859-1")));
   Test_Decode ("A =?iso-8859-1?q?A?= =?iso-8859-2?q?B?=",
           ((+"A ", +"us-ascii"), (+"A", +"iso-8859-1"),
            (+"B", +"iso-8859-2")));

   Test_Get_Param ("text/plain", "charset", "");
   Test_Get_Param ("text/plain; charset=""iso""", "charset", "iso");
   Test_Get_Param ("multipart/mixed;   boundary=""BOUNDARY""",
                   "boundary", "BOUNDARY");
   Test_Get_Param ("text/plain; charset=""iso-8859-1""; file=""foo""",
                   "file", "foo");
   Test_Get_Param ("text/plain; filename*0=""A""; filename*1=""B""",
                   "filename", "AB");

   Test_Add_Param ("text/plain", "charset", "iso-8859-1",
                   "text/plain; charset=""iso-8859-1""");
   Test_Add_Param ("text/plain; charset=""iso-8859-1""", "charset",
                   "iso-8859-2", "text/plain; charset=""iso-8859-2""");
   Test_Add_Param ("text/plain; charset=""iso-8859-1""; file=""foo""",
                   "charset", "iso-8859-2",
                   "text/plain; charset=""iso-8859-2""; file=""foo""");
   Test_Add_Param ("text/plain; charset=""iso-8859-1""; file=""foo""",
                   "file", "bar",
                   "text/plain; charset=""iso-8859-1""; file=""bar""");
   Test_Add_Param
      ("text/plain; charset=""iso-8859-1""; file=""foo""",
       "file2", "bar",
       "text/plain; charset=""iso-8859-1""; file=""foo""; file2=""bar""");

   Test_Del_Param ("text/plain", "charset", "text/plain");
   Test_Del_Param ("text/plain; charset=""iso-8859-1""", "charset",
                   "text/plain");
   Test_Del_Param ("text/plain; charset=""iso""; file=""foo""",
                   "charset", "text/plain; file=""foo""");
   Test_Del_Param ("text/plain; charset=""iso""; file=""foo""",
                   "file", "text/plain; charset=""iso""");

   Parse_File ("../email_data/F417_007");
   Parse_File ("../email_data/6205_002");
end Test_Email;
