|
1 | 1 | uses_git <- function(path = ".") { |
2 | | - !is.null(git2r::discover_repository(path, ceiling = 0)) |
3 | | -} |
4 | | - |
5 | | -# sha of most recent commit |
6 | | -git_repo_sha1 <- function(r) { |
7 | | - rev <- git2r::repository_head(r) |
8 | | - if (is.null(rev)) { |
9 | | - return(NULL) |
10 | | - } |
11 | | - |
12 | | - if (git2r::is_commit(rev)) { |
13 | | - rev$sha |
14 | | - } else { |
15 | | - git2r::branch_target(rev) |
16 | | - } |
17 | | -} |
18 | | - |
19 | | -git_sha1 <- function(n = 10, path = ".") { |
20 | | - r <- git2r::repository(path, discover = TRUE) |
21 | | - sha <- git_repo_sha1(r) |
22 | | - substr(sha, 1, n) |
23 | | -} |
24 | | - |
25 | | -git_uncommitted <- function(path = ".") { |
26 | | - r <- git2r::repository(path, discover = TRUE) |
27 | | - st <- vapply(git2r::status(r), length, integer(1)) |
28 | | - any(st != 0) |
29 | | -} |
30 | | - |
31 | | -git_sync_status <- function(path = ".", check_ahead = TRUE, check_behind = TRUE) { |
32 | | - r <- git2r::repository(path, discover = TRUE) |
33 | | - |
34 | | - r_head <- git2r::repository_head(r) |
35 | | - if (!inherits(r_head, "git_branch")) { |
36 | | - stop("HEAD is not a branch", call. = FALSE) |
37 | | - } |
38 | | - |
39 | | - upstream <- git2r::branch_get_upstream(r_head) |
40 | | - if (is.null(upstream)) { |
41 | | - stop("No upstream branch", call. = FALSE) |
42 | | - } |
43 | | - |
44 | | - git2r::fetch(r, git2r::branch_remote_name(upstream)) |
45 | | - |
46 | | - c1 <- git2r::lookup(r, git2r::branch_target(r_head)) |
47 | | - c2 <- git2r::lookup(r, git2r::branch_target(upstream)) |
48 | | - ab <- git2r::ahead_behind(c1, c2) |
49 | | - |
50 | | - # if (ab[1] > 0) |
51 | | - # message(ab[1], " ahead of remote") |
52 | | - # if (ab[2] > 0) |
53 | | - # message(ab[2], " behind remote") |
54 | | - |
55 | | - is_ahead <- ab[[1]] != 0 |
56 | | - is_behind <- ab[[2]] != 0 |
57 | | - check <- (check_ahead && is_ahead) || (check_behind && is_behind) |
58 | | - check |
59 | | -} |
60 | | - |
61 | | -# Retrieve the current running path of the git binary. |
62 | | -# @param git_binary_name The name of the binary depending on the OS. |
63 | | -git_path <- function(git_binary_name = NULL) { |
64 | | - # Use user supplied path |
65 | | - if (!is.null(git_binary_name)) { |
66 | | - if (!file.exists(git_binary_name)) { |
67 | | - stop("Path ", git_binary_name, " does not exist", .call = FALSE) |
68 | | - } |
69 | | - return(git_binary_name) |
70 | | - } |
71 | | - |
72 | | - # Look on path |
73 | | - git_path <- Sys.which("git")[[1]] |
74 | | - if (git_path != "") return(git_path) |
75 | | - |
76 | | - # On Windows, look in common locations |
77 | | - if (.Platform$OS.type == "windows") { |
78 | | - look_in <- c( |
79 | | - "C:/Program Files/Git/bin/git.exe", |
80 | | - "C:/Program Files (x86)/Git/bin/git.exe" |
81 | | - ) |
82 | | - found <- file.exists(look_in) |
83 | | - if (any(found)) return(look_in[found][1]) |
84 | | - } |
85 | | - |
86 | | - stop("Git does not seem to be installed on your system.", call. = FALSE) |
| 2 | + dir.exists(file.path(path, ".git")) |
87 | 3 | } |
88 | 4 |
|
89 | 5 | git_branch <- function(path = ".") { |
90 | | - r <- git2r::repository(path, discover = TRUE) |
91 | | - |
92 | | - if (git2r::is_detached(r)) { |
93 | | - return(NULL) |
94 | | - } |
| 6 | + withr::local_dir(path) |
95 | 7 |
|
96 | | - git2r::repository_head(r)$name |
| 8 | + system2("git", c("rev-parse", "--abbrev-ref", "HEAD"), stdout = TRUE) |
97 | 9 | } |
98 | 10 |
|
99 | | -# GitHub ------------------------------------------------------------------ |
100 | | - |
101 | | -uses_github <- function(path = ".") { |
102 | | - if (!uses_git(path)) { |
103 | | - return(FALSE) |
104 | | - } |
105 | | - |
106 | | - r <- git2r::repository(path, discover = TRUE) |
107 | | - r_remote_urls <- git2r::remote_url(r) |
108 | | - |
109 | | - any(grepl("github", r_remote_urls)) |
110 | | -} |
111 | | - |
112 | | -github_info <- function(path = ".", remote_name = NULL) { |
113 | | - if (!uses_github(path)) { |
114 | | - return(github_dummy) |
115 | | - } |
116 | | - |
117 | | - r <- git2r::repository(path, discover = TRUE) |
118 | | - r_remote_urls <- grep("github", remote_urls(r), value = TRUE) |
119 | | - |
120 | | - if (!is.null(remote_name) && !remote_name %in% names(r_remote_urls)) { |
121 | | - stop("no github-related remote named ", remote_name, " found") |
122 | | - } |
123 | | - |
124 | | - remote_name <- c(remote_name, "origin", names(r_remote_urls)) |
125 | | - x <- r_remote_urls[remote_name] |
126 | | - x <- x[!is.na(x)][1] |
127 | | - |
128 | | - github_remote_parse(x) |
129 | | -} |
130 | | - |
131 | | -github_dummy <- list(username = "<USERNAME>", repo = "<REPO>", fullname = "<USERNAME>/<REPO>") |
132 | | - |
133 | | -remote_urls <- function(r) { |
134 | | - remotes <- git2r::remotes(r) |
135 | | - stats::setNames(git2r::remote_url(r, remotes), remotes) |
136 | | -} |
137 | | - |
138 | | -github_remote_parse <- function(x) { |
139 | | - if (length(x) == 0) return(github_dummy) |
140 | | - if (!grepl("github", x)) return(github_dummy) |
141 | | - |
142 | | - if (grepl("^(https|git)", x)) { |
143 | | - # https://github.com/r-lib/devtools.git |
144 | | - # https://github.com/r-lib/devtools |
145 | | - # git@github.com:r-lib/devtools.git |
146 | | - re <- "github[^/:]*[/:]([^/]+)/(.*?)(?:\\.git)?$" |
147 | | - } else { |
148 | | - stop("Unknown GitHub repo format", call. = FALSE) |
149 | | - } |
150 | | - |
151 | | - m <- regexec(re, x) |
152 | | - match <- regmatches(x, m)[[1]] |
153 | | - list( |
154 | | - username = match[2], |
155 | | - repo = match[3], |
156 | | - fullname = paste0(match[2], "/", match[3]) |
157 | | - ) |
158 | | -} |
159 | | - |
160 | | -# Extract the commit hash from a git archive. Git archives include the SHA1 |
161 | | -# hash as the comment field of the zip central directory record |
162 | | -# (see https://www.kernel.org/pub/software/scm/git/docs/git-archive.html) |
163 | | -# Since we know it's 40 characters long we seek that many bytes minus 2 |
164 | | -# (to confirm the comment is exactly 40 bytes long) |
165 | | -git_extract_sha1 <- function(bundle) { |
166 | | - |
167 | | - # open the bundle for reading |
168 | | - conn <- file(bundle, open = "rb", raw = TRUE) |
169 | | - on.exit(close(conn)) |
170 | | - |
171 | | - # seek to where the comment length field should be recorded |
172 | | - seek(conn, where = -0x2a, origin = "end") |
| 11 | +git_uncommited <- function(path = ".") { |
| 12 | + withr::local_dir(path) |
173 | 13 |
|
174 | | - # verify the comment is length 0x28 |
175 | | - len <- readBin(conn, "raw", n = 2) |
176 | | - if (len[1] == 0x28 && len[2] == 0x00) { |
177 | | - # read and return the SHA1 |
178 | | - rawToChar(readBin(conn, "raw", n = 0x28)) |
179 | | - } else { |
180 | | - NULL |
181 | | - } |
| 14 | + out <- system2("git", c("status", "--porcelain=v1"), stdout = TRUE) |
| 15 | + length(out) > 0 |
182 | 16 | } |
0 commit comments