From 26bd64b5ee8247850c5777b2b34094d026bdff78 Mon Sep 17 00:00:00 2001 From: CIP-RIU Date: Fri, 11 Jan 2019 20:58:39 +0000 Subject: [PATCH] shinyURL for fbcheck in SPBase --- R/fbcheck_server_sbase.R | 282 ++++++++++++++++++++------------------- 1 file changed, 143 insertions(+), 139 deletions(-) diff --git a/R/fbcheck_server_sbase.R b/R/fbcheck_server_sbase.R index 9de541c..dfa0d76 100755 --- a/R/fbcheck_server_sbase.R +++ b/R/fbcheck_server_sbase.R @@ -9,11 +9,14 @@ #' @export fbcheck_server_sbase <- function(input, output, session, values) { - db <- reactiveValues() - db$constUserDB <- "hidap_sbase" - db$constPassDB <- "cKqrrEhTHLh3V2Fm70719" - db$constDBName <- "hidap_sbase" - db$constDBHost <- "176.34.248.121" + + ################################ R. ARIAS############################################### + # db <- reactiveValues() + # db$constUserDB <- "hidap_sbase" + # db$constPassDB <- "cKqrrEhTHLh3V2Fm70719" + # db$constDBName <- "hidap_sbase" + # db$constDBHost <- "176.34.248.121" + ################################ R. ARIAS############################################### #Catch the file path for reading fieldbook sheets volumes <- shinyFiles::getVolumes() @@ -65,11 +68,11 @@ fbcheck_server_sbase <- function(input, output, session, values) { file_fbapp <- input$file_fbapp_sbase #print(file_fbapp) if (is.null(file_fbapp)) { - shinyjs::disable("saveData") + #shinyjs::disable("saveData") # Codigo R.ARIAS SAVE return(NULL) } else { - dt <- readr::read_csv(file_fbapp$datapath) - shinyjs::enable("saveData") + dt <- readr::read_csv(file_fbapp$datapath) # Codigo R.ARIAS SAVE + #shinyjs::enable("saveData") } ####### Show Warnings to users ####### @@ -203,139 +206,140 @@ fbcheck_server_sbase <- function(input, output, session, values) { }) } ) + ################################## R .ARIAS ################ + # observeEvent(input$saveData,{ + # if(!session$userData$logged){ + # showModal(modalShowMessage("You must log in to save your data")) + # return() + # } + # showModal(modalEnterFileName()) + # }) - observeEvent(input$saveData,{ - if(!session$userData$logged){ - showModal(modalShowMessage("You must log in to save your data")) - return() - } - showModal(modalEnterFileName()) - }) - - observeEvent(input$btSaveModal, { - saveFile() - }) - - modalEnterFileName <- function(){ - modalDialog( - title = HTML("

Saving Study

"), - div( - textInput("fileName", "File name:"), - textInput("breederName", "Breeder Name:") - ), - - easyClose = T, - footer = tagList( - modalButton("Cancel"), - actionButton("btSaveModal", "Save", width = 120, icon = icon("save")), - actionButton("btModalSaveNUpdload", "Save & Upload", width = 120, icon=icon("upload")) - ) - ) - } - - modalShowMessage <- function(str){ - modalDialog( - title = HTML("

HiDAP says:

"), - div( - HTML(paste0("
",str, "
")) - ), - easyClose = T, - footer = tagList( - modalButton("Ok") - ) - ) - } - - ### to chek if name is correct and available - ### for testing, we will asume correct and no duplicate names are entered - checkNewFileName <- function (fname){ - - ### TO DO ### - - return(T) - } - - saveFile <- function(){ - - fileName <- trimws(input$fileName) - breederName <- trimws(input$breederName) - removeModal() - - message <- "" - - xdate <- Sys.time() - - v_study <- input$file_fbapp_sbase$name - v_study <- gsub(".csv", "", v_study) - - uploadDate <- as.character(xdate, "%Y%m%d%H%M%S") - uploadDate_s <- as.character(xdate, "%Y-%m-%d %H:%M:%S") - ranStr <- stri_rand_strings(1, 15, '[a-zA-Z0-9]') - servName <- paste(uploadDate, ranStr , sep= "-") #nombre sin extensions!!!! - servName <- paste0(servName, ".csv") - - - - shiny::withProgress(message = 'Saving file', value = 0, { - incProgress(1/4, detail = paste("Reading table data...")) - - - DF <- hot_to_r(input$hot_btable_fbapp_sbase) # Important note: run server - - - incProgress(2/4, detail = paste("Generating file...")) - - pathGlobal <- fbglobal::get_base_dir() - servPath <- file.path(pathGlobal,servName) - - write.csv(DF, file=servPath) - - incProgress(3/4, detail = paste("Saving into database")) - Sys.sleep(3) - - params <- list( - dataRequest = "uploadFile", - fileServerName = servName, - filedata=upload_file(servPath, "text/csv") - ) - - var <- POST("https://research.cip.cgiar.org/gtdms/hidap/script/hidap_sbase/getFileUpload.php", body=params) - code <- content(var, "text") - - - - if (file.exists(servPath)) file.remove(servPath) - - if (code == "200"){ - - message <- paste0(message, fileName, " was successfully saved
") - saveFileToDb("Sweetpotato", servName, paste0(fileName, ".csv"), breederName, v_study ,uploadDate_s ) - - # saveFileToDB <- function(crop, server_book_name, book_name, breeder_name, study, upload_date){ - - } - else{ - message = paste0( message, "Error while sharing ", fileName , ". Please Try again.
") - } - incProgress(4/4, detail = paste("Finishing")) - Sys.sleep(5) - - }) - - shinyalert("Success", message, type = "success") - - } - - saveFileToDb <- function(crop, server_book_name, book_name, breeder_name, study, upload_date){ - - mydb = dbConnect(MySQL(), user=db$constUserDB, password=db$constPassDB, dbname=db$constDBName, host=db$constDBHost) - strQry <- paste0("insert into files (owner_id, crop, breeder_name, book_name, server_book_name, study, status, date_created) values(", session$userData$userId, ",") - strQry <- paste0(strQry, "'",crop ,"','",breeder_name,"','",book_name,"','", server_book_name, "','", study, "','", "In review", "','",upload_date,"')") - qryUser = dbSendQuery(mydb, strQry) - dbDisconnect(mydb) - - } + # observeEvent(input$btSaveModal, { + # saveFile() + # }) + ################################## R .ARIAS ################ + # modalEnterFileName <- function(){ + # modalDialog( + # title = HTML("

