From e4231a023c645dd8996b313b2a732ba3d4622810 Mon Sep 17 00:00:00 2001 From: madeliri Date: Sat, 11 Apr 2026 01:57:47 +0300 Subject: [PATCH] =?UTF-8?q?feat:=20=D0=BF=D0=B5=D1=80=D0=B5=D1=80=D0=B0?= =?UTF-8?q?=D0=B1=D0=BE=D1=82=D0=B0=D0=BD=D0=B0=20=D1=80=D0=B0=D0=B1=D0=BE?= =?UTF-8?q?=D1=82=D0=B0=20=D1=81=20=D0=BA=D0=BB=D1=8E=D1=87=D0=B0=D0=BC?= =?UTF-8?q?=D0=B8=20(=D0=BD=D0=B5=D1=82=20=D0=BF=D1=80=D1=8F=D0=BC=D0=BE?= =?UTF-8?q?=D0=B9=20=D0=BF=D1=80=D0=B8=D0=B2=D1=8F=D0=B7=D0=BA=D0=B8=20?= =?UTF-8?q?=D0=BA=20=D0=B8=D1=81=D0=BF=D0=BE=D0=BB=D1=8C=D0=B7=D0=BE=D0=B2?= =?UTF-8?q?=D0=B0=D0=BD=D0=B8=D1=8E=20form=5Fid=20"main=5Fkey"=20=D0=B8=20?= =?UTF-8?q?"nested=5Fkey"?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- app.R | 74 +++++++++++++++++++++++++++++----------------------- modules/db.R | 60 +++++++++++++++++++++++++++++------------- 2 files changed, 84 insertions(+), 50 deletions(-) diff --git a/app.R b/app.R index 23ba0c3..c032caf 100644 --- a/app.R +++ b/app.R @@ -76,7 +76,7 @@ nav_panels_list <- purrr::map( # отделить схему для каждой страницы this_page_panels_scheme <- schm$get_schema("main") |> - dplyr::filter(!form_id %in% c("main_key", "nested_key")) |> + dplyr::filter(!form_id %in% schm$get_main_key_id) |> dplyr::filter(part == {{page_name}}) this_page_panels <- utils$make_panels(this_page_panels_scheme) @@ -297,17 +297,18 @@ server <- function(input, output, session) { show_modal_for_nested_form <- function(con) { ns <- NS(values$nested_form_id) + key_id <- schm$get_key_id(values$nested_form_id) # загрузка схемы для данной вложенной формы this_nested_form_scheme <- schm$get_schema(values$nested_form_id) values$nested_id_and_types <- schm$get_id_type_list(values$nested_form_id) # мини-схема для ключа - this_nested_form_key_scheme <- subset(this_nested_form_scheme, form_id == "nested_key") + this_nested_form_key_scheme <- subset(this_nested_form_scheme, form_id == key_id) if (nrow(this_nested_form_key_scheme) > 1) cli::cli_abort("количество строк не может быть больше одного для ключа") # выбираем все ключи из баз данных - kyes_for_this_table <- db$get_nested_keys_from_table(values$nested_form_id, values$main_key, con) + kyes_for_this_table <- db$get_nested_keys_from_table(values$nested_form_id, schm, values$main_key, con) kyes_for_this_table <- unique(c(values$nested_key, kyes_for_this_table)) values$nested_key <- if (length(kyes_for_this_table) == 0) NULL else kyes_for_this_table[[1]] @@ -327,7 +328,7 @@ server <- function(input, output, session) { subroup_scheme <- this_nested_form_scheme |> dplyr::filter(subgroup == {{subgroup}}) |> - dplyr::filter(!form_id %in% c("main_key", "nested_key")) + dplyr::filter(form_id != key_id) bslib::nav_panel( title = subgroup, @@ -379,11 +380,13 @@ server <- function(input, output, session) { ### функция для отображения DT-таблицы для выбранной вложенной формы -------- show_modal_for_nested_form_dt <- function(con) { + key_id <- schm$get_key_id(values$nested_form_id) + # получение дата-фрейма values$data <- db$read_df_from_db_by_id( table_name = values$nested_form_id, - main_key = values$main_key, - # nested_key = values$nested_key, + schm, + main_key_value = values$main_key, con = con ) @@ -393,11 +396,11 @@ server <- function(input, output, session) { date_cols <- subset(col_types, form_type == "date", form_id, drop = TRUE) values$data <- values$data |> - select(-main_key) |> + select(-schm$get_main_key_id) |> mutate( dplyr::across(tidyselect::all_of({{date_cols}}), as.Date) ) |> - arrange(nested_key) + arrange({{key_id}}) output$dt_nested <- DT::renderDataTable( DT::datatable( @@ -448,13 +451,13 @@ server <- function(input, output, session) { on.exit(db$close_db_connection(con, "nested_form_dt_save"), add = TRUE) export_df <- values$data |> - distinct() |> - mutate(main_key = values$main_key, .before = 1) + dplyr::distinct() |> + dplyr::mutate(!!dplyr::sym(schm$get_main_key_id) := values$main_key, .before = 1) db$write_df_to_db( df = export_df, table_name = values$nested_form_id, - schm = schm, + schm, main_key_value = values$main_key, nested_key_value = NULL, con = con @@ -509,15 +512,16 @@ server <- function(input, output, session) { con <- db$make_db_connection("nested_tables") on.exit(db$close_db_connection(con, "nested_tables"), add = TRUE) - kyes_for_this_table <- db$get_nested_keys_from_table(values$nested_form_id, values$main_key, con) + kyes_for_this_table <- db$get_nested_keys_from_table(values$nested_form_id, schm, values$main_key, con) if (values$nested_key %in% kyes_for_this_table) { # выгрузка датафрейма по общим и вложенным ключам df <- db$read_df_from_db_by_id( - table_name = values$nested_form_id, - main_key = values$main_key, - nested_key = values$nested_key, + table_name = values$nested_form_id, + schm, + main_key_value = values$main_key, + nested_key_value = values$nested_key, con = con ) @@ -537,7 +541,7 @@ server <- function(input, output, session) { # та самая форма для ключа scheme_for_key_input <- schm$get_schema(values$nested_form_id) |> - dplyr::filter(form_id %in% c("nested_key")) + dplyr::filter(form_id == schm$get_key_id(values$nested_form_id)) ui1 <- rlang::exec( .fn = utils$render_forms, @@ -558,18 +562,19 @@ server <- function(input, output, session) { # действие при подтверждении создания новой записи observeEvent(input$confirm_create_new_nested_key, { - req(input$nested_key) + req(input[[schm$get_key_id(values$nested_form_id)]]) con <- db$make_db_connection("confirm_create_new_key") on.exit(db$close_db_connection(con, "confirm_create_new_key"), add = TRUE) existed_key <- db$get_nested_keys_from_table( - table_name = values$nested_form_id, - main_key = values$main_key, + table_name = values$nested_form_id, + schm, + main_key_value = values$main_key, con ) - if (input$nested_key %in% existed_key) { + if (input[[schm$get_key_id(values$nested_form_id)]] %in% existed_key) { showNotification( sprintf("В базе уже запись с данным ключем."), type = "error" @@ -577,7 +582,7 @@ server <- function(input, output, session) { return() } - values$nested_key <- input$nested_key + values$nested_key <- input[[schm$get_key_id(values$nested_form_id)]] utils$clean_forms(values$nested_id_and_types, NS(values$nested_form_id)) removeModal() show_modal_for_nested_form(con) @@ -610,7 +615,7 @@ server <- function(input, output, session) { # данные для главного ключа scheme_for_key_input <- schm$get_schema("main") |> - dplyr::filter(form_id == "main_key") + dplyr::filter(form_id == schm$get_main_key_id) # создать форму для выбора ключа ui1 <- rlang::exec( @@ -633,15 +638,16 @@ server <- function(input, output, session) { ## действие при подтверждении (проверка нового создаваемого ключа) ------- observeEvent(input$confirm_create_new_main_key, { - req(input$main_key) + req(input[[schm$get_main_key_id]]) con <- db$make_db_connection("confirm_create_new_main_key") on.exit(db$close_db_connection(con, "confirm_create_new_key"), add = TRUE) - existed_key <- db$get_keys_from_table("main", con) + existed_key <- db$get_keys_from_table("main", schm, con) + print(existed_key) # если введенный ключ уже есть в базе - if (input$main_key %in% existed_key) { + if (input[[schm$get_main_key_id]] %in% existed_key) { showNotification( sprintf("В базе уже запись с данным ключем."), type = "error" @@ -649,7 +655,7 @@ server <- function(input, output, session) { return() } - values$main_key <- input$main_key + values$main_key <- input[[schm$get_main_key_id]] utils$clean_forms(schm$get_id_type_list("main")) removeModal() @@ -692,13 +698,14 @@ server <- function(input, output, session) { ## список ключей для загрузки данных ------------------- observeEvent(input$load_data_button, { + con <- db$make_db_connection("load_data_button") on.exit(db$close_db_connection(con, "load_data_button")) if (length(dbListTables(con)) != 0 && "main" %in% DBI::dbListTables(con)) { # GET DATA files - ids <- db$get_keys_from_table("main", con) + ids <- db$get_keys_from_table("main", schm, con) ui_load_menu <- renderUI({ selectizeInput( @@ -741,7 +748,8 @@ server <- function(input, output, session) { df <- db$read_df_from_db_by_id( table_name = "main", - main_key = input$load_data_key_selector, + schm = schm, + main_key_value = input$load_data_key_selector, con = con ) @@ -933,6 +941,8 @@ server <- function(input, output, session) { file <- input$upload_xlsx$datapath wb <- openxlsx2::wb_load(file) + main_key_id <- schm$get_main_key_id + # проверка на наличие всех листов в файле if (!all(schm$all_tables_names %in% openxlsx2::wb_get_sheet_names(wb))) { cli::cli_alert_warning("данные в файле '{file} не соответствуют схеме'") @@ -980,7 +990,7 @@ server <- function(input, output, session) { # даты - к единому формату dplyr::across(tidyselect::all_of({{date_columns}}), \(x) purrr::map_chr(x, db$excel_to_db_dates_converter)), ) |> - select(all_of(unique(c("main_key", scheme$form_id)))) + select(all_of(unique(c(main_key_id, scheme$form_id)))) df_original <- DBI::dbReadTable(con, table_name) |> as_tibble() @@ -988,11 +998,11 @@ server <- function(input, output, session) { if (input$upload_data_from_xlsx_owerwrite_all_data == TRUE) cli::cli_abort("not implemented yet") walk( - .x = unique(df$main_key), + .x = unique(df[[main_key_id]]), .f = \(main_key) { - if (main_key %in% unique(df_original$main_key)) { - DBI::dbExecute(con, glue::glue("DELETE FROM {table_name} WHERE main_key = '{main_key}'")) + if (main_key %in% unique(df_original[[main_key_id]])) { + DBI::dbExecute(con, glue::glue("DELETE FROM {table_name} WHERE {main_key_id} = '{main_key}'")) } } ) diff --git a/modules/db.R b/modules/db.R index 7cc7b6c..96b19f3 100644 --- a/modules/db.R +++ b/modules/db.R @@ -225,29 +225,38 @@ write_df_to_db <- function( #' @export #' reading tables from db by name and id ======== -read_df_from_db_by_id <- function(table_name, main_key, nested_key, con) { +read_df_from_db_by_id <- function( + table_name, + schm, + main_key_value, + nested_key_value, + con +) { + + main_key_id <- schm$get_main_key_id # check if this table exist if (table_name == "main") { query <- glue::glue(" SELECT * FROM main - WHERE main_key = '{main_key}' + WHERE {main_key_id} = '{main_key_value}' ") } if (table_name != "main") { - if(!missing(nested_key)) { + if(!missing(nested_key_value)) { + key_id <- schm$get_key_id(table_name) query <- glue::glue(" SELECT * FROM {table_name} - WHERE main_key = '{main_key}' AND nested_key = '{nested_key}' + WHERE {main_key_id} = '{main_key_value}' AND {key_id} = '{nested_key_value}' ") } else { query <- glue::glue(" SELECT * FROM {table_name} - WHERE main_key = '{main_key}' + WHERE {main_key_id} = '{main_key_value}' ") } } @@ -255,17 +264,21 @@ read_df_from_db_by_id <- function(table_name, main_key, nested_key, con) { } #' @export -get_keys_from_table <- function(table_name, con) { +get_keys_from_table <- function(table_name, schm, con) { - DBI::dbGetQuery(con, glue::glue("SELECT DISTINCT main_key FROM {table_name}")) |> + main_key_id <- schm$get_main_key_id + DBI::dbGetQuery(con, glue::glue("SELECT DISTINCT {main_key_id} FROM {table_name}")) |> dplyr::pull() } #' @export -get_nested_keys_from_table <- function(table_name, main_key, con) { +get_nested_keys_from_table <- function(table_name, schm, main_key_value, con) { - DBI::dbGetQuery(con, glue::glue("SELECT DISTINCT nested_key FROM {table_name} WHERE main_key == '{main_key}'")) |> + main_key_id <- schm$get_main_key_id + key_id <- schm$get_key_id(table_name) + + DBI::dbGetQuery(con, glue::glue("SELECT DISTINCT {key_id} FROM {table_name} WHERE {main_key_id} == '{main_key_value}'")) |> dplyr::pull() } @@ -275,15 +288,26 @@ get_nested_keys_from_table <- function(table_name, main_key, con) { #' @export excel_to_db_dates_converter <- function(date) { - if(is.na(date)) return(NA) + if (is.na(date)) return(NA) # cli::cli_inform("date: {date} | nchar: {nchar(date)} | typeof: {typeof(date)}") # если текст, количество символов 7, и маска соответствует 'MM.YYYY' - if (typeof(date) == "character" & nchar(date) == 4 & grepl("((?:19|20)\\d\\d)", date)) { - date <- sprintf("%s-01-01", date) - } else if (typeof(date) == "character" & nchar(date) == 7 & grepl("(0?[1-9]|1[012])\\.((?:19|20)\\d\\d)", date)) { - # если текст, количество символов 7, и маска соответствует 'MM.YYYY' - date <- sprintf("01.%s", date) + if (typeof(date) == "character") { + date <- trimws(date) + + if (nchar(date) == 4 & grepl("((?:19|20)\\d\\d)", date)) { + date <- sprintf("%s-01-01", date) + } else if (nchar(date) == 7 & grepl("(0?[1-9]|1[012])\\.((?:19|20)\\d\\d)", date)) { + # если текст, количество символов 7, и маска соответствует 'MM.YYYY' + date <- sprintf("01.%s", date) + } else if (nchar(date) == 10 & grepl("([12][0-9]|3[01]|0?[1-9])\\.(0?[1-9]|1[012])\\.((?:19|20)\\d\\d)", date)) { + # ... + } else if (nchar(date) == 10 & grepl("((?:19|20)\\d\\d)-(0?[1-9]|1[012])-([12][0-9]|3[01]|0?[1-9])", date)) { + # ... + } else { + cli::cli_alert_warning("can't compute date from '{date}'") + return(date) + } } parse_date1 <- tryCatch( @@ -292,7 +316,7 @@ excel_to_db_dates_converter <- function(date) { ) parse_date2 <- suppressWarnings(as.Date(as.numeric(date), origin = "1899-12-30")) - date <- if (!is.null(parse_date1)) { + fin_date <- if (!is.null(parse_date1)) { parse_date1 } else if (!is.na(parse_date2)) { parse_date2 @@ -300,6 +324,6 @@ excel_to_db_dates_converter <- function(date) { date } - date <- as.character(format(date, "%Y-%m-%d")) - date + fin_date <- as.character(format(fin_date, "%Y-%m-%d")) + fin_date }