Compare commits

..

18 Commits

Author SHA1 Message Date
e7497c7d53 0.16.0 2026-04-21 14:13:28 +03:00
830e9c31a8 feat: бэкапы локальных баз данных 2026-04-21 13:58:52 +03:00
b928f4d356 fix: теперь все правильно (configs) 2026-04-20 19:17:53 +03:00
788541ab2b fix: изменен пайплайн конфигов во избежания ошибок в работе 2026-04-20 19:10:30 +03:00
ac75ab08c2 feat: bring config file back 2026-04-20 18:50:40 +03:00
7a006f6d6b feat: валидация данных в виде модулей 2026-04-20 16:38:14 +03:00
be1623716c refactor: перенос объявление enabled_schema в отдельный файл в папке configs 2026-04-17 16:26:12 +03:00
b5260a510f Merge branch 'main' of https://gitea.madelirihs.ru/madeliri/shiny_form 2026-04-17 14:48:00 +03:00
a000a4e123 gitupdate 2026-04-17 14:47:01 +03:00
f0063f3f83 Merge branch 'main' of https://gitea.madelirihs.ru/madeliri/shiny_form 2026-04-16 17:33:16 +03:00
20f0d52f12 feat: добавление новых строк в формы select_one, select_multiple 2026-04-16 17:33:11 +03:00
65a85d330c Merge branch 'main' of https://gitea.madelirihs.ru/madeliri/shiny_form 2026-04-15 20:38:11 +03:00
e60a21013a what 2026-04-15 20:38:10 +03:00
68faf06e38 fix: корректная работа во вложенных формах при добавлении нового ключа 2026-04-15 17:26:35 +03:00
f344859f92 fix: nested forms for select_one and et cetera 2026-04-15 15:02:33 +03:00
d196715f50 fix: проверка на длину названий вложенных таблиц 2026-04-15 14:53:51 +03:00
c50a259541 fix: некорректная загрузка box-модуля 2026-04-14 17:31:40 +03:00
6cf76641ed refactor: небольшие изменения кода 2026-04-14 11:43:10 +03:00
15 changed files with 333 additions and 113 deletions

View File

@@ -1 +1,20 @@
source("renv/activate.R") source("renv/activate.R")
(function() {
paths <- c(
"R_CONFIG_ACTIVE",
"AUTH_DB_KEY"
)
lines <- paths[Sys.getenv(paths) == ""]
if (length(lines) > 0) {
cli::cli_h3("Настройка путей окружения")
cli::cli_code(paste0(lines, "="))
cli::cli_inform(c(
"i" = "Для нормальной работы скриптов добавьте в {.file .Renviron}:"
))
}
})()

2
.gitignore vendored
View File

@@ -1,8 +1,8 @@
/renv /renv
/temp /temp
/_devel
scheme.rds scheme.rds
.Renviron .Renviron
.DS_Store .DS_Store
.lintr .lintr

View File

@@ -1,3 +1,15 @@
### 0.16.0 (2026-04-21)
##### features
- возможность импорта данных в базу данных из ранее экспортированных .xlsx таблиц;
- пререндеринг схемы формы (сокращение количества времени на загрузку приложения);
- главная форма для заполнения не отображается если не выбрана/создана запись;
- валидация правильности заполненных данных в формах 'select_one', 'select_multiple', 'radio' и 'checkboxes';
- возможность работы с несколькими формами в пределах одного приложения;
##### changes
- в каждой схеме первый элемент с формой (по id) теперь является ключевым (ранее необходимо было явно указывать id 'main_key' и 'nested_key');
- при экспорте из базы в .xlsx числовые значения всегда экспортируются как текст (чтобы сохранить 'NA' значения);
### 0.15.0 (2026-04-07) ### 0.15.0 (2026-04-07)
##### features ##### features
- added `description_header` form type; - added `description_header` form type;

View File

