From 905cc041943d2d75021b685599f1a75c45c44b95 Mon Sep 17 00:00:00 2001 From: CIP-RIU Date: Mon, 23 Jul 2018 20:36:08 +0000 Subject: [PATCH 1/3] fbcheck test v.2.0.4: login brapi, upload files --- DESCRIPTION | 7 +- R/fbcheck_server_sbase.R | 145 ++++++++++++++++++++++++++++++++++++++- R/fbcheck_ui_sbase.R | 21 ++++-- 3 files changed, 163 insertions(+), 10 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 517410b..0dc4a71 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: fbcheck Title: Web Interface for Data Quality and Processing -Version: 2.0.3 +Version: 2.0.4 Authors@R: c( person("Omar","Benites",,"obacc07@gmail.com",c("aut","cre")) ) @@ -23,7 +23,10 @@ Imports: date, purrr, tidyr, - dplyr + dplyr, + httr, + RMySQL, + DT License: MIT + file LICENSE LazyData: true RoxygenNote: 6.0.1 diff --git a/R/fbcheck_server_sbase.R b/R/fbcheck_server_sbase.R index e36bc4c..d6bfbc1 100755 --- a/R/fbcheck_server_sbase.R +++ b/R/fbcheck_server_sbase.R @@ -9,6 +9,11 @@ #' @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" #Catch the file path for reading fieldbook sheets volumes <- shinyFiles::getVolumes() @@ -60,9 +65,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") return(NULL) } else { dt <- readr::read_csv(file_fbapp$datapath) + shinyjs::enable("saveData") } ####### Show Warnings to users ####### @@ -157,13 +164,14 @@ fbcheck_server_sbase <- function(input, output, session, values) { }, content = function(con) { path <- fbglobal::get_base_dir() - #print(path) - shiny::withProgress(message = 'Downloading file', value = 0, { - incProgress(1/6, detail = paste("Reading HIDAP data...")) + shiny::withProgress(message = 'Downloading file', value = 0, { + incProgress(1/6, detail = paste("Reading table data...")) + path <- file.path(path,"hot_fieldbook_sbase.rds") DF <- hot_to_r(input$hot_btable_fbapp_sbase) # Important note: run server + incProgress(2/6, detail = paste("Formatting hidap file...")) fb<- DF #hidap2fbApp(fieldbook = DF) @@ -181,6 +189,137 @@ fbcheck_server_sbase <- function(input, output, session, values) { } ) + 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 + + 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) + + } + } diff --git a/R/fbcheck_ui_sbase.R b/R/fbcheck_ui_sbase.R index 4619456..e6fe983 100755 --- a/R/fbcheck_ui_sbase.R +++ b/R/fbcheck_ui_sbase.R @@ -44,16 +44,27 @@ fbcheck_ui_sbase <- function(type="tab", title="Data Quality and Processing", na # # ), + #conditionalPanel( # condition = "input.fbdesign_dsource_sbase == 'FieldBookApp-SPBase'", + column(6, + shiny::fileInput(inputId = "file_fbapp_sbase", label = "Choose CSV File", multiple = FALSE, + accept = c("text/csv","text/comma-separated-values,text/plain", ".csv")) + ), + column(6, + # HTML('
'), + HTML('
'), + br(), + shiny::downloadButton('downloadData', 'Download', class = "btn-primary",style="color: #fff;"), + actionButton('saveData', 'Save', icon=icon("save"), width = 100), + HTML('
') + + ), - shiny::fileInput(inputId = "file_fbapp_sbase", label = "Choose CSV File", multiple = FALSE, - accept = c("text/csv","text/comma-separated-values,text/plain", ".csv")), + #actionButton('reset', 'Reset Input'), - HTML('
'), - shiny::downloadLink('downloadData', 'Download'), - HTML('
'), + # ) #), From 2aea53c4e018953a0796eca457b4ee1a0b9b6379 Mon Sep 17 00:00:00 2001 From: CIP-RIU Date: Thu, 2 Aug 2018 20:07:01 +0000 Subject: [PATCH 2/3] fbcheck for production version v2.0.5 --- DESCRIPTION | 2 +- R/fbcheck_server_sbase.R | 16 ++++++++++++++++ R/fbcheck_ui_sbase.R | 12 ++++++++++-- 3 files changed, 27 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0dc4a71..659dc1b 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: fbcheck Title: Web Interface for Data Quality and Processing -Version: 2.0.4 +Version: 2.0.5 Authors@R: c( person("Omar","Benites",,"obacc07@gmail.com",c("aut","cre")) ) diff --git a/R/fbcheck_server_sbase.R b/R/fbcheck_server_sbase.R index d6bfbc1..9de541c 100755 --- a/R/fbcheck_server_sbase.R +++ b/R/fbcheck_server_sbase.R @@ -73,6 +73,7 @@ fbcheck_server_sbase <- function(input, output, session, values) { } ####### Show Warnings to users ####### + #ToDo: Include plot_id if(!is.element("plot_name", names(dt))){ shinysky::showshinyalert(session, "alert_fbapp_warning_sbase", paste("ERROR: The file imported does not has 'plot_name' header."), styleclass = "danger") } else if(nrow(dt)==1){ @@ -175,6 +176,20 @@ fbcheck_server_sbase <- function(input, output, session, values) { incProgress(2/6, detail = paste("Formatting hidap file...")) fb<- DF #hidap2fbApp(fieldbook = DF) + exportFormat <- input$fbcheck_fbapp_ExportFormat_sbase + if(exportFormat=="Simple"){ + names(fb)[1] <- "observationunit_name" + #Remove unncesary columns for simple format + #ToDo: ask if user need 'plot_id' column in 'simple' format for sweetpotatobase + fb$accession_name <- fb$plot_id <- fb$plot_number <- fb$block_number <- fb$is_a_control <- fb$rep_number <- fb$row_number <- fb$col_number <- NULL + fb <- fb + + } else { + fb + } + + + incProgress(3/6, detail = paste("Downloading FieldBookApp-SPBase file...")) incProgress(4/6, detail = paste("Refreshing HIDAP...")) Sys.sleep(3) @@ -251,6 +266,7 @@ fbcheck_server_sbase <- function(input, output, session, values) { 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") diff --git a/R/fbcheck_ui_sbase.R b/R/fbcheck_ui_sbase.R index e6fe983..408eb60 100755 --- a/R/fbcheck_ui_sbase.R +++ b/R/fbcheck_ui_sbase.R @@ -49,14 +49,22 @@ fbcheck_ui_sbase <- function(type="tab", title="Data Quality and Processing", na # condition = "input.fbdesign_dsource_sbase == 'FieldBookApp-SPBase'", column(6, shiny::fileInput(inputId = "file_fbapp_sbase", label = "Choose CSV File", multiple = FALSE, - accept = c("text/csv","text/comma-separated-values,text/plain", ".csv")) + accept = c("text/csv","text/comma-separated-values,text/plain", ".csv")), + + selectInput(inputId = "fbcheck_fbapp_ExportFormat_sbase",label = "Spreadsheet format download",choices = c("Simple","Standard"), selected = 2) + + ), column(6, # HTML('
'), HTML('
'), br(), shiny::downloadButton('downloadData', 'Download', class = "btn-primary",style="color: #fff;"), - actionButton('saveData', 'Save', icon=icon("save"), width = 100), + + ################## HIDAP REGISTRY ######################################### + #actionButton('saveData', 'Save', icon=icon("save"), width = 100), + ######################################### ################################## + HTML('
') ), From 26bd64b5ee8247850c5777b2b34094d026bdff78 Mon Sep 17 00:00:00 2001 From: CIP-RIU Date: Fri, 11 Jan 2019 20:58:39 +0000 Subject: [PATCH 3/3] 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 ################ }