Skip to content
Snippets Groups Projects
Commit f97b62a1 authored by lisasmah's avatar lisasmah
Browse files

#33-deployement branche qui correspond à la version déployée

parent 2136137e
No related branches found
No related tags found
2 merge requests!38Mise à niveau par rapport à la version déployée début octobre,!36Mise à niveau de la branche de dev par rapport à la version déployée sur intranet mi sept
Hide whitespace changes
Inline Side-by-side
global.R
+ 1
− 1
View file @ f97b62a1
......@@ -11,4 +11,4 @@ nom_local <- "datamart_catalogue.RData"
adresse_T <- paste0("T:/datalab/SCTE/CATALOGUE/PRODUCTION/", nom_local)
if(file.exists(adresse_T)) load(file = adresse_T) else load(nom_local)
choix_bases <- setNames(bases_avec_commentaires$base, bases_avec_commentaires$display_name)
liste_bases <- bases_avec_commentaires$base %>% setNames(bases_avec_commentaires$display_name)
server.R
+ 123
− 106
View file @ f97b62a1
server <- function(input, output, session) {
r <- reactiveValues(
base = NULL,
schema = NULL,
table = NULL,
selected_metadata = NULL, # table de metadonnées à afficher
selected_metadata_base = NULL, # table de metadonnées de la base à telécharger
selected_metadata_schema = NULL , # table de metadonnées du schema à télécharger
......@@ -15,68 +12,76 @@ server <- function(input, output, session) {
table_size = NULL
)
observeEvent(input$base, { r$base <- input$base })
observeEvent(input$selected_base, { r$base <- input$selected_base })
observeEvent(input$schema, { r$schema <- input$schema })
observeEvent(input$selected_schema, { r$schema <- input$selected_schema })
observeEvent(input$table, { r$table <- input$table })
observeEvent(input$selected_table, { r$table <- input$selected_table })
# Mise à jour des listes déroulantes des bases avec commentaires au démarrage
observeEvent(TRUE, {
bases_avec_commentaires <- commentaires_base %>%
dplyr::mutate(commentaire = tidyr::replace_na(commentaire, "")) %>%
dplyr::mutate(display_name = paste(base, commentaire, sep = " : "))
updateSelectInput(session, "base", choices = bases_avec_commentaires$display_name, selected = NULL)
})
# Variable réactive pour stocker schemas_pour_base
schemas_pour_base_react <- reactive({
req(r$base)
schemas_pour_base <- db_schema_list %>%
dplyr::filter(base == r$base) %>%
selected_base <- sub(" : .*", "", input$base)
req(selected_base)
db_schema_list %>%
dplyr::filter(base == selected_base) %>%
dplyr::left_join(
commentaires_schema %>% dplyr::mutate(commentaire = tidyr::replace_na(commentaire, "")),
by = c("base", "nom_schema")
) %>%
dplyr::mutate(
commentaire = coalesce(commentaire.x, commentaire.y),
display_name = paste(nom_schema, commentaire, sep = " : ")
) %>%
dplyr::select(nom_schema, display_name)
# Création d'un vecteur de choix nommé
setNames(schemas_pour_base$nom_schema, schemas_pour_base$display_name)
by = c("base", "nom_schema")) %>%
dplyr::select(-commentaire.y) %>%
dplyr::rename(commentaire = commentaire.x) %>%
dplyr::mutate(display_name = paste(nom_schema, commentaire, sep = " : "))
})
observeEvent(r$base, {
req(r$base)
observeEvent(input$base, {
schemas_pour_base <- schemas_pour_base_react()
shiny::updateSelectInput(session, "schema", choices = c("Tous" = "Tous", schemas_pour_base), selected = "Tous")
shiny::updateSelectInput(session, "table", choices = c("Toutes"), selected = "Toutes")
# Vérifiez que schemas_pour_base a des éléments avant de mettre à jour
if(nrow(schemas_pour_base) > 0) {
shiny::updateSelectInput(session, "schema", choices = c("Tous", schemas_pour_base$nom_schema %>% setNames(schemas_pour_base$display_name)),
selected = "Tous")
} else {
shiny::updateSelectInput(session, "schema", choices = c("Tous"), selected = "Tous")
}
})
# Mettre à jour les tables disponibles en fonction de `r$schema`
observeEvent(r$schema, {
req(r$base, r$schema)
if (r$schema == "Tous") {
tables_pour_schema <- character(0)
observeEvent(c(input$base, input$schema), {
selected_base <- sub(" : .*", "", input$base)
selected_schema <- sub(" : .*", "", input$schema)
req(selected_base, selected_schema)
if (selected_schema == "Tous") {
tables_pour_schema <- character(0) # Pas de tables à afficher
} else {
tables_pour_schema <- tb_sch_base %>%
dplyr::filter(base == r$base, nom_schema == r$schema) %>%
dplyr::filter(base == selected_base, nom_schema == selected_schema) %>%
dplyr::pull(table)
}
shiny::updateSelectInput(session, "table", choices = c("Toutes", tables_pour_schema), selected = "Toutes")
if(length(tables_pour_schema) > 0) {
shiny::updateSelectInput(session, "table", choices = c("Toutes", tables_pour_schema), selected = "Toutes")
} else {
shiny::updateSelectInput(session, "table", choices = c("Toutes"), selected = "Toutes")
}
})
# Afficher le tableau selected_metadata uniquement si le bouton est cliqué
observeEvent(input$visualiserMetadata, {
req(r$base, r$schema, input$table)
r$table <- input$table
selected_base <- sub(" : .*", "", input$base)
selected_schema <- sub(" : .*", "", input$schema)
selected_table <- input$table
r$selected_data <- NULL
#r$acces <- FALSE
r$data_csv <- NULL
if (r$table == "Toutes") {
if (r$schema == "Tous") {
req(selected_base, selected_schema, selected_table)
if (selected_table == "Toutes") {
if (selected_schema == "Tous") {
# Cas où "Toutes" est sélectionné pour table et schema
r$selected_metadata_base <- commentaires_schema %>%
dplyr::filter(base == r$base) %>%
dplyr::filter(base == selected_base) %>%
dplyr::select(base, nom_schema, commentaire)
r$selected_metadata <- r$selected_metadata_base %>%
......@@ -85,48 +90,48 @@ server <- function(input, output, session) {
r$fil_ariane <- NULL
r$selected_row100 <- NULL
r$isSpatial <- NULL
r$nom_csv <- paste(r$base, Sys.Date(), "csv", sep = ".")
r$nom_meta_csv <- paste("matadonnées",r$base, Sys.Date(), sep = ".")
r$nom_csv <- paste(selected_base, Sys.Date(), "csv", sep = ".")
r$nom_meta_csv <- paste("matadonnées",selected_base, Sys.Date(), sep = ".")
r$data_csv <- r$selected_metadata_base
#Affichage du commentaire de la base
r$title_metadata <- r$base
r$title_metadata <- selected_base
r$commentaire <- bases_avec_commentaires %>%
filter(base == r$base) %>%
filter(base == selected_base) %>%
pull(commentaire) %>%
unique()
#r$commentaire <- paste("Schémas de la base", r$base)
#r$commentaire <- paste("Schémas de la base", selected_base)
r$table_rows <- NULL
r$table_size <- NULL
} else {
# Cas où une base, un schéma sont sélectionnés et "Toutes" pour les tables
r$selected_metadata_schema <- tables_catalog %>%
dplyr::filter(base == r$base, nom_schema == r$schema) %>%
dplyr::filter(base == selected_base, nom_schema == selected_schema) %>%
dplyr::group_by(nom_table) %>%
dplyr::slice_tail() %>%
dplyr::select(base, nom_schema, nom_table, commentaire)
r$selected_metadata <- r$selected_metadata_schema %>%
dplyr::select(- c(base,nom_schema))
r$selected_metadata_cmt <- commentaires_schema %>%
dplyr::filter(base == r$base, nom_schema == r$schema) %>%
dplyr::filter(base == selected_base, nom_schema == selected_schema) %>%
dplyr::pull(commentaire)
r$fil_ariane <- tags$nav(
class = "fr-breadcrumb",
class = "fr-breadcrumb__list",
tags$span(id = "base_text", class = "fr-breadcrumb__item", r$base),
tags$span(id = "base_text", class = "fr-breadcrumb__item", selected_base),
tags$span(" > "),
tags$span(id = "schema_text", class = "fr-breadcrumb__item", r$schema)
tags$span(id = "schema_text", class = "fr-breadcrumb__item", selected_schema)
)
r$selected_row100 <- NULL
r$isSpatial <- NULL
r$nom_csv <- paste(r$base, r$schema, Sys.Date(), "csv", sep = ".")
r$nom_meta_csv <- paste("metadonnees", r$base, r$schema, Sys.Date(), sep = ".")
r$nom_csv <- paste(selected_base, selected_schema, Sys.Date(), "csv", sep = ".")
r$nom_meta_csv <- paste("metadonnees", selected_base, selected_schema, Sys.Date(), sep = ".")
r$data_csv <- r$selected_metadata_schema
r$title_metadata <- NULL
#r$title_metadata <- r$schema # Définir title_metadata pour schéma
#r$commentaire <- paste('Tables du schéma "', r$schema, '" de la base "', r$base, '"')
#r$title_metadata <- selected_schema # Définir title_metadata pour schéma
#r$commentaire <- paste('Tables du schéma "', selected_schema, '" de la base "', selected_base, '"')
#Affichage du commentaire du schema
r$commentaire <- commentaires_schema %>%
filter(base == r$base, nom_schema == r$schema) %>%
filter(base == selected_base, nom_schema == selected_schema) %>%
pull(commentaire) %>%
unique()
r$table_rows <- NULL
......@@ -136,7 +141,7 @@ server <- function(input, output, session) {
# Cas où une base, un schéma, et une table sont sélectionnés
r$selected_metadata_0 <- tables_catalog %>%
dplyr::filter(base == r$base, nom_schema == r$schema, nom_table == r$table)
dplyr::filter(base == selected_base, nom_schema == selected_schema, nom_table == selected_table)
# dictionnaire d'attribut
r$selected_metadata <- r$selected_metadata_0 %>%
dplyr::filter(nom_col != "") %>%
......@@ -147,19 +152,19 @@ server <- function(input, output, session) {
dplyr::pull(commentaire)
# Établir la connexion à la base de données
conn <- datalibaba::connect_to_db(
db = r$base,
db = selected_base,
user = r$role
)
# Récupérer le nombre de lignes et la taille de la table
r$table_rows <- dbGetQuery(conn, paste0("SELECT COUNT(*) AS n_rows FROM ", r$schema, ".", r$table))$n_rows
r$table_size <- dbGetQuery(conn, paste0("SELECT pg_size_pretty(pg_relation_size('", r$schema, ".", r$table, "')) AS table_size"))$table_size
r$table_rows <- dbGetQuery(conn, paste0("SELECT COUNT(*) AS n_rows FROM ", selected_schema, ".", selected_table))$n_rows
r$table_size <- dbGetQuery(conn, paste0("SELECT pg_size_pretty(pg_relation_size('", selected_schema, ".", selected_table, "')) AS table_size"))$table_size
# Fermer la connexion par prudence
dbDisconnect(conn)
rm(conn)
# aperçu de la table: gerer les connexions refusées avec un message d'erreur
tryCatch({
r$selected_row100 <- datalibaba::importer_data(table = r$table, schema = r$schema, db = r$base, user = r$role, limit = 30)
r$selected_row100 <- datalibaba::importer_data(table = selected_table, schema = selected_schema, db = selected_base, user = r$role, limit = 30)
}, error = function(e) {
message("Erreur lors de la récupération des données de la table : ", e$message)
r$selected_row100 <- NULL
......@@ -169,17 +174,17 @@ server <- function(input, output, session) {
r$fil_ariane <- tags$nav(
class = "fr-breadcrumb",
class = "fr-breadcrumb__list",
tags$span(id = "base_text", class = "fr-breadcrumb__item", r$base),
tags$span(id = "base_text", class = "fr-breadcrumb__item", selected_base),
tags$span(" > "),
tags$span(id = "schema_text", class = "fr-breadcrumb__item", r$schema),
tags$span(id = "schema_text", class = "fr-breadcrumb__item", selected_schema),
tags$span(" > "),
tags$span(id = "table_text", class = "fr-breadcrumb__item", r$table)
tags$span(id = "table_text", class = "fr-breadcrumb__item", selected_table)
)
r$nom_csv <- paste(r$base, r$schema, r$table, Sys.Date(), sep = ".")
r$nom_meta_csv <- paste("metadonnées", r$base, r$schema, r$table, Sys.Date(), sep = ".")
r$nom_csv <- paste(selected_base, selected_schema, selected_table, Sys.Date(), sep = ".")
r$nom_meta_csv <- paste("metadonnées", selected_base, selected_schema, selected_table, Sys.Date(), sep = ".")
r$data_csv <- r$selected_metadata
r$title_metadata <- NULL
#r$title_metadata <- r$table # Définir title_metadata pour table
#r$title_metadata <- selected_table # Définir title_metadata pour table
r$commentaire <- r$selected_metadata_cmt
}
})
......@@ -334,22 +339,25 @@ server <- function(input, output, session) {
contentType = "text/csv"
)
# Recherche plein texte -------------------------------------
# Recherche plein texte-------------------------------------
# Événement lors du clic sur le bouton de recherche
observeEvent(input$search_button, {
# Fonction réactive pour filtrer les résultats de recherche
filtered_data <- reactive({
if (is.null(input$search_784_input) || input$search_784_input == '') {
return(NULL)
}
search_results <- base_recherche_txt %>%
dplyr::filter(grepl(input$search_784_input, description, ignore.case = TRUE)) %>%
dplyr::select(base, nom_schema, nom_table)
if (nrow(search_results) > 0) {
search_results <- search_results %>%
dplyr::left_join(tables_catalog %>% dplyr::select(base, nom_schema, nom_table, commentaire),
by = c("base", "nom_schema", "nom_table")) %>%
left_join(tables_catalog %>% dplyr::select(base, nom_schema, nom_table, commentaire),
by = c("base", "nom_schema", "nom_table")) %>%
dplyr::rename(Libellé = commentaire) %>%
dplyr::distinct()
dplyr::distinct() # Éliminer les doublons
}
search_results %>%
dplyr::mutate(
......@@ -369,7 +377,9 @@ server <- function(input, output, session) {
results <- filtered_data()
if (is.null(results) || nrow(results) == 0) {
tagList(
p("Aucun lot de données ne correspond à votre recherche, veuillez renouveler votre recherche ou explorer les bases de données disponibles (2e onglet)")
p(
"Aucun lot de données ne correspond à votre recherche, veuillez renouveler votre recherche ou explorer les bases de données disponibles (2e onglet)",
)
)
} else {
NULL
......@@ -377,17 +387,27 @@ server <- function(input, output, session) {
})
})
# Réagir à la sélection d'une base depuis les résultats de recherche
# Réagir à la sélection d'une base
observeEvent(input$selected_base, {
req(input$selected_base)
r$base <- input$selected_base
selected_base <- input$selected_base
req(selected_base)
schemas_pour_base <- schemas_pour_base_react()
shiny::updateSelectInput(session, "base", choices = choix_bases, selected = r$base)
shiny::updateSelectInput(session, "schema", choices = c("Tous", schemas_pour_base), selected = "Tous")
# Mettre à jour les sélections et vider les champs dépendants
shiny::updateSelectInput(session, "base", choices = c(selected_base), selected = selected_base)
shiny::updateSelectInput(session, "schema", choices = c("Tous", schemas_pour_base$display_name), selected = "Tous")
shiny::updateSelectInput(session, "table", choices = c("Toutes"), selected = "Toutes")
shinyjs::delay(500, { shinyjs::click("visualiserMetadata") })
# Simuler un clic sur le bouton "visualiserMetadata"
shinyjs::delay(500, {
shinyjs::click("visualiserMetadata")
})
})
# Réagir à la sélection d'un schéma
observeEvent(input$selected_schema, {
selected_schema <- input$selected_schema
......@@ -395,21 +415,18 @@ server <- function(input, output, session) {
dplyr::filter(nom_schema == selected_schema) %>%
dplyr::pull(base) %>%
unique()
r$base <- selected_base
req(r$base)
bases_pour_schema <- schemas_pour_base_react()
req(selected_base)
selected_schema <- sub(" : .*", "", input$selected_schema)
tables_pour_schema <- tb_sch_base %>%
dplyr::filter(base == r$base, nom_schema == selected_schema) %>%
dplyr::filter(base == selected_base, nom_schema == selected_schema) %>%
dplyr::pull(table)
# Mettre à jour les sélections et forcer la mise à jour des dépendances
shinyjs::delay(100, {
shiny::updateSelectInput(session, "base", choices = choix_bases, selected = r$base)
shiny::updateSelectInput(session, "base", choices = c(selected_base), selected = selected_base)
shinyjs::delay(100, {
shiny::updateSelectInput(session, "schema", choices = bases_pour_schema, selected = selected_schema)
shiny::updateSelectInput(session, "schema", choices = c(selected_schema), selected = selected_schema)
shiny::updateSelectInput(session, "table", choices = c("Toutes", tables_pour_schema), selected = "Toutes")
})
})
......@@ -420,46 +437,46 @@ server <- function(input, output, session) {
})
})
# Réagir à la sélection d'une table
observeEvent(input$selected_table, {
r$table <- input$selected_table
req(r$table)
selected_table <- input$selected_table
req(selected_table)
# Récupérer le schéma correspondant à la table sélectionnée et mettre à jour r$schema
r$schema <- tables_catalog %>%
dplyr::filter(nom_table == r$table) %>%
# Récupérer le schéma correspondant à la table sélectionnée
selected_schema <- tables_catalog %>%
dplyr::filter(nom_table == selected_table) %>%
dplyr::pull(nom_schema) %>%
unique()
req(r$schema)
req(selected_schema)
# Récupérer la base correspondant au schéma et à la table sélectionnés et mettre à jour r$base
r$base <- tables_catalog %>%
dplyr::filter(nom_schema == r$schema, nom_table == r$table) %>%
# Récupérer la base correspondant au schéma et la table sélectionnés
selected_base <- tables_catalog %>%
dplyr::filter(nom_schema == selected_schema, nom_table == selected_table) %>%
dplyr::pull(base) %>%
unique()
req(r$base)
req(selected_base)
# Mettre à jour les sélections et afficher les métadonnées
# Mettre à jour les sélections et forcer la mise à jour des dépendances
shinyjs::delay(100, {
shiny::updateSelectInput(session, "base", choices = choix_bases, selected = r$base)
shiny::updateSelectInput(session, "base", choices = c(selected_base), selected = selected_base)
shinyjs::delay(100, {
shiny::updateSelectInput(session, "schema", choices = c(r$schema), selected = r$schema)
shiny::updateSelectInput(session, "schema", choices = c(selected_schema), selected = selected_schema)
shinyjs::delay(100, {
shiny::updateSelectInput(session, "table", choices = c(r$table), selected = r$table)
shiny::updateSelectInput(session, "table", choices = c(selected_table), selected = selected_table)
})
})
})
# Simuler un clic sur le bouton "visualiserMetadata"
shinyjs::delay(500, {
shinyjs::click("visualiserMetadata")
# Simuler un clic sur le bouton "visualiserMetadata"
shinyjs::delay(500, {
shinyjs::click("visualiserMetadata")
})
})
})
# Observer l'événement nav_to_explorer
observeEvent(input$nav_to_explorer, {
shinygouv::updateTabsetPanel_dsfr(session = session, inputId = "mon_panel1", selected = "Explorer")
})
# Observer l'événement nav_to_explorer
observeEvent(input$nav_to_explorer, {
shinygouv::updateTabsetPanel_dsfr(session = session, inputId = "mon_panel1", selected = "Explorer")
})
}
ui.R
+ 14
− 13
View file @ f97b62a1
......@@ -22,12 +22,12 @@ ui <- fluidPage_dsfr(
title = "Rechercher",
content = fluidPage_dsfr(
h3("Rechercher un lot de données dans le patrimoine de la DREAL"),
search_bar(),
DT::dataTableOutput("search_results"),
uiOutput("search_message")
)
),
h3("Rechercher un lot de données dans le patrimoine de la DREAL"),
search_bar(),
DT::dataTableOutput("search_results"),
uiOutput("search_message")
)
),
tabPanel_dsfr(
id = "explorer",
title = "Explorer",
......@@ -35,11 +35,12 @@ ui <- fluidPage_dsfr(
sidebarLayout(
sidebarPanel(
h3("Explorer les bases de données du patrimoine de la DREAL"),
selectInput_dsfr("base", "Choisir la base", choices = choix_bases, selected = NULL),# Sélection de la base
#selectInput_dsfr("base", "Choisir la base", choices = NULL), # Sélection de la base
selectInput_dsfr("base", "Choisir la base", choices = liste_bases, selected = NULL), # Sélection de la base
shinygouv::selectInput_dsfr("schema", "Choisir le schéma", NULL), # Sélection du nom du schéma
shinygouv::selectInput_dsfr("table", "Choisir la table", NULL), # Sélection du nom de la table
shinygouv::actionButton_dsfr("visualiserMetadata", "Visualiser les métadonnées")# Bouton de validation pour visualiser les métadonnées
),
),
mainPanel(
uiOutput("breadcrumb_metadata"),
uiOutput("title_metadata"), # Titre de l'objet sélectionné
......@@ -73,9 +74,9 @@ ui <- fluidPage_dsfr(
id = "a_propos",
title = "À propos",
content = fluidPage_dsfr(
h3("À propos"),
includeMarkdown("www/about.md"),
div(paste0("Date de mise à jour des métadonnées affichées : ", date_datamart))
h3("À propos"),
includeMarkdown("www/about.md"),
div(paste0("Date de mise à jour des métadonnées affichées : ", date_datamart))
)
),
......@@ -83,8 +84,8 @@ ui <- fluidPage_dsfr(
id = "mentions_legales",
title = "Mentions légales",
content = fluidPage_dsfr(
h3("Mentions légales"),
includeMarkdown("www/legal_notice.md")
h3("Mentions légales"),
includeMarkdown("www/legal_notice.md")
)
)
)
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment