From a1f4f2c61add5c92fe1f7e159f276644f3796a23 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Michal=20Mal=C3=BD?= Date: Sun, 21 Dec 2014 03:36:45 +0100 Subject: [PATCH] [WHOOPS] Actually add logging_system.ad* files to the repo --- src/logging_system.adb | 130 +++++++++++++++++++++++++++++++++++++++++ src/logging_system.ads | 34 +++++++++++ 2 files changed, 164 insertions(+) create mode 100644 src/logging_system.adb create mode 100644 src/logging_system.ads diff --git a/src/logging_system.adb b/src/logging_system.adb new file mode 100644 index 0000000..f64e8d2 --- /dev/null +++ b/src/logging_system.adb @@ -0,0 +1,130 @@ +with Ada.Calendar; +with Ada.Calendar.Formatting; +with Ada.Unchecked_Deallocation; + +package body Logging_System is + + -- BEGIN: Public functions + + procedure Close is + begin + Logging_Internal.Delete_Logger; + end Close; + + function Initialize return RetCode is + Ret: RetCode; + begin + Logging_Internal.Initialize(Ret); + return Ret; + end Initialize; + + procedure Log(Message: in String; Level: in Log_Level; To_Console: in Boolean := False) is + begin + Logging_Internal.Log(Message, Level, To_Console); + end Log; + + -- END: Public functions + -- BEGIN: Private functions + + overriding procedure Finalize(This: in out Logger) is + begin + if Ada.Text_IO.Is_Open(This.File_Handle) then + Ada.Text_IO.Close(This.File_Handle); + end if; + end Finalize; + + -- END: Public functions + + protected body Logging_Internal is + + -- BEGIN: Public functions + + procedure Delete_Logger is + procedure Delete_Logger_Internal is new Ada.Unchecked_Deallocation(Object => Logger, Name => Logger_All_Access); + begin + Delete_Logger_Internal(The_Logger); + The_Logger := null; + end Delete_Logger; + + procedure Initialize(Ret: out RetCode) is + begin + if The_Logger /= null then + Ret := E_INVAL; -- Logger is already initialized + end if; + + The_Logger := new Logger; + if The_Logger = null then + Ret := E_NULLPTR; -- No memory + return; + end if; + + begin + Ada.Text_IO.Open(File => The_Logger.File_Handle, Name => LOG_FILE_NAME, Mode => Ada.Text_IO.Append_File); + exception + when Ada.Text_IO.Name_Error => + -- File does not exist, create it + begin + Ada.Text_IO.Create(File => The_Logger.File_Handle, Name => LOG_FILE_NAME, Mode => Ada.Text_IO.Out_File); + exception + when others => + Delete_Logger; + Ada.Text_IO.Put_Line("LOGGING SYSTEM: Cannot open log file"); + Ret := E_FAIL; + return; + end; + when others => + Delete_Logger; + Ada.Text_IO.Put_Line("LOGGING SYSTEM: Cannot open log file"); + Ret := E_FAIL; + return; + end; + + Ret := OK; + return; + end Initialize; + + procedure Log(Message: in String; Level: in Log_Level; To_Console: in Boolean := False) is + Full_Message: UB_Text; + Now: constant Ada.Calendar.Time := Ada.Calendar.Clock; + begin + if The_Logger = null then + raise Logger_Not_Initialized; + end if; + + if Ada.Text_IO.Is_Open(The_Logger.File_Handle) = False then + raise Logger_Not_Initialized; + end if; + Append_UB_Text(Source => Full_Message, New_Item => Ada.Calendar.Formatting.Image(Date => Now)); + + case Level is + when DEBUG => + Append_UB_Text(Source => Full_Message, New_Item => " - [DEBUG]: "); + when WARNING => + Append_UB_Text(Source => Full_Message, New_Item => " - [WARNING]: "); + when ERROR => + Append_UB_Text(Source => Full_Message, New_Item => " - [ERROR]: "); + end case; + + Append_UB_Text(Source => Full_Message, New_Item => Message); + declare + Full_Message_FStr: constant String := UB_Text_To_Fixed_String(Full_Message); + begin + Ada.Text_IO.Put_Line(File => The_Logger.File_Handle, Item => Full_Message_FStr); + if Level = ERROR then + Ada.Text_IO.Flush(File => The_Logger.File_Handle); + end if; + if To_Console then + Ada.Text_IO.Put_Line(File => Ada.Text_IO.Standard_Output, Item => Full_Message_FStr); + end if; + end; + + end Log; + + -- END: Public functions + + end Logging_Internal; + +end Logging_System; + + + diff --git a/src/logging_system.ads b/src/logging_system.ads new file mode 100644 index 0000000..bc2cf55 --- /dev/null +++ b/src/logging_system.ads @@ -0,0 +1,34 @@ +with Ada.Finalization; +with Ada.Text_IO; + +with Global_Types; + +use Global_Types; +package Logging_System is + Logger_Not_Initialized: exception; + type Log_Level is (DEBUG, WARNING, ERROR); + + procedure Close; + function Initialize return RetCode; + procedure Log(Message: in String; Level: in Log_Level; To_Console: in Boolean := False); + +private + type Logger is limited new Ada.Finalization.Limited_Controlled with + record + File_Handle: Ada.Text_IO.File_Type; + end record; + overriding procedure Finalize(This: in out Logger); + type Logger_All_Access is access all Logger; + + protected Logging_Internal is + procedure Delete_Logger; + procedure Initialize(Ret: out RetCode); + procedure Log(Message: in String; Level: in Log_Level; To_Console: in Boolean := False); + + private + The_Logger: Logger_All_Access; + end Logging_Internal; + + LOG_FILE_NAME: constant String := "./nine_q_log.log"; + +end Logging_System; -- 2.43.5