On Fri, 20 Oct 2017 09:15:42 +0200 Martin Maechler <maech...@stat.math.ethz.ch>
wrote:
>>>>>> Stephen Berman <stephen.ber...@gmx.net>
>>>>>> on Thu, 19 Oct 2017 17:12:50 +0200 writes:
>
> > On Wed, 18 Oct 2017 18:09:41 +0200 Martin Maechler
> > <maech...@stat.math.ethz.ch> wrote:
> >>>>>>> Martin Maechler <maech...@stat.math.ethz.ch>
> >>>>>>> on Mon, 16 Oct 2017 19:13:31 +0200 writes:
>
[...]
> >>> whereas on Windows I get Europe/Berlin for the first (why on
> >>> earth - I'm really in Zurich) and get "CEST" ("Central European Summer
> >>> Time")
> >>> for the 2nd one instead of NA ... simply using a smarter version
> >>> of your proposal. The windows source is
> >>> in R's source at src/library/base/R/windows/system.R :
> >>>
> >>> Sys.timezone <- function(location = TRUE)
> >>> {
> >>> tz <- Sys.getenv("TZ", names = FALSE)
> >>> if(nzchar(tz)) return(tz)
> >>> if(location) return(.Internal(tzone_name()))
> >>> z <- as.POSIXlt(Sys.time())
> >>> zz <- attr(z, "tzone")
> >>> if(length(zz) == 3L) zz[2L + z$isdst] else zz[1L]
> >>> }
> >>>
> >>> >From what I read, the last three lines also work in your setup
> >>> where it seems zz would be of length 1, right ?
>
> > Those line do indeed work here, but zz has three elements:
>
> >> attributes(as.POSIXlt(Sys.time()))$tzone
> > [1] "" "CET" "CEST"
>
> { "but" ?? yes, three elements is what I see too, but for that
> reason there's the if(length(zz) == 3L) ... }
The "but" was in response to "it seems zz would be of length 1", but
perhaps I misunderstood you.
[...]
> >> As you say yourself, the above system("... xargs md5sum ...")
> >> using workaround is really too platform specific but I'd guess
> >> there should be a less error prone way to get the long timezone
> >> name on your system ...
>
> > If I understand the zic(8) man page, the files in /usr/share/zoneinfo
> > should contain this information, but I don't know how to extract it,
> > since these are compiled files. And since on my system /etc/localtime
> > is a copy of one of these compiled files, I don't know of any other way
> > to recover the location name without comparing it to those files.
>
> >> If that remains "contained" (i.e. small) and works with files
> >> and R's files tools -- e.g. file.*() ones [but not system()],
> >> I'd consider a patch to the above source file
> >> (sent by you to the R-devel mailing list --- or after having
> >> gotten an account there by asking, via bug report & patch
> >> attachment at https://bugs.r-project.org/ )
>
> > If comparing file size sufficed, that would be easy to do in R;
> > unfortunately, it is not sufficient, since some files designating
> > different time zones in /usr/share/zoneinfo do have the same size. So
> > the only alternative I can think of is to compare bytes, e.g. with
> > md5sum or with cmp. Is there some way to do this in R without using
> > system()?
>
> Can't you use
> tz1 <- readBin("/etc/localtime", "raw", 200L)
> plus later
> tz2 <- gsub(......., rawToChar(tz1))
>
> on your /etc/localtime file
> almost identically as the current code does for "/etc/timezone" ?
Oh, thanks. I've looked at this code over and over again in the last
few days and somehow still didn't see its usefulness (maybe because I
haven't had occasion to deal with binary data in R till now). Anyway,
just substituting "/etc/localtime" for "/etc/timezone" doesn't work,
since my /etc/localtime file seems not to hold the timezone location
name in a form recoverable with rawToChar() (all I see are the
abbreviated timezones CEST, CEMT and CET-1CEST); but I can use the raw
bytes to make the comparison with files in /usr/share/zoneinfo. With
the attached patch, I get both the timezone location name (with
location=TRUE) and the abbreviated timezone (with location=FALSE). One
thing I wonder about: is looking at just the first 200 bytes guaranteed
to be sufficient, or would it be better to use n=file.size() to examine
the whole file?
Steve Berman
*** datetime.R.orig 2017-10-20 17:15:05.147093873 +0200
--- datetime.R.new 2017-10-20 18:18:58.598972383 +0200
***************
*** 30,54 ****
lt <- normalizePath("/etc/localtime") # most Linux, macOS, ...
if (grepl(pat <- "^/usr/share/zoneinfo/", lt) ||
grepl(pat <- "^/usr/share/zoneinfo.default/", lt)) sub(pat, "", lt)
! else if (lt == "/etc/localtime" && file.exists("/etc/timezone") &&
! dir.exists("/usr/share/zoneinfo") &&
! { # Debian etc.
! info <- file.info(normalizePath("/etc/timezone"),
! extra_cols = FALSE)
! (!info$isdir && info$size <= 200L)
! } && {
! tz1 <- tryCatch(readBin("/etc/timezone", "raw", 200L),
! error = function(e) raw(0L))
! length(tz1) > 0L &&
! all(tz1 %in% as.raw(c(9:10, 13L, 32:126)))
! } && {
! tz2 <- gsub("^[[:space:]]+|[[:space:]]+$", "", rawToChar(tz1))
! tzp <- file.path("/usr/share/zoneinfo", tz2)
! file.exists(tzp) && !dir.exists(tzp) &&
! identical(file.size(normalizePath(tzp)),
! file.size(lt))
! })
! tz2
else
NA_character_
}
--- 30,73 ----
lt <- normalizePath("/etc/localtime") # most Linux, macOS, ...
if (grepl(pat <- "^/usr/share/zoneinfo/", lt) ||
grepl(pat <- "^/usr/share/zoneinfo.default/", lt)) sub(pat, "", lt)
! else if (lt == "/etc/localtime")
! if (file.exists("/etc/timezone") &&
! dir.exists("/usr/share/zoneinfo") &&
! { # Debian etc.
! info <- file.info(normalizePath("/etc/timezone"),
! extra_cols = FALSE)
! (!info$isdir && info$size <= 200L)
! } && {
! tz1 <- tryCatch(readBin("/etc/timezone", "raw", 200L),
! error = function(e) raw(0L))
! length(tz1) > 0L &&
! all(tz1 %in% as.raw(c(9:10, 13L, 32:126)))
! } && {
! tz2 <- gsub("^[[:space:]]+|[[:space:]]+$", "",
! rawToChar(tz1))
! tzp <- file.path("/usr/share/zoneinfo", tz2)
! file.exists(tzp) && !dir.exists(tzp) &&
! identical(file.size(normalizePath(tzp)),
! file.size(lt))
! })
! tz2
! else { # !file.exists("/etc/timezone")
! zif1 <- list.files("/usr/share/zoneinfo/", full.names=TRUE,
! recursive=TRUE)
! zif2 <- zif1[file.size(zif1) == file.size("/etc/localtime")]
! if (length(zif2) == 1L) tz.usr <- zif2
! else {
! tz.loc <- readBin("/etc/localtime", "raw", 200L)
! for (f in zif2) {
! tzf <- readBin(f, "raw", 200L)
! if (identical(tzf, tz.loc)) {
! tz.usr <- f
! break
! }
! }
! }
! sub("^.*/([^/]+/[^/]+)$", "\\1", tz.usr)
! }
else
NA_character_
}
______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
