From 8ce339201babbe8dcdbdc688e9e06aa43728b2c2 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 27 Feb 2023 10:46:48 -0600 Subject: [PATCH 1/4] Get locale name from registry Fixes #233 --- NEWS.md | 2 + R/locale.R | 98 ++++++++---------------------------- tests/testthat/test-locale.R | 4 ++ 3 files changed, 26 insertions(+), 78 deletions(-) create mode 100644 tests/testthat/test-locale.R diff --git a/NEWS.md b/NEWS.md index bbac9a13..b555a184 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # rsconnect 0.8.30 (development version) +* Locale detection has been improved on windows (#233). + * `deployApp()` will now warn if `appFiles` or `appManifestFiles` contain files that don't exist, rather than silently ignoring them (#706). diff --git a/R/locale.R b/R/locale.R index f2d8b6bf..4f8620ce 100644 --- a/R/locale.R +++ b/R/locale.R @@ -1,84 +1,26 @@ -overrideWindowsLocale <- function(locale) { - map <- list() - map[["el_EL"]] <- "el_GR" - if (locale %in% names(map)) { - locale <- map[[locale]] - } - return(locale) -} - detectLocale <- function() { - sysName <- Sys.info()[["sysname"]] - if (identical(sysName, "Windows")) { - locale <- detectLocale.Windows() - } else { - locale <- detectLocale.Unix() - } - return(locale) -} - -detectLocale.Unix <- function() { - unlist(strsplit(Sys.getlocale("LC_CTYPE"), ".", fixed = TRUE))[1] -} - -detectLocale.Windows <- function(useCache = - getOption("rsconnect.locale.cache", TRUE)) { - - # default locale - locale <- "en_US" - - cacheFile <- localeCacheFile() - if (file.exists(cacheFile) && useCache) { - - # get chached - cache <- as.list(readDcf(cacheFile, all = TRUE)) - - locale <- unlist(cache$locale) - - } else { - - tryCatch({ - - # get system locale - locale <- systemLocale() - - # write the user info - write.dcf(list(locale = locale), - cacheFile, - width = 100) - - }, error = function(e) { - warning(paste0("Error detecting locale: ", e, - " (Using default: ", locale, ")"), call. = FALSE) - }) - } - return(overrideWindowsLocale(locale)) -} - -localeCacheFile <- function() { - normalizePath(file.path(rsconnectConfigDir(), "locale.dcf"), mustWork = FALSE) -} - -systemLocale <- function() { - message("Detecting system locale ... ", appendLF = FALSE) - - # get system locale - info <- systemInfo() - raw <- as.character(info[[20]]) - parts <- strsplit(unlist(strsplit(raw, ";", fixed = TRUE)), "-", fixed = TRUE) - - if (length(parts[[1]]) >= 2) { - # normalize locale to something like en_US - locale <- paste(tolower(parts[[1]][1]), toupper(parts[[1]][2]), sep = "_") + if (!isWindows()) { + locales <- strsplit(Sys.getlocale("LC_CTYPE"), ".", fixed = TRUE)[[1]] + locales[[1]] } else { - locale <- paste(tolower(parts[[1]][1]), toupper(parts[[1]][1]), sep = "_") + locale <- HCU_registry_key("Control Panel\\International\\User Profile")$Languages[[1]] + if (is.null(locale)) { + # Try approach that works on Windows 7 + locales <- HCU_registry_key("Control Panel\\International")$LocaleName + if (is.null(locale)) { + # Otherwise fall back US English + locale <- "en-US" + } + } + gsub("-", "_", locale) } - message(locale) - return(locale) } -systemInfo <- function() { - raw <- system("systeminfo /FO csv", intern = TRUE, wait = TRUE) - info <- read.csv(textConnection(raw)) - return(info) +HCU_registry_key <- function(key, default = NULL) { + tryCatch( + utils::readRegistry(key, hive = "HCU"), + error = function(err) { + default + } + ) } diff --git a/tests/testthat/test-locale.R b/tests/testthat/test-locale.R new file mode 100644 index 00000000..c34241bd --- /dev/null +++ b/tests/testthat/test-locale.R @@ -0,0 +1,4 @@ +test_that("locale is en_US on GHA", { + skip_if_not(identical(Sys.getenv("GITHUB_ACTIONS"), "true")) + expect_equal(detectLocale(), "en_US") +}) From a9fc88bd2b53c37134c2c88e8f62c368aedb3d3e Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 27 Feb 2023 10:59:03 -0600 Subject: [PATCH 2/4] Skip linux which uses C locale --- tests/testthat/test-locale.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-locale.R b/tests/testthat/test-locale.R index c34241bd..60dfc6f0 100644 --- a/tests/testthat/test-locale.R +++ b/tests/testthat/test-locale.R @@ -1,4 +1,6 @@ -test_that("locale is en_US on GHA", { +test_that("locale is en_US on mac/windows GHA", { + skip_on_os("linux") skip_if_not(identical(Sys.getenv("GITHUB_ACTIONS"), "true")) + expect_equal(detectLocale(), "en_US") }) From 8c8c6e5d44ef10cdd5d7c85f57e2abe3893dafe4 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 27 Feb 2023 15:57:26 -0600 Subject: [PATCH 3/4] Only use LocaleName key --- R/locale.R | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/R/locale.R b/R/locale.R index 4f8620ce..3a8199c8 100644 --- a/R/locale.R +++ b/R/locale.R @@ -3,14 +3,12 @@ detectLocale <- function() { locales <- strsplit(Sys.getlocale("LC_CTYPE"), ".", fixed = TRUE)[[1]] locales[[1]] } else { - locale <- HCU_registry_key("Control Panel\\International\\User Profile")$Languages[[1]] + # Possible values listed at https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-lcid/70feba9f-294e-491e-b6eb-56532684c37f + locales <- HCU_registry_key("Control Panel\\International")$LocaleName + if (is.null(locale)) { - # Try approach that works on Windows 7 - locales <- HCU_registry_key("Control Panel\\International")$LocaleName - if (is.null(locale)) { - # Otherwise fall back US English - locale <- "en-US" - } + # Otherwise fall back US English + locale <- "en-US" } gsub("-", "_", locale) } From 4e72ac42bfcf7c4f7350119baad78efca83db4ea Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 27 Feb 2023 16:41:17 -0600 Subject: [PATCH 4/4] Remove script tag; refactor --- R/locale.R | 33 ++++++++++++++++++--------------- tests/testthat/test-locale.R | 17 +++++++++++++++-- 2 files changed, 33 insertions(+), 17 deletions(-) diff --git a/R/locale.R b/R/locale.R index 3a8199c8..4e8d0fda 100644 --- a/R/locale.R +++ b/R/locale.R @@ -3,22 +3,25 @@ detectLocale <- function() { locales <- strsplit(Sys.getlocale("LC_CTYPE"), ".", fixed = TRUE)[[1]] locales[[1]] } else { - # Possible values listed at https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-lcid/70feba9f-294e-491e-b6eb-56532684c37f - locales <- HCU_registry_key("Control Panel\\International")$LocaleName - - if (is.null(locale)) { - # Otherwise fall back US English - locale <- "en-US" - } - gsub("-", "_", locale) + tryCatch(windowsLocale(), error = function(err) "en_US") } } -HCU_registry_key <- function(key, default = NULL) { - tryCatch( - utils::readRegistry(key, hive = "HCU"), - error = function(err) { - default - } - ) +# Possible values +# listed at https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-lcid +windowsLocale <- function() { + key <- utils::readRegistry("Control Panel\\International", hive = "HCU") + normalizeLocale(key$LocaleName) +} + +# Remove script tag, if present +normalizeLocale <- function(x) { + pieces <- strsplit(x, "-")[[1]] + all_upper <- pieces[pieces == toupper(pieces)] + + if (length(all_upper) == 0) { + pieces[[1]] + } else { + paste0(pieces[[1]], "_", all_upper[[1]]) + } } diff --git a/tests/testthat/test-locale.R b/tests/testthat/test-locale.R index 60dfc6f0..61a40c28 100644 --- a/tests/testthat/test-locale.R +++ b/tests/testthat/test-locale.R @@ -1,6 +1,19 @@ -test_that("locale is en_US on mac/windows GHA", { - skip_on_os("linux") +test_that("locale is en_US on mac GHA", { + skip_on_os(c("linux", "windows")) skip_if_not(identical(Sys.getenv("GITHUB_ACTIONS"), "true")) expect_equal(detectLocale(), "en_US") }) + +test_that("locale is en_US on mac GHA", { + skip_on_os(c("linux", "mac")) + skip_if_not(identical(Sys.getenv("GITHUB_ACTIONS"), "true")) + + expect_equal(windowsLocale(), "en_US") +}) + +test_that("normalizeLocale handles common forms", { + expect_equal(normalizeLocale("en-US"), "en_US") + expect_equal(normalizeLocale("az-Cyrl"), "az") + expect_equal(normalizeLocale("az-Cyrl-AZ"), "az_AZ") +})