From 3627048ee086966fde4cbb8fb2daf11cfaad2a04 Mon Sep 17 00:00:00 2001
From: Hadley Wickham <hadley@posit.co>
Date: Tue, 28 Feb 2023 08:28:27 -0600
Subject: [PATCH] Get locale name from registry (#715)

Fixes #233
---
 NEWS.md                      |  2 +
 R/locale.R                   | 89 +++++++-----------------------------
 tests/testthat/test-locale.R | 19 ++++++++
 3 files changed, 37 insertions(+), 73 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..4e8d0fda 100644
--- a/R/locale.R
+++ b/R/locale.R
@@ -1,84 +1,27 @@
-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()
+  if (!isWindows()) {
+    locales <- strsplit(Sys.getlocale("LC_CTYPE"), ".", fixed = TRUE)[[1]]
+    locales[[1]]
   } else {
-    locale <- detectLocale.Unix()
+    tryCatch(windowsLocale(), error = function(err) "en_US")
   }
-  return(locale)
 }
 
-detectLocale.Unix <- function() {
-  unlist(strsplit(Sys.getlocale("LC_CTYPE"), ".", fixed = TRUE))[1]
+# 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)
 }
 
-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)
+# 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 {
-
-    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)
-    })
+    paste0(pieces[[1]], "_", all_upper[[1]])
   }
-  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 = "_")
-  } else {
-    locale <- paste(tolower(parts[[1]][1]), toupper(parts[[1]][1]), sep = "_")
-  }
-  message(locale)
-  return(locale)
-}
-
-systemInfo <- function() {
-  raw <- system("systeminfo /FO csv", intern = TRUE, wait = TRUE)
-  info <- read.csv(textConnection(raw))
-  return(info)
 }
diff --git a/tests/testthat/test-locale.R b/tests/testthat/test-locale.R
new file mode 100644
index 00000000..61a40c28
--- /dev/null
+++ b/tests/testthat/test-locale.R
@@ -0,0 +1,19 @@
+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")
+})