File : adagio-trace.adb


------------------------------------------------------------------------------

--                         ADAGIO - ADALID - AENEA.                         --

--                                                                          --

--                            Copyright (C) 2003                            --

--                                 A. Mosteo.                               --

--                                                                          --

--  Authors: A. Mosteo. (adagio@mosteo.com)                                 --

--                                                                          --

--  If you have any questions in regard to this software, please address    --

--  them to the above email.                                                --

--                                                                          --

--  This program 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 program 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.          --

--                                                                          --

--  You are not allowed to use any part of this code to develop a program   --

--  whose output would be used to harass or prosecute other users of the    --

--  networks Adagio connects with. All data collected with Adagio or a tool --

--  containing Adagio code about other network users must remain            --

--  confidential and cannot be made public by any mean, nor be used to      --

--  harass or legally prosecute these users.                                --

------------------------------------------------------------------------------

--  $Id: adagio-trace.adb,v 1.5 2004/02/05 18:31:21 Jano Exp $


-- Package for help in tracing events


with Adagio.Debug;
with Adagio.Event_log;
with Adagio.Globals.Options;
with Adagio.Misc;
with Adagio.OS;

with Gnat.Os_lib;       use Gnat;

with Text_io;           use Text_io;
with Ada.Calendar;      use Ada.Calendar;
with System;

with Pragmarc.Assignment;
with Pragmarc.Queue_bounded_blocking;

