diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/datatypes.ads | 11 | ||||
| -rw-r--r-- | src/deck_convert.adb | 4 | ||||
| -rw-r--r-- | src/deck_io.adb | 81 | ||||
| -rw-r--r-- | src/deck_io.ads | 6 |
4 files changed, 85 insertions, 17 deletions
diff --git a/src/datatypes.ads b/src/datatypes.ads index 164e7c9..7229f2d 100644 --- a/src/datatypes.ads +++ b/src/datatypes.ads @@ -72,14 +72,17 @@ package Datatypes is subtype Note_Vector is Note_Vectors.Vector; - type Media_ID is new SU.Unbounded_String; type Media_Name is new SU.Unbounded_String; + type Media_ID is new SU.Unbounded_String; package Media_Maps is new Ada.Containers.Ordered_Maps - (Key_Type => Media_ID, - Element_Type => Media_Name); + (Key_Type => Media_Name, + Element_Type => Media_ID); - subtype Media_Map is Media_Maps.Map; + type Media_Collection is record + Filename : SU.Unbounded_String; + Map : Media_Maps.Map; + end record; end Datatypes; diff --git a/src/deck_convert.adb b/src/deck_convert.adb index 75a35d0..7037944 100644 --- a/src/deck_convert.adb +++ b/src/deck_convert.adb @@ -105,7 +105,7 @@ procedure Deck_Convert is Deck : Deck_IO.Deck_Handle; Models : Model_Map; Notes : Note_Vector; - Media : Media_Map; + Media : Media_Collection; begin @@ -270,7 +270,7 @@ begin if Verbose then Put (Standard_Error, "Reading media..."); end if; - Deck_IO.Read_Media_Map (-Input_Name, Media); + Deck_IO.Read_Media_Collection (-Input_Name, Media); if Verbose then Put_Line (Standard_Error, " Done"); Put (Standard_Error, "Writing output to Fresh Memory Dictionary..."); diff --git a/src/deck_io.adb b/src/deck_io.adb index 4c87164..2e2d1b4 100644 --- a/src/deck_io.adb +++ b/src/deck_io.adb @@ -105,9 +105,9 @@ package body Deck_IO is - procedure Read_Media_Map + procedure Read_Media_Collection (Filename : in String; - Media : out Media_Map) + Media : out Media_Collection) is Temp : String := Generate_Temp_Name; @@ -121,7 +121,7 @@ package body Deck_IO is is Val : SU.Unbounded_String := JS.Get (Value); begin - Media.Insert (Media_ID (+Name), Media_Name (Val)); + Media.Map.Insert (Media_Name (Val), Media_ID (+Name)); end Map_Iteration; begin UnZip.Extract (Filename, "media", Temp); @@ -135,7 +135,8 @@ package body Deck_IO is JSON_Data := JS.Read (-Raw_Data); JS.Map_JSON_Object (JSON_Data, Map_Iteration'Access); - end Read_Media_Map; + Media.Filename := +Filename; + end Read_Media_Collection; @@ -349,6 +350,63 @@ package body Deck_IO is end Compose_Name; + function Compose_Dir + (Directory : in String; + Basename : 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; + return Result; + end Compose_Dir; + + + procedure Extract_Images + (Texts : in out Datatypes.Field_Vector; + Outdir : in SU.Unbounded_String; + Media : in Media_Collection) + is + use type Pat.Match_Location; + Matches : Pat.Match_Array (0 .. 2); + Regexp : Pat.Pattern_Matcher := Pat.Compile + -- Absolutely disgusting regexes + ("<img\s+(?:alt=""[^""]*""\s+|alt=\S*\s+)?src=(?:""([^""]*)""|(\S*)\s)\s*/>", + Pat.Single_Line); + Marker : Positive; + Location : Pat.Match_Location; + Match_Name : SU.Unbounded_String; + begin + for Text of Texts loop + Marker := 1; + loop + Pat.Match (Regexp, -(SU.Unbounded_String (Text)), Matches, Marker); + exit when Matches (0) = Pat.No_Match; + Location := (if Matches (1) = Pat.No_Match then Matches (2) else Matches (1)); + Match_Name := SU.Unbounded_Slice + (SU.Unbounded_String (Text), Location.First, Location.Last); + if Media.Map.Contains (Media_Name (Match_Name)) then + if not FD.Exists (-Outdir) then + FD.Create_Directory (-Outdir); + end if; + if not FD.Exists (FD.Compose (-Outdir, -Match_Name)) then + UnZip.Extract + (-Media.Filename, + SU.To_String (SU.Unbounded_String + (Media.Map.Element (Media_Name (Match_Name)))), + FD.Compose (-Outdir, -Match_Name)); + end if; + SU.Insert (SU.Unbounded_String (Text), Location.First, "%%/"); + end if; + Marker := Matches (0).Last + 1; + end loop; + end loop; + end Extract_Images; + + procedure Write_CSV @@ -395,23 +453,28 @@ package body Deck_IO is Basename : in String; Models : in Model_Map; Notes : in Note_Vector; - Media : in Media_Map; + Media : in Media_Collection; Overwrite : in Boolean := False) is Counter : Positive := 1; - Outname : SU.Unbounded_String; + Outname, Outdir : SU.Unbounded_String; File_Handle : TIO.File_Type; + Current_Entry : Datatypes.Field_Vector; Entry_Size : Positive; begin for C in Models.Iterate loop Outname := Compose_Name (Directory, Basename, "fmd", Counter); + Outdir := Compose_Dir (Directory, Basename, Counter); if FD.Exists (-Outname) then if not Overwrite then - raise FD.Name_Error; + raise FD.Name_Error with "output file " & (-Outname) & " already exists"; else FD.Delete_File (-Outname); end if; end if; + if FD.Exists (-Outdir) and not Overwrite then + raise FD.Name_Error with "output directory " & (-Outdir) & " already exists"; + end if; TIO.Create (File_Handle, TIO.Out_File, -Outname); Entry_Size := Positive (Model_Maps.Element (C).Fields.Length); FMD.Put_Header (File_Handle); @@ -424,7 +487,9 @@ package body Deck_IO is FMD.Start_Entry_Section (File_Handle); for N of Notes loop if N.Model = Model_Maps.Key (C) then - FMD.Put_Entry (File_Handle, N.Fields, Entry_Size); + Current_Entry := N.Fields; + Extract_Images (Current_Entry, Outdir, Media); + FMD.Put_Entry (File_Handle, Current_Entry, Entry_Size); end if; end loop; FMD.End_Entry_Section (File_Handle); diff --git a/src/deck_io.ads b/src/deck_io.ads index 0145c4e..2f00207 100644 --- a/src/deck_io.ads +++ b/src/deck_io.ads @@ -29,9 +29,9 @@ package Deck_IO is return Boolean; - procedure Read_Media_Map + procedure Read_Media_Collection (Filename : in String; - Media : out Datatypes.Media_Map); + Media : out Datatypes.Media_Collection); procedure Open_Database @@ -71,7 +71,7 @@ package Deck_IO is Basename : in String; Models : in Datatypes.Model_Map; Notes : in Datatypes.Note_Vector; - Media : in Datatypes.Media_Map; + Media : in Datatypes.Media_Collection; Overwrite : in Boolean := False) with Pre => Matches (Models, Notes); |