1-- 2-- Copyright (c) 2009-2015, 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 23with Ada.Finalization; 24 25with Alog.Facilities; 26with Alog.Transforms; 27with Alog.Tasked_Logger; 28with Alog.Protected_Containers; 29with 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. 34package 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 Level : Log_Level; 102 Msg : String; 103 Source : 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 is terminated. 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 140private 141 142 protected type Protected_Boolean (Initial_State : Boolean) is 143 144 function State return Boolean; 145 -- Return current state. 146 147 procedure Swap 148 (New_State : Boolean; 149 Old_State : out Boolean); 150 -- Swap internal state with new state and return old state. 151 152 private 153 S : Boolean := Initial_State; 154 end Protected_Boolean; 155 -- Protected boolean used to guard shutdown procedure. 156 157 task type Logging_Task (Parent : not null access Instance); 158 -- This task takes logging requests from the parent's message queue and 159 -- logs them using the parent's backend logger. 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 Terminated : Protected_Boolean (Initial_State => False); 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 175end Alog.Active_Logger; 176