R/device.R

In details: Create Details HTML Tag for Markdown and Package Documentation

#' @importFrom withr with_png
#' @importFrom utils capture.output
device_check <- function(object,f_png = tempfile(fileext = ".png"), env){
  
  utils::capture.output(withr::with_png(f_png,print(object)))
  
  env$device <- is_not_blank_png(f_png)

  if(env$device){
    
    env$f_png <- f_png
    object    <- f_png
    
  }
  
  object
  
}

# augmented function from https://github.com/yihui/knitr/blob/a6cc50b09314ee0243b5d3223090fe4ecc9a13cd/R/utils-upload.R
# @importFrom httr POST add_headers upload_file stop_for_status content
# @importFrom xml2 as_list read_xml
# @importFrom utils packageVersion
# imgur_upload <- function (file, key = "9f3460e67f308f6",only_link = TRUE){
  
#   check_internet('imgur.com')
  
#   if (!is.character(key)) 
#     stop("The Imgur API Key must be a character string!")
  
#   resp <- httr::POST(
#     "https://api.imgur.com/3/image.xml", 
#     config = httr::add_headers(Authorization = paste("Client-ID", key)),
#     body = list(image = httr::upload_file(file))
#   )
  
#   httr::stop_for_status(resp, "upload to imgur")
  
#   res <- httr::content(resp, as = "raw")
  
#   res <- if (length(res)) 
#     xml2::as_list(xml2::read_xml(res))
  
#   if (utils::packageVersion("xml2") >= "1.2.0") 
#     res <- res[[1L]]
  
#   if (is.null(res$link[[1]])) 
#     stop("failed to upload ", file)
  
#   if(only_link){
    
#     res$link[[1]]
    
#   }else{
    
#     structure(res$link[[1]], XML = res)  
    
#   }
  
# }

is_not_na_png <- function(file){
  !is.na(file.size(file))
}

#' @importFrom png readPNG
is_not_blank_png <- function(file){
  
  ret <- is_not_na_png(file)
  
  if(ret){
    ret <- length(unique(unlist(as.list(png::readPNG(file)))))>1  
  }
  
  ret
  
}

#' @importFrom httr HEAD timeout
check_internet <- function(url = 'google.com'){
  if(inherits(try({
      httr::HEAD(url,httr::timeout(1))
    },silent = TRUE),'try-error'))
    stop('An internet connection was not found')
}