diff options
| -rw-r--r-- | freshdeck.gpr | 10 | ||||
| -rw-r--r-- | src/deck_convert.adb | 113 | ||||
| -rw-r--r-- | src/deck_io.adb | 298 | ||||
| -rw-r--r-- | src/deck_io.ads | 149 | ||||
| -rw-r--r-- | src/sqlite3.adb | 372 | ||||
| -rw-r--r-- | src/sqlite3.ads | 148 |
6 files changed, 1050 insertions, 40 deletions
diff --git a/freshdeck.gpr b/freshdeck.gpr index f3065e0..d5b0450 100644 --- a/freshdeck.gpr +++ b/freshdeck.gpr @@ -1,6 +1,7 @@ -- with "fltkada"; +with "gnatcoll"; with "zipada_lib"; @@ -23,13 +24,14 @@ project Freshdeck is package Compiler is - for Default_Switches("Ada") use ("-gnaty4aAbcefhiklM100nprt"); + for Default_Switches ("Ada") use ("-gnaty4aAbcefhiklM100nprt"); end Compiler; - -- package Linker is - -- for Default_Switches("Ada") use ("-lfltk", "-lfltk_images"); - -- end Linker; + package Linker is + -- for Default_Switches("Ada") use ("-lfltk", "-lfltk_images"); + for Default_Switches ("Ada") use ("-lsqlite3"); + end Linker; end Freshdeck; 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; + + |