-
Notifications
You must be signed in to change notification settings - Fork 22
/
Copy pathwrite_ods.R
167 lines (159 loc) · 9.21 KB
/
write_ods.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
## CREATION OF sysdata
## .CONTENT <- readLines("benchmark/header.xml")
## .FOOTER <- readLines("benchmark/footer.xml")
## .FODS_HEADER <- paste(readLines("benchmark/fods_header.xml"), collapse = "\n")
## .FODS_FOOTER <- paste(readLines("benchmark/fods_footer.xml"), collapse = "\n")
## usethis::use_data(.CONTENT, .FOOTER, .FODS_HEADER, .FODS_FOOTER, internal = TRUE, overwrite = TRUE)
.zip_tmp_to_path <- function(temp_ods_dir, path, overwrite = TRUE, flat = FALSE) {
if (flat) {
return(path) ## do nothing
}
wd <- getwd()
on.exit(setwd(wd), add = TRUE)
setwd(temp_ods_dir)
zip::zip(basename(path), include_directories = FALSE, recurse = TRUE, files = dir(), mode = "cherry-pick")
setwd(wd)
file.copy(file.path(temp_ods_dir, basename(path)), path, overwrite = overwrite)
return(path)
}
.convert_df_to_sheet <- function(x, sheet = "Sheet1", row_names = FALSE, col_names = FALSE, na_as_string = FALSE, padding = FALSE, xml_file = file.path(tempfile(fileext = ".xml"))) {
write_sheet_(x = x, filename = xml_file, sheet = sheet, row_names = row_names, col_names = col_names,
na_as_string = na_as_string, padding = padding,
header = "",
footer = "")
}
.preprocess_x <- function(x) {
if (inherits(x, "tbl_df")) { #Convert to a df if currently a tibble
x <- as.data.frame(x)
}
if (!is.data.frame(x)) {
stop("x must be a data.frame.", call. = FALSE)
}
## Limit writing to only files that Libreoffice and Excel can read
if (ncol(x) > 16383 || nrow(x) > 2^20) {
stop("Data exceeds max sheet size of 16383 x 1048576", call. = FALSE)
}
return(x)
}
.preprocess_path <- function(path) {
normalized_path <- normalizePath(path, mustWork = FALSE)
## ensure the file can be created
file.create(normalized_path, showWarnings = FALSE)
if (!file.exists(normalized_path)) {
stop("File cannot be created at this path: ", normalized_path, call. = FALSE)
}
return(normalized_path)
}
.update_ods <- function(x, path = tempfile(fileext = ".ods"), sheet = "Sheet1", append = FALSE, update = FALSE, row_names = FALSE, col_names = TRUE, na_as_string = FALSE, padding = FALSE, flat = FALSE, temp_ods_dir = NULL) {
if (!file.exists(path)) {
stop("File does not exist: ", path, call. = FALSE)
}
if (isFALSE(flat)) {
zip::unzip(path, exdir = temp_ods_dir)
contentfile <- file.path(temp_ods_dir, "content.xml")
sheets <- list_ods_sheets(path, include_external_data = TRUE)
} else {
contentfile <- path
sheets <- list_fods_sheets(path, include_external_data = TRUE)
}
is_in_sheet_names <- stringi::stri_cmp(e1 = sheet, e2 = sheets) == 0
sheet_exist <- any(is_in_sheet_names)
if ((sheet_exist && append && !update) || (sheet_exist && !update)) {
## Sheet exists so we cannot append
stop(paste0("Sheet ", sheet, " exists. Set update to TRUE is you want to update this sheet."), call. = FALSE)
}
if (!sheet_exist && update) {
stop(paste0("Sheet ", sheet, " does not exist. Cannot update."), call. = FALSE)
}
## numeric
normalized_sheet <- which(is_in_sheet_names)
throwaway_xml_file <- .convert_df_to_sheet(x = x, sheet = sheet, row_names = row_names, col_names = col_names,
na_as_string = na_as_string, padding = padding)
if (append) {
return(splice_sheet_(contentfile, throwaway_xml_file, flat))
}
return(update_sheet_(contentfile, throwaway_xml_file, flat, normalized_sheet))
}
.write_ods <- function(x, path = tempfile(fileext = ".ods"), sheet = "Sheet1", append = FALSE, update = FALSE, row_names = FALSE, col_names = TRUE, na_as_string = FALSE, padding = FALSE, flat = FALSE) {
if (isFALSE(inherits(x, "data.frame")) && !is.list(x)) {
stop("x must be data.frame or list.", call. = FALSE)
}
if (isFALSE(inherits(x, "data.frame")) && is.list(x) && length(x) == 0) {
stop("x must contain at least one data.frame.", call. = FALSE)
}
temp_ods_dir <- NULL
if (isFALSE(flat)) {
temp_ods_dir <- file.path(tempdir(), stringi::stri_rand_strings(1, 30, pattern = "[A-Za-z0-9]"))
dir.create(temp_ods_dir)
on.exit(unlink(temp_ods_dir))
}
if (append || update) {
.update_ods(x = .preprocess_x(x), path = path, sheet = sheet, append = append, update = update, row_names = row_names,
col_names = col_names, na_as_string = na_as_string, padding = padding, flat = flat,
temp_ods_dir = temp_ods_dir)
return(invisible(.zip_tmp_to_path(temp_ods_dir, path, flat = flat)))
}
if (isTRUE(inherits(x, "data.frame"))) {
x <- .preprocess_x(x)
.write_fun <- write_sheet_
} else {
## it's a list (at least we assume)
x <- lapply(x, .preprocess_x)
if (is.null(names(x))) {
names(x) <- paste0("Sheet", seq_along(x))
}
.write_fun <- write_sheet_list_
}
path <- .preprocess_path(path)
if (isFALSE(flat)) {
templatedir <- system.file("template", package = "readODS")
file.copy(dir(templatedir, full.names = TRUE), temp_ods_dir, recursive = TRUE, copy.mode = FALSE)
filename <- file.path(temp_ods_dir, "content.xml")
header <- paste0(.CONTENT[1], .CONTENT[2])
footer <- .FOOTER
} else {
filename <- path
header <- .FODS_HEADER
footer <- .FODS_FOOTER
}
.write_fun(filename = filename, x = x, sheet = sheet, row_names = row_names, col_names = col_names, na_as_string = na_as_string, padding = padding, header = header, footer = footer)
return(invisible(.zip_tmp_to_path(temp_ods_dir, path, flat = flat)))
}
#' Write Data to (F)ODS File
#' @description
#' Function to write a single data frame or a list of data frames to a (f)ods file.
#'
#' @param x data frame or list of data frames that will be sheets in the (f)ods. If the list is named, the names are used as sheet names
#' @param path Path to the (f)ods file to write
#' @param sheet Name of the sheet; ignore if `x` is a list of data frames
#' @param append logical, TRUE indicates that x should be appended to the existing file (path) as a new sheet. If a sheet with the same sheet_name exists, an exception is thrown. See update. Please also note that writing is slightly slower if TRUE. Default is FALSE. Ignore if `x` is a list of data frames
#' @param update logical, TRUE indicates that the sheet with sheet_name in the existing file (path) should be updated with the content of x. If a sheet with sheet_name does not exist, an exception is thrown. Please also note that writing is slightly slower if TRUE. Default is FALSE. Ignore if `x` is a list of data frames
#' @param row_names logical, TRUE indicates that row names of x are to be included in the sheet. Default is FALSE
#' @param col_names logical, TRUE indicates that column names of x are to be included in the sheet. Default is TRUE
#' @param na_as_string logical, TRUE indicates that NAs are written as string; FALSE indicates that NAs are written as empty cells
#' @param padding logical, TRUE indicates that the sheet is padded with repeated empty cells to the maximum size, either 2^20 x 1024 (if the number of columns of `x` is less than or equal 1024) or 2^20 x 16,384 (otherwise). This is the default behaviour of Microsoft Excel. Default is FALSE
#' @return A (F)ODS file written to the file path location specified by the user. The value of \code{path} is also returned invisibly
#' @details This function emulates [writexl::write_xlsx()] and [openxlsx::write.xlsx()] except in the handling of list columns. The expected behaviour for this is undefined and the two functions behave differently. This function handles list columns by converting them to character vectors of R code (similar to the output of [dput()]), which is probably not ideal.
#' @author Detlef Steuer <steuer@@hsu-hh.de>, Thomas J. Leeper <thosjleeper@@gmail.com>, John Foster <john.x.foster@@nab.com.au>, Chung-hong Chan <chainsawtiney@@gmail.com>
#' @examples
#' \dontrun{
#' # preserve the row names
#' write_ods(mtcars, "mtcars.ods", row_names = TRUE)
#' # append a sheet to an existing file
#' write_ods(PlantGrowth, "mtcars.ods", append = TRUE, sheet = "plant")
#' # This is however faster
#' write_ods(list("Sheet1" = mtcars, "plant" = PlantGrowth), "mtcars.ods", row_names = TRUE)
#' # write flat ODS file
#' write_fods(mtcars, "mtcars.fods", sheet = "mtcars")
#' }
#' @export
write_ods <- function(x, path = tempfile(fileext = ".ods"), sheet = "Sheet1", append = FALSE, update = FALSE, row_names = FALSE, col_names = TRUE, na_as_string = FALSE, padding = FALSE) {
.write_ods(x = x, path = path, sheet = sheet, append = append, update = update, row_names = row_names, col_names = col_names,
na_as_string = na_as_string, padding = padding, flat = FALSE)
}
#' @rdname write_ods
#' @export
write_fods <- function(x, path = tempfile(fileext = ".fods"), sheet = "Sheet1", append = FALSE, update = FALSE, row_names = FALSE, col_names = TRUE, na_as_string = FALSE, padding = FALSE) {
.write_ods(x = x, path = path, sheet = sheet, append = append, update = update, row_names = row_names, col_names = col_names,
na_as_string = na_as_string, padding = padding, flat = TRUE)
}