{- Copyright (C) 2008 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- | Module : Text.Pandoc.ODT Copyright : Copyright (C) 2006-7 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane Stability : alpha Portability : portable Functions for producing an ODT file from OpenDocument XML. -} module Text.Pandoc.ODT ( saveOpenDocumentAsODT ) where 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 Codec.Archive.Zip import Control.Applicative ( (<$>) ) import Text.ParserCombinators.Parsec import System.Time import Paths_pandoc ( getDataFileName ) import System.Directory import Control.Monad (liftM) -- | Produce an ODT file from OpenDocument XML. saveOpenDocumentAsODT :: FilePath -- ^ Path of user data directory -> FilePath -- ^ Pathname of ODT file to be produced. -> FilePath -- ^ Relative directory of source file. -> Maybe FilePath -- ^ Path specified by --reference-odt -> String -- ^ OpenDocument XML contents. -> IO () saveOpenDocumentAsODT datadir destinationODTPath sourceDirRelative mbRefOdt xml = do refArchive <- liftM toArchive $ case mbRefOdt of Just f -> B.readFile f Nothing -> do let userRefOdt = datadir "reference.odt" userRefOdtExists <- doesFileExist userRefOdt if userRefOdtExists then B.readFile userRefOdt else getDataFileName "reference.odt" >>= B.readFile -- 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 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 }) 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 " 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 $ "