1-- 2-- Copyright (c) 2008-2009, 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.Directories; 24with Ada.Exceptions; 25 26package body Alog.Facilities.File_Descriptor is 27 28 ------------------------------------------------------------------------- 29 30 procedure Close_Logfile 31 (Facility : in out Instance; 32 Remove : Boolean := False) 33 is 34 use Ada.Text_IO; 35 begin 36 if (Facility.Log_File_Ptr /= Standard_Output 37 and Facility.Log_File_Ptr /= Standard_Error) 38 and Is_Open (File => Facility.Log_File) 39 then 40 if Remove then 41 -- Close and delete. 42 Delete (File => Facility.Log_File); 43 else 44 -- Close only. 45 Close (File => Facility.Log_File); 46 end if; 47 end if; 48 end Close_Logfile; 49 50 ------------------------------------------------------------------------- 51 52 function Get_Logfile (Facility : Instance) return Ada.Text_IO.File_Access 53 is 54 begin 55 return Facility.Log_File_Ptr; 56 end Get_Logfile; 57 58 ------------------------------------------------------------------------- 59 60 procedure Set_Log_Stderr (Facility : in out Instance) 61 is 62 begin 63 Facility.Log_File_Ptr := Ada.Text_IO.Standard_Error; 64 end Set_Log_Stderr; 65 66 ------------------------------------------------------------------------- 67 68 procedure Set_Logfile 69 (Facility : in out Instance; 70 Path : String; 71 Append : Boolean := True) 72 is 73 begin 74 if not Ada.Directories.Exists (Name => Path) then 75 Ada.Text_IO.Create (File => Facility.Log_File, 76 Mode => Ada.Text_IO.Out_File, 77 Name => Path); 78 else 79 declare 80 File_Mode : Ada.Text_IO.File_Mode := Ada.Text_IO.Append_File; 81 begin 82 if not Append then 83 File_Mode := Ada.Text_IO.Out_File; 84 end if; 85 86 Ada.Text_IO.Open (File => Facility.Log_File, 87 Name => Path, 88 Mode => File_Mode); 89 end; 90 end if; 91 92 -- Set logfile name and pointer to newly created file. 93 94 Facility.Log_File_Name := BS_Path.To_Bounded_String (Path); 95 96 -- Unchecked_Access is needed here since we use a pointer which is 97 -- defined externaly in the Text_IO library. 98 99 Facility.Log_File_Ptr := Facility.Log_File'Unchecked_Access; 100 101 exception 102 when E : others => 103 raise Open_File_Error with "Unable to open logfile '" & Path 104 & "': " & Ada.Exceptions.Exception_Message (X => E); 105 end Set_Logfile; 106 107 ------------------------------------------------------------------------- 108 109 procedure Teardown (Facility : in out Instance) is 110 begin 111 Facility.Close_Logfile; 112 end Teardown; 113 114 ------------------------------------------------------------------------- 115 116 procedure Write 117 (Facility : Instance; 118 Level : Log_Level := Info; 119 Msg : String) 120 is 121 pragma Unreferenced (Level); 122 123 use type Ada.Text_IO.File_Access; 124 begin 125 Ada.Text_IO.Put_Line (File => Facility.Log_File_Ptr.all, 126 Item => Msg); 127 Ada.Text_IO.Flush (File => Facility.Log_File_Ptr.all); 128 end Write; 129 130end Alog.Facilities.File_Descriptor; 131