Skip to content

Commit 4884591

Browse files
mpadgempadge
authored
Merge pull request #18 from ropensci-review-tools/ci
ci chaoss metric for #11
2 parents d6ad8ab + 176204a commit 4884591

11 files changed

+705
-2
lines changed

‎DESCRIPTION

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
Package: githist
22
Title: Code analyses traced along the 'git' history of a package
3-
Version: 0.1.0.044
3+
Version: 0.1.0.049
44
Authors@R:
55
person("Mark", "Padgham", , "mark.padgham@email.com", role = c("aut", "cre"),
66
comment = c(ORCID = "0000-0003-2172-5265"))

‎R/chaoss-metrics-external.R

+9
Original file line numberDiff line numberDiff line change
@@ -25,3 +25,12 @@ cran_downloads <- function (pkg_name, end_date = Sys.Date ()) {
2525
body <- httr2::resp_body_json (resp)
2626
return (body [[1]]$downloads)
2727
}
28+
29+
has_gh_ci_tests <- function (path) {
30+
31+
or <- org_repo_from_path (path)
32+
33+
ci_data <- github_repo_workflow_query (or [1], or [2])
34+
h <- gert::git_log (repo = path, max = 1e6)
35+
any (ci_data$sha %in% h$commit)
36+
}

‎R/chaoss-metrics-hybrid.R

+16
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,16 @@
1+
# Hybird metrics from both internal structure and external data
2+
3+
chaoss_metric_has_ci <- function (path) {
4+
has_ci <- has_gh_ci_tests (path)
5+
if (!has_ci) {
6+
ci_files <- repo_has_ci_files (path)
7+
has_ci <- length (ci_files) > 0L
8+
if (has_ci) {
9+
cli::cli_alert_info (
10+
"Unable to determine whether runs are recent for CI service [{ci_files}]."
11+
)
12+
}
13+
}
14+
15+
return (has_ci)
16+
}

‎R/chaoss-metrics-internal.R

+21
Original file line numberDiff line numberDiff line change
@@ -62,3 +62,24 @@ git_log_in_period_internal <- function (path, end_date = Sys.Date (), period = 9
6262
return (h)
6363
}
6464
git_log_in_period <- memoise::memoise (git_log_in_period_internal)
65+
66+
#' Return names of CI services from corresponding configuration files contained
67+
#' in local repo.
68+
#' @noRd
69+
repo_has_ci_files <- function (path) {
70+
71+
flist <- fs::dir_ls (path, type = "file", all = TRUE, recurse = TRUE)
72+
ptns <- c (
73+
"\\.appveyor\\.yml",
74+
"\\.github\\/workflows",
75+
"\\.gitlab\\-ci\\.yml",
76+
"\\.circleci\\/config\\.yml",
77+
"codefresh\\.yml",
78+
"drone\\.yml",
79+
"\\.travis\\.yml"
80+
)
81+
has_it <- vapply (ptns, function (i) any (grepl (i, flist)), logical (1L))
82+
nms <- gsub ("\\\\.|\\\\.y.*$|\\\\/.*$|\\\\-.*$", "", ptns)
83+
84+
return (nms [which (has_it)])
85+
}

‎R/gh-queries.R

+44
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,44 @@
1+
#' Retrieve latest GitHub workflow results from Rest API
2+
#'
3+
#' This uses default of 30 most recent results.
4+
#' @noRd
5+
github_repo_workflow_query <- function (org = NULL, repo = NULL, n = 30L) {
6+
7+
checkmate::assert_integer (n, lower = 1L)
8+
u_base <- "https://api.github.com/repos/"
9+
u_repo <- paste0 (u_base, org, "/", repo, "/")
10+
u_wf <- paste0 (u_repo, "actions/runs?per_page=", n)
11+
12+
req <- httr2::request (u_wf)
13+
14+
if (!nzchar (Sys.getenv ("GITHUB_WORKFLOW"))) {
15+
tok <- get_gh_token ()
16+
headers <- list (Authorization = paste0 ("Bearer ", tok))
17+
req <- httr2::req_headers (req, "Authorization" = headers)
18+
}
19+
20+
resp <- httr2::req_perform (req)
21+
httr2::resp_check_status (resp)
22+
23+
body <- httr2::resp_body_json (resp)
24+
workflows <- body$workflow_runs
25+
26+
ids <- vapply (workflows, function (i) i$id, numeric (1L))
27+
names <- vapply (workflows, function (i) i$name, character (1L))
28+
shas <- vapply (workflows, function (i) i$head_sha, character (1L))
29+
titles <- vapply (workflows, function (i) i$display_title, character (1L))
30+
status <- vapply (workflows, function (i) i$status, character (1L))
31+
conclusion <- vapply (workflows, function (i) i$conclusion, character (1L))
32+
created <- vapply (workflows, function (i) i$created_at, character (1L))
33+
created <- as.POSIXct (created, format = "%Y-%m-%dT%H:%M:%S", tz = "UTC")
34+
35+
data.frame (
36+
name = names,
37+
id = ids,
38+
sha = shas,
39+
title = titles,
40+
status = status,
41+
conclusion = conclusion,
42+
created = created
43+
)
44+
}

