From 3ddfc80f519cfe5910ba36ea48f1767af9fef75e Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Tue, 2 Nov 2021 23:32:45 +1300 Subject: Models are queried --- src/deck_io.adb | 298 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 298 insertions(+) create mode 100644 src/deck_io.adb (limited to 'src/deck_io.adb') 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; + + -- cgit