R/utils.R

Defines functions extract_path_parts get_disk_space format_file_size is_file_locked get_file_type

#' Helper Functions for fileaccess Package
#'
#' Internal utility functions used by the main access-checking functions.
#' Not intended to be called directly by users.


#' Get Human-Readable File Type from Extension
#' @noRd
get_file_type <- function(file_path) {
  ext <- tolower(tools::file_ext(file_path))

  file_types <- list(
    csv      = "CSV (Comma-Separated Values)",
    xlsx     = "Excel Spreadsheet (.xlsx)",
    xls      = "Excel Spreadsheet (.xls)",
    sas7bdat = "SAS Data File",
    xpt      = "SAS Transport File",
    txt      = "Text File",
    json     = "JSON Data File",
    xml      = "XML Data File",
    pdf      = "PDF Document",
    docx     = "Word Document (.docx)",
    doc      = "Word Document (.doc)",
    pptx     = "PowerPoint Presentation",
    exe      = "Windows Executable",
    cmd      = "Command File",
    sh       = "Shell Script",
    bat      = "Batch File",
    r        = "R Script",
    py       = "Python Script",
    zip      = "ZIP Archive",
    rar      = "RAR Archive",
    tar      = "TAR Archive",
    gz       = "Gzip Archive"
  )

  if (ext %in% names(file_types)) return(file_types[[ext]])
  paste0("File (.", ext, ")")
}


#' Check if a File is Locked by Another Process
#' @noRd
is_file_locked <- function(file_path) {
  tryCatch({
    con <- file(file_path, "r+")
    close(con)
    FALSE
  }, error = function(e) TRUE)
}


#' Format File Size into Human-Readable String
#' @noRd
format_file_size <- function(bytes, unit = "auto") {
  if (is.na(bytes) || bytes == 0) return("0 B")

  units <- c("B", "KB", "MB", "GB", "TB")

  if (unit == "auto") {
    i    <- min(floor(log(bytes, base = 1024)), length(units) - 1)
    size <- round(bytes / (1024^i), 2)
    return(paste(size, units[i + 1]))
  }

  unit_upper <- toupper(unit)
  if (unit_upper %in% units) {
    idx  <- match(unit_upper, units)
    size <- round(bytes / (1024^(idx - 1)), 2)
    return(paste(size, unit_upper))
  }

  as.character(bytes)
}


#' Get Available Disk Space for a Given Path
#' @noRd
get_disk_space <- function(path) {
  tryCatch({
    if (.Platform$OS.type == "windows") {
      disk_info <- shell(
        paste("fsutil volume diskfree", path),
        intern = TRUE
      )
      if (length(disk_info) > 0) {
        free_bytes <- as.numeric(sub(".*: ", "", disk_info[1]))
        return(list(
          free_bytes = free_bytes,
          free_mb    = round(free_bytes / 1024^2, 2),
          free_gb    = round(free_bytes / 1024^3, 2)
        ))
      }
    } else {
      df_output <- system2("df", path, stdout = TRUE, stderr = FALSE)
      if (length(df_output) > 1) {
        parts      <- unlist(strsplit(df_output[2], "\\s+"))
        free_bytes <- as.numeric(parts[4]) * 1024
        return(list(
          free_bytes = free_bytes,
          free_mb    = round(free_bytes / 1024^2, 2),
          free_gb    = round(free_bytes / 1024^3, 2)
        ))
      }
    }
  }, error = function(e) NULL)

  list(free_bytes = NA, free_mb = NA, free_gb = NA)
}


#' Extract Server, Share, and Subpath from a UNC Network Path
#' @noRd
extract_path_parts <- function(network_path) {
  path_clean <- gsub("^(\\\\\\\\|//)", "", network_path)
  parts      <- unlist(strsplit(path_clean, "[/\\\\]"))

  list(
    server  = if (length(parts) >= 1) parts[1] else NA_character_,
    share   = if (length(parts) >= 2) parts[2] else NA_character_,
    subpath = if (length(parts) > 2)
      paste(parts[3:length(parts)], collapse = "/") else ""
  )
}

Try the fileaccess package in your browser

Any scripts or data that you put into this service are public.

fileaccess documentation built on June 18, 2026, 1:06 a.m.