#' Execution engine loop for all the fetch commands
#' @param self The R6 connection object.
#' @param id A message id obtained inside the main loop in \code{fetch_attachments_int}.
#' @param id_folder The name of the folder containing the message id.
#' @param content_disposition A \code{string} indicating which type of
#' "Content-Disposition" attachments should be retrieved. The options are
#' \code{both}, \code{attachment}, and \code{inline}. Default is
#' \code{"both"}, which retrieves regular attachments ("Content-Disposition:
#' attachment") and inline attachments ("Content-Disposition: inline").
#' @param override A \code{logical}. If \code{TRUE}, overrides existent files
#' containing the same name in the local directory. Default is \code{FALSE}.
#' @param df_meta_to_fetch A \code{data frame} returned by
#' \code{extract_MIME_level_and_filename()} containing the filenames, the
#' MIME level in which each attachment is, and the content-disposition of the
#' file.
#' @param fetch_request A string containing the fetch request to the server that
#' will be added to the curl handle.
#' @param folder_clean A \code{character} string containing the cleaned folder
#' name, which will be uses to create a local folder.
#' @param retries Number of attempts to connect and execute the command. Default
#' is \code{1}.
#' @param as_is If \code{TRUE} then write out attachments without base64
#' decoding. Default is \code{FALSE}.
#' @noRd
execute_attachment_fetch <- function(self, id, id_folder, df_meta_to_fetch, fetch_request,
folder_clean, content_disposition,
override, retries, as_is) {
url <- self$con_params$url
# url <- con$url
# override = FALSE
h <- self$con_handle
# h <- con$con_handle
# fetching
# msg_list <- list()
# idx = 0
# finding and removing any repeated MIME.level
# this situation may happen for inline attachments. Because in this case the data
# will come with the cntent_disposition: inline plus the filename and we will call
# get_attachments, we do not need to worry about the name as it will be identified
# by get_attachments after fetching
# and this willl prevent us from doing a second fetch of the same part
df_meta_to_fetch <- df_meta_to_fetch[!duplicated(df_meta_to_fetch$MIME_level), ]
df_meta_to_fetch$adjusted_filenames <- adjust_repeated_filenames(df_meta_to_fetch$filenames)
df_meta_to_fetch$adjusted_filenames <- decode_mime_header(string = df_meta_to_fetch$adjusted_filenames)
# loop exec
last_level = 0
for (i in 1:nrow(df_meta_to_fetch)) {
# print(i)
# i = 1
# idx = idx + 1
current_level = df_meta_to_fetch$MIME_level[i]
if (current_level != last_level) {
adjusted_fetch_request <- gsub(pattern = "#", replacement = id, x = fetch_request)
adjusted_fetch_request <- gsub(pattern = "level.MIME",
replacement = df_meta_to_fetch$MIME_level[i],
x = adjusted_fetch_request)
# self$select_folder("INBOX")
tryCatch({
curl::handle_setopt(
handle = h,
customrequest = adjusted_fetch_request)
}, error = function(e){
stop("The connection handle is dead. Please, configure a new IMAP connection with configure_imap().")
})
# REQUEST
response <- tryCatch({
curl::curl_fetch_memory(url, handle = h)
}, error = function(e){
# print(e$message)
response_error_handling(e$message[1]) # returns NULL for operation timeout: try reconnection
})
# print(exists("response")); print(exists("response")); print(exists("response"))
if (!is.null(response)) {
# msg_text = rawToChar(response$headers)
attachment <- clean_fetch_results(
rawToChar(response$headers), attachment_fetch = TRUE)
} else {
count_retries = 0 #the first try was already counted
# FORCE appending fresh_connect
# curl::handle_setopt(handle = h, fresh_connect = TRUE)
select_folder_int(self, name = self$con_params$folder, mute = TRUE, retries = 0) # ok! v0.0.9
# select folder will automatically adjust the folde rname inside
while (is.null(response) && count_retries < retries) {
count_retries = count_retries + 1
# reset customrequest in handle
tryCatch({
curl::handle_setopt(
handle = h,
customrequest = adjusted_fetch_request) #bug: response was NULL when recovering from a fetch timeout error
}, error = function(e){
stop("The connection handle is dead. Please, configure a new IMAP connection with configure_imap().")
})
# REQUEST
response <- tryCatch({
curl::curl_fetch_memory(url, handle = h)
}, error = function(e){
# print(e$message)
response_error_handling(e$message[1]) # returns NULL for operation timeout: try reconnection
})
if (!is.null(response)) {
attachment <- clean_fetch_results(
rawToChar(response$headers), attachment_fetch = TRUE)
} else {
stop('Fetch error: the server returned an error. Try to increase "timeout_ms".')
}
} #while
} #else-response
}
last_level = current_level # v0.9.1 # skips leveling up the fetching when there are more than one attachment in a unique level
# saving the file:
# preparing the directory for saving
# here we test if it is the case of:
# 1) the fetch has an inline attachment with the text part, and;
# 2) the fetch has more than one attachment
# OBS: has_attachment() is used as a tweak because it is able to recognize if the attachment is not "pure",
# like it had came with a boundary with some metadata of that part
if (has_attachment(attachment, call_from = "fetch_attachments")) {
msg_list <- list(attachment)
rm(attachment)
names(msg_list) <- id_folder
self$get_attachments(msg_list = msg_list,
content_disposition = content_disposition,
override = override, mute = TRUE)
# we still have to inform content_disposition in case there is two different types of attachments in the same part
#.. and one is an unwanted type
} else {
forbiden_chars <- "[\\/:*?\"<>|]"
# url <- "imaps://outlook.office365.com/"
# url_folder <- regmatches(url, gregexpr("://(.*?)(/|.)$", url))
user_folder <- self$con_params$username
user_folder = gsub(forbiden_chars, "", user_folder)
complete_path <- paste0("./", user_folder, "/", folder_clean, "/", id_folder)
# complete_path <- paste0("./", folder_clean, "/", id)
dir.create(path = complete_path, showWarnings = FALSE, recursive = TRUE)
if (isTRUE(override)) {
complete_path_with_filename <- paste0(complete_path, "/",
df_meta_to_fetch$adjusted_filenames[i])
} else {
# complete_path_with_filename <- serialize_filename(
# sufix = paste0(complete_path, "/", df_meta_to_fetch$adjusted_filenames[i]))
complete_path_with_filename <- serialize_filename(
sufix = df_meta_to_fetch$adjusted_filenames[i], complete_path = complete_path)
}
# looping on attachments
# for (i in seq_along(df_meta_to_fetch$filename)) {
# # base64 encoding
# if (encodings[i] == "base64") {
if (as_is) {
## write out the file directly to the final file name
writeBin(attachment, complete_path_with_filename)
} else {
# saving attachments
# thank's to:
# https://stackoverflow.com/questions/36708191/convert-base64-to-png-jpeg-file-in-r
# writing binary file
temp_bin_name <- paste0(sample(letters, 4), sample(0:9, 4), collapse="")
conn <- file(paste0(complete_path, "/", temp_bin_name, ".bin"),"wb")
writeBin(attachment, conn)
close(conn)
# decoding from BIN to the appropriate file extension
inconn <- file(paste0(complete_path, "/", temp_bin_name, ".bin"),"rb")
outconn <- file(complete_path_with_filename,"wb")
# base64 text decoding
tryCatch({
base64enc::base64decode(what=inconn, output=outconn)
}, error = function(e) {
warning(paste0("Base64 text decoding failed for", df_meta_to_fetch$filenames[i]))
})
close(inconn)
close(outconn)
unlink(paste0(complete_path, "/", temp_bin_name, ".bin")) # deleting binary file
# From unlink() help: Not deleting a non-existent file is not a failure
# we don't need a tryCatch()
# }
}
}
} #for
return(TRUE)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.