Updated opal management functions

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)
   }
 
-}
+  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

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,28 +24,31 @@ 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
+            }
           }
         }
       }
     }
     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