Reworked Text.Pandoc.ODT to use zip-archive instead of calling external 'zip'.

+ Removed utf8-string and xml-light modules, and unneeded content.xml.
+ Removed code for building reference.odt from Setup.hs.
  The ODT is now built using template haskell in Text.Pandoc.ODT.
+ Removed copyright statements for utf8-string and xml modules,
  since they are no longer included in the source.
+ README: Removed claim that 'zip' is needed for ODT production.
+ Removed dependency on 'zip' from debian/control.
+ Text.Pandoc.Shared: Removed withTempDir, added inDirectory.
+ Added makeZip to Text.Pandoc.TH.
+ pandoc.cabal: Added dependencies on old-time, zip-archive, and utf8-string.
  Added markdown2pdf files to extra-sources list.


git-svn-id: https://pandoc.googlecode.com/svn/trunk@1417 788f1e2b-df1e-0410-8736-df70ead52e1b

1 files changed, 46 insertions, 98 deletions

diff --git a/Text/Pandoc/ODT.hs b/Text/Pandoc/ODT.hs
index 8c3b1b45f..10cf1b7e2 100644
--- a/Text/Pandoc/ODT.hs
+++ b/Text/Pandoc/ODT.hs
@@ -29,22 +29,16 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 Functions for producing an ODT file from OpenDocument XML.
 -}
 module Text.Pandoc.ODT ( saveOpenDocumentAsODT ) where
-import Text.Pandoc.TH ( binaryContentsOf )
-import Data.Maybe ( fromJust )
-import Data.List ( partition, intersperse )
-import System.Directory
-import System.FilePath ( (</>), takeDirectory, takeFileName, splitDirectories )
-import System.Process ( runProcess, waitForProcess )
-import System.Exit
-import Text.XML.Light
-import Text.XML.Light.Cursor
-import Text.Pandoc.Shared ( withTempDir )
-import Network.URI ( isURI )
-import qualified Data.ByteString as B ( writeFile, pack )
-import Data.ByteString.Internal ( c2w )
+import Text.Pandoc.TH ( makeZip )
+import Data.List ( find )
+import System.FilePath ( (</>), takeFileName )
+import qualified Data.ByteString.Lazy as B
+import Data.ByteString.Lazy.UTF8 ( fromString )
 import Prelude hiding ( writeFile, readFile )
-import System.IO ( stderr )
-import System.IO.UTF8
+import Codec.Archive.Zip
+import Control.Applicative ( (<$>) )
+import Text.ParserCombinators.Parsec
+import System.Time
 
 -- | Produce an ODT file from OpenDocument XML.
 saveOpenDocumentAsODT :: FilePath    -- ^ Pathname of ODT file to be produced.
@@ -52,89 +46,43 @@ saveOpenDocumentAsODT :: FilePath    -- ^ Pathname of ODT file to be produced.
                       -> String      -- ^ OpenDocument XML contents.
                       -> IO ()
 saveOpenDocumentAsODT destinationODTPath sourceDirRelative xml = do
-  let zipCmd = "zip"
-  -- check for zip in path:
-  zipPathMaybe <- findExecutable zipCmd
-  let zipPath = case zipPathMaybe of
-                  Nothing -> error $ "The '" ++ zipCmd ++
-                                     "' command, which is needed to build an ODT file, was not found.\n" ++
-                                     "It can be obtained from http://www.info-zip.org/Zip.html\n" ++
-                                     "Debian (and Debian-based) linux: apt-get install zip\n" ++
-                                     "Windows: See http://gnuwin32.sourceforge.net/packages/zip.htm"
-                  Just x  -> x
-  withTempDir "pandoc-odt" $ \tempDir -> do
-    let tempODT = tempDir </> "reference.odt"
-    B.writeFile tempODT $ B.pack $ map c2w $(binaryContentsOf $ "odt-styles" </> "reference.odt")
-    xml' <- handlePictures tempODT sourceDirRelative xml
-    writeFile (tempDir </> "content.xml") xml'
-    ph <- runProcess zipPath ["-9", "-q", "-r", tempODT, "content.xml", "Pictures"]
-            (Just tempDir) Nothing Nothing Nothing (Just stderr)
-    ec <- waitForProcess ph   -- requires compilation with -threaded
-    case ec of
-         ExitSuccess -> copyFile tempODT destinationODTPath
-         _           -> error "Error creating ODT." >> exitWith ec
+  let refArchive = read $(makeZip "odt-styles")
+  -- handle pictures
+  let (newContents, pics) = 
+        case runParser pPictures [] "OpenDocument XML contents" xml of
+          Left err          -> error $ show err
+          Right x           -> x
+  picEntries <- mapM (makePictureEntry sourceDirRelative) pics 
+  (TOD epochTime _) <- getClockTime
+  let contentEntry = toEntry "content.xml" epochTime $ fromString newContents
+  let archive = foldr addEntryToArchive refArchive (contentEntry : picEntries)
+  B.writeFile destinationODTPath $ fromArchive archive
 
