R/file_access.R

In fileaccess: File and Directory Access Validation

#' Check Whether Path is a File
#'
#' Validates whether a file exists and returns detailed file information
#' including permissions, size, type, and timestamps. Supports both
#' local and UNC network paths.
#'
#' @param path Character string. File path to validate.
#'
#' @return A list of class \code{file_access_result} containing:
#' \itemize{
#'   \item path - Normalized file path
#'   \item exists - TRUE/FALSE
#'   \item can_read - TRUE/FALSE
#'   \item can_write - TRUE/FALSE
#'   \item can_execute - TRUE/FALSE
#'   \item locked - TRUE/FALSE
#'   \item size_mb - File size formatted
#'   \item type - Detected file type description
#'   \item modified - Last modified timestamp
#'   \item status - Overall status message
#' }
#'
#' @examples
#' # Create a temp file and check it
#' tmp <- tempfile(fileext = ".csv")
#' writeLines("col1,col2\n1,2", tmp)
#' result <- file.access(tmp)
#' print(result)
#' unlink(tmp)
#'
#' # Check a file that does not exist
#' result <- file.access(
#'   file.path(tempdir(), "missing.csv")
#' )
#' print(result)
#'
#' \donttest{
#' # UNC network path (requires network access)
#' file.access("//server/share/data.csv")
#' }
#'
#' @export
file.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)
  path_norm <- if (is_unc) {
    path
  } else {
    tryCatch(
      normalizePath(path, winslash = "/", mustWork = FALSE),
      error = function(e) path
    )
  }

  result <- list(
    path        = path_norm,
    exists      = FALSE,
    can_read    = FALSE,
    can_write   = FALSE,
    can_execute = FALSE,
    locked      = NA,
    size_mb     = NA_character_,
    type        = NA_character_,
    modified    = NA_character_,
    status      = "File not found"
  )

  exists        <- file.exists(path_norm)
  result$exists <- exists

  if (!exists) {
    class(result) <- "file_access_result"
    return(result)
  }

  info <- file.info(path_norm)

  if (info$isdir) {
    result$status <- "Path is a directory, not a file"
    class(result) <- "file_access_result"
    return(result)
  }

  can_read <- tryCatch({
    con <- file(path_norm, open = "r")
    close(con)
    TRUE
  }, error = function(e) FALSE)

  can_write <- tryCatch({
    con <- file(path_norm, open = "a")
    close(con)
    TRUE
  }, error = function(e) FALSE)

  can_execute <- tryCatch({
    ext <- tolower(tools::file_ext(path_norm))
    ext %in% c("exe", "bat", "cmd", "sh", "ps1")
  }, error = function(e) FALSE)

  result$can_read    <- can_read
  result$can_write   <- can_write
  result$can_execute <- can_execute
  result$locked      <- is_file_locked(path_norm)
  result$size_mb     <- format_file_size(info$size)
  result$type        <- get_file_type(path_norm)
  result$modified    <- as.character(info$mtime)
  result$status      <- ifelse(
    can_read || can_write,
    "File accessible",
    "File not accessible"
  )

  class(result) <- "file_access_result"
  return(result)
}

#' @export
print.file_access_result <- function(x, ...) {
  cat("\n")
  cat("================================================\n")
  cat("FILE ACCESS REPORT\n")
  cat("================================================\n\n")

  if (!is.na(x$status))   cat("Status   :", x$status,   "\n\n")
  if (!is.na(x$path))     cat("Path     :", x$path,     "\n")
  if (!is.na(x$type))     cat("Type     :", x$type,     "\n")
  if (!is.na(x$size_mb))  cat("Size     :", x$size_mb,  "\n")
  if (!is.na(x$modified)) cat("Modified :", x$modified, "\n")

  cat("\nPermissions:\n")
  cat("  Read    :", if (!is.na(x$can_read))    ifelse(x$can_read,    "YES", "NO") else "NA", "\n")
  cat("  Write   :", if (!is.na(x$can_write))   ifelse(x$can_write,   "YES", "NO") else "NA", "\n")
  cat("  Execute :", if (!is.na(x$can_execute)) ifelse(x$can_execute, "YES", "NO") else "NA", "\n")

  if (!is.na(x$locked)) {
    cat("\nLocked   :", ifelse(x$locked, "YES", "NO"), "\n")
  }

  cat("\n================================================\n")
  invisible(x)
}