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