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 Interfaces.C.Strings;
  23 with System;
  24
  25 with Morzhol.Logs;
  26
  27 package body DB.SQLite is
  28
  29    use Morzhol;
  30    use Interfaces.C;
  31
  32    Module : constant Logs.Module_Name := "DB_SQLITE";
  33
  34    Unique_Handle : sqlite3_h.Handle_Access := null;
  35    --  Unique handle to use when we want to use in memory connection
  36
  37    procedure Check_Result
  38      (Routine   : in String;
  39       Result    : in int;
  40       Error_Msg : in Strings.chars_ptr := Strings.Null_Ptr);
  41    --  Check result, raises and exception if it is an error code
  42
  43    procedure Step_Internal (Iter : in out Iterator);
  44    --  Advance to the next row and set Iter.More
  45
  46    --  Thread safe access to the SQLite database
  47
  48    protected SQLite_Safe is
  49
  50       procedure Close
  51         (DB : in out Handle; Result : out int);
  52       --  Close the database
  53
  54       procedure Exec
  55         (DB     : in Handle;
  56          SQL    : in String);
  57       --  Execute an SQL statement
  58       --  Raise DB_Error is case of failure
  59
  60       procedure Open
  61         (DB     : in out Handle;
  62          Name   : in     String;
  63          Result :    out int);
  64       --  Open the database
  65
  66       function Prepare_Select
  67         (DB   : in Handle;
  68          Iter : in Standard.DB.Iterator'Class;
  69          SQL  : in String) return Standard.DB.Iterator'Class;
  70       --  Prepare a select statement
  71
  72    end SQLite_Safe;
  73
  74    -----------------------
  75    -- Begin_Transaction --
  76    -----------------------
  77
  78    overriding procedure Begin_Transaction (DB : in Handle) is
  79    begin
  80       Logs.Write (Module, "begin");
  81       Execute (DB, "begin");
  82    end Begin_Transaction;
  83
  84    ------------------
  85    -- Check_Result --
  86    ------------------
  87
  88    procedure Check_Result
  89      (Routine   : in String;
  90       Result    : in int;
  91       Error_Msg : in Strings.chars_ptr := Strings.Null_Ptr)
  92    is
  93       use type sqlite3_h.sqlite_result;
  94
  95       DB_Result : sqlite3_h.sqlite_result;
  96       for DB_Result'Address use Result'Address;
  97
  98       function Error_Message return String;
  99       --  Returns and free Error_Msg content if not null
 100
 101       -------------------
 102       -- Error_Message --
 103       -------------------
 104
 105       function Error_Message return String is
 106          use type Strings.chars_ptr;
 107       begin
 108          if Error_Msg = Strings.Null_Ptr then
 109             return "";
 110          else
 111             Free : declare
 112                V : constant String := Strings.Value (Error_Msg);
 113             begin
 114                sqlite3_h.sqlite3_free (Error_Msg'Address);
 115                return V;
 116             end Free;
 117          end if;
 118       end Error_Message;
 119
 120    begin
 121       if not DB_Result'Valid then
 122          Logs.Write
 123            (Name    => Module,
 124             Kind    => Logs.Error,
 125             Content => "SQLite3 has return an unknown result in !" & Routine);
 126          raise DB_Error with "SQlite: Error (Unknown Error) in " & Routine;
 127       end if;
 128
 129       if DB_Result /= sqlite3_h.SQLITE_OK then
 130          Logs.Write
 131            (Name    => Module,
 132             Kind    => Logs.Error,
 133             Content => Logs.NV
 134               ("Return_Value", sqlite3_h.sqlite_result'Image (DB_Result))
 135             & ", " & Logs.NV ("routine", Routine)
 136             & ", " & Logs.NV ("message", Error_Message));
 137          raise DB_Error
 138            with "SQLite: Error "
 139              & sqlite3_h.sqlite_result'Image (DB_Result) & " in " & Routine;
 140       end if;
 141    end Check_Result;
 142
 143    -----------
 144    -- Close --
 145    -----------
 146
 147    overriding procedure Close (DB : in out Handle) is
 148       Result : int;
 149    begin
 150       Logs.Write (Module, "close");
 151       SQLite_Safe.Close (DB, Result);
 152       Check_Result ("close", Result);
 153    end Close;
 154
 155    ------------
 156    -- Commit --
 157    ------------
 158
 159    overriding procedure Commit (DB : in Handle) is
 160    begin
 161       Logs.Write (Module, "commit");
 162       Execute (DB, "commit");
 163    end Commit;
 164
 165    -------------
 166    -- Connect --
 167    -------------
 168
 169    overriding procedure Connect
 170      (DB       : in out Handle;
 171       Name     : in     String;
 172       User     : in     String := "";
 173       Password : in     String := "")
 174    is
 175       pragma Unreferenced (User, Password);
 176       use type sqlite3_h.Handle_Access;
 177
 178       Result : int;
 179    begin
 180       Logs.Write (Module, "connect " & Logs.NV ("Name", Name));
 181       SQLite_Safe.Open (DB, Name, Result);
 182       Check_Result ("connect", Result);
 183    end Connect;
 184
 185    ----------------
 186    -- End_Select --
 187    ----------------
 188
 189    overriding procedure End_Select (Iter : in out Iterator) is
 190    begin
 191       Logs.Write (Module, "end_select");
 192       Check_Result ("end_select_reset",
 193                     sqlite3_h.sqlite3_reset (Iter.S.all'Address));
 194       Check_Result ("end_select",
 195                     sqlite3_h.sqlite3_finalize (Iter.S.all'Address));
 196    end End_Select;
 197
 198    -------------
 199    -- Execute --
 200    -------------
 201
 202    overriding procedure Execute (DB : in Handle; SQL : in String) is
 203    begin
 204       Logs.Write (Module, "execute : " & Logs.NV ("SQL", SQL));
 205       SQLite_Safe.Exec (DB, SQL);
 206    exception
 207       when DB_Error =>
 208          raise DB_Error with "DB_Error on Execute " & SQL;
 209    end Execute;
 210
 211    --------------
 212    -- Get_Line --
 213    --------------
 214
 215    overriding procedure Get_Line
 216      (Iter   : in out Iterator;
 217       Result :    out String_Vectors.Vector)
 218    is
 219    begin
 220       Result.Clear;
 221       for K in 0 .. Iter.Col - 1 loop
 222          declare
 223             Text : constant Strings.chars_ptr :=
 224                      sqlite3_h.sqlite3_column_text (Iter.S.all'Address, K);
 225             use type Strings.chars_ptr;
 226          begin
 227             if Text /= Strings.Null_Ptr then
 228                String_Vectors.Append
 229                  (Result,
 230                   Interfaces.C.Strings.Value (Text));
 231             else
 232                String_Vectors.Append (Result, "");
 233             end if;
 234          end;
 235       end loop;
 236
 237       Step_Internal (Iter);
 238    end Get_Line;
 239
 240    -----------------------
 241    -- Last_Insert_Rowid --
 242    -----------------------
 243
 244    overriding function Last_Insert_Rowid (DB : in Handle) return String is
 245       Rowid : constant String :=
 246                 sqlite3_h.sqlite_int64'Image
 247                   (sqlite3_h.sqlite3_last_insert_rowid (DB.H.all'Address));
 248    begin
 249       --  Skip first whitespace returned by 'Image
 250       return Rowid (Rowid'First + 1 .. Rowid'Last);
 251    end Last_Insert_Rowid;
 252
 253    ----------
 254    -- More --
 255    ----------
 256
 257    overriding function More (Iter : in Iterator) return Boolean is
 258    begin
 259       return Iter.More;
 260    end More;
 261
 262    --------------------
 263    -- Prepare_Select --
 264    --------------------
 265
 266    overriding procedure Prepare_Select
 267      (DB   : in     Handle;
 268       Iter : in out Standard.DB.Iterator'Class;
 269       SQL  : in     String)
 270    is
 271    begin
 272       Iter := SQLite_Safe.Prepare_Select (DB, Iter, SQL);
 273    end Prepare_Select;
 274
 275    --------------
 276    -- Rollback --
 277    --------------
 278
 279    overriding procedure Rollback (DB : in Handle) is
 280    begin
 281       Logs.Write (Module, "rollback");
 282       Execute (DB, "rollback");
 283    end Rollback;
 284
 285    -----------------
 286    -- SQLite_Safe --
 287    -----------------
 288
 289    protected body SQLite_Safe is
 290
 291       -----------
 292       -- Close --
 293       -----------
 294
 295       procedure Close
 296         (DB : in out Handle; Result : out int) is
 297       begin
 298          if DB.Ref_Count /= 0 then
 299             DB.Ref_Count := DB.Ref_Count - 1;
 300             Result := 0; --  SQLite3_OK;
 301          else
 302             Result := sqlite3_h.sqlite3_close (DB.H.all'Address);
 303          end if;
 304       end Close;
 305
 306       ----------
 307       -- Exec --
 308       ----------
 309
 310       procedure Exec
 311         (DB : in Handle; SQL : in String) is
 312          SQL_Stat : Strings.chars_ptr := Strings.New_String (SQL);
 313          Result    : int;
 314          Error_Msg : Strings.chars_ptr;
 315       begin
 316          Result := sqlite3_h.sqlite3_exec_no_callback
 317            (DB.H.all'Address, SQL_Stat, System.Null_Address,
 318             System.Null_Address, Error_Msg'Address);
 319
 320          Check_Result ("Execute", Result, Error_Msg);
 321
 322          --  Free
 323          Strings.Free (SQL_Stat);
 324       end Exec;
 325
 326       ----------
 327       -- Open --
 328       ----------
 329
 330       procedure Open
 331         (DB     : in out Handle;
 332          Name   : in     String;
 333          Result :    out int) is
 334
 335          procedure Open_Db;
 336          --  Open a database connection
 337
 338          -------------
 339          -- Open_Db --
 340          -------------
 341
 342          procedure Open_Db is
 343             SQL_Name : Strings.chars_ptr := Strings.New_String (Name);
 344          begin
 345             Result := sqlite3_h.sqlite3_open (SQL_Name, DB.H'Address);
 346             Strings.Free (SQL_Name);
 347          end Open_Db;
 348
 349          use type sqlite3_h.Handle_Access;
 350       begin
 351          if Name = In_Memory_Database then
 352             if Unique_Handle = null then
 353                --  Open only one database connection !
 354                Open_Db;
 355                Unique_Handle := DB.H;
 356
 357             elsif DB.H = null then
 358                --  Get the open database connection
 359                DB.H   := Unique_Handle;
 360                Result := 0; --  SQLite_OK
 361
 362                --  Increment the reference counter
 363                DB.Ref_Count := DB.Ref_Count + 1;
 364             end if;
 365
 366          else
 367             Open_Db;
 368          end if;
 369       end Open;
 370
 371       --------------------
 372       -- Prepare_Select --
 373       --------------------
 374
 375       function Prepare_Select
 376         (DB   : in Handle;
 377          Iter : in Standard.DB.Iterator'Class;
 378          SQL  : in String) return Standard.DB.Iterator'Class
 379       is
 380          Select_Iter : Standard.DB.Iterator'Class := Iter;
 381          zSql        : Strings.chars_ptr := Strings.New_String (SQL);
 382          Select_Res  : int;
 383       begin
 384          pragma Assert (Select_Iter in Iterator);
 385
 386          Logs.Write
 387            (Module, "prepare select : " & Logs.NV ("SQL", SQL));
 388
 389          Iterator (Select_Iter).H := DB;
 390          Iterator (Select_Iter).More := False;
 391
 392          Select_Res := sqlite3_h.sqlite3_prepare_v2
 393               (db     => DB.H.all'Address,
 394                zSql   => zSql,
 395                nByte  => SQL'Length + 1,
 396                ppStmt => Iterator (Select_Iter).S'Address,
 397                pzTail => System.Null_Address);
 398
 399          Check_Result ("prepare_select", Select_Res);
 400
 401          Column_Count : declare
 402             use type sqlite3_h.sqlite_result;
 403
 404             DB_Result : sqlite3_h.sqlite_result;
 405             for DB_Result'Address use Select_Res'Address;
 406          begin
 407             if DB_Result = sqlite3_h.SQLITE_DONE then
 408                Iterator (Select_Iter).Col := 0;
 409             else
 410                Iterator (Select_Iter).Col :=
 411                  sqlite3_h.Sqlite3_Column_Count
 412                    (Iterator (Select_Iter).S.all'Address);
 413                Step_Internal (Iterator (Select_Iter));
 414             end if;
 415          end Column_Count;
 416
 417          Strings.Free (zSql);
 418          return Select_Iter;
 419       end Prepare_Select;
 420    end SQLite_Safe;
 421
 422    -------------------
 423    -- Step_Internal --
 424    -------------------
 425
 426    procedure Step_Internal (Iter : in out Iterator) is
 427       R : int;
 428    begin
 429       R := sqlite3_h.sqlite3_step (Iter.S.all'Address);
 430
 431       Analyse_Result : declare
 432          Result : sqlite3_h.sqlite_result;
 433          for Result'Address use R'Address;
 434
 435          use type sqlite3_h.sqlite_result;
 436       begin
 437          if not Result'Valid then
 438             raise DB_Error with "Wrong result from sqlite3_step ?";
 439          else
 440             if Result = sqlite3_h.SQLITE_DONE then
 441                Iter.More := False;
 442             elsif Result = sqlite3_h.SQLITE_ROW then
 443                Iter.More := True;
 444             else
 445                Check_Result ("step_internal", R);
 446                Iter.More := False;
 447             end if;
 448          end if;
 449       end Analyse_Result;
 450    end Step_Internal;
 451
 452 begin
 453    --  sqlite3_initialize is present only in very recent SQLite3
 454    --  versions and it is safe to disable the call for now
 455    --  Check_Result ("initialize", sqlite3_h.sqlite3_initialize);
 456    null;
 457 end DB.SQLite;