Merge pull request #202 from JanMarvin/gh_issue_201

[WIP] add DocSecurity type to protectWorkbook. closes #201

R/WorkbookClass.R

@@ -828,11 +828,14 @@ Workbook$methods(
       fl = file.path(relsDir, ".rels")
     )
 
+    app <- "<Application>Microsoft Excel</Application>"
+    # further protect argument (might be extended with: <ScaleCrop>, <HeadingPairs>, <TitlesOfParts>, <LinksUpToDate>, <SharedDoc>, <HyperlinksChanged>, <AppVersion>)
+    if (!is.null(workbook$apps)) app <- paste0(app, workbook$apps)
 
     ## write app.xml
     write_file(
       head = '<Properties xmlns="http://schemas.openxmlformats.org/officeDocument/2006/extended-properties" xmlns:vt="http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes">',
-      body = "<Application>Microsoft Excel</Application>",
+      body = app,
       tail = "</Properties>",
       fl = file.path(docPropsDir, "app.xml")
     )
@@ -4223,7 +4226,8 @@ Workbook$methods(
   protectWorkbook = function(protect = TRUE,
                              lockStructure = FALSE,
                              lockWindows = FALSE,
-                             password = NULL) {
+                             password = NULL,
+                             type = NULL) {
     attr <- c()
     if (!is.null(password)) {
       attr["workbookPassword"] <- hashPassword(password)
@@ -4248,6 +4252,8 @@ Workbook$methods(
             sep = ""
           )
         )
+      if (!is.null(type) | !is.null(password))
+        workbook$apps <<- sprintf("<DocSecurity>%i</DocSecurity>", type)
     } else {
       workbook$workbookProtection <<- ""
     }

R/wrappers.R

@@ -2437,6 +2437,7 @@ protectWorksheet <- function(wb, sheet, protect = TRUE, password = NULL,
 #' @param password (optional) password required to unprotect the workbook
 #' @param lockStructure Whether the workbook structure should be locked
 #' @param lockWindows Whether the window position of the spreadsheet should be locked
+#' @param type Lock type, default 1. From the xml documentation: 1 - Document is password protected. 2 - Document is recommended to be opened as read-only. 4 - Document is enforced to be opened as read-only. 8 - Document is locked for annotation.
 #' @export
 #' @examples
 #' wb <- createWorkbook()
@@ -2450,12 +2451,12 @@ protectWorksheet <- function(wb, sheet, protect = TRUE, password = NULL,
 #' \dontrun{
 #' saveWorkbook(wb, "WorkBook_Protection_unprotected.xlsx", overwrite = TRUE)
 #' }
-protectWorkbook <- function(wb, protect = TRUE, password = NULL, lockStructure = FALSE, lockWindows = FALSE) {
+protectWorkbook <- function(wb, protect = TRUE, password = NULL, lockStructure = FALSE, lockWindows = FALSE, type = 1L) {
   if (!"Workbook" %in% class(wb)) {
     stop("First argument must be a Workbook.")
   }
 
-  invisible(wb$protectWorkbook(protect = protect, password = password, lockStructure = lockStructure, lockWindows = lockWindows))
+  invisible(wb$protectWorkbook(protect = protect, password = password, lockStructure = lockStructure, lockWindows = lockWindows, type = type))
 }
 
 

tests/testthat/test-protect-workbook.R

@@ -24,8 +24,10 @@ test_that("Reading protected Workbook", {
   saveWorkbook(wb, tmp_file, overwrite = TRUE)
 
   wb2 <- loadWorkbook(file = tmp_file)
-  # Check that the order of teh sub-elements is preserved
-  expect_equal(names(wb2$workbook), names(wb$workbook))
+  # Check that the order of the sub-elements is preserved
+  n1 <- names(wb2$workbook)
+  n2 <- names(wb$workbook)[names(wb$workbook) != "apps"]
+  expect_equal(n1, n2)
 
   unlink(tmp_file, recursive = TRUE, force = TRUE)
 })