bug_fix : parametrage de la fonction poster_data() selon le nom de la colonne geométrique

DESCRIPTION

 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",

NEWS.md

+# 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.
 

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")