@@ -35,53 +35,51 @@ import Text.HTML.TagSoup
3535import Network.URI (isURI, escapeURIString)
3636import Data.ByteString.Base64
3737import qualified Data.ByteString.Char8 as B
38−import qualified Data.ByteString as BS
3938import Data.ByteString (ByteString)
40−import System.FilePath (takeExtension, dropExtension, takeDirectory, (</>))
39+import System.FilePath (takeExtension, takeDirectory, (</>))
4140import Data.Char (toLower, isAscii, isAlphaNum)
4241import Codec.Compression.GZip as Gzip
4342import qualified Data.ByteString.Lazy as L
44−import Text.Pandoc.Shared (renderTags', openURL, readDataFile, err)
45−import Text.Pandoc.MediaBag (MediaBag, lookupMedia)
43+import Text.Pandoc.Shared (renderTags', err, fetchItem')
44+import Text.Pandoc.MediaBag (MediaBag)
4645import Text.Pandoc.UTF8 (toString, fromString)
47−import Text.Pandoc.MIME (getMimeType)
48−import System.Directory (doesFileExist)
46+import Text.Pandoc.Options (WriterOptions(..))
4947
5048isOk :: Char -> Bool
5149isOk c = isAscii c && isAlphaNum c
5250
53−convertTag :: MediaBag -> Maybe FilePath -> Tag String -> IO (Tag String)
54−convertTag media userdata t@(TagOpen tagname as)
51+convertTag :: MediaBag -> Maybe String -> Tag String -> IO (Tag String)
52+convertTag media sourceURL t@(TagOpen tagname as)
5553 | tagname `elem` ["img", "embed", "video", "input", "audio", "source"] = do
5654 as' <- mapM processAttribute as
5755 return $ TagOpen tagname as'
5856 where processAttribute (x,y) =
5957 if x == "src" || x == "href" || x == "poster"
6058 then do
61− (raw, mime) <- getRaw media userdata (fromAttrib "type" t) y
59+ (raw, mime) <- getRaw media sourceURL (fromAttrib "type" t) y
6260 let enc = "data:" ++ mime ++ ";base64," ++ toString (encode raw)
6361 return (x, enc)
6462 else return (x,y)
65−convertTag media userdata t@(TagOpen "script" as) =
63+convertTag media sourceURL t@(TagOpen "script" as) =
6664 case fromAttrib "src" t of
6765 [] -> return t
6866 src -> do
69− (raw, mime) <- getRaw media userdata (fromAttrib "type" t) src
67+ (raw, mime) <- getRaw media sourceURL (fromAttrib "type" t) src
7068 let enc = "data:" ++ mime ++ "," ++ escapeURIString isOk (toString raw)
7169 return $ TagOpen "script" (("src",enc) : [(x,y) | (x,y) <- as, x /= "src"])
72−convertTag media userdata t@(TagOpen "link" as) =
70+convertTag media sourceURL t@(TagOpen "link" as) =
7371 case fromAttrib "href" t of
7472 [] -> return t
7573 src -> do
76− (raw, mime) <- getRaw media userdata (fromAttrib "type" t) src
74+ (raw, mime) <- getRaw media sourceURL (fromAttrib "type" t) src
7775 let enc = "data:" ++ mime ++ "," ++ escapeURIString isOk (toString raw)
7876 return $ TagOpen "link" (("href",enc) : [(x,y) | (x,y) <- as, x /= "href"])
7977convertTag _ _ t = return t
8078
8179-- NOTE: This is really crude, it doesn't respect CSS comments.
82−cssURLs :: MediaBag -> Maybe FilePath -> FilePath -> ByteString
80+cssURLs :: MediaBag -> Maybe String -> FilePath -> ByteString
8381 -> IO ByteString
84−cssURLs media userdata d orig =
82+cssURLs media sourceURL d orig =
8583 case B.breakSubstring "url(" orig of
8684 (x,y) | B.null y -> return orig
8785 | otherwise -> do
@@ -94,43 +92,21 @@ cssURLs media userdata d orig =
9492 let url' = if isURI url
9593 then url
9694 else d </> url
97− (raw, mime) <- getRaw media userdata "" url'
98− rest <- cssURLs media userdata d v
95+ (raw, mime) <- getRaw media sourceURL "" url'
96+ rest <- cssURLs media sourceURL d v
9997 let enc = "data:" `B.append` fromString mime `B.append`
10098 ";base64," `B.append` (encode raw)
10199 return $ x `B.append` "url(" `B.append` enc `B.append` rest
102100
103−getItem :: MediaBag -> Maybe FilePath -> String
104− -> IO (ByteString, Maybe String)
105−getItem media userdata f =
106− if isURI f
107− then openURL f >>= either handleErr return
108− else do
109− -- strip off trailing query or fragment part, if relative URL.
110− -- this is needed for things like cmunrm.eot?#iefix,
111− -- which is used to get old versions of IE to work with web fonts.
112− let f' = takeWhile (\c -> c /= '?' && c /= '#') f
113− let mbMime = case takeExtension f' of
114− ".gz" -> getMimeType $ dropExtension f'
115− x -> getMimeType x
116− exists <- doesFileExist f'
117− if exists
118− then do
119− cont <- B.readFile f'
120− return (cont, mbMime)
121− else case lookupMedia f media of
122− Just (mime,bs) -> return (BS.concat $ L.toChunks bs,
123− Just mime)
124− Nothing -> do
125− cont <- readDataFile userdata f'
126− return (cont, mbMime)
127− where handleErr e = err 61 $ "Failed to retrieve " ++ f ++ "\n" ++ show e
128−
129−getRaw :: MediaBag -> Maybe FilePath -> String -> String
101+getRaw :: MediaBag -> Maybe String -> String -> String
130102 -> IO (ByteString, String)
131−getRaw media userdata mimetype src = do
103+getRaw media sourceURL mimetype src = do
132104 let ext = map toLower $ takeExtension src
133− (raw, respMime) <- getItem media userdata src
105+ fetchResult <- fetchItem' media sourceURL src
106+ (raw, respMime) <- case fetchResult of
107+ Left msg -> err 67 $ "Could not fetch " ++ src ++
108+ "\n" ++ show msg
109+ Right x -> return x
134110 let raw' = if ext == ".gz"
135111 then B.concat $ L.toChunks $ Gzip.decompress $ L.fromChunks
136112 $ [raw]
@@ -141,20 +117,14 @@ getRaw media userdata mimetype src = do
141117 (x, Nothing) -> x
142118 (_, Just x ) -> x
143119 result <- if mime == "text/css"
144− then cssURLs media userdata (takeDirectory src) raw'
120+ then cssURLs media (Just src) (takeDirectory src) raw'
145121 else return raw'
146122 return (result, mime)
147123
148124-- | Convert HTML into self-contained HTML, incorporating images,
149−-- scripts, and CSS using data: URIs. Items specified using absolute
150−-- URLs will be downloaded; those specified using relative URLs will
151−-- be sought first relative to the working directory, then in the
152−-- media bag, then relative
153−-- to the user data directory (if the first parameter is 'Just'
154−-- a directory), and finally relative to pandoc's default data
155−-- directory.
156−makeSelfContained :: MediaBag -> Maybe FilePath -> String -> IO String
157−makeSelfContained media userdata inp = do
125+-- scripts, and CSS using data: URIs.
126+makeSelfContained :: WriterOptions -> String -> IO String
127+makeSelfContained opts inp = do
158128 let tags = parseTags inp
159− out' <- mapM (convertTag media userdata) tags
129+ out' <- mapM (convertTag (writerMediaBag opts) (writerSourceURL opts)) tags
160130 return $ renderTags' out'