Adaptation de la fonction post_data_pg, en erreur sur le jeu de données ECLN cogifié

DESCRIPTION

@@ -17,6 +17,8 @@ Imports:
     attempt,
     crayon,
     DBI,
+    dplyr,
+    forcats,
     fs,
     glue,
     odbc,
@@ -24,6 +26,7 @@ Imports:
     rpostgis,
     RPostgreSQL,
     sf,
+    tidyselect,
     usethis
 Encoding: UTF-8
 LazyData: true

NAMESPACE

@@ -26,11 +26,16 @@ importFrom(DBI,dbSendQuery)
 importFrom(DBI,dbWriteTable)
 importFrom(RPostgreSQL,postgresqlpqExec)
 importFrom(attempt,message_if)
+importFrom(attempt,message_if_none)
 importFrom(attempt,stop_if)
+importFrom(attempt,stop_if_all)
 importFrom(attempt,stop_if_not)
 importFrom(attempt,warn_if_not)
 importFrom(crayon,bgCyan)
 importFrom(crayon,bold)
+importFrom(dplyr,across)
+importFrom(dplyr,mutate)
+importFrom(forcats,fct_relabel)
 importFrom(fs,path)
 importFrom(fs,path_expand)
 importFrom(fs,path_home_r)
@@ -44,6 +49,7 @@ importFrom(rpostgis,dbTableInfo)
 importFrom(rpostgis,dbWriteDataFrame)
 importFrom(sf,st_read)
 importFrom(sf,st_write)
+importFrom(tidyselect,vars_select_helpers)
 importFrom(usethis,proj_get)
 importFrom(usethis,ui_done)
 importFrom(usethis,ui_info)

R/list_tables.R

 #' Lister les tables sur un schéma d'un connecteur.
 #'
-#' @param con Le connecteur de classe PosgreSQLConnection.
+#' @param con Le connecteur de classe PosgreSQLConnection, peut etre NULL si db et user sont tous deux renseignes, sera utilise par defaut si les 3 arguments renseigne.
+#' @param db Le nom de la base de donnees a laquelle se connecter pour trouver le schema, si con n'est pas renseigne.
+#' @param user Le nom de l'utilisateur de la connexion au serveur de donnees, si con n'est pas renseigne.
 #' @param schema Le nom du schéma sur le serveur de données.
 #' @return Un vecteur de caractères avec les tables présentes sur le schéma schema du connecteur con.
-#' @importFrom attempt stop_if stop_if_not
-#' @importFrom DBI dbGetQuery
+#' @importFrom attempt stop_if_all message_if_none stop_if stop_if_not
+#' @importFrom DBI dbGetQuery dbDisconnect
 #' @importFrom glue glue
 #' @export
