Merge pull request #11 from dgJacks0n/Git2r_023

Incorporate v 2.4.2 changes into master

envDocument/DESCRIPTION

@@ -1,8 +1,8 @@
 Package: envDocument
 Type: Package
 Title: Document the R Working Environment
-Version: 2.4.1
-Date: 2019-08-08
+Version: 2.4.1.9002
+Date: 2019-08-29
 Authors@R: person("Donald", "Jackson", email = "[email protected]",
                   role = c("aut", "cre"))
 Description: Prints out information about the R working environment
@@ -13,12 +13,12 @@ License: GPL (>= 3.0)
 Repository: CRAN
 URL: https://github.com/dgJacks0n/envDocument
 Suggests:
-    git2r(>= 0.22.1),
     knitr(>= 1.13),
     stringr(>= 1.2.0),
     testthat(>= 1.0.2)
-RoxygenNote: 6.1.0
+RoxygenNote: 6.1.1
 VignetteBuilder: knitr
 Imports:
-    utils,
-    methods
+      git2r(>= 0.22.1),
+      utils,
+      methods

envDocument/NEWS.md

@@ -1,9 +1,12 @@
 # NEWS
 
-# envDocument 2.4.1
+## envDocument 2.4.1.9002
+Pre-release (test) build for version 2.4.2.  Removes support for git2r versions <= 0.21
+
+##  envDocument 2.4.1
 Bug fix to provide compatibility with git2r versions 0.22.1+ (S3 based) as well as <= 0.21 (S4 based)
 
-# envDocument 2.4.0
+## envDocument 2.4.0
 
 + Identify runs in Domino Datalab environments and report additional information
 + Added unit tests with `testthat`
@@ -12,6 +15,6 @@ Bug fix to provide compatibility with git2r versions 0.22.1+ (S3 based) as well
 + Modified Author section in DESCRIPTION file in an effort to get better formatting.
 + Implemented `try()` calls to handle missing file/package errors more gracefully and consistently.
 
-# envDocument 2.3.0
+## envDocument 2.3.0
 This is the first CRAN submission for package envDocument.  The version number for this first submission is 2.3.0 for consistency with previous internal versions of this package.
 

envDocument/R/fileStatus.R

