3776e82 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Fix MediaBag regressions.

3776e82John MacFarlane5 years ago

MANUAL.txt+6−6

compare with master

unifiedsplit

@@ -675,12 +675,12 @@ header when requesting a document from a URL:

675: Extract images and other media contained in or linked from

676 the source document to the path *DIR*, creating it if

677 necessary, and adjust the images references in the document

678− so they point to the extracted files. If the source format is

678+ so they point to the extracted files. Media are downloaded,

679− a binary container (docx, epub, or odt), the media is

679+ read from the file system, or extracted from a binary

680− extracted from the container and the original

680+ container (e.g. docx), as needed. The original file paths

681− filenames are used. Otherwise the media is read from the

681+ are used if they are relative paths not containing `..`.

682− file system or downloaded, and new filenames are constructed

682+ Otherwise filenames are constructed from the SHA1 hash of

683− based on SHA1 hashes of the contents.

683+ the contents.

684

685`--abbreviations=`*FILE*

686

src/Text/Pandoc/Class/IO.hs+21−20

@@ -62,7 +62,7 @@ import Text.Pandoc.Definition (Pandoc, Inline (Image))

62import Text.Pandoc.Error (PandocError (..))

63import Text.Pandoc.Logging (LogMessage (..), messageVerbosity, showLogMessage)

64import Text.Pandoc.MIME (MimeType)

65−import Text.Pandoc.MediaBag (MediaBag, MediaItem(..), lookupMedia, mediaDirectory)

65+import Text.Pandoc.MediaBag (MediaBag, MediaItem(..), lookupMedia, mediaItems)

66import Text.Pandoc.Walk (walk)

67import qualified Control.Exception as E

68import qualified Data.ByteString as B

@@ -200,31 +200,32 @@ alertIndent (l:ls) = do

200extractMedia :: (PandocMonad m, MonadIO m) => FilePath -> Pandoc -> m Pandoc

201extractMedia dir d = do

202 media <- getMediaBag

203− case [fp | (fp, _, _) <- mediaDirectory media] of

203+ let items = mediaItems media

204+ if null items

204− [] -> return d

205+ then return d

205− fps -> do

206+ else do

206− mapM_ (writeMedia dir media) fps

207+ mapM_ (writeMedia dir) items

207− return $ walk (adjustImagePath dir fps) d

208+ return $ walk (adjustImagePath dir media) d

208

209

209-- | Write the contents of a media bag to a path.

210-- | Write the contents of a media bag to a path.

210writeMedia :: (PandocMonad m, MonadIO m)

211writeMedia :: (PandocMonad m, MonadIO m)

211− => FilePath -> MediaBag -> FilePath

212+ => FilePath

213+ -> (FilePath, MimeType, BL.ByteString)

212 -> m ()

214 -> m ()

213−writeMedia dir mediabag subpath = do

215+writeMedia dir (fp, _mt, bs) = do

214− let mbcontents = lookupMedia subpath mediabag

215− case mbcontents of

216− Nothing -> throwError $ PandocResourceNotFound $ pack subpath

217− Just item -> do

218− -- we normalize to get proper path separators for the platform

216+ -- we normalize to get proper path separators for the platform

219− let fullpath = dir </> normalise (mediaPath item)

217+ let fullpath = normalise $ dir </> fp

220− liftIOError (createDirectoryIfMissing True) (takeDirectory fullpath)

218+ liftIOError (createDirectoryIfMissing True) (takeDirectory fullpath)

221− logIOError $ BL.writeFile fullpath $ mediaContents item

219+ logIOError $ BL.writeFile fullpath bs

222

220

223-- | If the given Inline element is an image with a @src@ path equal to

221-- | If the given Inline element is an image with a @src@ path equal to

224-- one in the list of @paths@, then prepends @dir@ to the image source;

222-- one in the list of @paths@, then prepends @dir@ to the image source;

225-- returns the element unchanged otherwise.

223-- returns the element unchanged otherwise.

226−adjustImagePath :: FilePath -> [FilePath] -> Inline -> Inline

224+adjustImagePath :: FilePath -> MediaBag -> Inline -> Inline

227−adjustImagePath dir paths (Image attr lab (src, tit))

225+adjustImagePath dir mediabag (Image attr lab (src, tit)) =

228− | unpack src `elem` paths

226+ case lookupMedia (T.unpack src) mediabag of

227+ Nothing -> Image attr lab (src, tit)

228+ Just item ->

229+ let fullpath = dir </> mediaPath item

229− = Image attr lab (pack (normalise $ dir </> unpack src), tit)

230+ in Image attr lab (T.pack fullpath, tit)