@@ -12,14 +12,53 @@
... ...
# Quick start
## локально:
Копирование содержимого репозитория
```bash
git clone https://gitea.madelirihs.ru/madeliri/shiny_form.git
```
Восстановление окружения
```r
renv::init()
```
# Насторйки
## переменные окружения
### работа с авторизацией
Пароль базы данных с авторизацией необходимо указать в `.Renviron`:
```
AUTH_DB_KEY = "this_is_your_password"
```
### бэкапы локальных баз
Для создания бэкапов локальных баз данных, необходимо указать путь куда будут сохранятся бэкапы в переменной окружения:
```
FORM_APP_LOCAL_DB_BACKUP_PATH="path_to_backups"
```
Проверка осуществляется при каждом запуске приложения, бэкапы создаются раз в день (при первом запуске).
Количество сохраняемых бэкапов:
```
FORM_APP_LOCAL_DB_BACKUP_LIMITS=3
```
# Cтруктура `schema.xlsx` # Cтруктура `schema.xlsx`
Файл, формирующий структуру всей формы, представляет собой таблицу в формате `.xlsx`, состоящий из следующих столбцов: Файл, формирующий структуру всей формы, представляет собой таблицу в формате `.xlsx`, состоящий из следующих столбцов:
- `part` - группировка первого уровня (страницы); - `part` - группировка первого уровня (страницы), используется только в главной схеме ('main');
- `subgroup` - группировка второго уровня (колонки); - `subgroup` - группировка второго уровня (колонки);
- `form_id` - id; - `form_id` - id формы;
- `form_label` - Название формы; - `form_label` - Название формы;
- `form_description` - Описание формы; - `form_description` - Описание формы;
- `form_type` - тип формы, в настоящее время доступные следующие варианты: - `form_type` - тип формы, в настоящее время доступные следующие варианты:
@@ -32,20 +71,17 @@
- `checkboxes` - выбор нескольких вариантов (checkboxes); - `checkboxes` - выбор нескольких вариантов (checkboxes);
- `description` - описание (отображение текста, без формы выбора/ввода); - `description` - описание (отображение текста, без формы выбора/ввода);
- `description_header` - для отображение заголовка; - `description_header` - для отображение заголовка;
- `nested_form` - вложенная форма; - `nested_forms` - вложенная форма;
- `choices` - варианты выбора (если предполагаются типом формы ввода); - `choices` - варианты выбора (если предполагаются типом формы ввода);
- `condition` - условие, при котором форма ввода будет отображаться; - `condition` - условие, при котором форма ввода будет отображаться;
- `required` - проверка заполненности поля: пустое значение - нет проверки, 1 - есть проверка - `required` - проверка заполненности поля: пустое значение - нет проверки, 1 - есть проверка
Первый по порядку id для каждой схемы является ключевой (!)
# Как пользоваться # Как пользоваться
## Авторизация ## Авторизация
Пароль базы данных с авторизацией необходимо указать в `.Renviron`:
```
AUTH_DB_KEY = "this_is_your_password"
```
# trade-ofs # trade-ofs

73
app.R
View File

