1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
# retrieve the release dates of packages
cran_pkg_dates = function(full = FALSE, maintainer = 'Yihui Xie') {
info = tools::CRAN_package_db()
pkgs = info[grep(maintainer, info$Maintainer), 'Package']
info = setNames(vector('list', length(pkgs)), pkgs)
for (p in pkgs) {
message('Processing ', p)
x = readLines(u <- sprintf('https://cran.rstudio.com/web/packages/%s/', p))
i = which(x == '<td>Published:</td>')
if (length(i) == 0) stop('Cannot find the publishing date from ', u)
d = as.Date(gsub('</?td>', '', x[i[1] + 1]))
x = try_silent(suppressWarnings(readLines(
u <- sprintf('https://cran.r-project.org/src/contrib/Archive/%s/', p)
)))
if (inherits(x, 'try-error')) {
info[[p]] = d; next
}
r = '.+</td><td align="right">(\\d{4,}-\\d{2}-\\d{2}) .+'
d = c(d, as.Date(gsub(r, '\\1', grep(r, x, value = TRUE))))
info[[p]] = sort(d, decreasing = TRUE)
}
if (full) info else sort(do.call(c, lapply(info, `[`, 1)), decreasing = TRUE)
}
# return packages that haven't been updated for X days, and can be updated on CRAN
cran_updatable = function(days = 90, maintainer = 'Yihui Xie') {
info = cran_pkg_dates(TRUE, maintainer)
flag = unlist(lapply(info, function(d) {
sum(d > Sys.Date() - 180) < 6 && d[1] < Sys.Date() - days
}))
if (length(pkgs <- names(which(flag))) == 0) return(pkgs)
# look into DESCRIPTION in Github repos and see if new version has been pushed
info = tools::CRAN_package_db()
info = info[info$Package %in% pkgs, , drop = FALSE]
pkgs = info$Package
for (i in seq_len(nrow(info))) {
b = grep_sub('^(https://github.com/[^/]+/[^/]+)/issues$', '\\1', info$BugReports[i])
if (length(b) != 1) next
f = tempfile()
u = paste0(b, '/raw/HEAD/DESCRIPTION')
if (is.null(tryCatch(download.file(u, f, quiet = TRUE), error = function(e) NULL))) next
d = read.dcf(f)
file.remove(f)
if (!'Version' %in% colnames(d)) next
if (as.numeric_version(d[, 'Version']) <= paste0(info$Version[i], '.1')) {
pkgs = setdiff(pkgs, info$Package[i])
message('Skipped package ', info$Package[i], ' ', d[, 'Version'], ' (no new version).')
} else {
message('Package can be updated: ', b)
}
}
pkgs
}
#' Some utility functions for checking packages
#'
#' Miscellaneous utility functions to obtain information about the package
#' checking environment.
#' @export
#' @keywords internal
is_R_CMD_check = function() {
!is.na(check_package_name()) || tolower(Sys.getenv('_R_CHECK_LICENSE_')) == 'true'
}
#' @rdname is_R_CMD_check
#' @export
is_CRAN_incoming = function() {
isTRUE(as.logical(Sys.getenv('_R_CHECK_CRAN_INCOMING_REMOTE_')))
}
#' @rdname is_R_CMD_check
#' @export
check_package_name = function() {
Sys.getenv('_R_CHECK_PACKAGE_NAME_', NA)
}
# is R CMD check running on a package that has a version lower or equal to `version`?
#' @rdname is_R_CMD_check
#' @export
check_old_package = function(name, version) {
if (is.na(pkg <- check_package_name()) || pkg != name) return(FALSE)
tryCatch(packageVersion(name) <= version, error = function(e) FALSE)
}
# return package maintainers (with email addresses)
pkg_maintainers = function(pkgs) {
info = tools::CRAN_package_db()
info = info[match(pkgs, info$Package), c('Package', 'Maintainer')]
setNames(info$Maintainer, info$Package)
}
#' Submit a source package to CRAN
#'
#' Build a source package and submit it to CRAN with the \pkg{curl} package.
#' @param file The path to the source package tarball. By default, the current
#' working directory is treated as the package root directory, and
#' automatically built into a tarball, which is deleted after submission. This
#' means you should run \code{xfun::submit_cran()} in the root directory of a
#' package project, unless you want to pass a path explicitly to the
#' \code{file} argument.
#' @param comment Submission comments for CRAN. By default, if a file
#' \file{cran-comments.md} exists, its content will be read and used as the
#' comment.
#' @seealso \code{devtools::submit_cran()} does the same job, with a few more
#' dependencies in addition to \pkg{curl} (such as \pkg{cli});
#' \code{xfun::submit_cran()} only depends on \pkg{curl}.
#' @export
submit_cran = function(file = pkg_build(), comment = '') {
# if the tarball is automatically created, delete it after submission
if (missing(file)) on.exit(file.remove(file), add = TRUE)
# read the maintainer's name/email
dir_create(d <- tempfile())
on.exit(unlink(d, recursive = TRUE), add = TRUE)
desc = file.path(gsub('_.*', '', basename(file)), 'DESCRIPTION')
untar(file, desc, exdir = d)
info = read.dcf(file.path(d, desc), fields = 'Maintainer')[1, 1]
info = unlist(strsplit(info, '( <|>)'))
# read submission comments from cran-comments.md if exists
if (missing(comment) && file_exists(f <- 'cran-comments.md')) {
comment = file_string(f)
}
params = list(
uploaded_file = curl::form_file(file), name = info[1], email = info[2],
upload = 'Upload package'
)
params$comment = if (length(comment)) comment
server = 'https://xmpalantir.wu.ac.at/cransubmit/index2.php'
# submit the form
h = curl::new_handle()
curl::handle_setform(h, .list = params)
res = curl::curl_fetch_memory(server, h)
# find the pkg_id from the response page
id = grep_sub(
'(.*<input name="pkg_id" type="hidden" value=")([^"]+)(".*)', '\\2',
rawToChar(res$content)
)
if (length(id) != 1) stop('Failed to submit ', file, ' to CRAN')
# skip the review and submit directly
h = curl::new_handle()
curl::handle_setform(h, .list = list(pkg_id = id, submit = 'Submit package'))
res = curl::curl_fetch_memory(server, h)
if (grepl('>Step 3<', rawToChar(res$content))) message(
'The package has been submitted. Please confirm the submission in email: ',
params$email
) else message('The submission may be unsuccessful.')
}
|
