R/shiny_module.R

Defines functions shiny_drive_server shiny_drive_ui

Documented in shiny_drive_server shiny_drive_ui

#' @import shiny htmltools
#' @importFrom tools file_ext file_path_sans_ext
#' @importFrom DT datatable renderDT DTOutput JS
#'
#' @export
#'
#' @rdname shiny_drive_module
shiny_drive_ui <- function(id){
  ns <- NS(id)
  tagList(
    singleton(tags$head(
      tags$script(src = "shinydrive/shiny_utils_sfm.js")
    )),
    
    # fix fontAwesome init loading...
    fluidRow(
      actionButton("fix FA", "fix FA", icon = icon("refresh"), style = "display:none")
    ),
    
    conditionalPanel(condition = "output.show_dir", ns = ns,
                     fluidRow(
                       column(12,
                              fluidRow(
                                column(2,
                                       uiOutput(ns("ui_title"))
                                ),
                                column(4,
                                       style = "margin-left: 15px;",
                                       selectInput(ns("select_file_dir"), NULL, choices = NULL, selected = NULL, width = "100%")
                                ),
                                conditionalPanel("output.is_admin", ns = ns,
                                                 column(5, uiOutput(ns("admin_dir_btn"))
                                                 )
                                )
                              )
                       )
                     ) 
    ),
    # End fold management
    conditionalPanel("output.is_admin", ns = ns,
                     uiOutput(ns("admin_add_file")),
                     tags$hr()
    ),
    conditionalPanel("output.have_files", ns = ns,
                     DT::DTOutput(ns("dt")),
                     uiOutput(ns("supress_all"))
    ),
    conditionalPanel("output.have_files === false", ns = ns,
                     uiOutput(ns("msg_no_file"))
    ),
    tags$br()
  )
}



