1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
#' Time zone
#'
#' Change the time zone, and restore it afterwards.
#'
#' `with_timezone()` runs the code with the specified time zone and
#' resets it afterwards.
#'
#' `local_timezone()` changes the time zone for the caller
#' execution environment.
#'
#' @template with
#' @param tz `[character(1)]` a valid time zone specification, note that
#' time zone names might be platform dependent.
#'
#' @seealso [Sys.timezone()].
#' @export
#' @examples
#' Sys.time()
#' with_timezone("Europe/Paris", print(Sys.time()))
#' with_timezone("America/Los_Angeles", print(Sys.time()))
#'
with_timezone <- function(tz, code) {
reset_timezone()
with_envvar(c(TZ = tz), code)
}
#' @rdname with_timezone
#' @param .local_envir The environment to apply the change to.
#' @export
#' @examples
#' fun1 <- function() {
#' local_timezone("CET")
#' print(Sys.time())
#' }
#'
#' fun2 <- function() {
#' local_timezone("America/Los_Angeles")
#' print(Sys.time())
#' }
#' Sys.time()
#' fun1()
#' fun2()
#' Sys.time()
local_timezone <- function(tz, .local_envir = parent.frame()) {
reset_timezone(envir = .local_envir)
local_envvar(c(TZ = tz), .local_envir = .local_envir)
}
reset_timezone <- function(envir = parent.frame()) {
base_env <- baseenv()
old <- get0(".sys.timezone", base_env, mode = "character",
inherits = FALSE, ifnotfound = NA_character_)
is_locked <- bindingIsLocked(".sys.timezone", env = base_env)
if (is_locked) {
base_env$unlockBinding(".sys.timezone", env = base_env)
}
defer({
assign(".sys.timezone", old, envir = base_env)
if (is_locked) {
lockBinding(".sys.timezone", env = base_env)
}
}, envir = envir)
assign(".sys.timezone", NA_character_, envir = base_env)
}
|