--- | Find <draw:image ... /> elements and copy the file (xlink:href attribute) into Pictures/ in
--- the zip file.  If filename is a URL, attempt to download it.  Modify xlink:href attributes
--- to point to the new locations in Pictures/.  Return modified XML.
-handlePictures :: FilePath     -- ^ Path of ODT file in temp directory
-               -> FilePath     -- ^ Directory (relative) containing source file
-               -> String       -- ^ OpenDocument XML string
-               -> IO String    -- ^ Modified XML
-handlePictures tempODT sourceDirRelative xml = do
-  let parsed = case parseXMLDoc xml of
-                Nothing -> error "Could not parse OpenDocument XML."
-                Just x  -> x
-  let cursor = case (fromForest $ elContent parsed) of
-                   Nothing -> error "ODT appears empty"
-                   Just x  -> x
-  cursor' <- scanPictures tempODT sourceDirRelative cursor
-  let modified = parsed { elContent = toForest $ root cursor' }
-  return $ showTopElement modified
+makePictureEntry :: FilePath            -- ^ Relative directory of source file
+                 -> (FilePath, String)  -- ^ Path and new path of picture
+                 -> IO Entry
+makePictureEntry sourceDirRelative (path, newPath) = do
+  entry <- readEntry [] $ sourceDirRelative </> path
+  return (entry { eRelativePath = newPath })
 
-scanPictures :: FilePath -> FilePath -> Cursor -> IO Cursor
-scanPictures tempODT sourceDirRelative cursor = do
-  cursor' <- handleTree tempODT sourceDirRelative cursor
-  case right cursor' of
-       Just n  -> scanPictures tempODT sourceDirRelative n
-       Nothing -> return cursor'
-
-handleTree :: FilePath -> FilePath -> Cursor -> IO Cursor
-handleTree tempODT sourceDirRelative cursor = do
-  case firstChild cursor of
-       Nothing -> modifyContentM (handleContent tempODT sourceDirRelative) cursor
-       Just n  -> scanPictures tempODT sourceDirRelative n >>= return . fromJust . parent
-
--- | If content is an image link, handle it appropriately.
--- Otherwise, handle children if any.
-handleContent :: FilePath -> FilePath -> Content -> IO Content
-handleContent tempODT sourceDirRelative content@(Elem el) = do
-  if qName (elName el) == "image"
-     then do
-        let (hrefs, rest) = partition (\a -> qName (attrKey a) == "href") $ elAttribs el
-        let href = case hrefs of
-                          []     -> error $ "No href found in " ++ show el
-                          [x]    -> x
-                          _      -> error $ "Multiple hrefs found in " ++ show el
-        if isURI $ attrVal href
-           then return content
-           else do  -- treat as filename
-             let oldLoc = sourceDirRelative </> attrVal href
-             fileExists <- doesFileExist oldLoc
-             if fileExists
-                then do
-                   let pref = take 230 $ concat $ intersperse "_" $
-                                splitDirectories $ takeDirectory $ attrVal href
-                   let picName = pref ++ "_" ++ (takeFileName $ attrVal href)
-                   let tempDir = takeDirectory tempODT
-                   createDirectoryIfMissing False $ tempDir </> "Pictures"
-                   copyFile oldLoc $ tempDir </> "Pictures" </> picName
-                   let newAttrs = (href { attrVal = "Pictures/" ++ picName }) : rest
-                   return $ Elem (el { elAttribs = newAttrs })
-                else do
-                   hPutStrLn stderr $ "Warning:  Unable to find image at " ++ oldLoc ++ " - ignoring."
-                   return content
-     else return content
- 
-handleContent _ _ c = return c  -- not Element
+pPictures :: GenParser Char [(FilePath, String)] ([Char], [(FilePath, String)])
+pPictures = do
+  contents <- concat <$> many (pPicture <|> many1 (noneOf "<") <|> string "<")
+  pics <- getState
+  return (contents, pics)
 
+pPicture :: GenParser Char [(FilePath, String)] [Char]
+pPicture = try $ do
+  string "<draw:image xlink:href=\""
+  path <- manyTill anyChar (char '"')
+  let filename =  takeFileName path
+  pics <- getState
+  newPath <- case find (\(o, _) -> o == path) pics of
+             Just (_, new) -> return new
+             Nothing -> do 
+                        -- get a unique name
+                        let dups = length $ (filter (\(o, _) -> takeFileName o == filename)) pics 
+                        let new = "Pictures/" ++ replicate dups '0' ++ filename
+                        updateState ((path, new) :)
+                        return new
+  return $ "<draw:image xlink:href=\"" ++ newPath ++ "\""