@@ -30,7 +30,7 @@ github_repo_workflow_query <- function (org = NULL, repo = NULL, n = 30L) {
30
30
status <- vapply (workflows , function (i ) i $ status , character (1L ))
31
31
conclusion <- vapply (workflows , function (i ) i $ conclusion , character (1L ))
32
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 " )
33
+ created <- to_posix (created )
34
34
35
35
data.frame (
36
36
name = names ,
@@ -42,3 +42,140 @@ github_repo_workflow_query <- function (org = NULL, repo = NULL, n = 30L) {
42
42
created = created
43
43
)
44
44
}
45
+
46
+ # ' Use the GitHub Rest API activity list to extract event types.
47
+ # ' Activity requests are described at
48
+ # ' \url{https://docs.github.com/en/rest/repos/repos?apiVersion=2022-11-28#list-repository-activities}
49
+ # ' and the list of all event types is at
50
+ # ' \url{https://docs.github.com/en/rest/using-the-rest-api/github-event-types?apiVersion=2022-11-28}.
51
+ # ' @noRd
52
+ github_issues_prs_query <- function (org = NULL , repo = NULL ) {
53
+
54
+ u_base <- " https://api.github.com/repos/"
55
+ u_repo <- paste0 (u_base , org , " /" , repo , " /" )
56
+
57
+ is_test_env <- Sys.getenv (" REPOMETRICS_TESTS" ) == " true"
58
+ url0 <- paste0 (u_repo , " events?per_page=" , ifelse (is_test_env , 2 , 100 ))
59
+
60
+ body <- NULL
61
+ next_page <- 1
62
+ this_url <- url0
63
+ while (! is.null (next_page )) {
64
+
65
+ req <- httr2 :: request (this_url ) | >
66
+ add_token_to_req ()
67
+
68
+ resp <- httr2 :: req_perform (req )
69
+ httr2 :: resp_check_status (resp )
70
+
71
+ this_body <- httr2 :: resp_body_json (resp )
72
+ body <- c (body , this_body )
73
+
74
+ next_page <- get_next_page (resp )
75
+ if (is_test_env ) {
76
+ next_page <- NULL
77
+ }
78
+ this_url <- paste0 (url0 , " &page=" , next_page )
79
+ }
80
+
81
+ # Extraction function for single fields which may not be present
82
+ extract_one <- function (body , field = " action" , naval = NA_character_ ) {
83
+ ret_type <- do.call (typeof (naval ), list (1L ))
84
+ vapply (body , function (i ) {
85
+ ifelse (field %in% names (i $ payload ), i $ payload [[field ]], naval )
86
+ }, ret_type )
87
+ }
88
+
89
+ # Extraction function for doubly-nexted fields which may not be present
90
+ extract_two <- function (body ,
91
+ field1 = " pull_request" ,
92
+ field2 = " comments" ,
93
+ naval = NA_character_ ) {
94
+
95
+ ret_type <- do.call (typeof (naval ), list (1L ))
96
+ vapply (body , function (i ) {
97
+ ret <- naval
98
+ if (field1 %in% names (i $ payload )) {
99
+ if (field2 %in% names (i $ payload [[field1 ]])) {
100
+ ret <- i $ payload [[field1 ]] [[field2 ]]
101
+ }
102
+ }
103
+ ifelse (is.null (ret ), naval , ret )
104
+ }, ret_type )
105
+ }
106
+
107
+ # Items which are always present:
108
+ ids <- vapply (body , function (i ) i $ id , character (1L ))
109
+ type <- vapply (body , function (i ) i $ type , character (1L ))
110
+ login <- vapply (body , function (i ) i $ actor $ login , character (1L ))
111
+
112
+ # Single-nested items:
113
+ action <- extract_one (body , " action" , NA_character_ )
114
+ number <- extract_one (body , " number" , NA_integer_ )
115
+
116
+ # Doubly-nested items:
117
+ num_comments <- extract_two (body , " pull_request" , " comments" , NA_integer_ )
118
+ num_review_comments <-
119
+ extract_two (body , " pull_request" , " review_comments" , NA_integer_ )
120
+ commits <- extract_two (body , " pull_request" , " commits" , NA_integer_ )
121
+ additions <- extract_two (body , " pull_request" , " additions" , NA_integer_ )
122
+ deletions <- extract_two (body , " pull_request" , " deletions" , NA_integer_ )
123
+ changed_files <-
124
+ extract_two (body , " pull_request" , " changed_files" , NA_integer_ )
125
+ created_at <-
126
+ extract_two (body , " pull_request" , " created_at" , NA_character_ )
127
+ created_at <- to_posix (created_at )
128
+ merged_at <-
129
+ extract_two (body , " pull_request" , " created_at" , NA_character_ )
130
+ merged_at <- to_posix (merged_at )
131
+
132
+ data.frame (
133
+ id = ids ,
134
+ type = type ,
135
+ login = login ,
136
+ action = action ,
137
+ number = number ,
138
+ commits = commits ,
139
+ num_comments = num_comments ,
140
+ num_review_comments = num_review_comments ,
141
+ additions = additions ,
142
+ deletions = deletions ,
143
+ changed_files = changed_files ,
144
+ created_at = created_at ,
145
+ merged_at = merged_at
146
+ )
147
+ }
148
+
149
+ add_token_to_req <- function (req ) {
150
+
151
+ if (! nzchar (Sys.getenv (" GITHUB_WORKFLOW" ))) {
152
+ tok <- get_gh_token ()
153
+ headers <- list (Authorization = paste0 (" Bearer " , tok ))
154
+ req <- httr2 :: req_headers (req , " Authorization" = headers )
155
+ }
156
+
157
+ return (req )
158
+ }
159
+
160
+ # ' Pagination for Rest API. see
161
+ # ' https://docs.github.com/en/rest/using-the-rest-api/using-pagination-in-the-rest-api
162
+ # ' @noRd
163
+ get_next_page <- function (resp ) {
164
+
165
+ link <- httr2 :: resp_headers (resp )$ link
166
+
167
+ next_page <- NULL
168
+
169
+ if (! is.null (link )) {
170
+ next_ptn <- " rel\\ =\\\" next"
171
+ if (grepl (next_ptn , link )) {
172
+ # "next" is always first; where there are multiples, "prev" comes
173
+ # after "next"
174
+ ptn <- " <([^>]+)>"
175
+ next_page <- regmatches (link , regexpr (ptn , link ))
176
+ next_page <- gsub (" ^.*&page\\ =|>" , " " , next_page )
177
+ }
178
+ }
179
+
180
+ return (next_page )
181
+ }
0 commit comments