-list_tables <- function(con,schema) {
-  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_not(schema, ~ .x %in% list_schemas(con), msg = glue::glue("{schema} n'existe pas"))
-  all_tables <- DBI::dbGetQuery(conn = con,
+#'
+#' @examples
+#' \dontrun{
+#' list_tables(con = con, schema = "conjoncture")
+#' list_tables(schema = "conjoncture", db = "datamart", user = "does")
+#' }
+list_tables <- function(con = NULL, schema = NULL, db = NULL, user = NULL) {
+  connexion <- con
+  attempt::stop_if_all(c(connexion, db, user), is.null, msg = "con, db et user ne sont pas renseign\u00e9s, merci de fournir les arguments necessaires a la connexion (soit con, soit db + user). ")
+  attempt::stop_if_all(c(connexion, db), is.null, msg = "con et db ne sont pas renseign\u00e9s, merci de fournir les arguments necessaires a la connexion (soit con, soit db + user). ")
+  attempt::stop_if_all(c(connexion, user), is.null, msg = "con et user ne sont pas renseign\u00e9s, merci de fournir les arguments necessaires a la connexion (soit con, soit db + user). ")
+  attempt::stop_if(schema, is.null, msg = "schema n'est pas renseign\u00e9. ")
+  # attempt::message_if_none(c(connexion, db, user), is.null, msg = "con, db et user sont tous renseign\u00e9s, seul con sera utilise pour la connexion. ")
+
+  con_a_creer_fermer <- FALSE # initialisation
+  if(is.null(connexion)) {
+    con_a_creer_fermer <- TRUE
+    connexion <- connect_to_db(db, user)
+  }
+
+  attempt::stop_if_not(schema, ~ .x %in% list_schemas(connexion), msg = glue::glue("{schema} n'existe pas. "))
+
+  all_tables <- DBI::dbGetQuery(conn = connexion,
                                 statement = glue::glue("SELECT table_name FROM information_schema.tables
                    WHERE table_schema='{schema}'"))
+
+  if(con_a_creer_fermer) {
+    DBI::dbDisconnect(connexion)
+  }
+
   return(all_tables$table_name)
+
 }
 
+

R/post_data.R

@@ -48,10 +48,10 @@ post_data <- function(con,
 #'
 
 post_data_dbi <- function(con = NULL,
-                      data = NULL,
-                      schema = NULL,
-                      table = NULL,
-                      overwrite = FALSE) {
+                          data = NULL,
+                          schema = NULL,
+                          table = NULL,
+                          overwrite = FALSE) {
   attempt::stop_if(con, is.null, msg = "con n\'est pas renseign\u00e9")
   attempt::stop_if_not(deparse(substitute(con)), exists, msg = glue::glue("le connecteur {con} n\'existe pas"))
   attempt::stop_if(data, is.null, msg = "data n\'est pas renseign\u00e9")
@@ -75,11 +75,15 @@ post_data_dbi <- function(con = NULL,
 #' @param db La base sur laquelle se connecter.
 #' @param user Le nom d'utilisateur pour se connecter au SGBD.
 #' @param overwrite TRUE si on veut ecraser le fichier deja present.
+#' @param encod_client l'identifiant de l'encodage utilise par l'utilisateur, fixe a "windows-1252" par defaut, qui correspond a un RStudio sur windows
 #' @importFrom attempt stop_if stop_if_not warn_if_not
-#' @importFrom DBI Id dbDisconnect
+#' @importFrom DBI Id dbDisconnect dbWriteTable dbSendQuery
+#' @importFrom dplyr mutate across
+#' @importFrom forcats fct_relabel
 #' @importFrom glue glue
 #' @importFrom rpostgis dbSchema dbWriteDataFrame
 #' @importFrom sf st_write
+#' @importFrom tidyselect vars_select_helpers
 #'
 #' @return NULL, la fonction verse le dataset de l'environnement R sur le serveur de donnees.
 #' @export
@@ -94,10 +98,12 @@ post_data_pg <- function(data = NULL,
                          schema = NULL,
                          db = "production",
                          user = "does",
-                         overwrite = FALSE) {
+                         overwrite = FALSE,
+                         encod_client = "windows-1252") {
 
   # ouverture de la connexion avec DBI::dbDriver("PostgreSQL")
-  con <- connect_to_db(db, user)
+  .con <- connect_to_db(db, user)
+  DBI::dbSendQuery(.con, paste0("SET client_encoding TO \'", encod_client, "\';"))
 
   # verification de la validite des arguments
   attempt::stop_if(data, is.null, msg = "data n\'est pas renseign\u00e9")
@@ -105,23 +111,26 @@ post_data_pg <- function(data = NULL,
   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")
 
-  rpostgis::dbSchema(conn = con, name = schema, display = FALSE, exec = TRUE) # creation du schema au besoin
-  attempt::warn_if_not(schema, ~ .x %in% list_schemas(con), msg = glue::glue("le schema {schema} n\'existe pas. Il va \u00eatre cr\u00e9\u00e9 sous {db}."))
-  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\u00e8tre overwrite est \u00e0 FALSE"))
+  rpostgis::dbSchema(conn = .con, name = schema, display = FALSE, exec = TRUE) # creation du schema au besoin
+  attempt::warn_if_not(schema, ~ .x %in% list_schemas(.con), msg = glue::glue("le schema {schema} n\'existe pas. Il va \u00eatre cr\u00e9\u00e9 sous {db}."))
+  attempt::stop_if(table %in% list_tables(con = .con, schema = schema, db = NULL, user = NULL) & !overwrite, msg = glue::glue("La table {table} existe d\u00e9j\u00e0 sur le schema {schema} et le param\u00e8tre overwrite est \u00e0 FALSE"))
+
+  # precaution d'encodage des variables de types texte ou categorielles
+  data <- dplyr::mutate(data, dplyr::across(tidyselect::vars_select_helpers$where(is.character), enc2utf8),
+                              dplyr::across(tidyselect::vars_select_helpers$where(is.factor), ~ forcats::fct_relabel(.x, enc2utf8)))
 
-    # un comportement different pour les donnees spatiales et les autres dataframes
+  # un comportement different pour les donnees spatiales et les autres dataframes
   if( any(grepl("sf", class(data))) ) {
-    sf::st_write(obj = data, dsn = con, delete_layer = overwrite,
-             DBI::Id(schema = schema, table = table))
+    sf::st_write(obj = data, dsn = .con, delete_layer = overwrite, c(schema = schema, table = table))
     } else {
-      rpostgis::dbWriteDataFrame(conn = con, name = c(schema, table), df = data, overwrite = overwrite)
-    }
+      rpostgis::dbWriteDataFrame(conn = .con, name = c(schema, table), df = data, overwrite = overwrite)
+      }
 
   # ajout de metadonnees basiques en commentaires de la table
   meta <- enc2utf8(paste0("\nTable post\u00e9e le ", format(Sys.Date(), '%d/%m/%Y'), ", par ", Sys.getenv("USERNAME"), "."))
-  rpostgis::dbComment(conn = con, name = c(schema, table), comment = meta, type = "table", exec = TRUE)
+  rpostgis::dbComment(conn = .con, name = c(schema, table), comment = meta, type = "table", exec = TRUE)
 
-  DBI::dbDisconnect(con)
+  DBI::dbDisconnect(.con)
 
   return(invisible(NULL))
 

dev_history.R

@@ -20,6 +20,7 @@ usethis::use_r("commenter_table.R")
 usethis::use_r("commenter_champs.R")
 usethis::use_pkgdown()
 
+
 attachment::att_amend_desc()
 devtools::document()
 devtools::check()

man/list_tables.Rd

@@ -4,12 +4,16 @@
 \alias{list_tables}
 \title{Lister les tables sur un schéma d'un connecteur.}
 \usage{
-list_tables(con, schema)
+list_tables(con = NULL, schema = NULL, db = NULL, user = NULL)
 }
 \arguments{
-\item{con}{Le connecteur de classe PosgreSQLConnection.}
+\item{con}{Le connecteur de classe PosgreSQLConnection, peut etre NULL si db et user sont tous deux renseignes, sera utilise par defaut si les 3 arguments renseigne.}
 
 \item{schema}{Le nom du schéma sur le serveur de données.}
+
+\item{db}{Le nom de la base de donnees a laquelle se connecter pour trouver le schema, si con n'est pas renseigne.}
+
+\item{user}{Le nom de l'utilisateur de la connexion au serveur de donnees, si con n'est pas renseigne.}
 }
 \value{
 Un vecteur de caractères avec les tables présentes sur le schéma schema du connecteur con.
@@ -17,3 +21,9 @@ Un vecteur de caractères avec les tables présentes sur le schéma schema du co
 \description{
 Lister les tables sur un schéma d'un connecteur.
 }
+\examples{
+\dontrun{
+list_tables(con = con, schema = "conjoncture")
+list_tables(schema = "conjoncture", db = "datamart", user = "does")
+}
+}

man/post_data_pg.Rd

@@ -10,7 +10,8 @@ post_data_pg(
   schema = NULL,
   db = "production",
   user = "does",
-  overwrite = FALSE
+  overwrite = FALSE,
+  encod_client = "windows-1252"
 )
 }
 \arguments{
@@ -25,6 +26,8 @@ post_data_pg(
 \item{user}{Le nom d'utilisateur pour se connecter au SGBD.}
 
 \item{overwrite}{TRUE si on veut ecraser le fichier deja present.}
+
+\item{encod_client}{l'identifiant de l'encodage utilise par l'utilisateur, fixe a "windows-1252" par defaut, qui correspond a un RStudio sur windows}
 }
 \value{
 NULL, la fonction verse le dataset de l'environnement R sur le serveur de donnees.