diff --git a/.Renviron b/.Renviron deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/DESCRIPTION b/DESCRIPTION index fc4750b17b1f26ccc779add25932092d3ebd3c3a..81986661d0207044875675b8604ca25a71bf0349 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: datalibaba Title: Interface De Connexion a Une Base Posgres Postgis -Version: 0.0.0.9003 +Version: 0.0.0.9004 Authors@R: c(person(given = "Maël", family = "Theulière", @@ -32,14 +32,14 @@ Imports: magrittr, tibble, units, - tidyr, - gtools + tidyr +Suggests: + knitr, + rmarkdown, + RPostgres Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) -URL: https://dreal-datalab.gitlab.io/datalibaba/index.html, https://gitlab.com/dreal-datalab/datalibaba -RoxygenNote: 7.1.2 -Suggests: - knitr, - rmarkdown +URL: https://dreal-pdl.gitlab-pages.din.developpement-durable.gouv.fr/csd/datalibaba/index.html, https://gitlab-forge.din.developpement-durable.gouv.fr/dreal-pdl/csd/datalibaba +RoxygenNote: 7.2.3 VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index 2c5fe8a8d003cc1877a016b4b52b85fcfc659f93..c863c61df022ab006574697fea9bc933742381d9 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -61,7 +61,6 @@ importFrom(fs,path) importFrom(fs,path_expand) importFrom(fs,path_home_r) importFrom(glue,glue) -importFrom(gtools,ASCIIfy) importFrom(magrittr,"%>%") importFrom(odbc,odbc) importFrom(purrr,map) diff --git a/NEWS.md b/NEWS.md index 4640dd70e8833e0dcf77b0abf44c9003e5046938..2064263cba270a74238e416530483b771e713061 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,6 @@ +# datalibaba 0.0.0.9004 +- Meilleure gestion des facteurs ( encodage + échappement du caractère spécial " dans les levels) + # datalibaba 0.0.0.9003 - Correction d'un bug dans `poster_data()`, la fonction plantait si les modalités d'un facteur contenaient des caractères spéciaux. - Amélioration de la documentation sur la configuration du .Renviron. diff --git a/R/connect_to_db.R b/R/connect_to_db.R index 5f5d9658ba59b0c254825bfa1cc9ac9ae1b46af0..04f03fc43ec2a68fccdd7c4861ae3688d566809b 100644 --- a/R/connect_to_db.R +++ b/R/connect_to_db.R @@ -1,11 +1,11 @@ #' Connexion au serveur datamart #' #' @param db la database sur laquelle se connecter -#' @param user le profil utilisateur avec lequel se connecter : does ou dreal +#' @param user le profil utilisateur avec lequel se connecter : does ou dreal, suffixe utilise pour les variable d'environnement #' @param user_id le nom utilisateur avec lequel se connecter tel que renseigné dans votre renviron #' @param user_pwd le mot de passe avec lequel se connecter tel que renseigné dans votre renviron #' @param server l'adresse ip du serveur, laisser à NULL pour utiliser le variable d'environnement du .Renviron -#' @return La fonction créé un connecteur pour se connecter à la base posgresql du serveur via le driver "PostgreSQL". +#' @return La fonction cree un connecteur pour se connecter à la base posgresql du serveur via le driver DBI "PostgreSQL". #' @importFrom DBI dbDriver dbConnect #' @importFrom odbc odbc #' @importFrom glue glue @@ -15,10 +15,10 @@ #' \dontrun{ #' connect_to_db() #' } -connect_to_db <- function(db="datamart", - user="does", - user_id=paste0("user_",user), - user_pwd = paste0("pwd_",user), +connect_to_db <- function(db = "datamart", + user = "does", + user_id = paste0("user_", user), + user_pwd = paste0("pwd_", user), server = NULL){ drv <- DBI::dbDriver("PostgreSQL") @@ -32,6 +32,7 @@ connect_to_db <- function(db="datamart", user=Sys.getenv(user_id), password=Sys.getenv(user_pwd) ) + return(con) } @@ -70,6 +71,9 @@ connect_to_dbi <- function(db="datamart", .connection_string = , timeout = 10, encoding = "UTF-8") - DBI::dbSendQuery(con,"SET client_encoding TO 'windows-1252'") + # if(.Platform$OS.type == "windows") { + # DBI::dbSendQuery(con,"SET client_encoding TO \'windows-1252\'") + # } + return(con) } diff --git a/R/get_data.R b/R/get_data.R index a9279ff4ea4768ab93d58d47d3bcd51a76b804e1..b4fca0d6add6913bd08b1356163e1ad7fb75c630 100644 --- a/R/get_data.R +++ b/R/get_data.R @@ -16,7 +16,7 @@ get_data <- function(con = NULL, attempt::stop_if(con, is.null, msg = "con n'est pas renseign\u00e9") attempt::stop_if(schema, is.null, msg = "schema n'est pas renseign\u00e9") attempt::stop_if(table, is.null, msg = "table n'est pas renseign\u00e9") - RPostgreSQL::postgresqlpqExec(con, "SET client_encoding = 'windows-1252'") + data <- DBI::dbReadTable(con, c(schema,table)) return(data) } @@ -41,7 +41,6 @@ get_data_dbi <- function(con = NULL, attempt::stop_if(con, is.null, msg = "con n'est pas renseign\u00e9") attempt::stop_if(schema, is.null, msg = "schema n'est pas renseign\u00e9") attempt::stop_if(table, is.null, msg = "table n'est pas renseign\u00e9") - DBI::dbSendQuery(con,"SET client_encoding TO 'windows-1252'") tbl <- DBI::Id(schema = schema, table = table) data <- DBI::dbReadTable(con, tbl) return(data) @@ -60,6 +59,7 @@ get_data_dbi <- function(con = NULL, #' @importFrom attempt stop_if stop_if_not #' @importFrom DBI dbExistsTable dbReadTable dbDisconnect #' @importFrom dplyr filter arrange select all_of relocate rename_with +#' @importFrom glue glue #' @importFrom rlang .data #' @importFrom rpostgis dbTableInfo #' @importFrom sf st_read st_drop_geometry st_geometry @@ -146,9 +146,14 @@ importer_data <- function(table = NULL, schema = NULL, db = "public", server = ## (add new below) handle factors if (att$defs %in% c("factor", "ordered")) { levs <- unlist(strsplit(att$atts, "/*/", fixed = TRUE)) - ordered <- ifelse(att$defs == "ordered", TRUE, - FALSE) - data[, i] <- factor(as.character(data[, i]), levels = levs[levs != ""], ordered = ordered) + ordered <- ifelse(att$defs == "ordered", TRUE, FALSE) + # une précaution pour s'assurer que les levels ne presentent pas d'anomalie d'encodage ou autre par rapport au donnees chargees + if(all(data[, i] %in% c(levs, NA, ""))) { + data[, i] <- factor(as.character(data[, i]), levels = levs[levs != ""], ordered = ordered) + } else { + message(glue::glue("Les levels du facteur {{i}} sont incompatibles avec les donnees en base, cette variable est importee avec le type character")) + } + } ## handle POSIX time zones if (att$defs %in% c("POSIXct", "POSIXt")) { @@ -197,4 +202,8 @@ importer_data <- function(table = NULL, schema = NULL, db = "public", server = # ecln_cogifie2 <- importer_data(table = "test_ecln_cog", schema = "public", db = "public", server = "localhost", user = "does") # iris2 <- importer_data(table = "test_iris", schema = "public", db = "public", server = "localhost", user = "does") # pk = NULL, post_row_name = TRUE, overwrite = TRUE +# all(iris == iris2) # dep_geo <- importer_data(table = "test_dep", schema = "public", db = "public", server = "localhost", user = "does") # pk = "DEP", post_row_name = FALSE, overwrite = TRUE +# test_epci <- COGiter::epci %>% dplyr::select(-ends_with("DE_L_EPCI")) %>% dplyr::slice(1:270) %>% dplyr::mutate_if(is.factor, forcats::fct_drop) +# epci_test <- importer_data(table = "test_epci", schema = "public", db = "datamart", user = "does") +# all(epci_test == test_epci) diff --git a/R/post_data.R b/R/post_data.R index 3758fc07da787df4d54927720ab76cc14b930336..26d4c3390afe111313f2d4e544aab9fa8dc61a79 100644 --- a/R/post_data.R +++ b/R/post_data.R @@ -42,7 +42,6 @@ post_data <- function(con, #' @param overwrite TRUE si on veut ecraser le fichier deja present. #' @importFrom attempt stop_if stop_if_not #' @importFrom DBI dbWriteTable Id dbSendQuery -#' @importFrom gtools ASCIIfy #' @importFrom glue glue #' #' @return NULL, la fonction lance le chargement du dataset present dans l'environnement R et son ecriture sur le serveur @@ -62,7 +61,6 @@ post_data_dbi <- function(con = NULL, attempt::stop_if(table, is.null, msg = "table n\'est pas renseign\u00e9") attempt::stop_if_not(schema, ~ .x %in% list_schemas(con), msg = glue::glue("le schema {schema} n\'existe pas")) attempt::stop_if(table %in% list_tables(con,schema) & !overwrite, msg = glue::glue("La table {table} existe d\u00e9j\u00e0 sur le schema {schema} et le param\u00e8 tre overwrite est \u00e0 FALSE")) - DBI::dbSendQuery(con,"SET client_encoding TO \'windows-1252\'") tbl <- DBI::Id(schema = schema, table = table) DBI::dbWriteTable(con, tbl, data, overwrite = overwrite ) return(invisible(NULL)) @@ -186,11 +184,17 @@ poster_data <- function(data = NULL, } ### Gerer les facteurs + + # precaution d'encodage des variables de type texte ou categorielles--------------- + d <- dplyr::mutate(d, dplyr::across(tidyselect::vars_select_helpers$where(is.character), enc2utf8), + dplyr::across(tidyselect::vars_select_helpers$where(is.factor), ~ forcats::fct_relabel(.x, enc2utf8))) + fact <- unlist(lapply(d[1, ], function(x) { paste0("/*/", paste(attr(x, "levels"), collapse = "/*/"), "/*/") })) fact <- gsub(",", "\\,", fact, fixed = TRUE) + fact <- gsub('"', '\\"', fact, fixed = TRUE) attr2[!fact == "/*//*/"] <- fact[!fact == "/*//*/"] ### fin factor @@ -200,15 +204,12 @@ poster_data <- function(data = NULL, paste(as.character(attr2), collapse = ","), "},{", paste(noms_r, collapse = ","), "}}") - defs2 <- data.frame(table_nm = table, df_def = gtools::ASCIIfy(defs)) + defs2 <- data.frame(table_nm = table, df_def = enc2native(defs)) suppressWarnings(suppressMessages({ rpostgis::pgInsert(con, c(schema, "zz_r_df_def"), defs2, upsert.using = "table_nm", row.names = FALSE) })) - # precaution d'encodage des variables de type texte ou categorielles--------------- - d <- dplyr::mutate(d, dplyr::across(tidyselect::vars_select_helpers$where(is.character), enc2utf8), - dplyr::across(tidyselect::vars_select_helpers$where(is.factor), ~ forcats::fct_relabel(.x, enc2utf8))) # nom des variables de la cle primaire--------- if(is.null(pk)) { @@ -282,10 +283,13 @@ poster_data <- function(data = NULL, } -# + # poster_data(data = ecln_cogifie, table = "test_ecln_cog", schema = "public", db = "public", server = "localhost", # pk = c("TypeZone", "CodeZone", "date"), post_row_name = FALSE, overwrite = TRUE, user = "does") # poster_data(data = iris, table = "test_iris", schema = "public", db = "public", server = "localhost", # pk = NULL, post_row_name = TRUE, overwrite = TRUE, user = "does") # poster_data(data = COGiter::departements_geo, table = "test_dep", schema = "public", db = "public", server = "localhost", # pk = "DEP", post_row_name = FALSE, overwrite = TRUE, user = "does") +# poster_data(data = COGiter::epci %>% dplyr::select(-ends_with("DE_L_EPCI")) %>% dplyr::slice(1:270) %>% dplyr::mutate_if(is.factor, forcats::fct_drop), +# table = "test_epci", schema = "public", +# db = "datamart", pk = "EPCI", post_row_name = FALSE, overwrite = TRUE, user = "does") diff --git a/man/connect_to_db.Rd b/man/connect_to_db.Rd index 927570d4f5639744188ea5f565d2493475e38c6d..e4933e6b9556f0e833b0430385ca8d883e96e8d1 100644 --- a/man/connect_to_db.Rd +++ b/man/connect_to_db.Rd @@ -15,7 +15,7 @@ connect_to_db( \arguments{ \item{db}{la database sur laquelle se connecter} -\item{user}{le profil utilisateur avec lequel se connecter : does ou dreal} +\item{user}{le profil utilisateur avec lequel se connecter : does ou dreal, suffixe utilise pour les variable d'environnement} \item{user_id}{le nom utilisateur avec lequel se connecter tel que renseigné dans votre renviron} @@ -24,7 +24,7 @@ connect_to_db( \item{server}{l'adresse ip du serveur, laisser à NULL pour utiliser le variable d'environnement du .Renviron} } \value{ -La fonction créé un connecteur pour se connecter à la base posgresql du serveur via le driver "PostgreSQL". +La fonction cree un connecteur pour se connecter à la base posgresql du serveur via le driver DBI "PostgreSQL". } \description{ Connexion au serveur datamart