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