R/delete_stash.R

#' Delete a stashed file
#'
#' @param file.name Base file name for the object
#' @param from Path for where the object resides. Accepts a character
#'    string or *_stash object.
#' @param time.stamp TRUE or FALSE. When TRUE, files containing a time stamp
#'    generated by save_stash, or matching the save_stash pattern, will be
#'    deleted.
#' @param uuid TRUE or FALSE. When TRUE, files containing a uuid
#'    generated by save_stash, or matching the save_stash pattern, will be
#'    deleted.
#' @param extension Extension for the file to delete.
#' @param compression Accepts NULL for no compression, or 'gz' for gzip.
#' @param checksum Not being used right now.
#' @param no.prompt TRUE or FALSE. When FALSE, you will be promted to confirm
#'    deletion of matching files. When TRUE, you will not be prompted. Defaults
#'    to FALSE.
#' @param clean.up TRUE or FALSE. When TRUE, the directory that the file resided
#'    in will be deleted if it is empty.
#'
#' @return List of stash objects that were successfully deleted.
#' @export
delete_stash <- function(from, no.prompt = FALSE, clean.up = TRUE,
    simplify = TRUE) {

  from <- as.stash_file(from, simplify = FALSE)
  is.file <- file_exists(from)
  delete.from <- from[is.file]

  from[!is.file] <- set_messages(from[!is.file], 'message',
      'File does not exist')

  if (length(delete.from) == 0) {
    message('No files found to delete.')
    return(from)
  }

  if (!isTRUE(no.prompt)) {
    message('Ready to delete the following files:\n  - ',
        paste(get_filename(delete.from), collapse = '\n  - '))
    confirmation <- readline(prompt = 'Are you sure you want to delete?: (y/n) ')
    if (!tolower(confirmation) %in% c('yes', 'y')) {
      stop('Deletion has been cancelled.')
    }
  }

  res <- llply(delete.from, delete_stash_, clean.up = clean.up)
  from[is.file] <- res

  if (simplify && length(from) == 1) {
    return(from[[1]])
  }
  return(from)
}

delete_stash_ <- function(from, clean.up) {
  UseMethod('delete_stash_')
}


#' @export
delete_stash_.local_stash <- function(from, clean.up) {

  message('Deleting... ', from)
  unlink(from, recursive = TRUE)

  valid <- file_exists(from)
  from[!valid] <- set_messages(from[!valid], 'message', 'File deleted')
  from[valid] <- set_messages(from[valid], 'warning', 'File failed to delete')

  if (isTRUE(clean.up) && !any(valid)) {
    clean_empty_dir(get_directory(from))
  }

  return(from)
}


#' @export
delete_stash_.s3_stash <- function(from, clean.up) {

  from.args <- c(
    object = get_filepath(from),
    bucket = get_container(from),
    key = attr(from, 'access.key.id'),
    secret = attr(from, 'secret.access.key'),
    region = attr(from, 'region')
  )
  from.args <- as.list(from.args)

  message('Deleting... ', from)
  do.call(delete_object, from.args)

  valid <- file_exists(from)
  from[!valid] <- set_messages(from[!valid], 'message', 'File deleted')
  from[valid] <- set_messages(from[valid], 'warning', 'File failed to delete')

  return(from)
}
jason-huling/rstash documentation built on May 18, 2019, 4:53 p.m.