R/write_access.R

In fileaccess: File and Directory Access Validation

#' Check Whether File or Directory is Writable
#'
#' Validates whether a file or directory can be accessed
#' for writing. Supports both local and UNC network paths.
#'
#' @param path Character string. Full path to file or directory.
#'
#' @return A list of class \code{write_access_result} containing:
#' \itemize{
#'   \item path - Normalized input path
#'   \item exists - TRUE/FALSE
#'   \item type - "File", "Directory", or "New File/Directory"
#'   \item writable - TRUE/FALSE
#'   \item status - Overall status message
#' }
#'
#' @examples
#' # Check a temporary directory
#' result <- write.access(tempdir())
#' print(result)
#'
#' # Check an existing temporary file
#' tmp <- tempfile()
#' writeLines("hello", tmp)
#' result <- write.access(tmp)
#' print(result)
#' unlink(tmp)
#'
#' # Check a new file path that does not exist yet
#' result <- write.access(file.path(tempdir(), "newfile.csv"))
#' print(result)
#'
#' \donttest{
#' # UNC network path (requires network access)
#' write.access("//server/share/output/results.csv")
#' }
#'
#' @export
write.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
    )
  }

  exists <- file.exists(path_norm)

  if (exists) {
    info <- file.info(path_norm)
    type <- ifelse(info$isdir, "Directory", "File")
    writable <- tryCatch({
      if (info$isdir) {
        test_file <- tempfile(tmpdir = path_norm)
        con <- file(test_file, open = "w")
        close(con)
        unlink(test_file)
      } else {
        con <- file(path_norm, open = "a")
        close(con)
      }
      TRUE
    }, error = function(e) FALSE)
  } else {
    parent_dir <- dirname(path_norm)
    if (!dir.exists(parent_dir)) {
      result <- list(
        path     = path_norm,
        exists   = FALSE,
        type     = "New File/Directory",
        writable = FALSE,
        status   = "Parent directory does not exist"
      )
      class(result) <- "write_access_result"
      return(result)
    }
    type <- "New File/Directory"
    writable <- tryCatch({
      test_file <- tempfile(tmpdir = parent_dir)
      con <- file(test_file, open = "w")
      close(con)
      unlink(test_file)
      TRUE
    }, error = function(e) FALSE)
  }

  result <- list(
    path     = path_norm,
    exists   = exists,
    type     = type,
    writable = writable,
    status   = ifelse(writable, "Writable", "Not writable")
  )
  class(result) <- "write_access_result"
  return(result)
}

#' @export
print.write_access_result <- function(x, ...) {
  cat("\n")
  cat("========================================\n")
  cat("WRITE ACCESS REPORT\n")
  cat("========================================\n\n")
  cat("Path     :", x$path,     "\n")
  cat("Exists   :", x$exists,   "\n")
  cat("Type     :", x$type,     "\n")
  cat("Writable :", x$writable, "\n")
  cat("Status   :", x$status,   "\n")
  cat("\n========================================\n")
  invisible(x)
}