src/db-sqlite.adb

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