@@ -5,10 +5,7 @@ fileStatus <- function(repo, testPath) {
   testStatus <- NULL
 
   # need to get top level path for repo
-  # try S4 call first, then S3
-  repoPath <- ifelse(isS4(repo),
-    try(repo@path, silent = TRUE),
-    try(repo$path, silent = TRUE))
+  repoPath <- try(repo$path, silent = TRUE)
 
   if(class(repoPath) == "try-error") {
     return(infoNotFound())

envDocument/R/getDominoInfo.R

@@ -23,12 +23,8 @@ getDominoInfo <- function(drop_vars = c("DOMINO_API_HOST",
 
   domino_values <- Sys.getenv(domino_varnames)
 
-  # strip port off of DOMINO_API_HOST to get sever
-  domino_values["DOMINO_SERVER"] <- sub(":\\d+$", "", 
-                                        domino_values["DOMINO_API_HOST"])
-
   # build url
-  domino_values["DOMINO_RUN_URL"] <- paste(domino_values["DOMINO_SERVER"],
+  domino_values["DOMINO_RUN_URL"] <- paste(domino_values["DOMINO_USER_HOST"],
                                            "u",
                                            domino_values["DOMINO_PROJECT_OWNER"],
                                            domino_values["DOMINO_PROJECT_NAME"],

envDocument/R/getGitInfo.R

@@ -40,17 +40,15 @@ getGitInfo <- function(scriptpath = NA) {
     return(infoNotFound())
   }
 
-  # get branch information.  Need to support git2r >= v0.22.1 (S3) and < v0.21 (S4)
-  branch <- git2r::branches(scriptRepo)[[1]]
-
-  # try S4 method for git2r v <= 0.2.1 and S3 for later
-  branchname <- ifelse(isS4(branch),
-                       try(branch@name, silent = TRUE),
-                       try(branch$name, silent = TRUE)
-  )
+  # get branch information.  
+  local <- try(git2r::repository_head(scriptRepo)) 
+
+  if(class(local) == "try_error" | is.null(local)) {
+    return(infoNotFound())
+  }
 
+  branchname <- try(local$name, silent = TRUE)
 
-  # if both fail, give up
   if(class(branchname) == "try-error" | is.null(branchname)) {
     branchname <- infoNotFound()
   }
@@ -60,18 +58,12 @@ getGitInfo <- function(scriptpath = NA) {
                          Value = branchname)
 
    # get last commit info
-  # get last commit info, again with S4 or S3
-  #lastCommit <- as.data.frame(git2r::commits(scriptRepo, n = 1)[[1]])
   lastCommit <- git2r::commits(scriptRepo, n = 1)[[1]]
 
   # ifelse isn't working as expected here.
   last <- NULL
-  if(isS4(lastCommit)) {
-    last <- methods::as(scriptRepo, "data.frame")[1,]
-  } else {
-    last <- as.data.frame(lastCommit) # will methods::as work on S3?
-  }
-
+
+  last <- as.data.frame(lastCommit) # will methods::as work on S3?
 
   # has the file been changed since last commit
   changed <- fileStatus(scriptRepo, scriptpath) # need to update for git2r >= v0.22.1
@@ -92,6 +84,7 @@ getGitInfo <- function(scriptpath = NA) {
     results <- rbind(results, data.frame( Name = "Tag", Value = tagString))
   }
 
+  # get remote based on local head
   remotes <- remoteInfo(scriptRepo)
   results <- rbind(results, remotes)
 

envDocument/R/getTag.R

@@ -15,38 +15,59 @@ getTag <- function(repo) {
     return(NULL)
   }
 
-  tag <- tagList[[length(tagList)]]
-
-  # pull out sha for tag.  Try old (S4) way, then new (S3)
-  tagSha <- ifelse(isS4(tag),
-                   try(tag@sha, silent = TRUE),
-                   try(tag$sha, silent = TRUE))
-
-  if(class(tagSha) == "try-error") {
-    tagSha <- tag$sha
-  }
+  tagInfo <- lapply(tagList, parseS3Tag)
+
+  tagInfo <- do.call("rbind", tagInfo)
 
-  # same to get sha for last commit
+  # get sha for last commit
   lastCommit <- git2r::commits(repo, n = 1)[[1]]
+
+  last <- as.data.frame(lastCommit) # will methods::as work on S3?
+
+
+  # do any tag targets match last commit? if not, return null
+  if( !any(last$sha == tagInfo$target) ) { return(NULL) }
 
-  # ifelse isn't working as expected here.
-  last <- NULL
-  if(isS4(lastCommit)) {
-    last <- methods::as(repo, "data.frame")[1,]
-  } else {
-    last <- as.data.frame(lastCommit) # will methods::as work on S3?
-  }
+  # return info for tag that matches target
+  tagTarget <- tagInfo[ (last$sha == tagInfo$target), ]
 
+  tagString <- paste( "[", substring(tagTarget$target, 1,6), "] ", tagTarget$name, 
+                      sep = "" )
+  return(tagString)
 
+}
 
-  # do tags match?  If not, return NULL
-  if(tagSha != last$sha) {
+# parseS3Tags
+#
+# function to parse individual tags using S3 structure
+
+parseS3Tag <- function(thisTag) {
+  # if the repo has any lightweight tags, tagger is in author.
+  # otherwise it's in tagger
+
+  if("tagger" %in% names(thisTag)) {
+    tagger <- thisTag$tagger
+    tagName <- thisTag$name
+    tagTarget <- thisTag$target
+  } else if ("author" %in% names(thisTag)) {
+    tagger <- thisTag$author
+    tagName <- NA
+    tagTarget <- thisTag$sha
+  } else {
     return(NULL)
   }
 
+  thisTagTime <- tagger$when$time
 
-  tagString <- paste( "[", substring(tag@target, 1,6), "] ", tag@name, sep = "" )
-  return(tagString)
+  thisTagInfo <- data.frame( #sha = thisTag$sha,
+                             target= tagTarget,
+                             when = thisTagTime,
+                             name = tagName,
+                             message = thisTag$message,
+                             person = tagger$name,
+                             email = tagger$email
+                             )
+
+  return(thisTagInfo)
 
 }
-

envDocument/R/remoteInfo.R

@@ -3,9 +3,19 @@
 #' @param repo A git2r repository object
 #' 
 remoteInfo <- function(repo) {
-  if(length(git2r::remotes(repo)) == 0) { return(NULL)}
+  if(length(git2r::remotes(repo)) == 0) { return( infoNotFound() )}
 
-  remote_string <- paste(git2r::remotes(repo), git2r::remote_url(repo), sep = ": ")
+  # get remote based on local head
+  local <- try(git2r::repository_head(repo)) 
+
+  if(class(local) == "try_error" | is.null(local)) {
+    return(infoNotFound())
+  }
+
+  upstream <- git2r::branch_get_upstream(local)
+
+  remote_string <- paste(git2r::branch_remote_name(upstream), 
+                         git2r::branch_remote_url(upstream), sep = ": ")
 
   results <- data.frame( Name = "Remote", Value = remote_string)