Remove unneeded with statements
[gnadelite.git] / src / db-sqlite.adb
blob8092abdabcb7f9cbfc6e8bbe43cb68a0d6ee1221
1 ------------------------------------------------------------------------------
2 -- GnadeLite --
3 -- --
4 -- Copyright (C) 2006-2010 --
5 -- Pascal Obry - Olivier Ramonat --
6 -- --
7 -- This library is free software; you can redistribute it and/or modify --
8 -- it under the terms of the GNU General Public License as published by --
9 -- the Free Software Foundation; either version 2 of the License, or (at --
10 -- your option) any later version. --
11 -- --
12 -- This library is distributed in the hope that it will be useful, but --
13 -- WITHOUT ANY WARRANTY; without even the implied warranty of --
14 -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
15 -- General Public License for more details. --
16 -- --
17 -- You should have received a copy of the GNU General Public License --
18 -- along with this library; if not, write to the Free Software Foundation, --
19 -- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. --
20 ------------------------------------------------------------------------------
22 with Ada.Unchecked_Conversion;
23 with Interfaces.C.Strings;
24 with System;
26 with Morzhol.Logs;
28 package body DB.SQLite is
30 use Morzhol;
31 use Interfaces.C;
32 use type sqlite3_h.Handle_Access;
34 Module : constant Logs.Module_Name := "DB_SQLITE";
36 Unique_Handle : sqlite3_h.Handle_Access := null;
37 -- Unique handle to use when we want to use in memory connection
39 SQLite_Busy : exception;
40 -- Exception raised by SQLite when the database is locked
42 procedure Check_Result
43 (Routine : in String;
44 Result : in int;
45 Error_Msg : in Strings.chars_ptr := Strings.Null_Ptr);
46 -- Check result, raises an exception if it is an error code
48 procedure Step_Internal (Iter : in out Iterator);
49 -- Advance to the next row and set Iter.More
51 -- Thread safe access to the SQLite database
53 protected SQLite_Safe is
55 procedure Close
56 (DB : in out Handle; Result : out int);
57 -- Close the database
58 pragma Precondition (DB.H /= null);
60 procedure Exec
61 (DB : in Handle;
62 SQL : in String);
63 -- Execute an SQL statement
64 -- Raise DB_Error is case of failure
65 pragma Precondition (SQL /= "");
66 pragma Precondition (DB.H /= null);
67 pragma Postcondition (DB.H /= null);
69 procedure Open
70 (DB : in out Handle;
71 Name : in String;
72 Result : out int);
73 -- Open the database
74 pragma Precondition (Name /= "");
76 function Prepare_Select
77 (DB : in Handle;
78 Iter : in Standard.DB.Iterator'Class;
79 SQL : in String) return Standard.DB.Iterator'Class;
80 -- Prepare a select statement
81 pragma Precondition (SQL /= "");
82 pragma Precondition (DB.H /= null);
83 pragma Postcondition (DB.H /= null);
85 end SQLite_Safe;
87 -----------------------
88 -- Begin_Transaction --
89 -----------------------
91 overriding procedure Begin_Transaction (DB : in Handle) is
92 begin
93 Logs.Write (Module, "begin");
94 Execute (DB, "begin");
95 end Begin_Transaction;
97 ------------------
98 -- Check_Result --
99 ------------------
101 procedure Check_Result
102 (Routine : in String;
103 Result : in int;
104 Error_Msg : in Strings.chars_ptr := Strings.Null_Ptr)
106 use System;
107 use type sqlite3_h.sqlite_result;
109 DB_Result : sqlite3_h.sqlite_result;
110 for DB_Result'Address use Result'Address;
112 function To_Address is
113 new Unchecked_Conversion (Strings.chars_ptr, Address);
115 function Error_Message return String;
116 -- Returns and free Error_Msg content if not null
118 -------------------
119 -- Error_Message --
120 -------------------
122 function Error_Message return String is
123 use type Strings.chars_ptr;
124 begin
125 if Error_Msg = Strings.Null_Ptr then
126 return "";
128 else
129 Free : declare
130 V : constant String := Strings.Value (Error_Msg);
131 begin
132 sqlite3_h.sqlite3_free (To_Address (Error_Msg));
133 return V;
134 end Free;
135 end if;
136 end Error_Message;
138 begin
139 if not DB_Result'Valid then
140 Logs.Write
141 (Name => Module,
142 Kind => Logs.Error,
143 Content => "SQLite3 has return an unknown result in !" & Routine);
144 raise DB_Error with "SQlite: Error (Unknown Error) in " & Routine;
145 end if;
147 if DB_Result = sqlite3_h.SQLITE_BUSY then
148 raise SQLite_Busy;
149 elsif DB_Result /= sqlite3_h.SQLITE_OK then
150 Logs.Write
151 (Name => Module,
152 Kind => Logs.Error,
153 Content => Logs.NV
154 ("Return_Value", sqlite3_h.sqlite_result'Image (DB_Result))
155 & ", " & Logs.NV ("routine", Routine)
156 & ", " & Logs.NV ("message", Error_Message));
157 raise DB_Error
158 with "SQLite: Error "
159 & sqlite3_h.sqlite_result'Image (DB_Result) & " in " & Routine;
160 end if;
161 end Check_Result;
163 -----------
164 -- Close --
165 -----------
167 overriding procedure Close (DB : in out Handle) is
168 Result : int;
169 begin
170 Logs.Write (Module, "close");
171 SQLite_Safe.Close (DB, Result);
172 Check_Result ("close", Result);
173 end Close;
175 ------------
176 -- Commit --
177 ------------
179 overriding procedure Commit (DB : in Handle) is
180 begin
181 Logs.Write (Module, "commit");
182 Execute (DB, "commit");
183 end Commit;
185 -------------
186 -- Connect --
187 -------------
189 overriding procedure Connect
190 (DB : in out Handle;
191 Name : in String;
192 User : in String := "";
193 Password : in String := "")
195 pragma Unreferenced (User, Password);
197 Result : int;
198 begin
199 Logs.Write (Module, "connect " & Logs.NV ("Name", Name));
200 SQLite_Safe.Open (DB, Name, Result);
201 Check_Result ("connect", Result);
202 end Connect;
204 ----------------
205 -- End_Select --
206 ----------------
208 overriding procedure End_Select (Iter : in out Iterator) is
209 begin
210 Logs.Write (Module, "end_select");
211 Check_Result ("end_select_reset",
212 sqlite3_h.sqlite3_reset (Iter.S.all'Address));
213 Check_Result ("end_select",
214 sqlite3_h.sqlite3_finalize (Iter.S.all'Address));
215 end End_Select;
217 -------------
218 -- Execute --
219 -------------
221 overriding procedure Execute (DB : in Handle; SQL : in String) is
222 begin
223 Logs.Write (Module, "execute : " & Logs.NV ("SQL", SQL));
224 SQLite_Safe.Exec (DB, SQL);
225 exception
226 when DB_Error =>
227 raise DB_Error with "DB_Error on Execute " & SQL;
228 end Execute;
230 --------------
231 -- Get_Line --
232 --------------
234 overriding procedure Get_Line
235 (Iter : in out Iterator;
236 Result : out String_Vectors.Vector)
238 begin
239 Result.Clear;
240 for K in 0 .. Iter.Col - 1 loop
241 declare
242 Text : constant Strings.chars_ptr :=
243 sqlite3_h.sqlite3_column_text (Iter.S.all'Address, K);
244 use type Strings.chars_ptr;
245 begin
246 if Text /= Strings.Null_Ptr then
247 String_Vectors.Append
248 (Result,
249 Interfaces.C.Strings.Value (Text));
250 else
251 String_Vectors.Append (Result, "");
252 end if;
253 end;
254 end loop;
256 Step_Internal (Iter);
257 end Get_Line;
259 -----------------------
260 -- Last_Insert_Rowid --
261 -----------------------
263 overriding function Last_Insert_Rowid (DB : in Handle) return String is
264 Rowid : constant String :=
265 sqlite3_h.sqlite_int64'Image
266 (sqlite3_h.sqlite3_last_insert_rowid (DB.H.all'Address));
267 begin
268 -- Skip first whitespace returned by 'Image
269 return Rowid (Rowid'First + 1 .. Rowid'Last);
270 end Last_Insert_Rowid;
272 ----------
273 -- More --
274 ----------
276 overriding function More (Iter : in Iterator) return Boolean is
277 begin
278 return Iter.More;
279 end More;
281 --------------------
282 -- Prepare_Select --
283 --------------------
285 overriding procedure Prepare_Select
286 (DB : in Handle;
287 Iter : in out Standard.DB.Iterator'Class;
288 SQL : in String)
290 begin
291 Iter := SQLite_Safe.Prepare_Select (DB, Iter, SQL);
292 end Prepare_Select;
294 --------------
295 -- Rollback --
296 --------------
298 overriding procedure Rollback (DB : in Handle) is
299 begin
300 Logs.Write (Module, "rollback");
301 Execute (DB, "rollback");
302 end Rollback;
304 -------------------
305 -- Set_Max_Tries --
306 -------------------
308 overriding procedure Set_Max_Tries
309 (DB : in out Handle;
310 Count : in Positive;
311 Retry_Delay : Duration)
313 begin
314 DB.Max_Tries := Count;
315 DB.Retry_Delay := Retry_Delay;
316 end Set_Max_Tries;
318 -----------------
319 -- SQLite_Safe --
320 -----------------
322 protected body SQLite_Safe is
324 -----------
325 -- Close --
326 -----------
328 procedure Close
329 (DB : in out Handle; Result : out int) is
330 begin
331 if DB.Ref_Count /= 0 then
332 DB.Ref_Count := DB.Ref_Count - 1;
333 Result := 0; -- SQLite3_OK;
334 else
335 Result := sqlite3_h.sqlite3_close (DB.H.all'Address);
336 end if;
337 end Close;
339 ----------
340 -- Exec --
341 ----------
343 procedure Exec
344 (DB : in Handle; SQL : in String)
346 SQL_Stat : Strings.chars_ptr := Strings.New_String (SQL);
347 Result : int;
348 Error_Msg : Strings.chars_ptr := Strings.Null_Ptr;
350 Nb_Try : Natural := 0;
351 begin
352 while Nb_Try < DB.Max_Tries loop
353 begin
354 Error_Msg := Strings.Null_Ptr;
355 Result := sqlite3_h.sqlite3_exec_no_callback
356 (DB.H.all'Address, SQL_Stat, System.Null_Address,
357 System.Null_Address, Error_Msg'Address);
358 Check_Result ("Execute", Result, Error_Msg);
359 Strings.Free (SQL_Stat);
360 return;
361 exception
362 when SQLite_Busy =>
363 Nb_Try := Nb_Try + 1;
364 pragma Warnings
365 (Off,
366 "potentially blocking operation in protected operation");
367 -- Add a delay inside Exec to avoid having more SQLITE_BUSY
368 -- errors
369 delay DB.Retry_Delay;
370 pragma Warnings
371 (On,
372 "potentially blocking operation in protected operation");
373 when DB_Error =>
374 Strings.Free (SQL_Stat);
375 raise;
376 end;
377 end loop;
378 Strings.Free (SQL_Stat);
379 raise DB_Error with ("Max tries exceeded");
380 end Exec;
382 ----------
383 -- Open --
384 ----------
386 procedure Open
387 (DB : in out Handle;
388 Name : in String;
389 Result : out int) is
391 procedure Open_Db;
392 -- Open a database connection
394 -------------
395 -- Open_Db --
396 -------------
398 procedure Open_Db is
399 SQL_Name : Strings.chars_ptr := Strings.New_String (Name);
400 begin
401 Result := sqlite3_h.sqlite3_open (SQL_Name, DB.H'Address);
402 Strings.Free (SQL_Name);
403 end Open_Db;
405 begin
406 if Name = In_Memory_Database then
407 if Unique_Handle = null then
408 -- Open only one database connection !
409 Open_Db;
410 Unique_Handle := DB.H;
412 elsif DB.H = null then
413 -- Get the open database connection
414 DB.H := Unique_Handle;
415 Result := 0; -- SQLite_OK
417 -- Increment the reference counter
418 DB.Ref_Count := DB.Ref_Count + 1;
420 else
421 -- Nothing to do. Return OK
422 Result := 0; -- SQLite_OK
423 end if;
425 else
426 Open_Db;
427 end if;
428 end Open;
430 --------------------
431 -- Prepare_Select --
432 --------------------
434 function Prepare_Select
435 (DB : in Handle;
436 Iter : in Standard.DB.Iterator'Class;
437 SQL : in String) return Standard.DB.Iterator'Class
439 Select_Iter : Standard.DB.Iterator'Class := Iter;
440 zSql : Strings.chars_ptr := Strings.New_String (SQL);
441 Select_Res : int;
442 begin
443 pragma Assert (Select_Iter in Iterator);
445 Logs.Write
446 (Module, "prepare select : " & Logs.NV ("SQL", SQL));
448 Iterator (Select_Iter).H := DB;
449 Iterator (Select_Iter).More := False;
451 Select_Res := sqlite3_h.sqlite3_prepare_v2
452 (db => DB.H.all'Address,
453 zSql => zSql,
454 nByte => SQL'Length + 1,
455 ppStmt => Iterator (Select_Iter).S'Address,
456 pzTail => System.Null_Address);
458 Strings.Free (zSql);
460 Check_Result ("prepare_select", Select_Res);
462 Column_Count : declare
463 use type sqlite3_h.sqlite_result;
465 DB_Result : sqlite3_h.sqlite_result;
466 for DB_Result'Address use Select_Res'Address;
467 begin
468 if DB_Result = sqlite3_h.SQLITE_DONE then
469 Iterator (Select_Iter).Col := 0;
470 else
471 Iterator (Select_Iter).Col :=
472 sqlite3_h.sqlite3_column_count
473 (Iterator (Select_Iter).S.all'Address);
474 Step_Internal (Iterator (Select_Iter));
475 end if;
476 end Column_Count;
478 return Select_Iter;
479 end Prepare_Select;
481 end SQLite_Safe;
483 -------------------
484 -- Step_Internal --
485 -------------------
487 procedure Step_Internal (Iter : in out Iterator) is
488 R : int;
489 begin
490 R := sqlite3_h.sqlite3_step (Iter.S.all'Address);
492 Analyse_Result : declare
493 Result : sqlite3_h.sqlite_result;
494 for Result'Address use R'Address;
496 use type sqlite3_h.sqlite_result;
497 begin
498 if not Result'Valid then
499 raise DB_Error with "Wrong result from sqlite3_step ?";
500 else
501 if Result = sqlite3_h.SQLITE_DONE then
502 Iter.More := False;
503 elsif Result = sqlite3_h.SQLITE_ROW then
504 Iter.More := True;
505 else
506 Check_Result ("step_internal", R);
507 Iter.More := False;
508 end if;
509 end if;
510 end Analyse_Result;
511 end Step_Internal;
513 begin
514 -- sqlite3_initialize is present only in very recent SQLite3
515 -- versions and it is safe to disable the call for now
516 -- Check_Result ("initialize", sqlite3_h.sqlite3_initialize);
517 null;
518 end DB.SQLite;