1. -- 
  2. --  Copyright (c) 2009, 
  3. --  Reto Buerki, Adrian-Ken Rueegsegger 
  4. --  secunet SwissIT AG 
  5. -- 
  6. --  This file is part of Alog. 
  7. -- 
  8. --  Alog is free software; you can redistribute it and/or modify 
  9. --  it under the terms of the GNU Lesser General Public License as published 
  10. --  by the Free Software Foundation; either version 2.1 of the License, or 
  11. --  (at your option) any later version. 
  12. -- 
  13. --  Alog is distributed in the hope that it will be useful, 
  14. --  but WITHOUT ANY WARRANTY; without even the implied warranty of 
  15. --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
  16. --  GNU Lesser General Public License for more details. 
  17. -- 
  18. --  You should have received a copy of the GNU Lesser General Public License 
  19. --  along with Alog; if not, write to the Free Software 
  20. --  Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, 
  21. --  MA  02110-1301  USA 
  22. -- 
  23.  
  24. with Ada.Exceptions; 
  25. with Ada.Finalization; 
  26.  
  27. with Alog.Facilities; 
  28. with Alog.Transforms; 
  29. with Alog.Tasked_Logger; 
  30. with Alog.Protected_Containers; 
  31.  
  32. --  Active Logger instance. This logger is an active object and implements 
  33. --  concurrent, asynchronous logging. It provides the same functionality as the 
  34. --  'simple' logger. 
  35. package Alog.Active_Logger is 
  36.  
  37.    type Instance (Init : Boolean) is tagged limited private; 
  38.    --  Active logger instance. Incoming messages (via Log_Message) are put into 
  39.    --  a request queue. This queue is consumed by a logging task. Exceptions 
  40.    --  that might be thrown while logging are saved into a map on a per-caller 
  41.    --  basis. 
  42.  
  43.    type Handle is access all Instance; 
  44.    --  Handle to active logger type. 
  45.  
  46.    procedure Attach_Facility 
  47.      (Logger   : in out Instance; 
  48.       Facility :        Facilities.Handle); 
  49.    --  Attach a facility to logger instance. 
  50.  
  51.    procedure Attach_Default_Facility (Logger : in out Instance); 
  52.    --  Attach default facility with name Default_Facility_Name to logger 
  53.    --  instance. If the default facility is already attached do nothing. 
  54.  
  55.    procedure Detach_Facility 
  56.      (Logger : in out Instance; 
  57.       Name   :        String); 
  58.    --  Detach a facility with name 'Name' from logger instance. If the facility 
  59.    --  is not found a Facility_Not_Found exception is raised. 
  60.  
  61.    procedure Detach_Default_Facility (Logger : in out Instance); 
  62.    --  Detach default facility with name Default_Facility_Name from logger 
  63.    --  instance. If the default facility is not attached do nothing. 
  64.  
  65.    function Facility_Count (Logger : Instance) return Natural; 
  66.    --  Return number of attached facilites. 
  67.  
  68.    procedure Update 
  69.      (Logger  : in out Instance; 
  70.       Name    :        String; 
  71.       Process :        Tasked_Logger.Facility_Update_Handle); 
  72.    --  Update a specific Facility identified by 'Name'. Call the 'Process' 
  73.    --  procedure to perform the update operation. 
  74.  
  75.    procedure Iterate 
  76.      (Logger  : in out Instance; 
  77.       Process :        Tasked_Logger.Facility_Update_Handle); 
  78.    --  Call 'Process' for all attached facilities. 
  79.  
  80.    procedure Attach_Transform 
  81.      (Logger    : in out Instance; 
  82.       Transform :        Transforms.Handle); 
  83.    --  Attach a transform to logger instance. 
  84.  
  85.    procedure Detach_Transform 
  86.      (Logger : in out Instance; 
  87.       Name   :        String); 
  88.    --  Detach a transform with name 'Name' from logger instance. If the 
  89.    --  transform is not found a Transform_Not_Found exception is raised. 
  90.  
  91.    function Transform_Count (Logger : Instance) return Natural; 
  92.    --  Return number of attached transforms. 
  93.  
  94.    procedure Clear (Logger : in out Instance); 
  95.    --  Clear logger instance. Detach and teardown all attached facilities and 
  96.    --  transforms. 
  97.  
  98.    procedure Log_Message 
  99.      (Logger : in out Instance; 
  100.       Source :        String := ""; 
  101.       Level  :        Log_Level; 
  102.       Msg    :        String); 
  103.    --  Log the given message asynchronously. The message is put into a log 
  104.    --  request queue which is continuously consumed by a logging task. 
  105.    -- 
  106.    --  Prior to actually processing the given log message the policy database is 
  107.    --  inquired if the log message with given source and level should be logged. 
  108.    -- 
  109.    --  This procedure is *safe* to call from protected actions (e.g. from an 
  110.    --  entry call statement or rendezvous). 
  111.  
  112.    function Get_Queue_Length (Logger : Instance) return Natural; 
  113.    --  Returns the number of currently queued log messages. 
  114.  
  115.    procedure Shutdown 
  116.      (Logger : in out Instance; 
  117.       Flush  :        Boolean := True); 
  118.    --  Shutdown the active logger. This procedure must be called in order for 
  119.    --  the logger task to be terminated properly. If 'Flush' is set to True the 
  120.    --  procedure will wait for all queued messages to be logged. 
  121.  
  122.    function Is_Terminated (Logger : Instance) return Boolean; 
  123.    --  Returns True if active logger shutdown sequence is complete. 
  124.  
  125.    procedure All_Done (Logger : in out Instance); 
  126.    --  This procedure blocks until all queued logging requests have been 
  127.    --  consumed. 
  128.  
  129.    procedure Get_Last_Exception 
  130.      (Logger     : in out Instance; 
  131.       Occurrence :    out Ada.Exceptions.Exception_Occurrence); 
  132.    --  Return last known Exception_Occurrence for caller. If no exception 
  133.    --  occured Null_Occurrence is returned. 
  134.  
  135.    type Shutdown_Helper (Logger : not null access Instance) is private; 
  136.    --  This helper will call Shutdown on the logger given as discriminant when 
  137.    --  it goes out of scope. This relieves the user from having to excplicitly 
  138.    --  call shutdown on an instance of Alog active logger when wanting to 
  139.    --  terminate. Users must make sure to declare any shutdown helper in a 
  140.    --  smaller scope than the active logger on which the helper supposed to 
  141.    --  work. 
  142.  
  143. private 
  144.  
  145.    procedure Check_Exception (Logger : in out Instance); 
  146.    --  Check if call to backend raised an exception. Explicitly reraise if an 
  147.    --  exception occured; do nothing otherwise. 
  148.  
  149.    task type Logging_Task (Parent : not null access Instance); 
  150.    --  This task takes logging requests from the parent's message queue and 
  151.    --  logs them using the parent's backend logger. 
  152.  
  153.    protected type Trigger_Type is 
  154.       procedure Shutdown; 
  155.       entry Stop; 
  156.    private 
  157.       Shutdown_Requested : Boolean := False; 
  158.    end Trigger_Type; 
  159.    --  This trigger is used to terminate the logger task by means of ATC. 
  160.  
  161.    type Instance (Init : Boolean) is tagged limited record 
  162.       Logger_Task   : Logging_Task (Parent => Instance'Access); 
  163.       Backend       : Tasked_Logger.Instance (Init); 
  164.       Message_Queue : Protected_Containers.Log_Request_List; 
  165.       Trigger       : Trigger_Type; 
  166.    end record; 
  167.  
  168.    type Shutdown_Helper (Logger : not null access Instance) is 
  169.      new Ada.Finalization.Controlled with null record; 
  170.  
  171.    overriding 
  172.    procedure Finalize (Helper : in out Shutdown_Helper); 
  173.    --  Call shutdown on the active logger instance specified as discriminat. 
  174.  
  175. end Alog.Active_Logger;