summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/deck_io.adb12
-rw-r--r--src/sqlite3.adb146
-rw-r--r--src/sqlite3.ads92
3 files changed, 152 insertions, 98 deletions
diff --git a/src/deck_io.adb b/src/deck_io.adb
index 20eb6c1..8830df0 100644
--- a/src/deck_io.adb
+++ b/src/deck_io.adb
@@ -40,7 +40,6 @@ package body Deck_IO is
(This : in out Deck_Handle) is
begin
if This.Opened then
- SQLite3.Close (This.SQL_Handle);
FD.Delete_File (-This.Tempfile);
end if;
end Finalize;
@@ -123,7 +122,7 @@ package body Deck_IO is
Temp : String := Generate_Temp_Name;
begin
UnZip.Extract (Filename, "collection.anki2", Temp);
- SQLite3.Open (Temp, Deck.SQL_Handle);
+ Deck.SQL_Handle.Open (Temp);
Deck.Opened := True;
Deck.Tempfile := +Temp;
end Open_Database;
@@ -143,7 +142,7 @@ package body Deck_IO is
if Deck.Opened = False then
return;
end if;
- SQLite3.Close (Deck.SQL_Handle);
+ Deck.SQL_Handle.Close;
Deck.Opened := False;
FD.Delete_File (-Deck.Tempfile);
Deck.Tempfile := +"";
@@ -250,10 +249,9 @@ package body Deck_IO is
Extract_Model (Name, Value, Models);
end JSON_Callback;
begin
- SQLite3.Prepare (Deck.SQL_Handle, "SELECT models FROM col", Statement);
- SQLite3.Step (Statement, Deck.Status);
- SQLite3.Column (Statement, 0, Raw_Data);
- SQLite3.Finish (Statement);
+ Deck.SQL_Handle.Prepare ("SELECT models FROM col", Statement);
+ Statement.Step;
+ Raw_Data := Statement.Column (0);
JSON_Data := JS.Read (-Raw_Data);
JS.Map_JSON_Object (JSON_Data, JSON_Callback'Access);
end Query_Models;
diff --git a/src/sqlite3.adb b/src/sqlite3.adb
index 081d076..d39fd6c 100644
--- a/src/sqlite3.adb
+++ b/src/sqlite3.adb
@@ -8,9 +8,25 @@ with
package body SQLite3 is
+ procedure Finalize
+ (This : in out SQLite3_DB) is
+ begin
+ This.Close;
+ end Finalize;
+
+
+ procedure Finalize
+ (This : in out SQLite3_Statement) is
+ begin
+ This.Finish;
+ end Finalize;
+
+
+
+
procedure Open
- (Filename : in String;
- Handle : out SQLite3_DB)
+ (Handle : out SQLite3_DB;
+ Filename : in String)
is
function sqlite3_open
(Filename : in Interfaces.C.char_array;
@@ -21,6 +37,7 @@ package body SQLite3 is
Code : Interfaces.C.int;
begin
Code := sqlite3_open (Interfaces.C.To_C (Filename), Handle.Ptr'Access);
+ Handle.Prep := True;
if Status_Code (Code) /= SQLITE_OK then
raise Program_Error with Error_Message (Handle);
end if;
@@ -28,8 +45,8 @@ package body SQLite3 is
procedure Open
- (Filename : in String;
- Handle : out SQLite3_DB;
+ (Handle : out SQLite3_DB;
+ Filename : in String;
Flags : in Open_Flag)
is
function sqlite3_open_v2
@@ -47,6 +64,7 @@ package body SQLite3 is
Handle.Ptr'Access,
Interfaces.C.int (Flags),
Interfaces.C.To_C (""));
+ Handle.Prep := True;
if Status_Code (Code) /= SQLITE_OK then
raise Program_Error with Error_Message (Handle);
end if;
@@ -62,20 +80,24 @@ package body SQLite3 is
with Import => True, Convention => C;
Code : Interfaces.C.int;
- Status : Status_Code;
begin
+ if Handle.Prep = False then
+ return;
+ end if;
Code := sqlite3_close (Handle.Ptr);
- Status := Status_Code (Code);
- if Status /= SQLITE_OK and Status /= SQLITE_ROW and Status /= SQLITE_DONE then
+ Handle.Prep := False;
+ if Status_Code (Code) /= SQLITE_OK then
raise Program_Error with Error_Message (Handle);
end if;
end Close;
+
+
procedure Prepare
(Handle : in SQLite3_DB;
SQL : in String;
- SQL_Handle : out SQLite3_Statement)
+ SQL_Handle : out SQLite3_Statement'Class)
is
type Chars_Ptr_Ptr is access all Interfaces.C.Strings.chars_ptr;
@@ -104,7 +126,9 @@ package body SQLite3 is
nByte => SQL_Str'Length,
ppStmt => SQL_Handle.Ptr'Access,
pzTail => null);
- if Status_Code (Code) /= SQLITE_OK then
+ SQL_Handle.Prep := True;
+ SQL_Handle.Status := Status_Code (Code);
+ if SQL_Handle.Status /= SQLITE_OK then
raise Program_Error with Error_Message (Handle);
end if;
end Prepare;
@@ -114,7 +138,7 @@ package body SQLite3 is
(Handle : in SQLite3_DB;
SQL : in String;
Flags : in Prepare_Flag;
- SQL_Handle : out SQLite3_Statement)
+ SQL_Handle : out SQLite3_Statement'Class)
is
type Chars_Ptr_Ptr is access all Interfaces.C.Strings.chars_ptr;
@@ -146,15 +170,16 @@ package body SQLite3 is
prepFlags => Interfaces.C.unsigned (Flags),
ppStmt => SQL_Handle.Ptr'Access,
pzTail => null);
- if Status_Code (Code) /= SQLITE_OK then
+ SQL_Handle.Prep := True;
+ SQL_Handle.Status := Status_Code (Code);
+ if SQL_Handle.Status /= SQLITE_OK then
raise Program_Error with Error_Message (Handle);
end if;
end Prepare;
procedure Step
- (SQL_Handle : in SQLite3_Statement;
- Status : out Status_Code)
+ (SQL_Handle : in out SQLite3_Statement)
is
-- int sqlite3_step(sqlite3_stmt*);
function sqlite3_step
@@ -165,15 +190,26 @@ package body SQLite3 is
Code : Interfaces.C.int;
begin
Code := sqlite3_step (SQL_Handle.Ptr);
- Status := Status_Code (Code);
- if Status /= SQLITE_OK and Status /= SQLITE_ROW and Status /= SQLITE_DONE then
- raise Program_Error with Error_String (Status);
+ SQL_Handle.Status := Status_Code (Code);
+ if SQL_Handle.Status /= SQLITE_OK and
+ SQL_Handle.Status /= SQLITE_ROW and
+ SQL_Handle.Status /= SQLITE_DONE
+ then
+ raise Program_Error with Error_String (SQL_Handle.Status);
end if;
end Step;
- procedure Finish
+ function Status
(SQL_Handle : in SQLite3_Statement)
+ return Status_Code is
+ begin
+ return SQL_Handle.Status;
+ end Status;
+
+
+ procedure Finish
+ (SQL_Handle : in out SQLite3_Statement)
is
-- int sqlite3_finalize(sqlite3_stmt*);
function sqlite3_finalize
@@ -182,18 +218,21 @@ package body SQLite3 is
with Import => True, Convention => C;
Code : Interfaces.C.int;
- Status : Status_Code;
begin
+ if SQL_Handle.Prep = False then
+ return;
+ end if;
Code := sqlite3_finalize (SQL_Handle.Ptr);
- Status := Status_Code (Code);
- if Status /= SQLITE_OK then
- raise Program_Error with Error_String (Status);
+ SQL_Handle.Prep := False;
+ SQL_Handle.Status := Status_Code (Code);
+ if SQL_Handle.Status /= SQLITE_OK then
+ raise Program_Error with Error_String (SQL_Handle.Status);
end if;
end Finish;
procedure Reset
- (SQL_Handle : in SQLite3_Statement)
+ (SQL_Handle : in out SQLite3_Statement)
is
-- int sqlite3_reset(sqlite3_stmt*);
function sqlite3_reset
@@ -202,29 +241,28 @@ package body SQLite3 is
with Import => True, Convention => C;
Code : Interfaces.C.int;
- Status : Status_Code;
begin
Code := sqlite3_reset (SQL_Handle.Ptr);
- Status := Status_Code (Code);
- if Status /= SQLITE_OK then
- raise Program_Error with Error_String (Status);
+ SQL_Handle.Status := Status_Code (Code);
+ if SQL_Handle.Status /= SQLITE_OK then
+ raise Program_Error with Error_String (SQL_Handle.Status);
end if;
end Reset;
procedure Bind
- (SQL_Handle : in SQLite3_Statement;
- Index : in SQL_Parameter_Index;
- Value : in Integer) is
+ (SQL_Handle : in out SQLite3_Statement;
+ Index : in SQL_Parameter_Index;
+ Value : in Integer) is
begin
Bind (SQL_Handle, Index, Long_Integer (Value));
end Bind;
procedure Bind
- (SQL_Handle : in SQLite3_Statement;
- Index : in SQL_Parameter_Index;
- Value : in Long_Integer)
+ (SQL_Handle : in out SQLite3_Statement;
+ Index : in SQL_Parameter_Index;
+ Value : in Long_Integer)
is
-- int sqlite3_bind_int(sqlite3_stmt*, int, int);
function sqlite3_bind_int
@@ -235,23 +273,22 @@ package body SQLite3 is
with Import => True, Convention => C;
Code : Interfaces.C.int;
- Status : Status_Code;
begin
Code := sqlite3_bind_int
(Stmt => SQL_Handle.Ptr,
Index => Interfaces.C.int (Index),
Value => Interfaces.C.int (Value));
- Status := Status_Code (Code);
- if Status /= SQLITE_OK then
- raise Program_Error with Error_String (Status);
+ SQL_Handle.Status := Status_Code (Code);
+ if SQL_Handle.Status /= SQLITE_OK then
+ raise Program_Error with Error_String (SQL_Handle.Status);
end if;
end Bind;
procedure Bind
- (SQL_Handle : in SQLite3_Statement;
- Index : in SQL_Parameter_Index;
- Value : in Ada.Strings.Unbounded.Unbounded_String)
+ (SQL_Handle : in out SQLite3_Statement;
+ Index : in SQL_Parameter_Index;
+ Value : in Ada.Strings.Unbounded.Unbounded_String)
is
use Ada.Strings.Unbounded;
@@ -271,7 +308,6 @@ package body SQLite3 is
with Import => True, Convention => C;
Code : Interfaces.C.int;
- Status : Status_Code;
begin
Code := sqlite3_bind_text
(Stmt => SQL_Handle.Ptr,
@@ -279,17 +315,17 @@ package body SQLite3 is
Value => Interfaces.C.To_C (To_String (Value)),
Bytes => Interfaces.C.int (Length (Value)),
Opt => SQLITE_TRANSIENT);
- Status := Status_Code (Code);
- if Status /= SQLITE_OK then
- raise Program_Error with Error_String (Status);
+ SQL_Handle.Status := Status_Code (Code);
+ if SQL_Handle.Status /= SQLITE_OK then
+ raise Program_Error with Error_String (SQL_Handle.Status);
end if;
end Bind;
- procedure Column
- (SQL_Handle : in SQLite3_Statement;
- Index : in SQL_Column_Index;
- Value : out Int)
+ function Column
+ (SQL_Handle : in SQLite3_Statement;
+ Index : in SQL_Column_Index)
+ return Integer
is
-- int sqlite3_column_int(sqlite3_stmt*, int iCol);
function sqlite3_column_int
@@ -303,14 +339,14 @@ package body SQLite3 is
Ret_Val := sqlite3_column_int
(Stmt => SQL_Handle.Ptr,
Index => Interfaces.C.int (Index));
- Value := Int (Ret_Val);
+ return Integer (Ret_Val);
end Column;
- procedure Column
- (SQL_Handle : in SQLite3_Statement;
- Index : in SQL_Column_Index;
- Value : out Ada.Strings.Unbounded.Unbounded_String)
+ function Column
+ (SQL_Handle : in SQLite3_Statement;
+ Index : in SQL_Column_Index)
+ return Ada.Strings.Unbounded.Unbounded_String
is
use Ada.Strings.Unbounded;
use Interfaces;
@@ -329,13 +365,15 @@ package body SQLite3 is
(Stmt => SQL_Handle.Ptr,
Index => Interfaces.C.int (Index));
if Ret_Val = C.Strings.Null_Ptr then
- Value := Null_Unbounded_String;
+ return Null_Unbounded_String;
else
- Value := To_Unbounded_String (C.To_Ada (C.Strings.Value (Ret_Val)));
+ return To_Unbounded_String (C.To_Ada (C.Strings.Value (Ret_Val)));
end if;
end Column;
+
+
function Error_Message
(Handle : in SQLite3_DB)
return String
diff --git a/src/sqlite3.ads b/src/sqlite3.ads
index 667fdd6..df49e2c 100644
--- a/src/sqlite3.ads
+++ b/src/sqlite3.ads
@@ -2,16 +2,18 @@
with
- Ada.Strings.Unbounded,
- System,
- Interfaces.C;
+ Ada.Strings.Unbounded;
+
+private with
+
+ Ada.Finalization;
package SQLite3 is
- type SQLite3_DB is private;
- type SQLite3_Statement is private;
+ type SQLite3_DB is tagged limited private;
+ type SQLite3_Statement is tagged limited private;
type Open_Flag is mod 2**32;
type Prepare_Flag is mod 2**32;
@@ -19,7 +21,6 @@ package SQLite3 is
subtype SQL_Parameter_Index is Integer range 1 .. Integer'Last;
subtype SQL_Column_Index is Integer;
- type Int is new Interfaces.C.int;
OPEN_READONLY : constant Open_Flag := 1;
@@ -56,62 +57,66 @@ package SQLite3 is
procedure Open
- (Filename : in String;
- Handle : out SQLite3_DB);
+ (Handle : out SQLite3_DB;
+ Filename : in String);
procedure Open
- (Filename : in String;
- Handle : out SQLite3_DB;
+ (Handle : out SQLite3_DB;
+ Filename : in String;
Flags : in Open_Flag);
procedure Close
(Handle : in out SQLite3_DB);
+
procedure Prepare
(Handle : in SQLite3_DB;
SQL : in String;
- SQL_Handle : out SQLite3_Statement);
+ SQL_Handle : out SQLite3_Statement'Class);
procedure Prepare
(Handle : in SQLite3_DB;
SQL : in String;
Flags : in Prepare_Flag;
- SQL_Handle : out SQLite3_Statement);
+ SQL_Handle : out SQLite3_Statement'Class);
procedure Step
- (SQL_Handle : in SQLite3_Statement;
- Status : out Status_Code);
+ (SQL_Handle : in out SQLite3_Statement);
+
+ function Status
+ (SQL_Handle : in SQLite3_Statement)
+ return Status_Code;
procedure Finish
- (SQL_Handle : in SQLite3_Statement);
+ (SQL_Handle : in out SQLite3_Statement);
procedure Reset
- (SQL_Handle : in SQLite3_Statement);
+ (SQL_Handle : in out SQLite3_Statement);
procedure Bind
- (SQL_Handle : in SQLite3_Statement;
- Index : in SQL_Parameter_Index;
- Value : in Integer);
+ (SQL_Handle : in out SQLite3_Statement;
+ Index : in SQL_Parameter_Index;
+ Value : in Integer);
procedure Bind
- (SQL_Handle : in SQLite3_Statement;
- Index : in SQL_Parameter_Index;
- Value : in Long_Integer);
+ (SQL_Handle : in out SQLite3_Statement;
+ Index : in SQL_Parameter_Index;
+ Value : in Long_Integer);
procedure Bind
- (SQL_Handle : in SQLite3_Statement;
- Index : in SQL_Parameter_Index;
- Value : in Ada.Strings.Unbounded.Unbounded_String);
+ (SQL_Handle : in out SQLite3_Statement;
+ Index : in SQL_Parameter_Index;
+ Value : in Ada.Strings.Unbounded.Unbounded_String);
- procedure Column
- (SQL_Handle : in SQLite3_Statement;
- Index : in SQL_Column_Index;
- Value : out Int);
+ function Column
+ (SQL_Handle : in SQLite3_Statement;
+ Index : in SQL_Column_Index)
+ return Integer;
- procedure Column
- (SQL_Handle : in SQLite3_Statement;
- Index : in SQL_Column_Index;
- Value : out Ada.Strings.Unbounded.Unbounded_String);
+ function Column
+ (SQL_Handle : in SQLite3_Statement;
+ Index : in SQL_Column_Index)
+ return Ada.Strings.Unbounded.Unbounded_String;
private
@@ -132,16 +137,29 @@ private
type DB_Private is null record;
type DB_Private_Access is access all DB_Private;
- type SQLite3_DB is record
- Ptr : aliased DB_Private_Access;
+ type SQLite3_DB is new Ada.Finalization.Limited_Controlled with record
+ Ptr : aliased DB_Private_Access;
+ Prep : Boolean := False;
end record;
+ overriding
+ procedure Finalize
+ (This : in out SQLite3_DB);
+
+
type Statement_Private is null record;
type Statement_Private_Access is access all Statement_Private;
- type SQLite3_Statement is record
- Ptr : aliased Statement_Private_Access;
+
+ type SQLite3_Statement is new Ada.Finalization.Limited_Controlled with record
+ Ptr : aliased Statement_Private_Access;
+ Status : Status_Code := SQLITE_OK;
+ Prep : Boolean := False;
end record;
+ overriding
+ procedure Finalize
+ (This : in out SQLite3_Statement);
+
end SQLite3;
generated by cgit (git 2.30.0) at 2024-12-22 06:41:06 +0000