@@ -64,8 +64,6 @@ import Text.XML.Light ( unode, Element(..), unqual, Attr(..), add_attrs
64import Text.Pandoc.UUID (getRandomUUID)
64import Text.Pandoc.UUID (getRandomUUID)
65import Text.Pandoc.Writers.HTML (writeHtmlString, writeHtml)
65import Text.Pandoc.Writers.HTML (writeHtmlString, writeHtml)
66import Data.Char ( toLower, isDigit, isAlphaNum )
66import Data.Char ( toLower, isDigit, isAlphaNum )
67−import Network.URI ( unEscapeString, nonStrictRelativeTo,
68− escapeURIString, isAllowedInURI, parseURIReference )
69import Text.Pandoc.MIME (MimeType, getMimeType)
67import Text.Pandoc.MIME (MimeType, getMimeType)
70import qualified Control.Exception as E
68import qualified Control.Exception as E
71import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
69import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
@@ -766,23 +764,20 @@ metadataElement version md currentTime =
766showDateTimeISO8601 :: UTCTime -> String
764showDateTimeISO8601 :: UTCTime -> String
767showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ"
765showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ"
769−transformTag :: WriterOptions
770− -> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) media
767+transformTag :: IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) media
771 -> Tag String
768 -> Tag String
772 -> IO (Tag String)
769 -> IO (Tag String)
773−transformTag opts mediaRef tag@(TagOpen name attr)
770+transformTag mediaRef tag@(TagOpen name attr)
774 | name `elem` ["video", "source", "img", "audio"] = do
771 | name `elem` ["video", "source", "img", "audio"] = do
775 let src = fromAttrib "src" tag
772 let src = fromAttrib "src" tag
776 let poster = fromAttrib "poster" tag
773 let poster = fromAttrib "poster" tag
777− let oldsrc = src `relativeTo` writerSourceURL opts
778− let oldposter = poster `relativeTo` writerSourceURL opts
779− newsrc <- modifyMediaRef mediaRef oldsrc
774+ newsrc <- modifyMediaRef mediaRef src
780− newposter <- modifyMediaRef mediaRef oldposter
775+ newposter <- modifyMediaRef mediaRef poster
781 let attr' = filter (\(x,_) -> x /= "src" && x /= "poster") attr ++
776 let attr' = filter (\(x,_) -> x /= "src" && x /= "poster") attr ++
782 [("src", newsrc) | not (null newsrc)] ++
777 [("src", newsrc) | not (null newsrc)] ++
783 [("poster", newposter) | not (null newposter)]
778 [("poster", newposter) | not (null newposter)]
784 return $ TagOpen name attr'
779 return $ TagOpen name attr'
785−transformTag _ _ tag = return tag
780+transformTag _ tag = return tag
787modifyMediaRef :: IORef [(FilePath, FilePath)] -> FilePath -> IO FilePath
782modifyMediaRef :: IORef [(FilePath, FilePath)] -> FilePath -> IO FilePath
788modifyMediaRef _ "" = return ""
783modifyMediaRef _ "" = return ""
@@ -792,7 +787,7 @@ modifyMediaRef mediaRef oldsrc = do
792 Just n -> return n
787 Just n -> return n
793 Nothing -> do
788 Nothing -> do
794 let new = "media/file" ++ show (length media) ++
789 let new = "media/file" ++ show (length media) ++
795− takeExtension oldsrc
790+ takeExtension (takeWhile (/='?') oldsrc) -- remove query
796 modifyIORef mediaRef ( (oldsrc, new): )
791 modifyIORef mediaRef ( (oldsrc, new): )
797 return new
792 return new
@@ -800,10 +795,10 @@ transformBlock :: WriterOptions
800 -> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) media
795 -> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) media
802 -> IO Block
797 -> IO Block
803−transformBlock opts mediaRef (RawBlock fmt raw)
798+transformBlock _ mediaRef (RawBlock fmt raw)
804 | fmt == Format "html" = do
799 | fmt == Format "html" = do
805 let tags = parseTags raw
800 let tags = parseTags raw
806− tags' <- mapM (transformTag opts mediaRef) tags
801+ tags' <- mapM (transformTag mediaRef) tags
807 return $ RawBlock fmt (renderTags' tags')
802 return $ RawBlock fmt (renderTags' tags')
808transformBlock _ _ b = return b
803transformBlock _ _ b = return b
@@ -811,18 +806,17 @@ transformInline :: WriterOptions
811 -> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) media
806 -> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) media
812 -> Inline
807 -> Inline
813 -> IO Inline
808 -> IO Inline
814−transformInline opts mediaRef (Image lab (src,tit)) = do
809+transformInline _ mediaRef (Image lab (src,tit)) = do
815− let oldsrc = src `relativeTo` writerSourceURL opts
816− newsrc <- modifyMediaRef mediaRef oldsrc
810+ newsrc <- modifyMediaRef mediaRef src
817 return $ Image lab (newsrc, tit)
811 return $ Image lab (newsrc, tit)
818transformInline opts _ (x@(Math _ _))
812transformInline opts _ (x@(Math _ _))
819 | WebTeX _ <- writerHTMLMathMethod opts = do
813 | WebTeX _ <- writerHTMLMathMethod opts = do
820 raw <- makeSelfContained opts $ writeHtmlInline opts x
814 raw <- makeSelfContained opts $ writeHtmlInline opts x
821 return $ RawInline (Format "html") raw
815 return $ RawInline (Format "html") raw
822−transformInline opts mediaRef (RawInline fmt raw)
816+transformInline _ mediaRef (RawInline fmt raw)
823 | fmt == Format "html" = do
817 | fmt == Format "html" = do
824 let tags = parseTags raw
818 let tags = parseTags raw
825− tags' <- mapM (transformTag opts mediaRef) tags
819+ tags' <- mapM (transformTag mediaRef) tags
826 return $ RawInline fmt (renderTags' tags')
820 return $ RawInline fmt (renderTags' tags')
827transformInline _ _ x = return x
821transformInline _ _ x = return x
@@ -1205,10 +1199,3 @@ docTitle' meta = fromMaybe [] $ go <$> lookupMeta "title" meta
1205 go (MetaList xs) = concatMap go xs
1199 go (MetaList xs) = concatMap go xs
1206 go _ = []
1200 go _ = []
1208−relativeTo :: String -> Maybe String -> String
1209−relativeTo src mbbase =
1210− case (parseURIReference (ensureEscaped src),
1211− mbbase >>= parseURIReference . ensureEscaped) of
1212− (Just src', Just base') -> show (src' `nonStrictRelativeTo` base')
1213− _ -> unEscapeString src
1214− where ensureEscaped = escapeURIString isAllowedInURI