From a5ade9b7e7dd67be003e10cc5b8b08e58d1014eb Mon Sep 17 00:00:00 2001
From: Juliette Engelaere-Lefebvre
<juliette.engelaere@developpement-durable.gouv.fr>
Date: Tue, 14 Jun 2022 12:49:39 +0200
Subject: [PATCH] =?UTF-8?q?bug=5Ffix=20:=20parametrage=20de=20la=20fonctio?=
=?UTF-8?q?n=20poster=5Fdata()=20selon=20le=20nom=20de=20la=20colonne=20ge?=
=?UTF-8?q?om=C3=A9trique?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
---
DESCRIPTION | 4 ++--
NEWS.md | 6 +++++-
R/post_data.R | 28 +++++++++++++++++-----------
3 files changed, 24 insertions(+), 14 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index 7c0e3b1..2f208d4 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
Package: datalibaba
-Title: Interface De Connexion a Une Base Posgres
-Version: 0.0.0.9000
+Title: Interface De Connexion a Une Base Posgres Postgis
+Version: 0.0.0.9001
Authors@R:
c(person(given = "Maël",
family = "Theulière",
diff --git a/NEWS.md b/NEWS.md
index 86dc5b0..927e549 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,3 +1,7 @@
+# datalibaba 0.0.0.9001
+- Correction d'un bug dans la fonction `poster_data()` : paramétrage des contraintes géo selon le nom de la colonne géo. (auparavant utilisation de 'geometry' pour toutes les tables, ce qui provoquait des plantages).
+- Ajout de message pour le post de datatset geo afin d'identifier quelle étape est en cours.
+
# datalibaba 0.0.0.9000
- ajout de la fonction `check_server_renviron()` qui vérifie si les variables système sont bien activées via .Renviron.
@@ -8,7 +12,7 @@
- ajout des fonctions `post_data()`, `post_data_dbi()`, `poster_data()` : Versement d'un dataset sur le serveur.
- ajout des fonctions `get_data()`, `get_data_dbi()`, `importer_data()` : Import d'un dataset du serveur.
- ajout des fonctions `commenter_table()`, `commenter_schema()`, `commenter_champs()` et `post_dico_attr()` : Rédaction de commentaires descriptifs sur les schémas et les tables du serveur de données.
-- ajout des fonctions `get_table_comments()` et `transferer_table_comment()` : qui récupérent et transfèrent les commentaires descriptifs d'une table du serveur de données à une autre.
+- ajout des fonctions `get_table_comments()` et `transferer_table_comment()` : qui récupèrent et transfèrent les commentaires descriptifs d'une table du serveur de données à une autre.
- ajout de la fonction `exporter_table_comments()` qui récupère le descriptif d'une table SGBD (commentaire de table et commentaires de champs) et les exporte dans un tableur csv.
- ajout fonction `set_schema_rights()` qui affecte à une table les droits de lecture/écriture de son schéma.
diff --git a/R/post_data.R b/R/post_data.R
index 6af0c12..34fd1c4 100644
--- a/R/post_data.R
+++ b/R/post_data.R
@@ -200,10 +200,10 @@ poster_data <- function(data = NULL,
paste(noms_r, collapse = ","), "}}")
defs2 <- data.frame(table_nm = table, df_def = defs)
- suppressMessages({
+ 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),
@@ -223,26 +223,31 @@ poster_data <- function(data = NULL,
## Ecriture de la table : un comportement different pour les donnees spatiales et les autres dataframes------
if( any(grepl("sf", class(d))) ) {
- attempt::warn_if(attributes(d)$sf_column != names(d)[ncol(d)],
+ nom_col_geo <- attributes(d)$sf_column
+ attempt::warn_if(nom_col_geo != names(d)[ncol(d)],
msg = "La colonne geo n'est pas en fin de dataset, c'est une mauvaise pratique.")
sf::st_write(obj = d, dsn = con, delete_layer = overwrite, layer = c(schema = schema, table = table))
+ message(paste0('Table ', table,' ecrite sur le serveur avec sf::st_write(). '))
# Ajout contrainte forcage crs ouverture couche
crs <- sf::st_crs(x = d, parameters = TRUE)$epsg
crs <- ifelse(is.null(crs), 2154, crs)
- sql_query_crs <- paste0("ALTER TABLE ", schema, ".", table ," ADD CONSTRAINT enforce_srid_geom CHECK (st_srid(geometry) = ", crs, ");")
+ sql_query_crs <- paste0("ALTER TABLE ", schema, ".", table ," ADD CONSTRAINT enforce_srid_geom CHECK (st_srid(", nom_col_geo, ") = ", crs, ");")
DBI::dbExecute(conn = con, sql_query_crs)
+ message(paste0("Ajout de la contrainte du CRS d'ouverture : ", crs, "."))
# Ajout contrainte nombre de dimension
# if(chek_dim) {
- dim <- max(unique(sf::st_dimension(d, NA_if_empty = TRUE)), 2, na.rm = TRUE)
- sql_query_dim <- paste0("ALTER TABLE ", schema, ".", table ," ADD CONSTRAINT enforce_dims_geom CHECK (st_ndims(geometry) = ", dim, ");")
- DBI::dbExecute(conn = con, sql_query_dim)
- # }
+ dim <- max(unique(sf::st_dimension(d, NA_if_empty = TRUE)), 2, na.rm = TRUE)
+ sql_query_dim <- paste0("ALTER TABLE ", schema, ".", table ," ADD CONSTRAINT enforce_dims_geom CHECK (st_ndims(", nom_col_geo, ") = ", dim, ");")
+ DBI::dbExecute(conn = con, sql_query_dim)
+ message(paste0("Ajout de la contrainte du nombre de dimension : ", dim, "."))
+
+ # }
# Ajout index geo
nom_champ_geo <-
- rpostgis::dbIndex(conn = con, name = c(schema, table), colname = attributes(d)$sf_column,
- idxname = paste0("gix_", table), unique = FALSE, method = "gist",
- display = FALSE, exec = TRUE)
+ rpostgis::dbIndex(conn = con, name = c(schema, table), colname = attributes(d)$sf_column,
+ idxname = paste0("gix_", table), unique = FALSE, method = "gist",
+ display = FALSE, exec = TRUE)
mess <- "spatial "
mess2 <- paste0(" - index spatial declar\u00e9 sur '", attributes(d)$sf_column, "'")
} else {
@@ -276,6 +281,7 @@ poster_data <- function(data = NULL,
return(invisible(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")
--
GitLab