Merge branch 'release/1.21.0'

Author: pbchase

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: redcapcustodian
 Type: Package
 Title: Data automation for R-centric workflows with a nod towards REDCap
-Version: 1.20.0
+Version: 1.21.0
 Authors@R: c(
   person("Philip", "Chase",
         email = "pbc@ufl.edu",
@@ -55,7 +55,8 @@ Imports:
     tibble,
     tidyr,
     vctrs,
-    jsonlite
+    jsonlite,
+    writexl
 Suggests:
     RSQLite,
     digest,

NAMESPACE

@@ -63,3 +63,4 @@ export(write_to_sql_db)
 importFrom(magrittr,"%>%")
 importFrom(rlang,.data)
 importFrom(sendmailR,"sendmail")
+importFrom(writexl,write_xlsx)

NEWS.md

@@ -1,3 +1,6 @@
+# redcapcustodian 1.21.0 (released 2024-03-15)
+- Add attachment management to send_email() allowing lists of files or dataframes to be attached to an email (@ljwoodley, #152, #153)
+
 # redcapcustodian 1.20.0 (released 2024-02-28)
 - Add get_redcap_credentials() (@ljwoodley, #149, #151)
 - Revert "add redcap wrapper functions" (@ljwoodley, #149, #150)

R/logging.R

@@ -566,53 +566,178 @@ write_info_log_entry <- function(conn, target_db_name, table_written = NULL, df,
 
 #' A wrapper function that sends an email (via sendmailR) reporting the outcome of another function
 #'
+#' This function sends an email via `sendmailR`, optionally including a dataframe(s) or zip files(s) as attachments.
+#'
 #' @param email_body The contents of the email
 #' @param email_subject The subject line of the email
 #' @param email_to The email addresses of the primary recipient(s), separate recipient addresses with spaces
 #' @param email_cc The email addresses of cc'd recipient(s), separate recipient addresses with spaces
 #' @param email_from The email addresses of the sender
-#' @return No returned value
+#' @param df_to_email (Optional) A dataframe or a list of dataframes to be included as file attachment(s). If this parameter is used, `file_name` must also be specified.
+#'                    Each dataframe in the list must have a corresponding file name in the `file_name` parameter to ensure a one-to-one match between dataframes and file names.
+#' @param file_name (Optional) A character vector specifying the file name(s) of the attachment(s). Valid file extensions are `.csv`, `.xlsx`, and `.zip`. Each file name must be unique.
+#' @param ... Additional arguments passed directly to the file writing functions: `write.csv` for CSV files, and `writexl::write_xlsx` for XLSX files.
+#'
+#' @return No returned value. It performs an action by sending an email.
 #' @examples
 #'
 #' \dontrun{
-#' message <- paste("Failed REDCap data import to", project_title,
+#' email_body <- paste("Failed REDCap data import to", project_title,
 #'                   "\nThe reason given was:", error_message)
 #'
 #' email_subject <- paste("FAILED |", script_name, "|",
 #'                         Sys.getenv("INSTANCE"), "|", script_run_time)
 #'
-#' send_email(message, email_subject)
+#' # email without attachemnts
+#' send_email(email_body, email_subject)
+#'
+#' email_to <- c("email1@example.com email2@example.com")
+#' dfs_to_email <- list(head(cars), tail(cars))
+#' file_names <- c("file1.csv", "file2.xlsx")
+#'
+#' # single attachment and at least one email address
+#' send_email(
+#'   email_subject = email_subject,
+#'   email_body = email_body,
+#'   email_from = email_from,
+#'   email_to = email_to,
+#'   df_to_email = head(cars),
+#'   file_name = "file1.csv"
+#' )
+#'
+#' # multiple attachments and at least one email address
+#' send_email(
+#'   email_subject = email_subject,
+#'   email_body = email_body,
+#'   email_from = email_from,
+#'   email_to = email_to,
+#'   df_to_email = dfs_to_email,
+#'   file_name = file_names
+#' )
+#'
+#' send_email(
+#'   email_subject = email_subject,
+#'   email_body = email_body,
+#'   email_from = email_from,
+#'   email_to = email_to,
+#'   file_name = c("file1.zip", "<path_to_file>file2.zip")
+#' )
+#'
+#' # single attachment for each email group
+#' email_to <- c("email1@example.com", c("email2@example.com email3@example.com"))
+#'
+#' args_list <- list(
+#'   email_subject = email_subject,
+#'   email_body = email_body,
+#'   email_to = email_to,
+#'   email_from = email_from,
+#'   df_to_email = dfs_to_email,
+#'   file_name = file_names
+#' )
+#'
+#' purrr::pmap(args_list, send_email)
+#'
+#' # multiple attachments for each email group
+#' email_to <- c(
+#'   c("email1@example.com email2@example.com"),
+#'   c("email3@example.com email4@example.com")
+#' )
+#'
+#' args_list <- list(
+#'   email_subject = email_subject,
+#'   email_body = email_body,
+#'   email_to = email_to,
+#'   email_from = email_from,
+#'   df_to_email = list(dfs_to_email, dfs_to_email),
+#'   file_name = list(file_names, file_names)
+#' )
+#'
+#' purrr::pmap(args_list, send_email)
+#'
 #' }
 #' @importFrom sendmailR "sendmail"
+#' @importFrom writexl write_xlsx
 #' @export
-send_email <- function(email_body, email_subject = "", email_to = "", email_cc = "", email_from = "") {
-  # email credentials
-  email_server <- list(smtpServer = Sys.getenv("SMTP_SERVER"))
-  if (email_from == "") {
-    email_from <- Sys.getenv("EMAIL_FROM")
-  }
-  if (email_cc == "") {
-    email_cc <- unlist(strsplit(Sys.getenv("EMAIL_CC"), " "))
-  } else {
-    email_cc <- unlist(strsplit(email_cc, " "))
-  }
-  if (email_subject == "") {
-    email_subject <- paste(Sys.getenv("EMAIL_SUBJECT"), get_script_run_time())
-  }
+send_email <-
+  function(email_body,
+           email_subject = "",
+           email_to = "",
+           email_cc = "",
+           email_from = "",
+           df_to_email = NULL,
+           file_name = NULL,
+           ...
+  ) {
+
+    email_server <- list(smtpServer = Sys.getenv("SMTP_SERVER"))
+    if (email_from == "") {
+      email_from <- Sys.getenv("EMAIL_FROM")
+    }
+    if (email_cc == "") {
+      email_cc <- unlist(strsplit(Sys.getenv("EMAIL_CC"), " "))
+    } else {
+      email_cc <- unlist(strsplit(email_cc, " "))
+    }
+    if (email_subject == "") {
+      email_subject <-
+        paste(Sys.getenv("EMAIL_SUBJECT"), get_script_run_time())
+    }
 
-  if (email_to == "") {
-    email_to <- unlist(strsplit(Sys.getenv("EMAIL_TO"), " "))
-  } else {
-    email_to <- unlist(strsplit(email_to, " "))
-  }
+    if (email_to == "") {
+      email_to <- unlist(strsplit(Sys.getenv("EMAIL_TO"), " "))
+    } else {
+      email_to <- unlist(strsplit(email_to, " "))
+    }
 
-  ## TODO: consider toggling bypass of printing if interactive and local env detected
-  ## if (interactive()) {
-  ##   print(email_body)
-  ##   return(email_body)
-  ## }
-  # TODO: consider replacing sendmailR with mRpostman
-  sendmailR::sendmail(from = email_from, to = email_to, cc = email_cc,
-                      subject = email_subject, msg = email_body,
-                      control = email_server)
-}
+    if (!is.null(file_name)) {
+      output_dir <- tempdir()
+      email_content <- list()
+
+      if (!is.null(df_to_email) && is.data.frame(df_to_email)) {
+        df_to_email <- list(df_to_email)
+      }
+
+      if (!is.null(df_to_email) &&
+          length(df_to_email) != length(file_name)) {
+        stop("The number of dataframes and file names must match.")
+      }
+
+      for (i in seq_along(file_name)) {
+        file_extension <- tolower(sub(".*\\.(.*)$", "\\1", file_name[[i]]))
+        file_fullpath <- file.path(output_dir, basename(file_name[[i]]))
+
+        if (!is.null(df_to_email)) {
+          if (file_extension == "csv") {
+            readr::write_csv(df_to_email[[i]], file_fullpath, ...)
+          } else if (file_extension == "xlsx") {
+            writexl::write_xlsx(df_to_email[[i]], file_fullpath, ...)
+          } else {
+            stop("Unsupported file format. Use 'csv' or 'xlsx'.")
+          }
+        }
+
+        if (file_extension == "zip" &&
+            !file.copy(file_name[[i]], output_dir, overwrite = TRUE)) {
+          stop(paste("Failed to move", file_name[[i]]))
+        }
+
+        attachment_object <- sendmailR::mime_part(file_fullpath, basename(file_fullpath))
+        email_content <- c(email_content, attachment_object)
+      }
+    }
+
+    ## TODO: consider toggling bypass of printing if interactive and local env detected
+    ## if (interactive()) {
+    ##   print(email_body)
+    ##   return(email_body)
+    ## }
+    # TODO: consider replacing sendmailR with mRpostman
+    sendmailR::sendmail(
+      from = email_from,
+      to = email_to,
+      cc = email_cc,
+      subject = email_subject,
+      msg = email_content,
+      control = email_server
+    )
+  }

VERSION

@@ -1 +1 @@
-1.20.0
+1.21.0