1---  This file is covered by the Internet Software Consortium (ISC) License
2--  Reference: ../../License.txt
3
4with Ada.Calendar.Formatting;
5
6package body AdaBase.Logger.Base is
7
8   package ACF renames Ada.Calendar.Formatting;
9
10
11   -----------------------
12   --  set_information  --
13   -----------------------
14   procedure set_information
15               (listener   : out Base_Logger;
16                category   : Log_Category;
17                driver     : Driver_Type;
18                message    : CT.Text;
19                error_msg  : CT.Text      := CT.blank;
20                error_code : Driver_Codes := 0;
21                sqlstate   : SQL_State    := stateless)
22   is
23      prefix    : String (1 .. 17);
24      drv       : String (1 .. 11);
25      timestamp : constant AC.Time := AC.Clock;
26      TS        : constant String  := ACF.Image (Date => timestamp);
27      error     : CT.Text := CT.SUS (error_code'Img &  " : SQLSTATE[" &
28                                     sqlstate & "] : ");
29      err_label : CT.Text := CT.SUS (" : Driver code :");
30      composite : CT.Text := CT.blank;
31   begin
32      listener.prop_timestamp  := timestamp;
33      listener.prop_category   := category;
34      listener.prop_driver     := driver;
35      listener.prop_message    := message;
36      listener.prop_error_msg  := error_msg;
37      listener.prop_error_code := error_code;
38      listener.prop_sqlstate   := sqlstate;
39      listener.prop_is_error   := not CT.IsBlank (error_msg);
40
41      case driver is
42         when driver_mysql      => drv := "    mysql :";
43         when driver_sqlite     => drv := "   sqlite :";
44         when driver_postgresql => drv := "    pgsql :";
45         when driver_firebird   => drv := " firebird :";
46         when foundation        => drv := "     none :";
47      end case;
48
49      case category is
50         when connecting            => prefix := "       Connect : ";
51         when disconnecting         => prefix := "    Disconnect : ";
52         when transaction           => prefix := "   Transaction : ";
53         when execution             => prefix := "       Execute : ";
54         when statement_preparation => prefix := "  Prepare Stmt : ";
55         when statement_execution   => prefix := "  Execute Stmt : ";
56         when miscellaneous         => prefix := " Miscellaneous : ";
57         when note                  => prefix := "          Note : ";
58      end case;
59
60      composite := CT.SUS (TS & drv & prefix);
61
62      CT.SU.Append (Source => composite, New_Item => message);
63      if listener.prop_is_error then
64         CT.SU.Append (Source => composite, New_Item => err_label);
65         CT.SU.Append (Source => composite, New_Item => error);
66         CT.SU.Append (Source => composite, New_Item => error_msg);
67      end if;
68
69      listener.prop_composite  := composite;
70   end set_information;
71
72
73   -----------------
74   --  timestamp  --
75   -----------------
76   function timestamp  (listener : Base_Logger) return AC.Time
77   is
78   begin
79      return listener.prop_timestamp;
80   end timestamp;
81
82
83   ----------------
84   --  category  --
85   ----------------
86   function category   (listener : Base_Logger) return Log_Category
87   is
88   begin
89      return listener.prop_category;
90   end category;
91
92
93   --------------
94   --  driver  --
95   --------------
96   function driver (listener : Base_Logger) return Driver_Type
97   is
98   begin
99      return listener.prop_driver;
100   end driver;
101
102
103   -----------------
104   --  composite  --
105   -----------------
106   function composite (listener : Base_Logger) return CT.Text
107   is
108   begin
109      return listener.prop_composite;
110   end composite;
111
112
113   ---------------
114   --  message  --
115   ---------------
116   function message (listener : Base_Logger) return CT.Text
117   is
118   begin
119      return listener.prop_message;
120   end message;
121
122
123   -----------------
124   --  error_msg  --
125   -----------------
126   function error_msg  (listener : Base_Logger) return CT.Text
127   is
128   begin
129      return listener.prop_error_msg;
130   end error_msg;
131
132
133   ------------------
134   --  error_code  --
135   ------------------
136   function error_code (listener : Base_Logger) return Driver_Codes
137   is
138   begin
139      return listener.prop_error_code;
140   end error_code;
141
142
143   ----------------
144   --  sqlstate  --
145   ----------------
146   function sqlstate (listener : Base_Logger) return SQL_State is
147   begin
148      return listener.prop_sqlstate;
149   end sqlstate;
150
151
152   ----------------
153   --  is_error  --
154   ----------------
155   function is_error (listener : Base_Logger) return Boolean is
156   begin
157      return listener.prop_is_error;
158   end is_error;
159
160
161end AdaBase.Logger.Base;
162