@@ -1,101 +0,0 @@
1−{-
2−Copyright (C) 2008-2010 John MacFarlane <jgm@berkeley.edu>
3−
4−This program is free software; you can redistribute it and/or modify
5−it under the terms of the GNU General Public License as published by
6−the Free Software Foundation; either version 2 of the License, or
7−(at your option) any later version.
8−
9−This program is distributed in the hope that it will be useful,
10−but WITHOUT ANY WARRANTY; without even the implied warranty of
11−MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12−GNU General Public License for more details.
13−
14−You should have received a copy of the GNU General Public License
15−along with this program; if not, write to the Free Software
16−Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
17−-}
18−
19−{- |
20− Module : Text.Pandoc.ODT
21− Copyright : Copyright (C) 2008-2010 John MacFarlane
22− License : GNU GPL, version 2 or above
23−
24− Maintainer : John MacFarlane <jgm@berkeley.edu>
25− Stability : alpha
26− Portability : portable
27−
28−Functions for producing an ODT file from OpenDocument XML.
29−-}
30−module Text.Pandoc.ODT ( saveOpenDocumentAsODT ) where
31−import Data.List ( find )
32−import System.FilePath ( (</>), takeFileName )
33−import qualified Data.ByteString.Lazy as B
34−import Data.ByteString.Lazy.UTF8 ( fromString )
35−import Codec.Archive.Zip
36−import Control.Applicative ( (<$>) )
37−import Text.ParserCombinators.Parsec
38−import System.Time
39−import Paths_pandoc ( getDataFileName )
40−import System.Directory
41−import Control.Monad (liftM)
42−
43−-- | Produce an ODT file from OpenDocument XML.
44−saveOpenDocumentAsODT :: Maybe FilePath -- ^ Path of user data directory
45− -> FilePath -- ^ Pathname of ODT file to be produced
46− -> FilePath -- ^ Relative directory of source file
47− -> Maybe FilePath -- ^ Path specified by --reference-odt
48− -> String -- ^ OpenDocument XML contents
49− -> IO ()
50−saveOpenDocumentAsODT datadir destinationODTPath sourceDirRelative mbRefOdt xml = do
51− refArchive <- liftM toArchive $
52− case mbRefOdt of
53− Just f -> B.readFile f
54− Nothing -> do
55− let defaultODT = getDataFileName "reference.odt" >>= B.readFile
56− case datadir of
57− Nothing -> defaultODT
58− Just d -> do
59− exists <- doesFileExist (d </> "reference.odt")
60− if exists
61− then B.readFile (d </> "reference.odt")
62− else defaultODT
63− -- handle pictures
64− let (newContents, pics) =
65− case runParser pPictures [] "OpenDocument XML contents" xml of
66− Left err -> error $ show err
67− Right x -> x
68− picEntries <- mapM (makePictureEntry sourceDirRelative) pics
69− (TOD epochTime _) <- getClockTime
70− let contentEntry = toEntry "content.xml" epochTime $ fromString newContents
71− let archive = foldr addEntryToArchive refArchive (contentEntry : picEntries)
72− B.writeFile destinationODTPath $ fromArchive archive
73−
74−makePictureEntry :: FilePath -- ^ Relative directory of source file
75− -> (FilePath, String) -- ^ Path and new path of picture
76− -> IO Entry
77−makePictureEntry sourceDirRelative (path, newPath) = do
78− entry <- readEntry [] $ sourceDirRelative </> path
79− return (entry { eRelativePath = newPath })
80−
81−pPictures :: GenParser Char [(FilePath, String)] ([Char], [(FilePath, String)])
82−pPictures = do
83− contents <- concat <$> many (pPicture <|> many1 (noneOf "<") <|> string "<")
84− pics <- getState
85− return (contents, pics)
86−
87−pPicture :: GenParser Char [(FilePath, String)] [Char]
88−pPicture = try $ do
89− string "<draw:image xlink:href=\""
90− path <- manyTill anyChar (char '"')
91− let filename = takeFileName path
92− pics <- getState
93− newPath <- case find (\(o, _) -> o == path) pics of
94− Just (_, new) -> return new
95− Nothing -> do
96− -- get a unique name
97− let dups = length $ (filter (\(o, _) -> takeFileName o == filename)) pics
98− let new = "Pictures/" ++ replicate dups '0' ++ filename
99− updateState ((path, new) :)
100− return new
101− return $ "<draw:image xlink:href=\"" ++ newPath ++ "\""