|
5 | 5 | #' @return dataframe |
6 | 6 | #' @keywords internal |
7 | 7 | #' |
8 | | -.update_git_repos<-function(){ |
9 | | - git_pkgs = c("NPSdataverse", |
10 | | - "QCkit", |
11 | | - "EMLeditor", |
12 | | - "DPchecker", |
13 | | - "NPSutils", |
14 | | - "EMLassemblyline") |
| 8 | +.update_git_repos <- function() { |
| 9 | + git_pkgs <- tibble::tibble( |
| 10 | + package = c( |
| 11 | + "QCkit", |
| 12 | + "EMLeditor", |
| 13 | + "DPchecker", |
| 14 | + "NPSutils", |
| 15 | + "EMLassemblyline", |
| 16 | + "NPSdataverse" |
| 17 | + ), |
| 18 | + repo = c( |
| 19 | + "nationalparkservice", |
| 20 | + "nationalparkservice", |
| 21 | + "nationalparkservice", |
| 22 | + "nationalparkservice", |
| 23 | + "EDIorg", |
| 24 | + "nationalparkservice"), |
| 25 | + branch = c( |
| 26 | + "master", |
| 27 | + "main", |
| 28 | + "main", |
| 29 | + "master", |
| 30 | + "main", |
| 31 | + "main" |
| 32 | + ) |
| 33 | + ) |
15 | 34 |
|
16 | | - pkg_update <- remotes::package_deps(git_pkgs, dependencies = c("Imports", |
17 | | - "Remotes", |
18 | | - "Suggests")) |
| 35 | + git_pkgs$local_version <- lapply(git_pkgs$package, packageVersion) |
| 36 | + git_pkgs$latest_version <- mapply(function(x, y, z) .latest_github_version(repo = x, repo_owner = y, branch = z), git_pkgs$package, git_pkgs$repo, git_pkgs$branch, USE.NAMES = FALSE, SIMPLIFY = FALSE) |
| 37 | + git_pkgs$behind <- mapply(function(x, y) x < y, git_pkgs$local_version, git_pkgs$latest_version) |
| 38 | + git_pkgs$ahead <- mapply(function(x, y) x > y, git_pkgs$local_version, git_pkgs$latest_version) |
| 39 | + git_pkgs$local_version <- sapply(git_pkgs$local_version, as.character) |
| 40 | + git_pkgs$latest_version <- sapply(git_pkgs$latest_version, as.character) |
| 41 | + |
| 42 | + if (any(git_pkgs$behind)) { |
| 43 | + old_pkgs <- git_pkgs[git_pkgs$behind, ] |
19 | 44 |
|
20 | | - if(any(pkg_update$diff < 0)){ |
21 | | - old_pkgs <- NULL |
22 | | - old_users <- NULL |
23 | | - for(i in seq_along(pkg_update$diff)){ |
24 | | - if(pkg_update$diff[i] < 0){ |
25 | | - old_pkgs <- append(old_pkgs, pkg_update$package[i]) |
26 | | - old_users <- append(old_users, pkg_update$remote[[i]]$username) |
27 | | - } |
28 | | - } |
29 | 45 | load_header <- cli::rule( |
30 | 46 | left = cli::pluralize( |
31 | | - "The following {cli::qty(length(old_pkgs))}package{?s} {?is/are} out of date:\n")) |
32 | | - msg(load_header) |
33 | | - .print_cust_package_deps(pkg_update) |
| 47 | + "The following {cli::qty(length(old_pkgs$package))}package{?s} {?is/are} out of date:\n" |
| 48 | + ) |
| 49 | + ) |
| 50 | + packageStartupMessage(load_header) |
| 51 | + packageStartupMessage(.print_cust_package_deps(old_pkgs)) |
34 | 52 | cli::cat_line() |
35 | 53 | cli::cli_text( |
36 | | - "{.strong To update {cli::qty(length(old_pkgs))}th{?is/ese} {cli::qty(length(old_pkgs))}package{?s}, please run:\n}") |
| 54 | + "{.strong To update {cli::qty(length(old_pkgs$package))}th{?is/ese} {cli::qty(length(old_pkgs$package))}package{?s}, please run:\n}" |
| 55 | + ) |
37 | 56 | cli::cat_line("detach_NPSdataverse()") |
38 | | - cli::cat_line("devtools::install_github(\"", old_users, "/", old_pkgs, "\")") |
| 57 | + cli::cat_line("devtools::install_github(\"", old_pkgs$repo, "/", old_pkgs$package, "\")") |
39 | 58 | cli::cat_line("\nClose R and Rstudio. Open a new R session and reload the NPSdataverse.") |
40 | 59 | cli::cat_line() |
41 | | - } |
42 | | - else{ |
| 60 | + } else { |
43 | 61 | load_header <- cli::rule( |
44 | 62 | left = cli::pluralize( |
45 | | - "All NPSdataverse packages are up to date.")) |
46 | | - msg(load_header) |
| 63 | + "All NPSdataverse packages are up to date." |
| 64 | + ) |
| 65 | + ) |
| 66 | + packageStartupMessage(load_header) |
47 | 67 | cli::cat_line() |
48 | 68 | } |
49 | | - |
50 | 69 | } |
51 | 70 |
|
52 | 71 | #' Custom print function for github repos to update |
|
61 | 80 | #' @return printed text to console |
62 | 81 | #' @keywords internal |
63 | 82 | #' |
64 | | -.print_cust_package_deps<-function (x, show_ok = FALSE, ...){ |
65 | | - class(x) <- "data.frame" |
66 | | - x$remote <- lapply(x$remote, format) |
67 | | - ahead <- x$diff > 0L |
68 | | - behind <- x$diff < 0L |
69 | | - same_ver <- x$diff == 0L |
70 | | - x$diff <- NULL |
71 | | - x[] <- lapply(x, remotes:::format_str, width = 12) |
72 | | - if (any(behind)) { |
73 | | - #cat("Needs update -----------------------------\n") |
74 | | - print(x[behind, , drop = FALSE], row.names = FALSE, right = FALSE) |
75 | | - } |
76 | | - if (any(ahead)) { |
77 | | - cat("Not on CRAN ----------------------------\n") |
78 | | - print(x[ahead, , drop = FALSE], row.names = FALSE, right = FALSE) |
| 83 | +.print_cust_package_deps <- function(pkgs) { |
| 84 | + |
| 85 | + pkg_names <- paste0(cli::col_yellow(cli::symbol$warning), " ", cli::col_blue(pkgs$package)) |
| 86 | + vers <- paste0("(", pkgs$local_version, " ", cli::symbol$arrow_right, " ", pkgs$latest_version, ")") |
| 87 | + |
| 88 | + packages <- paste( |
| 89 | + cli::ansi_align(pkg_names, max(cli::ansi_nchar(pkg_names))), |
| 90 | + vers, collapse = "\n") |
| 91 | + |
| 92 | + return(packages) |
| 93 | +} |
| 94 | + |
| 95 | +#' Get the latest version of an R package that is on GitHub |
| 96 | +#' |
| 97 | +#' @param repo Name of the GitHub repository (e.g. "DPchecker") |
| 98 | +#' @param repo_owner Owner of the GitHub repository (e.g. "nationalparkservice") |
| 99 | +#' @param branch Branch to use (defaults to "main") |
| 100 | +#' @param release_only If TRUE, only looks at GitHub releases. If FALSE (default), looks at the version number in the DESCRIPTION file. |
| 101 | +#' |
| 102 | +#' @returns A package version number |
| 103 | +#' @keywords internal |
| 104 | +#' |
| 105 | +.latest_github_version <- function(repo, repo_owner, branch = "main", release_only = FALSE) { |
| 106 | + if (!release_only) { |
| 107 | + # Get version number from DESCRIPTION file on GitHub |
| 108 | + description_url <- paste("https://raw.githubusercontent.com", repo_owner, repo, branch, "DESCRIPTION", sep = "/") |
| 109 | + description <- readr::read_lines(description_url) |
| 110 | + version_line <- grep("^Version:\\s*", description) |
| 111 | + version_number <- stringr::str_remove(description[version_line], "^Version:\\s*") |
79 | 112 | } |
80 | | - if (show_ok && any(same_ver)) { |
81 | | - cat("OK ---------------------------------------\n") |
82 | | - print(x[same_ver, , drop = FALSE], row.names = FALSE, |
83 | | - right = FALSE) |
| 113 | + else { |
| 114 | + # Get version number of latest release on GitHub |
| 115 | + releases_url <- paste("https://api.github.com/repos", repo_owner, repo, "releases?per_page=1", sep = "/") |
| 116 | + latest_release <- gh::gh(releases_url) |
| 117 | + version_number <- latest_release[[1]]$tag_name |
84 | 118 | } |
| 119 | + |
| 120 | + version_number <- stringr::str_remove_all(version_number, "[a-zA-Z]") |
| 121 | + version_number <- as.package_version(version_number) |
| 122 | + |
| 123 | + return(version_number) |
85 | 124 | } |
0 commit comments