src/db-sqlite.adb

   1 ------------------------------------------------------------------------------
   2 --                                GnadeLite                                 --
   3 --                                                                          --
   4 --                         Copyright (C) 2006-2008                          --
   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 ------------------------------------------------------------------------------
  21
  22 with Ada.Unchecked_Deallocation;
  23
  24 with Morzhol.Logs;
  25
  26 package body DB.SQLite is
  27
  28    use GNU.DB;
  29    use Morzhol;
  30
  31    Module : constant Logs.Module_Name := "DB_SQLITE";
  32
  33    Unique_Handle : SQLite3.Handle := null;
  34    --  Unique handle to use when we want to use in memory connection
  35
  36    procedure Unchecked_Free is new Unchecked_Deallocation
  37      (Object => SQLite3.Object, Name => SQLite3.Handle);
  38
  39    procedure Check_Result
  40      (Routine : in String;
  41       Result  : in SQLite3.Return_Value);
  42    pragma Inline (Check_Result);
  43    --  Check result, raises and exception if it is an error code
  44
  45    procedure Step_Internal (Iter : in out Iterator);
  46    --  Advance to the next row and set Iter.More
  47
  48    protected SQLite_Safe is
  49       procedure Close
  50         (DB : in Handle; Result : out Sqlite3.Return_Value);
  51       --  Close the database
  52
  53       procedure Exec
  54         (DB : in Handle; SQL : in String; Result : out Sqlite3.Return_Value);
  55       --  Execute an SQL statement
  56
  57       procedure Open
  58         (DB : in Handle; Name : in String; Result : out Sqlite3.Return_Value);
  59       --  Open the database
  60
  61       procedure Prepare_Select
  62         (DB   : in     Handle;
  63          Iter : in out Standard.DB.Iterator'Class;
  64          SQL  : in     String);
  65       --  Prepare a select statement
  66    end SQLite_Safe;
  67
  68    -----------------------
  69    -- Begin_Transaction --
  70    -----------------------
  71
  72    overriding procedure Begin_Transaction (DB : in Handle) is
  73    begin
  74       Logs.Write (Module, "begin");
  75       Execute (DB, "begin");
  76    end Begin_Transaction;
  77
  78    ------------------
  79    -- Check_Result --
  80    ------------------
  81
  82    procedure Check_Result
  83      (Routine : in String;
  84       Result  : in SQLite3.Return_Value)
  85    is
  86       use type SQLite3.Return_Value;
  87    begin
  88       if Result /= SQLite3.SQLITE_OK then
  89          Logs.Write
  90            (Name    => Module,
  91             Kind    => Logs.Error,
  92             Content => Logs.NV
  93               ("Return_Value", SQLite3.Return_Value'Image (Result))
  94               & ", " & Logs.NV ("routine", Routine));
  95          raise DB_Error
  96            with "SQLite: Error " & SQLite3.Return_Value'Image (Result) &
  97              " in " & Routine;
  98       end if;
  99    end Check_Result;
 100
 101    -----------
 102    -- Close --
 103    -----------
 104
 105    overriding procedure Close (DB : in out Handle) is
 106      Result : Sqlite3.Return_Value;
 107    begin
 108       Logs.Write (Module, "close");
 109       SQLite_Safe.Close (DB, Result);
 110       Check_Result ("close", Result);
 111       Unchecked_Free (DB.H);
 112    end Close;
 113
 114    ------------
 115    -- Commit --
 116    ------------
 117
 118    overriding procedure Commit (DB : in Handle) is
 119    begin
 120       Logs.Write (Module, "commit");
 121       Execute (DB, "commit");
 122    end Commit;
 123
 124    -------------
 125    -- Connect --
 126    -------------
 127
 128    overriding procedure Connect
 129      (DB       : in out Handle;
 130       Name     : in     String;
 131       User     : in     String := "";
 132       Password : in     String := "")
 133    is
 134       pragma Unreferenced (User, Password);
 135       use type GNU.DB.SQLite3.Handle;
 136
 137       Result : Sqlite3.Return_Value;
 138    begin
 139       Logs.Write
 140         (Module, "connect " & Logs.NV ("Name", Name));
 141       if Name = In_Memory_Database then
 142          if Unique_Handle = null then
 143
 144             --  Open only one database connection !
 145
 146             Unique_Handle := new GNU.DB.SQLite3.Object;
 147             DB.H := Unique_Handle;
 148             SQLite_Safe.Open (DB, Name, Result);
 149             Check_Result ("connect", Result);
 150
 151          elsif DB.H = null then
 152             --  Get the open database connection
 153             DB.H := Unique_Handle;
 154          end if;
 155       else
 156          if DB.H = null then
 157             DB.H := new GNU.DB.SQLite3.Object;
 158          end if;
 159
 160          SQLite_Safe.Open (DB, Name, Result);
 161          Check_Result ("connect", Result);
 162       end if;
 163    end Connect;
 164
 165    ----------------
 166    -- End_Select --
 167    ----------------
 168
 169    overriding procedure End_Select (Iter : in out Iterator) is
 170    begin
 171       Logs.Write (Module, "end_select");
 172       Check_Result ("end_select", SQLite3.finalize (Iter.S'Unchecked_Access));
 173    end End_Select;
 174
 175    -------------
 176    -- Execute --
 177    -------------
 178
 179    overriding procedure Execute (DB : in Handle; SQL : in String) is
 180      Result : SQLite3.Return_Value;
 181    begin
 182       Logs.Write
 183         (Module, "execute : " & Logs.NV ("SQL", SQL));
 184       SQLite_Safe.Exec (DB, SQL, Result);
 185       Check_Result ("execute", Result);
 186    exception
 187       when DB_Error =>
 188          raise DB_Error with "DB_Error on Execute " & SQL;
 189    end Execute;
 190
 191    --------------
 192    -- Get_Line --
 193    --------------
 194
 195    overriding procedure Get_Line
 196      (Iter   : in out Iterator;
 197       Result :    out String_Vectors.Vector)
 198    is
 199       use type SQLite3.Return_Value;
 200    begin
 201       for K in 0 .. Iter.Col - 1 loop
 202          String_Vectors.Append
 203            (Result, SQLite3.column_text (Iter.S'Unchecked_Access, K));
 204       end loop;
 205
 206       Step_Internal (Iter);
 207    end Get_Line;
 208
 209    -----------------------
 210    -- Last_Insert_Rowid --
 211    -----------------------
 212
 213    overriding function Last_Insert_Rowid (DB : in Handle) return String is
 214      Rowid : constant String :=
 215                  SQLite3.uint64'Image (SQLite3.Last_Insert_Rowid (DB.H));
 216    begin
 217       --  Skip first whitespace returned by 'Image
 218       return Rowid (Rowid'First + 1 .. Rowid'Last);
 219    end Last_Insert_Rowid;
 220
 221    ----------
 222    -- More --
 223    ----------
 224
 225    overriding function More (Iter : in Iterator) return Boolean is
 226    begin
 227       return Iter.More;
 228    end More;
 229
 230    --------------------
 231    -- Prepare_Select --
 232    --------------------
 233
 234    overriding procedure Prepare_Select
 235      (DB   : in     Handle;
 236       Iter : in out Standard.DB.Iterator'Class;
 237       SQL  : in     String)
 238    is
 239       use type SQLite3.Statement_Reference;
 240    begin
 241       SQLite_Safe.Prepare_Select (DB, Iter, SQL);
 242    end Prepare_Select;
 243
 244    --------------
 245    -- Rollback --
 246    --------------
 247
 248    overriding procedure Rollback (DB : in Handle) is
 249    begin
 250       Logs.Write (Module, "rollback");
 251       Execute (DB, "rollback");
 252    end Rollback;
 253
 254    -----------------
 255    -- SQLite_Safe --
 256    -----------------
 257
 258    protected body SQLite_Safe is
 259
 260       -----------
 261       -- Close --
 262       -----------
 263
 264       procedure Close
 265         (DB : in Handle; Result : out Sqlite3.Return_Value) is
 266       begin
 267          Result := SQLite3.Close (DB.H);
 268       end Close;
 269
 270       ----------
 271       -- Exec --
 272       ----------
 273
 274       procedure Exec
 275         (DB : in Handle; SQL : in String; Result : out Sqlite3.Return_Value) is
 276       begin
 277          Result := SQLite3.Exec (DB.H, SQL);
 278       end Exec;
 279
 280       ----------
 281       -- Open --
 282       ----------
 283
 284       procedure Open
 285         (DB : in Handle; Name : in String; Result : out Sqlite3.Return_Value) is
 286       begin
 287          Result := SQLite3.Open (DB.H, Name);
 288       end Open;
 289
 290       --------------------
 291       -- Prepare_Select --
 292       --------------------
 293
 294       procedure Prepare_Select
 295         (DB   : in     Handle;
 296          Iter : in out Standard.DB.Iterator'Class;
 297          SQL  : in     String)
 298       is
 299          use type SQLite3.Statement_Reference;
 300       begin
 301          pragma Assert (Iter in Iterator);
 302          Logs.Write
 303            (Module, "prepare select : " & Logs.NV ("SQL", SQL));
 304
 305          Iterator (Iter).H := DB;
 306          Iterator (Iter).More := False;
 307
 308          Check_Result
 309            ("prepare_select",
 310             SQLite3.prepare (DB.H, SQL, Iterator (Iter).S'Unchecked_Access));
 311
 312          Iterator (Iter).Col :=
 313            SQLite3.column_count (Iterator (Iter).S'Unchecked_Access);
 314
 315          Step_Internal (Iterator (Iter));
 316       end Prepare_Select;
 317    end SQLite_Safe;
 318
 319    -------------------
 320    -- Step_Internal --
 321    -------------------
 322
 323    procedure Step_Internal (Iter : in out Iterator) is
 324       use type SQLite3.Return_Value;
 325       R : SQLite3.Return_Value;
 326    begin
 327       R := SQLite3.step (Iter.S'Unchecked_Access);
 328
 329       if R = SQLite3.SQLITE_DONE then
 330          Iter.More := False;
 331       elsif R = SQLite3.SQLITE_ROW then
 332          Iter.More := True;
 333       else
 334          Check_Result ("step_internal", R);
 335          Iter.More := False;
 336       end if;
 337    end Step_Internal;
 338
 339 end DB.SQLite;