Merge pull request #67 from EcologyR/sending_certificates

Sending certificates

DESCRIPTION

@@ -19,13 +19,15 @@ Description: Create custom labels, badges, certificates
 License: MIT + file LICENSE
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2
 URL: https://github.com/EcologyR/labeleR/, https://ecologyr.github.io/labeleR/
 BugReports: https://github.com/EcologyR/labeleR/issues/
 Depends: 
     R (>= 3.5.0)
 LazyData: true
 Suggests: 
+    blastula,
+    keyring,
     testthat (>= 3.0.0)
 Config/testthat/edition: 3
 Imports: 

NAMESPACE

@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+export(configure_email)
 export(create_attendance_certificate)
 export(create_badge)
 export(create_collection_label)

NEWS.md

@@ -1,3 +1,7 @@
+# labeleR 0.2.0
+
+* Allow sending certificates via mail
+
 # labeleR 0.1.4
 
 * Add inner margin to herbarium labels

R/certificate_attendance.R

@@ -7,6 +7,9 @@
 #' @param filename Character. Filename of the pdf. If NULL, default is "Attendance" for English, "Asistencia" for Spanish".
 #' @param language Character. Select 'English' or 'Spanish'.
 #' @param name.column Character. Name of the column in `data` storing attendees' name.
+#' @param email.column Character. Name of the column in `data` storing attendees' email address
+#' to automatically send them their certificates.
+#' @param email.info Object created using [configure_email()] function.
 #' @param type Character (optional). Type of event (conference, workshop, seminar...)
 #' @param title Character. Title of the event
 #' @param date Date of the event
@@ -58,6 +61,8 @@ create_attendance_certificate <- function(
     filename = NULL,
     language = c("English", "Spanish"),
     name.column = NULL,
+    email.column = NULL,
+    email.info = NULL,
     type = "",
     title = "",
     date = "",
@@ -96,9 +101,17 @@ create_attendance_certificate <- function(
     if (language == "Spanish") {filename <- "Asistencia"}
   }
 
+
+  sendmail <- sendmail_setup(email.column, email.info)
+
+
   check_column_in_df(data, name.column)
   data[,name.column]<- check_latex(data, name.column)
 
+  if(!is.null(email.column)){
+  check_column_in_df(data, email.column)
+  }
+
   stopifnot(is.character(type))
   stopifnot(is.character(title))
   stopifnot(is.character(freetext))
@@ -173,6 +186,7 @@ create_attendance_certificate <- function(
   for (i in 1:nrow(data)) {
     out.name <- filename
     out.name <- paste0(out.name, "_", data[i, name.column])
+    out.name <- check_file_name(out.name, ".pdf", path)
     output_file <- paste0(out.name, '.pdf')
 
     bl.char <- "~"
@@ -193,6 +207,16 @@ create_attendance_certificate <- function(
       )
     )
 
+    if(isTRUE(sendmail)){
+      send_mail(data = data,
+               row = i,
+               email.info = email.info,
+               name.column  =  name.column ,
+               email.column =  email.column ,
+               attachment = paste0(path, "/", output_file)
+      )
+    }
+
   }
 
 }

R/certificate_participation.R

@@ -15,6 +15,9 @@
 #' contribution.
 #' @param date.column Character. Name of the column in `data` storing dates of
 #' participation.
+#' @param email.column Character. Name of the column in `data` storing attendees' email address
+#' to automatically send them their certificates.
+#' @param email.info Object created using [configure_email()] function.
 #' @param type Character (optional). Type of event (conference, workshop, seminar...)
 #' @param event Character. Title of the event
 #' @param freetext Character (optional). Free text to insert before the date.
