@@ -17,7 +17,8 @@ box::use(
modules / db ,
modules / data_validation ,
app / forms ,
app / tasks
app / tasks ,
modules / data_manipulations [is_this_empty_value ]
)
# global settings:
@@ -61,7 +62,7 @@ ui <- page_sidebar(
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" ) ,
@@ -72,7 +73,7 @@ ui <- page_sidebar(
span (
config :: get ( " form_app_version" ) ,
fontawesome :: fa ( " circle-info" , a11y = " sem" , title = " Settings" ) ,
style = " color: #9c9c9c; position: fixed; bottom: 5px; righ t: 5px;" ) ,
style = " color: #9c9c9c; position: fixed; bottom: 5px; lef t: 5px;" ) ,
title = " about" ,
placement = " left" ,
tagList ( span ( " здесь пока ничего нет" ) , br ( ) , span ( " вот" ) )
@@ -126,6 +127,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 ( {
@@ -157,29 +175,60 @@ server <- function(input, output, session) {
}
} )
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# REACTIVE VALUES =================================
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# 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 -------------------------------
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -187,15 +236,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_scheme s,
choices = values $ user_form_acces s,
selected = scheme ( )
) ,
hr ( ) ,
@@ -207,13 +257,20 @@ server <- function(input, output, session) {
# загрузка панели для работы с базой данных
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 ( " Обратитесь к системному администратору." )
)
}
} )
@@ -222,7 +279,7 @@ 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 )
@@ -356,6 +413,7 @@ server <- function(input, output, session) {
## кнопки для каждой вложенной таблицы -------------------------------
observe ( {
req ( scheme ( ) )
# проверка инициализированы ли для этой схемы наблюдатели для кнопок вложенных таблиц
is_observer_is_started <- ( isolate ( scheme ( ) ) %in% isolate ( observers_started ( ) ) )
@@ -746,6 +804,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" ) | >
@@ -797,6 +856,8 @@ server <- function(input, output, session) {
## переход на главный акран -----------------------
### show modal -------
observeEvent ( input $ clean_data_button , {
req ( main_form_is_empty ( ) == " form" )
showModal ( modalDialog (
" Данное действие очистит все заполненные данные. Убедитесь, что нужные данные сохранены." ,
title = " Очистить форму?" ,
@@ -814,7 +875,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" )
@@ -844,6 +905,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" ) )
@@ -925,7 +987,7 @@ server <- function(input, output, session) {
}
main_form_is_empty ( FALSE )
main_form_is_empty ( " form" )
}
@@ -940,6 +1002,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 )
@@ -1009,6 +1072,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 (
" ---" ,
@@ -1018,7 +1083,6 @@ server <- function(input, output, session) {
" ---" ,
" \n"
)
box :: use ( modules / data_manipulations [is_this_empty_value ] )
# iterate by scheme parts
purrr :: walk (