From 8f5544f14a525e12e6c0e47038407bb6917970af Mon Sep 17 00:00:00 2001 From: Stuart Wheater Date: Tue, 12 Feb 2019 12:38:15 +0000 Subject: [PATCH] Updated opal management functions --- R/findLoginObjects.R | 50 +++++++++++++++++++++++++++----------------- R/getOpals.R | 23 +++++++++++--------- 2 files changed, 44 insertions(+), 29 deletions(-) diff --git a/R/findLoginObjects.R b/R/findLoginObjects.R index 439624c..9b0f064 100644 --- a/R/findLoginObjects.R +++ b/R/findLoginObjects.R @@ -2,32 +2,44 @@ #' @title searches for opal login object in the environment #' @description This is an internal function required by a client function #' @details if the user does not set the argument 'datasources', this function -#' is called to searches for opal login objects in the environment. If more than one -#' login object is found a prompt asks the user to choose one and if none is found -#' the process stops. +#' is called to searches for opal login objects in the environment. +#' If only one opal object is found, it automatically becomes the default selection. +#' If more than one is found but one is called 'default.opals' then that is selected. +#' If more than one is found with none is called 'default.opals' the user is +#' told that they can either specify a particular Opal using the 'datasources=' argument +#' that exists in every relevant datashield client-side function or else they +#' can use the 'ds.setDefaultOpals()' function to create a copy of a selected Opal objects +#' which is called 'default.opals' and is then selected by default in future calls to findLoginObjects. +#' If the default Opal object needs to be changed then 'ds.setDefaultOpals()' can be run again. +#' A previous version of 'findLoginObjects()' asked the user to specify which Opal to choose +#' if no default could be identified, but that did not work in all versions of R and so was removed. #' @keywords internal #' @return returns a list of opal login objects or stops the process -#' @author Gaye, A. +#' @author Amadou Gaye, Paul Burton (updated 15/10/18). THIS IS VERSION TO USE 8/2/19. #' findLoginObjects <- function(){ findLogin <- getOpals() + + if (findLogin$flag == 0){ + stop(" Are you logged in to any server? Please provide a valid opal login object! ", call.=FALSE) + } + if(findLogin$flag == 1){ datasources <- findLogin$opals - return (datasources) - }else{ - if(findLogin$flag == 0){ - stop(" Are you logged in to any server? Please provide a valid opal login object! ", call.=FALSE) - }else{ - message(paste0("More than one list of opal login object were found: '", paste(findLogin$opals,collapse="', '"), "'!")) - userInput <- readline("Please enter the name of the login object you want to use: ") - datasources <- eval(parse(text=userInput)) - if(class(datasources[[1]]) == 'opal'){ - return (datasources) - }else{ - stop("End of process: you failed to enter a valid login object", call.=FALSE) - } - } + return(datasources) } -} \ No newline at end of file + if(findLogin$flag > 1) { + for(j in 1:findLogin$flag){ + if(findLogin$opals[[j]]=="default.opals"){ + datasources<-eval(parse(text=findLogin$opals[[j]]),envir=0) + return(datasources) + } + } + message(paste0(" More than one list of opal login objects was found with no default specified:\n '", paste(findLogin$opals.list,collapse="', '"), "'!!")) + stop(" \n\n Please specify a default Opal object using the following call syntax:\n ds.setDefaultOpals(opal.name='name of opal in inverted commas')\n\n",call.=FALSE) + } + +} +#findLoginObjects diff --git a/R/getOpals.R b/R/getOpals.R index ee86536..f643eb1 100644 --- a/R/getOpals.R +++ b/R/getOpals.R @@ -6,9 +6,9 @@ #' This way no matter what the user calls his opal login object it will be captured. #' @keywords internal #' @return a list of opal object obtained after login into the servers -#' @author Gaye,A. -#' +#' @author Amadou Gaye, Paul Burton (updated 15/10/18). THIS IS VERSION TO USE 8/2/19. getOpals <- function(){ + # get the names of all the objects in the current work environment objs <- ls(name=.GlobalEnv) @@ -24,10 +24,12 @@ getOpals <- function(){ list2check <- eval(parse(text=objs[i])) if(length(list2check) > 0){ cl2 <- class(list2check[[1]]) - if(cl2 == 'opal'){ - cnt <- cnt + 1 - opalist[[cnt]] <- objs[i] - flag <- 1 + for(s in 1:length(cl2)){ + if(cl2[s] == 'opal'){ + cnt <- cnt + 1 + opalist[[cnt]] <- objs[i] + flag <- 1 + } } } } @@ -35,17 +37,18 @@ getOpals <- function(){ if(flag == 1){ if(length(opalist) > 1){ flag <- 2 - return(list("flag"=flag, "opals"=unlist(opalist))) + return(list("flag"=flag, "opals"=unlist(opalist), "opals.list"=unlist(opalist))) }else{ pp <- opalist[[1]] opals <- eval(parse(text=pp)) - return(list("flag"=flag, "opals"=opals)) + return(list("flag"=flag, "opals"=opals, "opals.list"=unlist(opalist))) } }else{ - return(list("flag"=flag, "opals"=NULL)) + return(list("flag"=flag, "opals"=NULL, "opals.list"=NULL)) } }else{ - return(list("flag"=flag, "opals"=NULL)) + return(list("flag"=flag, "opals"=NULL, "opals.list"=NULL)) } } +#getOpals \ No newline at end of file