------------------------------------------------------------------------------
--                                  Log4Ada                                 --
--                                                                          --
--                            Copyright (C) 2007                            --
--                              X. Grave CNRS                               --
--                                                                          --
--  This library is free software; you can redistribute it and/or modify    --
--  it under the terms of the GNU General Public License as published by    --
--  the Free Software Foundation; either version 2 of the License, 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              --
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU       --
--  General Public License for more details.                                --
--                                                                          --
--  You should have received a copy of the GNU General Public License       --
--  along with this library; if not, write to the Free Software Foundation, --
--  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.          --
--                                                                          --

with GNAT.Traceback.Symbolic;

package body Log4ada.Events is

   use Ada.Strings.Unbounded;
   use Ada.Exceptions;

   procedure Free (Event : in out Event_Access) is
   begin
      Real_Free (Event);
   end Free;

   Event_Name : constant Unbounded_String :=
     To_Unbounded_String ("log4ada:event");

   ---------------
   -- New_Event --
   ---------------

   function New_Event (Location_Information : String;
                       Logger_Name : String;
                       Level : Level_Type;
                       Timestamp : Integer;
                       Message : String)
                      return Event_Type is
   begin
      return (Name => Event_Name,
              Location_Information =>
                To_Unbounded_String (Location_Information),
              Logger_Name => To_Unbounded_String (Logger_Name),
              Level => Level,
              Timestamp => Timestamp,
              Message => To_Unbounded_String (Message),
              Exception_Present => False,
              Exception_To_Send_Name => Null_Unbounded_String,
              Exception_To_Send_Message => Null_Unbounded_String,
              With_Traces => False,
              Trace => Null_Unbounded_String);
   end New_Event;

   function New_Event
     (Location_Information : String;
      Logger_Name : String;
      Level : Level_Type;
      Timestamp : Integer;
      Message : String;
      Exception_To_Send : Ada.Exceptions.Exception_Occurrence;
      With_Traces : Boolean := True)
      return Event_Type
   is
      Trace : constant String := GNAT.Traceback.Symbolic.Symbolic_Traceback (Exception_To_Send);
   begin
      if With_Traces then
         return (Name => Event_Name,
                 Location_Information      => To_Unbounded_String (Location_Information),
                 Logger_Name               => To_Unbounded_String (Logger_Name),
                 Level                     => Level,
                 Timestamp                 => Timestamp,
                 Message                   => To_Unbounded_String (Message),
                 Exception_Present         => True,
                 Exception_To_Send_Name    => To_Unbounded_String (Exception_Name (Exception_To_Send)),
                 Exception_To_Send_Message => To_Unbounded_String (Exception_Message (Exception_To_Send)),
                 With_Traces               => True,
                 Trace                     => To_Unbounded_String (Trace));
      else
         return (Name => Event_Name,
                 Location_Information      => To_Unbounded_String (Location_Information),
                 Logger_Name               => To_Unbounded_String (Logger_Name),
                 Level                     => Level,
                 Timestamp                 => Timestamp,
                 Message                   => To_Unbounded_String (Message),
                 Exception_Present         => True,
                 Exception_To_Send_Name    => To_Unbounded_String (Exception_Name (Exception_To_Send)),
                 Exception_To_Send_Message => To_Unbounded_String (Exception_Message (Exception_To_Send)),
                 With_Traces               => False,
                 Trace                     => Null_Unbounded_String);
      end if;
   end New_Event;

   ------------------------------
   -- Get_Location_Information --
   ------------------------------

   function Get_Location_Information (Event : Event_Type) return String is
   begin
      return To_String (Event.Location_Information);
   end Get_Location_Information;

   function Get_Logger_Name (Event : Event_Type) return String is
   begin
      return To_String (Event.Logger_Name);
   end Get_Logger_Name;
   ---------------
   -- Get_Level --
   ---------------

   function Get_Level (Event : Event_Type) return Level_Type is
   begin
      return Event.Level;
   end Get_Level;

   -------------------
   -- Get_Timestamp --
   -------------------

   function Get_Timestamp (Event : Event_Type) return Integer is
   begin
      return Event.Timestamp;
   end Get_Timestamp;

   -----------------
   -- Get_Message --
   -----------------

   function Get_Message (Event : Event_Type) return String is
   begin
      return To_String (Event.Message);
   end Get_Message;

   -------------------
   -- Get_Exception --
   -------------------
   function Exception_Present (Event : Event_Type) return Boolean is
   begin
      return Event.Exception_Present;
   end Exception_Present;

   function Get_Exception_Name
     (Event : Event_Type)
     return String
   is
   begin
      return To_String (Event.Exception_To_Send_Name);
   end Get_Exception_Name;

   function Get_Exception_Message (Event : Event_Type) return String is
   begin
      return To_String (Event.Exception_To_Send_Message);
   end Get_Exception_Message;

   function Get_Trace (Event : Event_Type) return String is
   begin
      return To_String (Event.Trace);
   end Get_Trace;

   Event_Separator : constant String := "<log4Ada_Tag>";
   Missing_Separator : exception;

   function Get_First_Value (Work_Event_String : Unbounded_String)
                            return String;
   function Get_First_Value_Unbounded (Work_Event_String : Unbounded_String)
                                      return Unbounded_String;
   procedure Cut_First_Value (Work_Event_String : in out Unbounded_String);

   function To_Event (Event_String : String) return Event_Type is
      Event : Event_Type;
      Work_Event_String : Unbounded_String :=
        To_Unbounded_String (Event_String);
   begin
      Event.Name := Get_First_Value_Unbounded (Work_Event_String);
      Cut_First_Value (Work_Event_String);
      Event.Location_Information :=
        Get_First_Value_Unbounded (Work_Event_String);
      Cut_First_Value (Work_Event_String);
      Event.Level := Level_Type'Value (Get_First_Value (Work_Event_String));
      Cut_First_Value (Work_Event_String);
      Event.Timestamp := Integer'Value (Get_First_Value (Work_Event_String));
      Cut_First_Value (Work_Event_String);
      Event.Message := Get_First_Value_Unbounded (Work_Event_String);
      Cut_First_Value (Work_Event_String);
      Event.Logger_Name := Get_First_Value_Unbounded (Work_Event_String);
      Cut_First_Value (Work_Event_String);
      Event.Exception_Present := Boolean'Value (Get_First_Value (Work_Event_String));
      if Event.Exception_Present then
         Cut_First_Value (Work_Event_String);
         Event.Exception_To_Send_Name :=
           Get_First_Value_Unbounded (Work_Event_String);
         Cut_First_Value (Work_Event_String);
         Event.Exception_To_Send_Message :=
           Get_First_Value_Unbounded (Work_Event_String);
         Cut_First_Value (Work_Event_String);
         Event.With_Traces := Boolean'Value (Get_First_Value (Work_Event_String));
         if Event.With_Traces then
            Cut_First_Value (Work_Event_String);
            Event.Trace := Get_First_Value_Unbounded (Work_Event_String);
         else
            Event.Trace := Null_Unbounded_String;
         end if;
      else
         Event.Exception_To_Send_Name := Null_Unbounded_String;
         Event.Exception_To_Send_Message := Null_Unbounded_String;
         Event.Trace := Null_Unbounded_String;
      end if;
      return Event;
   end To_Event;

   function To_String (Event : Event_Type) return String is
      String_To_Return : Unbounded_String := Event_Name;
   begin
      String_To_Return := String_To_Return & Event_Separator & Event.Location_Information;
      String_To_Return := String_To_Return & Event_Separator & Event.Level'Img;
      String_To_Return := String_To_Return & Event_Separator & Event.Timestamp'Img;
      String_To_Return := String_To_Return & Event_Separator & Event.Message;
      String_To_Return := String_To_Return & Event_Separator & Event.Logger_Name;
      String_To_Return := String_To_Return & Event_Separator & Event.Exception_Present'Img;
      String_To_Return := String_To_Return & Event_Separator & Event.Exception_To_Send_Name;
      String_To_Return := String_To_Return & Event_Separator & Event.Exception_To_Send_Message;
      String_To_Return := String_To_Return & Event_Separator & Event.With_Traces'Img;
      String_To_Return := String_To_Return & Event_Separator & Event.Trace;
      return To_String (String_To_Return);
   end To_String;

   function Get_First_Value (Work_Event_String : Unbounded_String)
                            return String is
   begin
      return To_String (Get_First_Value_Unbounded (Work_Event_String));
   end Get_First_Value;

   function Get_First_Value_Unbounded (Work_Event_String : Unbounded_String)
                                      return Unbounded_String is
      Separator_Position : constant Natural := Index (Work_Event_String,
                                                      Event_Separator);
   begin
      if Separator_Position = 0 then
         return Work_Event_String;
      end if;
      return Head (Work_Event_String, Separator_Position - 1);
   end Get_First_Value_Unbounded;

   procedure Cut_First_Value (Work_Event_String : in out Unbounded_String) is
      Separator_Position : constant Natural := Index (Work_Event_String,
                                                      Event_Separator);
   begin
      if Separator_Position = 0 then
         raise Missing_Separator;
      end if;
      Tail (Work_Event_String,
            Length (Work_Event_String) -
            Separator_Position -
            Event_Separator'Length + 1);
   end Cut_First_Value;



end Log4ada.Events;
