Ajout de script R pour l'export de données

Suite à la demande de @frederic.jean d'avoir accès facilement aux données de l'observatoire Forêt pour leurs analyses, utiliser l'export par web service de SIDO est la solution la plus sûre et autonome.

Les besoins sont :

• script R
• utilisation de la bibliothèque Rcurl (qui fonctionne sur leurs postes)
• sorties dans des CSV en reprenant les colonnes du modèle de classeur, de la feuille Données et aussi des feuilles Dico* (Échelle notation autre...)
• ajout d'une colonne reprenant le nom du fichier XLSX contenant la donnée

Le paramétrage SIDO a été fait dans le commit de ce jour.

fixes #10604

bin/export.r

+#!/usr/bin/Rscript --vanilla --no-save --no-restore --quiet --encoding=UTF-8
+# Call SIDO web service to get data
+#
+## Uses
+## - RCurl: https://cran.r-project.org/web/packages/RCurl/index.html
+## - keyring: https://cran.r-project.org/web/packages/keyring/index.html
+## - logger: https://cran.r-project.org/web/packages/logger/index.html
+
+sido_ws_url <- "https://sido.pheno.fr/ws"
+observatory_schema <- "foret"
+keyring_service <- "sido-export"
+
+#' Load or install a package.
+#'
+#' @param packagename string package name
+require_install_package <- function(packagename) {
+  if (!library(packagename, character.only=TRUE, logical.return=TRUE)) {
+    logger::log_info("Installing the library {packagename}...")
+    install.packages(packagename, repos = "http://cran.at.r-project.org/")
+    if (!library(packagename, character.only=TRUE, logical.return=TRUE)) {
+      logger::log_error("Installing the library {packagename} failed.")
+      q()
+    }
+  }
+  require(packagename, quietly = TRUE, character.only = TRUE)
+}
+
+require_install_package("RCurl")
+require_install_package("jsonlite")
+require_install_package("keyring")
+require_install_package("logger")
+
+#' Get keyring
+#'
+#' @return keyring for the script
+get_keyring <- function(keyring_service) {
+  logger::log_info("Using backend_file")
+  kr <- keyring::default_backend(keyring = keyring_service)
+  if (kr$keyring_is_locked(keyring=keyring_service)) {
+    kr$keyring_unlock(keyring = keyring_service)
+  }
+  kr
+}
+
+#' Get key value from keyring.
+#'
+#' @param kr keyring for the script
+#' @param key_name string key name
+#' @param prompt string prompt message
+#' @return string keyring value
+get_keyring_value <- function(kr, key_name, prompt) {
+  logger::log_info("Getting keyring value for {key_name}...")
+  if (!keyring::has_keyring_support()) {
+    logger::log_error("No keyring support!")
+    logger::log_info("Set value for the variable sido_{key_name} in the code.")
+    q()
+  }
+  keyring_service <- kr$keyring_default()
+
+  key_list <- kr$list()
+  match_keys <- subset(key_list,
+                       service == keyring_service & username == key_name)
+  if (dim(match_keys)[1] == 0) {
+    logger::log_info("No value found for {keyring_service} and {key_name}.")
+    kr$set(service = keyring_service, username = key_name, prompt = prompt)
+  }
+  kr$get(service = keyring_service, username = key_name)
+}
+
+#' Get access token using client credentials.
+#'
+#' @param sido_url string root URL of SIDO WS
+#' @param sido_client_id string OAuth2 client ID for SIDO
+#' @param sido_client_secret string OAuth2 client secret for SIDO
+#' @return access token
+get_access_token <- function(sido_url, sido_client_id, sido_client_secret) {
+  logger::log_info("Getting access token...")
+  token_url <- paste0(sido_url, "/oauth/token")
+  # Perform the POST request
+  post_data <- paste0(
+                      "client_id=", sido_client_id,
+                      "&client_secret=", sido_client_secret,
+                      "&grant_type=client_credentials")
+  headers <- c("Content-Type" = "application/x-www-form-urlencoded")
+  opts <- list(postfields = post_data, httpheader = headers)
+  logger::log_info("Calling {token_url}...")
+  post_response <- RCurl::postForm(token_url, .opts = opts)
+  logger::log_info("Parsing JSON...")
+  token <- jsonlite::fromJSON(post_response)
+  token$access_token
+}
+
+#' Get queries for a given schema.
+#'
+#' @param sido_url string root URL of SIDO WS
+#' @param schema string schema name
+#' @param access_token string access token
+#' @return queries list of query names
+get_queries <- function(sido_url, schema, access_token) {
+  logger::log_info("Getting queries...")
+  queries_url <- paste0(sido_url, "/data/queries/", schema)
+  headers <- c("Authorization" = paste0("Bearer ", access_token))
+  queries_response <- RCurl::getURL(queries_url,
+                                    .opts = list(httpheader = headers))
+  queries <- jsonlite::fromJSON(queries_response)
+  queries$data[, "name"]
+}
+
+#' Get data for a given schema and query.
+#'
+#' @param sido_url string root URL of SIDO WS
+#' @param schema string schema name
+#' @param query string query name
+#' @param access_token string access token
+#' @return data data frame
+get_data <- function(sido_url, schema, query, access_token) {
+  logger::log_info("- Getting data for {schema}/{query}...")
+  data_url <- paste0(sido_url, "/data/", schema, "/", query)
+  headers <- c("Authorization" = paste0("Bearer ", access_token))
+  data_response <- RCurl::getURL(data_url,
+                                 .opts = list(httpheader = headers),
+                                 .encoding = "UTF-8")
+  data <- jsonlite::fromJSON(data_response)
+  if (data$status != 200) {
+    logger::log_error(paste0("  Error ", data$status, ": ", data$message))
+  }
+  df <- data.frame(data$data$values)
+  names(df) <- data$data$properties$title
+  df
+}
+
+# Run
+
+kr <- get_keyring(keyring_service)
+sido_client_id <- get_keyring_value(kr, "client_id",
+                                    "Type your client_id for SIDO")
+sido_client_secret <- get_keyring_value(kr, "client_secret",
+                                        "Type your client_secret for SIDO")
+
+token <- get_access_token(sido_ws_url, sido_client_id, sido_client_secret)
+queries <- get_queries(sido_ws_url, observatory_schema, token)
+logger::log_info("- nb of queries: {0}", length(queries))
+for (i in seq_along(queries)) {
+  query = queries[i]
+  logger::log_info("- query: {query}")
+  if (query == "data") {
+    logger::log_info("  - skipping data query")
+  } else {
+    data <- get_data(sido_ws_url, observatory_schema, query, token)
+    filename <- paste0(observatory_schema, "-", query, ".csv")
+    logger::log_info("  - file: {filename}...")
+    write.table(data,
+                file = filename,
+                col.names = TRUE,
+                row.names = FALSE,
+                sep = ",",
+                quote = TRUE)
+    logger::log_info("    done")
+  }
+}