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