1
#' Temporary files
2
#'
3
#' Temporarily create a tempfile, which is automatically removed afterwards.
4
#' @template with
5
#' @param new `[character vector]`\cr (Deprecated for `local_tempfile()`) Names of temporary file handles to create.
6
#' @param envir `[environment]`\cr Environment in which to define the temporary files.
7
#' @param clean `[logical(1)]`\cr A logical indicating if the temporary
8
#'   directory should be deleted after use (`TRUE`, default) or left alone (`FALSE`).
9
#' @inheritParams with_collate
10
#' @inheritParams base::tempfile
11
#' @examples
12
#' # check how big iris would be if written as csv vs RDS
13
#' tf <- with_tempfile("tf", {write.csv(iris, tf); file.size(tf)})
14
#' tf <- with_tempfile("tf", {saveRDS(iris, tf); file.size(tf)})
15
#' @export
16
with_tempfile <- function(new, code, envir = parent.frame(),
17
  pattern = "file", tmpdir = tempdir(), fileext = "") {
18 1
  env <- new.env(parent = envir)
19 1
  for (f in new) {
20 1
    assign(f,
21 1
      tempfile(pattern = pattern, tmpdir = tmpdir, fileext = fileext),
22 1
      envir = env)
23
  }
24 1
  on.exit(unlink(mget(new, envir = env), recursive = TRUE))
25 1
  eval(substitute(code), envir = env)
26
}
27

28
#' @rdname with_tempfile
29
#' @export
30
local_tempfile <- function(new = NULL, envir = parent.frame(),
31
  pattern = "file", tmpdir = tempdir(), fileext = "") {
32 1
  if (is.null(new)) {
33 1
    path <- tempfile(pattern = pattern, tmpdir = tmpdir, fileext = fileext)
34 1
    defer(unlink(path, recursive = TRUE), envir = envir)
35 1
    return(path)
36
  }
37

38 1
  .Deprecated(msg = "`new` argument of local_tempfile() is deprecated.\n  Use `path <- local_tempfile()` instead.")
39

40 1
  for (f in new) {
41 1
    assign(f,
42 1
      tempfile(pattern = pattern, tmpdir = tmpdir, fileext = fileext),
43 1
      envir = envir)
44
  }
45 1
  defer(unlink(mget(new, envir = envir), recursive = TRUE), envir = envir)
46
}
47

48

49
#' @rdname with_tempfile
50
#' @export
51
with_tempdir <- function(code, clean = TRUE,
52
  pattern = "file", tmpdir = tempdir(), fileext = "") {
53 1
  if (length(clean) > 1 || !is.logical(clean)) {
54 1
    stop("`clean` must be a single TRUE or FALSE", call. = FALSE)
55
  }
56

57 1
  tmp <- tempfile(pattern = pattern, tmpdir = tmpdir, fileext = fileext)
58

59 1
  dir.create(tmp)
60 1
  if (clean) {
61 1
    on.exit(unlink(tmp, recursive = TRUE), add = TRUE)
62
  }
63 1
  withr::with_dir(tmp, code)
64
}
65

66
#' @rdname with_tempfile
67
#' @export
68
local_tempdir <- function(pattern = "file", tmpdir = tempdir(),
69
                          fileext = "", .local_envir = parent.frame(), clean = TRUE) {
70 1
  if (length(clean) > 1 || !is.logical(clean)) {
71 0
    stop("`clean` must be a single TRUE or FALSE", call. = FALSE)
72
  }
73

74 1
  path <- tempfile(pattern = pattern, tmpdir = tmpdir, fileext = fileext)
75

76 1
  dir.create(path, recursive = TRUE)
77

78 1
  if (isTRUE(clean)) {
79 1
    defer(unlink(path, recursive = TRUE), envir = .local_envir)
80
  }
81

82 1
  path
83
}

Read our documentation on viewing source code .

Loading