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('
'),
+
# )
#),