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 ################
}