Skip to content

Commit

Permalink
Merge pull request #28 from RMI-PACTA/file-checks
Browse files Browse the repository at this point in the history
Add (file) IO checks
  • Loading branch information
AlexAxthelm authored Aug 14, 2024
2 parents fdc0b8b + b3457ae commit 838ea80
Show file tree
Hide file tree
Showing 8 changed files with 404 additions and 0 deletions.
3 changes: 3 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,5 +1,8 @@
# Generated by roxygen2: do not edit by hand

export(check_dir_writable)
export(check_file)
export(check_io)
export(export_manifest)
export(get_file_metadata)
export(get_git_info)
Expand Down
97 changes: 97 additions & 0 deletions R/file_checks.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,97 @@
#' check_dir_writable
#'
#' Check if a directory is writable. Check is performed by attempting to write
#' a 0-byte file (`.test`) to the directory (and removing afterwards). Emits a
#' warning on windows, since file permissions on Windows systems are difficult
#' to test, but _should_ be accurate.
#'
#' @param dir directory to check writiblity
#' @return logical, can a file be written to the directory?
#' @export
check_dir_writable <- function(dir) {
log_trace("Checking if directory is writable: ", dir)
if (tolower(Sys.info()[["sysname"]]) == "windows") {
log_warn("Function check_dir_writable is not tested on Windows.")
warning("check_dir_writable may return incorrect results on Windows.")
}
if (dir.exists(dir)) {
log_trace("Directory exists.")
test_path <- file.path(dir, ".test")
dir_is_writable <- file.create(test_path, showWarnings = FALSE)
if (dir_is_writable) {
file.remove(test_path)
}
} else {
log_error("Directory \"{dir}\" does not exist.")
warning("Directory does not exist.")
dir_is_writable <- FALSE
}
return(dir_is_writable)
}

#' check_file
#'
#' check a filepath for existence, non-zero size, and non-directory status.
#'
#' @param filepath path to file
#' @return logical(1L), is the file valid?
#' @export
check_file <- function(filepath) {
log_trace("Checking if file exists: ", filepath)
pass <- FALSE
info <- file.info(filepath, extra_cols = FALSE)
if (all(is.na(info))) {
log_error("File \"{filepath}\" does not exist.")
warning("File does not exist.")
} else if (is.na(info[["isdir"]]) || info[["isdir"]]) {
log_error("File \"{filepath}\" is a directory.")
warning("File is a directory.")
} else if (info[["size"]] == 0L || is.na(info[["size"]])) {
log_warn("File \"{filepath}\" is empty.")
warning("File is empty.")
} else {
log_trace("File exists and is non-zero size.")
pass <- TRUE
}
return(invisible(pass))
}

#' check_io
#'
#' check `input_files` using \code{\link{check_file}} and `output_dirs` using
#' \code{\link{check_dir_writable}}.
#'
#' @param input_files list or vector of file paths to check with
#' \code{\link{check_file}}
#' @param output_dirs list or vector of directories to check with
#' \code{\link{check_dir_writable}}
#' @return logical(1L), are all files and directories valid? Note that function
#' will throw an error in situations where this is not TRUE.
#' @export
check_io <- function(
input_files = NULL,
output_dirs = NULL
) {
input_checks <- vapply(
X = input_files,
FUN = check_file,
FUN.VALUE = logical(1L)
)
output_checks <- vapply(
X = output_dirs,
FUN = check_dir_writable,
FUN.VALUE = logical(1L)
)
if (!all(c(input_checks, output_checks))) {
invalid_input_idx <- which(!input_checks)
for (ii in invalid_input_idx) {
log_error("Invalid input file: ", input_files[[ii]])
}
invalid_output_idx <- which(!output_checks)
for (ii in invalid_output_idx) {
log_error("Invalid output directory: ", output_dirs[[ii]])
}
stop("IO checks failed.")
}
return(invisible(all(input_checks, output_checks)))
}
20 changes: 20 additions & 0 deletions man/check_dir_writable.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

17 changes: 17 additions & 0 deletions man/check_file.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

23 changes: 23 additions & 0 deletions man/check_io.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

48 changes: 48 additions & 0 deletions tests/testthat/test-check_dir_writable.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,48 @@
## save current settings so that we can reset later
threshold <- logger::log_threshold()
appender <- logger::log_appender()
layout <- logger::log_layout()
on.exit({
## reset logger settings
logger::log_threshold(threshold)
logger::log_layout(layout)
logger::log_appender(appender)
})

logger::log_appender(logger::appender_stdout)
logger::log_threshold(logger::FATAL)
logger::log_layout(logger::layout_simple)

# TESTS BEGIN

test_that("check_dir_writable correctly registers writable directory", {
skip_on_os("windows")
test_dir <- withr::local_tempdir()
expect_true(check_dir_writable(test_dir))
})

test_that("check_dir_writable correctly errors on missing directory", {
skip_on_os("windows")
test_dir <- withr::local_tempdir()
dne_dir <- file.path(test_dir, "does_not_exist")
expect_warning(
check_dir_writable(dne_dir),
regexp = "^Directory does not exist.$"
)
})

test_that("check_dir_writable correctly registers un-writable directory", {
skip_on_os("windows")
test_dir <- withr::local_tempdir()
Sys.chmod(test_dir, mode = "000")
expect_false(check_dir_writable(test_dir))
})

test_that("check_dir_writable emits warning on windows.", {
skip_on_os(c("mac", "linux", "solaris"))
test_dir <- withr::local_tempdir()
expect_warning(
check_dir_writable(test_dir),
regexp = "^check_dir_writable may return incorrect results on Windows.$"
)
})
49 changes: 49 additions & 0 deletions tests/testthat/test-check_file.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,49 @@
## save current settings so that we can reset later
threshold <- logger::log_threshold()
appender <- logger::log_appender()
layout <- logger::log_layout()
on.exit({
## reset logger settings
logger::log_threshold(threshold)
logger::log_layout(layout)
logger::log_appender(appender)
})

logger::log_appender(logger::appender_stdout)
logger::log_threshold(logger::FATAL)
logger::log_layout(logger::layout_simple)

test_that("check_dir_writable correctly identifies missing files", {
test_file <- withr::local_tempfile()
expect_warning(
{results <- check_file(test_file)},
regexp = "^File does not exist.$"
)
expect_false(results)
})

test_that("check_dir_writable correctly identifies missing files", {
test_file <- withr::local_tempdir()
expect_warning(
{results <- check_file(test_file)},
regexp = "^File is a directory.$"
)
expect_false(results)
})

test_that("check_dir_writable correctly identifies 0-byte files", {
test_file <- withr::local_tempfile()
file.create(test_file)
expect_warning(
{results <- check_file(test_file)},
regexp = "^File is empty.$"
)
expect_false(results)
})

test_that("check_dir_writable correctly identifies extant, non-empty files", {
test_file <- withr::local_tempfile()
saveRDS(object = mtcars, file = test_file)
results <- check_file(test_file)
expect_true(results)
})
Loading

0 comments on commit 838ea80

Please sign in to comment.