summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJedidiah Barber <contact@jedbarber.id.au>2021-11-02 23:32:45 +1300
committerJedidiah Barber <contact@jedbarber.id.au>2021-11-02 23:32:45 +1300
commit3ddfc80f519cfe5910ba36ea48f1767af9fef75e (patch)
tree2d24c1696d3faa3ef6d3dce4fd1880e3ec1a6aee /src
parent32a6db11b7e8ca95bac718baac019d19fff03845 (diff)
Models are queried
Diffstat (limited to 'src')
-rw-r--r--src/deck_convert.adb113
-rw-r--r--src/deck_io.adb298
-rw-r--r--src/deck_io.ads149
-rw-r--r--src/sqlite3.adb372
-rw-r--r--src/sqlite3.ads148
5 files changed, 1044 insertions, 36 deletions
diff --git a/src/deck_convert.adb b/src/deck_convert.adb
index 6d140a4..94b7098 100644
--- a/src/deck_convert.adb
+++ b/src/deck_convert.adb
@@ -10,7 +10,8 @@ with
Ada.Directories,
Ada.Strings.Unbounded,
Ada.Text_IO,
- UnZip;
+ SQLite3,
+ Deck_IO;
use
@@ -50,16 +51,23 @@ procedure Deck_Convert is
Further_Help : String := "Try ""deckconv --help"" for more information.";
- Verbose : aliased Boolean;
- Help : aliased Boolean;
- Overwrite : aliased Boolean;
- Output_Format : aliased GStr.String_Access;
- Input_Name : aliased GStr.String_Access;
- Output_Name : aliased GStr.String_Access;
+ Verbose : aliased Boolean;
+ Help : aliased Boolean;
+ Overwrite : aliased Boolean;
+ Format_Arg : aliased GStr.String_Access;
+ Input_Arg : aliased GStr.String_Access;
+ Output_Arg : aliased GStr.String_Access;
- Temp : File_Type;
- Temp_Name : SU.Unbounded_String;
+ Deck_Format : SU.Unbounded_String;
+ Input_Name : SU.Unbounded_String;
+ Output_Name : SU.Unbounded_String;
+
+
+ Deck : Deck_IO.Deck_Handle;
+ Models : Deck_IO.Model_Maps.Map;
+ Notes : Deck_IO.Note_Vectors.Vector;
+ Media : Deck_IO.Media_Maps.Map;
begin
@@ -81,19 +89,19 @@ begin
Help => "overwrite selected output file if present");
GCom.Define_Switch
- (Config => Config, Output => Output_Format'Access,
+ (Config => Config, Output => Format_Arg'Access,
Switch => "-t:", Long_Switch => "--type=",
Help => "format of output data, valid options are CSV or FMD");
GCom.Define_Switch
- (Config => Config, Output => Input_Name'Access,
+ (Config => Config, Output => Input_Arg'Access,
Switch => "-i:", Long_Switch => "--input=",
Help => "file name of input deck");
GCom.Define_Switch
- (Config => Config, Output => Output_Name'Access,
+ (Config => Config, Output => Output_Arg'Access,
Switch => "-o:", Long_Switch => "--output=",
- Help => "file name to store output data");
+ Help => "base name to store output data");
GCom.Set_Usage
@@ -116,10 +124,16 @@ begin
end;
- if Charhand.To_Upper (Output_Format.all) /= "CSV" and
- Charhand.To_Upper (Output_Format.all) /= "FMD"
- then
- Put_Line (Standard_Error, Output_Format.all);
+ if Format_Arg.all = "" then
+ if Verbose then
+ Put_Line (Standard_Error, "WARNING: No output deck format selected. " &
+ "Proceeding with FMD as default.");
+ end if;
+ Deck_Format := +"fmd";
+ else
+ Deck_Format := +(Charhand.To_Lower (Format_Arg.all));
+ end if;
+ if Deck_Format /= "csv" and Deck_Format /= "fmd" then
Put_Line (Standard_Error, "Output deck format required. Valid options are CSV or FMD." &
Latin.LF & Further_Help);
ACom.Set_Exit_Status (ACom.Failure);
@@ -127,13 +141,14 @@ begin
end if;
- if Input_Name.all = "" then
+ if Input_Arg.all = "" then
Put_Line (Standard_Error, "File name of input deck was not provided." &
Latin.LF & Further_Help);
ACom.Set_Exit_Status (ACom.Failure);
return;
end if;
- if not File.Exists (Input_Name.all) then
+ Input_Name := +(Input_Arg.all);
+ if not File.Exists (-Input_Name) then
Put_Line (Standard_Error, "Input deck does not exist." &
Latin.LF & Further_Help);
ACom.Set_Exit_Status (ACom.Failure);
@@ -141,13 +156,14 @@ begin
end if;
- if Output_Name.all = "" then
+ if Output_Arg.all = "" then
Put_Line (Standard_Error, "File name for output deck was not provided." &
Latin.LF & Further_Help);
ACom.Set_Exit_Status (ACom.Failure);
return;
end if;
- if File.Exists (Output_Name.all) and not Overwrite then
+ Output_Name := +(Output_Arg.all);
+ if File.Exists ((-Output_Name) & "." & (-Deck_Format)) and not Overwrite then
Put_Line (Standard_Error, "Output deck file name already exists." &
Latin.LF & Further_Help);
ACom.Set_Exit_Status (ACom.Failure);
@@ -155,24 +171,49 @@ begin
end if;
- if File.Exists ("collection.anki2") and not Overwrite then
- Put_Line (Standard_Error, "Temporary collection.anki2 file already exists." &
- Latin.LF & Further_Help);
- ACom.Set_Exit_Status (ACom.Failure);
- return;
+ -- if File.Exists ("collection.anki2") and not Overwrite then
+ -- Put_Line (Standard_Error, "Temporary collection.anki2 file already exists." &
+ -- Latin.LF & Further_Help);
+ -- ACom.Set_Exit_Status (ACom.Failure);
+ -- return;
+ -- end if;
+
+
+ -- 1. extract media to a temporary file
+ -- 2. generate mapping of what media filenames correspond to what names in the zip
+ -- 3. extract collection.anki2 to a temporary file
+ -- 4. open collection.anki2 as an SQL database
+ -- 5. SELECT models from col
+ -- 6. store models in vector with id, flds, tmpls
+ -- 7. SELECT mid, flds FROM notes
+ -- 8. store as a map from mid -> array of flds values
+ -- 9. generate required output file names and dir names for each mid from base name
+ -- 10. for each of the models...
+
+ -- CSV process
+ -- 10.1. write header to output file using the fld names in model
+ -- 10.2. write csv formatted row of each note for that model
+ -- 10.3. as that is being done, if any note needs media, extract from zip into relevant dir
+
+ -- FMD process
+ -- 10.1.
+
+
+ Deck_IO.Open_Database (-Input_Name, Deck);
+ Deck_IO.Query_Models (Deck, Models);
+ Deck_IO.Query_Notes (Deck, Notes);
+ Deck_IO.Close_Database (Deck);
+
+ if Deck_Format = "csv" then
+ Deck_IO.Write_CSV ("", "", Models, Notes);
+ elsif Deck_Format = "fmd" then
+ Deck_IO.Read_Media_Map (-Input_Name, Media);
+ Deck_IO.Write_FMD ("", "", Models, Notes, Media);
+ else
+ raise Constraint_Error;
end if;
- -- Generate a temporary filename
- Create (File => Temp);
- Temp_Name := +Name (Temp);
- Close (Temp);
-
- UnZip.Extract (Input_Name.all, "collection.anki2", (-Temp_Name));
- Put_Line ("Extracted collection as " & (-Temp_Name));
- File.Delete_File (-Temp_Name);
-
-
end Deck_Convert;
diff --git a/src/deck_io.adb b/src/deck_io.adb
new file mode 100644
index 0000000..20eb6c1
--- /dev/null
+++ b/src/deck_io.adb
@@ -0,0 +1,298 @@
+
+
+with
+
+ Ada.Characters.Latin_1,
+ Ada.Directories,
+ Ada.Text_IO,
+ GNAT.Regpat,
+ GNATCOLL.JSON,
+ UnZip;
+
+use
+
+ Ada.Text_IO;
+
+
+package body Deck_IO is
+
+
+ package Latin renames Ada.Characters.Latin_1;
+ package FD renames Ada.Directories;
+ package Pat renames GNAT.Regpat;
+ package JS renames GNATCOLL.JSON;
+
+
+ function "+"
+ (S : in String)
+ return SU.Unbounded_String
+ renames SU.To_Unbounded_String;
+
+ function "-"
+ (US : in SU.Unbounded_String)
+ return String
+ renames SU.To_String;
+
+
+
+
+ procedure Finalize
+ (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;
+
+
+
+
+ function Generate_Temp_Name
+ return String
+ is
+ Handle : File_Type;
+ Filename : SU.Unbounded_String;
+ begin
+ Create (File => Handle);
+ Filename := +Name (Handle);
+ Close (Handle);
+ return -Filename;
+ end Generate_Temp_Name;
+
+
+
+
+ function Matches
+ (Models : in Model_Maps.Map;
+ Notes : in Note_Vectors.Vector)
+ return Boolean
+ is
+ use type Ada.Containers.Count_Type;
+ begin
+ for Note of Notes loop
+ if not Models.Contains (Note.Model) or else
+ Note.Fields.Length > Models.Element (Note.Model).Fields.Length
+ then
+ return False;
+ end if;
+ end loop;
+ return True;
+ end Matches;
+
+
+
+
+ procedure Read_Media_Map
+ (Filename : in String;
+ Media_Map : out Media_Maps.Map)
+ is
+ Temp : String := Generate_Temp_Name;
+
+ Input_Handle : File_Type;
+ Raw_Data : SU.Unbounded_String;
+ JSON_Data : JS.JSON_Value;
+
+ procedure Map_Iteration
+ (Name : in JS.UTF8_String;
+ Value : in JS.JSON_Value) is
+ begin
+ Media_Map.Insert (Media_ID (+Name), JS.Get (Value));
+ end Map_Iteration;
+ begin
+ UnZip.Extract (Filename, "media", Temp);
+
+ Open (Input_Handle, In_File, Temp);
+ while not End_Of_File (Input_Handle) loop
+ SU.Append (Raw_Data, Get_Line (Input_Handle) & Latin.LF);
+ end loop;
+ Close (Input_Handle);
+ FD.Delete_File (Temp);
+
+ JSON_Data := JS.Read (-Raw_Data);
+ JS.Map_JSON_Object (JSON_Data, Map_Iteration'Access);
+ end Read_Media_Map;
+
+
+
+
+ procedure Open_Database
+ (Filename : in String;
+ Deck : in out Deck_Handle)
+ is
+ Temp : String := Generate_Temp_Name;
+ begin
+ UnZip.Extract (Filename, "collection.anki2", Temp);
+ SQLite3.Open (Temp, Deck.SQL_Handle);
+ Deck.Opened := True;
+ Deck.Tempfile := +Temp;
+ end Open_Database;
+
+
+ function Is_Open
+ (Deck : in Deck_Handle)
+ return Boolean is
+ begin
+ return Deck.Opened;
+ end Is_Open;
+
+
+ procedure Close_Database
+ (Deck : in out Deck_Handle) is
+ begin
+ if Deck.Opened = False then
+ return;
+ end if;
+ SQLite3.Close (Deck.SQL_Handle);
+ Deck.Opened := False;
+ FD.Delete_File (-Deck.Tempfile);
+ Deck.Tempfile := +"";
+ end Close_Database;
+
+
+
+
+ procedure Extract_Field_IDs
+ (Value : in JS.JSON_Array;
+ FIDs : out Field_ID_Vectors.Vector)
+ is
+ Index : Positive;
+ Item : JS.JSON_Value;
+ Ordinal : Integer;
+ begin
+ Index := JS.Array_First (Value);
+ while JS.Array_Has_Element (Value, Index) loop
+ Item := JS.Array_Element (Value, Index);
+ Ordinal := JS.Get (Item, "ord") + 1;
+ if Ordinal > Integer (FIDs.Length) then
+ FIDs.Set_Length (Ada.Containers.Count_Type (Ordinal));
+ end if;
+ declare
+ Name : String := JS.Get (Item, "name");
+ begin
+ FIDs.Replace_Element (Field_Ordinal (Ordinal), Field_ID (+Name));
+ end;
+ Index := Index + 1;
+ end loop;
+ end Extract_Field_IDs;
+
+
+ procedure Regex_Fields
+ (Raw_Data : in JS.UTF8_String;
+ FIDs : out Field_ID_Vectors.Vector)
+ is
+ use type Pat.Match_Location;
+ Matches : Pat.Match_Array (0 .. 1);
+ Regexp : Pat.Pattern_Matcher := Pat.Compile ("{{(?:\w+:)?(\w+)}}", Pat.Single_Line);
+ Marker : Positive := Raw_Data'First;
+ begin
+ loop
+ Pat.Match (Regexp, Raw_Data, Matches, Marker);
+ exit when Matches (1) = Pat.No_Match;
+ declare
+ Item : String := Raw_Data (Matches (1).First .. Matches (1).Last);
+ begin
+ if Item /= "FrontSide" then
+ FIDs.Append (Field_ID (+Item));
+ end if;
+ end;
+ Marker := Matches (0).Last + 1;
+ end loop;
+ end Regex_Fields;
+
+
+ procedure Extract_Templates
+ (Value : in JS.JSON_Array;
+ TMPLs : out Template_Vectors.Vector)
+ is
+ Index : Positive;
+ Item : JS.JSON_Value;
+ Current_Tmpl : Template;
+ begin
+ Index := JS.Array_First (Value);
+ while JS.Array_Has_Element (Value, Index) loop
+ Item := JS.Array_Element (Value, Index);
+ Regex_Fields (JS.Get (Item, "qfmt"), Current_Tmpl.Question);
+ Regex_Fields (JS.Get (Item, "afmt"), Current_Tmpl.Answer);
+ TMPLs.Append (Current_Tmpl);
+ Current_Tmpl.Question.Clear;
+ Current_Tmpl.Answer.Clear;
+ Index := Index + 1;
+ end loop;
+ end Extract_Templates;
+
+
+ procedure Extract_Model
+ (Name : in JS.UTF8_String;
+ Value : in JS.JSON_Value;
+ Models : in out Model_Maps.Map)
+ is
+ Current_Model : Model;
+ begin
+ Extract_Field_IDs (JS.Get (Value, "flds"), Current_Model.Fields);
+ Extract_Templates (JS.Get (Value, "tmpls"), Current_Model.Templates);
+ Models.Insert (Model_ID (+Name), Current_Model);
+ end Extract_Model;
+
+
+ procedure Query_Models
+ (Deck : in out Deck_Handle;
+ Models : out Model_Maps.Map)
+ is
+ Statement : SQLite3.SQLite3_Statement;
+ Raw_Data : SU.Unbounded_String;
+ JSON_Data : JS.JSON_Value;
+
+ procedure JSON_Callback
+ (Name : in JS.UTF8_String;
+ Value : in JS.JSON_Value) is
+ begin
+ 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);
+ JSON_Data := JS.Read (-Raw_Data);
+ JS.Map_JSON_Object (JSON_Data, JSON_Callback'Access);
+ end Query_Models;
+
+
+ procedure Query_Notes
+ (Deck : in out Deck_Handle;
+ Notes : out Note_Vectors.Vector)
+ is
+ begin
+ null;
+ end Query_Notes;
+
+
+
+
+ procedure Write_CSV
+ (Directory : in String;
+ Basename : in String;
+ Models : in Model_Maps.Map;
+ Notes : in Note_Vectors.Vector)
+ is
+ begin
+ null;
+ end Write_CSV;
+
+
+ procedure Write_FMD
+ (Directory : in String;
+ Basename : in String;
+ Models : in Model_Maps.Map;
+ Notes : in Note_Vectors.Vector;
+ Media : in Media_Maps.Map)
+ is
+ begin
+ null;
+ end Write_FMD;
+
+
+end Deck_IO;
+
+
diff --git a/src/deck_io.ads b/src/deck_io.ads
new file mode 100644
index 0000000..5fe9880
--- /dev/null
+++ b/src/deck_io.ads
@@ -0,0 +1,149 @@
+
+
+with
+
+ Ada.Containers.Vectors,
+ Ada.Containers.Ordered_Maps,
+ Ada.Strings.Unbounded;
+
+private with
+
+ Ada.Finalization,
+ SQLite3;
+
+
+package Deck_IO is
+
+
+ package SU renames Ada.Strings.Unbounded;
+ use type SU.Unbounded_String;
+
+
+ type Deck_Handle is limited private;
+
+
+ type Field_Ordinal is new Positive;
+ type Field_ID is new SU.Unbounded_String;
+
+ package Field_ID_Vectors is new Ada.Containers.Vectors
+ (Index_Type => Field_Ordinal,
+ Element_Type => Field_ID);
+
+
+ type Template is record
+ Question : Field_ID_Vectors.Vector;
+ Answer : Field_ID_Vectors.Vector;
+ end record;
+
+ package Template_Vectors is new Ada.Containers.Vectors
+ (Index_Type => Positive,
+ Element_Type => Template);
+
+
+ type Model_ID is new SU.Unbounded_String;
+
+ type Model is record
+ Fields : Field_ID_Vectors.Vector;
+ Templates : Template_Vectors.Vector;
+ end record;
+
+ package Model_Maps is new Ada.Containers.Ordered_Maps
+ (Key_Type => Model_ID,
+ Element_Type => Model);
+
+
+ type Field is new SU.Unbounded_String;
+
+ package Field_Vectors is new Ada.Containers.Vectors
+ (Index_Type => Positive,
+ Element_Type => Field);
+
+
+ type Note is record
+ Model : Model_ID;
+ Fields : Field_Vectors.Vector;
+ end record;
+
+ package Note_Vectors is new Ada.Containers.Vectors
+ (Index_Type => Positive,
+ Element_Type => Note);
+
+
+ function Matches
+ (Models : in Model_Maps.Map;
+ Notes : in Note_Vectors.Vector)
+ return Boolean;
+
+
+ type Media_ID is new SU.Unbounded_String;
+ subtype Media_Name is SU.Unbounded_String;
+
+ package Media_Maps is new Ada.Containers.Ordered_Maps
+ (Key_Type => Media_ID,
+ Element_Type => Media_Name);
+
+
+ procedure Read_Media_Map
+ (Filename : in String;
+ Media_Map : out Media_Maps.Map);
+
+
+ procedure Open_Database
+ (Filename : in String;
+ Deck : in out Deck_Handle)
+ with Post => Is_Open (Deck);
+
+ function Is_Open
+ (Deck : in Deck_Handle)
+ return Boolean;
+
+ procedure Close_Database
+ (Deck : in out Deck_Handle)
+ with Post => not Is_Open (Deck);
+
+ procedure Query_Models
+ (Deck : in out Deck_Handle;
+ Models : out Model_Maps.Map)
+ with Pre => Is_Open (Deck);
+
+ procedure Query_Notes
+ (Deck : in out Deck_Handle;
+ Notes : out Note_Vectors.Vector)
+ with Pre => Is_Open (Deck);
+
+
+ procedure Write_CSV
+ (Directory : in String;
+ Basename : in String;
+ Models : in Model_Maps.Map;
+ Notes : in Note_Vectors.Vector)
+ with Pre => Matches (Models, Notes);
+
+ procedure Write_FMD
+ (Directory : in String;
+ Basename : in String;
+ Models : in Model_Maps.Map;
+ Notes : in Note_Vectors.Vector;
+ Media : in Media_Maps.Map)
+ with Pre => Matches (Models, Notes);
+
+
+private
+
+
+ type Deck_Handle is new Ada.Finalization.Limited_Controlled with record
+ SQL_Handle : SQLite3.SQLite3_DB;
+ Status : SQLite3.Status_Code := SQLite3.SQLITE_OK;
+ Opened : Boolean := False;
+ Tempfile : SU.Unbounded_String := SU.To_Unbounded_String ("");
+ end record;
+
+
+ overriding
+ procedure Finalize
+ (This : in out Deck_Handle);
+
+
+end Deck_IO;
+
+
diff --git a/src/sqlite3.adb b/src/sqlite3.adb
new file mode 100644
index 0000000..081d076
--- /dev/null
+++ b/src/sqlite3.adb
@@ -0,0 +1,372 @@
+
+
+with
+
+ Interfaces.C.Strings;
+
+
+package body SQLite3 is
+
+
+ procedure Open
+ (Filename : in String;
+ Handle : out SQLite3_DB)
+ is
+ function sqlite3_open
+ (Filename : in Interfaces.C.char_array;
+ DB_Handle : access DB_Private_Access)
+ return Interfaces.C.int
+ with Import => True, Convention => C;
+
+ Code : Interfaces.C.int;
+ begin
+ Code := sqlite3_open (Interfaces.C.To_C (Filename), Handle.Ptr'Access);
+ if Status_Code (Code) /= SQLITE_OK then
+ raise Program_Error with Error_Message (Handle);
+ end if;
+ end Open;
+
+
+ procedure Open
+ (Filename : in String;
+ Handle : out SQLite3_DB;
+ Flags : in Open_Flag)
+ is
+ function sqlite3_open_v2
+ (Filename : in Interfaces.C.char_array;
+ DB_Handle : access DB_Private_Access;
+ Flags : in Interfaces.C.int;
+ VFS : in Interfaces.C.char_array)
+ return Interfaces.C.int
+ with Import => True, Convention => C;
+
+ Code : Interfaces.C.int;
+ begin
+ Code := sqlite3_open_v2
+ (Interfaces.C.To_C (Filename),
+ Handle.Ptr'Access,
+ Interfaces.C.int (Flags),
+ Interfaces.C.To_C (""));
+ if Status_Code (Code) /= SQLITE_OK then
+ raise Program_Error with Error_Message (Handle);
+ end if;
+ end Open;
+
+
+ procedure Close
+ (Handle : in out SQLite3_DB)
+ is
+ function sqlite3_close
+ (DB_Handle : in DB_Private_Access)
+ return Interfaces.C.int
+ with Import => True, Convention => C;
+
+ Code : Interfaces.C.int;
+ Status : Status_Code;
+ begin
+ Code := sqlite3_close (Handle.Ptr);
+ Status := Status_Code (Code);
+ if Status /= SQLITE_OK and Status /= SQLITE_ROW and Status /= SQLITE_DONE 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)
+ is
+ type Chars_Ptr_Ptr is access all Interfaces.C.Strings.chars_ptr;
+
+ -- int sqlite3_prepare_v2(
+ -- sqlite3 *db, /* Database handle */
+ -- const char *zSql, /* SQL statement, UTF-8 encoded */
+ -- int nByte, /* Maximum length of zSql in bytes. */
+ -- sqlite3_stmt **ppStmt, /* OUT: Statement handle */
+ -- const char **pzTail /* OUT: Pointer to unused portion of zSql */
+ -- );
+ function sqlite3_prepare_v2
+ (DB_Handle : in DB_Private_Access;
+ zSql : in Interfaces.C.char_array;
+ nByte : in Interfaces.C.int;
+ ppStmt : access Statement_Private_Access;
+ pzTail : in Chars_Ptr_Ptr)
+ return Interfaces.C.int
+ with Import => True, Convention => C;
+
+ SQL_Str : Interfaces.C.char_array := Interfaces.C.To_C (SQL);
+ Code : Interfaces.C.int;
+ begin
+ Code := sqlite3_prepare_v2
+ (DB_Handle => Handle.Ptr,
+ zSql => SQL_Str,
+ nByte => SQL_Str'Length,
+ ppStmt => SQL_Handle.Ptr'Access,
+ pzTail => null);
+ if Status_Code (Code) /= SQLITE_OK then
+ raise Program_Error with Error_Message (Handle);
+ end if;
+ end Prepare;
+
+
+ procedure Prepare
+ (Handle : in SQLite3_DB;
+ SQL : in String;
+ Flags : in Prepare_Flag;
+ SQL_Handle : out SQLite3_Statement)
+ is
+ type Chars_Ptr_Ptr is access all Interfaces.C.Strings.chars_ptr;
+
+ -- int sqlite3_prepare_v3(
+ -- sqlite3 *db, /* Database handle */
+ -- const char *zSql, /* SQL statement, UTF-8 encoded */
+ -- int nByte, /* Maximum length of zSql in bytes. */
+ -- unsigned int prepFlags /* Zero or more SQLITE_PREPARE_ flags */
+ -- sqlite3_stmt **ppStmt, /* OUT: Statement handle */
+ -- const char **pzTail /* OUT: Pointer to unused portion of zSql */
+ -- );
+ function sqlite3_prepare_v2
+ (DB_Handle : in DB_Private_Access;
+ zSql : in Interfaces.C.char_array;
+ nByte : in Interfaces.C.int;
+ prepFlags : in Interfaces.C.unsigned;
+ ppStmt : access Statement_Private_Access;
+ pzTail : in Chars_Ptr_Ptr)
+ return Interfaces.C.int
+ with Import => True, Convention => C;
+
+ SQL_Str : Interfaces.C.char_array := Interfaces.C.To_C (SQL);
+ Code : Interfaces.C.int;
+ begin
+ Code := sqlite3_prepare_v2
+ (DB_Handle => Handle.Ptr,
+ zSql => SQL_Str,
+ nByte => SQL_Str'Length,
+ prepFlags => Interfaces.C.unsigned (Flags),
+ ppStmt => SQL_Handle.Ptr'Access,
+ pzTail => null);
+ if Status_Code (Code) /= 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)
+ is
+ -- int sqlite3_step(sqlite3_stmt*);
+ function sqlite3_step
+ (Stmt : in Statement_Private_Access)
+ return Interfaces.C.int
+ with Import => True, Convention => C;
+
+ 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);
+ end if;
+ end Step;
+
+
+ procedure Finish
+ (SQL_Handle : in SQLite3_Statement)
+ is
+ -- int sqlite3_finalize(sqlite3_stmt*);
+ function sqlite3_finalize
+ (Stmt : in Statement_Private_Access)
+ return Interfaces.C.int
+ with Import => True, Convention => C;
+
+ Code : Interfaces.C.int;
+ Status : Status_Code;
+ begin
+ Code := sqlite3_finalize (SQL_Handle.Ptr);
+ Status := Status_Code (Code);
+ if Status /= SQLITE_OK then
+ raise Program_Error with Error_String (Status);
+ end if;
+ end Finish;
+
+
+ procedure Reset
+ (SQL_Handle : in SQLite3_Statement)
+ is
+ -- int sqlite3_reset(sqlite3_stmt*);
+ function sqlite3_reset
+ (Stmt : in Statement_Private_Access)
+ return Interfaces.C.int
+ 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);
+ end if;
+ end Reset;
+
+
+ procedure Bind
+ (SQL_Handle : in 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)
+ is
+ -- int sqlite3_bind_int(sqlite3_stmt*, int, int);
+ function sqlite3_bind_int
+ (Stmt : in Statement_Private_Access;
+ Index : in Interfaces.C.int;
+ Value : in Interfaces.C.int)
+ return Interfaces.C.int
+ 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);
+ end if;
+ end Bind;
+
+
+ procedure Bind
+ (SQL_Handle : in SQLite3_Statement;
+ Index : in SQL_Parameter_Index;
+ Value : in Ada.Strings.Unbounded.Unbounded_String)
+ is
+ use Ada.Strings.Unbounded;
+
+ -- int sqlite3_bind_text
+ -- (sqlite3_stmt*,
+ -- int,
+ -- const char*,
+ -- int,
+ -- void(*)(void*));
+ function sqlite3_bind_text
+ (Stmt : in Statement_Private_Access;
+ Index : in Interfaces.C.int;
+ Value : in Interfaces.C.char_array;
+ Bytes : in Interfaces.C.int;
+ Opt : in Interfaces.C.long)
+ return Interfaces.C.int
+ with Import => True, Convention => C;
+
+ Code : Interfaces.C.int;
+ Status : Status_Code;
+ begin
+ Code := sqlite3_bind_text
+ (Stmt => SQL_Handle.Ptr,
+ Index => Interfaces.C.int (Index),
+ 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);
+ end if;
+ end Bind;
+
+
+ procedure Column
+ (SQL_Handle : in SQLite3_Statement;
+ Index : in SQL_Column_Index;
+ Value : out Int)
+ is
+ -- int sqlite3_column_int(sqlite3_stmt*, int iCol);
+ function sqlite3_column_int
+ (Stmt : in Statement_Private_Access;
+ Index : in Interfaces.C.int)
+ return Interfaces.C.int
+ with Import => True, Convention => C;
+
+ Ret_Val : Interfaces.C.int;
+ begin
+ Ret_Val := sqlite3_column_int
+ (Stmt => SQL_Handle.Ptr,
+ Index => Interfaces.C.int (Index));
+ Value := Int (Ret_Val);
+ end Column;
+
+
+ procedure Column
+ (SQL_Handle : in SQLite3_Statement;
+ Index : in SQL_Column_Index;
+ Value : out Ada.Strings.Unbounded.Unbounded_String)
+ is
+ use Ada.Strings.Unbounded;
+ use Interfaces;
+ use type Interfaces.C.Strings.chars_ptr;
+
+ -- const unsigned char *sqlite3_column_text(sqlite3_stmt*, int iCol);
+ function sqlite3_column_text
+ (Stmt : in Statement_Private_Access;
+ Index : in Interfaces.C.int)
+ return Interfaces.C.Strings.chars_ptr
+ with Import => True, Convention => C;
+
+ Ret_Val : Interfaces.C.Strings.chars_ptr;
+ begin
+ Ret_Val := sqlite3_column_text
+ (Stmt => SQL_Handle.Ptr,
+ Index => Interfaces.C.int (Index));
+ if Ret_Val = C.Strings.Null_Ptr then
+ Value := Null_Unbounded_String;
+ else
+ Value := To_Unbounded_String (C.To_Ada (C.Strings.Value (Ret_Val)));
+ end if;
+ end Column;
+
+
+ function Error_Message
+ (Handle : in SQLite3_DB)
+ return String
+ is
+ use Interfaces;
+
+ -- const char *sqlite3_errmsg(sqlite3*);
+ function sqlite3_errmsg
+ (DB_Handle : in DB_Private_Access)
+ return C.Strings.chars_ptr
+ with Import => True, Convention => C;
+ begin
+ return C.To_Ada (C.Strings.Value (sqlite3_errmsg (Handle.Ptr)));
+ end Error_Message;
+
+
+ function Error_String
+ (Status : in Status_Code)
+ return String
+ is
+ use Interfaces;
+
+ function sqlite3_errstr
+ (Code : in Interfaces.C.int)
+ return C.Strings.chars_ptr
+ with Import => True, Convention => C;
+ begin
+ return C.To_Ada (C.Strings.Value (sqlite3_errstr (Interfaces.C.int (Status))));
+ end Error_String;
+
+
+end SQLite3;
+
+
diff --git a/src/sqlite3.ads b/src/sqlite3.ads
new file mode 100644
index 0000000..667fdd6
--- /dev/null
+++ b/src/sqlite3.ads
@@ -0,0 +1,148 @@
+
+
+with
+
+ Ada.Strings.Unbounded,
+ System,
+ Interfaces.C;
+
+
+package SQLite3 is
+
+
+ type SQLite3_DB is private;
+ type SQLite3_Statement is private;
+
+ type Open_Flag is mod 2**32;
+ type Prepare_Flag is mod 2**32;
+ type Status_Code is new Long_Integer;
+
+ 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;
+ OPEN_READWRITE : constant Open_Flag := 2;
+ OPEN_CREATE : constant Open_Flag := 4;
+ OPEN_DELETEONCLOSE : constant Open_Flag := 8;
+ OPEN_EXCLUSIVE : constant Open_Flag := 16;
+ OPEN_AUTOPROXY : constant Open_Flag := 32;
+ OPEN_URI : constant Open_Flag := 64;
+ OPEN_MEMORY : constant Open_Flag := 128;
+ OPEN_MAIN_DB : constant Open_Flag := 256;
+ OPEN_TEMP_DB : constant Open_Flag := 512;
+ OPEN_TRANSIENT_DB : constant Open_Flag := 1024;
+ OPEN_MAIN_JOURNAL : constant Open_Flag := 2048;
+ OPEN_TEMP_JOURNAL : constant Open_Flag := 4096;
+ OPEN_SUBJOURNAL : constant Open_Flag := 8192;
+ OPEN_SUPER_JOURNAL : constant Open_Flag := 16384;
+ OPEN_NOMUTEX : constant Open_Flag := 32768;
+ OPEN_FULLMUTEX : constant Open_Flag := 65536;
+ OPEN_SHAREDCACHE : constant Open_Flag := 131072;
+ OPEN_PRIVATECACHE : constant Open_Flag := 262144;
+ OPEN_WAL : constant Open_Flag := 524288;
+ OPEN_NOFOLLOW : constant Open_Flag := 16777216;
+
+ PREPARE_PERSISTENT : constant Prepare_Flag := 1;
+ PREPARE_NORMALIZE : constant Prepare_Flag := 2;
+ PREPARE_NO_VTAB : constant Prepare_Flag := 4;
+
+ SQLITE_OK : constant Status_Code := 0;
+ SQLITE_ROW : constant Status_Code := 100;
+ SQLITE_DONE : constant Status_Code := 101;
+
+ SQLITE_TRANSIENT : constant := -1;
+
+
+ procedure Open
+ (Filename : in String;
+ Handle : out SQLite3_DB);
+
+ procedure Open
+ (Filename : in String;
+ Handle : out SQLite3_DB;
+ 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);
+
+ procedure Prepare
+ (Handle : in SQLite3_DB;
+ SQL : in String;
+ Flags : in Prepare_Flag;
+ SQL_Handle : out SQLite3_Statement);
+
+ procedure Step
+ (SQL_Handle : in SQLite3_Statement;
+ Status : out Status_Code);
+
+ procedure Finish
+ (SQL_Handle : in SQLite3_Statement);
+
+ procedure Reset
+ (SQL_Handle : in SQLite3_Statement);
+
+ procedure Bind
+ (SQL_Handle : in 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);
+
+ procedure Bind
+ (SQL_Handle : in 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);
+
+ procedure Column
+ (SQL_Handle : in SQLite3_Statement;
+ Index : in SQL_Column_Index;
+ Value : out Ada.Strings.Unbounded.Unbounded_String);
+
+
+private
+
+
+ -- There are actually many more errors than this
+ SQLITE_ERROR : constant Status_Code := 1;
+
+ function Error_Message
+ (Handle : in SQLite3_DB)
+ return String;
+
+ function Error_String
+ (Status : in Status_Code)
+ return String;
+
+
+ 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;
+ end record;
+
+ 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;
+ end record;
+
+
+end SQLite3;
+
+