1#' Release package to CRAN. 2#' 3#' Run automated and manual tests, then post package to CRAN. 4#' 5#' The package release process will: 6#' 7#' \itemize{ 8#' \item Confirm that the package passes `R CMD check` on relevant platforms 9#' \item Confirm that important files are up-to-date 10#' \item Build the package 11#' \item Submit the package to CRAN, using comments in "cran-comments.md" 12#' } 13#' 14#' You can add arbitrary extra questions by defining an (un-exported) function 15#' called `release_questions()` that returns a character vector 16#' of additional questions to ask. 17#' 18#' You also need to read the CRAN repository policy at 19#' 'https://cran.r-project.org/web/packages/policies.html' and make 20#' sure you're in line with the policies. `release` tries to automate as 21#' many of polices as possible, but it's impossible to be completely 22#' comprehensive, and they do change in between releases of devtools. 23#' 24#' @template devtools 25#' @param check if `TRUE`, run checking, otherwise omit it. This 26#' is useful if you've just checked your package and you're ready to 27#' release it. 28#' @param args An optional character vector of additional command 29#' line arguments to be passed to `R CMD build`. 30#' @seealso [usethis::use_release_issue()] to create a checklist of release 31#' tasks that you can use in addition to or in place of `release`. 32#' @export 33release <- function(pkg = ".", check = FALSE, args = NULL) { 34 pkg <- as.package(pkg) 35 # Figure out if this is a new package 36 cran_version <- cran_pkg_version(pkg$package) 37 new_pkg <- is.null(cran_version) 38 39 if (yesno("Have you checked for spelling errors (with `spell_check()`)?")) { 40 return(invisible()) 41 } 42 43 if (check) { 44 cat_rule( 45 left = "Building and checking", 46 right = pkg$package, 47 line = 2 48 ) 49 check(pkg, 50 cran = TRUE, remote = TRUE, manual = TRUE, 51 build_args = args, run_dont_test = TRUE 52 ) 53 } 54 if (yesno("Have you run `R CMD check` locally?")) { 55 return(invisible()) 56 } 57 58 release_checks(pkg) 59 if (yesno("Were devtool's checks successful?")) { 60 return(invisible()) 61 } 62 63 if (!new_pkg) { 64 show_cran_check <- TRUE 65 cran_details <- NULL 66 end_sentence <- " ?" 67 if (requireNamespace("foghorn", quietly = TRUE)) { 68 show_cran_check <- has_cran_results(pkg$package) 69 cran_details <- foghorn::cran_details(pkg = pkg$package) 70 } 71 if (show_cran_check) { 72 if (!is.null(cran_details)) { 73 end_sentence <- "\n shown above?" 74 cat_rule(paste0("Details of the CRAN check results for ", pkg$package)) 75 summary(cran_details) 76 cat_rule() 77 } 78 cran_url <- paste0( 79 cran_mirror(), "/web/checks/check_results_", 80 pkg$package, ".html" 81 ) 82 if (yesno( 83 "Have you fixed all existing problems at \n", cran_url, 84 end_sentence 85 )) { 86 return(invisible()) 87 } 88 } 89 } 90 91 if (yesno("Have you checked on R-hub (with `check_rhub()`)?")) { 92 return(invisible()) 93 } 94 95 if (yesno("Have you checked on win-builder (with `check_win_devel()`)?")) { 96 return(invisible()) 97 } 98 99 deps <- if (new_pkg) 0 else length(revdep(pkg$package)) 100 if (deps > 0) { 101 msg <- paste0( 102 "Have you checked the ", deps, " reverse dependencies ", 103 "(with the revdepcheck package)?" 104 ) 105 if (yesno(msg)) { 106 return(invisible()) 107 } 108 } 109 110 questions <- c( 111 "Have you updated `NEWS.md` file?", 112 "Have you updated `DESCRIPTION`?", 113 "Have you updated `cran-comments.md?`", 114 if (dir_exists("docs/")) "Have you updated website in `docs/`?", 115 if (file_exists("codemeta.json")) "Have you updated codemeta.json with codemetar::write_codemeta()?", 116 find_release_questions(pkg) 117 ) 118 for (question in questions) { 119 if (yesno(question)) return(invisible()) 120 } 121 122 if (uses_git(pkg$path)) { 123 git_checks(pkg) 124 if (yesno("Were Git checks successful?")) { 125 return(invisible()) 126 } 127 } 128 129 submit_cran(pkg, args = args) 130 131 invisible(TRUE) 132} 133 134has_cran_results <- function(pkg) { 135 cran_res <- foghorn::cran_results( 136 pkg = pkg, 137 show = c("error", "fail", "warn", "note") 138 ) 139 sum(cran_res[, -1]) > 0 140} 141 142find_release_questions <- function(pkg = ".") { 143 pkg <- as.package(pkg) 144 145 q_fun <- pkgload::ns_env(pkg$package)$release_questions 146 if (is.null(q_fun)) { 147 character() 148 } else { 149 q_fun() 150 } 151} 152 153yesno <- function(...) { 154 yeses <- c("Yes", "Definitely", "For sure", "Yup", "Yeah", "Of course", "Absolutely") 155 nos <- c("No way", "Not yet", "I forget", "No", "Nope", "Uhhhh... Maybe?") 156 157 cat(paste0(..., collapse = "")) 158 qs <- c(sample(yeses, 1), sample(nos, 2)) 159 rand <- sample(length(qs)) 160 161 utils::menu(qs[rand]) != which(rand == 1) 162} 163 164# https://tools.ietf.org/html/rfc2368 165email <- function(address, subject, body) { 166 url <- paste( 167 "mailto:", 168 utils::URLencode(address), 169 "?subject=", utils::URLencode(subject), 170 "&body=", utils::URLencode(body), 171 sep = "" 172 ) 173 174 tryCatch({ 175 utils::browseURL(url, browser = email_browser()) 176 }, 177 error = function(e) { 178 cli::cli_alert_danger("Sending failed with error: {e$message}") 179 cat("To: ", address, "\n", sep = "") 180 cat("Subject: ", subject, "\n", sep = "") 181 cat("\n") 182 cat(body, "\n", sep = "") 183 } 184 ) 185 186 invisible(TRUE) 187} 188 189email_browser <- function() { 190 if (!identical(.Platform$GUI, "RStudio")) { 191 return(getOption("browser")) 192 } 193 194 # Use default browser, even if RStudio running 195 if (.Platform$OS.type == "windows") { 196 return(NULL) 197 } 198 199 browser <- Sys.which(c("xdg-open", "open")) 200 browser[nchar(browser) > 0][[1]] 201} 202 203 204maintainer <- function(pkg = ".") { 205 pkg <- as.package(pkg) 206 207 authors <- pkg$`authors@r` 208 if (!is.null(authors)) { 209 people <- eval(parse(text = authors)) 210 if (is.character(people)) { 211 maintainer <- utils::as.person(people) 212 } else { 213 maintainer <- Find(function(x) "cre" %in% x$role, people) 214 } 215 } else { 216 maintainer <- pkg$maintainer 217 if (is.null(maintainer)) { 218 stop("No maintainer defined in package.", call. = FALSE) 219 } 220 maintainer <- utils::as.person(maintainer) 221 } 222 223 list( 224 name = paste(maintainer$given, maintainer$family), 225 email = maintainer$email 226 ) 227} 228 229cran_comments <- function(pkg = ".") { 230 pkg <- as.package(pkg) 231 232 path <- path(pkg$path, "cran-comments.md") 233 if (!file_exists(path)) { 234 warning("Can't find cran-comments.md.\n", 235 "This file gives CRAN volunteers comments about the submission,\n", 236 "Create it with use_cran_comments().\n", 237 call. = FALSE 238 ) 239 return(character()) 240 } 241 242 paste0(readLines(path, warn = FALSE), collapse = "\n") 243} 244 245cran_submission_url <- "https://xmpalantir.wu.ac.at/cransubmit/index2.php" 246 247#' Submit a package to CRAN. 248#' 249#' This uses the new CRAN web-form submission process. After submission, you 250#' will receive an email asking you to confirm submission - this is used 251#' to check that the package is submitted by the maintainer. 252#' 253#' It's recommended that you use [release()] rather than this 254#' function as it performs more checks prior to submission. 255#' 256#' @template devtools 257#' @inheritParams release 258#' @export 259#' @keywords internal 260submit_cran <- function(pkg = ".", args = NULL) { 261 if (yesno("Is your email address ", maintainer(pkg)$email, "?")) { 262 return(invisible()) 263 } 264 265 pkg <- as.package(pkg) 266 built_path <- build_cran(pkg, args = args) 267 268 if (yesno("Ready to submit ", pkg$package, " (", pkg$version, ") to CRAN?")) { 269 return(invisible()) 270 } 271 272 upload_cran(pkg, built_path) 273 274 usethis::with_project(pkg$path, 275 flag_release(pkg) 276 ) 277} 278 279build_cran <- function(pkg, args) { 280 cli::cli_alert_info("Building") 281 built_path <- pkgbuild::build(pkg$path, tempdir(), manual = TRUE, args = args) 282 cli::cli_alert_info("Submitting file: {built_path}") 283 size <- format(as.object_size(file_info(built_path)$size), units = "auto") 284 cli::cli_alert_info("File size: {size}") 285 built_path 286} 287 288extract_cran_msg <- function(msg) { 289 # Remove "CRAN package Submission" and "Submit package to CRAN" 290 msg <- gsub("CRAN package Submission|Submit package to CRAN", "", msg) 291 292 # remove all html tags 293 msg <- gsub("<[^>]+>", "", msg) 294 295 # remove tabs 296 msg <- gsub("\t+", "", msg) 297 298 # Remove extra newlines 299 msg <- gsub("\n+", "\n", msg) 300 301 msg 302} 303 304upload_cran <- function(pkg, built_path) { 305 pkg <- as.package(pkg) 306 maint <- maintainer(pkg) 307 comments <- cran_comments(pkg) 308 309 # Initial upload --------- 310 cli::cli_alert_info("Uploading package & comments") 311 body <- list( 312 pkg_id = "", 313 name = maint$name, 314 email = maint$email, 315 uploaded_file = httr::upload_file(built_path, "application/x-gzip"), 316 comment = comments, 317 upload = "Upload package" 318 ) 319 r <- httr::POST(cran_submission_url, body = body) 320 321 # If a 404 likely CRAN is closed for maintenance, try to get the message 322 if (httr::status_code(r) == 404) { 323 msg <- "" 324 try({ 325 r2 <- httr::GET(sub("index2", "index", cran_submission_url)) 326 msg <- extract_cran_msg(httr::content(r2, "text")) 327 }) 328 stop("Submission failed:", msg, call. = FALSE) 329 } 330 331 httr::stop_for_status(r) 332 new_url <- httr::parse_url(r$url) 333 334 # Confirmation ----------- 335 cli::cli_alert_info("Confirming submission") 336 body <- list( 337 pkg_id = new_url$query$pkg_id, 338 name = maint$name, 339 email = maint$email, 340 policy_check = "1/", 341 submit = "Submit package" 342 ) 343 r <- httr::POST(cran_submission_url, body = body) 344 httr::stop_for_status(r) 345 new_url <- httr::parse_url(r$url) 346 if (new_url$query$submit == "1") { 347 cli::cli_alert_success("Package submission successful") 348 cli::cli_alert_info("Check your email for confirmation link.") 349 } else { 350 stop("Package failed to upload.", call. = FALSE) 351 } 352 353 invisible(TRUE) 354} 355 356as.object_size <- function(x) structure(x, class = "object_size") 357 358flag_release <- function(pkg = ".") { 359 pkg <- as.package(pkg) 360 if (!uses_git(pkg$path)) { 361 return(invisible()) 362 } 363 364 cli::cli_alert_warning("Don't forget to tag this release once accepted by CRAN") 365 366 date <- Sys.Date() 367 withr::with_dir(pkg$path, { 368 sha <- system2("git", c("rev-parse", "--short", "HEAD"), stdout = TRUE) 369 }) 370 371 msg <- paste0( 372 "This package was submitted to CRAN on ", date, ".\n", 373 "Once it is accepted, delete this file and tag the release (commit ", sha, ")." 374 ) 375 writeLines(msg, path(pkg$path, "CRAN-RELEASE")) 376 usethis::use_build_ignore("CRAN-RELEASE") 377} 378 379cran_mirror <- function(repos = getOption("repos")) { 380 repos[repos == "@CRAN@"] <- "https://cloud.r-project.org" 381 382 if (is.null(names(repos))) { 383 names(repos) <- "CRAN" 384 } 385 386 repos[["CRAN"]] 387} 388 389# Return the version of a package on CRAN (or other repository) 390# @param package The name of the package. 391# @param available A matrix of information about packages. 392cran_pkg_version <- function(package, available = available.packages()) { 393 idx <- available[, "Package"] == package 394 if (any(idx)) { 395 as.package_version(available[package, "Version"]) 396 } else { 397 NULL 398 } 399} 400