Compare commits

...

9 Commits

13 changed files with 293 additions and 61 deletions

View File

@@ -30,3 +30,14 @@ source("renv/activate.R")
}
})()
# при первом запуске скопировать пример конфига
(function() {
if (!file.exists("config.yml")) {
file.copy("config_example.yml", "config.yml")
}
})()

View File

@@ -1,3 +1,11 @@
### 0.18.1 (2026-06-08)
##### fix
- правильный экспорт текстовых данных
### 0.18.0 (2026-06-06)
##### features
- возможность отрганичить доступ к базам данных для отдельных пользователей
### 0.17.0 (2026-04-24)
##### features
- модуль с задачами: для каждой записи в базе можно создать задачи, на главном экране отображается общее количество активных задач, по сроку выполнения на сегодня и просроченные задачи;

View File

@@ -23,10 +23,11 @@ git clone https://gitea.madelirihs.ru/madeliri/shiny_form.git
Восстановление окружения
```r
renv::activate()
renv::init()
```
# Насторйки
# Настройки
## переменные окружения
@@ -46,7 +47,8 @@ FORM_APP_LOCAL_DB_BACKUP_PATH="path_to_backups"
Проверка осуществляется при каждом запуске приложения, бэкапы создаются раз в день (при первом запуске).
Количество сохраняемых бэкапов:
Количество послдних сохраненных бэкапов:
```
FORM_APP_LOCAL_DB_BACKUP_LIMITS=3
```

170
app.R
View File

