# ----------------------------------------------------------------------------------------------------------------------------  #
  #  --------------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                               #
  #           File Name              :  EmailStatusUpdate.r                                                                       #
  #           Last Updated Funclist  :  15 Feb 2014, 12:22 AM (Saturday)                                                          #
  #                                                                                                                               #
  #           Author Name            :  Rick Saporta                                                                              #
  #           Author Email           :  RickSaporta@gmail.com                                                                     #
  #           Author URL             :  www.github.com/rsaporta                                                                   #
  #                                                                                                                               #
  #           Packages Called        :  sendmailR                                                                                 #
  #           Packages Used via NS   :  NA                                                                                        #
  #                                                                                                                               #
  #  --------------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                               #
  #   getDefaultEmails  ( emails=TRUE, showWarnings=TRUE )                                                                        #
  #   setDefaultEmails  ( emails=list(), showWarnings=TRUE )                                                                      #
  #   EmailStatusUpdate ( status="Job Completed", msg.details=message, to=c(), work=TRUE, home=FALSE, sms=TRUE                    #
  #                       , email.from=getDefaultEmails("from")                                                                   #
  #                       , email.from.name=ifelse(Sys.info()[["sysname"]] == "Linux", "RBox", "R"), projName=getProjName(pos=2)  #
  #                       , subProjName=getProjName(subProj.instead=TRUE), subject=NULL, from=NULL, eom.append=TRUE               #
  #                       , notify.osx=TRUE, this.is.a.relay=FALSE, debug=FALSE, message="" )                                     #
  #   getProjName       ( appendImgSave=FALSE, fresh=FALSE, pos=1, subProj.instead=FALSE )                                        #
  #   getScreen         ( prefix="", suffix="" )                                                                                  #
  #                                                                                                                               #
  #                                                                                                                               #
  #                                                       <END FUNCS>                                                             #
  #  --------------------------------------------------------------------------------------------------------------------------   #
  # ----------------------------------------------------------------------------------------------------------------------------  #

## Set Platform
if (!exists(".Pfm"))
  .Pfm <- Sys.info()[['sysname']]


## At the end of this .r file, there is a call to 
##    setDefaultEmails(emails=defaultEmails)
defaultEmails <-  list(
            from = "RBox2@theorchard.com"
          , home = "rsaporta@gmail.com"
          , work = "rsaporta@theorchard.com"
          , sms  = "3474490839@txt.att.net"
          , rauto= "rstatsnotifier@gmail.com"
          , outgoing = "rsMailRobot@gmail.com"
        )

## USAGE: 
# 
#  if (FALSE)  {
#      ## to clear default emails: 
#      setDefaultEmails()
#      setDefaultEmails(showWarnings=FALSE)
#      ## to set dedfault emails: 
#      setDefaultEmails(emails=list(
#              from = "rsaporta@theorchard.com"
#            , home = "rsaporta@gmail.com"
#            , work = "rsaporta@theorchard.com"
#            , sms  = "3474490839@txt.att.net"
#          ))
#  
#      ## to retrieve default emails:
#      getDefaultEmails(c("work", "sms"))
#  
#      ## to send an email status update
#      EmailStatusUpdate("This is the subject", "Here are some longer details for the body.")
#  }


getDefaultEmails <- function(emails=TRUE, showWarnings=TRUE) {
# emails : can be a named vector of defaults to search for. 
#        : TRUE.  return ALL defaults
#        : c().  Return blank
#        : if the first element starts with "!", then will take a negative selection of the whole group

  require(sendmailR)

  addrs <- sendmail_options("default.emails")[[1L]]

  if (isTRUE(emails))
    return(addrs)
  if (!length(emails))
    return(c())

  ## If Negative selection, then simply return the appropriate selection
  if (substr(emails, 1, 1)[[1L]] == "!") {
    addrs[!names(addrs) %in% gsub("\\!", "", emails)]
  }

  # check which emails are missing
  miss <- setdiff(emails, names(addrs))
 
  ## if none of the requested values are found, then probably have not yet been set
  if (identical(miss, emails)) {
    if (showWarnings)
      warning("None of the emails requested are set in the defaults.\nUse 'setDefaultEmails(namedList)' to set them.")
    return(invisible(c()))
  }

  if (length(miss) && showWarnings) 
    warning("Some requested default email addresses do not have default values. They are:\n  ", paste0("'", miss, "'", collapse=", "), "\n")

  return(addrs[setdiff(emails, miss)])
}

