f8087b6 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

EPUB writer: correctly resolve relative URIs. (Closes #1671.)

f8087b6John MacFarlane12 years ago

src/Text/Pandoc/Writers/EPUB.hs+14−11

compare with master

unifiedsplit

@@ -35,7 +35,7 @@ import Data.Maybe ( fromMaybe )

35import Data.List ( isPrefixOf, isInfixOf, intercalate )

36import System.Environment ( getEnv )

37import Text.Printf (printf)

38−import System.FilePath ( (</>), takeExtension, takeFileName )

38+import System.FilePath ( takeExtension, takeFileName )

39import qualified Data.ByteString.Lazy as B

40import qualified Data.ByteString.Lazy.Char8 as B8

41import qualified Text.Pandoc.UTF8 as UTF8

@@ -64,7 +64,8 @@ import Text.XML.Light ( unode, Element(..), unqual, Attr(..), add_attrs

64import Text.Pandoc.UUID (getRandomUUID)

65import Text.Pandoc.Writers.HTML (writeHtmlString, writeHtml)

66import Data.Char ( toLower, isDigit, isAlphaNum )

67−import Network.URI ( unEscapeString, isURI )

67+import Network.URI ( unEscapeString, nonStrictRelativeTo,

68+ escapeURIString, isAllowedInURI, parseURIReference )

68import Text.Pandoc.MIME (MimeType, getMimeType)

69import Text.Pandoc.MIME (MimeType, getMimeType)

69import qualified Control.Exception as E

70import qualified Control.Exception as E

70import Text.Blaze.Html.Renderer.Utf8 (renderHtml)

71import Text.Blaze.Html.Renderer.Utf8 (renderHtml)

@@ -773,12 +774,8 @@ transformTag opts mediaRef tag@(TagOpen name attr)

773 | name `elem` ["video", "source", "img", "audio"] = do

774 | name `elem` ["video", "source", "img", "audio"] = do

774 let src = fromAttrib "src" tag

775 let src = fromAttrib "src" tag

775 let poster = fromAttrib "poster" tag

776 let poster = fromAttrib "poster" tag

776− let oldsrc = case writerSourceURL opts of

777+ let oldsrc = src `relativeTo` writerSourceURL opts

777− Just u | not (isURI src) -> u </> src

778− _ -> src

779− let oldposter = case writerSourceURL opts of

778+ let oldposter = poster `relativeTo` writerSourceURL opts

780− Just u | not (isURI src) -> u </> poster

781− _ -> poster

782 newsrc <- modifyMediaRef mediaRef oldsrc

779 newsrc <- modifyMediaRef mediaRef oldsrc

783 newposter <- modifyMediaRef mediaRef oldposter

780 newposter <- modifyMediaRef mediaRef oldposter

784 let attr' = filter (\(x,_) -> x /= "src" && x /= "poster") attr ++

781 let attr' = filter (\(x,_) -> x /= "src" && x /= "poster") attr ++

@@ -815,9 +812,7 @@ transformInline :: WriterOptions

815 -> Inline

812 -> Inline

816 -> IO Inline

813 -> IO Inline

817transformInline opts mediaRef (Image lab (src,tit)) = do

814transformInline opts mediaRef (Image lab (src,tit)) = do

818− let oldsrc = case (unEscapeString src, writerSourceURL opts) of

815+ let oldsrc = src `relativeTo` writerSourceURL opts

819− (s, Just u) | not (isURI src) -> u </> s

820− (s, _) -> s

821 newsrc <- modifyMediaRef mediaRef oldsrc

816 newsrc <- modifyMediaRef mediaRef oldsrc

822 return $ Image lab (newsrc, tit)

817 return $ Image lab (newsrc, tit)

823transformInline opts _ (x@(Math _ _))

818transformInline opts _ (x@(Math _ _))

@@ -1209,3 +1204,11 @@ docTitle' meta = fromMaybe [] $ go <$> lookupMeta "title" meta

1209 _ -> []

1204 _ -> []

1210 go (MetaList xs) = concatMap go xs

1205 go (MetaList xs) = concatMap go xs

1211 go _ = []

1206 go _ = []

1207+

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