fbcheck test v.2.0.4: login brapi, upload files

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",,"[email protected]",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

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("<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
+
+    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/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('<div style="float: right; margin: 0 5px 5px 10px;">'),
+                                   HTML('<div style="float: right;">'),
+                                   br(),
+                                   shiny::downloadButton('downloadData', 'Download', class = "btn-primary",style="color: #fff;"),
+                                   actionButton('saveData', 'Save', icon=icon("save"), width = 100),
+                                   HTML('</div>')
+
+                                   ),
 
-                                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('<div style="float: right; margin: 0 5px 5px 10px;">'),
-                                shiny::downloadLink('downloadData', 'Download'),
-                                HTML('</div>'),
+
                              # )
                             #),