setDefaultEmails <- function(emails=list(), showWarnings=TRUE) {
  require(sendmailR)

  if (exists("inDebugMode"))
    browser(expr=inDebugMode(c("setDefaultEmails")), text="at top of setDefaultEmails()")

  if (!length(emails) && showWarnings)
    warning("Empty list submitted to 'setDefaultEmails()'. Any previously set default emails have been cleared.")

  if (!identical(length(emails), length(names(emails))))
    stop("'emails' has length ", length(emails), ", but names(emails) has length ", length(names(emails)), "\n'emails' must be a named list.\n   eg:  emails=list(work='me@company.com')")

  sendmail_options(
    ## default.emails is a named-vector of email adddresses
    default.emails = unlist(emails, use.names=TRUE)
  )
}


EmailStatusUpdate <- function(
    status="Job Completed"
  , msg.details = message

  # List of email addresses to send to
  , to=c()
  # Include default work email address
  , work=TRUE
  # Include default home email address
  , home=FALSE
  # Include default SMS email address
  , sms=TRUE

  ## What address the email will be sent from
  , email.from = getDefaultEmails("from")
  , email.from.name = ifelse(Sys.info()[['sysname']]=="Linux", "RBox", "R")

  ## Project Name. Allowed to be blank
  , projName=getProjName(pos=2)
  , subProjName=getProjName(subProj.instead=TRUE)

  ## subject is normally computed from status, unless otherwise given
  , subject=NULL
  ## from is normally computed using email.from + projName, unless otherwise given
  , from=NULL


  ## Whehter to add an <EOM> tag. If message is blank, this will be added to subject
  , eom.append=TRUE

  , notify.osx=TRUE
  , this.is.a.relay=FALSE
  , debug=FALSE

  # synonym for msg.details
  , message=""
) {


##       EMAIL STRUCTURE
##  ---------------------------
##    To: me work / text
##    From:  {"Box (projName)" <default.from> }
##    Subj:  {subprojName}: {status}
##    Msg :  {msg.details}

  browser(expr=isTRUE(debug))

  require(sendmailR)

  ## cleanup the msg.details value
  ## if not character, coerce
  if (!all(is.character(msg.details)))
    msg.details <- capture.output(print(msg.details))
  ## Collapse into a single string
  msg.details <- paste0(msg.details, collapse="\n")

  ## cleanup the 'to' value
  if (is.null(to) || is.na(to) || identical(to, list()))
     to <- c("")
  if (!is.character(to))
    stop("'to' should be a string value")

  ## Rick's personal use. Checks for running on Mac OSX and not work wd.
  if (.Pfm == "Darwin" && !grepl("/orch(/|$)", getwd()) ) {
    home <- TRUE
    work <- FALSE 
  }

  ## Add-in some defaults, UNLESS this is a relay
  if (!this.is.a.relay) {
    # Here, we use the "string"[logical] such that if the flag is FALSE, then 
    defaultsUsing <- c("work"[work], "home"[home], "sms"[sms])
    to <- c(to, getDefaultEmails(defaultsUsing, showWarnings=FALSE))
    to <- to[to != ""]  # Used "" to denote a blank
  }

  ## Check that at least ONE 'to' address is valid. 
  if (!length(to)) {
    warning("  There are no 'to' email addresses set, and no defaults available.\n  Check getDefaultEmails() and check the falgs that are set in the call to this function, EmailStatusUpdate()\n  Returning NULL")
    return(invisible(NULL))
  }

  ## Check for valid projName input
  if (is.logical(projName)) {
    warning("'projName' in 'SendStatusEmail()' should be a string. Use NULL or \"\" to set to blank.")
    if (isTRUE(projName))
      projName <- getProjName(pos=2)
    else 
      projName <- ""
  }


  browser(expr=identical(debug, 2))
  ## Rest of the fields    ##
  ## --------------------- ##
  if (is.null(from))
    from    <- sprintf('"%s (%s)"<%s>', email.from.name, projName, email.from)

  ## Append colon at end, for subject line
  if (!is.null(subProjName) && nchar(subProjName))
    subProjName <- paste0(subProjName, ": ")

  ## If subject is NOT given explicitly, compose it by 
  ##    a concat of 'subProj status (screen)'
  if (is.null(subject))
    subject <- paste0(subProjName, status, getScreen(prefix=" "))
                ## getScreen() grabs the screen info, if available (Linux only)
  
  ## Append an '<EOM>' to either the message or the subject
  if (eom.append) {
    if (!length(msg.details) || !nchar(msg.details)) {
      msg.details <- NULL
      subject <- paste0(subject, " <EOM>")
    } else {
      msg.details <- paste(msg.details, if(nchar(msg.details)>250) "\n", "\n<EOM>\n") # extra line break, if message is long.
    }
  }

  browser(expr=identical(debug, 3))
  ## Also send a notification to the OS 
  if (notify.osx && exists("notify") && !this.is.a.relay)
    notify(message=msg.details, title=projName, subtitle=subject)

  ## Initialize list to capture return results from sendmail()
  res <- vector(mode="list",length=length(to))
  res <- setNames(res, to)

  browser(expr=identical(debug, 4))
  ## Send an emial for each recepient in 'to'
  for (tt in to) {
    res[[tt]] <- sendmail(from = from
                        , to   = tt
                        , subject = subject
                        , msg  = msg.details
                      )
    }

  # convert the list to a data.table
  if (exists("data.table"))
     res <- cbind(to, rbindlist(lapply(res, as.data.table)))

  return(invisible(res))
}




