Skip to content

Commit

Permalink
shinyURL for fbcheck in SPBase
Browse files Browse the repository at this point in the history
  • Loading branch information
CIP-RIU committed Jan 11, 2019
1 parent 2aea53c commit 26bd64b
Showing 1 changed file with 143 additions and 139 deletions.
282 changes: 143 additions & 139 deletions R/fbcheck_server_sbase.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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()
Expand Down Expand Up @@ -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 #######
Expand Down Expand Up @@ -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("<center><font color='#f7941d'><h2> Saving Study </h2></font></center>"),
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("<center><font color='#f7941d'><h2> HiDAP says: </h2></font></center>"),
div(
HTML(paste0("<h5>",str, "<h5>"))
),
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 <br>")
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. <br>")
}
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("<center><font color='#f7941d'><h2> Saving Study </h2></font></center>"),
# 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("<center><font color='#f7941d'><h2> HiDAP says: </h2></font></center>"),
# div(
# HTML(paste0("<h5>",str, "<h5>"))
# ),
# 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 <br>")
# 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. <br>")
# }
# 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 ################

}

Expand Down

0 comments on commit 26bd64b

Please sign in to comment.