Skip to content

Commit

Permalink
Finished version comparison functions
Browse files Browse the repository at this point in the history
  • Loading branch information
@rogerssam
rogerssam committed Nov 30, 2023
1 parent 0890986 commit 6deedfa
Showing 1 changed file with 114 additions and 61 deletions.
175 changes: 114 additions & 61 deletions R/install_asreml.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
}
Expand All @@ -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) {
Expand Down Expand Up @@ -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']],
Expand All @@ -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/"))
}

0 comments on commit 6deedfa

Please sign in to comment.