1overrideWindowsLocale <- function(locale) {
2  map <- list()
3  map[['el_EL']] <- "el_GR"
4  if (locale %in% names(map)) {
5    locale <- map[[locale]]
6  }
7  return(locale)
8}
9
10detectLocale <- function () {
11  sysName <- Sys.info()[['sysname']]
12  if (identical(sysName, "Windows")) {
13    locale <- detectLocale.Windows()
14  } else {
15    locale <- detectLocale.Unix()
16  }
17  return(locale)
18}
19
20detectLocale.Unix <- function () {
21  unlist(strsplit(Sys.getlocale("LC_CTYPE"), ".", fixed=TRUE))[1]
22}
23
24detectLocale.Windows <- function (useCache =
25                                  getOption('rsconnect.locale.cache', TRUE)) {
26
27  # default locale
28  locale <- 'en_US'
29
30  cacheFile <- localeCacheFile()
31  if (file.exists(cacheFile) && useCache) {
32
33    # get chached
34    cache <- as.list(readDcf(cacheFile, all=TRUE))
35
36    locale <- unlist(cache$locale)
37
38  } else {
39
40    tryCatch({
41
42      # get system locale
43      locale <- systemLocale()
44
45      # write the user info
46      write.dcf(list(locale = locale),
47                cacheFile,
48                width = 100)
49
50    }, error=function(e) {
51      warning(paste0("Error detecting locale: ", e,
52                     " (Using default: ", locale, ")"), call.=FALSE)
53    })
54  }
55  return(overrideWindowsLocale(locale))
56}
57
58localeCacheFile <- function() {
59  normalizePath(file.path(rsconnectConfigDir(), "locale.dcf"), mustWork = FALSE)
60}
61
62systemLocale <- function() {
63  message("Detecting system locale ... ", appendLF = FALSE)
64
65  # get system locale
66  info <- systemInfo()
67  raw <- as.character(info[[20]])
68  parts <- strsplit(unlist(strsplit(raw, ";",  fixed=TRUE)), "-", fixed=TRUE)
69
70  if (length(parts[[1]]) >= 2) {
71    # normalize locale to something like en_US
72    locale <- paste(tolower(parts[[1]][1]), toupper(parts[[1]][2]), sep="_")
73  } else {
74    locale <- paste(tolower(parts[[1]][1]), toupper(parts[[1]][1]), sep="_")
75  }
76  message(locale)
77  return(locale)
78}
79
80systemInfo <- function () {
81  raw <- system("systeminfo /FO csv", intern=TRUE, wait=TRUE)
82  info <- read.csv(textConnection(raw))
83  return(info)
84}
85