diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/csv.adb | 91 | ||||
| -rw-r--r-- | src/csv.ads | 64 | ||||
| -rw-r--r-- | src/deck_convert.adb | 39 | ||||
| -rw-r--r-- | src/deck_io.adb | 74 | ||||
| -rw-r--r-- | src/deck_io.ads | 6 |
5 files changed, 248 insertions, 26 deletions
diff --git a/src/csv.adb b/src/csv.adb new file mode 100644 index 0000000..9d4f498 --- /dev/null +++ b/src/csv.adb @@ -0,0 +1,91 @@ + + +with + + Ada.Characters.Latin_1, + Ada.Strings.Fixed, + Ada.Strings.Maps, + Ada.Text_IO; + +use + + Ada.Text_IO; + + +package body CSV is + + + package Latin renames Ada.Characters.Latin_1; + package Strfix renames Ada.Strings.Fixed; + package Strmap renames Ada.Strings.Maps; + + + + + procedure Put_Cell + (File_Handle : in Ada.Text_IO.File_Type; + Data : in String) is + begin + Put_Cell (File_Handle, +Data); + end Put_Cell; + + + procedure Put_Cell + (File_Handle : in Ada.Text_IO.File_Type; + Data : in Ada.Strings.Unbounded.Unbounded_String) + is + Processed : SU.Unbounded_String := Data; + Position : Natural; + begin + -- Deal with any lurking linefeed characters + loop + Position := SU.Index (Processed, Strmap.To_Set (Latin.LF)); + exit when Position = 0; + SU.Replace_Element (Processed, Position, ' '); + end loop; + + -- Escape any quizzical quotation characters + Position := SU.Index (Processed, Strmap.To_Set (Quote_Char)); + while Position /= 0 loop + SU.Insert (Processed, Position, Strfix."*" (1, Escape_Char)); + Position := Position + 2; -- skip over the \" we already know about + exit when Position > SU.Length (Processed); + Position := SU.Index (Processed, Strmap.To_Set (Quote_Char), Position); + end loop; + + -- Surround any suspicious separator characters + if SU.Index (Processed, Strmap.To_Set (Separator_Char)) /= 0 then + SU.Insert (Processed, 1, Strfix."*" (1, Quote_Char)); + SU.Append (Processed, Quote_Char); + end if; + + Put (File_Handle, -Processed); + end Put_Cell; + + + procedure Put_Row + (File_Handle : in Ada.Text_IO.File_Type; + Cells : in Data_Vectors.Vector; + Quantity : in Positive) + is + Counter : Positive := 1; + Position : Vector_Index := Cells.First_Index; + begin + while Counter < Quantity loop + if Position <= Cells.Last_Index then + Put_Cell (File_Handle, To_Unbounded_String (Cells.Element (Position))); + end if; + Put (File_Handle, Separator_Char); + Position := Vector_Index'Succ (Position); + Counter := Counter + 1; + end loop; + if Position <= Cells.Last_Index then + Put_Cell (File_Handle, To_Unbounded_String (Cells.Element (Position))); + end if; + New_Line (File_Handle); + end Put_Row; + + +end CSV; + + diff --git a/src/csv.ads b/src/csv.ads new file mode 100644 index 0000000..cc1eef5 --- /dev/null +++ b/src/csv.ads @@ -0,0 +1,64 @@ + + +with + + Ada.Containers.Vectors, + Ada.Strings.Unbounded, + Ada.Text_IO; + + +generic + + Separator_Char : Character := ','; + Quote_Char : Character := '"'; + Escape_Char : Character := '\'; + +package CSV is + + + procedure Put_Cell + (File_Handle : in Ada.Text_IO.File_Type; + Data : in String); + + procedure Put_Cell + (File_Handle : in Ada.Text_IO.File_Type; + Data : in Ada.Strings.Unbounded.Unbounded_String); + + + generic + + type Vector_Index is range <>; + type Vector_Data is private; + + with package Data_Vectors is new Ada.Containers.Vectors (Vector_Index, Vector_Data); + + with function To_Unbounded_String + (Data : in Vector_Data) + return Ada.Strings.Unbounded.Unbounded_String is <>; + + procedure Put_Row + (File_Handle : in Ada.Text_IO.File_Type; + Cells : in Data_Vectors.Vector; + Quantity : in Positive); + + +private + + + package SU renames Ada.Strings.Unbounded; + + + 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; + + +end CSV; + + diff --git a/src/deck_convert.adb b/src/deck_convert.adb index 94b7098..a8c8673 100644 --- a/src/deck_convert.adb +++ b/src/deck_convert.adb @@ -26,11 +26,11 @@ procedure Deck_Convert is package ACom renames Ada.Command_Line; package GCom renames GNAT.Command_Line; package GStr renames GNAT.Strings; - package File renames Ada.Directories; + package FD renames Ada.Directories; package SU renames Ada.Strings.Unbounded; - use type File.File_Kind; + use type FD.File_Kind; use type SU.Unbounded_String; @@ -148,7 +148,7 @@ begin return; end if; Input_Name := +(Input_Arg.all); - if not File.Exists (-Input_Name) then + if not FD.Exists (-Input_Name) then Put_Line (Standard_Error, "Input deck does not exist." & Latin.LF & Further_Help); ACom.Set_Exit_Status (ACom.Failure); @@ -157,13 +157,13 @@ begin if Output_Arg.all = "" then - Put_Line (Standard_Error, "File name for output deck was not provided." & + Put_Line (Standard_Error, "Base file name for output deck was not provided." & Latin.LF & Further_Help); ACom.Set_Exit_Status (ACom.Failure); return; end if; Output_Name := +(Output_Arg.all); - if File.Exists ((-Output_Name) & "." & (-Deck_Format)) and not Overwrite then + if FD.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); @@ -171,14 +171,6 @@ 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; - -- 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 @@ -204,14 +196,19 @@ begin 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; + declare + Contain_Dir : String := FD.Containing_Directory (-Output_Name); + Simple_Name : String := FD.Simple_Name (-Output_Name); + begin + if Deck_Format = "csv" then + Deck_IO.Write_CSV (Contain_Dir, Simple_Name, Models, Notes, Overwrite); + elsif Deck_Format = "fmd" then + Deck_IO.Read_Media_Map (-Input_Name, Media); + Deck_IO.Write_FMD (Contain_Dir, Simple_Name, Models, Notes, Media, Overwrite); + else + raise Constraint_Error; + end if; + end; end Deck_Convert; diff --git a/src/deck_io.adb b/src/deck_io.adb index c0dd38c..9e5b4b7 100644 --- a/src/deck_io.adb +++ b/src/deck_io.adb @@ -4,8 +4,10 @@ with Ada.Characters.Latin_1, Ada.Directories, + Ada.Strings.Fixed, Ada.Strings.Maps, Ada.Text_IO, + CSV, GNAT.Regpat, GNATCOLL.JSON, UnZip; @@ -20,6 +22,7 @@ package body Deck_IO is package Latin renames Ada.Characters.Latin_1; package FD renames Ada.Directories; + package Strfix renames Ada.Strings.Fixed; package Strmap renames Ada.Strings.Maps; package Pat renames GNAT.Regpat; package JS renames GNATCOLL.JSON; @@ -36,6 +39,21 @@ package body Deck_IO is renames SU.To_String; + function To_Unbounded_String + (Item : in Field_ID) + return SU.Unbounded_String is + begin + return SU.Unbounded_String (Item); + end To_Unbounded_String; + + function To_Unbounded_String + (Item : in Field) + return SU.Unbounded_String is + begin + return SU.Unbounded_String (Item); + end To_Unbounded_String; + + procedure Finalize @@ -299,29 +317,79 @@ package body Deck_IO is Current_Note.Model := Model_ID (Raw_Model); Tokenize_Fields (Statement.Column (1), Current_Note.Fields); Notes.Append (Current_Note); + Current_Note.Fields.Clear; end loop; end Query_Notes; + function Compose_Name + (Directory : in String; + Basename : in String; + Extension : in String; + Model_Num : in Positive) + return SU.Unbounded_String + is + Result : SU.Unbounded_String := +FD.Compose (Directory, Basename); + begin + if Model_Num > 1 then + SU.Append (Result, "-" & Strfix.Trim (Integer'Image (Model_Num), Ada.Strings.Left)); + end if; + SU.Append (Result, "." & Extension); + return Result; + end Compose_Name; + + + + procedure Write_CSV (Directory : in String; Basename : in String; Models : in Model_Maps.Map; - Notes : in Note_Vectors.Vector) + Notes : in Note_Vectors.Vector; + Overwrite : in Boolean := False) is + package My_CSV is new CSV; + procedure Put_Header is new My_CSV.Put_Row (Field_Ordinal, Field_ID, Field_ID_Vectors); + procedure Put_Row is new My_CSV.Put_Row (Field_Ordinal, Field, Field_Vectors); + + Counter : Positive := 1; + Outname : SU.Unbounded_String; + File_Handle : File_Type; + Row_Size : Positive; begin - null; + for C in Models.Iterate loop + Outname := Compose_Name (Directory, Basename, "csv", Counter); + if FD.Exists (-Outname) then + if not Overwrite then + raise FD.Name_Error; + else + FD.Delete_File (-Outname); + end if; + end if; + Create (File_Handle, Out_File, -Outname); + Row_Size := Positive (Model_Maps.Element (C).Fields.Length); + Put_Header (File_Handle, Model_Maps.Element (C).Fields, Row_Size); + for N of Notes loop + if N.Model = Model_Maps.Key (C) then + Put_Row (File_Handle, N.Fields, Row_Size); + end if; + end loop; + Close (File_Handle); + end loop; 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) + Media : in Media_Maps.Map; + Overwrite : in Boolean := False) is begin null; diff --git a/src/deck_io.ads b/src/deck_io.ads index e7723a3..7121a37 100644 --- a/src/deck_io.ads +++ b/src/deck_io.ads @@ -116,7 +116,8 @@ package Deck_IO is (Directory : in String; Basename : in String; Models : in Model_Maps.Map; - Notes : in Note_Vectors.Vector) + Notes : in Note_Vectors.Vector; + Overwrite : in Boolean := False) with Pre => Matches (Models, Notes); procedure Write_FMD @@ -124,7 +125,8 @@ package Deck_IO is Basename : in String; Models : in Model_Maps.Map; Notes : in Note_Vectors.Vector; - Media : in Media_Maps.Map) + Media : in Media_Maps.Map; + Overwrite : in Boolean := False) with Pre => Matches (Models, Notes); |