1 files changed, 298 insertions, 0 deletions
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;
+
+