use fromJSON to access the github APIs

ChangeLog

@@ -1,3 +1,8 @@
+2018-08-22 Li Jianfeng <[email protected]>
+
+		* add copy_plugins and copy_configs functions in R/web.R
+		* replace getURL by fromJSON to access the Github APIs
+
 2018-08-18 Li Jianfeng <[email protected]>
 
 		* add miniconda and spack in docker image

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: BioInstaller
 Title: Integrator of Bioinformatics Resources
-Version: 0.3.5.7000
+Version: 0.3.6
 Authors@R: person("Jianfeng", "Li", email = "[email protected]", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-2349-208X"))
 Maintainer: Jianfeng Li <[email protected]>
 Description:
@@ -15,7 +15,8 @@ LazyData: true
 Imports:
     stringr (>= 1.2.0),
     futile.logger (>= 1.4.1),
-    configr (>= 0.3.1.1),
+    configr (>= 0.3.3),
+    jsonlite,
     git2r (>= 0.0.3),
     R.utils (>= 2.5.0),
     RCurl (>= 1.95-4.8),

NAMESPACE

@@ -6,6 +6,8 @@ export(conda)
 export(conda.env.create)
 export(conda.env.list)
 export(conda.list)
+export(copy_configs)
+export(copy_plugins)
 export(crawl.all.versions)
 export(del.info)
 export(docker.pull)
@@ -26,6 +28,7 @@ export(spack.list)
 export(web)
 import(configr)
 import(futile.logger)
+import(liteq)
 import(rvest)
 import(stringr)
 importFrom(R.utils,gunzip)
@@ -35,6 +38,7 @@ importFrom(RCurl,getURL)
 importFrom(devtools,install_github)
 importFrom(git2r,checkout)
 importFrom(git2r,clone)
+importFrom(jsonlite,fromJSON)
 importFrom(shiny,runApp)
 importFrom(stringi,stri_rand_strings)
 importFrom(utils,URLencode)

R/BioInstaller.R

@@ -12,7 +12,8 @@
 #'
 #' @docType package
 #' @name BioInstaller
-#' @import configr stringr futile.logger rvest
+#' @import configr stringr futile.logger rvest liteq
+#' @importFrom jsonlite fromJSON
 #' @importFrom git2r clone checkout
 #' @importFrom stringi stri_rand_strings
 #' @importFrom RCurl getURL basicTextGatherer

R/conda.R

@@ -10,12 +10,17 @@
 #' \dontrun{
 #'   conda()
 #' }
-conda <- function(suffix_params = "", prefix_params = "", conda = Sys.which('conda'), ...) {
+conda <- function(suffix_params = "", prefix_params = "", conda = Sys.which("conda"), 
+  ...) {
   conda <- unname(conda)
-  if (conda == "") {warning("Executable 'conda' Not Found."); return(FALSE)}
-  objs <- system(sprintf("%s%s %s", prefix_params, conda, suffix_params), intern = TRUE, ...)
+  if (conda == "") {
+    warning("Executable 'conda' Not Found.")
+    return(FALSE)
+  }
+  objs <- system(sprintf("%s%s %s", prefix_params, conda, suffix_params), intern = TRUE, 
+    ...)
   x <- paste0(objs, collapse = "\n")
-  return(x) 
+  return(x)
 }
 
 #' Wrapper function of 'conda list', list linked packages in a conda environment.
@@ -27,19 +32,26 @@ conda <- function(suffix_params = "", prefix_params = "", conda = Sys.which('con
 #' @examples
 #' \dontrun{
 #'   conda.list()
-#'   conda.list(env_name = "your_env")
+#'   conda.list(env_name = 'your_env')
 #' }
 conda.list <- function(env_name = "base", ...) {
-  if (!is.null(env_name) && env_name != "") objs <- conda("list", prefix_params = sprintf("source activate %s;", env_name), ...)
-  if (is.null (env_name) || env_name == "") objs <- conda("list", ...)
-  if (is.logical(objs) && !objs) {return(FALSE)}
+  if (!is.null(env_name) && env_name != "") 
+    objs <- conda("list", prefix_params = sprintf("source activate %s;", env_name), 
+      ...)
+  if (is.null(env_name) || env_name == "") 
+    objs <- conda("list", ...)
+  if (is.logical(objs) && !objs) {
+    return(FALSE)
+  }
   text <- paste0(objs, collapse = "\n")
-  x <- tryCatch(read.table(text=text), error = function(e) {
+  x <- tryCatch(read.table(text = text), error = function(e) {
     data.frame()
   })
-  if (nrow(x) == 0) return(x)
+  if (nrow(x) == 0) 
+    return(x)
   colnames(x)[1:3] <- c("Name", "Version", "Build")
-  if (ncol(x) == 4) colnames(x)[4] <- "Channel"
+  if (ncol(x) == 4) 
+    colnames(x)[4] <- "Channel"
   return(x)
 }
 
@@ -54,9 +66,11 @@ conda.list <- function(env_name = "base", ...) {
 #' }
 conda.env.list <- function(...) {
   objs <- conda("env list", ...)
-  if (is.logical(objs) && !objs) {return(FALSE)}
+  if (is.logical(objs) && !objs) {
+    return(FALSE)
+  }
   text <- paste0(objs, collapse = "\n")
-  x <- read.table(text=str_replace(text, " [*] ", ""), skip=2)
+  x <- read.table(text = str_replace(text, " [*] ", ""), skip = 2)
   colnames(x) <- c("env_name", "env_path")
   return(x)
 }
@@ -72,21 +86,21 @@ conda.env.list <- function(...) {
 #'
 #' @examples
 #' \dontrun{
-#'   conda.env.create(params = "vader/deathstar")
-#'   conda.env.create(env_name = "name")
-#'   conda.env.create(env_file = "/path/to/environment.yml")
-#'   conda.env.create(env_name = "deathstar", 
-#'                    env_file = "/path/to/requirements.txt")
-#'   conda.env.create(env_file = "/path/to/requirements.txt", 
-#'   env_path = "/home/user/software/deathstar")
+#'   conda.env.create(params = 'vader/deathstar')
+#'   conda.env.create(env_name = 'name')
+#'   conda.env.create(env_file = '/path/to/environment.yml')
+#'   conda.env.create(env_name = 'deathstar', 
+#'                    env_file = '/path/to/requirements.txt')
+#'   conda.env.create(env_file = '/path/to/requirements.txt', 
+#'   env_path = '/home/user/software/deathstar')
 #' }
-conda.env.create <- function(env_name = "", 
-                             env_file = "", 
-                             env_path = "",
-                             params = "",
-                             ...) {
-  if (env_name != "") env_name <- paste0("-n ", env_name, " ")
-  if (env_file != "") env_file <- paste0("-f=", env_file, " ")
-  if (env_path != "") env_path <- paste0("-p ", env_path, " ")
+conda.env.create <- function(env_name = "", env_file = "", env_path = "", params = "", 
+  ...) {
+  if (env_name != "") 
+    env_name <- paste0("-n ", env_name, " ")
+  if (env_file != "") 
+    env_file <- paste0("-f=", env_file, " ")
+  if (env_path != "") 
+    env_path <- paste0("-p ", env_path, " ")
   conda(sprintf("env create %s%s%s%s", env_name, env_file, env_path, params), ...)
 }

R/config.R

@@ -5,11 +5,10 @@
 #' @param publication Publication of new item
 #' @export
 #' @examples
-#' new.bioinfo("db_main.toml", "test_item", "Just is a test item", "NA")
-new.bioinfo <- function(config.file = "github.toml", 
-                        title = "", description = "", 
-                        publication = "") {
+#' new.bioinfo('db_main.toml', 'test_item', 'Just is a test item', 'NA')
+new.bioinfo <- function(config.file = "github.toml", title = "", description = "", 
+  publication = "") {
   text <- sprintf("**Configuration file**:%s\n**title**:%s\n**description**:%s\n**publication**:%s\n", 
-                  config.file, title, description, publication)
+    config.file, title, description, publication)
   cat(text)
 }

R/info.R

@@ -17,7 +17,8 @@
 #' bin.dir = '', excutable.files = c('demo'), others.customer = 'demo')
 #' unlink(db)
 change.info <- function(name = "", installed = TRUE, source.dir = "", bin.dir = "", 
-  executable.files = "", db = Sys.getenv("BIO_SOFTWARES_DB_ACTIVE", tempfile()), ..., verbose = TRUE) {
+  executable.files = "", db = Sys.getenv("BIO_SOFTWARES_DB_ACTIVE", tempfile()), 
+  ..., verbose = TRUE) {
   msg <- sprintf("Running change.info for %s and be saved to %s", name, db)
   info.msg(msg, verbose = verbose)
   source.dir <- normalizePath(source.dir, mustWork = F)
@@ -50,7 +51,8 @@ change.info <- function(name = "", installed = TRUE, source.dir = "", bin.dir =
 #' bin.dir = '', excutable.files = c('demo'), others.customer = 'demo')
 #' get.info('bwa')
 #' unlink(db)
-get.info <- function(name = "", db = Sys.getenv("BIO_SOFTWARES_DB_ACTIVE", tempfile()), verbose = TRUE) {
+get.info <- function(name = "", db = Sys.getenv("BIO_SOFTWARES_DB_ACTIVE", tempfile()), 
+  verbose = TRUE) {
   db <- normalizePath(db, mustWork = FALSE)
   if (!db.check(db)) {
     return(FALSE)
@@ -81,7 +83,8 @@ get.info <- function(name = "", db = Sys.getenv("BIO_SOFTWARES_DB_ACTIVE", tempf
 #' bin.dir = '', excutable.files = c('demo'), others.customer = 'demo')
 #' del.info('bwa')
 #' unlink(db)
-del.info <- function(name = "", db = Sys.getenv("BIO_SOFTWARES_DB_ACTIVE", tempfile()), verbose = TRUE) {
+del.info <- function(name = "", db = Sys.getenv("BIO_SOFTWARES_DB_ACTIVE", tempfile()), 
+  verbose = TRUE) {
   db <- normalizePath(db, mustWork = FALSE)
   if (!db.check(db)) {
     return(FALSE)
@@ -113,8 +116,8 @@ del.info <- function(name = "", db = Sys.getenv("BIO_SOFTWARES_DB_ACTIVE", tempf
 #' bin.dir = '', excutable.files = c('demo'), others.customer = 'demo')
 #' show.installed()
 #' unlink(db)
-show.installed <- function(db = Sys.getenv("BIO_SOFTWARES_DB_ACTIVE", tempfile()), only.installed = TRUE, 
-  verbose = TRUE) {
+show.installed <- function(db = Sys.getenv("BIO_SOFTWARES_DB_ACTIVE", tempfile()), 
+  only.installed = TRUE, verbose = TRUE) {
   db <- normalizePath(db, mustWork = FALSE)
   if (!db.check(db)) {
     return(FALSE)

R/install.R

@@ -40,7 +40,10 @@
 #' @examples
 #' db <- sprintf('%s/.BioInstaller', tempdir())
 #' set.biosoftwares.db(db)
-#' install.bioinfo('bwa', show.all.versions = TRUE)
+#' tryCatch(install.bioinfo('bwa', show.all.versions = TRUE), 
+#' error = function(e) {
+#'   message('Connecting Github failed. Please try it again later.')
+#' })
 #' unlink(db)
 install.bioinfo <- function(name = c(), download.dir = c(), destdir = c(), name.saved = NULL, 
   github.cfg = system.file("extdata", "config/github/github.toml", package = "BioInstaller"), 
@@ -52,8 +55,8 @@ install.bioinfo <- function(name = c(), download.dir = c(), destdir = c(), name.
   db = Sys.getenv("BIO_SOFTWARES_DB_ACTIVE", system.file("extdata", "demo/softwares_db_demo.yaml", 
     package = "BioInstaller")), download.only = FALSE, decompress = TRUE, dependence.need = TRUE, 
   showWarnings = FALSE, extra.list = list(), rcmd.parse = TRUE, bash.parse = TRUE, 
-  glue.parse = TRUE, glue.flag = "!!glue", save.to.db = TRUE, license = "", overwrite = FALSE, verbose = TRUE, 
-  ...) {
+  glue.parse = TRUE, glue.flag = "!!glue", save.to.db = TRUE, license = "", overwrite = FALSE, 
+  verbose = TRUE, ...) {
   github.cfg.env <- paste0(github.cfg, collapse = ",")
   nongithub.cfg.env <- paste0(nongithub.cfg, collapse = ",")
   Sys.setenv(github.cfg = github.cfg.env, nongithub.cfg = nongithub.cfg.env)
@@ -128,8 +131,7 @@ install.bioinfo <- function(name = c(), download.dir = c(), destdir = c(), name.
         decompress = decompress, dependence.need = dependence.need, verbose = verbose, 
         extra.list = extra.list, rcmd.parse = rcmd.parse, bash.parse = bash.parse, 
         glue.parse = glue.parse, glue.flag = glue.flag, save.to.db = save.to.db, 
-        overwrite = overwrite,
-        ...)
+        overwrite = overwrite, ...)
       bynongithub <- c(bynongithub, i)
     } else {
       warning(sprintf("%s not existed in install database, so can not be installed by BioInstaller package.", 
@@ -211,7 +213,10 @@ install.bioinfo <- function(name = c(), download.dir = c(), destdir = c(), name.
 #' @examples
 #' db <- sprintf('%s/.BioInstaller', tempdir())
 #' set.biosoftwares.db(db)
-#' install.github('bwa', show.all.versions = TRUE)
+#' tryCatch(install.github('bwa', show.all.versions = TRUE),
+#' error = function(e) {
+#'   message('Connecting Github failed. Please try it again later.')
+#' })
 #' unlink(db)
 install.github <- function(name = "", download.dir = NULL, destdir = NULL, version = NULL, 
   local.source = NULL, show.all.versions = FALSE, name.saved = NULL, github.cfg = system.file("extdata", 
@@ -243,7 +248,7 @@ install.github <- function(name = "", download.dir = NULL, destdir = NULL, versi
   destdir <- processed.dir.list[["des.dir"]]
   download.dir <- processed.dir.list[["down.dir"]]
   status <- destdir.initial(download.dir, strict = FALSE, download.only, local.source = local.source, 
-                            overwrite = overwrite, is.git = TRUE)
+    overwrite = overwrite, is.git = TRUE)
   if (status == FALSE) {
     return(FALSE)
   }
@@ -384,7 +389,10 @@ install.github <- function(name = "", download.dir = NULL, destdir = NULL, versi
 #' @examples
 #' db <- sprintf('%s/.BioInstaller', tempdir())
 #' set.biosoftwares.db(db)
-#' install.nongithub('gmap', show.all.versions = TRUE)
+#' tryCatch(install.nongithub('gmap', show.all.versions = TRUE),
+#' error = function(e) {
+#'   message('Connecting Gmap website failed. Please try it again later.')
+#' })
 #' unlink(db)
 install.nongithub <- function(name = "", download.dir = NULL, destdir = NULL, version = NULL, 
   local.source = NULL, show.all.versions = FALSE, name.saved = NULL, nongithub.cfg = c(system.file("extdata", 
@@ -420,7 +428,7 @@ install.nongithub <- function(name = "", download.dir = NULL, destdir = NULL, ve
   destdir <- processed.dir.list[["des.dir"]]
   download.dir <- processed.dir.list[["down.dir"]]
   status <- destdir.initial(download.dir, strict = FALSE, download.only, local.source = local.source, 
-                            is.git = FALSE, overwrite = overwrite)
+    is.git = FALSE, overwrite = overwrite)
   if (status == FALSE) {
     return(FALSE)
   }

R/spack.R

@@ -10,10 +10,15 @@
 #' \dontrun{
 #'   spack()
 #' }
-spack <- function(suffix_params = "", prefix_params = "", spack = Sys.which('spack'), ...) {
+spack <- function(suffix_params = "", prefix_params = "", spack = Sys.which("spack"), 
+  ...) {
   spack <- unname(spack)
-  if (spack == "") {warning("Executable 'spack' Not Found."); return(FALSE)}
-  objs <- system(sprintf("%s%s %s", prefix_params, spack, suffix_params), intern = TRUE, ...)
+  if (spack == "") {
+    warning("Executable 'spack' Not Found.")
+    return(FALSE)
+  }
+  objs <- system(sprintf("%s%s %s", prefix_params, spack, suffix_params), intern = TRUE, 
+    ...)
   paste0(objs, collapse = "\n")
 }
 
@@ -28,9 +33,11 @@ spack <- function(suffix_params = "", prefix_params = "", spack = Sys.which('spa
 #' }
 spack.list <- function(...) {
   objs <- spack("list", ...)
-  if (is.logical(objs) && !objs) {return(FALSE)}
+  if (is.logical(objs) && !objs) {
+    return(FALSE)
+  }
   text <- paste0(objs, collapse = "\n")
-  x <- read.table(text=text)
+  x <- read.table(text = text)
   colnames(x) <- c("Name")
   return(x)
 }

R/utils_function.R

@@ -226,7 +226,7 @@ download.file.custom <- function(url = "", destfile = "", is.dir = FALSE, showWa
 
 # Check destdir and decide wheather overwrite
 destdir.initial <- function(destdir, strict = TRUE, download.only = FALSE, local.source = NULL, 
-                            is.git = TRUE, overwrite = FALSE) {
+  is.git = TRUE, overwrite = FALSE) {
   if (!is.null(local.source)) {
     return(TRUE)
   }

R/versions.R

@@ -21,17 +21,15 @@ github2versions <- function(github.url) {
   txt <- str_split(github.url, "/")[[1]]
   user <- txt[2]
   repo <- txt[3]
-  h <- basicTextGatherer()
-  myheader <- c(`User-Agent` = "Mozilla/5.0 (iPhone; U; CPU iPhone OS 4_0_1 like Mac OS X; ja-jp) AppleWebKit/532.9 (KHTML, like Gecko) Version/4.0.5 Mobile/8A306 Safari/6531.22.7", 
-    Accept = "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8", 
-    `Accept-Language` = "en-us", Connection = "keep-alive", `Accept-Charset` = "GB2312,utf-8;q=0.7,*;q=0.7")
   url <- sprintf("https://api.github.com/repos/%s/%s/tags?client_id=1d40ab6884d214ef6889&client_secret=23b818c2bad8e9f88dafd8a425613475362b326d", 
     user, repo)
-  txt <- tryCatch(getURL(url, headerfunction = h$update, httpheader = myheader), error = function(e) {
-       getURL(url, headerfunction = h$update, httpheader = myheader, ssl.verifypeer = FALSE) })
-  json <- tempfile()
-  cat(txt, file = json, sep = "\n")
-  return(read.config(file = json)$name)
+  json <- tryCatch(fromJSON(url), error = function(e) {
+    message("Featch the github version failed.")
+    NULL
+  })
+  if (is.null(json)) 
+    return("master")
+  return(json$name)
 }
 
 use.github.response <- function(config) {