From ee7675f6eb2511d5fd5546d4b5251c7215470304 Mon Sep 17 00:00:00 2001 From: Jianfeng Date: Wed, 22 Aug 2018 21:51:17 +0800 Subject: [PATCH] use fromJSON to access the github APIs --- ChangeLog | 5 + DESCRIPTION | 5 +- NAMESPACE | 4 + R/BioInstaller.R | 3 +- R/conda.R | 70 ++++++---- R/config.R | 9 +- R/info.R | 13 +- R/install.R | 26 ++-- R/spack.R | 17 ++- R/utils_function.R | 2 +- R/versions.R | 16 +-- R/web.R | 123 +++++++++++++----- inst/extdata/shiny/global_var.R | 7 +- man/conda.env.create.Rd | 14 +- man/conda.list.Rd | 2 +- man/copy_configs.Rd | 27 ++++ man/copy_plugins.Rd | 26 ++++ man/install.bioinfo.Rd | 5 +- man/install.github.Rd | 5 +- man/install.nongithub.Rd | 5 +- man/new.bioinfo.Rd | 2 +- tests/testthat/test_install.R | 101 ++++++++------ ...t_install_uilts.R => test_install_utils.R} | 32 +++-- tests/testthat/test_utils.R | 6 +- tests/testthat/test_versions.R | 9 +- tests/testthat/test_web.R | 7 + 26 files changed, 369 insertions(+), 172 deletions(-) create mode 100644 man/copy_configs.Rd create mode 100644 man/copy_plugins.Rd rename tests/testthat/{test_install_uilts.R => test_install_utils.R} (76%) create mode 100644 tests/testthat/test_web.R diff --git a/ChangeLog b/ChangeLog index 55985fc..34085da 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2018-08-22 Li Jianfeng + + * 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 * add miniconda and spack in docker image diff --git a/DESCRIPTION b/DESCRIPTION index a15c1f6..265a4f0 100644 --- a/DESCRIPTION +++ b/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 = "lee_jianfeng@sjtu.edu.cn", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-2349-208X")) Maintainer: Jianfeng Li 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), diff --git a/NAMESPACE b/NAMESPACE index ec9d7fe..b6118b3 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/BioInstaller.R b/R/BioInstaller.R index dc29c28..5010b02 100644 --- a/R/BioInstaller.R +++ b/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 diff --git a/R/conda.R b/R/conda.R index bf1e64b..1bf19e6 100644 --- a/R/conda.R +++ b/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), ...) } diff --git a/R/config.R b/R/config.R index 46a6aca..5411898 100644 --- a/R/config.R +++ b/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) } diff --git a/R/info.R b/R/info.R index 764767e..8970c28 100644 --- a/R/info.R +++ b/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) diff --git a/R/install.R b/R/install.R index bbb4c61..9e8d482 100644 --- a/R/install.R +++ b/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) } diff --git a/R/spack.R b/R/spack.R index d080e71..2e5eb9f 100644 --- a/R/spack.R +++ b/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) } diff --git a/R/utils_function.R b/R/utils_function.R index 77e0f0b..fa7468e 100644 --- a/R/utils_function.R +++ b/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) } diff --git a/R/versions.R b/R/versions.R index 4a66871..0a69aa7 100644 --- a/R/versions.R +++ b/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) { diff --git a/R/web.R b/R/web.R index 5b1305f..5c05d59 100644 --- a/R/web.R +++ b/R/web.R @@ -10,13 +10,14 @@ #' \dontrun{ #' web(auto_create = TRUE) #' } -web <- function(appDir = system.file("extdata", "shiny", package = "BioInstaller"), - auto_create = FALSE, ...) { +web <- function(appDir = system.file("extdata", "shiny", package = "BioInstaller"), + auto_create = FALSE, ...) { check_shiny_dep(install = TRUE) params <- list(...) params <- config.list.merge(list(appDir), params) - Sys.setenv("AUTO_CREATE_BIOINSTALLER_DIR"=FALSE) - if (auto_create) Sys.setenv("AUTO_CREATE_BIOINSTALLER_DIR"=TRUE) + Sys.setenv(AUTO_CREATE_BIOINSTALLER_DIR = FALSE) + if (auto_create) + Sys.setenv(AUTO_CREATE_BIOINSTALLER_DIR = TRUE) do.call(runApp, params) } @@ -29,26 +30,27 @@ web <- function(appDir = system.file("extdata", "shiny", package = "BioInstaller #' check_shiny_dep() #' } check_shiny_dep <- function(install = FALSE) { - - pkgs_meta <- as.data.frame(installed.packages())[,c(1,3)] - pkgs_meta[,2] <- as.character(pkgs_meta[,2]) - cran_pkgs <- c("shinycssloaders", "shinydashboard", "configr", - "data.table", "shinyjs", "DT", "stringr", "liteq", - "benchmarkme", "rmarkdown", "markdown", "rentrez") + + pkgs_meta <- as.data.frame(installed.packages())[, c(1, 3)] + pkgs_meta[, 2] <- as.character(pkgs_meta[, 2]) + cran_pkgs <- c("shinycssloaders", "shinydashboard", "configr", "data.table", + "shinyjs", "DT", "stringr", "liteq", "benchmarkme", "rmarkdown", "markdown", + "rentrez") cran_lowest_version <- list(configr = "0.3.2", data.table = "1.11.2") github_pkgs <- c() github_lowest_version <- list() github_urls <- list() - + bioc_pkgs <- c() bioc_lowest_version <- list() - + req.pkgs <- c() - for(pkg in cran_pkgs) { - is.installed <- pkg %in% pkgs_meta[,1] + for (pkg in cran_pkgs) { + is.installed <- pkg %in% pkgs_meta[, 1] need.check.version <- pkg %in% names(cran_lowest_version) - if (is.installed && need.check.version){ - lower_version <- compareVersion(pkgs_meta[pkg,2], cran_lowest_version[[pkg]]) < 0 + if (is.installed && need.check.version) { + lower_version <- compareVersion(pkgs_meta[pkg, 2], cran_lowest_version[[pkg]]) < + 0 } else { lower_version <- FALSE } @@ -58,11 +60,12 @@ check_shiny_dep <- function(install = FALSE) { req.pkgs <- c(req.pkgs, pkg) } } - for(pkg in github_pkgs) { - is.installed <- pkg %in% pkgs_meta[,1] + for (pkg in github_pkgs) { + is.installed <- pkg %in% pkgs_meta[, 1] need.check.version <- pkg %in% names(github_lowest_version) - if (is.installed && need.check.version){ - lower_version <- compareVersion(pkgs_meta[pkg,2], github_lowest_version[[pkg]]) < 0 + if (is.installed && need.check.version) { + lower_version <- compareVersion(pkgs_meta[pkg, 2], github_lowest_version[[pkg]]) < + 0 } else { lower_version <- FALSE } @@ -72,23 +75,24 @@ check_shiny_dep <- function(install = FALSE) { req.pkgs <- c(req.pkgs, pkg) } } - - for(pkg in bioc_pkgs) { - is.installed <- pkg %in% pkgs_meta[,1] + + for (pkg in bioc_pkgs) { + is.installed <- pkg %in% pkgs_meta[, 1] need.check.version <- pkg %in% names(bioc_lowest_version) - if (is.installed && need.check.version){ - lower_version <- compareVersion(pkgs_meta[pkg,2], bioc_lowest_version[[pkg]]) < 0 + if (is.installed && need.check.version) { + lower_version <- compareVersion(pkgs_meta[pkg, 2], bioc_lowest_version[[pkg]]) < + 0 } else { lower_version <- FALSE } if ((!is.installed || lower_version) && install) { source("https://bioconductor.org/biocLite.R") - eval(parse(text = 'biocLite(pkg, ask = FALSE)')) + eval(parse(text = "biocLite(pkg, ask = FALSE)")) } else if (!is.installed || lower_version) { req.pkgs <- c(req.pkgs, pkg) } } - + return(req.pkgs) } @@ -103,17 +107,66 @@ check_shiny_dep <- function(install = FALSE) { #' \dontrun{ #' set_shiny_workers(4) #' } -set_shiny_workers <- function(n, shiny_config_file = - Sys.getenv("BIOINSTALLER_SHINY_CONFIG", system.file("extdata", "config/shiny/shiny.config.yaml", - package = "BioInstaller")), auto_create = FALSE) { +set_shiny_workers <- function(n, shiny_config_file = Sys.getenv("BIOINSTALLER_SHINY_CONFIG", + system.file("extdata", "config/shiny/shiny.config.yaml", package = "BioInstaller")), + auto_create = FALSE) { config <- configr::read.config(shiny_config_file) log_dir <- config$shiny_queue$log_dir if (auto_create) { - if(!dir.exists(log_dir)) {dir.create(log_dir, recursive = TRUE)} + if (!dir.exists(log_dir)) { + dir.create(log_dir, recursive = TRUE) + } } - worker_script <- system.file('extdata', 'shiny/worker.R', package = 'BioInstaller') - - for(i in 1:n) { - system(sprintf("Rscript %s &> %s/worker_%s.log &", worker_script, log_dir, stringi::stri_rand_strings(1, 20))) + worker_script <- system.file("extdata", "shiny/worker.R", package = "BioInstaller") + + for (i in 1:n) { + system(sprintf("Rscript %s &> %s/worker_%s.log &", worker_script, log_dir, + stringi::stri_rand_strings(1, 20))) } } + +#' Function to copy the default plugins of BioInstaller +#' +#' @param plugin_dir The destdir to store plugins [~/.BioInstaller/plugins] +#' @param template_dir The template dir system.file('extdata', 'config/shiny/', +#' package = 'BioInstaller') +#' @param pattern Used in \code{\link{list.files}} ["shiny.*.parameters.toml"] +#' @param auto_create Auto create dir, default is FALSE +#' @export +#' @examples +#' copy_plugins(tempdir()) +copy_plugins <- function(plugin_dir = "~/.BioInstaller/plugins", template_dir = system.file('extdata', 'config/shiny/', + package = 'BioInstaller'), + pattern = "shiny.*.parameters.toml", auto_create = FALSE) { + plugin_dir <- normalizePath(plugin_dir, mustWork = FALSE) + if (!dir.exists(plugin_dir) && auto_create) {dir.create(plugin_dir, recursive = TRUE)} + else if (!dir.exists(plugin_dir) && !auto_create) { + warning(sprintf("Plugin dir %s not exists and auto_create was FALSE.", plugin_dir));return(FALSE)} + if (!dir.exists(template_dir)) {warning(sprintf("Template dir %s not exists.", template_dir));return(FALSE)} + all_plugins <- list.files(template_dir, pattern, full.names = TRUE) + if (length(all_plugins) >= 1) file.copy(all_plugins, plugin_dir) +} + + +#' Function to copy the default configuration file of BioInstaller +#' +#' @param config_dir The destdir to store plugins [~/.BioInstaller] +#' @param template_dir The template dir system.file('extdata', 'config/shiny/', +#' package = 'BioInstaller') +#' @param pattern Used in \code{\link{list.files}} ["shiny.config.yaml"] +#' @param auto_create Auto create dir, default is FALSE +#' @export +#' @examples +#' copy_configs(tempdir()) +copy_configs <- function(config_dir = "~/.BioInstaller/", template_dir = Sys.getenv("BIOINSTALLER_SHINY_CONFIG", + system.file('extdata', 'config/shiny/', + package = 'BioInstaller')), + pattern = "shiny.config.yaml", auto_create = FALSE) { + config_dir <- normalizePath(config_dir, mustWork = FALSE) + if (!dir.exists(config_dir) && auto_create) {dir.create(config_dir, recursive = TRUE)} + else if (!dir.exists(config_dir) && !auto_create) { + warning(sprintf("Config dir %s not exists and auto_create was FALSE.", config_dir));return(FALSE)} + if (!dir.exists(template_dir)) {warning(sprintf("Template dir %s not exists.", template_dir));return(FALSE)} + all_configs <- list.files(template_dir, pattern, full.names = TRUE) + if (length(all_configs) >= 1) file.copy(all_configs, config_dir) +} diff --git a/inst/extdata/shiny/global_var.R b/inst/extdata/shiny/global_var.R index f7c6bc4..2882eba 100644 --- a/inst/extdata/shiny/global_var.R +++ b/inst/extdata/shiny/global_var.R @@ -15,7 +15,8 @@ if (!dir.exists(db_dirname) && auto_create) { } else if (!dir.exists(db_dirname) && !auto_create){ stop("Please set the 'auto_create' in web() to TRUE, or AUTO_CREATE_BIOINSTALLER_DIR to TRUE.") } -if (!file.exists(config.file) || !configr::is.yaml.file(config.file)) file.copy(config.file.template, sprintf("%s/shiny.config.yaml", db_dirname)) +if (!file.exists(config.file) || !configr::is.yaml.file(config.file)) + file.copy(config.file.template, sprintf("%s/shiny.config.yaml", db_dirname)) Sys.setenv(BIOINSTALLER_SHINY_CONFIG = sprintf("%s/shiny.config.yaml", db_dirname)) shiny_plugin_dir_repo <- system.file("extdata", "config/shiny", package = "BioInstaller") @@ -24,9 +25,7 @@ if (!is.null(config$shiny_plugins$shiny_plugin_dir)) { shiny_plugin_dir <-config$shiny_plugins$shiny_plugin_dir } if (!dir.exists(shiny_plugin_dir) || length(list.files(shiny_plugin_dir)) == 0) { - dir.create(shiny_plugin_dir, recursive = TRUE, showWarnings = FALSE) - file.copy(sprintf("%s/%s", shiny_plugin_dir_repo, list.files(shiny_plugin_dir_repo, "shiny.*parameters")), - shiny_plugin_dir) + BioInstaller::copy_plugins(shiny_plugin_dir, auto_create = auto_create) } db_type <- config$shiny_db$db_type diff --git a/man/conda.env.create.Rd b/man/conda.env.create.Rd index 548d0b8..e934e82 100644 --- a/man/conda.env.create.Rd +++ b/man/conda.env.create.Rd @@ -23,12 +23,12 @@ Wrapper function of 'conda env create', create an environment based on an enviro } \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') } } diff --git a/man/conda.list.Rd b/man/conda.list.Rd index ba13b4c..6835da7 100644 --- a/man/conda.list.Rd +++ b/man/conda.list.Rd @@ -17,6 +17,6 @@ Wrapper function of 'conda list', list linked packages in a conda environment. \examples{ \dontrun{ conda.list() - conda.list(env_name = "your_env") + conda.list(env_name = 'your_env') } } diff --git a/man/copy_configs.Rd b/man/copy_configs.Rd new file mode 100644 index 0000000..a273436 --- /dev/null +++ b/man/copy_configs.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/web.R +\name{copy_configs} +\alias{copy_configs} +\title{Function to copy the default configuration file of BioInstaller} +\usage{ +copy_configs(config_dir = "~/.BioInstaller/", + template_dir = Sys.getenv("BIOINSTALLER_SHINY_CONFIG", + system.file("extdata", "config/shiny/", package = "BioInstaller")), + pattern = "shiny.config.yaml", auto_create = FALSE) +} +\arguments{ +\item{config_dir}{The destdir to store plugins [~/.BioInstaller]} + +\item{template_dir}{The template dir system.file('extdata', 'config/shiny/', +package = 'BioInstaller')} + +\item{pattern}{Used in \code{\link{list.files}} ["shiny.config.yaml"]} + +\item{auto_create}{Auto create dir, default is FALSE} +} +\description{ +Function to copy the default configuration file of BioInstaller +} +\examples{ +copy_configs(tempdir()) +} diff --git a/man/copy_plugins.Rd b/man/copy_plugins.Rd new file mode 100644 index 0000000..ca0c0d2 --- /dev/null +++ b/man/copy_plugins.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/web.R +\name{copy_plugins} +\alias{copy_plugins} +\title{Function to copy the default plugins of BioInstaller} +\usage{ +copy_plugins(plugin_dir = "~/.BioInstaller/plugins", + template_dir = system.file("extdata", "config/shiny/", package = + "BioInstaller"), pattern = "shiny.*.parameters.toml", auto_create = FALSE) +} +\arguments{ +\item{plugin_dir}{The destdir to store plugins [~/.BioInstaller/plugins]} + +\item{template_dir}{The template dir system.file('extdata', 'config/shiny/', +package = 'BioInstaller')} + +\item{pattern}{Used in \code{\link{list.files}} ["shiny.*.parameters.toml"]} + +\item{auto_create}{Auto create dir, default is FALSE} +} +\description{ +Function to copy the default plugins of BioInstaller +} +\examples{ +copy_plugins(tempdir()) +} diff --git a/man/install.bioinfo.Rd b/man/install.bioinfo.Rd index 7509f9b..5f4bf64 100644 --- a/man/install.bioinfo.Rd +++ b/man/install.bioinfo.Rd @@ -91,6 +91,9 @@ Download and install biology software or database \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) } diff --git a/man/install.github.Rd b/man/install.github.Rd index 387b026..17c44d4 100644 --- a/man/install.github.Rd +++ b/man/install.github.Rd @@ -71,6 +71,9 @@ Install or download softwares from Github \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) } diff --git a/man/install.nongithub.Rd b/man/install.nongithub.Rd index 88a65b3..3524d57 100644 --- a/man/install.nongithub.Rd +++ b/man/install.nongithub.Rd @@ -80,6 +80,9 @@ Install or download softwares from non-Github Web site \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) } diff --git a/man/new.bioinfo.Rd b/man/new.bioinfo.Rd index 01b6aaf..190c7e6 100644 --- a/man/new.bioinfo.Rd +++ b/man/new.bioinfo.Rd @@ -20,5 +20,5 @@ new.bioinfo(config.file = "github.toml", title = "", description = "", Create new BioInstaller items to github forum } \examples{ -new.bioinfo("db_main.toml", "test_item", "Just is a test item", "NA") +new.bioinfo('db_main.toml', 'test_item', 'Just is a test item', 'NA') } diff --git a/tests/testthat/test_install.R b/tests/testthat/test_install.R index 71a14f6..89c8f38 100644 --- a/tests/testthat/test_install.R +++ b/tests/testthat/test_install.R @@ -5,58 +5,79 @@ db <- sprintf('%s/.BioInstaller', tempdir()) set.biosoftwares.db(db) test_that("install.github", { - destdir <- sprintf('%s/github_demo0', tempdir()) - destdir <- normalizePath(destdir, "/", FALSE) - x <- install.github(name = "github_demo", destdir = destdir, + x <- tryCatch(RCurl::getURL("https://github.com"), error = function(e){message("Connect Github failed. Please check the network.");NULL}) + if (!is.null(x)) { + destdir <- sprintf('%s/github_demo0', tempdir()) + destdir <- normalizePath(destdir, "/", FALSE) + x <- install.github(name = "github_demo", destdir = destdir, download.dir = destdir, verbose = F) - unlink(destdir, recursive = T, TRUE) - expect_that(x, equals(TRUE)) - destdir <- sprintf('%s/github_demo1', tempdir()) - destdir <- normalizePath(destdir, "/", FALSE) - x <- suppressWarnings(install.github(show.all.versions = T, verbose = F)) - expect_that(x, equals(FALSE)) - destdir <- sprintf('%s/bwa', tempdir()) - destdir <- normalizePath(destdir, "/", FALSE) - x <- install.github(name = "bwa", show.all.versions = T, verbose = F) - expect_that(is.character(x), equals(TRUE)) - unlink(destdir, recursive = T, TRUE) - x <- tryCatch(install.github(name = list(), show.all.versions = T, verbose = F), error = function(e) {return(FALSE)}) - expect_that(is.character(x), equals(FALSE)) - unlink(destdir, recursive = T, TRUE) - destdir <- sprintf('%s/github_demo2', tempdir()) - destdir <- normalizePath(destdir, "/", FALSE) - x <- install.github(name = "github_demo", destdir = destdir, - download.dir = destdir, verbose = F, download.only = TRUE) - expect_that(x, equals(TRUE)) - unlink(destdir, recursive = T, TRUE) + expect_that(x, equals(TRUE)) + unlink(destdir, recursive = T, TRUE) + destdir <- sprintf('%s/github_demo1', tempdir()) + destdir <- normalizePath(destdir, "/", FALSE) + x <- suppressWarnings(install.github(show.all.versions = T, verbose = F)) + expect_that(x, equals(FALSE)) + destdir <- sprintf('%s/bwa', tempdir()) + destdir <- normalizePath(destdir, "/", FALSE) + x <- install.github(name = "bwa", show.all.versions = T, verbose = F) + expect_that(is.character(x), equals(TRUE)) + unlink(destdir, recursive = T, TRUE) + x <- tryCatch(install.github(name = list(), show.all.versions = T, verbose = F), error = function(e) {return(FALSE)}) + expect_that(is.character(x), equals(FALSE)) + unlink(destdir, recursive = T, TRUE) + destdir <- sprintf('%s/github_demo2', tempdir()) + destdir <- normalizePath(destdir, "/", FALSE) + x <- install.github(name = "github_demo", destdir = destdir, + download.dir = destdir, verbose = F, download.only = TRUE) + expect_that(x, equals(TRUE)) + unlink(destdir, recursive = T, TRUE) + } else { + message("Please check RCurl::getURL('https://github.com')") + } }) test_that("install.nongithub", { destdir <- sprintf('%s/demo0', tempdir()) destdir <- normalizePath(destdir, "/", FALSE) - x <- install.nongithub('demo', destdir = destdir, verbose = F) - expect_that(x, equals(TRUE)) - expect_that(is.list(get.info('demo')), equals(TRUE)) - unlink(destdir, recursive = T, TRUE) - x <- install.nongithub('demo', destdir = destdir, verbose = F, download.only = T) - expect_that(as.logical(x), equals(TRUE)) - unlink(destdir, recursive = T, TRUE) + x <- tryCatch(install.nongithub('demo', destdir = destdir, verbose = F), + warning = function(w) {NULL}) + if (!is.null(x) && is.logical(x) && x) { + expect_that(x, equals(TRUE)) + expect_that(is.list(get.info('demo')), equals(TRUE)) + unlink(destdir, recursive = T, TRUE) + x <- install.nongithub('demo', destdir = destdir, verbose = F, download.only = T) + expect_that(as.logical(x), equals(TRUE)) + unlink(destdir, recursive = T, TRUE) + } else { + message("Please check install.nongithub('demo', destdir = destdir, verbose = F)") + expect_that(is.null(x) || is.logical(x), equals(TRUE)) + } }) test_that("install.bioinfo", { destdir <- sprintf('%s/demo1', tempdir()) destdir <- normalizePath(destdir, "/", FALSE) - x <- install.bioinfo('demo', destdir = destdir, verbose = F) - expect_that("demo" %in% x$success.list, equals(TRUE)) - expect_that(is.list(get.info('demo')), equals(TRUE)) - unlink(destdir, recursive = T, TRUE) + x <- tryCatch(install.bioinfo('demo', destdir = destdir, verbose = F), + error = function(e) {message(e); NULL}) + if (!is.null(x) && is.list(x) && "demo" %in% x$success.list) { + expect_that("demo" %in% x$success.list, equals(TRUE)) + expect_that(is.list(get.info('demo')), equals(TRUE)) + unlink(destdir, recursive = T, TRUE) - destdir <- sprintf('%s/github_demo3', tempdir()) - destdir <- normalizePath(destdir, "/", FALSE) - unlink(destdir, recursive = T, TRUE) - x <- install.bioinfo(name = "github_demo", destdir = destdir, - download.dir = destdir, verbose = F) - expect_that("github_demo" %in% x$success.list, equals(TRUE)) + destdir <- sprintf('%s/github_demo3', tempdir()) + destdir <- normalizePath(destdir, "/", FALSE) + unlink(destdir, recursive = T, TRUE) + } else { + message("Please check install.bioinfo('demo', destdir = destdir, verbose = F)") + expect_that(is.null(x) || is.list(x), equals(TRUE)) + expect_that("demo" %in% x$fail.list, equals(TRUE)) + } + x <- tryCatch(install.bioinfo(name = "github_demo", destdir = destdir, + download.dir = destdir, verbose = F), + error = function(e) { + message("Connecting Github website failed (SSL possible)."); NULL + }) + if (!is.null(x)) expect_that("github_demo" %in% x$success.list, equals(TRUE)) unlink(destdir, recursive = T, TRUE) }) diff --git a/tests/testthat/test_install_uilts.R b/tests/testthat/test_install_utils.R similarity index 76% rename from tests/testthat/test_install_uilts.R rename to tests/testthat/test_install_utils.R index 411228b..84221b5 100644 --- a/tests/testthat/test_install_uilts.R +++ b/tests/testthat/test_install_utils.R @@ -36,10 +36,13 @@ test_that("initial",{ config.cfg <- system.file("extdata", "config/github/github.toml", package = "BioInstaller") x <- config.and.name.initial(config.cfg, "bwa") config <- eval.config(config = "bwa", file = config.cfg) - versions <- show.avaliable.versions(config) - params <- list(name = "bwa", version = "v0.7.15", versions = versions, config = config) - x <- do.call(version.initial, params) - expect_that(x, equals("v0.7.15")) + versions <- tryCatch(show.avaliable.versions(config), + error = function(e) {message("Featch bwa version failed."); NULL}) + if (!is.null(versions)) { + params <- list(name = "bwa", version = "v0.7.15", versions = versions, config = config) + x <- do.call(version.initial, params) + expect_that(x, equals("v0.7.15")) + } x <- tryCatch({ x <- check.configfile.validate(config.cfg) }, warning = function(w) {}, error = function(e){ @@ -85,12 +88,15 @@ test_that("dependence",{ expect_that(x[[1]][1], equals('htslib')) destdir <- sprintf('%s/', tempdir()) destdir <- normalizePath(destdir, "/", FALSE) - x <- install.dependence('github_demo', 'master', destdir, destdir, F) - expect_that(x, equals(TRUE)) - unlink(destdir, recursive=TRUE, TRUE) - x <- process.dependence(eval.config(config = "github_demo", file = config.cfg), db, destdir, destdir, FALSE) - expect_that(x, equals(TRUE)) - unlink(destdir, recursive=TRUE, TRUE) + x <- tryCatch(install.dependence('github_demo', 'master', destdir, destdir, F), + error = function(e) {message("Connecting Github website failed."); NULL}) + if (!is.null(x)) { + expect_that(x, equals(TRUE)) + unlink(destdir, recursive=TRUE, TRUE) + x <- process.dependence(eval.config(config = "github_demo", file = config.cfg), db, destdir, destdir, FALSE) + expect_that(x, equals(TRUE)) + unlink(destdir, recursive=TRUE, TRUE) + } }) @@ -99,8 +105,10 @@ test_that("git.download",{ destdir <- normalizePath(destdir, "/", FALSE) unlink(destdir, recursive = TRUE, TRUE) url <- "https://github.com/Miachol/github_demo" - x <- git.download("github_demo", destdir, "master", url, TRUE, FALSE, FALSE) - expect_that(x, equals(TRUE)) + x <- tryCatch(git.download("github_demo", destdir, "master", + url, TRUE, FALSE, FALSE), + error = function(e) {NULL}) + expect_that(is.null(x) || x, equals(TRUE)) unlink(destdir, recursive=TRUE, TRUE) }) diff --git a/tests/testthat/test_utils.R b/tests/testthat/test_utils.R index d6252d1..6eb06d2 100644 --- a/tests/testthat/test_utils.R +++ b/tests/testthat/test_utils.R @@ -101,8 +101,10 @@ test_that("get.file.type", { test_that("download.file.custom", { url <- "https://github.com/Miachol/ftp/blob/master/files/GRCh37_MT_ensGene.txt" destfile <- sprintf("%s/GRCh37", tempdir()) - x <- download.file.custom(url, destfile, quiet = T) - expect_that(x, equals(0)) + x <- tryCatch(download.file.custom(url, destfile, quiet = T), + warning= function(w) {NULL}) + if (!is.null(x)) expect_that(x, equals(0)) + else expect_that(x, equals(NULL)) unlink(destfile) }) diff --git a/tests/testthat/test_versions.R b/tests/testthat/test_versions.R index 1e20d9a..5e6e0c6 100644 --- a/tests/testthat/test_versions.R +++ b/tests/testthat/test_versions.R @@ -2,8 +2,13 @@ if (!dir.exists(tempdir())) { dir.create(tempdir()) } test_that("nongithub.versions",{ - x <- nongithub2versions("gmap") - expect_that(length(x) > 1, equals(TRUE)) + x <- tryCatch(nongithub2versions("gmap"), error = function(e) { + message("Connecting Gmap website failed. Please try it later.") + NULL + }) + if (!is.null(x)) expect_that(length(x) > 1, equals(TRUE)) else { + expect_that(x, equals(NULL)) + } }) temps <- list.files(tempdir(), ".*") unlink(sprintf("%s/%s", tempdir(), temps), recursive = TRUE, TRUE) diff --git a/tests/testthat/test_web.R b/tests/testthat/test_web.R new file mode 100644 index 0000000..4d97628 --- /dev/null +++ b/tests/testthat/test_web.R @@ -0,0 +1,7 @@ +test_that("copy_plugins_configs", { + destdir = tempdir() + x <- copy_plugins(destdir) + expect_that(all(x), equals(TRUE)) + x <- copy_configs(destdir) + expect_that(all(x), equals(TRUE)) +})