R/network_access.R

In fileaccess: File and Directory Access Validation

#' Check Whether Path is a Network Path
#'
#' Validates whether a path is a network (UNC) path and
#' whether it is accessible.
#'
#' @param path Character string. Network path to validate.
#'
#' @return A list of class \code{network_access_result} containing:
#' \itemize{
#'   \item path - Input path
#'   \item network_path - TRUE/FALSE
#'   \item server - Server name extracted from UNC path
#'   \item share - Share name extracted from UNC path
#'   \item accessible - TRUE/FALSE
#'   \item status - Overall status message
#' }
#'
#' @examples
#' # A local path is not a network path
#' result <- network.access(tempdir())
#' print(result)
#'
#' # Parse a UNC path structure (no network needed — just parsing)
#' result <- network.access("//myserver/myshare/data")
#' print(result)
#'
#' \donttest{
#' # Real UNC network path (requires actual network access)
#' network.access("//server/share/data")
#' }
#'
#' @export
network.access <- function(path) {
  if (!is.character(path) || length(path) != 1 || is.na(path)) {
    stop("path must be a non-empty character string")
  }

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

  result <- list(
    path         = path,
    network_path = is_network,
    server       = NA_character_,
    share        = NA_character_,
    accessible   = FALSE,
    status       = "Not a network path"
  )

  if (!is_network) {
    class(result) <- "network_access_result"
    return(result)
  }

  path_clean <- gsub("^[/\\\\]+", "", path)
  parts      <- unlist(strsplit(path_clean, "[/\\\\]"))

  if (length(parts) >= 1) result$server <- parts[1]
  if (length(parts) >= 2) result$share  <- parts[2]

  accessible <- tryCatch({
    file.exists(path) || dir.exists(path)
  }, error = function(e) FALSE)

  result$accessible <- accessible
  result$status     <- ifelse(
    accessible,
    "Accessible network path",
    "Network path not accessible"
  )

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

#' @export
print.network_access_result <- function(x, ...) {
  cat("\n")
  cat("========================================\n")
  cat("NETWORK ACCESS REPORT\n")
  cat("========================================\n\n")
  cat("Path         :", x$path,         "\n")
  cat("Network Path :", x$network_path, "\n")
  cat("Server       :", x$server,       "\n")
  cat("Share        :", x$share,        "\n")
  cat("Accessible   :", x$accessible,   "\n")
  cat("Status       :", x$status,       "\n")
  cat("\n========================================\n")
  invisible(x)
}