diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs index 91731d396..14a0b8044 100644 --- a/src/Text/Pandoc/Class.hs +++ b/src/Text/Pandoc/Class.hs @@ -93,15 +93,16 @@ import Network.URI ( escapeURIString, nonStrictRelativeTo, unEscapeString, parseURIReference, isAllowedInURI, parseURI, URI(..) ) import qualified Data.Time.LocalTime as IO (getCurrentTimeZone) -import Text.Pandoc.MediaBag (MediaBag, lookupMedia, extractMediaBag, - mediaDirectory) +import Text.Pandoc.MediaBag (MediaBag, lookupMedia, mediaDirectory) import Text.Pandoc.Walk (walkM, walk) import qualified Text.Pandoc.MediaBag as MB import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified System.Environment as IO (lookupEnv) import System.FilePath.Glob (match, compile) -import System.FilePath ((>), (<.>), takeExtension, dropExtension, isRelative) +import System.Directory (createDirectoryIfMissing) +import System.FilePath ((>), (<.>), takeDirectory, + takeExtension, dropExtension, isRelative, normalise) import qualified System.FilePath.Glob as IO (glob) import qualified System.Directory as IO (getModificationTime) import Control.Monad as M (fail) @@ -387,9 +388,23 @@ extractMedia dir d = do case [fp | (fp, _, _) <- mediaDirectory media] of [] -> return d fps -> do - liftIO $ extractMediaBag True dir media + mapM_ (writeMedia dir media) fps return $ walk (adjustImagePath dir fps) d +writeMedia :: FilePath -> MediaBag -> FilePath -> PandocIO () +writeMedia dir mediabag subpath = do + -- we join and split to convert a/b/c to a\b\c on Windows; + -- in zip containers all paths use / + let fullpath = dir > normalise subpath + let mbcontents = lookupMedia subpath mediabag + case mbcontents of + Nothing -> throwError $ PandocResourceNotFound subpath + Just (_, bs) -> do + report $ Extracting fullpath + liftIO $ do + createDirectoryIfMissing True $ takeDirectory fullpath + BL.writeFile fullpath bs + adjustImagePath :: FilePath -> [FilePath] -> Inline -> Inline adjustImagePath dir paths (Image attr lab (src, tit)) | src `elem` paths = Image attr lab (dir ++ "/" ++ src, tit) diff --git a/src/Text/Pandoc/Logging.hs b/src/Text/Pandoc/Logging.hs index 7afce9f5f..da8c775f6 100644 --- a/src/Text/Pandoc/Logging.hs +++ b/src/Text/Pandoc/Logging.hs @@ -89,6 +89,7 @@ data LogMessage = | CouldNotConvertTeXMath String String | CouldNotParseCSS String | Fetching String + | Extracting String | NoTitleElement String | NoLangSpecified | CouldNotHighlight String @@ -178,6 +179,8 @@ instance ToJSON LogMessage where ["message" .= Text.pack msg] Fetching fp -> ["path" .= Text.pack fp] + Extracting fp -> + ["path" .= Text.pack fp] NoTitleElement fallback -> ["fallback" .= Text.pack fallback] NoLangSpecified -> [] @@ -248,6 +251,8 @@ showLogMessage msg = "Could not parse CSS" ++ if null m then "" else (':':'\n':m) Fetching fp -> "Fetching " ++ fp ++ "..." + Extracting fp -> + "Extracting " ++ fp ++ "..." NoTitleElement fallback -> "This document format requires a nonempty