From 6deedfaa122a7e72dc94ccd47be723517483dfb9 Mon Sep 17 00:00:00 2001 From: Sam Rogers <7007561+rogerssam@users.noreply.github.com> Date: Thu, 30 Nov 2023 21:33:48 +1030 Subject: [PATCH] Finished version comparison functions --- R/install_asreml.R | 175 +++++++++++++++++++++++++++++---------------- 1 file changed, 114 insertions(+), 61 deletions(-) diff --git a/R/install_asreml.R b/R/install_asreml.R index 475c855..fa5455c 100644 --- a/R/install_asreml.R +++ b/R/install_asreml.R @@ -37,8 +37,8 @@ install_asreml <- function(library = .libPaths()[1], quiet = FALSE, force = FALS # Get OS and R version - os_ver <- build_version() - url <- paste0("https://link.biometryhubwaite.com/", os, "-", ifelse(arm, "arm-", ""), ver) + os_ver <- get_r_os() + url <- paste0("https://link.biometryhubwaite.com/", os_ver$os_ver) # First check if file already exists, both in the current directory and temp folder # Need to create a regex to check it's the correct file extension, so tests ignore .R files @@ -72,7 +72,7 @@ install_asreml <- function(library = .libPaths()[1], quiet = FALSE, force = FALS } # If forcing installation, remove existing version to avoid errors on installation - if(force && rlang::is_installed("asreml") && os != "linux") { + if(force && rlang::is_installed("asreml") && os_ver$os != "linux") { if("asreml" %in% .packages()) { detach("package:asreml", unload = TRUE, force = TRUE) } @@ -92,7 +92,7 @@ install_asreml <- function(library = .libPaths()[1], quiet = FALSE, force = FALS } # Install asreml - install.packages(save_file, lib = library, repos = NULL, quiet = quiet, type = ifelse(os == "win", "binary", "source")) + install.packages(save_file, lib = library, repos = NULL, quiet = quiet, type = ifelse(os_ver$os == "win", "binary", "source")) # If keep_file is true, copy asreml to current directory if(keep_file == TRUE) { @@ -161,48 +161,16 @@ update_asreml <- function(...) { } -#' Build the version of R and OS +#' Get the version of R and OS #' -#' @return A string with the version of R and the OS in a standard format +#' @return A list with the version of R and the OS in a standard format #' @keywords internal -build_version <- function() { - # macOS needs some special set up - arm <- FALSE - if(Sys.info()[["sysname"]] == "Darwin") { - # Monterey needs a folder created - if (Sys.info()["release"] >= 21 && !dir.exists("/Library/Application Support/Reprise/")) { +get_r_os <- function() { - result <- tryCatch( - expr = { - dir.create("/Library/Application Support/Reprise/", recursive = T) - }, - error = function(cond) { - return(FALSE) - }, - warning = function(cond) { - return(FALSE) - } - ) - - if(isFALSE(result)) { - message("The ASReml-R package uses Reprise license management and will require administrator privilege to create the folder '/Library/Application Support/Reprise' before it can be loaded.") - input <- readline("Would you like to create this folder now (Yes/No)? You will be prompted for your password if yes. ") - - if(toupper(input) %in% c("YES", "Y") && rlang::is_installed("getPass")) { - system("sudo -S mkdir '/Library/Application Support/Reprise' && sudo -S chmod 777 '/Library/Application Support/Reprise'", - input = getPass::getPass("Please enter your user account password: ")) - } - else { - stop("ASReml-R cannot be installed until the folder '/Library/Application Support/Reprise' is created with appropriate permissions. - Please run the following command on your terminal: - sudo -S mkdir '/Library/Application Support/Reprise' && sudo -S chmod 777 '/Library/Application Support/Reprise'") - } - } - } - # arm Macs need a different package - if(Sys.info()[["machine"]] == "arm64") { - arm <- TRUE - } + arm <- FALSE + # arm Macs need a different package + if(Sys.info()[["sysname"]] == "Darwin" && Sys.info()[["machine"]] == "arm64") { + arm <- TRUE } os <- switch(Sys.info()[['sysname']], @@ -213,40 +181,125 @@ build_version <- function() { ver <- gsub("\\.", "", substr(getRversion(), 1, 3)) - os_ver <- paste0(os, "-", ifelse(arm, "arm-", ""), ver) + os_ver <- list(os_ver = paste0(os, "-", ifelse(arm, "arm-", ""), ver), + os = os, ver = ver, arm = arm) return(os_ver) } -#' Check for a new version of ASReml-R +#' Get released versions of ASReml-R in lookup table #' -#' @return The version number and release date of latest released ASReml-R version for comparison +#' @return A list of data frames containing the version number and release date of released ASReml-R versions for comparison #' @keywords internal -check_available_version <- function() { +#' @importFrom xml2 read_html xml_text xml_find_all +#' @importFrom stringi stri_split_fixed +get_version_table <- function() { url <- "https://asreml.kb.vsni.co.uk/asreml-r-4-download-success/?site_reference=VS9AF20" res <- xml2::read_html(url) - tables <- list() - done <- FALSE - i <- 1 - while(!done) { - header <- xml2::xml_text(xml2::xml_find_first(res, "//h3")) - tab <- xml2::xml_text(xml2::xml_find_first(res, xpath = "//table")) + headers <- xml2::xml_text(xml2::xml_find_all(res, "//h3")) + headers <- headers[grepl("^ASReml-?R? 4.*\\(All platforms\\)", headers)] + + tables <- xml2::xml_text(xml2::xml_find_all(res, xpath = "//table")) + tables <- tables[grepl("macOS", tables)] + tables <- stringi::stri_split_fixed(tables, "\n") + tables <- lapply(tables, \(x) x[!is.na(x) & x != ""]) + + fix_tables <- function(x) { + first_row <- x[1:4] + x <- as.data.frame(matrix(x[5:length(x)], ncol = 4, byrow = TRUE)) + colnames(x) <- first_row + # Parse dates + x[,grepl("Date", colnames(x))] <- as.Date(x[,grepl("Date", colnames(x))], + tryFormats = c("%d %B %Y", "%d/%m/%Y", + "%d %b %Y", "%d-%m-%Y")) + return(x) + } - # Do some checking here to break on old versions + for(i in 1:length(tables)) { + tables[[i]] <- fix_tables(tables[[i]]) + tables[[i]]["os"] <- ifelse(grepl("Windows", x = tables[[i]][["Download"]], ignore.case = TRUE), "win", + ifelse(grepl("macOS", x = tables[[i]][["Download"]], ignore.case = TRUE), "mac", + ifelse(grepl("Ubuntu", x = tables[[i]][["Download"]], ignore.case = TRUE), "linux", "centos"))) + tables[[i]]["arm"] <- ifelse(grepl("arm", x = tables[[i]][["Download"]], ignore.case = TRUE), TRUE, FALSE) + tables[[i]]["r_ver"] <- paste0(stringi::stri_match_first_regex(headers[i], "R version (\\d?)\\.(\\d?)")[2:3], collapse = "") + tables[[i]]["asr_ver"] <- stringi::stri_match_first_regex(tables[[i]][["File name"]], "asreml-?_?(\\d\\.\\d?\\.\\d?\\.\\d*)")[,2] + } + tables <- do.call("rbind", tables) - tab <- strsplit(tab, "\n") - cols <- tab[[1]][1:4] - tab <- as.data.frame(matrix(tab[[1]], ncol = 4, byrow = TRUE)[-1,]) - colnames(tab) <- cols - tables[[i]] <- tab - names(tables)[i] <- header + return(tables) +} - i <- i+1 +#' Compare installed version of ASReml-R with available versions +#' +#' @return TRUE if a newer version is available online, FALSE otherwise +#' @keywords internal +compare_versions <- function() { + online_versions <- get_version_table() + os_ver <- get_r_os() + + newest <- subset(online_versions, + online_versions$os==os_ver$os & + online_versions$arm==os_ver$arm & + online_versions$r_ver==os_ver$ver & + numeric_version(online_versions$asr_ver)==max(numeric_version(online_versions$asr_ver))) + + if(rlang::is_installed("asreml")) { + asr_desc <- packageDescription("asreml") + asr_date <- as.Date(substr(asr_desc$Packaged, 1, 10)) + asr_ver <- asr_desc$Version + } + else { + asr_date <- as.Date("1900-01-01") + asr_ver <- 0 } + + if(newest$`Date published` > asr_date | numeric_version(newest$asr_ver) > numeric_version(asr_ver)) { + output <- TRUE + } + else { + output <- FALSE + } + return(output) } +#' Create the folder MacOS needs for licensing +#' +#' @return logical; TRUE if folder successfully created, otherwise it will error +#' @keywords internal +create_mac_folder <- function() { + # macOS needs some special set up + if(Sys.info()[["sysname"]] == "Darwin" && + Sys.info()["release"] >= 21 && + !dir.exists("/Library/Application Support/Reprise/")) { + result <- tryCatch( + expr = { + dir.create("/Library/Application Support/Reprise/", recursive = T) + }, + error = function(cond) { + return(FALSE) + }, + warning = function(cond) { + return(FALSE) + } + ) + if(isFALSE(result)) { + message("The ASReml-R package uses Reprise license management and will require administrator privilege to create the folder '/Library/Application Support/Reprise' before it can be installed.") + input <- readline("Would you like to create this folder now (Yes/No)? You will be prompted for your password if yes. ") + if(toupper(input) %in% c("YES", "Y") && rlang::is_installed("getPass")) { + system("sudo -S mkdir '/Library/Application Support/Reprise' && sudo -S chmod 777 '/Library/Application Support/Reprise'", + input = getPass::getPass("Please enter your user account password: ")) + } + else { + stop("ASReml-R cannot be installed until the folder '/Library/Application Support/Reprise' is created with appropriate permissions. + Please run the following command on your terminal: + sudo -S mkdir '/Library/Application Support/Reprise' && sudo -S chmod 777 '/Library/Application Support/Reprise'") + } + } + } + return(dir.exists("/Library/Application Support/Reprise/")) +}