Compare commits
4 Commits
2f62a94afa
...
5a021b7e8f
| Author | SHA1 | Date | |
|---|---|---|---|
| 5a021b7e8f | |||
| 3f396dedb4 | |||
| c72cf5b815 | |||
| 0212726b06 |
24
app.R
24
app.R
@@ -868,6 +868,7 @@ server <- function(input, output, session) {
|
||||
|
||||
date_columns <- subset(scheme, form_type == "date", 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 |>
|
||||
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({{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
|
||||
}
|
||||
)
|
||||
|
||||
# добавить мета информацию
|
||||
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
|
||||
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 <- df_to_schema_compare[df_to_schema_compare != main_key_id]
|
||||
schema_to_df_compare <- setdiff(unique(scheme$form_id), colnames(df))
|
||||
|
||||
if (length(df_to_schema_compare) > 0 ) {
|
||||
@@ -1054,8 +1066,8 @@ server <- function(input, output, session) {
|
||||
if (length(schema_to_df_compare) > 0 ) {
|
||||
|
||||
message <- glue::glue("столбцы в таблице '{table_name}' не соответсвуют схеме")
|
||||
cli::cli_warn(c(message, paste("- ", schema_to_df_compare)))
|
||||
showNotification(message, type = "error")
|
||||
cli::cli_warn(c(message, paste("- ", schema_to_df_compare)))
|
||||
|
||||
return()
|
||||
}
|
||||
@@ -1067,8 +1079,9 @@ server <- function(input, output, session) {
|
||||
df <- openxlsx2::read_xlsx(wb, 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)
|
||||
other_cols <- which(colnames(df) %in% c(date_columns, number_columns))
|
||||
|
||||
# функция для преобразование числовых значений и сохранения "NA"
|
||||
num_converter <- function(old_col) {
|
||||
@@ -1086,8 +1099,9 @@ server <- function(input, output, session) {
|
||||
df <- df |>
|
||||
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({{other_cols}}), as.character)
|
||||
) |>
|
||||
select(all_of(unique(c(main_key_id, scheme$form_id))))
|
||||
|
||||
@@ -1115,7 +1129,7 @@ server <- function(input, output, session) {
|
||||
|
||||
# очистка от пустых ключей
|
||||
df <- df |>
|
||||
dplyr::filter(!is.na(main_key))
|
||||
dplyr::filter(!is.na({{main_key_id}}))
|
||||
|
||||
DBI::dbWriteTable(
|
||||
con,
|
||||
|
||||
@@ -191,6 +191,7 @@ write_df_to_db = function(
|
||||
|
||||
date_columns <- subset(scheme, form_type == "date", 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 |>
|
||||
dplyr::mutate(
|
||||
@@ -198,8 +199,12 @@ 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({{number_columns}}), ~ gsub("\\.", "," , .x)),
|
||||
dplyr::across(tidyselect::all_of({{other_cols}}), as.character),
|
||||
)
|
||||
|
||||
df |>
|
||||
dplyr::glimpse()
|
||||
|
||||
if (table_name == "main") {
|
||||
del_query <- glue::glue("DELETE FROM main WHERE {main_key_id} = '{main_key_value}'")
|
||||
}
|
||||
|
||||
@@ -18,6 +18,10 @@ scheme_R6 <- R6::R6Class(
|
||||
dplyr::distinct(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(
|
||||
.x = purrr::set_names(private$nested_forms_names),
|
||||
.f = \(nested_form_id) {
|
||||
@@ -109,6 +113,7 @@ scheme_R6 <- R6::R6Class(
|
||||
nested_forms_names = NA,
|
||||
bslib_rendered_ui = NA,
|
||||
excluded_types = c("nested_forms", "description", "description_header"),
|
||||
reserved_table_names = c("meta", "log", "main"),
|
||||
|
||||
load_scheme_from_xlsx = function(sheet_name) {
|
||||
|
||||
@@ -132,8 +137,15 @@ scheme_R6 <- R6::R6Class(
|
||||
dplyr::pull(form_id)
|
||||
|
||||
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
|
||||
}
|
||||
)
|
||||
|
||||
Reference in New Issue
Block a user