## This is a support function.  If there is an object `projName` in the parent.frame() environment
##   or in the global environment, this will grab its value. If it cannot find such an object, it will
##   return a blank string, "".  
##   
## This is useful for working with different projects that might have similar file names or messages
##   as the porjName can be stamped onto these items.
##
## Function is part of a larger utils file, and thus do not want to overwrite, if present.
if (!exists("getProjName"))
getProjName <- function (appendImgSave=FALSE, fresh=FALSE, pos=1, subProj.instead=FALSE) {
    force(pos)
    if (is.null(subProj.instead) || is.na(subProj.instead)) 
        subProj.instead <- FALSE
    if (!is.logical(subProj.instead)) 
        stop("`subProj.instead` should be a logical value.")
    proj.string <- ifelse(isTRUE(subProj.instead), "subProj", 
        "projName")
    if (exists(proj.string, envir = parent.frame(pos))) {
        ret <- get(proj.string, envir = parent.frame(pos))
    }
    else {
        ret <- ""
    }
    if (appendImgSave && !grepl("ImageSave", ret) && !fresh) 
        ret <- paste(ret, "ImageSave", sep = ifelse(nchar(ret), 
            "_", ""))
    return(ret)
}

getScreen <- function(prefix="", suffix="") {
## The screen info is in the prompt
  x <- getOption("prompt")
  if (!length(x))
    return("")

  ret <- gsub(" R(.*)(>|\\$) $", "", x, perl=TRUE)
  paste0(prefix, gsub("\\s*(>|\\$)\\s*$", "", ret), suffix)
}



{
  try({
    suppressPackageStartupMessages ( require(utils)     ) # sendmailR requires utils, but does not sepcify as such
    suppressPackageStartupMessages ( require(sendmailR) )

    if (exists("sendmail_options")) {
      setDefaultEmails(emails=defaultEmails)
      rm(defaultEmails)
    }
  })
}