‎R/utils.R

+49
Original file line numberDiff line numberDiff line change
@@ -28,13 +28,62 @@ set_num_cores <- function (num_cores) {
2828
return (num_cores)
2929
}
3030

31+
# nocov start
32+
get_gh_token <- function () {
33+
e <- Sys.getenv ()
34+
nms <- names (e)
35+
tok <- unique (e [grep ("GITHUB", nms)])
36+
if (length (tok) != 1L) {
37+
tok <- unique (e [grep ("GITHUB\\_(PAT|TOK)", nms)])
38+
}
39+
if (length (tok) != 1L) {
40+
cli::cli_abort (
41+
"Unable to determine unique GitHub token from environment variables"
42+
)
43+
}
44+
return (tok)
45+
}
46+
# nocov end
47+
3148
pkg_name_from_path <- function (path) {
3249
desc <- fs::dir_ls (path, type = "file", regexp = "DESCRIPTION$")
3350
checkmate::assert_file_exists (desc)
3451

3552
unname (read.dcf (desc) [, "Package"])
3653
}
3754

55+
pkg_gh_url_from_path <- function (path) {
56+
desc <- fs::dir_ls (path, type = "file", regexp = "DESCRIPTION$")
57+
checkmate::assert_file_exists (desc)
58+
59+
desc <- read.dcf (desc)
60+
ret <- NULL
61+
if ("URL" %in% colnames (desc)) {
62+
url <- unname (desc [, "URL"])
63+
url <- strsplit (gsub ("\\n", "", url), ",") [[1]]
64+
ret <- grep ("github\\.com", url, value = TRUE)
65+
}
66+
return (ret)
67+
}
68+
69+
org_repo_from_path <- function (path) {
70+
71+
url <- pkg_gh_url_from_path (path)
72+
if (length (url) == 0L) {
73+
return (FALSE)
74+
}
75+
76+
url_parts <- strsplit (url, "\\/") [[1]]
77+
i <- which (url_parts == "github.com")
78+
if (length (i) == 0L || i > (length (url_parts) + 2L)) {
79+
return (FALSE)
80+
}
81+
org <- url_parts [i + 1L]
82+
repo <- url_parts [i + 2L]
83+
84+
c (org, repo)
85+
}
86+
3887
filter_git_hist <- function (h, n, step_days) {
3988
if (!is.null (n)) {
4089
h <- h [seq_len (n), ]

‎codemeta.json

+1-1
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@
88
"codeRepository": "https://github.com/ropensci-review-tools/githist",
99
"issueTracker": "https://github.com/ropensci-review-tools/githist/issues",
1010
"license": "https://spdx.org/licenses/GPL-3.0",
11-
"version": "0.1.0.044",
11+
"version": "0.1.0.049",
1212
"programmingLanguage": {
1313
"@type": "ComputerLanguage",
1414
"name": "R",

‎inst/httptest2/redact.R

+15
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,21 @@ function (resp) {
77
fixed = TRUE
88
)
99

10+
resp <- httptest2::gsub_response (
11+
resp,
12+
"https://api.github.com/repos/",
13+
"ghapi/",
14+
fixed = TRUE
15+
)
16+
17+
test_repo <- "ropensci-review-tools/githist"
18+
resp <- httptest2::gsub_response (
19+
resp,
20+
paste0 (test_repo, "/actions"),
21+
"repo/",
22+
fixed = TRUE
23+
)
24+
1025
# Timestamp pattern, where replacing with "" removes sub-dir:
1126
ptn <- "[0-9]{4}\\-[0-9]{2}\\-[0-9]{2}"
1227
resp <- httptest2::gsub_response (

0 commit comments

Comments
 (0)