Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

DOCX reader: Allow empty dates in comments and tracked changes (#6726)

Browse source 
For security reasons, some legal firms delete the date from comments and
tracked changes.

* Make date optional (Maybe) in tracked changes and comments datatypes
* Add tests
This commit is contained in:
Diego Balseiro 2020-10-06 23:03:00 -05:00 committed by GitHub
parent a27a0b5419
commit eda5540719
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
8 changed files with 42 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
src/Text/Pandoc/Readers/Docx.hs
View file

@ -365,7 +365,7 @@ parPartToInlines' (ChangedRuns (TrackedChange Insertion (ChangeInfo _ author dat
RejectChanges -> return mempty
AllChanges -> do
ils <- smushInlines <$> mapM runToInlines runs
let attr = ("", ["insertion"], [("author", author), ("date", date)])
let attr = ("", ["insertion"], addAuthorAndDate author date)
return $ spanWith attr ils
parPartToInlines' (ChangedRuns (TrackedChange Deletion (ChangeInfo _ author date)) runs) = do
opts <- asks docxOptions
@ -374,7 +374,7 @@ parPartToInlines' (ChangedRuns (TrackedChange Deletion (ChangeInfo _ author date
RejectChanges -> smushInlines <$> mapM runToInlines runs
AllChanges -> do
ils <- smushInlines <$> mapM runToInlines runs
let attr = ("", ["deletion"], [("author", author), ("date", date)])
let attr = ("", ["deletion"], addAuthorAndDate author date)
return $ spanWith attr ils
parPartToInlines' (CommentStart cmtId author date bodyParts) = do
opts <- asks docxOptions
@ -382,7 +382,7 @@ parPartToInlines' (CommentStart cmtId author date bodyParts) = do
AllChanges -> do
blks <- smushBlocks <$> mapM bodyPartToBlocks bodyParts
ils <- blocksToInlinesWarn cmtId blks
let attr = ("", ["comment-start"], [("id", cmtId), ("author", author), ("date", date)])
let attr = ("", ["comment-start"], ("id", cmtId) : addAuthorAndDate author date)
return $ spanWith attr ils
_ -> return mempty
parPartToInlines' (CommentEnd cmtId) = do
@ -593,7 +593,7 @@ bodyPartToBlocks (Paragraph pPr parparts)
return mempty
(Just (TrackedChange Insertion (ChangeInfo _ cAuthor cDate))
, AllChanges) -> do
let attr = ("", ["paragraph-insertion"], [("author", cAuthor), ("date", cDate)])
let attr = ("", ["paragraph-insertion"], addAuthorAndDate cAuthor cDate)
insertMark = spanWith attr mempty
transform <- parStyleToTransform pPr'
return $ transform $
@ -605,7 +605,7 @@ bodyPartToBlocks (Paragraph pPr parparts)
handleInsertion
(Just (TrackedChange Deletion (ChangeInfo _ cAuthor cDate))
, AllChanges) -> do
let attr = ("", ["paragraph-deletion"], [("author", cAuthor), ("date", cDate)])
let attr = ("", ["paragraph-deletion"], addAuthorAndDate cAuthor cDate)
insertMark = spanWith attr mempty
transform <- parStyleToTransform pPr'
return $ transform $
@ -732,3 +732,8 @@ docxToOutput :: PandocMonad m
docxToOutput opts (Docx (Document _ body)) =
let dEnv = def { docxOptions = opts} in
evalDocxContext (bodyToOutput body) dEnv def
addAuthorAndDate :: T.Text -> Maybe T.Text -> [(T.Text, T.Text)]
addAuthorAndDate author mdate =
("author", author) : maybe [] (\date -> [("date", date)]) mdate

14
src/Text/Pandoc/Readers/Docx/Parse.hs
View file

@ -213,7 +213,7 @@ data ParIndentation = ParIndentation { leftParIndent :: Maybe Integer
data ChangeType = Insertion | Deletion
deriving Show
data ChangeInfo = ChangeInfo ChangeId Author ChangeDate
data ChangeInfo = ChangeInfo ChangeId Author (Maybe ChangeDate)
deriving Show
data TrackedChange = TrackedChange ChangeType ChangeInfo
@ -276,7 +276,7 @@ type Extent = Maybe (Double, Double)
data ParPart = PlainRun Run
| ChangedRuns TrackedChange [Run]
| CommentStart CommentId Author CommentDate [BodyPart]
| CommentStart CommentId Author (Maybe CommentDate) [BodyPart]
| CommentEnd CommentId
| BookMark BookMarkId Anchor
| InternalHyperLink Anchor [Run]
@ -852,7 +852,7 @@ elemToCommentStart ns element
| isElem ns "w" "comment" element
, Just cmtId <- findAttrTextByName ns "w" "id" element
, Just cmtAuthor <- findAttrTextByName ns "w" "author" element
, Just cmtDate <- findAttrTextByName ns "w" "date" element = do
, cmtDate <- findAttrTextByName ns "w" "date" element = do
bps <- mapD (elemToBodyPart ns) (elChildren element)
return $ CommentStart cmtId cmtAuthor cmtDate bps
elemToCommentStart _ _ = throwError WrongElem
@ -958,14 +958,14 @@ getTrackedChange ns element
| isElem ns "w" "ins" element || isElem ns "w" "moveTo" element
, Just cId <- findAttrTextByName ns "w" "id" element
, Just cAuthor <- findAttrTextByName ns "w" "author" element
, Just cDate <- findAttrTextByName ns "w" "date" element =
Just $ TrackedChange Insertion (ChangeInfo cId cAuthor cDate)
, mcDate <- findAttrTextByName ns "w" "date" element =
Just $ TrackedChange Insertion (ChangeInfo cId cAuthor mcDate)
getTrackedChange ns element
| isElem ns "w" "del" element || isElem ns "w" "moveFrom" element
, Just cId <- findAttrTextByName ns "w" "id" element
, Just cAuthor <- findAttrTextByName ns "w" "author" element
, Just cDate <- findAttrTextByName ns "w" "date" element =
Just $ TrackedChange Deletion (ChangeInfo cId cAuthor cDate)
, mcDate <- findAttrTextByName ns "w" "date" element =
Just $ TrackedChange Deletion (ChangeInfo cId cAuthor mcDate)
getTrackedChange _ _ = Nothing
elemToParagraphStyle :: NameSpaces -> Element -> ParStyleMap -> ParagraphStyle

18
src/Text/Pandoc/Writers/Docx.hs
View file

@ -1244,33 +1244,29 @@ inlineToOpenXML' opts (Span (ident,classes,kvs) ils) = do
else id)
getChangeAuthorDate = do
defaultAuthor <- asks envChangesAuthor
defaultDate <- asks envChangesDate
let author = fromMaybe defaultAuthor (lookup "author" kvs)
date = fromMaybe defaultDate (lookup "date" kvs)
return (author, date)
let mdate = lookup "date" kvs
return $ ("w:author", T.unpack author) :
maybe [] (\date -> [("w:date", T.unpack date)]) mdate
insmod <- if "insertion" `elem` classes
then do
(author, date) <- getChangeAuthorDate
changeAuthorDate <- getChangeAuthorDate
insId <- gets stInsId
modify $ \s -> s{stInsId = insId + 1}
return $ \f -> do
x <- f
return [ mknode "w:ins"
[("w:id", show insId),
("w:author", T.unpack author),
("w:date", T.unpack date)] x ]
(("w:id", show insId) : changeAuthorDate) x]
else return id
delmod <- if "deletion" `elem` classes
then do
(author, date) <- getChangeAuthorDate
changeAuthorDate <- getChangeAuthorDate
delId <- gets stDelId
modify $ \s -> s{stDelId = delId + 1}
return $ \f -> local (\env->env{envInDel=True}) $ do
x <- f
return [mknode "w:del"
[("w:id", show delId),
("w:author", T.unpack author),
("w:date", T.unpack date)] x]
(("w:id", show delId) : changeAuthorDate) x]
else return id
contents <- insmod $ delmod $ dirmod $ stylemod $ pmod
$ inlinesToOpenXML opts ils