#' File management shiny module.
#'
#' File management shiny module.
#'
#' @param id \code{character}. An ID string
#' @param input shiny input
#' @param output shiny input
#' @param session shiny input
#' @param save_dir \code{character/reactive}. Main directory of the files.
#' @param admin_user \code{boolean/reactive} (TRUE). Admin user or not.
#' @param lan \code{character/reactive} ("EN"). Language to be used in the module (FR, EN and CN availabled... contributions are welcome :)).
#' @param dir_access \code{character/reactive} vector for dir(s) access. Default to \code{NULL} (all directories)
#' @param file_translate \code{data.frame/reactive} File for translation.
#' @param force_desc \code{boolean/reactive} (FALSE). Force to add an entry description ?
#' @param datatable_options \code{list/reactive}.  \code{DT::datatable} options argument.
#' @param yml \code{characte/reactiver} yaml configuration file name.
#' @param date_time_format \code{character} DateTime format.
#' 
#' @return Shiny module without return value.
#' 
#' @importFrom utils zip read.csv
#'
#' @export
#'
#' @examples
#' \dontrun{
#'
#' if(require(shiny)){
#'   ui <- fluidPage(
#'     shiny_drive_ui(id = "idm")
#'   )
#'   server <- function(input, output, session) {
#'     callModule(module = shiny_drive_server,
#'              id = "idm",
#'              session = session,
#'              admin_user = TRUE,
#'              save_dir =  getwd(),
#'              lan = "FR")
#'   }
#'   shinyApp(ui, server)
#' }
#'
#' }
#'
#' @importFrom stats runif
#'
#' @rdname shiny_drive_module
#'
shiny_drive_server <- function(input,
                               output,
                               session,
                               id,
                               save_dir,
                               dir_access = NULL,
                               admin_user = TRUE,
                               force_desc = FALSE,
                               lan = "EN",
                               file_translate = read.csv(system.file("translate/translate.csv", package = "shinydrive"),
                                                         sep = ";",
                                                         encoding = "UTF-8",
                                                         check.names=FALSE), 
                               datatable_options = list(), 
                               yml = "files_desc.yaml", 
                               date_time_format = "%Y%m%d_%H%M%s") {
  
  ns <- session$ns
  
  if (!shiny::is.reactive(yml)){
    get_yml <- shiny::reactive({yml})
  } else {
    get_yml <- yml
  }
  
  if (!shiny::is.reactive(save_dir)){
    get_save_dir <- shiny::reactive({save_dir})
  } else {
    get_save_dir <- save_dir
  }
  
  if (!shiny::is.reactive(dir_access)){
    get_dir_access <- shiny::reactive({dir_access})
  } else {
    get_dir_access <- dir_access
  }
  
  if (!shiny::is.reactive(admin_user)){
    get_admin_user <- shiny::reactive({admin_user})
  } else {
    get_admin_user <- admin_user
  }
  
  if (!shiny::is.reactive(lan)){
    get_lan <- shiny::reactive({lan})
  } else {
    get_lan <- lan
  }
  
  if (!shiny::is.reactive(file_translate)){
    get_file_translate <- shiny::reactive({file_translate})
  } else {
    get_file_translate <- file_translate
  }
  
  if (!shiny::is.reactive(force_desc)){
    get_force_desc <- shiny::reactive({force_desc})
  } else {
    get_force_desc <- force_desc
  }
  if (! shiny::is.reactive(datatable_options)) {
    get_datatable_options <- shiny::reactive(datatable_options)
  } else {
    get_datatable_options <- datatable_options
  }
  
  output$msg_no_file <- renderUI({
    file_translate <- get_file_translate()
    req(file_translate)
    div(h4(file_translate[file_translate$ID == 45, get_lan()]), align = "center")
  })
  
  # Admin TRUE (pass to module at final version)
  output$is_admin <- reactive({
    get_admin_user()
  })
  outputOptions(output, "is_admin", suspendWhenHidden = FALSE)
  
  output$show_dir <- reactive({
    if(is.null(get_admin_user())){
      FALSE
    } else {
      (get_admin_user() | (!get_admin_user() & length(list.available.dirs()) >= 1))
    }
  })
  outputOptions(output, "show_dir", suspendWhenHidden = FALSE)
  
  output$ui_title <- renderUI({
    file_translate <- get_file_translate()
    req(file_translate)
    div(h4(file_translate[file_translate$ID == 1, get_lan()]), align = "center")
  })
  
  output$admin_dir_btn <- renderUI({
    file_translate <- get_file_translate()
    req(file_translate)
    fluidRow(
      column(4, actionButton(ns("create_file_dir_bis"),file_translate[file_translate$ID == 2, get_lan()], icon = icon("plus"))),
      column(4, 
             conditionalPanel("input.select_file_dir !== '/'", ns = ns,
                              actionButton(ns("rename_file_dir"), file_translate[file_translate$ID == 3, get_lan()], icon = icon("edit"))
             )
      ),
      column(4, 
             conditionalPanel("input.select_file_dir !== '/'", ns = ns,
                              actionButton(ns("remove_file_dir"), file_translate[file_translate$ID == 47, get_lan()], icon = icon("trash"))
             )
      )
    )
  })
  
  output$admin_add_file <- renderUI({
    file_translate <- get_file_translate()
    req(file_translate)
    actionButton(
      inputId = ns("add_file"),
      label = file_translate[file_translate$ID == 4, get_lan()],
      icon = icon("plus"),
      width = "100%",
      class = "btn-primary"
    )
  })
  # gestion dossier
  auto_udpate <- reactiveTimer(1000)
  list.available.dirs <- reactiveVal(NULL)
  
  observe({
    get_save_dir <- get_save_dir()
    req(get_save_dir)
    auto_udpate()
    if (!is.null(get_save_dir) && length(get_save_dir) > 0 && dir.exists(get_save_dir)){
      val <- list.dirs(get_save_dir, recursive = T, full.names = F)
    } else {
      val <- NULL
    }
    if(!isTRUE(all.equal(val, isolate(list.available.dirs())))){
      list.available.dirs(val)
    }
  })
  
  
  current_dir <- reactiveVal(NULL)
  
  observe({
    select_file_dir <- input$select_file_dir
    if(!is.null(select_file_dir)){
      if(select_file_dir == "") select_file_dir <- "/"
      current_dir(select_file_dir)
    }
  })
  
  observe({
    dir_access <- get_dir_access()
    list.available.dirs <- list.available.dirs()
    list.available.dirs <- c("/",list.available.dirs)
    if(!is.null(dir_access)){
      if("" %in% dir_access)  dir_access <- c(dir_access, "/")
      list.available.dirs <- list.available.dirs[list.available.dirs %in% dir_access]
    }
    
    isolate({
      if (!is.null(list.available.dirs) ){
        if(!is.null(current_dir()) && current_dir() %in% list.available.dirs){
          sel <- current_dir()
        } else {
          sel <- NULL
        }
        updateSelectInput(session,
                          "select_file_dir",
                          choices = list.available.dirs,
                          selected = sel)
      }
    })
  })
  
  
  observeEvent(input$create_file_dir_bis, {
    file_translate <- get_file_translate()
    
    removeModal()
    
    shiny::showModal(shiny::modalDialog(
      title = div(paste0(ifelse(input$select_file_dir != "/", paste0(input$select_file_dir, " : "), ""), file_translate[file_translate$ID == 5, get_lan()]), style = "color: #337ab7; font-size: 25px; font-weight: bold;"),
      shiny::textInput(ns("file_dir_desc"), file_translate[file_translate$ID == 6, get_lan()], value="", width = "100%"),
      footer = fluidRow(
        column(6, div(actionButton(ns("create_file_dir_ok"), file_translate[file_translate$ID == 2, get_lan()]), align = "center")),
        column(6, div(modalButton(file_translate[file_translate$ID == 7, get_lan()]), align = "center")
        )
      ),
      easyClose = FALSE
    ))
  }, ignoreInit = TRUE)
  
  observeEvent(input$rename_file_dir,{
    file_translate <- get_file_translate()
    
    list_dirs <- list.available.dirs()
    
    req(list_dirs)
    
    if(length(list_dirs) > 0){
      
      removeModal()
      
      shiny::showModal(shiny::modalDialog(
        title = div(paste0(ifelse(input$select_file_dir != "/", paste0(input$select_file_dir, " : "), ""), file_translate[file_translate$ID == 39, get_lan()]), style = "color: #337ab7; font-size: 25px; font-weight: bold;"),
        # selectInput(ns("select_file_dir_rename"), file_translate[file_translate$ID == 1, get_lan()], choices = list_dirs),
        shiny::textInput(ns("new_file_dir_desc"),  file_translate[file_translate$ID == 40, get_lan()],
                         value = "", width = "100%"),
        footer = fluidRow(
          column(6, div(actionButton(ns("rename_file_dir_selected"), file_translate[file_translate$ID == 3, get_lan()]), align = "center")),
          column(6, div(modalButton(file_translate[file_translate$ID == 7, get_lan()]), align = "center")
          )
        ),
        easyClose = FALSE
      ))
    } else {
      
      removeModal()
      
      shiny::showModal(shiny::modalDialog(
        easyClose = TRUE,
        footer = NULL,
        file_translate[file_translate$ID == 43, get_lan()]
      ))
    }
  }, ignoreInit = TRUE)
  
  
  # Renomer un sous-dossier
  observeEvent(input$rename_file_dir_selected,{
    
    save_dir <- isolate(get_save_dir())
    
    file_translate <- get_file_translate()
    
    list_dirs <- list.available.dirs()
    
    if (!is.null(input$new_file_dir_desc) && input$new_file_dir_desc == ""){
      removeModal()
      
      shiny::showModal(shiny::modalDialog(
        title = div(paste0(ifelse(input$select_file_dir != "/", paste0(input$select_file_dir, " : "), ""), file_translate[file_translate$ID == 39, get_lan()]), style = "color: #337ab7; font-size: 25px; font-weight: bold;"),
        shiny::textInput(ns("new_file_dir_desc"), file_translate[file_translate$ID == 40, get_lan()],
                         value = "", width = "100%"),
        easyClose = FALSE,
        footer = fluidRow(
          column(6, div(actionButton(ns("rename_file_dir_selected"),  file_translate[file_translate$ID == 3, get_lan()]), align = "center")),
          column(6, div(modalButton(file_translate[file_translate$ID == 7, get_lan()]), align = "center")
          )
        )
      ))
    } else {

      new_dir <- strsplit(input$select_file_dir, "/")[[1]]
      new_dir <- file.path(paste0(new_dir[-length(new_dir)], collapse = "/"), input$new_file_dir_desc)
      
      if (new_dir %in% list_dirs){
        removeModal()
        
        shiny::showModal(shiny::modalDialog(
          title = div(paste0(ifelse(input$select_file_dir != "/", paste0(input$select_file_dir, " : "), ""), file_translate[file_translate$ID == 39, get_lan()]), style = "color: #337ab7; font-size: 25px; font-weight: bold;"),
          shiny::textInput(ns("new_file_dir_desc"), file_translate[file_translate$ID == 8, get_lan()],
                           value = "", width = "100%"),
          easyClose = FALSE,
          footer = fluidRow(
            column(6, div(actionButton(ns("rename_file_dir_selected"),  file_translate[file_translate$ID == 3, get_lan()]), align = "center")),
            column(6, div(modalButton(file_translate[file_translate$ID == 7, get_lan()]), align = "center")
            )
          )
        ))
      } else {
        file.rename(from = file.path(save_dir, input$select_file_dir),
                    to = file.path(save_dir, new_dir))
        removeModal()
        shiny::showModal(shiny::modalDialog(
          easyClose = TRUE,
          footer = NULL,
          file_translate[file_translate$ID == 41, get_lan()]
        ))
      }
    }
  }, ignoreInit = TRUE)
  
  # supprimer un dossier
  observeEvent(input$remove_file_dir,{
    file_translate <- get_file_translate()
    
    list_dirs <- list.available.dirs()
    
    req(list_dirs)
    req(input$select_file_dir)
    
    if(length(list_dirs) > 0 && !input$select_file_dir %in% c("", "/")){
      
      removeModal()
      
      shiny::showModal(shiny::modalDialog(
        title = div(file_translate[file_translate$ID == 42, get_lan()], style = "color: #337ab7; font-size: 25px; font-weight: bold;"),
        div(h4(input$select_file_dir), align = "center"),
        footer = fluidRow(
          column(6, div(actionButton(ns("remove_file_dir_ok"), file_translate[file_translate$ID == 47, get_lan()]), align = "center")),
          column(6, div(modalButton(file_translate[file_translate$ID == 7, get_lan()]), align = "center")
          )
        ),
        easyClose = FALSE
      ))
    }
  }, ignoreInit = TRUE)
  
  observeEvent(input$remove_file_dir_ok,{
    save_dir <- isolate(get_save_dir())
    req(save_dir)
    req(input$select_file_dir)
    if(!input$select_file_dir %in% c("", "/")){
      tryCatch({
        fold_path <- file.path(save_dir, input$select_file_dir)
        unlink(fold_path, recursive = TRUE)
      }, error = function(e) NULL)
    }
    removeModal()
  }, ignoreInit = TRUE)
  
  observeEvent(input$create_file_dir_ok,{
    
    save_dir <- isolate(get_save_dir())
    
    file_translate <- get_file_translate()
    
    if (!is.null(input$file_dir_desc) && input$file_dir_desc == ""){
      shiny::showModal(shiny::modalDialog(
        title = div(paste0(ifelse(input$select_file_dir != "/", paste0(input$select_file_dir, " : "), ""), file_translate[file_translate$ID == 5, get_lan()]), style = "color: #337ab7; font-size: 25px; font-weight: bold;"),
        shiny::textInput(ns("file_dir_desc"), file_translate[file_translate$ID == 6, get_lan()], value="", width = "100%"),
        footer = fluidRow(
          column(6, div(actionButton(ns("create_file_dir_ok"), file_translate[file_translate$ID == 2, get_lan()]), align = "center")),
          column(6, div(modalButton(file_translate[file_translate$ID == 7, get_lan()]), align = "center")
          )
        ),
        easyClose = FALSE
      ))
    } else {
      
      if(isolate(input$select_file_dir) != "/"){
        new_dir <- gsub("^/", "", file.path(isolate(input$select_file_dir), input$file_dir_desc))
      } else {
        new_dir <- input$file_dir_desc
      }
      
      if (new_dir %in% list.available.dirs()){
        removeModal()
        
        shiny::showModal(shiny::modalDialog(
          title = div(file_translate[file_translate$ID == 5, get_lan()], style = "color: #337ab7; font-size: 25px; font-weight: bold;"),
          shiny::textInput(ns("file_dir_desc"), file_translate[file_translate$ID == 8, get_lan()], value="", width = "100%"),
          footer = fluidRow(
            column(6, div(actionButton(ns("create_file_dir_ok"), file_translate[file_translate$ID == 2, get_lan()]), align = "center")),
            column(6, div(modalButton(file_translate[file_translate$ID == 7, get_lan()]), align = "center")
            )
          ),
          easyClose = FALSE
        ))
      } else {
        fold_path <- file.path(save_dir, new_dir)
        create_test <- dir.create(fold_path)
        if (create_test){
          file.create(file.path(fold_path, isolate(get_yml())))
          current_dir(new_dir)
          removeModal()
          shiny::showModal(shiny::modalDialog(
            easyClose = TRUE,
            footer = NULL,
            file_translate[file_translate$ID == 9, get_lan()]
          ))
          
        } else {
          removeModal()
          shiny::showModal(shiny::modalDialog(
            easyClose = TRUE,
            footer = NULL,
            file_translate[file_translate$ID == 10, get_lan()]
          ))
        }
      }
    }
  }, ignoreInit = TRUE)
  
  req_yml <- reactive({
    
    save_dir <- get_save_dir()
    
    if(!is.null(input$select_file_dir) && input$select_file_dir != ""){
      if(input$select_file_dir !="/"){
        file.path(save_dir, input$select_file_dir, isolate(get_yml()))
      }else{
        file.path(save_dir, isolate(get_yml()))
      }
    } else {
      ""
    }
  })
  
  # End gestion dossier
  
  all_files <- reactiveFileReader(1000, session, req_yml, function(x){
    if (!is.null(x) && length(x) > 0 && file.exists(x)){
      get_yaml_info(x, 
                    recorded_name = TRUE,
                    date_time_format = date_time_format, 
                    add_img = TRUE, 
                    img_size = 30
      )
    } else {
      NULL
    }})
  
  output$have_files <- reactive({
    !is.null(all_files()) && nrow(all_files()) > 0
  })
  outputOptions(output, "have_files", suspendWhenHidden = FALSE)
  
  # launch modal to add a new file
  count_file_load <- reactiveVal(round(runif(1, 1, 100000000), 0))
  
  output$file_load <- renderUI({
    file_translate <- get_file_translate()
    
    fluidRow(
      column(12,
             fileInput(ns(paste0("file_load", count_file_load())), label = file_translate[file_translate$ID == 11, get_lan()])
      )
    )
  })
  
  output$file_comp_load <- renderUI({
    file_name <- input[[paste0("file_load", count_file_load())]]$name
    file_translate <- get_file_translate()
    
    if(is.null(file_name)){
      fluidRow()
    } else {
      fluidRow(
        column(12,
               textInput(ns("file_name"), paste0(file_translate[file_translate$ID == 13, get_lan()], " (*)"), tools::file_path_sans_ext(file_name)),
               p(file_translate[file_translate$ID == 14, get_lan()], tools::file_ext(file_name)),
               textInput(ns("description"), paste0(file_translate[file_translate$ID == 15, get_lan()], ifelse(isolate(get_force_desc()), " (*)", "")), "")
        )
      )
    }
  })
  
  observeEvent(input$add_file, {
    file_translate <- get_file_translate()
    
    count_file_load(count_file_load() + 1)
    
    removeModal()
    
    showModal(modalDialog(
      title = div(file_translate[file_translate$ID == 4, get_lan()], style = "color: #337ab7; font-size: 25px; font-weight: bold;"),
      easyClose = F,
      uiOutput(ns("file_load")),
      uiOutput(ns("file_comp_load")),
      tags$div(id = "placeholder-user-exist"),
      footer = tagList(
        modalButton(file_translate[file_translate$ID == 7, get_lan()]),
        actionButton(
          inputId = ns("added_file"),
          label = file_translate[file_translate$ID == 12, get_lan()],
          class = "btn-primary",
          `data-dismiss` = "modal"
        )
      )
    ))
  }, ignoreInit = TRUE)
  
  observe({
    file_info <- input[[paste0("file_load", count_file_load())]]
    name <- input$file_name
    description <- input$description
    
    if(!is.null(isolate(get_force_desc()))){
      if (isolate(get_force_desc()) && length(file_info) > 0 && length(name) > 0 && name != "" && length(description) > 0 && description != "") {
        toggleBtn(session = session, inputId = ns("added_file"), type = "enable")
      } else if (!isolate(get_force_desc()) && length(file_info) > 0 && length(name) > 0  && name != "") {
        toggleBtn(session = session, inputId = ns("added_file"), type = "enable")
      } else {
        toggleBtn(session = session, inputId = ns("added_file"), type = "disable")
      }
    }
  })
  
  # Add a file
  observeEvent(input$added_file, {
    
    save_dir <- isolate(get_save_dir())
    
    file_info <- input[[paste0("file_load", count_file_load())]]
    
    # To folder
    if(!is.null(input$select_file_dir) && input$select_file_dir != "/"){
      dir <- file.path(save_dir, input$select_file_dir)
    }else{
      dir <- save_dir
    }
    
    
    removeModal()
    
    ctrl_add <- tryCatch({
      add_file_in_dir(
        file = file_info$datapath,
        dir = dir,
        name = input$file_name,
        yml = req_yml(),
        description = input$description, 
        date_time_format = date_time_format
      )
    },
    error = function(e){
      showModal(
        modalDialog(
          title = "Error adding file",
          easyClose = TRUE,
          footer = NULL,
          e$message
        ))
      NULL
    })
    
  }, ignoreInit = TRUE)
  
  uniquenames <- reactive({
    req(all_files())
    dt <- all_files()
    uniquenames <- gsub("([[:space:]])+|([[:punct:]])+", "_", paste0(tools::file_path_sans_ext(dt$name), dt$date_time))
    uniquenames
  })
  
  ctname <- reactive({
    all_files()
    paste0(sample(LETTERS, 5), collapse = "")
  })
  
  output$dt <- DT::renderDT({
    
    unbindDTSFM(ns("dt"))
    
    req(all_files())
    
    dt <- all_files()
    dt$recorded_name <- NULL
    
    file_translate <- get_file_translate()
    
    if(nrow(dt) == 0) return(NULL)
    
    if(!is.null(get_admin_user) && get_admin_user()){
      dt$Edit <- input_btns(ns("edit_file"), uniquenames(), file_translate[file_translate$ID == 16, get_lan()], icon("pencil-square-o"), status = "primary")
      dt$Remove <- input_btns(ns("remove_file"), uniquenames(), file_translate[file_translate$ID == 17, get_lan()], icon("trash-o"), status = "danger")
    }
    
    dt$Download <- input_btns(ns("download_file"), uniquenames(), file_translate[file_translate$ID == 18, get_lan()], icon("download"), status = "success")
    
    dt$Select <- input_checkbox_ui(ns("remove_mult_files"), paste0(uniquenames(), ctname()), 
                                   session = session, 
                                   checked = FALSE)
    
    file_translate[[get_lan()]] <- as.character(file_translate[[get_lan()]])
    
    dt$id <- NULL
    
    if(get_admin_user()){
      if(ncol(dt) < 8){return(NULL)}
      names(dt) <- c(file_translate[file_translate$ID == 46, get_lan()],
                     file_translate[file_translate$ID == 19, get_lan()],
                     file_translate[file_translate$ID == 20, get_lan()],
                     file_translate[file_translate$ID == 21, get_lan()],
                     file_translate[file_translate$ID == 22, get_lan()],
                     file_translate[file_translate$ID == 23, get_lan()],
                     file_translate[file_translate$ID == 24, get_lan()],
                     file_translate[file_translate$ID == 25, get_lan()])
      
      
      target_wd_cols <- c(0, (ncol(dt)-4):(ncol(dt)-1))
    }else{
      if(ncol(dt) < 6){return(NULL)}
      
      names(dt) <- c( file_translate[file_translate$ID == 46, get_lan()],
                      file_translate[file_translate$ID == 19, get_lan()],
                      file_translate[file_translate$ID == 20, get_lan()],
                      file_translate[file_translate$ID == 21, get_lan()],
                      file_translate[file_translate$ID == 24, get_lan()],
                      file_translate[file_translate$ID == 25, get_lan()])
      
      target_wd_cols <- c(0, (ncol(dt)-2):(ncol(dt)-1))
    }
    
    default_options = list(
      language = list(url = file_translate[file_translate$ID == 26, get_lan()]),
      drawCallback = DT::JS("function() {Shiny.bindAll(this.api().table().node());}"),
      scrollX = TRUE,
      columnDefs = list(
        list(className =  "dt-head-center", "targets" = "_all"),
        list(width = "50px", targets = target_wd_cols)
      )
    )
    
    custom_options <- get_datatable_options()
    if(length(custom_options) > 0){
      for(n in names(custom_options)){
        default_options[[n]] <- custom_options[[n]]
      }
    }
    
    DT::datatable(
      data = dt,
      colnames = make_title(names(dt)),
      rownames = FALSE,
      escape = FALSE,
      selection = "none",
      extensions = 'AutoFill',
      #extensions = 'FixedColumns', # bug using FixedColumns on checkbox + update table...
      options = default_options
    )
  }, server = FALSE)
  
  download_file_r <- reactive({
    dt <- all_files()
    all_names <- uniquenames()
    dt_sel <- dt[all_names %in% input$download_file, ]
    dt_sel
  })
  
  download_file_rf <- reactive({
    
    save_dir <- isolate(get_save_dir())
    
    if(!is.null(input$select_file_dir) && input$select_file_dir != "/"){
      fp <- file.path(save_dir, input$select_file_dir, download_file_r()$recorded_name)
    }else{
      fp <- file.path(save_dir,download_file_r()$recorded_name)
    }
    fp
  })
  
  
  
  observeEvent(input$download_file, {
    file_translate <- get_file_translate()
    
    removeModal()
    
    showModal(modalDialog(
      title =  div(file_translate[file_translate$ID == 18, get_lan()], style = "color: #337ab7; font-size: 25px; font-weight: bold;"),
      ui_describ_file(tools::file_path_sans_ext(download_file_r()$name),
                      download_file_r()$date_time,
                      download_file_r()$description,
                      tools::file_ext(download_file_r()$name), get_lan(), file_translate),
      tags$div(id = "placeholder-editfile-exist"),
      footer = tagList(
        modalButton(file_translate[file_translate$ID == 7, get_lan()]),
        downloadButton(
          ns("downloaded_file_sgl"),
          file_translate[file_translate$ID == 27, get_lan()]
        )
      )
    ))
  }, ignoreInit = TRUE)
  
  # download_file
  output$downloaded_file_sgl <- downloadHandler(
    
    filename <- function() {
      paste0(tools::file_path_sans_ext(download_file_r()$name),  ".",
             tools::file_ext(download_file_r()$name))
      
    },
    
    content <- function(file) {
      fp <- download_file_rf()
      removeModal()
      file.copy(fp, file)
    }
  )
  
  file_to_edit <- reactive({
    dt <- all_files()
    all_names <- uniquenames()
    dt_sel <- dt[all_names == input$edit_file, ]
    dt_sel
  })
  
  
  
  # Edit file
  observeEvent(input$edit_file, {
    cpt <- count_file_load() + 1
    count_file_load(cpt)
    file_translate <- get_file_translate()
    
    removeModal()
    
    showModal(modalDialog(
      title = div(file_translate[file_translate$ID == 16, get_lan()], style = "color: #337ab7; font-size: 25px; font-weight: bold;"),
      fluidRow(
        column(7,
               textInput(ns("file_name_bis"), paste0(file_translate[file_translate$ID == 13, get_lan()], " (*)"),
                         tools::file_path_sans_ext(file_to_edit()$name), width = "100%")
        )
      ),
      fluidRow(
        column(12,
               textInput(ns("description_bis"), paste0(file_translate[file_translate$ID == 15, get_lan()], ifelse(isolate(get_force_desc()), " (*)", "")), file_to_edit()$description),
               checkboxInput(ns("load_new"), file_translate[file_translate$ID == 44, get_lan()]),
               conditionalPanel(
                 condition = paste0("input['", ns("load_new"), "']"),
                 fileInput(ns(paste0("file_load", cpt)), label = file_translate[file_translate$ID == 11, get_lan()])
               )
        )
      ),
      tags$div(id = "placeholder-editfile-exist"),
      footer = tagList(
        modalButton(file_translate[file_translate$ID == 7, get_lan()]),
        actionButton(
          inputId = ns("edited_file"),
          label = file_translate[file_translate$ID == 28, get_lan()],
          class = "btn-primary",
          `data-dismiss` = "modal"
        )
      )
    ))
  }, ignoreInit = TRUE)
  
  observe({
    file_info <- input[[paste0("file_load", count_file_load())]]
    name <- input$file_name_bis
    description <- input$description_bis
    
    if(!is.null(input$load_new)){
      if (input$load_new && isolate(get_force_desc()) && length(file_info) > 0 && length(name) > 0 && name != "" && length(description) > 0 && description != "") {
        toggleBtn(session = session, inputId = ns("edited_file"), type = "enable")
      } else if (input$load_new &&  !isolate(get_force_desc()) && length(file_info) > 0 && length(name) > 0  && name != "") {
        toggleBtn(session = session, inputId = ns("edited_file"), type = "enable")
      } else if (!input$load_new && isolate(get_force_desc())  && length(name) > 0 && name != "" && length(description) > 0 && description != "") {
        toggleBtn(session = session, inputId = ns("edited_file"), type = "enable")
      } else if (!input$load_new &&  !isolate(get_force_desc()) && length(name) > 0  && name != "") {
        toggleBtn(session = session, inputId = ns("edited_file"), type = "enable")
      } else {
        toggleBtn(session = session, inputId = ns("edited_file"), type = "disable")
      }
    }
  })
  
  observeEvent(input$edited_file, {
    
    save_dir <- isolate(get_save_dir())
    
    if(!is.null(input$load_new)){
      file_info <- input[[paste0("file_load", count_file_load())]]
    } else {
      file_info <- NULL
    }
    
    if(!is.null(input$select_file_dir) && input$select_file_dir != "/"){
      dir <- file.path(save_dir, input$select_file_dir)
    }else{
      dir <- save_dir
    }
    
    # Write yaml edited
    removeModal()
    
    ctrl_edit <- tryCatch({
      edit_file_in_dir(id = as.character(file_to_edit()$id),
                       dir = dir,
                       yml = req_yml(),
                       name = input$file_name_bis,
                       description = input$description_bis,
                       file = file_info$datapath, 
                       date_time_format = date_time_format)
    },
    error = function(e){
      showModal(
        modalDialog(
          title = "Error editing file",
          easyClose = TRUE,
          footer = NULL,
          e$message
        ))
      NULL
    })
    
  }, ignoreInit = TRUE)
  # End edit file
  
  
  # Suppress file
  file_to_remove <- reactive({
    dt <- all_files()
    all_names <- uniquenames()
    dt_sel <- dt[all_names == input$remove_file, ]
    dt_sel
  })
  
  observeEvent(input$remove_file, {
    file_translate <- get_file_translate()
    
    removeModal()
    
    showModal(modalDialog(
      title = div(file_translate[file_translate$ID == 17, get_lan()], style = "color: #337ab7; font-size: 25px; font-weight: bold;"),
      ui_describ_file(tools::file_path_sans_ext(file_to_remove()$name),
                      file_to_remove()$date_time,
                      file_to_remove()$description,
                      tools::file_ext(file_to_remove()$name), get_lan(), file_translate)
      ,
      tags$div(id = "placeholder-editfile-exist"),
      footer = tagList(
        modalButton(file_translate[file_translate$ID == 7, get_lan()]),
        actionButton(
          inputId = ns("removed_file"),
          label = file_translate[file_translate$ID == 42, get_lan()],
          class = "btn-primary",
          `data-dismiss` = "modal"
        )
      )
    ))
  }, ignoreInit = TRUE)
  
  observeEvent(input$removed_file, {
    
    save_dir <- isolate(get_save_dir())
    
    if(!is.null(input$select_file_dir) && input$select_file_dir != "/"){
      dir <- file.path(save_dir, input$select_file_dir)
    }else{
      dir <- save_dir
    }
    
    
    ctrl_rm <- tryCatch({
      suppress_file_in_dir(id = as.character(file_to_remove()$id),
                           dir = dir,
                           yml = req_yml())
    },
    error = function(e){
      showModal(
        modalDialog(
          title = "Error removing file",
          easyClose = TRUE,
          footer = NULL,
          e$message
        ))
      NULL
    })
    
  }, ignoreInit = TRUE)
  
  # Remove multiple
  r_selected_files <- callModule(module = input_checkbox, id = "remove_mult_files")
  
  # # # Remove all selected files
  output$supress_all <- renderUI({
    r_selected_files()
    file_translate <- get_file_translate()
    
    req(files_to_remove())
    
    if(nrow(files_to_remove()) > 1){
      div(
        conditionalPanel("output.is_admin",ns = ns,
                         actionButton(
                           inputId = ns("remove_selected_files"),
                           label = file_translate[file_translate$ID == 29, get_lan()],
                           class = "btn-danger pull-right",
                           icon = icon("trash-o"))
        ),
        p(),
        actionButton(
          inputId = ns("download_delected_files"),
          label = file_translate[file_translate$ID == 30, get_lan()],
          class = "btn-success pull-right",
          icon = icon("download"))
      )
    }
  })
  
  
  all_output <- reactive({
    selected_files <- r_selected_files()
    selected_files
  })
  
  files_to_remove <- reactive({
    req(all_output())
    dt_sel <- all_files()[paste0(uniquenames(), ctname()) %in%  all_output(), ]
    dt_sel
  })
  
  observeEvent(input$remove_selected_files, {
    file_translate <- get_file_translate()
    
    removeModal()
    
    showModal(
      modalDialog(
        title = div(file_translate[file_translate$ID == 31, get_lan()], style = "color: #337ab7; font-size: 25px; font-weight: bold;"),
        tags$div(id = "placeholder-editfile-exist"),
        shiny::tagList(
          lapply(1:nrow(files_to_remove()), function(i){
            p(tags$b(h4(paste0(file_translate[file_translate$ID == 32, get_lan()], " ", i))),
              ui_describ_file(tools::file_path_sans_ext(files_to_remove()$name[i]),
                              files_to_remove()$date_time[i],
                              files_to_remove()$description[i],
                              tools::file_ext(files_to_remove()$name[i]), get_lan(), file_translate),style = "border: 1px solid silver;")
          })
        ),
        footer = tagList(
          modalButton(file_translate[file_translate$ID == 7, get_lan()]),
          actionButton(
            inputId = ns("removed_selected_files"),
            label = file_translate[file_translate$ID == 42, get_lan()],
            class = "btn-primary",
            `data-dismiss` = "modal"
          )
        )
      ))
  }, ignoreInit = TRUE)
  
  
  observeEvent(input$removed_selected_files, {
    
    save_dir <- isolate(get_save_dir())
    
    if(!is.null(input$select_file_dir) && input$select_file_dir != "/"){
      dir <- file.path(save_dir, input$select_file_dir)
    }else{
      dir <- save_dir
    }
    
    for(i in 1:nrow(files_to_remove())){
      
      ctrl_rm <- tryCatch({
        suppress_file_in_dir(id = as.character(files_to_remove()[i, "id"]),
                             dir = dir,
                             yml = req_yml())
      },
      error = function(e){
        showModal(
          modalDialog(
            title = "Error removing file",
            easyClose = TRUE,
            footer = NULL,
            e$message
          ))
        NULL
      })
    }
  }, ignoreInit = TRUE)
  
  #  And download all files
  observeEvent(input$download_delected_files, {
    file_translate <- get_file_translate()
    
    removeModal()
    
    showModal(modalDialog(
      title = div(file_translate[file_translate$ID == 34, get_lan()], style = "color: #337ab7; font-size: 25px; font-weight: bold;"),
      tags$div(id = "placeholder-editfile-exist"),
      tagList(
        lapply(1:nrow(files_to_remove()), function(i){
          tmp <- files_to_remove()[i, ]
          p(tags$b(h4(paste0(file_translate[file_translate$ID == 32, get_lan()], " ", i))),
            ui_describ_file(tools::file_path_sans_ext(tmp$name),
                            tmp$date_time,
                            tmp$description,
                            tools::file_ext(tmp$name), get_lan(), file_translate),style = "border: 1px solid silver;")
        })
      ),
      footer = tagList(
        modalButton(file_translate[file_translate$ID == 7, get_lan()]),
        downloadButton(
          ns("downloaded_file"),
          file_translate[file_translate$ID == 35, get_lan()]
        )
      )
    ))
  }, ignoreInit = TRUE)
  
  download_all_file_rf <- reactive({
    
    save_dir <- isolate(get_save_dir())
    
    sapply(1:nrow(files_to_remove()), function(i){
      download_file_r <- files_to_remove()[i, ]
      if((input$select_file_dir != "/")){
        fp <- file.path(save_dir, input$select_file_dir, download_file_r$recorded_name)
        names(fp) <- paste0(tools::file_path_sans_ext(download_file_r$name),  ".",
                            tools::file_ext(download_file_r$name))
      }else{
        fp <- file.path(save_dir, download_file_r$recorded_name)
        names(fp) <- paste0(tools::file_path_sans_ext(download_file_r$name),  ".",
                            tools::file_ext(download_file_r$name))
      }
      fp
    })
  })
  
  output$downloaded_file <- downloadHandler(
    filename <- function() {
      paste0("shinydrive_files_", format(Sys.time(), format = "%Y%m%d_%H%M%S"), ".zip")
    },
    content <- function(file) {
      fp <- download_all_file_rf()
      tmp_fp <- sapply(1:length(fp), function(x){
        cur_file <- unname(fp[x])
        tmp_file <- file.path(tempdir(), names(fp)[x])
        file.copy(cur_file, to = tmp_file)
        tmp_file <- tmp_file
      })
      removeModal()
      zip(file, tmp_fp, flags = "-r9X -j")
      
      tryCatch({file.remove(tmp_fp)}, error = function(e) NULL, warning = function(e) NULL)
    }
  )
}

Try the shinydrive package in your browser

Any scripts or data that you put into this service are public.

shinydrive documentation built on Sept. 29, 2022, 9:06 a.m.