@@ -9,30 +9,34 @@ suppressPackageStartupMessages({
library(shinymanager) library(shinymanager)
}) })
# КАК ЗАПРЯТЯАТЬ ID
# SOURCE FILES ============================ # SOURCE FILES ============================
box::purge_cache() box::purge_cache()
box::use( box::use(
modules/utils, modules/utils,
modules/global_options, modules/global_options,
modules/global_options[enabled_schemas],
modules/db, modules/db,
modules/data_validation, modules/data_validation,
modules/scheme_generator[scheme_R6] modules/scheme_generator[scheme_R6]
) )
# SETTINGS ================================
FILE_SCHEME <- fs::path("configs/schemas", "schema.xlsx")
AUTH_ENABLED <- Sys.getenv("FORM_AUTH_ENABLED", FALSE)
HEADER_TEXT <- sprintf("%s (%s)", Sys.getenv("FORM_TITLE", "NA"), Sys.getenv("FORM_VERSION", "NA"))
global_options$set_global_options( global_options$set_global_options(
shiny.host = "0.0.0.0" shiny.host = "0.0.0.0"
# enabled_schemas = "example_of_scheme"
) )
global_options$check_and_init_scheme() global_options$check_and_init_scheme()
# global vars
box::use(
modules/global_options[AUTH_ENABLED]
)
# SETTINGS ================================
HEADER_TEXT <- sprintf("%s (%s)", config::get("form_name"), config::get("form_app_version"))
# sadasdasdasdasdas
options(box.path = config::get("form_app_configure_path"))
box::use(configs/enabled_schemes[enabled_schemes])
# CHECK FOR PANDOC # CHECK FOR PANDOC
# TEMP ! NEED TO HANDLE # TEMP ! NEED TO HANDLE
rmarkdown::find_pandoc(dir = "/opt/homebrew/bin/") rmarkdown::find_pandoc(dir = "/opt/homebrew/bin/")
@@ -45,7 +49,14 @@ schms <- readRDS("scheme.rds")
# UI ======================= # UI =======================
ui <- page_sidebar( ui <- page_sidebar(
title = HEADER_TEXT, # title = HEADER_TEXT,
title = tagList(
h4(HEADER_TEXT, style = "margin-top: .5rem"),
tooltip(
span("about", icon("circle-info", lib = "font-awesome")),
"Данный функционал позволяет обрабатывать информацию о пациентах на комиссию, используя Excel (обновление данных возможно через окно формирования списка пациентов)"
)
),
theme = bs_theme(version = 5, preset = "bootstrap"), theme = bs_theme(version = 5, preset = "bootstrap"),
sidebar = sidebar( sidebar = sidebar(
actionButton("add_new_main_key_button", "Добавить новую запись", icon("plus", lib = "font-awesome")), actionButton("add_new_main_key_button", "Добавить новую запись", icon("plus", lib = "font-awesome")),
@@ -59,12 +70,9 @@ ui <- page_sidebar(
position = "left", position = "left",
open = list(mobile = "always") open = list(mobile = "always")
), ),
as_fill_carrier(uiOutput("main_ui_navset")) as_fill_carrier(uiOutput("main_ui_navset")),
) )
# MODALS ========================
# окно для подвтерждения очищения данных
# init auth ======================= # init auth =======================
if (AUTH_ENABLED) { if (AUTH_ENABLED) {
# shinymanager::set_labels("en", "Please authenticate" = "scheme()") # shinymanager::set_labels("en", "Please authenticate" = "scheme()")
@@ -118,9 +126,9 @@ server <- function(input, output, session) {
if (AUTH_ENABLED) { if (AUTH_ENABLED) {
reactiveValuesToList(res_auth) reactiveValuesToList(res_auth)
if (res_auth$admin) { if (res_auth$admin) {
print("admin") # print("admin")
} else { } else {
print("not_admin") # print("not_admin")
showing_buttons <- FALSE showing_buttons <- FALSE
} }
} }
@@ -147,8 +155,8 @@ server <- function(input, output, session) {
nested_form_id = NULL nested_form_id = NULL
) )
scheme <- reactiveVal(enabled_schemas[1]) # наименование выбранной схемы scheme <- reactiveVal(enabled_schemes[1]) # наименование выбранной схемы
mhcs <- reactiveVal(schms[[enabled_schemas[1]]]) # объект для выбранной схемы mhcs <- reactiveVal(schms[[enabled_schemes[1]]]) # объект для выбранной схемы
observers_started <- reactiveVal(NULL) observers_started <- reactiveVal(NULL)
main_form_is_empty <- reactiveVal(TRUE) main_form_is_empty <- reactiveVal(TRUE)
@@ -166,7 +174,7 @@ server <- function(input, output, session) {
shiny::radioButtons( shiny::radioButtons(
"schmes_selector", "schmes_selector",
label = strong("Выбрать базу данных для работы:"), label = strong("Выбрать базу данных для работы:"),
choices = enabled_schemas, choices = enabled_schemes,
selected = scheme() selected = scheme()
), ),
"Для начала работы нужно создать новую запись или загрузить существующую!", "Для начала работы нужно создать новую запись или загрузить существующую!",
@@ -342,8 +350,13 @@ server <- function(input, output, session) {
this_nested_form_scheme <- mhcs()$get_scheme(values$nested_form_id) this_nested_form_scheme <- mhcs()$get_scheme(values$nested_form_id)
# мини-схема для ключа # мини-схема для ключа
this_nested_form_key_scheme <- subset(this_nested_form_scheme, form_id == key_id) this_nested_form_key_scheme <- this_nested_form_scheme |>
if (nrow(this_nested_form_key_scheme) > 1) cli::cli_abort("количество строк не может быть больше одного для ключа") dplyr::filter(form_id == {{key_id}})
this_nested_form_key_scheme_smoll <- this_nested_form_key_scheme |>
dplyr::distinct(form_id, form_label, form_type)
if (nrow(this_nested_form_key_scheme_smoll) > 1) cli::cli_abort("количество строк не может быть больше одного для ключа")
# выбираем все ключи из баз данных # выбираем все ключи из баз данных
kyes_for_this_table <- db$get_nested_keys_from_table(values$nested_form_id, mhcs(), values$main_key, con) kyes_for_this_table <- db$get_nested_keys_from_table(values$nested_form_id, mhcs(), values$main_key, con)
@@ -352,7 +365,7 @@ server <- function(input, output, session) {
values$nested_key <- if (length(kyes_for_this_table) == 0) NULL else kyes_for_this_table[[1]] values$nested_key <- if (length(kyes_for_this_table) == 0) NULL else kyes_for_this_table[[1]]
# если ключ в формате даты - дать человекочитаемые данные # если ключ в формате даты - дать человекочитаемые данные
if (this_nested_form_key_scheme$form_type == "date") { if (this_nested_form_key_scheme_smoll$form_type == "date") {
kyes_for_this_table <- setNames( kyes_for_this_table <- setNames(
kyes_for_this_table, kyes_for_this_table,
format(as.Date(kyes_for_this_table), "%d.%m.%Y") format(as.Date(kyes_for_this_table), "%d.%m.%Y")
@@ -390,7 +403,7 @@ server <- function(input, output, session) {
width = 300, width = 300,
selectizeInput( selectizeInput(
inputId = "nested_key_selector", inputId = "nested_key_selector",
label = strong(this_nested_form_key_scheme$form_label), label = strong(this_nested_form_key_scheme_smoll$form_label),
choices = kyes_for_this_table, choices = kyes_for_this_table,
selected = values$nested_key, selected = values$nested_key,
# options = list(placeholder = "действие комиссии", create = FALSE, onInitialize = I('function() { this.setValue(""); }')) # options = list(placeholder = "действие комиссии", create = FALSE, onInitialize = I('function() { this.setValue(""); }'))
@@ -589,6 +602,8 @@ server <- function(input, output, session) {
mhcs(), mhcs(),
ns = NS(values$nested_form_id) ns = NS(values$nested_form_id)
) )
} else {
utils$clean_forms(values$nested_form_id, mhcs(), NS(values$nested_form_id))
} }
}) })
@@ -655,7 +670,7 @@ server <- function(input, output, session) {
need(values$main_key, "⚠️ Необходимо указать id пациента!") need(values$main_key, "⚠️ Необходимо указать id пациента!")
) )
span( span(
strong("Таблица: "), names(enabled_schemas)[enabled_schemas == scheme()], strong("Таблица: "), names(enabled_schemes)[enabled_schemes == scheme()],
br(), br(),
strong("ID: "), values$main_key strong("ID: "), values$main_key
) )
@@ -889,8 +904,10 @@ server <- function(input, output, session) {
list_of_df[["meta"]] <- dplyr::tribble( list_of_df[["meta"]] <- dplyr::tribble(
~`Параметр` , ~`Значение`, ~`Параметр` , ~`Значение`,
"Пользователь" , ifelse(AUTH_ENABLED, res_auth$user, "anonymous"), "Пользователь" , ifelse(AUTH_ENABLED, res_auth$user, "anonymous"),
"Название базы" , names(enabled_schemas)[enabled_schemas == scheme()], "Название базы" , names(enabled_schemes)[enabled_schemes == scheme()],
"id базы" , scheme(), "id базы" , scheme(),
"id формы" , config::get("form_id"),
"ver формы" , config::get("form_app_version"),
"Время выгрузки" , format(Sys.time(), "%d.%m.%Y %H:%M:%S"), "Время выгрузки" , format(Sys.time(), "%d.%m.%Y %H:%M:%S"),
) )
@@ -1138,7 +1155,7 @@ server <- function(input, output, session) {
append = TRUE append = TRUE
) )
message <- glue::glue("Данные таблицы '{table_name}' успешно обновлены") message <- glue::glue("Данные таблицы '{table_name}' успешно обновлены (добавлено {nrow(df)} записей)")
showNotification( showNotification(
message, message,
type = "message" type = "message"
@@ -1180,7 +1197,7 @@ server <- function(input, output, session) {
"exporting data to xlsx", "exporting data to xlsx",
"importing data from xlsx" "importing data from xlsx"
), ),
key = NULL, key = NA,
con con
) { ) {
@@ -1189,6 +1206,8 @@ server <- function(input, output, session) {
action_row <- tibble( action_row <- tibble(
date = Sys.time(), date = Sys.time(),
user = ifelse(AUTH_ENABLED, res_auth$user, "anonymous"), user = ifelse(AUTH_ENABLED, res_auth$user, "anonymous"),
app_id = config::get("form_id"),
app_ver = config::get("form_app_version"),
remote_addr = session$request$REMOTE_ADDR, remote_addr = session$request$REMOTE_ADDR,
key = key, key = key,
action = action, action = action,

13
config.yml Normal file
View File

@@ -0,0 +1,13 @@
default:
form_app_version: 0.16.0
form_id: new_formy
form_name: NEW FORMY
prod:
form_app_configure_path: "."
form_auth_enabled: true
devel:
form_app_configure_path: _devel/d2tra
form_auth_enabled: false
form_app_version: 0.16.0 dev

View File

@@ -0,0 +1,4 @@
#' @export
enabled_schemes <- c(
`Тестовая база данных` = "example_of_scheme"
)

View File

@@ -1,10 +1,9 @@
options(box.path = here::here())
box::use(modules/data_manipulations[is_this_empty_value])
#' @export #' @export
init_val = function(scheme, ns) { init_val = function(scheme, ns) {
options(box.path = here::here())
box::use(modules/data_manipulations[is_this_empty_value])
iv <- shinyvalidate::InputValidator$new() iv <- shinyvalidate::InputValidator$new()
# если передана функция с пространством имен, то происходит модификация id # если передана функция с пространством имен, то происходит модификация id
@@ -37,18 +36,7 @@ init_val = function(scheme, ns) {
# value `0; 250` -> transform to rule validation value from 0 to 250 # value `0; 250` -> transform to rule validation value from 0 to 250
if (form_type == "number") { if (form_type == "number") {
iv$add_rule(x_input_id, function(x) { iv$add_rule(x_input_id, val_is_a_number)
# exit if empty
if (is_this_empty_value(x)) {
return(NULL)
}
# хак для пропуска значений
if (x == "NA") return(NULL)
# check for numeric
# if (grepl("^[-]?(\\d*\\,\\d+|\\d+\\,\\d*|\\d+)$", x)) NULL else "Значение должно быть числом."
if (grepl("^[+-]?\\d*[\\.|\\,]?\\d+$", x)) NULL else "Значение должно быть числом."
})
# проверка на соответствие диапазону значений # проверка на соответствие диапазону значений
if (!is.na(choices)) { if (!is.na(choices)) {
@@ -59,15 +47,44 @@ init_val = function(scheme, ns) {
if (length(ranges) > 3) { if (length(ranges) > 3) {
warning("Количество переданных элементов'", x_input_id, "' > 2") warning("Количество переданных элементов'", x_input_id, "' > 2")
} else { } else {
iv$add_rule( iv$add_rule(x_input_id, val_number_within_a_range, ranges = ranges)
x_input_id, }
function(x) { }
# exit if empty
if (is_this_empty_value(x)) {
return(NULL)
} }
if (form_type %in% c("select_multiple", "select_one", "radio", "checkbox")) {
iv$add_rule(x_input_id, val_choice_within_a_dict, choices = choices)
}
# if in `required` column value is `1` apply standart validation
if (!is.na(val_required) && val_required == 1) {
iv$add_rule(x_input_id, shinyvalidate::sv_required(message = "Необходимо заполнить."))
}
}
)
iv
}
# работа с числовыми значениями ------------------
## проверка является ли значение числом ----------
val_is_a_number = function(x) {
# exit if empty
if (is_this_empty_value(x)) return(NULL)
# хак для пропуска значений
if (x == "NA") return(NULL)
# check for numeric
# if (grepl("^[-]?(\\d*\\,\\d+|\\d+\\,\\d*|\\d+)$", x)) NULL else "Значение должно быть числом."
if (grepl("^[+-]?\\d*[\\.|\\,]?\\d+$", x)) NULL else "Значение должно быть числом."
}
## находится ли число в заданном диапазоне значений -------
val_number_within_a_range = function(x, ranges) {
# exit if empty
if (is_this_empty_value(x)) return(NULL)
if (x == "NA") return(NULL) if (x == "NA") return(NULL)
# замена разделителя десятичных цифр # замена разделителя десятичных цифр
@@ -80,13 +97,10 @@ init_val = function(scheme, ns) {
glue::glue("Значение должно быть между {ranges[1]} и {ranges[2]}.") glue::glue("Значение должно быть между {ranges[1]} и {ranges[2]}.")
} }
} }
)
}
}
}
if (form_type %in% c("select_multiple", "select_one", "radio", "checkbox")) { # списки ---------------------------------------------------------
iv$add_rule(x_input_id, function(x) { ## являются ли выбранные значения допустимы (согласно файлу схемы)
val_choice_within_a_dict = function(x, choices) {
if (length(x) == 1) { if (length(x) == 1) {
if (is_this_empty_value(x)) return(NULL) if (is_this_empty_value(x)) return(NULL)
@@ -99,16 +113,4 @@ init_val = function(scheme, ns) {
text <- paste0("'",x[!compare_to_dict],"'", collapse = ", ") text <- paste0("'",x[!compare_to_dict],"'", collapse = ", ")
glue::glue("варианты, не соответствующие схеме: {text}") glue::glue("варианты, не соответствующие схеме: {text}")
} }
})
}
# if in `required` column value is `1` apply standart validation
if (!is.na(val_required) && val_required == 1) {
iv$add_rule(x_input_id, shinyvalidate::sv_required(message = "Необходимо заполнить."))
}
}
)
iv
} }

View File

@@ -4,7 +4,12 @@
#' @param where text mark to distingiush calss #' @param where text mark to distingiush calss
make_db_connection = function(scheme, where = "") { make_db_connection = function(scheme, where = "") {
if (getOption("APP.DEBUG", FALSE)) message("=== DB CONNECT ", where) if (getOption("APP.DEBUG", FALSE)) message("=== DB CONNECT ", where)
DBI::dbConnect(RSQLite::SQLite(), fs::path("db", scheme, ext = "sqlite")) DBI::dbConnect(RSQLite::SQLite(), fs::path(
config::get("form_app_configure_path"),
"db",
scheme,
ext = "sqlite"
))
} }
#' @export #' @export
@@ -12,12 +17,14 @@ make_db_connection = function(scheme, where = "") {
#' Function to close connection to db, disigned to easy dubugging and #' Function to close connection to db, disigned to easy dubugging and
#' hide warnings. #' hide warnings.
close_db_connection = function(con, where = "") { close_db_connection = function(con, where = "") {
tryCatch( tryCatch(
expr = DBI::dbDisconnect(con), expr = DBI::dbDisconnect(con),
error = function(e) print(e), error = function(e) print(e),
warning = function(w) if (getOption("APP.DEBUG", FALSE)) message("=!= ALREADY DISCONNECTED ", where), warning = function(w) if (getOption("APP.DEBUG", FALSE)) message("=!= ALREADY DISCONNECTED ", where),
finally = if (getOption("APP.DEBUG", FALSE)) message("=/= DB DISCONNECT ", where) finally = if (getOption("APP.DEBUG", FALSE)) message("=/= DB DISCONNECT ", where)
) )
} }
#' @export #' @export
@@ -202,9 +209,6 @@ write_df_to_db = function(
dplyr::across(tidyselect::all_of({{other_cols}}), as.character), 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}'")
} }
@@ -332,3 +336,71 @@ excel_to_db_dates_converter = function(date) {
fin_date <- as.character(format(fin_date, "%Y-%m-%d")) fin_date <- as.character(format(fin_date, "%Y-%m-%d"))
fin_date fin_date
} }
#' @export
local_db_backup <- function(
db_name,
backups_paths = Sys.getenv("FORM_APP_LOCAL_DB_BACKUP_PATH"),
backups_limit = as.integer(Sys.getenv("FORM_APP_LOCAL_DB_BACKUP_LIMITS", 5))
) {
db_path <- fs::path(config::get("form_app_configure_path"), "db")
db_full_path <- fs::path(db_path, db_name, ext = "sqlite")
backup_folder <- fs::path(backups_paths, db_name)
if (!dir.exists(backup_folder)) dir.create(backup_folder, recursive = TRUE)
date_mark <- format(Sys.time(), "%Y%m%d")
schedule <- c(
daily = 1,
weekly = 7,
monthly = 28
)
purrr::walk2(
.x = schedule,
.y = names(schedule),
.f = \(schedule_days, schedule_name) {
# daily
daily_folder <- fs::path(backup_folder, schedule_name)
todays_backup <- fs::path(daily_folder, paste0(db_name, "_", format(Sys.time(), "%Y%m%d")), ext = "sqlite")
if (!dir.exists(daily_folder)) dir.create(daily_folder)
existed_files <- fs::dir_ls(daily_folder, regexp = "((?:19|20)\\d\\d)(0?[1-9]|1[012])([12][0-9]|3[01]|0?[1-9])")
existed_files <- sort(existed_files, decreasing = TRUE)
# если бэкап для сегодняшнего дня есть - скипаем процедуру
if (todays_backup %in% existed_files) {
return()
}
# парсим даты
dates <- stringr::str_extract(existed_files, "((?:19|20)\\d\\d)(0?[1-9]|1[012])([12][0-9]|3[01]|0?[1-9])")
dates <- as.Date(dates, "%Y%m%d")
# если количество существующих бэкапов значимо превышает установленный лимит, удаляем лишнее
if (length(existed_files) > backups_limit) {
file.remove(utils::tail(existed_files, length(existed_files) - backups_limit))
}
# если количество существующих бэкапов равно имеющемуся и пора делать бэкап - делаем бэкап, удаляем послендий файл
if (length(existed_files) >= backups_limit & dates[1] + schedule_days == Sys.Date()) {
file.remove(utils::tail(existed_files, 1))
file.copy(db_full_path, todays_backup)
} else if(length(existed_files) == 0) {
file.copy(db_full_path, todays_backup)
}
}
)
}

View File

@@ -3,13 +3,27 @@
set_global_options = function( set_global_options = function(
SYMBOL_DELIM = "; ", SYMBOL_DELIM = "; ",
APP.DEBUG = FALSE, APP.DEBUG = FALSE,
# APP.FILE_DB = fs::path("data.sqlite"),
shiny.host = "127.0.0.1", shiny.host = "127.0.0.1",
shiny.port = 1337, shiny.port = 1338,
... ...
) { ) {
config_params_to_check <- c(
"form_app_version",
"form_app_configure_path",
"form_auth_enabled",
"form_id",
"form_name"
)
expected_params_in_config <- config_params_to_check %in% names(config::get())
if (!all(expected_params_in_config)) {
cli::cli_abort(c("ну так не пойдет:", paste("-", config_params_to_check[!expected_params_in_config])))
}
options( options(
SYMBOL_DELIM = SYMBOL_DELIM, SYMBOL_DELIM = SYMBOL_DELIM,
# form.db_path = config::get("form_db_path"),
APP.DEBUG = APP.DEBUG, APP.DEBUG = APP.DEBUG,
# APP.FILE_DB = APP.FILE_DB, # APP.FILE_DB = APP.FILE_DB,
shiny.host = shiny.host, shiny.host = shiny.host,
@@ -19,28 +33,35 @@ set_global_options = function(
} }
#' @export #' @export
enabled_schemas <- c( AUTH_ENABLED <- config::get("form_auth_enabled")
`Тестовая база данных` = "example_of_scheme"
# `D2TRA (для отладки)` = "d2tra_t"
)
#' @export #' @export
check_and_init_scheme = function() { check_and_init_scheme = function() {
cli::cli_inform(c("*" = "проверка схемы...")) cli::cli_inform(c("*" = "проверка схемы..."))
options(box.path = here::here())
box::use(modules/db[local_db_backup])
options(box.path = config::get("form_app_configure_path"))
box::use(configs/enabled_schemes[enabled_schemes])
# список файлов, изменение которых, приведут к переинициализиации схемы
files_to_watch <- c( files_to_watch <- c(
fs::path(config::get("form_app_configure_path"), "configs", "enabled_schemes.R"),
"modules/scheme_generator.R", "modules/scheme_generator.R",
"modules/utils.R" "modules/utils.R"
) )
scheme_names <- enabled_schemas scheme_names <- enabled_schemes
scheme_file <- paste0("configs/schemas/", scheme_names, ".xlsx") scheme_file <- paste0(config::get("form_app_configure_path"), "/configs/schemas/", scheme_names, ".xlsx")
scheme_file <- stats::setNames(scheme_file, scheme_names) scheme_file <- stats::setNames(scheme_file, scheme_names)
if (!all(file.exists(scheme_file))) cli::cli_abort(c("Отсутствуют файлы схем для следующих наименований:", paste("-", names(scheme_file)[!file.exists(scheme_file)]))) if (!all(file.exists(scheme_file))) {
cli::cli_abort(c("Отсутствуют файлы схем для следующих наименований:", paste("-", names(scheme_file)[!file.exists(scheme_file)])))
}
db_files <- paste0("db/", scheme_names, ".sqlite") db_files <- paste0(config::get("form_app_configure_path"), "/db/", scheme_names, ".sqlite")
hash_file <- "temp/schema_hash.rds" hash_file <- "temp/schema_hash.rds"
@@ -68,12 +89,18 @@ check_and_init_scheme = function() {
} }
} }
# MAKING BACKUPS
if (Sys.getenv("FORM_APP_LOCAL_DB_BACKUP_PATH") != "") {
cli::cli_inform(c("*" = "создание бэкапов баз данных..."))
purrr::walk(scheme_names, local_db_backup)
}
# перезаписываем файл # перезаписываем файл
if (!dir.exists("temp")) dir.create("temp") if (!dir.exists("temp")) dir.create("temp")
saveRDS(exist_hash, hash_file) saveRDS(exist_hash, hash_file)
} }
init_scheme = function(scheme_file) { init_scheme = function(scheme_file) {
options(box.path = here::here()) options(box.path = here::here())
@@ -82,7 +109,8 @@ init_scheme = function(scheme_file) {
modules/scheme_generator[scheme_R6] modules/scheme_generator[scheme_R6]
) )
if (!dir.exists("db")) dir.create("db") db_path <- fs::path(config::get("form_app_configure_path"), "db")
if (!dir.exists(db_path)) dir.create(db_path)
cli::cli_h1("Инициализация схемы") cli::cli_h1("Инициализация схемы")
schms <- purrr::map2( schms <- purrr::map2(

View File

@@ -22,6 +22,10 @@ scheme_R6 <- R6::R6Class(
check <- private$reserved_table_names %in% private$nested_forms_names check <- private$reserved_table_names %in% private$nested_forms_names
if (any(check)) cli::cli_abort(c("нельзя использовать данные имена вложенных таблиц:", paste("- ", private$reserved_table_names[check]))) if (any(check)) cli::cli_abort(c("нельзя использовать данные имена вложенных таблиц:", paste("- ", private$reserved_table_names[check])))
# проверка на длину строк
check <- (nchar(private$nested_forms_names) > 31)
if (any(check)) cli::cli_abort(c("нельзя использовать имена длиной более 31 символа:", paste("- ", private$nested_forms_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) {

View File

@@ -162,7 +162,7 @@ render_forms = function(
choices = choices, choices = choices,
selected = NULL, selected = NULL,
options = list( options = list(
create = FALSE, create = TRUE,
onInitialize = I('function() { this.setValue(""); }') onInitialize = I('function() { this.setValue(""); }')
) )
) )
@@ -177,7 +177,7 @@ render_forms = function(
selected = NULL, selected = NULL,
multiple = TRUE, multiple = TRUE,
options = list( options = list(
create = FALSE, create = TRUE,
onInitialize = I('function() { this.setValue(""); }') onInitialize = I('function() { this.setValue(""); }')
) )
) )
@@ -264,6 +264,7 @@ update_forms_with_data = function(
ns ns
) { ) {
options(box.path = here::here())
box::use(modules/data_manipulations[is_this_empty_value]) box::use(modules/data_manipulations[is_this_empty_value])
# print("-----------------") # print("-----------------")

View File

@@ -318,6 +318,16 @@
"Repository": "CRAN", "Repository": "CRAN",
"Hash": "14eb0596f987c71535d07c3aff814742" "Hash": "14eb0596f987c71535d07c3aff814742"
}, },
"config": {
"Package": "config",
"Version": "0.3.2",
"Source": "Repository",
"Repository": "RSPM",
"Requirements": [
"yaml"
],
"Hash": "8b7222e9d9eb5178eea545c0c4d33fc2"
},
"cpp11": { "cpp11": {
"Package": "cpp11", "Package": "cpp11",
"Version": "0.5.1", "Version": "0.5.1",