package body Adagio.Trace is

   -- Minimum debug level

   -- See elaboration for additional initializing.

   Minimum_Level : Warning_Level := Warning_level'Value (
      S (Globals.Options.Debug_loglevel));

   procedure Check_changed_level is
   begin
      Minimum_Level := Warning_level'Value (
         S (Globals.Options.Debug_loglevel));
   end Check_changed_level;

   task Poll_task is
      pragma Priority (System.Default_Priority + 1);
   end Poll_task;

   -- Instance vars for debugging.

   -- To avoid continuous polling in the tracing function:

   Debug_on      : boolean renames Globals.Options.Debug_active;
   Logfile       : Ustring renames Globals.Options.Debug_logfile;
   Echo          : Boolean renames Globals.Options.Debug_ConsoleEcho;

   ---

   type A_trace is record
      Text : Ustring;
      File : Ustring;
   end record;

   procedure Assign is new Pragmarc.Assignment (A_trace);

   package Trace_queue is new Pragmarc.Queue_bounded_blocking (
      A_trace, Assign);

   Queue : Trace_queue.Handle (1000, System.Priority'Last);
   Queue_out : Trace_queue.Handle (1000, System.Priority'Last);

   -----------------

   -- Poll_task

   -----------------


   task body Poll_task is
      No_File      : constant Ustring := U ("");
      Next         : A_trace;
      Real_file    : Ustring;
      F            : Text_io.File_type;
      Last         : Calendar.Time;
      Current_File : Ustring := No_File;

      use type Calendar.Time;
   begin
      loop
         begin
         select
            Queue.Get (Next);
            if not Queue_out.Full then
               select
                  Queue_out.Put (Next);
               or
                  delay 0.01;
               end select;
            end if;
            Last := Calendar.Clock;
            -- Write next:

            if Next.File = "" then
               Real_file:= Logfile;
            else
               Real_file:= Next.File;
            end if;
            if Real_file /= "error" then
               begin
                  if Real_File /= Current_File then
                     if Current_File /= No_File then
                        Text_IO.Close (F);
                     end if;

                     Current_File := Real_File;

                     if Gnat.Os_lib.Is_regular_file (S (Real_file)) then
                        Text_io.Open(f,
                           Mode => Text_io.Append_file,
                           Name => S (Real_file));
                     else
                        Text_io.Create(f,
                           Mode => Text_io.Out_file,
                           Name => S (Real_file));
                     end if;
                  end if;

                  Text_IO.Put_line (f, S (Next.Text));
                  Text_IO.Flush (F);
               exception
                  when others =>
                     if Text_io.Is_open (f) then
                        Text_io.Close (f);
                        Current_file := No_file;
                        raise;
                     end if;
               end;
            end if;
         or
            delay until Clock + 1.0;
         end select;
         exception
            when E : others =>
               Os.Message_box ("Trace.Poll_task", Trace.Report (E));
         end;

         exit when
            Globals.Requested_exit and then
            Queue.Empty and then
            Calendar.Clock - Last > 5.0;
      end loop;

      Adagio.Debug.Tracing_finished := true;
   end Poll_task;

   subtype Warn_Prefix is String (1 .. 4);
   type Prefix is array (All_levels) of Warn_Prefix;

   Warn : constant Prefix := (
      Never       => ":n: ",
      Debug       => "-d- ",
      Informative => "(i) ",
      Error       => "[E] ",
      Warning     => "<w> ",
      Always      => "!A! ");

   Event_equiv : constant array (All_levels) of Event_log.Levels := (
      Never       => Event_log.Debug,
      Debug       => Event_log.Debug,
      Informative => Event_log.Normal,
      Error       => Event_log.Error,
      Warning     => Event_log.Warning,
      Always      => Event_log.Normal);

   -- Logs a text to log file. Slow, thread safe.

   -- Timestamp automatically prepended.

   procedure Log(
      Text    : String;
      Warning : All_levels := Debug;
      File    : String     := "") 
   is
      Next    : A_trace;
   begin
      if not Debug_on then  -- Earliest exit

         return;
      elsif Warning < Minimum_level then
         return;
--      elsif Globals.Requested_exit then

--         return;

      end if;

      Next.Text :=
         U ("[" & Adagio.Misc.Timestamp & "] " & Warn (Warning) & Text);
      Next.File := U (File);

      if Echo then
         begin
            Put_line (S (Next.Text));
         exception
            when others =>
               null;
         end;
      end if;

      -- To web log

      Event_log.Add ((
         Arrival  => Calendar.Clock,
         Level    => Event_equiv (Warning),
         Text     => U (Text)));

      -- Exit if finished

      if Adagio.Debug.Tracing_Finished then
         return;
      end if;

      select
         Queue.Put (Next);
      or
         delay until Clock + 1.0;
      end select;
   exception
      when E : others =>
         Os.Message_box ("Trace.Log", Exception_information (E));
   end Log;

   -- Displays a box with info about some exception

   procedure Report(e: Ada.Exceptions.Exception_occurrence;
                    Context: String:= "") is
   begin
      OS.Message_box
        ("Adagio " & Context,
         "Error: " & Ada.Exceptions.Exception_name(e) & ": " &
                     Ada.Exceptions.Exception_message(e));
   end Report;

   -- Constructs a error string upon exception:

   function Report(e: Ada.Exceptions.Exception_occurrence) return String is
   begin
--         return Ada.Exceptions.Exception_name(e) & ": " &

--                Ada.Exceptions.Exception_message(e) &

           return     Exception_information (e);
   end Report;

   -- Returns next N characters from a stream as hex

   function Debug_stream (
      Stream      : access Streams.Root_stream_type'Class;
      N           : Positive := 8;
      Separator   : String := ":") return String is

      S : String (1 .. N);
      R : UString;

   begin
      String'Read (Stream, S);
      for n in S'Range loop
         R := R & "0x" & Misc.To_hex (S (n));
         if n /= S'Last then
            R := R & Separator;
         end if;
      end loop;

      return To_string (R);
   end Debug_stream;

   -- Get pending logs

   function Get_logs return Ustring_array is
      Result : Ustring_array (1 .. 10);
      Pos    : Natural := 0;
      Next   : A_trace;
   begin
      while Pos < Result'Last and not Queue_out.Empty loop
         Pos := Pos + 1;
         Queue_out.Get (Next);
         Result (Pos) := Next.Text;
      end loop;
      return Result (1 .. Pos);
   end Get_logs;

end Adagio.Trace;