@@ -17,7 +17,9 @@ box::use(
modules/db,
modules/data_validation,
app/forms,
app/tasks
app/tasks,
app/logs,
modules/data_manipulations[is_this_empty_value]
)
# global settings:
@@ -45,37 +47,41 @@ schms <- readRDS("scheme.rds")
# TODO: dynamic button render depend on pandoc installation
if (!rmarkdown::pandoc_available()) warning("Can't find pandoc!")
# web resources ------
shiny::addResourcePath("www", "www")
# UI =======================
ui <- page_sidebar(
# title = config::get("form_name"),
title = tagList(
h4(config::get("form_name"), style = "margin-top: .5rem"),
popover(
span(
config::get("form_app_version"),
fontawesome::fa("circle-info", a11y = "sem", title = "Settings"),
style = "color: #9c9c9c"),
title = "about",
placement = "left",
tagList(span("здесь пока ничего нет"), br(), span("вот"))
)
),
title = config::get("form_name"),
theme = bs_theme(version = 5, preset = "bootstrap"),
header = tags$head(
tags$link(rel = "icon", href = "www/favicon.ico")
),
sidebar = sidebar(
actionButton("add_new_main_key_button", "Добавить новую запись", icon("plus", lib = "font-awesome")),
actionButton("save_data_button", "Сохранить данные", icon("floppy-disk", lib = "font-awesome")),
actionButton("clean_data_button", "Главная страница", icon("house", lib = "font-awesome")),
actionButton("load_data_button", "Загрузить данные", icon("pencil", lib = "font-awesome")),
downloadButton("downloadDocx", "get .docx (test only)"),
# downloadButton("downloadDocx", "get .docx (test only)"),
uiOutput("status_message"),
textOutput("status_message2"),
uiOutput("display_log"),
actionButton("tasks-display_task_modal", "Задачи: нет активных", icon("list-check")),
uiOutput("logs-display_log"),
position = "left",
open = list(mobile = "always")
open = list(mobile = "always"),
popover(
span(
config::get("form_app_version"),
fontawesome::fa("circle-info", a11y = "sem", title = "Settings"),
style = "color: #9c9c9c; position: fixed; bottom: 5px; left: 5px;"),
title = "about",
placement = "left",
tagList(span("здесь пока ничего нет"), br(), span("вот"))
)
),
as_fill_carrier(uiOutput("main_ui_navset")),
)
# init auth =======================
@@ -122,6 +128,23 @@ server <- function(input, output, session) {
NULL
}
user_access <- function(string) {
if (is_this_empty_value(string)) return(NA)
if (string == "all") return("all")
forms_access <- stringr::str_split_1(string, ", ")
# check if exists
exists <- forms_access %in% enabled_schemes
if (!all(exists)) {
cli::cli_warn(c("these forms is not exist:", paste("- ", forms_access[!exists])))
}
# возращаем схемы для которых есть доступ
forms_access[exists]
}
# важные кнопки управления
output$admin_buttons_panel <- renderUI({
@@ -142,12 +165,16 @@ server <- function(input, output, session) {
if (showing_buttons) {
tagList(
br(),
strong("Импорт и экспорт данных для выбранной схемы:"),
verticalLayout(
downloadButton("downloadData", "Экспорт в .xlsx", style = "width: 250px; margin-top: 5px"),
actionButton("button_upload_data_from_xlsx", "импорт!", icon("file-import", lib = "font-awesome"), style = "width: 250px; margin-top: 10px"),
fluid = FALSE
),
strong("Дополнительные опции:"),
verticalLayout(
actionButton("logs-show_last_actions", "Все действия", icon("scroll", lib = "font-awesome"), style = "width: 250px; margin-top: 10px"),
fluid = FALSE
)
)
}
@@ -159,23 +186,53 @@ server <- function(input, output, session) {
# Create a reactive values object to store the input data
values <- reactiveValues(
data = NULL,
tasks_data = NULL,
main_key = NULL,
nested_key = NULL,
nested_form_id = NULL,
tasks_id = NULL,
current_user = NULL
data = NULL,
tasks_data = NULL,
main_key = NULL,
nested_key = NULL,
nested_form_id = NULL,
tasks_id = NULL,
current_user = NULL,
user_form_access = enabled_schemes
)
scheme <- reactiveVal(enabled_schemes[1]) # наименование выбранной схемы
mhcs <- reactiveVal(schms[[enabled_schemes[1]]]) # объект для выбранной схемы
scheme <- reactiveVal(NULL) # наименование выбранной схемы
mhcs <- reactiveVal(NULL) # объект для выбранной схемы
observers_started <- reactiveVal(NULL)
main_form_is_empty <- reactiveVal(TRUE)
main_form_is_empty <- reactiveVal(NULL)
validator_main <- reactiveVal(NULL)
validator_nested <- reactiveVal(NULL)
# доступ к схемам
observe({
# определение доступа в завимости от условий (включена ли авторизация, и есть ли доступы)
res <- if (AUTH_ENABLED) {
# если администратор - полный доступ, если нет - проверка по полю
ifelse(res_auth$admin, "all", user_access(res_auth$scheme_access))
} else {
# если нет авторизации - полный доступ
"all"
}
if(length(res) == 0) return(NA)
# списки доступных схем
allowed_schemas <- if (is.na(res)) {
NA # нет доступа
} else if (res == "all") {
enabled_schemes # все схемы
} else {
enabled_schemes[enabled_schemes == res] # только указанные
}
# переопределяем переменные
main_form_is_empty(ifelse(is.na(res), "empty", "main_menu"))
values$user_form_access <- allowed_schemas
scheme(values$user_form_access[1])
mhcs(schms[[values$user_form_access[1]]])
})
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# reactive ui -------------------------------
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -183,15 +240,16 @@ server <- function(input, output, session) {
## reactive ui -----------------------------------
### main screen ------
output$main_ui_navset <- renderUI({
req(main_form_is_empty())
if (main_form_is_empty()) {
if (main_form_is_empty() == "main_menu") {
validator_main(NULL)
div(
h5("Выбрать базу данных для работы:"),
shiny::radioButtons(
"schmes_selector",
label = NULL,
choices = enabled_schemes,
choices = values$user_form_access,
selected = scheme()
),
hr(),
@@ -199,17 +257,23 @@ server <- function(input, output, session) {
hr(),
"Для начала работы нужно создать новую запись или загрузить существующую!",
hr(),
# сво
# загрузка панели для работы с базой данных
uiOutput("admin_buttons_panel")
)
} else {
} else if (main_form_is_empty() == "form") {
# list of rendered panels
validator_main(data_validation$init_val(mhcs()$get_scheme("main")))
validator_main()$enable()
mhcs()$get_main_form_ui
} else if (main_form_is_empty() == "empty") {
div(
h5("Нет доступных баз данных для работы"),
p("Для данного пользователя нет доступа к формам для работы."),
p("Обратитесь к системному администратору.")
)
}
})
@@ -218,7 +282,8 @@ server <- function(input, output, session) {
output$base_data <- renderUI({
if (main_form_is_empty() == TRUE) {
if (main_form_is_empty() == "main_menu") {
con <- db$make_db_connection(scheme(),"base_data")
on.exit(db$close_db_connection(con, "base_data"), add = TRUE)
@@ -231,13 +296,13 @@ server <- function(input, output, session) {
# задачи на сегодня
if ("tasks" %in% DBI::dbListTables(con)) {
tasks_count <- DBI::dbGetQuery(con, glue::glue("SELECT COUNT (task_id) FROM tasks WHERE task_status = 'active'")) |>
tasks_count <- DBI::dbGetQuery(con, glue::glue("SELECT COUNT (task_id) FROM \"tasks\" WHERE task_status = 'active'")) |>
dplyr::pull()
tasks_today_count <- DBI::dbGetQuery(con, glue::glue("SELECT COUNT (task_id) FROM tasks WHERE task_status = 'active' AND task_due_date = {as.integer(Sys.Date())}")) |>
tasks_today_count <- DBI::dbGetQuery(con, glue::glue("SELECT COUNT (task_id) FROM \"tasks\" WHERE task_status = 'active' AND task_due_date = {as.integer(Sys.Date())}")) |>
dplyr::pull()
tasks_overdue_count <- DBI::dbGetQuery(con, glue::glue("SELECT COUNT (task_id) FROM tasks WHERE task_status = 'active' AND task_due_date < {as.integer(Sys.Date())}")) |>
tasks_overdue_count <- DBI::dbGetQuery(con, glue::glue("SELECT COUNT (task_id) FROM \"tasks\" WHERE task_status = 'active' AND task_due_date < {as.integer(Sys.Date())}")) |>
dplyr::pull()
} else {
@@ -352,6 +417,7 @@ server <- function(input, output, session) {
## кнопки для каждой вложенной таблицы -------------------------------
observe({
req(scheme())
# проверка инициализированы ли для этой схемы наблюдатели для кнопок вложенных таблиц
is_observer_is_started <- (isolate(scheme()) %in% isolate(observers_started()))
@@ -647,10 +713,11 @@ server <- function(input, output, session) {
# загрузка данных в формы
forms$load_data_to_form(
df = df,
table_name = values$nested_form_id,
mhcs = mhcs,
table_name = values$nested_form_id,
mhcs = mhcs,
ns = NS(values$nested_form_id)
)
} else {
utils$clean_forms(values$nested_form_id, mhcs(), NS(values$nested_form_id))
}
@@ -742,6 +809,7 @@ server <- function(input, output, session) {
## добавить новый главный ключ ------------------------
### modal -------
observeEvent(input$add_new_main_key_button, {
req(main_form_is_empty() != "empty")
# данные для главного ключа
scheme_for_key_input <- mhcs()$get_scheme("main") |>
@@ -793,6 +861,8 @@ server <- function(input, output, session) {
## переход на главный акран -----------------------
### show modal -------
observeEvent(input$clean_data_button, {
req(main_form_is_empty() == "form")
showModal(modalDialog(
"Данное действие очистит все заполненные данные. Убедитесь, что нужные данные сохранены.",
title = "Очистить форму?",
@@ -810,7 +880,7 @@ server <- function(input, output, session) {
# rewrite all inputs with empty data
values$main_key <- NULL
utils$clean_forms("main", mhcs())
main_form_is_empty(TRUE)
main_form_is_empty("main_menu")
removeModal()
showNotification("Данные очищены!", type = "warning")
@@ -840,6 +910,7 @@ server <- function(input, output, session) {
## загрузка данных -------------------
### modal with keys -----
observeEvent(input$load_data_button, {
req(main_form_is_empty() != "empty")
con <- db$make_db_connection(scheme(),"load_data_button")
on.exit(db$close_db_connection(con, "load_data_button"))
@@ -921,7 +992,7 @@ server <- function(input, output, session) {
}
main_form_is_empty(FALSE)
main_form_is_empty("form")
}
@@ -936,6 +1007,7 @@ server <- function(input, output, session) {
paste0(isolate(scheme()), "_", format(Sys.time(), "%Y%m%d_%H%M%S"), ".xlsx")
},
content = function(file) {
req(main_form_is_empty() != "empty")
con <- db$make_db_connection(isolate(scheme()),"downloadData")
on.exit(db$close_db_connection(con, "downloadData"), add = TRUE)
@@ -953,7 +1025,8 @@ 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))
# other_cols <- which(colnames(df) %in% c(date_columns, number_columns))
other_cols <- colnames(df)[!(colnames(df) %in% c(date_columns, number_columns))]
df <- df |>
dplyr::mutate(
@@ -961,7 +1034,7 @@ 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::across(tidyselect::all_of({{other_cols}}), \(x) dplyr::if_else(x == "", as.character(NA), as.character(x)))
) |>
# очистка от пустых ключей
dplyr::filter(!is.na(mhcs()$get_main_key_id))
@@ -1005,6 +1078,8 @@ server <- function(input, output, session) {
paste0(values$main_key, "_", format(Sys.time(), "%Y%m%d_%H%M%S"), ".docx")
},
content = function(file) {
req(main_form_is_empty() != "empty")
# prepare YAML sections
empty_vec <- c(
"---",
@@ -1014,7 +1089,6 @@ server <- function(input, output, session) {
"---",
"\n"
)
box::use(modules/data_manipulations[is_this_empty_value])
# iterate by scheme parts
purrr::walk(
@@ -1170,7 +1244,8 @@ 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))
# other_cols <- which(colnames(df) %in% c(date_columns, number_columns))
other_cols <- colnames(df)[!(colnames(df) %in% c(date_columns, number_columns))]
# функция для преобразование числовых значений и сохранения "NA"
num_converter <- function(old_col) {
@@ -1188,9 +1263,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)
dplyr::across(tidyselect::all_of({{other_cols}}), \(x) dplyr::if_else(x == "", as.character(NA), as.character(x)))
) |>
select(all_of(unique(c(main_key_id, scheme$form_id))))
@@ -1293,6 +1368,9 @@ server <- function(input, output, session) {
# TASKS ---------------------------------------
tasks$server("tasks", values, scheme, mhcs)
# SHOW LOGS -----------------------------------
logs$server("logs", values, scheme, mhcs)
}

129
app/logs.R Normal file
View File

@@ -0,0 +1,129 @@
box::use(
shiny[...],
bslib[...]
)
options(box.path = here::here())
box::use(
modules/db,
modules/utils,
app/forms
)
#' @export
server <- function(id, values, scheme, mhcs) {
ns <- NS(id)
moduleServer(id, function(input, output, session) {
# отображение DT-таблицы со списком последних действий
observeEvent(input$show_last_actions, {
con <- db$make_db_connection(scheme(),"show_last_actions")
on.exit(db$close_db_connection(con, "show_last_actions"), add = TRUE)
log_df <- DBI::dbReadTable(con, "log")
# новые записи вначале, формат даты с временем
log_df <- log_df |>
dplyr::arrange(dplyr::desc(date)) |>
dplyr::mutate(date = format(as.POSIXct(date), "%d.%m.%Y %H:%M"))
output$dt_logs <- DT::renderDataTable(
DT::datatable(
log_df,
# caption = 'Table 1: This is a simple caption for the table.',
rownames = FALSE,
colnames = logs_colnames,
extensions = c('KeyTable', "FixedColumns"),
# editable = 'cell',
class = 'cell-border stripe',
selection = "single",
options = list(
# dom = 'tipf',
scrollX = TRUE,
fixedColumns = list(leftColumns = 1),
keys = TRUE,
autoWidth = TRUE,
columnDefs = list(
list(width = "150px", targets = c(0,6)),
list(width = "110px", targets = c(1:4))
)
)
)
)
showModal(modalDialog(
DT::dataTableOutput(ns("dt_logs")),
size = "xl",
# footer = tagList(
# actionButton("nested_form_dt_save", "сохранить изменения")
# ),
easyClose = TRUE
))
})
# observe({
# print(input$dt_logs_rows_selected)
# })
output$display_log <- renderUI({
req(values$main_key)
# получение логов
con <- db$make_db_connection(scheme(),"display_log")
on.exit(db$close_db_connection(con, "display_log"), add = TRUE)
query <- sprintf("SELECT * FROM \"log\" WHERE key = '%s'", values$main_key)
log_df_for_id <- DBI::dbGetQuery(con, query)
if (nrow(log_df_for_id) > 0) {
lines <- log_df_for_id |>
dplyr::mutate(
date = as.POSIXct(date),
date = date + lubridate::hours(3), # fix datetime
date_day = as.Date(date)
) |>
dplyr::mutate(cons_actions = dplyr::consecutive_id(action, user)) |>
dplyr::mutate(n_actions = dplyr::row_number(), .by = c(cons_actions, user, action, date_day)) |>
dplyr::slice(which.max(n_actions), .by = c(user, action, date_day)) |>
dplyr::arrange(date) |>
dplyr::mutate(string_to_print = sprintf(
"<b>[%s %s]</b> %s: %s (%s)",
format(date, "%d.%m.%y"),
format(date, "%H:%M"),
user,
action,
n_actions
)) |>
dplyr::pull(string_to_print) |>
paste(collapse = "</br>")
} else {
lines <- ""
}
div(
strong("Последние действия:"),
br(),
HTML(lines),
style = "font-size:10px;"
)
})
})
}
logs_colnames <- c(
"время" = "date",
"пользователь" = "user",
"приложение" = "app_id",
"версия" = "app_ver",
"ip" = "remote_addr",
"ID записи" = "key",
"действие" = "action"
)

View File

@@ -1,4 +1,3 @@
box::use(
shiny[...],
bslib[...]
@@ -239,7 +238,6 @@ server <- function(id, values, scheme, mhcs) {
date_cols <- c("task_datetime_created", "task_datetime_completed", "task_datetime_last_updated", "task_due_date")
date_cols <- which(colnames(values$tasks_data) %in% date_cols)
output$dt_tasks <- DT::renderDataTable(
DT::datatable(
values$tasks_data,
@@ -438,13 +436,11 @@ update_task_button_count <- function(con, values, ns) {
inputID <- "display_task_modal"
if (!missing(ns)) inputID <- ns(inputID)
# если ключ не определен - выход из функции
if (is.null(values$main_key)) {
updateActionButton(inputId = inputID, label = "Задачи")
return()
}
# при наличии таблицы - полу

View File

@@ -1,4 +1,4 @@
default:
form_app_version: 0.17.0
form_id: new_formy
form_name: NEW FORMY
form_app_version: 0.18.1
form_id: formy
form_name: FORMY

View File

@@ -10,6 +10,7 @@ make_db_connection = function(scheme, where = "") {
scheme,
ext = "sqlite"
))
}
#' @export
@@ -200,7 +201,8 @@ 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))
# other_cols <- which(colnames(df) %in% c(date_columns, number_columns))
other_cols <- colnames(df)[!(colnames(df) %in% c(date_columns, number_columns))]
df <- df |>
dplyr::mutate(
@@ -208,7 +210,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),
dplyr::across(tidyselect::all_of({{other_cols}}), \(x) dplyr::if_else(x == "", as.character(NA), as.character(x)))
)
if (table_name == "main") {

View File

@@ -54,8 +54,13 @@ check_and_init_scheme = function() {
"modules/utils.R"
)
# проверка существования отслеживаемых файлов
if (!all(file.exists(files_to_watch))) {
cli::cli_abort("проверка схем: {files_to_watch[!file.exists(files_to_watch)]} is not exists")
}
scheme_names <- names(config::get()$form_schemes)
scheme_file <- paste0(config::get("form_app_configure_path"), "/configs/schemas/", scheme_names, ".xlsx")
scheme_file <- paste0(config::get("form_app_configure_path"), "/schemas/", scheme_names, ".xlsx")
scheme_file <- stats::setNames(scheme_file, scheme_names)
if (!all(file.exists(scheme_file))) {

BIN
test.xlsx Normal file

Binary file not shown.

View File

@@ -3,10 +3,11 @@
# SETUP AUTH =============================
# Init DB using credentials data
credentials <- data.frame(
user = c("admin", "user"),
password = c("admin", "user"),
user = c("admin", "user", "user2"),
password = c("admin", "user", "user2"),
# password will automatically be hashed
admin = c(TRUE, FALSE),
admin = c(TRUE, FALSE, FALSE),
scheme_access = c(NA, "all", "example_of_scheme"), # NA - none | all - all | string with seperate
stringsAsFactors = FALSE
)

BIN
www/favicon.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 295 KiB