From 8f7beb6d10f49b00b3b486c8edd50fa0a0deb2e3 Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Fri, 11 Jan 2013 15:45:19 -0800
Subject: ODT, Docx writers:  Properly handle URL refs for images.

These images are now downloaded instead of being ignored (as
used to happen in the docx reader) or causing an error (as
used to happen in the odt reader).
---
 src/Text/Pandoc/Writers/Docx.hs | 11 ++++++++--
 src/Text/Pandoc/Writers/ODT.hs  | 47 +++++++++++++++++++++++++----------------
 2 files changed, 38 insertions(+), 20 deletions(-)

(limited to 'src')

diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index f40429aaa..e8d49ead0 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -52,6 +52,8 @@ import Data.Unique (hashUnique, newUnique)
 import System.Random (randomRIO)
 import Text.Printf (printf)
 import qualified Control.Exception as E
+import Network.URI (isAbsoluteURI)
+import System.FilePath ((</>))
 
 data WriterState = WriterState{
          stTextProperties :: [Element]
@@ -624,10 +626,15 @@ inlineToOpenXML opts (Image alt (src, tit)) = do
   case M.lookup src imgs of
     Just (_,_,elt,_) -> return [elt]
     Nothing -> do
-      res <- liftIO $ E.try $ getItem (writerUserDataDir opts) src
+      let sourceDir = writerSourceDirectory opts
+      let src' = case src of
+                   s | isAbsoluteURI s         -> s
+                     | isAbsoluteURI sourceDir -> sourceDir ++ "/" ++ s
+                     | otherwise               -> sourceDir </> s
+      res <- liftIO $ E.try $ getItem Nothing src'
       case res of
         Left (_ :: E.SomeException) -> do
-          liftIO $ warn $ "Could not find image `" ++ src ++ "', skipping..."
+          liftIO $ warn $ "Could not find image `" ++ src' ++ "', skipping..."
           -- emit alt text
           inlinesToOpenXML opts alt
         Right (img, _) -> do
diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs
index 5e92cfcec..8bae293c4 100644
--- a/src/Text/Pandoc/Writers/ODT.hs
+++ b/src/Text/Pandoc/Writers/ODT.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE ScopedTypeVariables #-}
 {-
 Copyright (C) 2008-2010 John MacFarlane <jgm@berkeley.edu>
 
@@ -30,23 +31,24 @@ Conversion of 'Pandoc' documents to ODT.
 module Text.Pandoc.Writers.ODT ( writeODT ) where
 import Data.IORef
 import Data.List ( isPrefixOf )
-import System.FilePath ( (</>), takeExtension )
+import System.FilePath ( takeExtension, (</>) )
 import qualified Data.ByteString.Lazy as B
 import Text.Pandoc.UTF8 ( fromStringLazy )
 import Codec.Archive.Zip
-import Data.Time.Clock.POSIX
 import Text.Pandoc.Options ( WriterOptions(..) )
-import Text.Pandoc.Shared ( stringify, readDataFile )
-import Text.Pandoc.ImageSize ( readImageSize, sizeInPoints )
+import Text.Pandoc.Shared ( stringify, readDataFile, getItem, warn )
+import Text.Pandoc.ImageSize ( imageSize, sizeInPoints )
 import Text.Pandoc.MIME ( getMimeType )
 import Text.Pandoc.Definition
 import Text.Pandoc.Generic
 import Text.Pandoc.Writers.OpenDocument ( writeOpenDocument )
 import Control.Monad (liftM)
-import Network.URI ( unEscapeString )
+import Control.Monad.Trans (liftIO)
+import Network.URI ( unEscapeString, isAbsoluteURI )
 import Text.Pandoc.XML
 import Text.Pandoc.Pretty
 import qualified Control.Exception as E
+import Data.Time.Clock.POSIX ( getPOSIXTime )
 
 -- | Produce an ODT file from a Pandoc document.
 writeODT :: WriterOptions  -- ^ Writer options
@@ -111,18 +113,27 @@ writeODT opts doc@(Pandoc (Meta title _ _) _) = do
   return $ fromArchive archive''
 
 transformPic :: FilePath -> IORef [Entry] -> Inline -> IO Inline
-transformPic sourceDir entriesRef (Image lab (src,tit)) = do
-  let src' = unEscapeString src
-  mbSize <- readImageSize src'
-  let tit' = case mbSize of
-                  Just s   -> let (w,h) = sizeInPoints s
-                              in  show w ++ "x" ++ show h
-                  Nothing  -> tit
-  entries <- readIORef entriesRef
-  let newsrc = "Pictures/" ++ show (length entries) ++ takeExtension src'
-  E.catch (readEntry [] (sourceDir </> src') >>= \entry ->
-            modifyIORef entriesRef (entry{ eRelativePath = newsrc } :) >>
-            return (Image lab (newsrc, tit')))
-          (\e -> let _ = (e :: E.SomeException) in return (Emph lab))
+transformPic sourceDir entriesRef (Image lab (src,_)) = do
+  let src' = case unEscapeString src of
+                  s | isAbsoluteURI s         -> s
+                    | isAbsoluteURI sourceDir -> sourceDir ++ "/" ++ s
+                    | otherwise               -> sourceDir </> s
+  res <- liftIO $ E.try $ getItem Nothing src'
+  case res of
+     Left (_ :: E.SomeException) -> do
+       liftIO $ warn $ "Could not find image `" ++ src' ++ "', skipping..."
+       return $ Emph lab
+     Right (img, _) -> do
+       let size = imageSize img
+       let (w,h) = maybe (0,0) id $ sizeInPoints `fmap` size
+       let tit' = show w ++ "x" ++ show h
+       entries <- readIORef entriesRef
+       let newsrc = "Pictures/" ++ show (length entries) ++ takeExtension src'
+       let toLazy = B.fromChunks . (:[])
+       epochtime <- floor `fmap` getPOSIXTime
+       let entry = toEntry newsrc epochtime $ toLazy img
+       -- insert into entriesRef: sourceDir </> src', eRelativePath = newsrc
+       modifyIORef entriesRef (entry:)
+       return $ Image lab (newsrc, tit')
 transformPic _ _ x = return x
 
-- 
cgit v1.2.3