src/db-sqlite.adb

   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 ------------------------------------------------------------------------------
  21
  22 with Ada.Unchecked_Conversion;
  23 with Interfaces.C.Strings;
  24 with System;
  25
  26 with Morzhol.Logs;
  27
  28 package body DB.SQLite is
  29
  30    use Morzhol;
  31    use Interfaces.C;
  32    use type sqlite3_h.Handle_Access;
  33
  34    Module : constant Logs.Module_Name := "DB_SQLITE";
  35
  36    Unique_Handle : sqlite3_h.Handle_Access := null;
  37    --  Unique handle to use when we want to use in memory connection
  38
  39    SQLite_Busy : exception;
  40    --  Exception raised by SQLite when the database is locked
  41
  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
  47
  48    procedure Step_Internal (Iter : in out Iterator);
  49    --  Advance to the next row and set Iter.More
  50
  51    --  Thread safe access to the SQLite database
  52
  53    protected SQLite_Safe is
  54
  55       procedure Close
  56         (DB : in out Handle; Result : out int);
  57       --  Close the database
  58       pragma Precondition (DB.H /= null);
  59
  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);
  68
  69       procedure Open
  70         (DB     : in out Handle;
  71          Name   : in     String;
  72          Result :    out int);
  73       --  Open the database
  74       pragma Precondition (Name /= "");
  75
  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);
  84
  85    end SQLite_Safe;
  86
  87    -----------------------
  88    -- Begin_Transaction --
  89    -----------------------
  90
  91    overriding procedure Begin_Transaction (DB : in Handle) is
  92    begin
  93       Logs.Write (Module, "begin");
  94       Execute (DB, "begin");
  95    end Begin_Transaction;
  96
  97    ------------------
  98    -- Check_Result --
  99    ------------------
 100
 101    procedure Check_Result
 102      (Routine   : in String;
 103       Result    : in int;
 104       Error_Msg : in Strings.chars_ptr := Strings.Null_Ptr)
 105    is
 106       use System;
 107       use type sqlite3_h.sqlite_result;
 108
 109       DB_Result : sqlite3_h.sqlite_result;
 110       for DB_Result'Address use Result'Address;
 111
 112       function To_Address is
 113          new Unchecked_Conversion (Strings.chars_ptr, Address);
 114
 115       function Error_Message return String;
 116       --  Returns and free Error_Msg content if not null
 117
 118       -------------------
 119       -- Error_Message --
 120       -------------------
 121
 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 "";
 127
 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;
 137
 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;
 146
 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;
 162
 163    -----------
 164    -- Close --
 165    -----------
 166
 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;
 174
 175    ------------
 176    -- Commit --
 177    ------------
 178
 179    overriding procedure Commit (DB : in Handle) is
 180    begin
 181       Logs.Write (Module, "commit");
 182       Execute (DB, "commit");
 183    end Commit;
 184
 185    -------------
 186    -- Connect --
 187    -------------
 188
 189    overriding procedure Connect
 190      (DB       : in out Handle;
 191       Name     : in     String;
 192       User     : in     String := "";
 193       Password : in     String := "")
 194    is
 195       pragma Unreferenced (User, Password);
 196
 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;
 203
 204    ----------------
 205    -- End_Select --
 206    ----------------
 207
 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;
 216
 217    -------------
 218    -- Execute --
 219    -------------
 220
 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;
 229
 230    --------------
 231    -- Get_Line --
 232    --------------
 233
 234    overriding procedure Get_Line
 235      (Iter   : in out Iterator;
 236       Result :    out String_Vectors.Vector)
 237    is
 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;
 255
 256       Step_Internal (Iter);
 257    end Get_Line;
 258
 259    -----------------------
 260    -- Last_Insert_Rowid --
 261    -----------------------
 262
 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;
 271
 272    ----------
 273    -- More --
 274    ----------
 275
 276    overriding function More (Iter : in Iterator) return Boolean is
 277    begin
 278       return Iter.More;
 279    end More;
 280
 281    --------------------
 282    -- Prepare_Select --
 283    --------------------
 284
 285    overriding procedure Prepare_Select
 286      (DB   : in     Handle;
 287       Iter : in out Standard.DB.Iterator'Class;
 288       SQL  : in     String)
 289    is
 290    begin
 291       Iter := SQLite_Safe.Prepare_Select (DB, Iter, SQL);
 292    end Prepare_Select;
 293
 294    --------------
 295    -- Rollback --
 296    --------------
 297
 298    overriding procedure Rollback (DB : in Handle) is
 299    begin
 300       Logs.Write (Module, "rollback");
 301       Execute (DB, "rollback");
 302    end Rollback;
 303
 304    -------------------
 305    -- Set_Max_Tries --
 306    -------------------
 307
 308    overriding procedure Set_Max_Tries
 309       (DB          : in out Handle;
 310        Count       : in     Positive;
 311        Retry_Delay :        Duration)
 312    is
 313    begin
 314       DB.Max_Tries   := Count;
 315       DB.Retry_Delay := Retry_Delay;
 316    end Set_Max_Tries;
 317
 318    -----------------
 319    -- SQLite_Safe --
 320    -----------------
 321
 322    protected body SQLite_Safe is
 323
 324       -----------
 325       -- Close --
 326       -----------
 327
 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;
 338
 339       ----------
 340       -- Exec --
 341       ----------
 342
 343       procedure Exec
 344         (DB : in Handle; SQL : in String)
 345       is
 346          SQL_Stat  : Strings.chars_ptr := Strings.New_String (SQL);
 347          Result    : int;
 348          Error_Msg : Strings.chars_ptr := Strings.Null_Ptr;
 349
 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;
 381
 382       ----------
 383       -- Open --
 384       ----------
 385
 386       procedure Open
 387         (DB     : in out Handle;
 388          Name   : in     String;
 389          Result :    out int) is
 390
 391          procedure Open_Db;
 392          --  Open a database connection
 393
 394          -------------
 395          -- Open_Db --
 396          -------------
 397
 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;
 404
 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;
 411
 412             elsif DB.H = null then
 413                --  Get the open database connection
 414                DB.H   := Unique_Handle;
 415                Result := 0; --  SQLite_OK
 416
 417                --  Increment the reference counter
 418                DB.Ref_Count := DB.Ref_Count + 1;
 419
 420             else
 421                --  Nothing to do. Return OK
 422                Result := 0; -- SQLite_OK
 423             end if;
 424
 425          else
 426             Open_Db;
 427          end if;
 428       end Open;
 429
 430       --------------------
 431       -- Prepare_Select --
 432       --------------------
 433
 434       function Prepare_Select
 435         (DB   : in Handle;
 436          Iter : in Standard.DB.Iterator'Class;
 437          SQL  : in String) return Standard.DB.Iterator'Class
 438       is
 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);
 444
 445          Logs.Write
 446            (Module, "prepare select : " & Logs.NV ("SQL", SQL));
 447
 448          Iterator (Select_Iter).H := DB;
 449          Iterator (Select_Iter).More := False;
 450
 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);
 457
 458          Strings.Free (zSql);
 459
 460          Check_Result ("prepare_select", Select_Res);
 461
 462          Column_Count : declare
 463             use type sqlite3_h.sqlite_result;
 464
 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;
 477
 478          return Select_Iter;
 479       end Prepare_Select;
 480
 481    end SQLite_Safe;
 482
 483    -------------------
 484    -- Step_Internal --
 485    -------------------
 486
 487    procedure Step_Internal (Iter : in out Iterator) is
 488       R : int;
 489    begin
 490       R := sqlite3_h.sqlite3_step (Iter.S.all'Address);
 491
 492       Analyse_Result : declare
 493          Result : sqlite3_h.sqlite_result;
 494          for Result'Address use R'Address;
 495
 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;
 512
 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;