R/callB_func.R

Defines functions import_lopo my.delete.callback my.update.callback my.insert.callback getFilters getOutput getLopo checkLopo

library(DBI)


# studyl<-study
# ########js script to fix href links (browseUrl)#######
# # define js function for opening urls in new tab/window
# js_code <- "
# shinyjs.browseURL = function(url) {
#   window.open(url,'_blank');
# }
# 
# shinyjs.reset = function() {history.go(0)}
# 
# "

#########Check if LOPO exists###########
checkLopo <- function(stud) {
  if (!file.exists(stud)) {
    lopoMessage<-"Lopo does not exisit" }
  else{
    lopoMessage<-"OK"
  }
  return(lopoMessage)
}
 

# lopoPath <- paste0("Studies/",studyl,"/",studyl)
########call a lopo################### 

getLopo <- function(stud,s_path) {
  conB <- dbConnect(RSQLite::SQLite(), s_path)
  request <- paste0("SELECT * FROM ", stud)
  res <- unname(dbSendQuery(conB,request))
  lopo <- dbFetch(res)
  dbClearResult(res)
  dbDisconnect(conB)
  return(lopo)
}

# s_path <- "inst/example_lopo/BP40657.sqlite"
# x <- getLopo("userDB", s_path)
# x <- getLopo("BP40657", s_path)
# conB <- dbConnect(RSQLite::SQLite(), "inst/example_lopo/BP40657.sqlite")
# dbListTables(conB)
# list of studies

#####################################


########call an output################### 

getOutput<- function(stud,s_path,id) {
  conh <- dbConnect(RSQLite::SQLite(), s_path )
  request <- paste0("SELECT * FROM ", stud , " where rowid = ", id)
  res <- unname(dbSendQuery(conh,request))
  output <- dbFetch(res)
  dbClearResult(res)
  dbDisconnect(conh)
  return(output)
}
#####################################

########call filters ################### 

getFilters <- function(f_path) {
  con <- dbConnect(RSQLite::SQLite(), f_path )
  request<-paste0("SELECT * FROM FILTERS")
  res <- unname(dbSendQuery(con,request))
  f_data <- dbFetch(res)
  dbClearResult(res)
  dbDisconnect(con)
  return(f_data)
}
#####################################



#########Get data path (for progr data output)######
#getDataPath <- function(stud,username) {
#  con <- dbConnect(RSQLite::SQLite(), "/home/bceuser/remusatp/General/StudyDB" )
#  request<-paste0("SELECT path FROM StudyDB  where STUDY='",stud,"' and USER='",username,"'")
#  res <- unname(dbSendQuery(con,request))
#  dataPath <- dbFetch(res)
#  dbClearResult(res)
#  dbDisconnect(con)
#  return(dataPath)
#}




##### Callback functions.
my.insert.callback <- function(data, row) {
  conA <- dbConnect(RSQLite::SQLite(),  paste0("Studies/",studyl,"/",studyl))
  queryA <- paste0("INSERT INTO ",studyl," ( Titles, Footnotes, Filters, Domain) VALUES (",
                  "'", as.character(data[row,]$Titles), "', ", 
                  "'", as.character(data[row,]$Footnotes), "', ",
                  "'", as.character(data[row,]$Filters), "', ",
                  "'", as.character(data[row,]$Domain), "' ",
                  ")")
  print(queryA)
  dbGetQuery(conA, queryA)
  dbDisconnect(conA)
  
  return(getLopo(studyl,lopoPath))
}

my.update.callback <- function(data, olddata, row) {
  con <- dbConnect(RSQLite::SQLite(),  paste0("Studies/",studyl,"/",studyl))
  query <- paste0("UPDATE  ",studyl,"  SET ",
                  "Domain = '",  as.character(data[row,]$Domain), "', ",
                  "Titles = '", as.character(data[row,]$Titles), "', ",
                  "Footnotes = '", data[row,]$Footnotes, "', ",
                  "Filters = '", as.character(data[row,]$Filters), "' ",
                  "WHERE rowid = ", data[row,]$idbis)
  print(query)
  dbSendQuery(con, query)
  dbDisconnect(con)
  
  return(getLopo(studyl,lopoPath))
}


my.delete.callback <- function(data, row) {
  con <- dbConnect(RSQLite::SQLite(),  paste0("Studies/",studyl,"/",studyl))
  query <- paste0('DELETE FROM  ',studyl,'  WHERE rowid = ', data[row,]$idbis)
  dbSendQuery(con, query)
  dbDisconnect(con)
  return(getLopo(studyl,lopoPath))
}



############Import LOPO#############
import_lopo <- function(input_l, study ,lopoPath) {
  
  inFile <- input_l$file1
  if(is.null(inFile))return(NULL)
  file.rename(inFile$datapath,paste(inFile$datapath, ".xls", sep=""))
  newLopo <-readxl::read_excel(paste(inFile$datapath, ".xls",  sep=""), sheet="List of Planned Outputs (SMT)",skip = 6)
}

#newLopo$Study <- study
#newLopo$id <- 1:nrow(newLopo)
#len_newLopo<-dim(newLopo)[1]
#newLopo0<-newLopo
#newLopo<-newLopo0[c(dim(newLopo)[2], 1:(dim(newLopo)[2]-1))]
#newLopo<-newLopo[1:25,]
#newLopo[is.na(newLopo)] <- ''   
####Lopo as a SQL database  ####
#con <- dbConnect(RSQLite::SQLite(), lopoPath)
#dbCreateTable(con, study, newLopo)
#dbAppendTable(con, study, newLopo)
#dbReadTable(con, study)
#dbDisconnect(con)


################################
kismet303/lopo3000 documentation built on Dec. 5, 2019, 8:40 a.m.