From 45b74609599af3065f572b032a25bd4819e7ff7a Mon Sep 17 00:00:00 2001 From: blmage Date: Sun, 16 Jun 2019 09:44:04 +0200 Subject: Do not override existing "fileN" medias when writing to EPUB format (fix #4206) --- src/Text/Pandoc/Writers/EPUB.hs | 23 ++++++++++++++++------- 1 file changed, 16 insertions(+), 7 deletions(-) (limited to 'src/Text/Pandoc/Writers/EPUB.hs') diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index 82b6e8221..82a6b4403 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -67,6 +67,7 @@ data Chapter = Chapter (Maybe [Int]) [Block] data EPUBState = EPUBState { stMediaPaths :: [(FilePath, (FilePath, Maybe Entry))] + , stMediaNextId :: Int , stEpubSubdir :: String } @@ -390,7 +391,7 @@ writeEPUB epubVersion opts doc = do -- sanity check on epubSubdir unless (all (\c -> isAscii c && isAlphaNum c) epubSubdir) $ throwError $ PandocEpubSubdirectoryError epubSubdir - let initState = EPUBState { stMediaPaths = [], stEpubSubdir = epubSubdir } + let initState = EPUBState { stMediaPaths = [], stMediaNextId = 0, stEpubSubdir = epubSubdir } evalStateT (pandocToEPUB epubVersion opts doc) initState pandocToEPUB :: PandocMonad m @@ -994,17 +995,25 @@ modifyMediaRef oldsrc = do Just (n,_) -> return n Nothing -> catchError (do (img, mbMime) <- P.fetchItem oldsrc - let new = "media/file" ++ show (length media) ++ - fromMaybe (takeExtension (takeWhile (/='?') oldsrc)) - (('.':) <$> (mbMime >>= extensionFromMimeType)) - entry <- mkEntry new (B.fromChunks . (:[]) $ img) + let ext = fromMaybe (takeExtension (takeWhile (/='?') oldsrc)) + (('.':) <$> (mbMime >>= extensionFromMimeType)) + newName <- getMediaNextNewName ext + let newPath = "media/" ++ newName + entry <- mkEntry newPath (B.fromChunks . (:[]) $ img) modify $ \st -> st{ stMediaPaths = - (oldsrc, (new, Just entry)):media} - return new) + (oldsrc, (newPath, Just entry)):media} + return newPath) (\e -> do report $ CouldNotFetchResource oldsrc (show e) return oldsrc) +getMediaNextNewName :: PandocMonad m => String -> E m String +getMediaNextNewName ext = do + nextId <- gets stMediaNextId + modify $ \st -> st { stMediaNextId = nextId + 1 } + let nextName = "file" ++ show nextId ++ ext + (P.fetchItem nextName >> getMediaNextNewName ext) `catchError` const (return nextName) + transformBlock :: PandocMonad m => Block -> E m Block -- cgit v1.2.3