230adjustImagePath _ _ x = x

231adjustImagePath _ _ x = x

src/Text/Pandoc/Class/PandocMonad.hs+6−11

@@ -638,17 +638,12 @@ fillMediaBag d = walkM handleImage d

638 handleImage (Image attr lab (src, tit)) = catchError

639 (do mediabag <- getMediaBag

640 let fp = T.unpack src

641− src' <- T.pack <$> case lookupMedia fp mediabag of

641+ case lookupMedia fp mediabag of

642− Just item -> return $ mediaPath item

642+ Just _ -> return ()

643− Nothing -> do

643+ Nothing -> do

644− (bs, mt) <- fetchItem src

644+ (bs, mt) <- fetchItem src

645− insertMedia fp mt (BL.fromStrict bs)

645+ insertMedia fp mt (BL.fromStrict bs)

646− mediabag' <- getMediaBag

647− case lookupMedia fp mediabag' of

648− Just item -> return $ mediaPath item

649− Nothing -> throwError $ PandocSomeError $

650− src <> " not successfully inserted into MediaBag"

651− return $ Image attr lab (src', tit))

646+ return $ Image attr lab (src, tit))

652 (\e ->

647 (\e ->

653 case e of

648 case e of

654 PandocResourceNotFound _ -> do

649 PandocResourceNotFound _ -> do

src/Text/Pandoc/MediaBag.hs+14−11

@@ -71,16 +71,21 @@ insertMedia :: FilePath -- ^ relative path and canonical name of resource

71 -> MediaBag

72 -> MediaBag

73insertMedia fp mbMime contents (MediaBag mediamap) =

74− MediaBag (M.insert (canonicalize fp) mediaItem mediamap)

74+ MediaBag (M.insert fp' mediaItem mediamap)

75− where mediaItem = MediaItem{ mediaPath = showDigest (sha1 contents) <>

75+ where mediaItem = MediaItem{ mediaPath = newpath

76− "." <> ext

77 , mediaContents = contents

76 , mediaContents = contents

78 , mediaMimeType = mt }

77 , mediaMimeType = mt }

78+ fp' = canonicalize fp

79+ newpath = if isRelative fp && ".." `notElem` splitPath fp

80+ then T.unpack fp'

81+ else showDigest (sha1 contents) <> "." <> ext

79 fallback = case takeExtension fp of

82 fallback = case takeExtension fp of

80 ".gz" -> getMimeTypeDef $ dropExtension fp

83 ".gz" -> getMimeTypeDef $ dropExtension fp

81 _ -> getMimeTypeDef fp

84 _ -> getMimeTypeDef fp

82 mt = fromMaybe fallback mbMime

85 mt = fromMaybe fallback mbMime

86+ ext = case takeExtension fp of

87+ '.':e -> e

83− ext = maybe (takeExtension fp) T.unpack $ extensionFromMimeType mt

88+ _ -> maybe "" T.unpack $ extensionFromMimeType mt

86-- | Lookup a media item in a 'MediaBag', returning mime type and contents.

91-- | Lookup a media item in a 'MediaBag', returning mime type and contents.

@@ -92,13 +97,11 @@ lookupMedia fp (MediaBag mediamap) = M.lookup (canonicalize fp) mediamap

92-- | Get a list of the file paths stored in a 'MediaBag', with

97-- | Get a list of the file paths stored in a 'MediaBag', with

93-- their corresponding mime types and the lengths in bytes of the contents.

98-- their corresponding mime types and the lengths in bytes of the contents.

94mediaDirectory :: MediaBag -> [(FilePath, MimeType, Int)]

99mediaDirectory :: MediaBag -> [(FilePath, MimeType, Int)]

95−mediaDirectory (MediaBag mediamap) =

100+mediaDirectory mediabag =

96− M.foldrWithKey (\fp item ->

97− ((T.unpack fp, mediaMimeType item,

98− fromIntegral (BL.length (mediaContents item))):)) [] mediamap

101+ map (\(fp, mt, bs) -> (fp, mt, fromIntegral (BL.length bs)))

102+ (mediaItems mediabag)

103

100mediaItems :: MediaBag -> [(FilePath, MimeType, BL.ByteString)]

104mediaItems :: MediaBag -> [(FilePath, MimeType, BL.ByteString)]

101mediaItems (MediaBag mediamap) =

105mediaItems (MediaBag mediamap) =

102− M.foldrWithKey (\fp item ->

103− ((T.unpack fp, mediaMimeType item, mediaContents item):))

106+ map (\item -> (mediaPath item, mediaMimeType item, mediaContents item))

104− [] mediamap

107+ (M.elems mediamap)