Saving Study

"), + # div( + # textInput("fileName", "File name:"), + # textInput("breederName", "Breeder Name:") + # ), + # + # easyClose = T, + # footer = tagList( + # modalButton("Cancel"), + # actionButton("btSaveModal", "Save", width = 120, icon = icon("save")), + # actionButton("btModalSaveNUpdload", "Save & Upload", width = 120, icon=icon("upload")) + # ) + # ) + # } + # + # modalShowMessage <- function(str){ + # modalDialog( + # title = HTML("

HiDAP says:

"), + # div( + # HTML(paste0("
",str, "
")) + # ), + # easyClose = T, + # footer = tagList( + # modalButton("Ok") + # ) + # ) + # } + # + # ### to chek if name is correct and available + # ### for testing, we will asume correct and no duplicate names are entered + # checkNewFileName <- function (fname){ + # + # ### TO DO ### + # + # return(T) + # } + # + # saveFile <- function(){ + # + # fileName <- trimws(input$fileName) + # breederName <- trimws(input$breederName) + # removeModal() + # + # message <- "" + # + # xdate <- Sys.time() + # + # v_study <- input$file_fbapp_sbase$name + # v_study <- gsub(".csv", "", v_study) + # + # uploadDate <- as.character(xdate, "%Y%m%d%H%M%S") + # uploadDate_s <- as.character(xdate, "%Y-%m-%d %H:%M:%S") + # ranStr <- stri_rand_strings(1, 15, '[a-zA-Z0-9]') + # servName <- paste(uploadDate, ranStr , sep= "-") #nombre sin extensions!!!! + # servName <- paste0(servName, ".csv") + # + # + # + # shiny::withProgress(message = 'Saving file', value = 0, { + # incProgress(1/4, detail = paste("Reading table data...")) + # + # + # DF <- hot_to_r(input$hot_btable_fbapp_sbase) # Important note: run server + # + # + # incProgress(2/4, detail = paste("Generating file...")) + # + # pathGlobal <- fbglobal::get_base_dir() + # servPath <- file.path(pathGlobal,servName) + # + # write.csv(DF, file=servPath) + # + # incProgress(3/4, detail = paste("Saving into database")) + # Sys.sleep(3) + # + # params <- list( + # dataRequest = "uploadFile", + # fileServerName = servName, + # filedata=upload_file(servPath, "text/csv") + # ) + # + # var <- POST("https://research.cip.cgiar.org/gtdms/hidap/script/hidap_sbase/getFileUpload.php", body=params) + # code <- content(var, "text") + # + # + # + # if (file.exists(servPath)) file.remove(servPath) + # + # if (code == "200"){ + # + # message <- paste0(message, fileName, " was successfully saved
") + # saveFileToDb("Sweetpotato", servName, paste0(fileName, ".csv"), breederName, v_study ,uploadDate_s ) + # + # # saveFileToDB <- function(crop, server_book_name, book_name, breeder_name, study, upload_date){ + # + # } + # else{ + # message = paste0( message, "Error while sharing ", fileName , ". Please Try again.
") + # } + # incProgress(4/4, detail = paste("Finishing")) + # Sys.sleep(5) + # + # }) + # + # shinyalert("Success", message, type = "success") + # + # } + # + # saveFileToDb <- function(crop, server_book_name, book_name, breeder_name, study, upload_date){ + # + # mydb = dbConnect(MySQL(), user=db$constUserDB, password=db$constPassDB, dbname=db$constDBName, host=db$constDBHost) + # strQry <- paste0("insert into files (owner_id, crop, breeder_name, book_name, server_book_name, study, status, date_created) values(", session$userData$userId, ",") + # strQry <- paste0(strQry, "'",crop ,"','",breeder_name,"','",book_name,"','", server_book_name, "','", study, "','", "In review", "','",upload_date,"')") + # qryUser = dbSendQuery(mydb, strQry) + # dbDisconnect(mydb) + # + # } + ################################## R .ARIAS ################ }