1-- This file is covered by the Internet Software Consortium (ISC) License 2-- Reference: ../../License.txt 3 4package body AdaBase.Driver.Base is 5 6 7 ------------------------ 8 -- trait_autocommit -- 9 ------------------------ 10 overriding 11 function trait_autocommit (driver : Base_Driver) return Boolean is 12 begin 13 return driver.connection.autoCommit; 14 end trait_autocommit; 15 16 17 ------------------------- 18 -- trait_column_case -- 19 ------------------------- 20 overriding 21 function trait_column_case (driver : Base_Driver) return Case_Modes is 22 begin 23 return driver.connection.getCaseMode; 24 end trait_column_case; 25 26 27 ------------------------ 28 -- trait_error_mode -- 29 ------------------------ 30 overriding 31 function trait_error_mode (driver : Base_Driver) return Error_Modes is 32 begin 33 return logger.error_mode; 34 end trait_error_mode; 35 36 37 ----------------------- 38 -- trait_connected -- 39 ----------------------- 40 overriding 41 function trait_connected (driver : Base_Driver) return Boolean is 42 begin 43 return driver.connection.connected; 44 end trait_connected; 45 46 47 -------------------- 48 -- trait_driver -- 49 -------------------- 50 overriding 51 function trait_driver (driver : Base_Driver) return String is 52 begin 53 return driver.connection.description; 54 end trait_driver; 55 56 57 ------------------------- 58 -- trait_client_info -- 59 ------------------------- 60 overriding 61 function trait_client_info (driver : Base_Driver) return String is 62 begin 63 return driver.connection.clientInfo; 64 end trait_client_info; 65 66 67 ---------------------------- 68 -- trait_client_version -- 69 ---------------------------- 70 overriding 71 function trait_client_version (driver : Base_Driver) return String is 72 begin 73 return driver.connection.clientVersion; 74 end trait_client_version; 75 76 77 ------------------------- 78 -- trait_server_info -- 79 ------------------------- 80 overriding 81 function trait_server_info (driver : Base_Driver) return String is 82 begin 83 return driver.connection.serverInfo; 84 end trait_server_info; 85 86 87 ---------------------------- 88 -- trait_server_version -- 89 ---------------------------- 90 overriding 91 function trait_server_version (driver : Base_Driver) return String is 92 begin 93 return driver.connection.serverVersion; 94 end trait_server_version; 95 96 97 --------------------------- 98 -- trait_max_blob_size -- 99 --------------------------- 100 overriding 101 function trait_max_blob_size (driver : Base_Driver) return BLOB_Maximum is 102 begin 103 return driver.connection.maxBlobSize; 104 end trait_max_blob_size; 105 106 107 --------------------------- 108 -- trait_character_set -- 109 --------------------------- 110 overriding 111 function trait_character_set (driver : Base_Driver) return String is 112 begin 113 return driver.connection.character_set; 114 end trait_character_set; 115 116 117 ---------------------------- 118 -- set_trait_autocommit -- 119 ---------------------------- 120 overriding 121 procedure set_trait_autocommit (driver : Base_Driver; trait : Boolean) is 122 begin 123 driver.connection.setAutoCommit (auto => trait); 124 end set_trait_autocommit; 125 126 127 ----------------------------- 128 -- set_trait_column_case -- 129 ----------------------------- 130 overriding 131 procedure set_trait_column_case (driver : Base_Driver; trait : Case_Modes) 132 is 133 begin 134 driver.connection.setCaseMode (mode => trait); 135 end set_trait_column_case; 136 137 138 ---------------------------- 139 -- set_trait_error_mode -- 140 ---------------------------- 141 overriding 142 procedure set_trait_error_mode (driver : Base_Driver; trait : Error_Modes) 143 is 144 begin 145 logger.set_error_mode (mode => trait); 146 end set_trait_error_mode; 147 148 149 ------------------------------- 150 -- set_trait_max_blob_size -- 151 ------------------------------- 152 overriding 153 procedure set_trait_max_blob_size (driver : Base_Driver; 154 trait : BLOB_Maximum) is 155 begin 156 driver.connection.setMaxBlobSize (maxsize => trait); 157 end set_trait_max_blob_size; 158 159 160 ------------------------------------ 161 -- set_trait_multiquery_enabled -- 162 ------------------------------------ 163 overriding 164 procedure set_trait_multiquery_enabled (driver : Base_Driver; 165 trait : Boolean) 166 is 167 begin 168 driver.connection.setMultiQuery (multiple => trait); 169 end set_trait_multiquery_enabled; 170 171 172 ------------------------------- 173 -- set_trait_character_set -- 174 ------------------------------- 175 overriding 176 procedure set_trait_character_set (driver : Base_Driver; trait : String) is 177 begin 178 driver.connection.set_character_set (charset => trait); 179 end set_trait_character_set; 180 181 182 -------------------------------- 183 -- trait_multiquery_enabled -- 184 -------------------------------- 185 overriding 186 function trait_multiquery_enabled (driver : Base_Driver) return Boolean is 187 begin 188 return driver.connection.multiquery; 189 end trait_multiquery_enabled; 190 191 192 ----------------------- 193 -- standard_logger -- 194 ----------------------- 195 overriding 196 procedure command_standard_logger (driver : Base_Driver; 197 device : ALF.TLogger; 198 action : ALF.TAction) is 199 begin 200 logger.standard_logger (logger => device, action => action); 201 end command_standard_logger; 202 203 204 --------------------------- 205 -- set_logger_filename -- 206 --------------------------- 207 overriding 208 procedure set_logger_filename (driver : Base_Driver; filename : String) is 209 begin 210 logger.set_log_file (filename); 211 end set_logger_filename; 212 213 214 ---------------------------- 215 -- detach_custom_logger -- 216 ---------------------------- 217 overriding 218 procedure detach_custom_logger (driver : Base_Driver) is 219 begin 220 logger.detach_custom_logger; 221 end detach_custom_logger; 222 223 224 ---------------------------- 225 -- attach_custom_logger -- 226 ---------------------------- 227 overriding 228 procedure attach_custom_logger 229 (driver : Base_Driver; 230 logger_access : ALF.AL.BaseClass_Logger_access) is 231 begin 232 logger.attach_custom_logger (logger_access => logger_access); 233 end attach_custom_logger; 234 235 236 ------------------------- 237 -- query_clear_table -- 238 ------------------------- 239 overriding 240 procedure query_clear_table (driver : Base_Driver; table : String) 241 is 242 sql : constant String := "TRUNCATE " & table; 243 AR : Affected_Rows; 244 begin 245 AR := execute (driver => Base_Driver'Class (driver), sql => sql); 246 end query_clear_table; 247 248 249 ------------------------ 250 -- query_drop_table -- 251 ------------------------ 252 overriding 253 procedure query_drop_table (driver : Base_Driver; 254 tables : String; 255 when_exists : Boolean := False; 256 cascade : Boolean := False) 257 258 is 259 use type Driver_Type; 260 -- MySQL accepts CASCADE but ignores it 261 -- MySQL and PostgreSQL can use this versions, but Firebird 262 -- needs if_exists implementation and doesn't know CASCADE, so it 263 -- needs an overriding implementation. 264 sql : CT.Text; 265 AR : Affected_Rows; 266 begin 267 if cascade and then driver.dialect = driver_mysql 268 then 269 driver.log_nominal (category => note, message => 270 CT.SUS ("Requested CASCADE has no effect on MySQL")); 271 end if; 272 case when_exists is 273 when True => sql := CT.SUS ("DROP TABLE IF EXISTS " & tables); 274 when False => sql := CT.SUS ("DROP TABLE " & tables); 275 end case; 276 if cascade then 277 CT.SU.Append (Source => sql, New_Item => " CASCADE"); 278 end if; 279 AR := execute (driver => Base_Driver'Class (driver), 280 sql => CT.USS (sql)); 281 end query_drop_table; 282 283 284 ------------------ 285 -- disconnect -- 286 ------------------ 287 overriding 288 procedure disconnect (driver : out Base_Driver) 289 is 290 msg : constant CT.Text := 291 CT.SUS ("Disconnect From " & CT.USS (driver.database) & "database"); 292 err : constant CT.Text := 293 CT.SUS ("ACK! Disconnect attempted on inactive connection"); 294 begin 295 if driver.connection_active then 296 driver.connection.disconnect; 297 driver.connection_active := False; 298 299 driver.log_nominal (category => disconnecting, 300 message => msg); 301 else 302 -- Non-fatal attempt to disconnect db when none is connected 303 driver.log_problem (category => disconnecting, 304 message => err); 305 end if; 306 end disconnect; 307 308 309 ---------------- 310 -- rollback -- 311 ---------------- 312 overriding 313 procedure rollback (driver : Base_Driver) 314 is 315 use type Trax_Isolation; 316 err1 : constant CT.Text := 317 CT.SUS ("ACK! Rollback attempted on inactive connection"); 318 err2 : constant CT.Text := 319 CT.SUS ("ACK! Rollback attempted when autocommit mode set on"); 320 err3 : constant CT.Text := 321 CT.SUS ("Rollback attempt failed"); 322 msg1 : constant CT.Text := CT.SUS ("ROLLBACK TRANSACTION"); 323 begin 324 if not driver.connection_active then 325 -- Non-fatal attempt to roll back when no database is connected 326 driver.log_problem (category => miscellaneous, 327 message => err1); 328 return; 329 end if; 330 if driver.connection.autoCommit then 331 -- Non-fatal attempt to roll back when autocommit is on 332 driver.log_problem (category => miscellaneous, 333 message => err2); 334 return; 335 end if; 336 driver.connection.rollback; 337 driver.log_nominal (category => transaction, message => msg1); 338 exception 339 when others => 340 driver.log_problem (category => miscellaneous, 341 message => err3, 342 pull_codes => True); 343 end rollback; 344 345 346 -------------- 347 -- commit -- 348 -------------- 349 overriding 350 procedure commit (driver : Base_Driver) 351 is 352 use type Trax_Isolation; 353 err1 : constant CT.Text := 354 CT.SUS ("ACK! Commit attempted on inactive connection"); 355 err2 : constant CT.Text := 356 CT.SUS ("ACK! Commit attempted when autocommit mode set on"); 357 err3 : constant CT.Text := CT.SUS ("Commit attempt failed"); 358 msg1 : constant CT.Text := CT.SUS ("END TRANSACTION (COMMIT)"); 359 begin 360 if not driver.connection_active then 361 -- Non-fatal attempt to commit when no database is connected 362 driver.log_problem (category => transaction, message => err1); 363 return; 364 end if; 365 if driver.connection.autoCommit then 366 -- Non-fatal attempt to commit when autocommit is on 367 driver.log_problem (category => transaction, message => err2); 368 return; 369 end if; 370 driver.connection.commit; 371 driver.log_nominal (category => transaction, message => msg1); 372 exception 373 when others => 374 driver.log_problem (category => transaction, 375 message => err3, 376 pull_codes => True); 377 end commit; 378 379 380 ------------------------ 381 -- last_driver_code -- 382 ------------------------ 383 overriding 384 function last_sql_state (driver : Base_Driver) return SQL_State is 385 begin 386 return driver.connection.SqlState; 387 end last_sql_state; 388 389 390 ------------------------ 391 -- last_driver_code -- 392 ------------------------ 393 overriding 394 function last_driver_code (driver : Base_Driver) return Driver_Codes is 395 begin 396 return driver.connection.driverCode; 397 end last_driver_code; 398 399 400 --------------------------- 401 -- last_driver_message -- 402 --------------------------- 403 overriding 404 function last_driver_message (driver : Base_Driver) return String is 405 begin 406 return driver.connection.driverMessage; 407 end last_driver_message; 408 409 410 ---------------------- 411 -- last_insert_id -- 412 ---------------------- 413 overriding 414 function last_insert_id (driver : Base_Driver) return Trax_ID is 415 begin 416 return driver.connection.lastInsertID; 417 end last_insert_id; 418 419 420 ------------------------------------------------------------------------ 421 -- PUBLIC ROUTINES NOT COVERED BY INTERFACES -- 422 ------------------------------------------------------------------------ 423 424 ------------------------ 425 -- basic_connect #1 -- 426 ------------------------ 427 overriding 428 procedure basic_connect (driver : out Base_Driver; 429 database : String; 430 username : String := blankstring; 431 password : String := blankstring; 432 socket : String := blankstring) 433 is 434 begin 435 private_connect (driver => Base_Driver'Class (driver), 436 database => database, 437 username => username, 438 password => password, 439 socket => socket); 440 end basic_connect; 441 442 443 ------------------------ 444 -- basic_connect #2 -- 445 ------------------------ 446 overriding 447 procedure basic_connect (driver : out Base_Driver; 448 database : String; 449 username : String := blankstring; 450 password : String := blankstring; 451 hostname : String := blankstring; 452 port : Posix_Port) 453 is 454 begin 455 private_connect (driver => Base_Driver'Class (driver), 456 database => database, 457 username => username, 458 password => password, 459 hostname => hostname, 460 port => port); 461 end basic_connect; 462 463 464 ----------------------------------------------------------------------- 465 -- PRIVATE ROUTINES NOT COVERED BY INTERFACES -- 466 ------------------------------------------------------------------------ 467 468 ------------------ 469 -- log_nominal -- 470 ------------------ 471 procedure log_nominal (driver : Base_Driver; 472 category : Log_Category; 473 message : CT.Text) 474 is 475 begin 476 logger.log_nominal (driver => driver.dialect, 477 category => category, 478 message => message); 479 end log_nominal; 480 481 482 ------------------ 483 -- log_problem -- 484 ------------------ 485 procedure log_problem 486 (driver : Base_Driver; 487 category : Log_Category; 488 message : CT.Text; 489 pull_codes : Boolean := False; 490 break : Boolean := False) 491 is 492 error_msg : CT.Text := CT.blank; 493 error_code : Driver_Codes := 0; 494 sqlstate : SQL_State := stateless; 495 begin 496 if pull_codes then 497 error_msg := CT.SUS (driver.connection.driverMessage); 498 error_code := driver.connection.driverCode; 499 sqlstate := driver.connection.SqlState; 500 end if; 501 502 logger.log_problem (driver => driver.dialect, 503 category => category, 504 message => message, 505 error_msg => error_msg, 506 error_code => error_code, 507 sqlstate => sqlstate, 508 break => break); 509 end log_problem; 510 511 512 ------------------------------ 513 -- assembly_common_select -- 514 ------------------------------ 515 function assembly_common_select (distinct : Boolean; 516 tables : String; 517 columns : String; 518 conditions : String; 519 groupby : String; 520 having : String; 521 order : String) return String 522 is 523 function proc_distinct (given : Boolean) return String; 524 function proc_conditions (given : String) return String; 525 function proc_groupby (given : String) return String; 526 function proc_having (given : String) return String; 527 function proc_order (given : String) return String; 528 529 function proc_distinct (given : Boolean) return String is 530 begin 531 if given then 532 return "DISTINCT "; 533 end if; 534 return "ALL "; 535 end proc_distinct; 536 function proc_conditions (given : String) return String is 537 begin 538 if CT.IsBlank (given) then 539 return blankstring; 540 end if; 541 return " WHERE " & given; 542 end proc_conditions; 543 function proc_groupby (given : String) return String is 544 begin 545 if CT.IsBlank (given) then 546 return blankstring; 547 end if; 548 return " GROUP BY " & given; 549 end proc_groupby; 550 function proc_having (given : String) return String is 551 begin 552 if CT.IsBlank (given) then 553 return blankstring; 554 end if; 555 return " HAVING " & given; 556 end proc_having; 557 function proc_order (given : String) return String is 558 begin 559 if CT.IsBlank (given) then 560 return blankstring; 561 end if; 562 return " ORDER BY " & given; 563 end proc_order; 564 begin 565 return "SELECT " & proc_distinct (distinct) & columns & 566 " FROM " & tables & 567 proc_conditions (conditions) & 568 proc_groupby (groupby) & 569 proc_having (having) & 570 proc_order (order); 571 end assembly_common_select; 572 573end AdaBase.Driver.Base; 574