R/execute_access.R

In fileaccess: File and Directory Access Validation

#' Check Whether File is Executable
#'
#' Validates whether a file or command can be executed.
#' Supports both local paths and executables available in system PATH.
#'
#' @param path Character string. Executable name or full path.
#'
#' @return A list of class \code{execute_access_result} containing:
#' \itemize{
#'   \item path - Resolved executable path
#'   \item exists - TRUE/FALSE
#'   \item executable - TRUE/FALSE
#'   \item in_path - TRUE/FALSE
#'   \item status - Overall status message
#' }
#'
#' @examples
#' \donttest{
#' # Check if Rscript is available (available on all R machines)
#' result <- execute.access("Rscript")
#' print(result)
#'
#' # Check a full path to an executable
#' result <- execute.access(file.path(R.home("bin"), "Rscript"))
#' print(result)
#' }
#'
#' @export
execute.access <- function(path) {
  if (!is.character(path) || length(path) != 1 || is.na(path)) {
    stop("path must be a non-empty character string")
  }

  is_unc        <- grepl("^[/\\\\]{2}", path)
  has_separator <- grepl("[/\\\\]", path)

  result <- list(
    path       = NA_character_,
    exists     = FALSE,
    executable = FALSE,
    in_path    = FALSE,
    status     = "Not executable"
  )

  if (has_separator) {
    path_norm <- if (is_unc) {
      path
    } else {
      tryCatch(
        normalizePath(path, winslash = "/", mustWork = FALSE),
        error = function(e) path
      )
    }
    result$path <- path_norm

    if (!file.exists(path_norm)) {
      class(result) <- "execute_access_result"
      return(result)
    }

    result$exists     <- TRUE
    result$executable <- tryCatch({
      system2(path_norm, args = "--version", stdout = TRUE, stderr = TRUE)
      TRUE
    }, error = function(e) FALSE)

  } else {
    which_cmd <- if (.Platform$OS.type == "windows") "where" else "which"
    resolved  <- tryCatch({
      system2(which_cmd, path, stdout = TRUE, stderr = FALSE)[1]
    }, error = function(e) NA_character_)

    if (!is.na(resolved) && nzchar(resolved)) {
      result$path       <- resolved
      result$exists     <- TRUE
      result$in_path    <- TRUE
      result$executable <- tryCatch({
        system2(path, args = "--version", stdout = TRUE, stderr = TRUE)
        TRUE
      }, error = function(e) FALSE)
    }
  }

  result$status <- ifelse(result$executable, "Executable", "Not executable")
  class(result) <- "execute_access_result"
  return(result)
}

#' @export
print.execute_access_result <- function(x, ...) {
  cat("\n")
  cat("========================================\n")
  cat("EXECUTE ACCESS REPORT\n")
  cat("========================================\n\n")
  cat("Path       :", x$path,       "\n")
  cat("Exists     :", x$exists,     "\n")
  cat("Executable :", x$executable, "\n")
  cat("In PATH    :", x$in_path,    "\n")
  cat("Status     :", x$status,     "\n")
  cat("\n========================================\n")
  invisible(x)
}