R/informations.R

In davidgohel/locatexec: External Program Localization

# global ----
.exec <- new.env()
.exec$node <- list(dir = NULL, version = NULL)
.exec$npm <- list(dir = NULL, version = NULL)
.exec$chrome <- list(dir = NULL, version = NULL)
.exec$libreoffice <- list(dir = NULL, version = NULL)
.exec$python <- list(dir = NULL, version = NULL)
.exec$pip <- list(dir = NULL, version = NULL)

supported_exec <- c("chrome", "libreoffice", "node", "npm", "python", "pip")

# utils ----
set_exec_info <- function(dir, version = NULL, exec) {
  if(is.null(version) && !is.null(dir)) {
    version <- extract_numeric_version(dir, file_exe = exec)
  }
  .exec[[exec]]$dir <- dir
  .exec[[exec]]$version <- version
}

exe_located <- function(exec, version){
  !is.null(.exec[[exec]]$dir) &&
    (is.null(version) ||
       version == .exec[[exec]]$version)
}

min_version_available <- function(exec, version){
  !is.null(.exec[[exec]]$dir) &&
    (is.null(version) ||
       version >= as.numeric_version(.exec[[exec]]$version))
}

#' @importFrom utils head
extract_numeric_version <- function(dir, file_exe) {
  info <- read_version(dir_exe = dir, file_exe = file_exe)
  if(any(is.na(info))) return(numeric_version("0"))
  gmatch <- gregexpr("[[:digit:]\\.]+", info)
  version <- regmatches(info, gmatch)
  version <- unlist(version)
  version <- head(version, n = 1)
  numeric_version(version)
}

valid_exec_dir <- function(dir){
  dir.exists(dir) && !grepl("Microsoft/WindowsApps", absolute_path(dir), fixed = TRUE)
}

match_version <- function(dirs, versions, match_version = NULL){

  choosen_dir <- NULL
  choosen_ver <- numeric_version("0")

  for (i in seq_along(dirs)) {
    current_version <- versions[[i]]
    if ((!is.null(match_version) && current_version == match_version) || (is.null(match_version) && current_version > choosen_ver)) {
      choosen_ver <- current_version
      choosen_dir <- dirs[[i]]
    }
  }

  list(dir = choosen_dir, ver = choosen_ver)
}

# funs ----

#' @export
#' @title Get executable version
#' @description get the version of an executable.
#' @param exec executable identifier, a single character.
#' Use one of these values:
#'
#' * `chrome`: "Google Chrome" executable
#' * `libreoffice`: "LibreOffice" executable
#' * `node`: "node.js" executable
#' * `npm`: "npm" executable
#' * `python`: "python" executable
#' * `pip`: "pip" executable
#'
#' @return a [numeric_version()] with the version of the executable found.
#' @examples
#' if(is_available("chrome"))
#'   message(exec_version("chrome"))
#' if(is_available("node"))
#'   message(exec_version("node"))
#' if(is_available("python"))
#'   message(exec_version("python"))
#' if(is_available("libreoffice"))
#'   message(exec_version("libreoffice"))
exec_version <- function(exec) {
  exec <- match.arg(exec, choices = supported_exec, several.ok = FALSE)
  locate_exec(exec)
  .exec[[exec]]$version
}


#' @title Check executable availability and version
#' @description determine whether an executable is
#' currently available on the user machine (optionally checking for
#' a specific or greater version).
#' @inheritParams exec_version
#' @param version required version of executable
#' @param error if `TRUE`, executes an error action if executable
#' with the required version is not found.
#' @return a logical indicating whether the executable is available.
#' @examples
#' if (is_available("python")) {
#'   cat("python", as.character(exec_version("python")), "is available!\\n")
#' }
#' py_path <- "~/../AppData/Local/Programs/Python/Python39"
#' if(dir.exists(py_path)){
#'   locate_exec("python", dir = py_path, cache = FALSE)
#' }
#' if(is_available("python", "3.9")) {
#'   cat("required version of python is available!\\n")
#' }
#' if (is_available("pip")) {
#'   cat("pip", as.character(exec_version("pip")), "is available!\\n")
#' }
#' if (is_available("pip", "19.3")) {
#'   cat("pip", as.character(exec_version("pip")), "is available!\\n")
#' }
#' if (is_available("chrome")) {
#'   cat("chrome", as.character(exec_version("chrome")), "is available!\\n")
#' }
#' if (is_available("node")) {
#'   cat("node.js", as.character(exec_version("node")), "is available!\\n")
#' }
#' if (is_available("npm")) {
#'   cat("npm", as.character(exec_version("npm")), "is available!\\n")
#' }
#' if (is_available("npm", version = "10.13.0")) {
#'   cat("npm", as.character(exec_version("npm")), "is available!\\n")
#' }
#' @export
is_available <- function(exec, version = NULL, error = FALSE) {
  exec <- match.arg(exec, choices = supported_exec, several.ok = FALSE)
  locate_exec(exec)
  x <- min_version_available(exec = exec, version = version)

  msg <- c(
    exec,
    if (!is.null(version)) c("version", version, "or higher"),
    "is required and was not found.")

  if (error && !x)
    stop(paste(msg, collapse = " "), call. = FALSE)

  x
}