Nothing
R/AppenderDigest.R
In lgrExtra: Extra Appenders for 'lgr'
# AppenderDigest --------------------------------------------------------
#' Abstract class for digests (multi-log message notifications)
#'
#' @description
#' Digests is an abstract class for report-like output that contain several
#' log messages and a title; e.g. an E-mail containing the last 10 log messages
#' before an error was encountered or a push notification.
#'
#' @template abstract_class
#'
#' @export
#' @seealso [LayoutFormat], [LayoutGlue]
#' @family Digest Appenders
AppenderDigest <- R6::R6Class(
"AppenderDigest",
inherit = lgr::AppenderMemory,
cloneable = FALSE,
# +- public --------------------------------------------------------------
public = list(
initialize = function(...){
stop(CannotInitializeAbstractClassError())
},
set_subject_layout = function(layout){
assert(inherits(layout, "Layout"))
private$.subject_layout <- layout
invisible(self)
}
),
active = list(
#' @field subject_layout A [Layout] used to format the last [LogEvent]
#' in this Appenders buffer when it is flushed. The result will be used as
#' the subject of the digest (for example, the E-mail subject).
subject_layout = function() get(".subject_layout", private)
),
private = list(
.subject_layout = NULL
)
)
# AppenderPushbullet --------------------------------------------------------
#' Send push-notifications via RPushbullet
#'
#' @description
#' Send push notifications via [Pushbullet](https://www.pushbullet.com/). This
#' Appender keeps an in-memory buffer like [AppenderBuffer]. If the buffer is
#' flushed, usually because an event of specified magnitude is encountered, all
#' buffered events are concatenated to a single message that is sent to
#' [RPushbullet::pbPost()]. The default behavior is to push the last 7 log
#' events in case a `fatal` event is encountered.
#'
#' @template appender
#' @family Digest Appenders
#' @seealso [LayoutFormat], [LayoutGlue]
#' @export
#' @examples
#' if (requireNamespace("RPushbullet") && !is.null(getOption("rpushbullet.key")) ){
#' app <- AppenderPushbullet$new()
#'
#' lg <- lgr::get_logger("test/dbi")$
#' add_appender(app, "pb")$
#' set_propagate(FALSE)
#'
#' lg$fatal("info")
#' lg$fatal("test")
#'
#' invisible(lg$config(NULL))
#' }
AppenderPushbullet <- R6::R6Class(
"AppenderPushbullet",
inherit = AppenderDigest,
cloneable = FALSE,
# +- public --------------------------------------------------------------
public = list(
#' @param recipients,email,channel,devices,apikey see [RPushbullet::pbPost]
#' @param threshold,flush_threshold,layout,buffer_size see [AppenderBuffer]
#' @param subject_layout A [lgr::LayoutFormat] object.
initialize = function(
threshold = NA_integer_,
flush_threshold = "fatal",
layout = LayoutFormat$new(fmt = "%K %t> %m %f", timestamp_fmt = "%H:%M:%S"),
subject_layout = LayoutFormat$new(fmt = "[LGR] %L: %m"),
buffer_size = 6,
recipients = NULL,
email = NULL,
channel = NULL,
devices = NULL,
apikey = getOption("rpushbullet.key"),
filters = NULL
){
assert_namespace("RPushbullet")
private$initialize_buffer(buffer_size)
self$set_flush_on_rotate(FALSE)
self$set_flush_on_exit(FALSE)
self$set_filters(filters)
self$set_layout(layout)
self$set_threshold(threshold)
self$set_flush_threshold(flush_threshold)
self$set_apikey(apikey)
self$set_buffer_size(buffer_size)
self$set_subject_layout(subject_layout)
self$set_should_flush(NULL)
self$set_recipients(recipients)
self$set_email(email)
self$set_channel(channel)
self$set_devices(devices)
},
flush = function(
){
assign("insert_pos", 0L, envir = private)
body <- paste(
unlist(lapply(self$buffer_events, self$layout$format_event)),
collapse = "\n"
)
le <- self$buffer_events[[length(self$buffer_events)]]
title <- self$subject_layout$format_event(le)
cl <- list(
type = "note",
title = title,
body = body
)
if (!is.null(self$apikey)){
cl$apikey <- self$apikey
cl$recipients <- self$recipients
cl$email <- self$email
cl$channel <- self$channel
cl$devices <- self$devices
}
do.call(RPushbullet::pbPost, compact(cl))
private$.buffer_events <- list()
invisible(self)
},
set_apikey = function(x){
assert(is.null(x) || is_scalar_character(x))
private$.apikey <- x
invisible(self)
},
set_recipients = function(x){
private$.recipients <- x
invisible(self)
},
set_email = function(x){
private$.email <- x
invisible(self)
},
set_channel = function(x){
private$.channel <- x
invisible(self)
},
set_devices = function(x){
private$.devices <- x
invisible(self)
}
),
# +- active ---------------------------------------------------------------
active = list(
#' @field apikey see [RPushbullet::pbPost()]
apikey = function() private$.apikey,
#' @field recipients see [RPushbullet::pbPost()]
recipients = function() get(".recipients", private),
#' @field email see [RPushbullet::pbPost()]
email = function() get(".email", private),
#' @field channel see [RPushbullet::pbPost()]
channel = function() get(".channel", private),
#' @field devices see [RPushbullet::pbPost()]
devices = function() get(".devices", private),
destination = function(){
if (!is.null(self$recipients))
return(self$recipients)
else if (!is.null(self$email)){
return(self$email)
} else if (!is.null(self$channel)){
self$channel
}
}
),
private = list(
.apikey = NULL,
.recipients = NULL,
.email = NULL,
.channel = NULL,
.devices = NULL
)
)
# AppenderMail ------------------------------------------------------------
#' Abstract class for email Appenders
#'
#' @template abstract_class
#'
#' @family Digest Appenders
AppenderMail <- R6::R6Class(
"AppenderMail",
inherit = AppenderDigest,
cloneable = FALSE,
# +- public --------------------------------------------------------------
public = list(
initialize = function(...){
stop(CannotInitializeAbstractClassError())
},
set_to = function(x){
private$.to <- x
invisible(self)
},
set_from = function(x){
private$.from <- x
invisible(self)
},
set_cc = function(x){
private$.cc <- x
invisible(self)
},
set_bcc = function(x){
private$.bcc <- x
invisible(self)
},
set_html = function(x){
assert(is_scalar_bool(x))
private$.html <- x
invisible(self)
},
format = function(
color = FALSE,
...
){
res <- super$format(color = color, ...)
if (!color)
style_error <- identity
if (class(self)[[1]] == "AppenderMail"){
paste(res[[1]], style_error("[abstract class]"))
} else {
res
}
}
),
# +- active ---------------------------------------------------------------
active = list(
#' @field to `character` vector. The email addresses of the recipient
to = function() get(".to", envir = private),
#' @field from `character` vector. The email address of the sender
from = function() get(".from", envir = private),
#' @field cc `character` vector. The email addresses of the cc-recipients (carbon copy)
cc = function() get(".cc", envir = private),
#' @field bcc `character` vector. The email addresses of bcc-recipients (blind carbon copy)
bcc = function() get(".bcc", envir = private),
#' @field html `logical` scalar. Send a html email message?
#' This does currently only format the log contents as monospace verbatim
#' text.
html = function() get(".html", envir = private),
destination = function() self$to
),
private = list(
.to = NULL,
.from = NULL,
.cc = NULL,
.bcc = NULL,
.html = NULL
)
)
# AppenderSendmail --------------------------------------------------------
#' Send emails via sendmailR
#'
#' @description
#' Send mails via [sendmailR::sendmail()], which requires that you have access
#' to an SMTP server that does not require authentication. This
#' Appender keeps an in-memory buffer like [AppenderBuffer]. If the buffer is
#' flushed, usually because an event of specified magnitude is encountered, all
#' buffered events are concatenated to a single message. The default behavior
#' is to push the last 30 log events in case a `fatal` event is encountered.
#'
#' @note The default Layout's `fmt` indents each log entry with 3 blanks. This
#' is a workaround so that Microsoft Outlook does not mess up the line breaks.
#'
#' @examples
#' \dontrun{
#' lgr::AppenderSendmail$new(
#' to = "user@ecorp.com",
#' control = list(smtpServer = "mail.ecorp.com"),
#' from = "lgr_user@yourmail.com"
#' )
#' }
#'
#' @template appender
#' @seealso [LayoutFormat], [LayoutGlue]
#' @family Digest Appenders
#' @export
#' @examples
#' if (requireNamespace("sendmailR")){
#' # requires that you have access to an SMTP server
#'
#' lg <- lgr::get_logger("lgrExtra/test/mail")$
#' set_propagate(FALSE)$
#' add_appender(AppenderSendmail$new(
#' from = "ceo@ecorp.com",
#' to = "some.guy@ecorp.com",
#' control = list(smtpServer = "mail.somesmptserver.com")
#' ))
#' # cleanup
#' invisible(lg$config(NULL))
#' }
AppenderSendmail <- R6::R6Class(
"AppenderSendmail",
inherit = AppenderMail,
cloneable = FALSE,
# +- public --------------------------------------------------------------
public = list(
#' @description
#' see [AppenderMail] for details
initialize = function(
to,
control,
threshold = NA_integer_,
flush_threshold = "fatal",
layout = LayoutFormat$new(fmt = " %L [%t] %m %f", timestamp_fmt = "%H:%M:%S"),
subject_layout = LayoutFormat$new(fmt = "[LGR] %L: %m"),
buffer_size = 29,
from = get_user(),
cc = NULL,
bcc = NULL,
html = FALSE,
headers = NULL,
filters = NULL
){
assert_namespace("sendmailR")
assert(is_scalar_bool(html))
private$initialize_buffer(buffer_size)
self$set_flush_on_rotate(FALSE)
self$set_flush_on_exit(FALSE)
self$set_filters(filters)
self$set_to(to)
self$set_control(control)
self$set_from(from)
self$set_cc(cc)
self$set_bcc(bcc)
self$set_headers(headers)
self$set_subject_layout(subject_layout)
self$set_html(html)
self$set_layout(layout)
self$set_threshold(threshold)
self$set_should_flush(NULL)
self$set_flush_threshold(flush_threshold)
},
flush = function(
){
assign("insert_pos", 0L, envir = private)
# body
body <- paste(
unlist(lapply(self$buffer_events, self$layout$format_event)),
collapse = "\r\n"
)
if (self$html) {
body <- paste0("<pre>\n", body, "</pre>\n")
body <- sendmailR::mime_part(body)
body[["headers"]][["Content-Type"]] <- "text/html; charset=UTF-8;"
} else {
body <- sendmailR::mime_part(body)
body[["headers"]][["Content-Type"]] <- "text/plain; charset=UTF-8;"
}
# title
le <- self$buffer_events[[length(self$buffer_events)]]
title <- self$subject_layout$format_event(le)
title <- try(
iconv(title, from = "UTF-8", to = "ASCII//TRANSLIT"),
silent = TRUE
)
args <- list(
from = self$from,
to = self$to,
subject = title,
msg = body,
cc = self$cc,
bcc = self$bcc,
headers = self$headers,
control = self$control
)
# sendmailR expects missing() instead of NULL for default values
args <- compact(args)
do.call(sendmailR::sendmail, args)
private$.buffer_events <- list()
invisible(self)
},
set_control = function(x){
private$.control <- x
},
set_headers = function(x){
private$.headers <- x
}
),
# +- active ---------------------------------------------------------------
active = list(
#' @field control see [sendmailR::sendmail()]
control = function() get(".control", envir = private),
#' @field headers see [sendmailR::sendmail()]
headers = function() get(".headers", envir = private)
),
private = list(
.control = NULL,
.headers = NULL
)
)
# AppenderGmail --------------------------------------------------------
#' Send emails via the Gmail REST API
#'
#' @description
#' Send mails via [gmailr::gm_send_message()]. This
#' Appender keeps an in-memory buffer like [AppenderBuffer]. If the buffer is
#' flushed, usually because an event of specified magnitude is encountered, all
#' buffered events are concatenated to a single message. The default behavior
#' is to push the last 30 log events in case a `fatal` event is encountered.
#'
#' **NOTE:** This Appender requires that you set up google API authorization,
#' please refer to the [documentation of gmailr](https://github.com/r-lib/gmailr)
#' for details.
#'
#' @template appender
#' @seealso [LayoutFormat], [LayoutGlue]
#' @export
AppenderGmail <- R6::R6Class(
"AppenderGmail",
inherit = AppenderMail,
cloneable = FALSE,
# +- public --------------------------------------------------------------
public = list(
#' @description see [AppenderMail] for details
initialize = function(
to,
threshold = NA_integer_,
flush_threshold = "fatal",
layout = LayoutFormat$new(fmt = "%L [%t] %m %f", timestamp_fmt = "%H:%M:%S"),
subject_layout = LayoutFormat$new(fmt = "[LGR] %L: %m"),
buffer_size = 30,
from = get_user(),
cc = NULL,
bcc = NULL,
html = FALSE,
filters = NULL
){
assert_namespace("gmailr")
private$initialize_buffer(buffer_size)
self$set_flush_on_rotate(FALSE)
self$set_flush_on_exit(FALSE)
self$set_filters(filters)
self$set_to(to)
self$set_from(from)
self$set_cc(cc)
self$set_bcc(bcc)
self$set_html(html)
self$set_subject_layout(subject_layout)
self$set_layout(layout)
self$set_threshold(threshold)
self$set_flush_threshold(flush_threshold)
self$set_buffer_size(buffer_size)
self$set_should_flush(NULL)
private$.flush_on_exit <- FALSE
private$.flush_on_rotate <- FALSE
},
flush = function(
){
assign("insert_pos", 0L, envir = private)
body <- paste(
unlist(lapply(self$buffer_events, self$layout$format_event)),
collapse = "\n"
)
le <- self$buffer_events[[length(self$buffer_events)]]
title <- self$subject_layout$format_event(le)
title <- try(
iconv(title, from = "UTF-8", to = "ASCII//TRANSLIT"),
silent = TRUE
)
mail <- gmailr::gm_mime()
mail <- gmailr::gm_to(mail, self$to)
mail <- gmailr::gm_from(mail, self$from)
mail <- gmailr::gm_cc(mail, self$cc)
mail <- gmailr::gm_bcc(mail, self$bcc)
mail <- gmailr::gm_subject(mail, title)
if (self$html){
mail <- gmailr::gm_html_body(mail, paste0("<pre>\n", body, "</pre>\n"))
} else {
mail <- gmailr::gm_text_body(mail, body)
}
gmailr::gm_send_message(mail)
private$.buffer_events <- list()
invisible(self)
}
),
# +- active ---------------------------------------------------------------
private = list(
.to = NULL,
.from = NULL,
.cc = NULL,
.bcc = NULL,
.html = NULL
)
)
Try the lgrExtra package in your browser
Any scripts or data that you put into this service are public.
lgrExtra documentation built on Jan. 6, 2023, 5:15 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
# AppenderDigest --------------------------------------------------------
#' Abstract class for digests (multi-log message notifications)
#'
#' @description
#' Digests is an abstract class for report-like output that contain several
#' log messages and a title; e.g. an E-mail containing the last 10 log messages
#' before an error was encountered or a push notification.
#'
#' @template abstract_class
#'
#' @export
#' @seealso [LayoutFormat], [LayoutGlue]
#' @family Digest Appenders
AppenderDigest <- R6::R6Class(
"AppenderDigest",
inherit = lgr::AppenderMemory,
cloneable = FALSE,
# +- public --------------------------------------------------------------
public = list(
initialize = function(...){
stop(CannotInitializeAbstractClassError())
},
set_subject_layout = function(layout){
assert(inherits(layout, "Layout"))
private$.subject_layout <- layout
invisible(self)
}
),
active = list(
#' @field subject_layout A [Layout] used to format the last [LogEvent]
#' in this Appenders buffer when it is flushed. The result will be used as
#' the subject of the digest (for example, the E-mail subject).
subject_layout = function() get(".subject_layout", private)
),
private = list(
.subject_layout = NULL
)
)
# AppenderPushbullet --------------------------------------------------------
#' Send push-notifications via RPushbullet
#'
#' @description
#' Send push notifications via [Pushbullet](https://www.pushbullet.com/). This
#' Appender keeps an in-memory buffer like [AppenderBuffer]. If the buffer is
#' flushed, usually because an event of specified magnitude is encountered, all
#' buffered events are concatenated to a single message that is sent to
#' [RPushbullet::pbPost()]. The default behavior is to push the last 7 log
#' events in case a `fatal` event is encountered.
#'
#' @template appender
#' @family Digest Appenders
#' @seealso [LayoutFormat], [LayoutGlue]
#' @export
#' @examples
#' if (requireNamespace("RPushbullet") && !is.null(getOption("rpushbullet.key")) ){
#' app <- AppenderPushbullet$new()
#'
#' lg <- lgr::get_logger("test/dbi")$
#' add_appender(app, "pb")$
#' set_propagate(FALSE)
#'
#' lg$fatal("info")
#' lg$fatal("test")
#'
#' invisible(lg$config(NULL))
#' }
AppenderPushbullet <- R6::R6Class(
"AppenderPushbullet",
inherit = AppenderDigest,
cloneable = FALSE,
# +- public --------------------------------------------------------------
public = list(
#' @param recipients,email,channel,devices,apikey see [RPushbullet::pbPost]
#' @param threshold,flush_threshold,layout,buffer_size see [AppenderBuffer]
#' @param subject_layout A [lgr::LayoutFormat] object.
initialize = function(
threshold = NA_integer_,
flush_threshold = "fatal",
layout = LayoutFormat$new(fmt = "%K %t> %m %f", timestamp_fmt = "%H:%M:%S"),
subject_layout = LayoutFormat$new(fmt = "[LGR] %L: %m"),
buffer_size = 6,
recipients = NULL,
email = NULL,
channel = NULL,
devices = NULL,
apikey = getOption("rpushbullet.key"),
filters = NULL
){
assert_namespace("RPushbullet")
private$initialize_buffer(buffer_size)
self$set_flush_on_rotate(FALSE)
self$set_flush_on_exit(FALSE)
self$set_filters(filters)
self$set_layout(layout)
self$set_threshold(threshold)
self$set_flush_threshold(flush_threshold)
self$set_apikey(apikey)
self$set_buffer_size(buffer_size)
self$set_subject_layout(subject_layout)
self$set_should_flush(NULL)
self$set_recipients(recipients)
self$set_email(email)
self$set_channel(channel)
self$set_devices(devices)
},
flush = function(
){
assign("insert_pos", 0L, envir = private)
body <- paste(
unlist(lapply(self$buffer_events, self$layout$format_event)),
collapse = "\n"
)
le <- self$buffer_events[[length(self$buffer_events)]]
title <- self$subject_layout$format_event(le)
cl <- list(
type = "note",
title = title,
body = body
)
if (!is.null(self$apikey)){
cl$apikey <- self$apikey
cl$recipients <- self$recipients
cl$email <- self$email
cl$channel <- self$channel
cl$devices <- self$devices
}
do.call(RPushbullet::pbPost, compact(cl))
private$.buffer_events <- list()
invisible(self)
},
set_apikey = function(x){
assert(is.null(x) || is_scalar_character(x))
private$.apikey <- x
invisible(self)
},
set_recipients = function(x){
private$.recipients <- x
invisible(self)
},
set_email = function(x){
private$.email <- x
invisible(self)
},
set_channel = function(x){
private$.channel <- x
invisible(self)
},
set_devices = function(x){
private$.devices <- x
invisible(self)
}
),
# +- active ---------------------------------------------------------------
active = list(
#' @field apikey see [RPushbullet::pbPost()]
apikey = function() private$.apikey,
#' @field recipients see [RPushbullet::pbPost()]
recipients = function() get(".recipients", private),
#' @field email see [RPushbullet::pbPost()]
email = function() get(".email", private),
#' @field channel see [RPushbullet::pbPost()]
channel = function() get(".channel", private),
#' @field devices see [RPushbullet::pbPost()]
devices = function() get(".devices", private),
destination = function(){
if (!is.null(self$recipients))
return(self$recipients)
else if (!is.null(self$email)){
return(self$email)
} else if (!is.null(self$channel)){
self$channel
}
}
),
private = list(
.apikey = NULL,
.recipients = NULL,
.email = NULL,
.channel = NULL,
.devices = NULL
)
)
# AppenderMail ------------------------------------------------------------
#' Abstract class for email Appenders
#'
#' @template abstract_class
#'
#' @family Digest Appenders
AppenderMail <- R6::R6Class(
"AppenderMail",
inherit = AppenderDigest,
cloneable = FALSE,
# +- public --------------------------------------------------------------
public = list(
initialize = function(...){
stop(CannotInitializeAbstractClassError())
},
set_to = function(x){
private$.to <- x
invisible(self)
},
set_from = function(x){
private$.from <- x
invisible(self)
},
set_cc = function(x){
private$.cc <- x
invisible(self)
},
set_bcc = function(x){
private$.bcc <- x
invisible(self)
},
set_html = function(x){
assert(is_scalar_bool(x))
private$.html <- x
invisible(self)
},
format = function(
color = FALSE,
...
){
res <- super$format(color = color, ...)
if (!color)
style_error <- identity
if (class(self)[[1]] == "AppenderMail"){
paste(res[[1]], style_error("[abstract class]"))
} else {
res
}
}
),
# +- active ---------------------------------------------------------------
active = list(
#' @field to `character` vector. The email addresses of the recipient
to = function() get(".to", envir = private),
#' @field from `character` vector. The email address of the sender
from = function() get(".from", envir = private),
#' @field cc `character` vector. The email addresses of the cc-recipients (carbon copy)
cc = function() get(".cc", envir = private),
#' @field bcc `character` vector. The email addresses of bcc-recipients (blind carbon copy)
bcc = function() get(".bcc", envir = private),
#' @field html `logical` scalar. Send a html email message?
#' This does currently only format the log contents as monospace verbatim
#' text.
html = function() get(".html", envir = private),
destination = function() self$to
),
private = list(
.to = NULL,
.from = NULL,
.cc = NULL,
.bcc = NULL,
.html = NULL
)
)
# AppenderSendmail --------------------------------------------------------
#' Send emails via sendmailR
#'
#' @description
#' Send mails via [sendmailR::sendmail()], which requires that you have access
#' to an SMTP server that does not require authentication. This
#' Appender keeps an in-memory buffer like [AppenderBuffer]. If the buffer is
#' flushed, usually because an event of specified magnitude is encountered, all
#' buffered events are concatenated to a single message. The default behavior
#' is to push the last 30 log events in case a `fatal` event is encountered.
#'
#' @note The default Layout's `fmt` indents each log entry with 3 blanks. This
#' is a workaround so that Microsoft Outlook does not mess up the line breaks.
#'
#' @examples
#' \dontrun{
#' lgr::AppenderSendmail$new(
#' to = "user@ecorp.com",
#' control = list(smtpServer = "mail.ecorp.com"),
#' from = "lgr_user@yourmail.com"
#' )
#' }
#'
#' @template appender
#' @seealso [LayoutFormat], [LayoutGlue]
#' @family Digest Appenders
#' @export
#' @examples
#' if (requireNamespace("sendmailR")){
#' # requires that you have access to an SMTP server
#'
#' lg <- lgr::get_logger("lgrExtra/test/mail")$
#' set_propagate(FALSE)$
#' add_appender(AppenderSendmail$new(
#' from = "ceo@ecorp.com",
#' to = "some.guy@ecorp.com",
#' control = list(smtpServer = "mail.somesmptserver.com")
#' ))
#' # cleanup
#' invisible(lg$config(NULL))
#' }
AppenderSendmail <- R6::R6Class(
"AppenderSendmail",
inherit = AppenderMail,
cloneable = FALSE,
# +- public --------------------------------------------------------------
public = list(
#' @description
#' see [AppenderMail] for details
initialize = function(
to,
control,
threshold = NA_integer_,
flush_threshold = "fatal",
layout = LayoutFormat$new(fmt = " %L [%t] %m %f", timestamp_fmt = "%H:%M:%S"),
subject_layout = LayoutFormat$new(fmt = "[LGR] %L: %m"),
buffer_size = 29,
from = get_user(),
cc = NULL,
bcc = NULL,
html = FALSE,
headers = NULL,
filters = NULL
){
assert_namespace("sendmailR")
assert(is_scalar_bool(html))
private$initialize_buffer(buffer_size)
self$set_flush_on_rotate(FALSE)
self$set_flush_on_exit(FALSE)
self$set_filters(filters)
self$set_to(to)
self$set_control(control)
self$set_from(from)
self$set_cc(cc)
self$set_bcc(bcc)
self$set_headers(headers)
self$set_subject_layout(subject_layout)
self$set_html(html)
self$set_layout(layout)
self$set_threshold(threshold)
self$set_should_flush(NULL)
self$set_flush_threshold(flush_threshold)
},
flush = function(
){
assign("insert_pos", 0L, envir = private)
# body
body <- paste(
unlist(lapply(self$buffer_events, self$layout$format_event)),
collapse = "\r\n"
)
if (self$html) {
body <- paste0("<pre>\n", body, "</pre>\n")
body <- sendmailR::mime_part(body)
body[["headers"]][["Content-Type"]] <- "text/html; charset=UTF-8;"
} else {
body <- sendmailR::mime_part(body)
body[["headers"]][["Content-Type"]] <- "text/plain; charset=UTF-8;"
}
# title
le <- self$buffer_events[[length(self$buffer_events)]]
title <- self$subject_layout$format_event(le)
title <- try(
iconv(title, from = "UTF-8", to = "ASCII//TRANSLIT"),
silent = TRUE
)
args <- list(
from = self$from,
to = self$to,
subject = title,
msg = body,
cc = self$cc,
bcc = self$bcc,
headers = self$headers,
control = self$control
)
# sendmailR expects missing() instead of NULL for default values
args <- compact(args)
do.call(sendmailR::sendmail, args)
private$.buffer_events <- list()
invisible(self)
},
set_control = function(x){
private$.control <- x
},
set_headers = function(x){
private$.headers <- x
}
),
# +- active ---------------------------------------------------------------
active = list(
#' @field control see [sendmailR::sendmail()]
control = function() get(".control", envir = private),
#' @field headers see [sendmailR::sendmail()]
headers = function() get(".headers", envir = private)
),
private = list(
.control = NULL,
.headers = NULL
)
)
# AppenderGmail --------------------------------------------------------
#' Send emails via the Gmail REST API
#'
#' @description
#' Send mails via [gmailr::gm_send_message()]. This
#' Appender keeps an in-memory buffer like [AppenderBuffer]. If the buffer is
#' flushed, usually because an event of specified magnitude is encountered, all
#' buffered events are concatenated to a single message. The default behavior
#' is to push the last 30 log events in case a `fatal` event is encountered.
#'
#' **NOTE:** This Appender requires that you set up google API authorization,
#' please refer to the [documentation of gmailr](https://github.com/r-lib/gmailr)
#' for details.
#'
#' @template appender
#' @seealso [LayoutFormat], [LayoutGlue]
#' @export
AppenderGmail <- R6::R6Class(
"AppenderGmail",
inherit = AppenderMail,
cloneable = FALSE,
# +- public --------------------------------------------------------------
public = list(
#' @description see [AppenderMail] for details
initialize = function(
to,
threshold = NA_integer_,
flush_threshold = "fatal",
layout = LayoutFormat$new(fmt = "%L [%t] %m %f", timestamp_fmt = "%H:%M:%S"),
subject_layout = LayoutFormat$new(fmt = "[LGR] %L: %m"),
buffer_size = 30,
from = get_user(),
cc = NULL,
bcc = NULL,
html = FALSE,
filters = NULL
){
assert_namespace("gmailr")
private$initialize_buffer(buffer_size)
self$set_flush_on_rotate(FALSE)
self$set_flush_on_exit(FALSE)
self$set_filters(filters)
self$set_to(to)
self$set_from(from)
self$set_cc(cc)
self$set_bcc(bcc)
self$set_html(html)
self$set_subject_layout(subject_layout)
self$set_layout(layout)
self$set_threshold(threshold)
self$set_flush_threshold(flush_threshold)
self$set_buffer_size(buffer_size)
self$set_should_flush(NULL)
private$.flush_on_exit <- FALSE
private$.flush_on_rotate <- FALSE
},
flush = function(
){
assign("insert_pos", 0L, envir = private)
body <- paste(
unlist(lapply(self$buffer_events, self$layout$format_event)),
collapse = "\n"
)
le <- self$buffer_events[[length(self$buffer_events)]]
title <- self$subject_layout$format_event(le)
title <- try(
iconv(title, from = "UTF-8", to = "ASCII//TRANSLIT"),
silent = TRUE
)
mail <- gmailr::gm_mime()
mail <- gmailr::gm_to(mail, self$to)
mail <- gmailr::gm_from(mail, self$from)
mail <- gmailr::gm_cc(mail, self$cc)
mail <- gmailr::gm_bcc(mail, self$bcc)
mail <- gmailr::gm_subject(mail, title)
if (self$html){
mail <- gmailr::gm_html_body(mail, paste0("<pre>\n", body, "</pre>\n"))
} else {
mail <- gmailr::gm_text_body(mail, body)
}
gmailr::gm_send_message(mail)
private$.buffer_events <- list()
invisible(self)
}
),
# +- active ---------------------------------------------------------------
private = list(
.to = NULL,
.from = NULL,
.cc = NULL,
.bcc = NULL,
.html = NULL
)
)
Try the lgrExtra package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.