EPUB reader: Further URI handling improvements.
Now we outsource most of the work to `fetchItem'`. Also, do not include queries in file extensions. Improves fix to #1671. It is possible that this will have some unexpected effects, so further testing would be good.
This commit is contained in:
parent
f8087b6c43
commit
2eaa0f6ab1
1 changed files with 12 additions and 25 deletions
|
@ -64,8 +64,6 @@ import Text.XML.Light ( unode, Element(..), unqual, Attr(..), add_attrs
|
|||
import Text.Pandoc.UUID (getRandomUUID)
|
||||
import Text.Pandoc.Writers.HTML (writeHtmlString, writeHtml)
|
||||
import Data.Char ( toLower, isDigit, isAlphaNum )
|
||||
import Network.URI ( unEscapeString, nonStrictRelativeTo,
|
||||
escapeURIString, isAllowedInURI, parseURIReference )
|
||||
import Text.Pandoc.MIME (MimeType, getMimeType)
|
||||
import qualified Control.Exception as E
|
||||
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
|
||||
|
@ -766,23 +764,20 @@ metadataElement version md currentTime =
|
|||
showDateTimeISO8601 :: UTCTime -> String
|
||||
showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ"
|
||||
|
||||
transformTag :: WriterOptions
|
||||
-> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) media
|
||||
transformTag :: IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) media
|
||||
-> Tag String
|
||||
-> IO (Tag String)
|
||||
transformTag opts mediaRef tag@(TagOpen name attr)
|
||||
transformTag mediaRef tag@(TagOpen name attr)
|
||||
| name `elem` ["video", "source", "img", "audio"] = do
|
||||
let src = fromAttrib "src" tag
|
||||
let poster = fromAttrib "poster" tag
|
||||
let oldsrc = src `relativeTo` writerSourceURL opts
|
||||
let oldposter = poster `relativeTo` writerSourceURL opts
|
||||
newsrc <- modifyMediaRef mediaRef oldsrc
|
||||
newposter <- modifyMediaRef mediaRef oldposter
|
||||
newsrc <- modifyMediaRef mediaRef src
|
||||
newposter <- modifyMediaRef mediaRef poster
|
||||
let attr' = filter (\(x,_) -> x /= "src" && x /= "poster") attr ++
|
||||
[("src", newsrc) | not (null newsrc)] ++
|
||||
[("poster", newposter) | not (null newposter)]
|
||||
return $ TagOpen name attr'
|
||||
transformTag _ _ tag = return tag
|
||||
transformTag _ tag = return tag
|
||||
|
||||
modifyMediaRef :: IORef [(FilePath, FilePath)] -> FilePath -> IO FilePath
|
||||
modifyMediaRef _ "" = return ""
|
||||
|
@ -792,7 +787,7 @@ modifyMediaRef mediaRef oldsrc = do
|
|||
Just n -> return n
|
||||
Nothing -> do
|
||||
let new = "media/file" ++ show (length media) ++
|
||||
takeExtension oldsrc
|
||||
takeExtension (takeWhile (/='?') oldsrc) -- remove query
|
||||
modifyIORef mediaRef ( (oldsrc, new): )
|
||||
return new
|
||||
|
||||
|
@ -800,10 +795,10 @@ transformBlock :: WriterOptions
|
|||
-> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) media
|
||||
-> Block
|
||||
-> IO Block
|
||||
transformBlock opts mediaRef (RawBlock fmt raw)
|
||||
transformBlock _ mediaRef (RawBlock fmt raw)
|
||||
| fmt == Format "html" = do
|
||||
let tags = parseTags raw
|
||||
tags' <- mapM (transformTag opts mediaRef) tags
|
||||
tags' <- mapM (transformTag mediaRef) tags
|
||||
return $ RawBlock fmt (renderTags' tags')
|
||||
transformBlock _ _ b = return b
|
||||
|
||||
|
@ -811,18 +806,17 @@ transformInline :: WriterOptions
|
|||
-> IORef [(FilePath, FilePath)] -- ^ (oldpath, newpath) media
|
||||
-> Inline
|
||||
-> IO Inline
|
||||
transformInline opts mediaRef (Image lab (src,tit)) = do
|
||||
let oldsrc = src `relativeTo` writerSourceURL opts
|
||||
newsrc <- modifyMediaRef mediaRef oldsrc
|
||||
transformInline _ mediaRef (Image lab (src,tit)) = do
|
||||
newsrc <- modifyMediaRef mediaRef src
|
||||
return $ Image lab (newsrc, tit)
|
||||
transformInline opts _ (x@(Math _ _))
|
||||
| WebTeX _ <- writerHTMLMathMethod opts = do
|
||||
raw <- makeSelfContained opts $ writeHtmlInline opts x
|
||||
return $ RawInline (Format "html") raw
|
||||
transformInline opts mediaRef (RawInline fmt raw)
|
||||
transformInline _ mediaRef (RawInline fmt raw)
|
||||
| fmt == Format "html" = do
|
||||
let tags = parseTags raw
|
||||
tags' <- mapM (transformTag opts mediaRef) tags
|
||||
tags' <- mapM (transformTag mediaRef) tags
|
||||
return $ RawInline fmt (renderTags' tags')
|
||||
transformInline _ _ x = return x
|
||||
|
||||
|
@ -1205,10 +1199,3 @@ docTitle' meta = fromMaybe [] $ go <$> lookupMeta "title" meta
|
|||
go (MetaList xs) = concatMap go xs
|
||||
go _ = []
|
||||
|
||||
relativeTo :: String -> Maybe String -> String
|
||||
relativeTo src mbbase =
|
||||
case (parseURIReference (ensureEscaped src),
|
||||
mbbase >>= parseURIReference . ensureEscaped) of
|
||||
(Just src', Just base') -> show (src' `nonStrictRelativeTo` base')
|
||||
_ -> unEscapeString src
|
||||
where ensureEscaped = escapeURIString isAllowedInURI
|
||||
|
|
Loading…
Add table
Reference in a new issue