1## git2r, R bindings to the libgit2 library.
2## Copyright (C) 2013-2019 The git2r contributors
3##
4## This program is free software; you can redistribute it and/or modify
5## it under the terms of the GNU General Public License, version 2,
6## as published by the Free Software Foundation.
7##
8## git2r is distributed in the hope that it will be useful,
9## but WITHOUT ANY WARRANTY; without even the implied warranty of
10## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11## GNU General Public License for more details.
12##
13## You should have received a copy of the GNU General Public License along
14## with this program; if not, write to the Free Software Foundation, Inc.,
15## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
16
17##' Ahead Behind
18##'
19##' Count the number of unique commits between two commit objects.
20##' @param local a git_commit object. Can also be a tag or a branch,
21##'     and in that case the commit will be the target of the tag or
22##'     branch.
23##' @param upstream a git_commit object. Can also be a tag or a
24##'     branch, and in that case the commit will be the target of the
25##'     tag or branch.
26##' @return An integer vector of length 2 with number of commits that
27##'     the upstream commit is ahead and behind the local commit
28##' @export
29##' @examples \dontrun{
30##' ## Create a directory in tempdir
31##' path <- tempfile(pattern="git2r-")
32##' dir.create(path)
33##'
34##' ## Initialize a repository
35##' repo <- init(path)
36##' config(repo, user.name = "Alice", user.email = "alice@@example.org")
37##'
38##' ## Create a file, add and commit
39##' lines <- "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do"
40##' writeLines(lines, file.path(path, "test.txt"))
41##' add(repo, "test.txt")
42##' commit_1 <- commit(repo, "Commit message 1")
43##' tag_1 <- tag(repo, "Tagname1", "Tag message 1")
44##'
45##' # Change file and commit
46##' lines <- c(
47##'   "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do",
48##'   "eiusmod tempor incididunt ut labore et dolore magna aliqua.")
49##' writeLines(lines, file.path(path, "test.txt"))
50##' add(repo, "test.txt")
51##' commit_2 <- commit(repo, "Commit message 2")
52##' tag_2 <- tag(repo, "Tagname2", "Tag message 2")
53##'
54##' ahead_behind(commit_1, commit_2)
55##' ahead_behind(tag_1, tag_2)
56##' }
57ahead_behind <- function(local = NULL, upstream = NULL) {
58    .Call(git2r_graph_ahead_behind,
59          lookup_commit(local),
60          lookup_commit(upstream))
61}
62
63##' Add sessionInfo to message
64##'
65##' @param message The message.
66##' @return message with appended sessionInfo
67##' @importFrom utils capture.output
68##' @importFrom utils sessionInfo
69##' @noRd
70add_session_info <- function(message) {
71    paste0(message, "\n\nsessionInfo:\n",
72           paste0(utils::capture.output(utils::sessionInfo()),
73                  collapse = "\n"))
74}
75
76##' Commit
77##'
78##' @template repo-param
79##' @param message The commit message.
80##' @param all Stage modified and deleted files. Files not added to
81##'     Git are not affected.
82##' @param session Add sessionInfo to commit message. Default is
83##'     FALSE.
84##' @param author Signature with author and author time of commit.
85##' @param committer Signature with committer and commit time of
86##'     commit.
87##' @return A list of class \code{git_commit} with entries:
88##' \describe{
89##'   \item{sha}{
90##'     The 40 character hexadecimal string of the SHA-1
91##'   }
92##'   \item{author}{
93##'     An author signature
94##'   }
95##'   \item{committer}{
96##'     The committer signature
97##'   }
98##'   \item{summary}{
99##'     The short "summary" of a git commit message, comprising the first
100##'     paragraph of the message with whitespace trimmed and squashed.
101##'   }
102##'   \item{message}{
103##'     The message of a commit
104##'   }
105##'   \item{repo}{
106##'     The \code{git_repository} object that contains the commit
107##'   }
108##' }
109##' @export
110##' @examples
111##' \dontrun{
112##' ## Initialize a repository
113##' path <- tempfile(pattern="git2r-")
114##' dir.create(path)
115##' repo <- init(path)
116##'
117##' ## Config user
118##' config(repo, user.name = "Alice", user.email = "alice@@example.org")
119##'
120##' ## Write to a file and commit
121##' lines <- "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do"
122##' writeLines(lines, file.path(path, "example.txt"))
123##' add(repo, "example.txt")
124##' commit(repo, "First commit message")
125##' }
126commit <- function(repo      = ".",
127                   message   = NULL,
128                   all       = FALSE,
129                   session   = FALSE,
130                   author    = NULL,
131                   committer = NULL) {
132    repo <- lookup_repository(repo)
133    if (is.null(author))
134        author <- default_signature(repo)
135    if (is.null(committer))
136        committer <- default_signature(repo)
137
138    stopifnot(is.character(message), identical(length(message), 1L))
139    if (!nchar(message[1]))
140        stop("Aborting commit due to empty commit message.")
141
142    if (isTRUE(all)) {
143        s <- status(repo,
144                    unstaged  = TRUE,
145                    staged    = FALSE,
146                    untracked = FALSE,
147                    ignored   = FALSE)
148
149        ## Convert list of lists to character vector
150        unstaged <- unlist(s$unstaged)
151        for (i in seq_along(unstaged)) {
152            if (names(unstaged)[i] == "modified") {
153                ## Stage modified files
154                add(repo, unstaged[i])
155            } else if (names(unstaged)[i] == "deleted") {
156                ## Stage deleted files
157                .Call(git2r_index_remove_bypath, repo, unstaged[i])
158            }
159        }
160
161    }
162
163    if (isTRUE(session))
164        message <- add_session_info(message)
165
166    .Call(git2r_commit, repo, message, author, committer)
167}
168
169##' Check limit in number of commits
170##' @noRd
171get_upper_limit_of_commits <- function(n) {
172    if (is.null(n)) {
173        n <- -1L
174    } else if (is.numeric(n)) {
175        if (!identical(length(n), 1L))
176            stop("'n' must be integer")
177        if (abs(n - round(n)) >= .Machine$double.eps^0.5)
178            stop("'n' must be integer")
179        n <- as.integer(n)
180    } else {
181        stop("'n' must be integer")
182    }
183
184    n
185}
186
187shallow_commits <- function(repo, sha, n) {
188    ## List to hold result
189    result <- list()
190
191    ## Get latest commit
192    x <- lookup(repo, sha)
193
194    ## Repeat until no more parent commits
195    repeat {
196        if (n == 0) {
197            break
198        } else if (n > 0) {
199            n <- n - 1
200        }
201
202        if (is.null(x))
203            break
204        result[[length(result) + 1]] <- x
205
206        ## Get parent to commit
207        x <- tryCatch(parents(x)[[1]], error = function(e) NULL)
208    }
209
210    result
211}
212
213##' Commits
214##'
215##' @template repo-param
216##' @param topological Sort the commits in topological order (parents
217##'     before children); can be combined with time sorting. Default
218##'     is TRUE.
219##' @param time Sort the commits by commit time; Can be combined with
220##'     topological sorting. Default is TRUE.
221##' @param reverse Sort the commits in reverse order; can be combined
222##'     with topological and/or time sorting. Default is FALSE.
223##' @param n The upper limit of the number of commits to output. The
224##'     default is NULL for unlimited number of commits.
225##' @param ref The name of a reference to list commits from e.g. a tag
226##'     or a branch. The default is NULL for the current branch.
227##' @param path The path to a file. If not NULL, only commits modifying
228##'     this file will be returned. Note that modifying commits that
229##'     occurred before the file was given its present name are not
230##'     returned; that is, the output of \code{git log} with
231##'     \code{--no-follow} is reproduced.
232##' @return list of commits in repository
233##' @export
234##' @examples
235##' \dontrun{
236##' ## Initialize a repository
237##' path <- tempfile(pattern="git2r-")
238##' dir.create(path)
239##' repo <- init(path)
240##'
241##' ## Config user
242##' config(repo, user.name = "Alice", user.email = "alice@@example.org")
243##'
244##' ## Write to a file and commit
245##' lines <- "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do"
246##' writeLines(lines, file.path(path, "example.txt"))
247##' add(repo, "example.txt")
248##' commit(repo, "First commit message")
249##'
250##' ## Change file and commit
251##' lines <- c(
252##'   "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do",
253##'   "eiusmod tempor incididunt ut labore et dolore magna aliqua.")
254##' writeLines(lines, file.path(path, "example.txt"))
255##' add(repo, "example.txt")
256##' commit(repo, "Second commit message")
257##'
258##' ## Create a tag
259##' tag(repo, "Tagname", "Tag message")
260##'
261##' ## Change file again and commit
262##' lines <- c(
263##'   "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do",
264##'   "eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad",
265##'   "minim veniam, quis nostrud exercitation ullamco laboris nisi ut")
266##' writeLines(lines, file.path(path, "example.txt"))
267##' add(repo, "example.txt")
268##' commit(repo, "Third commit message")
269##'
270##' ## Create a new file containing R code, and commit.
271##' writeLines(c("x <- seq(1,100)",
272##'              "print(mean(x))"),
273##'            file.path(path, "mean.R"))
274##' add(repo, "mean.R")
275##' commit(repo, "Fourth commit message")
276##'
277##' ## List the commits in the repository
278##' commits(repo)
279##'
280##' ## List the commits starting from the tag
281##' commits(repo, ref = "Tagname")
282##'
283##' ## List the commits modifying example.txt and mean.R.
284##' commits(repo, path = "example.txt")
285##' commits(repo, path = "mean.R")
286##'
287##' ## Create and checkout 'dev' branch in the repo
288##' checkout(repo, "dev", create = TRUE)
289##'
290##' ## Add changes to the 'dev' branch
291##' lines <- c(
292##'   "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do",
293##'   "eiusmod tempor incididunt ut labore et dolore magna aliqua.")
294##' writeLines(lines, file.path(path, "example.txt"))
295##' add(repo, "example.txt")
296##' commit(repo, "Commit message in dev branch")
297##'
298##' ## Checkout the 'master' branch again and list the commits
299##' ## starting from the 'dev' branch.
300##' checkout(repo, "master")
301##' commits(repo, ref = "dev")
302##' }
303commits <- function(repo        = ".",
304                    topological = TRUE,
305                    time        = TRUE,
306                    reverse     = FALSE,
307                    n           = NULL,
308                    ref         = NULL,
309                    path        = NULL) {
310    ## Check limit in number of commits
311    n <- get_upper_limit_of_commits(n)
312
313    if (!is.null(path)) {
314        if (!(is.character(path) && length(path) == 1)) {
315            stop("path must be a single file")
316        }
317    }
318
319    repo <- lookup_repository(repo)
320    if (is_empty(repo))
321        return(list())
322
323    if (is.null(ref)) {
324        sha <- sha(repository_head(repo))
325    } else {
326        sha <- sha(lookup_commit(.Call(git2r_reference_dwim, repo, ref)))
327    }
328
329    if (is_shallow(repo)) {
330        ## FIXME: Remove this if-statement when libgit2 supports
331        ## shallow clones, see #219.  Note: This workaround does not
332        ## use the 'topological', 'time' and 'reverse' flags.
333        return(shallow_commits(repo, sha, n))
334    }
335
336    if (!is.null(path)) {
337        repo_wd <- normalizePath(workdir(repo), winslash = "/")
338        path <- sanitize_path(path, repo_wd)
339        path_revwalk <- .Call(git2r_revwalk_list2, repo, sha, topological,
340                              time, reverse, n, path)
341        return(path_revwalk[!vapply(path_revwalk, is.null, logical(1))])
342    }
343
344    .Call(git2r_revwalk_list, repo, sha, topological, time, reverse, n)
345}
346
347##' Last commit
348##'
349##' Get last commit in the current branch.
350##' @template repo-param
351##' @export
352##' @examples
353##' \dontrun{
354##' ## Initialize a repository
355##' path <- tempfile(pattern="git2r-")
356##' dir.create(path)
357##' repo <- init(path)
358##'
359##' ## Config user
360##' config(repo, user.name = "Alice", user.email = "alice@@example.org")
361##'
362##' ## Write to a file and commit
363##' lines <- "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do"
364##' writeLines(lines, file.path(path, "example.txt"))
365##' add(repo, "example.txt")
366##' commit(repo, "First commit message")
367##'
368##' ## Get last commit
369##' last_commit(repo)
370##' last_commit(path)
371##'
372##' ## Coerce the last commit to a data.frame
373##' as.data.frame(last_commit(path), "data.frame")
374##'
375##' ## Summary of last commit in repository
376##' summary(last_commit(repo))
377##' }
378last_commit <- function(repo = ".") {
379    commits(lookup_repository(repo), n = 1)[[1]]
380}
381
382##' Descendant
383##'
384##' Determine if a commit is the descendant of another commit
385##' @param commit a git_commit object. Can also be a tag or a branch,
386##'     and in that case the commit will be the target of the tag or
387##'     branch.
388##' @param ancestor a git_commit object to check if ancestor to
389##'     \code{commit}. Can also be a tag or a branch, and in that case
390##'     the commit will be the target of the tag or branch.
391##' @return TRUE if \code{commit} is descendant of \code{ancestor},
392##'     else FALSE
393##' @export
394##' @examples
395##' \dontrun{
396##' ## Create a directory in tempdir
397##' path <- tempfile(pattern="git2r-")
398##' dir.create(path)
399##'
400##' ## Initialize a repository
401##' repo <- init(path)
402##' config(repo, user.name = "Alice", user.email = "alice@@example.org")
403##'
404##' ## Create a file, add and commit
405##' lines <- "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do"
406##' writeLines(lines, file.path(path, "test.txt"))
407##' add(repo, "test.txt")
408##' commit_1 <- commit(repo, "Commit message 1")
409##' tag_1 <- tag(repo, "Tagname1", "Tag message 1")
410##'
411##' # Change file and commit
412##' lines <- c(
413##'   "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do",
414##'   "eiusmod tempor incididunt ut labore et dolore magna aliqua.")
415##' writeLines(lines, file.path(path, "test.txt"))
416##' add(repo, "test.txt")
417##' commit_2 <- commit(repo, "Commit message 2")
418##' tag_2 <- tag(repo, "Tagname2", "Tag message 2")
419##'
420##' descendant_of(commit_1, commit_2)
421##' descendant_of(commit_2, commit_1)
422##' descendant_of(tag_1, tag_2)
423##' descendant_of(tag_2, tag_1)
424##' }
425descendant_of <- function(commit = NULL, ancestor = NULL) {
426    .Call(git2r_graph_descendant_of,
427          lookup_commit(commit),
428          lookup_commit(ancestor))
429}
430
431##' Check if object is a git_commit object
432##'
433##' @param object Check if object is a git_commit object
434##' @return TRUE if object is a git_commit, else FALSE
435##' @export
436##' @examples
437##' \dontrun{
438##' ## Initialize a temporary repository
439##' path <- tempfile(pattern="git2r-")
440##' dir.create(path)
441##' repo <- init(path)
442##'
443##' ## Create a user
444##' config(repo, user.name = "Alice", user.email = "alice@@example.org")
445##'
446##' ## Commit a text file
447##' writeLines("Hello world!", file.path(path, "example.txt"))
448##' add(repo, "example.txt")
449##' commit_1 <- commit(repo, "First commit message")
450##'
451##' ## Check if commit
452##' is_commit(commit_1)
453##' }
454is_commit <- function(object) {
455    inherits(object, "git_commit")
456}
457
458##' Is merge
459##'
460##' Determine if a commit is a merge commit, i.e. has more than one
461##' parent.
462##' @param commit a git_commit object.
463##' @return TRUE if commit has more than one parent, else FALSE
464##' @export
465##' @examples
466##' \dontrun{
467##' ## Initialize a temporary repository
468##' path <- tempfile(pattern="git2r-")
469##' dir.create(path)
470##' repo <- init(path)
471##'
472##' ## Create a user and commit a file
473##' config(repo, user.name = "Alice", user.email = "alice@@example.org")
474##' writeLines(c("First line in file 1.", "Second line in file 1."),
475##'            file.path(path, "example-1.txt"))
476##' add(repo, "example-1.txt")
477##' commit(repo, "First commit message")
478##'
479##' ## Create and add one more file
480##' writeLines(c("First line in file 2.", "Second line in file 2."),
481##'            file.path(path, "example-2.txt"))
482##' add(repo, "example-2.txt")
483##' commit(repo, "Second commit message")
484##'
485##' ## Create a new branch 'fix'
486##' checkout(repo, "fix", create = TRUE)
487##'
488##' ## Update 'example-1.txt' (swap words in first line) and commit
489##' writeLines(c("line First in file 1.", "Second line in file 1."),
490##'            file.path(path, "example-1.txt"))
491##' add(repo, "example-1.txt")
492##' commit(repo, "Third commit message")
493##'
494##' checkout(repo, "master")
495##'
496##' ## Update 'example-2.txt' (swap words in second line) and commit
497##' writeLines(c("First line in file 2.", "line Second in file 2."),
498##'            file.path(path, "example-2.txt"))
499##' add(repo, "example-2.txt")
500##' commit(repo, "Fourth commit message")
501##'
502##' ## Merge 'fix'
503##' merge(repo, "fix")
504##'
505##' ## Display parents of last commit
506##' parents(lookup(repo, branch_target(repository_head(repo))))
507##'
508##' ## Check that last commit is a merge
509##' is_merge(lookup(repo, branch_target(repository_head(repo))))
510##' }
511is_merge <- function(commit = NULL) {
512    length(parents(commit)) > 1
513}
514
515##' Parents
516##'
517##' Get parents of a commit.
518##' @param object a git_commit object.
519##' @return list of git_commit objects
520##' @export
521##' @examples
522##' \dontrun{
523##' ## Initialize a temporary repository
524##' path <- tempfile(pattern="git2r-")
525##' dir.create(path)
526##' repo <- init(path)
527##'
528##' ## Create a user and commit a file
529##' config(repo, user.name = "Alice", user.email = "alice@@example.org")
530##' writeLines("First line.",
531##'            file.path(path, "example.txt"))
532##' add(repo, "example.txt")
533##' commit_1 <- commit(repo, "First commit message")
534##'
535##' ## commit_1 has no parents
536##' parents(commit_1)
537##'
538##' ## Update 'example.txt' and commit
539##' writeLines(c("First line.", "Second line."),
540##'            file.path(path, "example.txt"))
541##' add(repo, "example.txt")
542##' commit_2 <- commit(repo, "Second commit message")
543##'
544##' ## commit_2 has commit_1 as parent
545##' parents(commit_2)
546##' }
547parents <- function(object = NULL) {
548    .Call(git2r_commit_parent_list, object)
549}
550
551##' @export
552format.git_commit <- function(x, ...) {
553    sprintf("[%s] %s: %s",
554            substring(x$sha, 1, 7),
555            substring(as.character(x$author$when), 1, 10),
556            x$summary)
557}
558
559##' @export
560print.git_commit <- function(x, ...) {
561    cat(format(x, ...), "\n", sep = "")
562    invisible(x)
563}
564
565##' @export
566summary.git_commit <- function(object, ...) {
567    is_merge_commit <- is_merge(object)
568    po <- parents(object)
569
570    cat(sprintf("Commit:  %s\n", object$sha))
571
572    if (is_merge_commit) {
573        sha <- vapply(po, "[[", character(1), "sha")
574        cat(sprintf("Merge:   %s\n", sha[1]))
575        cat(paste0("         ", sha[-1]), sep = "\n")
576    }
577
578    cat(sprintf(paste0("Author:  %s <%s>\n",
579                       "When:    %s\n\n"),
580                object$author$name,
581                object$author$email,
582                as.character(object$author$when)))
583
584    msg <- paste0("    ", readLines(textConnection(object$message)))
585    cat("", sprintf("%s\n", msg))
586
587    if (is_merge_commit) {
588        cat("\n")
589        lapply(po, function(parent) {
590            cat("Commit message: ", parent$sha, "\n")
591            msg <- paste0("    ",
592                          readLines(textConnection(parent$message)))
593            cat("", sprintf("%s\n", msg), "\n")
594        })
595    }
596
597    if (identical(length(po), 1L)) {
598        df <- diff(tree(po[[1]]), tree(object))
599        if (length(df) > 0) {
600            if (length(df) > 1) {
601                cat(sprintf("%i files changed, ", length(df)))
602            } else {
603                cat("1 file changed, ")
604            }
605
606            cat(sprintf(
607                "%i insertions, %i deletions\n",
608                sum(vapply(lines_per_file(df), "[[", numeric(1), "add")),
609                sum(vapply(lines_per_file(df), "[[", numeric(1), "del"))))
610
611            plpf <- print_lines_per_file(df)
612            hpf <- hunks_per_file(df)
613            hunk_txt <- ifelse(hpf > 1, " hunks",
614                        ifelse(hpf > 0, " hunk",
615                               " hunk (binary file)"))
616            phpf <- paste0("  in ", format(hpf), hunk_txt)
617            cat(paste0(plpf, phpf), sep = "\n")
618        }
619
620        cat("\n")
621    }
622
623    invisible(NULL)
624}
625
626##' @export
627as.data.frame.git_commit <- function(x, ...) {
628    data.frame(sha              = x$sha,
629               summary          = x$summary,
630               message          = x$message,
631               author           = x$author$name,
632               email            = x$author$email,
633               when             = as.POSIXct(x$author$when),
634               stringsAsFactors = FALSE)
635}
636