@@ -69,6 +72,8 @@ create_participation_certificate <- function(
     comm.type.column = NULL,
     title.column = NULL,
     date.column = NULL,
+    email.column = NULL,
+    email.info = NULL,
     type = "",
     event = "",
     freetext = "",
@@ -105,6 +110,10 @@ create_participation_certificate <- function(
     if (language == "Spanish") {filename <- "Participacion"}
   }
 
+
+  sendmail <- sendmail_setup(email.column, email.info)
+
+
   check_column_in_df(data, name.column)
 
   if (!is.null(affiliation.column)) {
@@ -118,6 +127,10 @@ create_participation_certificate <- function(
 
   check_column_in_df(data, date.column)
 
+  if(!is.null(email.column)){
+    check_column_in_df(data, email.column)
+  }
+
   arguments <- c(name.column, comm.type.column, title.column, date.column)
   arguments <- arguments[arguments!=""]
 
@@ -187,8 +200,9 @@ create_participation_certificate <- function(
 
   for (i in 1:nrow(data)) {
     out.name <- filename
-    out.name <- paste0(out.name, "_", data[i, name.column], "_",
-                       gsub("/","-", data[i, date.column]))
+    out.name <- paste0(out.name, "_", data[i, name.column])
+    out.name <- check_file_name(out.name, ".pdf", path)
+
     output_file <- paste0(out.name,'.pdf')
 
     bl.char <- "~"
@@ -211,7 +225,16 @@ create_participation_certificate <- function(
       )
     )
 
+      if(isTRUE(sendmail)){
+        send_mail(data = data,
+                 row = i,
+                 email.info = email.info,
+                 name.column  =  name.column ,
+                 email.column =  email.column,
+                 attachment = paste0(path, "/", output_file) )
+      }
+    }
   }
 
-}
+
 

R/configure_email.R

@@ -0,0 +1,112 @@
+
+
+#' Configure email sending
+#'
+#' Configure the email application to automatically send certificates.
+#'
+#' @param user Character. Gmail account that will be used to send certificates.
+#' @param app.name Name of the mail application used to send emails.
+#' To create one, access <https://myaccount.google.com/apppasswords>.
+#' @param subject Character. Subject of the email to be sent. If not specified, labeleR will use a default value.
+#' @param body Character. Body text of the email to be sent. If not specified, labeleR will use a default value.
+#' @param cc Character. String (or vector of strings) containing the email addresses to send the email as a copy.
+#' @param bcc Character. String (or vector of strings) containing the email addresses to send the email as a hidden copy.
+#'
+#' @return A list including at least a 'user' string' and an 'app.name' string. Optionally, slots 'subject',
+#' 'body', 'cc' and 'bcc' can be edited to compile the email to send.
+#'
+#' @export
+#' @examples
+#' \dontrun{
+#' email.info <- configure_email(user = 'example@@gmail.com')
+#'
+#' ## If you already have created an application:
+#' email.info <- configure_email(user = 'example@@gmail.com', app.name = "emailsend")
+#'
+#' }
+#'
+#'
+#'
+#' @author Ignacio Ramos-Gutierrez, Julia G. de Aledo, Jimena Mateo-Martín, Francisco Rodriguez-Sanchez
+#'
+configure_email <- function(user = NULL,
+                            app.name = NULL,
+                            subject = NULL,
+                            body = NULL,
+                            cc = NULL,
+                            bcc = NULL
+) {
+
+  if (!requireNamespace("blastula", quietly = TRUE)) {
+    stop("For automatically sending emails, the `blastula` package must be installed.\n",
+         "Please run install.packages(\"blastula\")")
+  }
+
+  if (!requireNamespace("keyring", quietly = TRUE)) {
+    stop("For automatically sending emails, the `keyring` package must be installed.\n",
+         "Please run install.packages(\"keyring\")")
+  }
+
+  if (is.null(user)) {
+    user <- readline("Please write here the gmail account you would like to use to send the emails: ")
+    user <- gsub(" ", "", user)
+  }
+  stopifnot(is.character(user))
+  if (!grepl("@gmail", user)) {
+    stop("Please provide a complete gmail address")
+  }
+
+
+  credentials <- blastula::view_credential_keys()
+  credentials <- credentials[credentials$username == user,]
+
+  if (!is.null(app.name)){
+    credentials <- credentials[credentials$id == app.name, ]
+    if(nrow(credentials) == 0){
+      stop( "No application ", app.name, " found for user ", user)
+    }
+  }
+
+  if (is.null(app.name) ){
+    app.exists <- utils::askYesNo("Have you already created an application for this gmail account?", default = FALSE)
+    if (!isTRUE(app.exists)) {
+      message(
+        "You must first create a mail sending application\n(don't worry, it is very easy, and is necessary only the first time!).\n\n",
+
+        "- First access this link using the specified  mail user (R will open it for you):
+      https://myaccount.google.com/apppasswords \n\n",
+
+        "- Choose a name for you application.\n\n",
+
+        "- Save the password anywhere safe, as you will be asked for it later!\n\n")
+
+      utils::browseURL("https://myaccount.google.com/apppasswords")
+
+    }
+
+    app.name <- readline("What is your application name? Please write it here: ")
+    app.name <- gsub(" ", "", app.name)
+
+  }
+
+
+  blastula::create_smtp_creds_key(id = app.name,
+                                  provider = "gmail",
+                                  user = user,
+                                  overwrite = TRUE)
+  # credentials <- blastula::view_credential_keys()
+  # credentials <- credentials[credentials$username == user,]
+  # credentials <- credentials[credentials$id == app.name,]
+
+  email.info.ret <- list(
+    "user" = user,
+    "app.name" = app.name,
+    "subject" = subject,
+    "body" = body,
+    "cc" = cc,
+    "bcc" = bcc
+  )
+
+  return(email.info.ret)
+
+}

R/zzz.R

@@ -96,3 +96,119 @@ use_image <- function(image = NULL, name = NULL, folder = NULL) {
   }
 
 }
