0.16.0

.Rprofile

@@ -1 +1,20 @@
 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}:"
+    ))
+  }
+})()

.gitignore

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

CHANGELOG.md

@@ -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)
 ##### features
 - added `description_header` form type;

README.md

@@ -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`
 
 Файл, формирующий структуру всей формы, представляет собой таблицу в формате `.xlsx`, состоящий из следующих столбцов:
 
-- `part` - группировка первого уровня (страницы);
+- `part` - группировка первого уровня (страницы), используется только в главной схеме ('main');
 - `subgroup` - группировка второго уровня (колонки);
-- `form_id` - id;
+- `form_id` - id формы;
 - `form_label` - Название формы;
 - `form_description` - Описание формы;
 - `form_type` - тип формы, в настоящее время доступные следующие варианты:
@@ -32,20 +71,17 @@
   - `checkboxes` - выбор нескольких вариантов (checkboxes); 
   - `description` - описание (отображение текста, без формы выбора/ввода);
   - `description_header` - для отображение заголовка;
-  - `nested_form` - вложенная форма;
+  - `nested_forms` - вложенная форма;
 - `choices` - варианты выбора (если предполагаются типом формы ввода);
 - `condition` - условие, при котором форма ввода будет отображаться;
 - `required` - проверка заполненности поля: пустое значение - нет проверки, 1 - есть проверка
 
+Первый по порядку id – для каждой схемы является ключевой (!)
+
 # Как пользоваться
 
 ## Авторизация
 
-Пароль базы данных с авторизацией необходимо указать в `.Renviron`:
-
-```
-AUTH_DB_KEY = "this_is_your_password"
-```
 
 # trade-ofs
 

app.R

@@ -9,30 +9,34 @@ suppressPackageStartupMessages({
   library(shinymanager)
 })
 
-# КАК ЗАПРЯТЯАТЬ ID
-
 # SOURCE FILES ============================
 box::purge_cache()
 box::use(
   modules/utils,
   modules/global_options,
-  modules/global_options[enabled_schemas],
   modules/db,
   modules/data_validation,
   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(
   shiny.host = "0.0.0.0"
-  # enabled_schemas = "example_of_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
 # TEMP ! NEED TO HANDLE
 rmarkdown::find_pandoc(dir = "/opt/homebrew/bin/")
@@ -45,7 +49,14 @@ schms <- readRDS("scheme.rds")
 
 # UI =======================
 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"),
   sidebar = sidebar(
     actionButton("add_new_main_key_button", "Добавить новую запись", icon("plus", lib = "font-awesome")),
@@ -59,12 +70,9 @@ ui <- page_sidebar(
     position = "left",
     open = list(mobile = "always")
   ),
-  as_fill_carrier(uiOutput("main_ui_navset"))
+  as_fill_carrier(uiOutput("main_ui_navset")),
 )
 
-# MODALS ========================
-# окно для подвтерждения очищения данных
-
 # init auth =======================
 if (AUTH_ENABLED) {
   # shinymanager::set_labels("en", "Please authenticate" = "scheme()")
@@ -118,9 +126,9 @@ server <- function(input, output, session) {
     if (AUTH_ENABLED) {
       reactiveValuesToList(res_auth)
       if (res_auth$admin) {
-        print("admin")
+        # print("admin")
       } else {
-        print("not_admin")
+        # print("not_admin")
         showing_buttons <- FALSE
       }
     }
@@ -147,8 +155,8 @@ server <- function(input, output, session) {
     nested_form_id = NULL
   )
 
-  scheme <- reactiveVal(enabled_schemas[1]) # наименование выбранной схемы
-  mhcs   <- reactiveVal(schms[[enabled_schemas[1]]]) # объект для выбранной схемы
+  scheme <- reactiveVal(enabled_schemes[1]) # наименование выбранной схемы
+  mhcs   <- reactiveVal(schms[[enabled_schemes[1]]]) # объект для выбранной схемы
   observers_started <- reactiveVal(NULL)
 
   main_form_is_empty <- reactiveVal(TRUE)
@@ -166,7 +174,7 @@ server <- function(input, output, session) {
         shiny::radioButtons(
           "schmes_selector",
           label = strong("Выбрать базу данных для работы:"),
-          choices = enabled_schemas,
+          choices = enabled_schemes,
           selected = scheme()
         ),
         "Для начала работы нужно создать новую запись или загрузить существующую!",
@@ -234,8 +242,8 @@ server <- function(input, output, session) {
   ) {
 
     nested_key_id <- mhcs()$get_key_id(table_name)
-    input_types <- unname(id_and_types_list)
-    input_ids   <- names(id_and_types_list)
+    input_types   <- unname(id_and_types_list)
+    input_ids     <- names(id_and_types_list)
 
     if (missing(ns)) ns <- NULL
 
@@ -342,8 +350,13 @@ server <- function(input, output, session) {
     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)
-    if (nrow(this_nested_form_key_scheme) > 1) cli::cli_abort("количество строк не может быть больше одного для ключа")
+    this_nested_form_key_scheme <- this_nested_form_scheme |>
+      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)
@@ -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]]
 
     # если ключ в формате даты - дать человекочитаемые данные
-    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,
         format(as.Date(kyes_for_this_table), "%d.%m.%Y")
@@ -390,7 +403,7 @@ server <- function(input, output, session) {
         width = 300,
         selectizeInput(
           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,
           selected = values$nested_key,
           # options = list(placeholder = "действие комиссии", create = FALSE, onInitialize = I('function() { this.setValue(""); }'))
@@ -589,6 +602,8 @@ server <- function(input, output, session) {
         mhcs(),
         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 пациента!")
     )
     span(
-      strong("Таблица: "), names(enabled_schemas)[enabled_schemas == scheme()],
+      strong("Таблица: "), names(enabled_schemes)[enabled_schemes == scheme()],
       br(),
       strong("ID: "), values$main_key
     )
@@ -868,6 +883,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 +891,26 @@ 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_schemes)[enabled_schemes == scheme()],
+        "id базы"        , scheme(),
+        "id формы"       , config::get("form_id"),
+        "ver формы"      , config::get("form_app_version"),
+        "Время выгрузки" , format(Sys.time(), "%d.%m.%Y %H:%M:%S"),
+      )
+
       # set date params
       options("openxlsx2.dateFormat" = "dd.mm.yyyy")
 
@@ -1044,6 +1072,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 +1083,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 +1096,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 +1116,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 +1146,7 @@ server <- function(input, output, session) {
 
       # очистка от пустых ключей
       df <- df |>
-        dplyr::filter(!is.na(main_key))
+        dplyr::filter(!is.na({{main_key_id}}))
 
       DBI::dbWriteTable(
         con,
@@ -1124,7 +1155,7 @@ server <- function(input, output, session) {
         append = TRUE
       )
 
-      message <- glue::glue("Данные таблицы '{table_name}' успешно обновлены")
+      message <- glue::glue("Данные таблицы '{table_name}' успешно обновлены (добавлено {nrow(df)} записей)")
       showNotification(
         message,
         type = "message"
@@ -1166,7 +1197,7 @@ server <- function(input, output, session) {
       "exporting data to xlsx",
       "importing data from xlsx"
     ),
-    key = NULL,
+    key = NA,
     con
   ) {
 
@@ -1175,6 +1206,8 @@ server <- function(input, output, session) {
     action_row <- tibble(
       date        = Sys.time(),
       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,
       key         = key,
       action      = action,

config.yml

@@ -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

configs/enabled_schemes.R

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

modules/data_validation.R

@@ -1,14 +1,13 @@
+options(box.path = here::here())
+box::use(modules/data_manipulations[is_this_empty_value])
 
 #' @export
 init_val = function(scheme, ns) {
 
-  options(box.path = here::here())
-  box::use(modules/data_manipulations[is_this_empty_value])
-
   iv <- shinyvalidate::InputValidator$new()
 
   # если передана функция с пространством имен, то происходит модификация id
-  if(!missing(ns)) {
+  if (!missing(ns)) {
     scheme <- scheme |>
       dplyr::mutate(form_id = ns(form_id))
   }
@@ -37,18 +36,7 @@ init_val = function(scheme, ns) {
       # value `0; 250` -> transform to rule validation value from 0 to 250
       if (form_type == "number") {
 
-        iv$add_rule(x_input_id, 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 "Значение должно быть числом."
-        })
+        iv$add_rule(x_input_id, val_is_a_number)
 
         # проверка на соответствие диапазону значений
         if (!is.na(choices)) {
@@ -59,51 +47,15 @@ init_val = function(scheme, ns) {
           if (length(ranges) > 3) {
             warning("Количество переданных элементов'", x_input_id, "' > 2")
           } else {
-            iv$add_rule(
-              x_input_id,
-              function(x) {
-
-                # exit if empty
-                if (is_this_empty_value(x)) {
-                  return(NULL)
-                }
-
-                if (x == "NA") return(NULL)
-
-                # замена разделителя десятичных цифр
-                x <- stringr::str_replace(x, ",", ".")
-
-                # check for currect value
-                if (dplyr::between(as.double(x), ranges[1], ranges[2])) {
-                  NULL
-                } else {
-                  glue::glue("Значение должно быть между {ranges[1]} и {ranges[2]}.")
-                }
-              }
-            )
+            iv$add_rule(x_input_id, val_number_within_a_range, ranges = ranges)
           }
         }
       }
 
       if (form_type %in% c("select_multiple", "select_one", "radio", "checkbox")) {
-        iv$add_rule(x_input_id, function(x) {
-
-          if (length(x) == 1) {
-            if (is_this_empty_value(x)) return(NULL)
-          }
-
-          # проверка на соответствие вариантов схеме ---------
-          compare_to_dict <- (x %in% choices)
-          if (!all(compare_to_dict)) {
-
-            text <- paste0("'",x[!compare_to_dict],"'", collapse = ", ")
-            glue::glue("варианты, не соответствующие схеме: {text}")
-          }
-        })
-
+        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 = "Необходимо заполнить."))
@@ -112,3 +64,53 @@ init_val = function(scheme, ns) {
   )
   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)
+
+  # замена разделителя десятичных цифр
+  x <- stringr::str_replace(x, ",", ".")
+
+  # check for currect value
+  if (dplyr::between(as.double(x), ranges[1], ranges[2])) {
+    NULL
+  } else {
+    glue::glue("Значение должно быть между {ranges[1]} и {ranges[2]}.")
+  }
+}
+
+# списки ---------------------------------------------------------
+## являются ли выбранные значения допустимы (согласно файлу схемы)
+val_choice_within_a_dict = function(x, choices) {
+
+  if (length(x) == 1) {
+    if (is_this_empty_value(x)) return(NULL)
+  }
+
+  # проверка на соответствие вариантов схеме ---------
+  compare_to_dict <- (x %in% choices)
+  if (!all(compare_to_dict)) {
+
+    text <- paste0("'",x[!compare_to_dict],"'", collapse = ", ")
+    glue::glue("варианты, не соответствующие схеме: {text}")
+  }
+}

modules/db.R

@@ -4,7 +4,12 @@
 #' @param where text mark to distingiush calss
 make_db_connection = function(scheme, 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
@@ -12,12 +17,14 @@ make_db_connection = function(scheme, where = "") {
 #' Function to close connection to db, disigned to easy dubugging and
 #' hide warnings.
 close_db_connection = function(con, where = "") {
+
   tryCatch(
     expr = DBI::dbDisconnect(con),
     error = function(e) print(e),
     warning = function(w) if (getOption("APP.DEBUG", FALSE)) message("=!= ALREADY DISCONNECTED ", where),
     finally = if (getOption("APP.DEBUG", FALSE)) message("=/= DB DISCONNECT ", where)
   )
+
 }
 
 #' @export
@@ -191,6 +198,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,6 +206,7 @@ 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),
     )
 
   if (table_name == "main") {
@@ -327,3 +336,71 @@ excel_to_db_dates_converter = function(date) {
   fin_date <- as.character(format(fin_date, "%Y-%m-%d"))
   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)
+
+      }
+  
+    }
+  )
+
+}
+

modules/global_options.R

@@ -3,13 +3,27 @@
 set_global_options = function(
   SYMBOL_DELIM = "; ",
   APP.DEBUG = FALSE,
-  # APP.FILE_DB = fs::path("data.sqlite"),
   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(
     SYMBOL_DELIM = SYMBOL_DELIM,
+    # form.db_path = config::get("form_db_path"),
     APP.DEBUG = APP.DEBUG,
     # APP.FILE_DB = APP.FILE_DB,
     shiny.host = shiny.host,
@@ -19,28 +33,35 @@ set_global_options = function(
 }
 
 #' @export
-enabled_schemas <- c(
-  `Тестовая база данных` = "example_of_scheme"
-  # `D2TRA (для отладки)` = "d2tra_t"
-)
+AUTH_ENABLED <- config::get("form_auth_enabled")
 
 #' @export
 check_and_init_scheme = function() {
 
   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(
+    fs::path(config::get("form_app_configure_path"), "configs", "enabled_schemes.R"),
     "modules/scheme_generator.R",
     "modules/utils.R"
   )
 
-  scheme_names <- enabled_schemas
-  scheme_file <- paste0("configs/schemas/", scheme_names, ".xlsx")
+  scheme_names <- enabled_schemes
+  scheme_file <- paste0(config::get("form_app_configure_path"), "/configs/schemas/", scheme_names, ".xlsx")
   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"
 
@@ -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")
   saveRDS(exist_hash, hash_file)
 }
 
-
 init_scheme = function(scheme_file) {
 
   options(box.path = here::here())
@@ -82,7 +109,8 @@ init_scheme = function(scheme_file) {
     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("Инициализация схемы")
   schms <- purrr::map2(

modules/scheme_generator.R

@@ -18,6 +18,14 @@ 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])))
+
+      # проверка на длину строк
+      check <- (nchar(private$nested_forms_names) > 31)
+      if (any(check)) cli::cli_abort(c("нельзя использовать имена длиной более 31 символа:", paste("- ", private$nested_forms_names[check])))
+
       purrr::walk(
         .x = purrr::set_names(private$nested_forms_names),
         .f = \(nested_form_id) {
@@ -109,6 +117,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 +141,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
     }
   )

modules/utils.R

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

renv.lock

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

utils/init_login_db.r

@@ -3,7 +3,7 @@
 # SETUP AUTH =============================
 # Init DB using credentials data
 credentials <- data.frame(
-  user = c("admin", "user"),
+  user     = c("admin", "user"),
   password = c("admin", "user"),
   # password will automatically be hashed
   admin = c(TRUE, FALSE),