4
test/Tests/Readers/Docx.hs
View file

@ -405,6 +405,10 @@ tests = [ testGroup "document"
"paragraph insertion/deletion (all)"
"docx/paragraph_insertion_deletion.docx"
"docx/paragraph_insertion_deletion_all.native"
, testCompareWithOpts def{readerTrackChanges=AllChanges}
"paragraph insertion/deletion (all)"
"docx/track_changes_scrubbed_metadata.docx"
"docx/track_changes_scrubbed_metadata.native"
, testForWarningsWithOpts def{readerTrackChanges=AcceptChanges}
"comment warnings (accept -- no warnings)"
"docx/comments_warning.docx"

5
test/Tests/Writers/Docx.hs
View file

@ -150,6 +150,11 @@ tests = [ testGroup "inlines"
def
"docx/comments.native"
"docx/golden/comments.docx"
, docxTest
"scrubbed metadata"
def
"docx/track_changes_scrubbed_metadata.native"
"docx/golden/track_changes_scrubbed_metadata.docx"
]
, testGroup "custom styles"
[ docxTest "custom styles without reference.docx"

BIN
test/docx/golden/track_changes_scrubbed_metadata.docx Normal file
View file

Binary file not shown.

BIN
test/docx/track_changes_scrubbed_metadata.docx Normal file
View file

Binary file not shown.

9
test/docx/track_changes_scrubbed_metadata.native Normal file
View file

@ -0,0 +1,9 @@
[Para [ Str "Here", Space, Str "is", Space, Str "a", Space
, Span ("",["deletion"],[("author","Author")]) [Str "dummy"]
, Span ("",["insertion"],[("author","Author")]) [Str "test"]
, Space
, Span ("",["comment-start"],[("id","3"),("author","Author")])
[Str "With",Space,Str "a",Space,Str "comment!"]
, Str "document",Span ("",["comment-end"],[("id","3")]) [],Str "."
]
]