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 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); Deck.SQL_Handle.Open (Temp); 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; Deck.SQL_Handle.Close; 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 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; 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;