+
+
+#Function to change a name between brackets
+check_file_name <- function(name, suffix, path){
+
+  if(!file.exists(paste0(path, "/", name, suffix))){
+    newname <- name
+  }else{
+    files <- list.files(path, pattern = name)
+    if(length(files)==1){
+      newname <- paste0(name, "(2)")
+    }else{
+      files <- gsub(name, "", files)
+      files <- gsub(suffix, "", files)
+      files <- files[files!=""]
+      files <- gsub("\\(", "", files)
+      files <- gsub("\\)", "", files)
+      num <- max(as.numeric(files))
+      newname <- paste0(name, "(",num+1 ,")")
+    }
+  }
+  return(newname)
+}
+
+#### Function to set the SMTP server
+sendmail_setup <- function(email.column, email.info){
+
+  if( is.null(email.column) & !is.null(email.info)){
+    stop("You must specify the email column")
+  }
+
+  if(!is.null(email.column) & is.null(email.info)){
+    email.info <- configure_email()
+  }
+
+  if(!is.null(email.info) &
+     (!inherits(email.info, "list") |
+      !(("user") %in% names(email.info)) |
+      !(("app.name") %in% names(email.info)))){
+    stop("'email.info' should be a list object created using 'configure_email' function")
+  }
+
+  if(!is.null(email.column) & !is.null(email.info)){
+    sendmail <- TRUE
+  }else {
+    sendmail <- FALSE
+  }
+
+  if (isTRUE(sendmail)) {
+    sendmail <- utils::askYesNo("You are trying to send automatically certificates via email. Are you sure you want to continue with the automatic sending?",
+                                default = FALSE,
+                                prompts = getOption("askYesNo", gettext(c("Yes", "No", "Cancel"))))
+    if(is.na(sendmail)){stop("Cancel button selected. Aborting.")}
+  }
+
+  # if(isTRUE(sendmail)){
+  #
+  #
+  #   blastula::create_smtp_creds_key(id = email.info$app.name,
+  #                                   provider = "gmail",
+  #                                   user = email.info$user,
+  #                                   overwrite = T)
+  #   credentials <- blastula::view_credential_keys()
+  #   credentials <- credentials[credentials$username == email.info$user &
+  #                                credentials$id == email.info$app.name,]
+  #
+  # }
+
+  return(sendmail)
+}
+
+#### Function to send a mail and atachment within the loop
+
+send_mail <- function(data, row, email.info,
+                     name.column, email.column,
+                     attachment){
+  mail.to <- data[row,email.column]
+
+  if (!grepl("@", mail.to)) {message("email not sent to ", data[row, name.column])}#se puede mandar un auto mensaje??
+  if (grepl("@", mail.to)){
+
+    mail.from <- email.info$user
+    mail.subj <- email.info$subject
+    mail.body <- email.info$body
+    mail.cc   <- email.info$cc
+    mail.bcc   <- email.info$bcc
+
+    if(is.null(mail.subj)){mail.subj <- paste0("Certificate - ", data[row, name.column])}
+
+    if(is.null(mail.body)){mail.body <- paste0("Certificate for ", data[row, name.column],".\n\n",
+                                               "This certificate was automatically sent by labeleR using 'blastula'")}
+
+
+    mail.body <- gsub("\n", "\n\n", mail.body)
+    email <- blastula::compose_email(
+      body = blastula::md(mail.body),
+      footer = blastula::md(
+        "Mail sent automatically using labeleR.\r\n
+https://ecologyr.github.io/labeleR/"))
+    email <- blastula::add_attachment(email, file = attachment)
+
+
+    blastula::smtp_send(
+      email,
+      credentials = blastula::creds_key(email.info$app.name),
+      to = mail.to,
+      from = mail.from,
+      subject = mail.subj,
+      cc = mail.cc,
+      bcc = mail.bcc)
+
+
+  }}
+
+
+