Compare commits

...

4 Commits

3 changed files with 37 additions and 6 deletions

24
app.R
View File

@@ -868,6 +868,7 @@ server <- function(input, output, session) {
date_columns <- subset(scheme, form_type == "date", form_id, drop = TRUE) date_columns <- subset(scheme, form_type == "date", form_id, drop = TRUE)
number_columns <- subset(scheme, form_type == "number", form_id, drop = TRUE) number_columns <- subset(scheme, form_type == "number", form_id, drop = TRUE)
other_cols <- which(colnames(df) %in% c(date_columns, number_columns))
df <- df |> df <- df |>
dplyr::mutate( dplyr::mutate(
@@ -875,14 +876,24 @@ server <- function(input, output, session) {
dplyr::across(tidyselect::all_of({{date_columns}}), as.Date), dplyr::across(tidyselect::all_of({{date_columns}}), as.Date),
# числа - к единому формату десятичных значений # числа - к единому формату десятичных значений
dplyr::across(tidyselect::all_of({{number_columns}}), ~ gsub("\\.", "," , .x)), dplyr::across(tidyselect::all_of({{number_columns}}), ~ gsub("\\.", "," , .x)),
dplyr::across(tidyselect::all_of({{other_cols}}), as.character)
) |> ) |>
# очистка от пустых ключей # очистка от пустых ключей
dplyr::filter(!is.na(main_key)) dplyr::filter(!is.na(mhcs()$get_main_key_id))
df df
} }
) )
# добавить мета информацию
list_of_df[["meta"]] <- dplyr::tribble(
~`Параметр` , ~`Значение`,
"Пользователь" , ifelse(AUTH_ENABLED, res_auth$user, "anonymous"),
"Название базы" , names(enabled_schemas)[enabled_schemas == scheme()],
"id базы" , scheme(),
"Время выгрузки" , format(Sys.time(), "%d.%m.%Y %H:%M:%S"),
)
# set date params # set date params
options("openxlsx2.dateFormat" = "dd.mm.yyyy") options("openxlsx2.dateFormat" = "dd.mm.yyyy")
@@ -1044,6 +1055,7 @@ server <- function(input, output, session) {
# столбцы в таблицы и схема # столбцы в таблицы и схема
df_to_schema_compare <- setdiff(colnames(df), unique(scheme$form_id)) df_to_schema_compare <- setdiff(colnames(df), unique(scheme$form_id))
df_to_schema_compare <- df_to_schema_compare[df_to_schema_compare != main_key_id]
schema_to_df_compare <- setdiff(unique(scheme$form_id), colnames(df)) schema_to_df_compare <- setdiff(unique(scheme$form_id), colnames(df))
if (length(df_to_schema_compare) > 0 ) { if (length(df_to_schema_compare) > 0 ) {
@@ -1054,8 +1066,8 @@ server <- function(input, output, session) {
if (length(schema_to_df_compare) > 0 ) { if (length(schema_to_df_compare) > 0 ) {
message <- glue::glue("столбцы в таблице '{table_name}' не соответсвуют схеме") message <- glue::glue("столбцы в таблице '{table_name}' не соответсвуют схеме")
cli::cli_warn(c(message, paste("- ", schema_to_df_compare)))
showNotification(message, type = "error") showNotification(message, type = "error")
cli::cli_warn(c(message, paste("- ", schema_to_df_compare)))
return() return()
} }
@@ -1067,8 +1079,9 @@ server <- function(input, output, session) {
df <- openxlsx2::read_xlsx(wb, table_name) df <- openxlsx2::read_xlsx(wb, table_name)
scheme <- mhcs()$get_scheme_with_values_forms(table_name) scheme <- mhcs()$get_scheme_with_values_forms(table_name)
date_columns <- subset(scheme, form_type == "date", form_id, drop = TRUE) date_columns <- subset(scheme, form_type == "date", form_id, drop = TRUE)
number_columns <- subset(scheme, form_type == "number", form_id, drop = TRUE) number_columns <- subset(scheme, form_type == "number", form_id, drop = TRUE)
other_cols <- which(colnames(df) %in% c(date_columns, number_columns))
# функция для преобразование числовых значений и сохранения "NA" # функция для преобразование числовых значений и сохранения "NA"
num_converter <- function(old_col) { num_converter <- function(old_col) {
@@ -1086,8 +1099,9 @@ server <- function(input, output, session) {
df <- df |> df <- df |>
dplyr::mutate( dplyr::mutate(
# даты - к единому формату # даты - к единому формату
dplyr::across(tidyselect::all_of({{date_columns}}), \(x) purrr::map_chr(x, db$excel_to_db_dates_converter)), dplyr::across(tidyselect::all_of({{date_columns}}), \(x) purrr::map_chr(x, db$excel_to_db_dates_converter)),
dplyr::across(tidyselect::all_of({{number_columns}}), num_converter), dplyr::across(tidyselect::all_of({{number_columns}}), num_converter),
dplyr::across(tidyselect::all_of({{other_cols}}), as.character)
) |> ) |>
select(all_of(unique(c(main_key_id, scheme$form_id)))) select(all_of(unique(c(main_key_id, scheme$form_id))))
@@ -1115,7 +1129,7 @@ server <- function(input, output, session) {
# очистка от пустых ключей # очистка от пустых ключей
df <- df |> df <- df |>
dplyr::filter(!is.na(main_key)) dplyr::filter(!is.na({{main_key_id}}))
DBI::dbWriteTable( DBI::dbWriteTable(
con, con,

View File

@@ -191,6 +191,7 @@ write_df_to_db = function(
date_columns <- subset(scheme, form_type == "date", form_id, drop = TRUE) date_columns <- subset(scheme, form_type == "date", form_id, drop = TRUE)
number_columns <- subset(scheme, form_type == "number", form_id, drop = TRUE) number_columns <- subset(scheme, form_type == "number", form_id, drop = TRUE)
other_cols <- which(colnames(df) %in% c(date_columns, number_columns))
df <- df |> df <- df |>
dplyr::mutate( dplyr::mutate(
@@ -198,7 +199,11 @@ write_df_to_db = function(
dplyr::across(tidyselect::all_of({{date_columns}}), \(x) purrr::map_chr(x, excel_to_db_dates_converter)), dplyr::across(tidyselect::all_of({{date_columns}}), \(x) purrr::map_chr(x, excel_to_db_dates_converter)),
# числа - к единому формату десятичных значений # числа - к единому формату десятичных значений
dplyr::across(tidyselect::all_of({{number_columns}}), ~ gsub("\\.", "," , .x)), dplyr::across(tidyselect::all_of({{number_columns}}), ~ gsub("\\.", "," , .x)),
dplyr::across(tidyselect::all_of({{other_cols}}), as.character),
) )
df |>
dplyr::glimpse()
if (table_name == "main") { if (table_name == "main") {
del_query <- glue::glue("DELETE FROM main WHERE {main_key_id} = '{main_key_value}'") del_query <- glue::glue("DELETE FROM main WHERE {main_key_id} = '{main_key_value}'")

View File

@@ -18,6 +18,10 @@ scheme_R6 <- R6::R6Class(
dplyr::distinct(form_id) |> dplyr::distinct(form_id) |>
dplyr::pull(form_id) dplyr::pull(form_id)
# проверка на не пересечение с зарезервированными именами
check <- private$reserved_table_names %in% private$nested_forms_names
if (any(check)) cli::cli_abort(c("нельзя использовать данные имена вложенных таблиц:", paste("- ", private$reserved_table_names[check])))
purrr::walk( purrr::walk(
.x = purrr::set_names(private$nested_forms_names), .x = purrr::set_names(private$nested_forms_names),
.f = \(nested_form_id) { .f = \(nested_form_id) {
@@ -109,6 +113,7 @@ scheme_R6 <- R6::R6Class(
nested_forms_names = NA, nested_forms_names = NA,
bslib_rendered_ui = NA, bslib_rendered_ui = NA,
excluded_types = c("nested_forms", "description", "description_header"), excluded_types = c("nested_forms", "description", "description_header"),
reserved_table_names = c("meta", "log", "main"),
load_scheme_from_xlsx = function(sheet_name) { load_scheme_from_xlsx = function(sheet_name) {
@@ -132,8 +137,15 @@ scheme_R6 <- R6::R6Class(
dplyr::pull(form_id) dplyr::pull(form_id)
if (length(duplicate_ids) > 0) { if (length(duplicate_ids) > 0) {
cli::cli_abort(c("В схеме для формы '{sheet_name}' содержатся повторяющиеся id:", paste("-", duplicate_ids))) cli::cli_abort(c("В схеме '{private$scheme_file_path}' для формы '{sheet_name}' содержатся повторяющиеся id:", paste("-", duplicate_ids)))
} }
# проверка на корректные id
input_names_with_dash <- unique(table$form_id)[grepl("-", unique(table$form_id))]
if (length(input_names_with_dash) > 0) {
cli::cli_abort(c("В схеме '{private$scheme_file_path}' в id форм содержатся `-`, может привести к некорректной последующей работой с базой данных", paste("-", input_names_with_dash)))
}
table table
} }
) )