mirror of
https://github.com/jgm/pandoc.git
synced 2026-08-28 17:20:47 +08:00
Docx writer: use namespace URI instead of prefix in extractPageLayout (#11697)
When a reference document uses a non-standard namespace prefix for the WordprocessingML namespace (e.g. `ns0` instead of `w`), `sectPr` elements copied from the reference would retain the non-`w` prefix, producing malformed XML in the output document. Similarly, `extractPageLayout` only matched elements with prefix `w`, missing `sectPr` elements with other prefixes. This is fixed by matching on the namespace URI rather than the prefix, and normalizing the prefix to `w` on all elements and attributes copied from reference-doc `sectPr`. Some new tests have been added, and the test suite has been streamlined using helper functions.
This commit is contained in:
Robertas
@@ -115,8 +115,7 @@ writeDocx opts doc = do
|
||||
-- Phase 6: Core content generation
|
||||
-- adjust contents to add sectPr from reference.docx
|
||||
let sectpr = case mbsectpr of
|
||||
Just sectpr' -> add_attrs (elAttribs sectpr') $ mknode "w:sectPr" []
|
||||
(elChildren sectpr')
|
||||
Just sectpr' -> setWmlPrefix sectpr'
|
||||
Nothing -> mknode "w:sectPr" []
|
||||
[ mknode "w:footnotePr" []
|
||||
[ mknode "w:numRestart" [("w:val","eachSect")] () ]
|
||||
@@ -477,6 +476,18 @@ modifyAtPath (p:ps) f e = e{ elContent = map go (elContent e) }
|
||||
go (Elem el) | p (elName el) = Elem (modifyAtPath ps f el)
|
||||
go c = c
|
||||
|
||||
setWmlPrefix :: Element -> Element
|
||||
setWmlPrefix el =
|
||||
el{ elName = setPrefix (elName el)
|
||||
, elAttribs = map setAttr (elAttribs el)
|
||||
, elContent = map setContent (elContent el) }
|
||||
where
|
||||
setPrefix qn | isWmlNamespace qn = qn{ qPrefix = Just "w" }
|
||||
| otherwise = qn
|
||||
setAttr attr = attr{ attrKey = setPrefix (attrKey attr) }
|
||||
setContent (Elem e) = Elem (setWmlPrefix e)
|
||||
setContent c = c
|
||||
|
||||
-- | Load reference and distribution archives
|
||||
loadArchives :: PandocMonad m
|
||||
=> WriterOptions
|
||||
@@ -496,12 +507,18 @@ loadArchives opts = do
|
||||
readDataFile "reference.docx"
|
||||
return (refArchive, distArchive, username, utctime)
|
||||
|
||||
isWmlNamespace :: QName -> Bool
|
||||
isWmlNamespace qn =
|
||||
qURI qn == Just
|
||||
"http://schemas.openxmlformats.org/wordprocessingml/2006/main" ||
|
||||
qURI qn == Just "http://purl.oclc.org/ooxml/wordprocessingml/main"
|
||||
|
||||
-- | Extract page dimensions from template
|
||||
extractPageLayout :: PandocMonad m
|
||||
=> Archive -> Archive -> m (Maybe Element, Maybe Integer)
|
||||
extractPageLayout refArchive distArchive = do
|
||||
parsedDoc <- parseXml refArchive distArchive "word/document.xml"
|
||||
let wname f qn = qPrefix qn == Just "w" && f (qName qn)
|
||||
let wname f qn = isWmlNamespace qn && f (qName qn)
|
||||
let mbsectpr = filterElementName (wname (=="sectPr")) parsedDoc
|
||||
|
||||
-- Gets the template size
|
||||
|
||||
+62
-84
@@ -1,7 +1,7 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Tests.Writers.Docx (tests) where
|
||||
|
||||
import Codec.Archive.Zip (findEntryByPath, fromEntry, toArchive)
|
||||
import Codec.Archive.Zip (Archive, findEntryByPath, fromEntry, toArchive)
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import Data.List (isInfixOf, isPrefixOf)
|
||||
import qualified Data.Map as M
|
||||
@@ -12,7 +12,34 @@ import Test.Tasty
|
||||
import Test.Tasty.HUnit
|
||||
import Tests.Writers.OOXML
|
||||
import Text.Pandoc
|
||||
import Text.XML.Light (QName(QName), findAttr, findElements, parseXMLDoc)
|
||||
import Text.XML.Light ( Element, QName(QName), findAttr, findElements
|
||||
, parseXMLDoc )
|
||||
|
||||
wmlName :: String -> QName
|
||||
wmlName n = QName n
|
||||
(Just "http://schemas.openxmlformats.org/wordprocessingml/2006/main")
|
||||
(Just "w")
|
||||
|
||||
entryBytes :: String -> Archive -> IO BL.ByteString
|
||||
entryBytes path archive =
|
||||
maybe (assertFailure $ "Missing " ++ path) (return . fromEntry) $
|
||||
findEntryByPath path archive
|
||||
|
||||
entryXml :: String -> Archive -> IO Element
|
||||
entryXml path archive =
|
||||
maybe (assertFailure $ "Invalid " ++ path) return . parseXMLDoc
|
||||
=<< entryBytes path archive
|
||||
|
||||
documentXml :: WriterOptions -> Pandoc -> IO Element
|
||||
documentXml opts doc =
|
||||
entryXml "word/document.xml" . toArchive =<<
|
||||
runIOorExplode (setVerbosity ERROR >> writeDocx opts doc)
|
||||
|
||||
documentXmlFromNative :: WriterOptions -> FilePath -> IO Element
|
||||
documentXmlFromNative opts fp = do
|
||||
txt <- T.readFile fp
|
||||
entryXml "word/document.xml" . toArchive =<<
|
||||
runIOorExplode (setVerbosity ERROR >> readNative def txt >>= writeDocx opts)
|
||||
|
||||
-- we add an extra check to make sure that we're not writing in the
|
||||
-- toplevel docx directory. We don't want to accidentally overwrite an
|
||||
@@ -223,82 +250,39 @@ tests = [ testGroup "inlines"
|
||||
"docx/golden/document-properties-short-desc.docx"
|
||||
]
|
||||
, testGroup "top-level-division"
|
||||
-- Helper to count occurrences of a substring
|
||||
-- Note: counts by splitting on "<w:sectPr" which marks section properties
|
||||
[ testCase "no section break before first chapter (#10578)" $ do
|
||||
-- With --top-level-division=chapter, there should be no section
|
||||
-- break before the first chapter (to avoid blank first page)
|
||||
let opts = def{ writerTopLevelDivision = TopLevelChapter }
|
||||
bs <- runIOorExplode $ do
|
||||
setVerbosity ERROR
|
||||
let doc = Pandoc mempty
|
||||
[ Header 1 ("ch1", [], []) [Str "Chapter", Space, Str "1"]
|
||||
, Para [Str "First", Space, Str "chapter."]
|
||||
]
|
||||
writeDocx opts doc
|
||||
let archive = toArchive bs
|
||||
entry <- case findEntryByPath "word/document.xml" archive of
|
||||
Nothing -> assertFailure "Missing word/document.xml in output docx"
|
||||
Just e -> return e
|
||||
let docXml = show (fromEntry entry)
|
||||
-- Count occurrences of "<w:sectPr" (opening tag for section properties)
|
||||
let countOccurrences needle haystack =
|
||||
length (filter (needle `isPrefixOf`) (tails haystack))
|
||||
where tails [] = []; tails s@(_:xs) = s : tails xs
|
||||
let sectPrCount = countOccurrences "<w:sectPr" docXml
|
||||
-- Should have exactly 1 sectPr (the final document section),
|
||||
-- not 2 (which would mean one before the chapter heading)
|
||||
assertBool ("Expected 1 sectPr (final section only), found " ++ show sectPrCount)
|
||||
doc <- documentXml opts $ Pandoc mempty
|
||||
[ Header 1 ("ch1", [], []) [Str "Chapter", Space, Str "1"]
|
||||
, Para [Str "First", Space, Str "chapter."]
|
||||
]
|
||||
let sectPrCount = length $ findElements (wmlName "sectPr") doc
|
||||
assertBool ("Expected 1 sectPr, found " ++ show sectPrCount)
|
||||
(sectPrCount == 1)
|
||||
, testCase "section breaks between chapters (#11482)" $ do
|
||||
-- With --top-level-division=chapter, there should be section
|
||||
-- breaks between chapters (but not before the first one)
|
||||
let opts = def{ writerTopLevelDivision = TopLevelChapter }
|
||||
bs <- runIOorExplode $ do
|
||||
setVerbosity ERROR
|
||||
let doc = Pandoc mempty
|
||||
[ Header 1 ("ch1", [], []) [Str "Chapter", Space, Str "1"]
|
||||
, Para [Str "First", Space, Str "chapter."]
|
||||
, Header 1 ("ch2", [], []) [Str "Chapter", Space, Str "2"]
|
||||
, Para [Str "Second", Space, Str "chapter."]
|
||||
, Header 1 ("ch3", [], []) [Str "Chapter", Space, Str "3"]
|
||||
, Para [Str "Third", Space, Str "chapter."]
|
||||
]
|
||||
writeDocx opts doc
|
||||
let archive = toArchive bs
|
||||
entry <- case findEntryByPath "word/document.xml" archive of
|
||||
Nothing -> assertFailure "Missing word/document.xml in output docx"
|
||||
Just e -> return e
|
||||
let docXml = show (fromEntry entry)
|
||||
-- Count occurrences of "<w:sectPr" (opening tag for section properties)
|
||||
let countOccurrences needle haystack =
|
||||
length (filter (needle `isPrefixOf`) (tails haystack))
|
||||
where tails [] = []; tails s@(_:xs) = s : tails xs
|
||||
let sectPrCount = countOccurrences "<w:sectPr" docXml
|
||||
-- Should have 3 sectPr elements:
|
||||
-- - 1 before chapter 2
|
||||
-- - 1 before chapter 3
|
||||
-- - 1 final document section
|
||||
-- (No section break before chapter 1)
|
||||
assertBool ("Expected 3 sectPr elements, found " ++ show sectPrCount)
|
||||
doc <- documentXml opts $ Pandoc mempty
|
||||
[ Header 1 ("ch1", [], []) [Str "Chapter", Space, Str "1"]
|
||||
, Para [Str "First", Space, Str "chapter."]
|
||||
, Header 1 ("ch2", [], []) [Str "Chapter", Space, Str "2"]
|
||||
, Para [Str "Second", Space, Str "chapter."]
|
||||
, Header 1 ("ch3", [], []) [Str "Chapter", Space, Str "3"]
|
||||
, Para [Str "Third", Space, Str "chapter."]
|
||||
]
|
||||
let sectPrCount = length $ findElements (wmlName "sectPr") doc
|
||||
assertBool ("Expected 3 sectPrs, found " ++ show sectPrCount)
|
||||
(sectPrCount == 3)
|
||||
]
|
||||
, testGroup "reference docx"
|
||||
[ testCase "no media directory override in content types" $ do
|
||||
let opts = def{ writerReferenceDoc = Just "docx/inline_images.docx" }
|
||||
let opts = def{writerReferenceDoc=Just "docx/inline_images.docx"}
|
||||
txt <- T.readFile "docx/inline_formatting.native"
|
||||
bs <- runIOorExplode $ do
|
||||
mblang <- toLang (Just (Text.pack "en-US") :: Maybe Text)
|
||||
maybe (return ()) setTranslations mblang
|
||||
setVerbosity ERROR
|
||||
readNative def txt >>= writeDocx opts
|
||||
let archive = toArchive bs
|
||||
entry <- case findEntryByPath "[Content_Types].xml" archive of
|
||||
Nothing -> assertFailure "Missing [Content_Types].xml in output docx"
|
||||
Just e -> return e
|
||||
doc <- case parseXMLDoc (fromEntry entry) of
|
||||
Nothing -> assertFailure "Failed to parse [Content_Types].xml"
|
||||
Just d -> return d
|
||||
doc <- entryXml "[Content_Types].xml" $ toArchive bs
|
||||
let partNameAttr = QName "PartName" Nothing Nothing
|
||||
let overrideName = QName "Override" Nothing Nothing
|
||||
let overrides = findElements overrideName doc
|
||||
@@ -311,43 +295,41 @@ tests = [ testGroup "inlines"
|
||||
-- First, verify that the german-reference.docx actually has de-DE
|
||||
refBs <- BL.readFile "docx/german-reference.docx"
|
||||
let refArchive = toArchive refBs
|
||||
refEntry <- case findEntryByPath "word/styles.xml" refArchive of
|
||||
Nothing -> assertFailure "Missing word/styles.xml in german-reference.docx"
|
||||
Just e -> return e
|
||||
let refStylesXml = show (fromEntry refEntry)
|
||||
refStylesXml <- show <$> entryBytes "word/styles.xml" refArchive
|
||||
let getLangLines = filter ("w:lang" `isInfixOf`) . lines
|
||||
assertBool ("german-reference.docx w:lang line: " ++
|
||||
unlines (getLangLines refStylesXml))
|
||||
(any ("de-DE" `isInfixOf`) (getLangLines refStylesXml))
|
||||
-- Now test that using this reference preserves the language
|
||||
let opts = def{ writerReferenceDoc = Just "docx/german-reference.docx" }
|
||||
let opts = def{writerReferenceDoc=Just "docx/german-reference.docx"}
|
||||
txt <- T.readFile "docx/inline_formatting.native"
|
||||
bs <- runIOorExplode $ do
|
||||
setVerbosity ERROR
|
||||
readNative def txt >>= writeDocx opts
|
||||
let archive = toArchive bs
|
||||
entry <- case findEntryByPath "word/styles.xml" archive of
|
||||
Nothing -> assertFailure "Missing word/styles.xml in output docx"
|
||||
Just e -> return e
|
||||
let stylesXml = show (fromEntry entry)
|
||||
stylesXml <- show <$> entryBytes "word/styles.xml" (toArchive bs)
|
||||
-- Find the w:lang line for debugging
|
||||
-- Check that the styles.xml contains the German language
|
||||
assertBool ("Language from reference docx not preserved. w:lang lines: " ++ unlines (getLangLines stylesXml))
|
||||
(any ("de-DE" `isInfixOf`) (getLangLines stylesXml))
|
||||
, testCase "section properties from non-w-prefix reference docx" $ do
|
||||
let opts = def{writerReferenceDoc=Just "docx/ns0-reference.docx"}
|
||||
doc <- documentXmlFromNative opts "docx/inline_formatting.native"
|
||||
case findElements (wmlName "sectPr") doc of
|
||||
[] -> assertFailure "sectPr not found in output"
|
||||
sectPr:_ -> do
|
||||
assertBool "pgSz not found in output"
|
||||
(not $ null $ findElements (wmlName "pgSz") sectPr)
|
||||
findAttr (wmlName "type") sectPr @?= Just "continuous"
|
||||
, testCase "language from metadata overrides reference docx" $ do
|
||||
-- Use a reference docx with German language, but specify French in metadata
|
||||
let opts = def{ writerReferenceDoc = Just "docx/german-reference.docx" }
|
||||
let opts = def{writerReferenceDoc=Just "docx/german-reference.docx"}
|
||||
bs <- runIOorExplode $ do
|
||||
setVerbosity ERROR
|
||||
-- Create a document with French language metadata
|
||||
let doc = Pandoc (Meta $ M.fromList [("lang", MetaString "fr-FR")])
|
||||
[Para [Str "Test"]]
|
||||
writeDocx opts doc
|
||||
let archive = toArchive bs
|
||||
entry <- case findEntryByPath "word/styles.xml" archive of
|
||||
Nothing -> assertFailure "Missing word/styles.xml in output docx"
|
||||
Just e -> return e
|
||||
let stylesXml = show (fromEntry entry)
|
||||
stylesXml <- show <$> entryBytes "word/styles.xml" (toArchive bs)
|
||||
-- Check that the styles.xml contains the French language (not German)
|
||||
let getLangLines = filter ("w:lang" `isInfixOf`) . lines
|
||||
assertBool "Language from metadata did not override reference docx (expected fr-FR)"
|
||||
@@ -364,11 +346,7 @@ tests = [ testGroup "inlines"
|
||||
, Para [Str "Para", Space, Str "after."]
|
||||
]
|
||||
writeDocx opts doc
|
||||
let archive = toArchive bs
|
||||
entry <- case findEntryByPath "word/document.xml" archive of
|
||||
Nothing -> assertFailure "Missing word/document.xml in output docx"
|
||||
Just e -> return e
|
||||
let docXml = show (fromEntry entry)
|
||||
docXml <- show <$> entryBytes "word/document.xml" (toArchive bs)
|
||||
assertBool
|
||||
("Expected FirstParagraph style after heading with footnote, got: "
|
||||
++ docXml)
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user