R/utils.R

In kiernann/zippr: Consistent Cross-Platform ZIP Compression

get_zip_data <- function(files, recurse, keep_path, include_directories) {
  list <- if (keep_path) {
    get_zip_data_path(files, recurse)
  } else {
    get_zip_data_nopath(files, recurse)
  }

  if (!include_directories) {
    list <- list[! list$dir, ]
  }

  list
}

get_zip_data_path <- function(files, recurse) {
    if (recurse && length(files)) {
    data <- do.call(rbind, lapply(files, get_zip_data_path_recursive))
    dup <- duplicated(data$files)
    if (any(dup)) data <- data <- data[ !dup, drop = FALSE ]
    data

  } else {
    files <- ignore_dirs_with_warning(files)
    data.frame(
      stringsAsFactors = FALSE,
      key = files,
      files = files,
      dir = rep(FALSE, length(files))
    )
  }
}

warn_for_dotdot <- function(files) {
  if (any(grepl("^[.][/\\\\]", files))) {
    warning("Some paths start with `./`, creating non-portable zip file")
  }
  if (any(grepl("^[.][.][/\\\\]", files))) {
    warning("Some paths reference parent directory, ",
            "creating non-portable zip file")
  }
  files
}

get_zip_data_nopath <- function(files, recurse) {
  if (recurse && length(files)) {
    data <- do.call(rbind, lapply(files, get_zip_data_nopath_recursive))
    dup <- duplicated(data$files)
    if (any(dup)) data <- data[ !dup, drop = FALSE ]
    data

  } else {
    files <- ignore_dirs_with_warning(files)
    data.frame(
      stringsAsFactors = FALSE,
      key = basename(files),
      file = files,
      dir = rep(FALSE, length(files))
    )
  }
}

ignore_dirs_with_warning <- function(files) {
  info <- file.info(files)
  if (any(info$isdir)) {
    warning("directories ignored in zip file, specify recurse = TRUE")
    files <- files[!info$isdir]
  }
  files
}

get_zip_data_path_recursive <- function(x) {
  if (file.info(x)$isdir) {
    files <- c(x, dir(x, recursive = TRUE, full.names = TRUE,
                      all.files = TRUE, include.dirs = TRUE, no.. = TRUE))
    dir <- file.info(files)$isdir
    data.frame(
      stringsAsFactors = FALSE,
      key = ifelse(dir, paste0(files, "/"), files),
      file = normalizePath(files),
      dir = dir
    )
  } else {
    data.frame(
      stringsAsFactors = FALSE,
      key = x,
      file = normalizePath(x),
      dir = FALSE
    )
  }
}

get_zip_data_nopath_recursive <- function(x) {
  x <- normalizePath(x)
  wd <- getwd()
  on.exit(setwd(wd))
  setwd(dirname(x))
  bnx <- basename(x)

  files <- dir(
    bnx,
    recursive = TRUE,
    all.files = TRUE,
    include.dirs = TRUE,
    no.. = TRUE
  )

  key <- c(bnx, file.path(bnx, files))
  files <- c(x, file.path(dirname(x), bnx, files))
  dir <- file.info(files)$isdir
  key <- ifelse(dir, paste0(key, "/"), key)

  data.frame(
    stringsAsFactors = FALSE,
    key = key,
    file = normalizePath(files),
    dir = dir
  )
}

# from r-lib/fs/R/utils.R
as_tibble <- function(x) {
  if (getOption("fs.use_tibble", TRUE) && is_installed("tibble")) {
    tibble::as_tibble(x)
  } else {
    x
  }
}

is_installed <- function(pkg) {
  isTRUE(requireNamespace(pkg, quietly = TRUE))
}