1 2#' Install a package from a SVN repository 3#' 4#' This function requires \command{svn} to be installed on your system in order to 5#' be used. 6#' 7#' It is vectorised so you can install multiple packages with 8#' a single command. 9#' 10#' @inheritParams install_git 11#' @param subdir A sub-directory within a svn repository that contains the 12#' package we are interested in installing. 13#' @param args A character vector providing extra options to pass on to 14#' \command{svn}. 15#' @param revision svn revision, if omitted updates to latest 16#' @param ... Other arguments passed on to [utils::install.packages()]. 17#' @inheritParams install_github 18#' @family package installation 19#' @export 20#' 21#' @examples 22#' \dontrun{ 23#' install_svn("https://github.com/hadley/stringr/trunk") 24#' install_svn("https://github.com/hadley/httr/branches/oauth") 25#'} 26install_svn <- function(url, subdir = NULL, args = character(0), 27 revision = NULL, 28 dependencies = NA, 29 upgrade = c("default", "ask", "always", "never"), 30 force = FALSE, 31 quiet = FALSE, 32 build = TRUE, build_opts = c("--no-resave-data", "--no-manual", "--no-build-vignettes"), 33 build_manual = FALSE, build_vignettes = FALSE, 34 repos = getOption("repos"), 35 type = getOption("pkgType"), 36 ...) { 37 38 remotes <- lapply(url, svn_remote, svn_subdir = subdir, 39 revision = revision, args = args) 40 41 install_remotes(remotes, args = args, 42 dependencies = dependencies, 43 upgrade = upgrade, 44 force = force, 45 quiet = quiet, 46 build = build, 47 build_opts = build_opts, 48 build_manual = build_manual, 49 build_vignettes = build_vignettes, 50 repos = repos, 51 type = type, 52 ...) 53} 54 55svn_remote <- function(url, svn_subdir = NULL, revision = NULL, 56 args = character(0), ...) { 57 remote("svn", 58 url = url, 59 svn_subdir = svn_subdir, 60 revision = revision, 61 args = args 62 ) 63} 64 65#' @export 66remote_download.svn_remote <- function(x, quiet = FALSE) { 67 if (!quiet) { 68 message("Downloading svn repo ", x$url) 69 } 70 71 bundle <- tempfile() 72 svn_binary_path <- svn_path() 73 url <- x$url 74 75 args <- "co" 76 if (!is.null(x$revision)) { 77 args <- c(args, "-r", x$revision) 78 } 79 args <- c(args, x$args, full_svn_url(x), bundle) 80 81 if (!quiet) { message(shQuote(svn_binary_path), " ", paste0(args, collapse = " ")) } 82 request <- system2(svn_binary_path, args, stdout = FALSE, stderr = FALSE) 83 84 # This is only looking for an error code above 0-success 85 if (request > 0) { 86 stop("There seems to be a problem retrieving this SVN-URL.", call. = FALSE) 87 } 88 89 in_dir(bundle, { 90 if (!is.null(x$revision)) { 91 request <- system2(svn_binary_path, paste("update -r", x$revision), stdout = FALSE, stderr = FALSE) 92 if (request > 0) { 93 stop("There was a problem switching to the requested SVN revision", call. = FALSE) 94 } 95 } 96 }) 97 bundle 98} 99 100#' @export 101remote_metadata.svn_remote <- function(x, bundle = NULL, source = NULL, sha = NULL) { 102 103 if (!is.null(bundle)) { 104 in_dir(bundle, { 105 revision <- svn_revision() 106 }) 107 } else { 108 revision <- sha 109 } 110 111 list( 112 RemoteType = "svn", 113 RemoteUrl = x$url, 114 RemoteSubdir = x$svn_subdir, 115 RemoteArgs = if (length(x$args) > 0) paste0(deparse(x$args), collapse = " "), 116 RemoteSha = revision # for compatibility with other remotes 117 ) 118} 119 120svn_path <- function(svn_binary_name = NULL) { 121 # Use user supplied path 122 if (!is.null(svn_binary_name)) { 123 if (!file.exists(svn_binary_name)) { 124 stop("Path ", svn_binary_name, " does not exist", .call = FALSE) 125 } 126 return(svn_binary_name) 127 } 128 129 # Look on path 130 svn_path <- Sys.which("svn")[[1]] 131 if (svn_path != "") return(svn_path) 132 133 # On Windows, look in common locations 134 if (os_type() == "windows") { 135 look_in <- c( 136 "C:/Program Files/Svn/bin/svn.exe", 137 "C:/Program Files (x86)/Svn/bin/svn.exe" 138 ) 139 found <- file.exists(look_in) 140 if (any(found)) return(look_in[found][1]) 141 } 142 143 stop("SVN does not seem to be installed on your system.", call. = FALSE) 144} 145 146#' @export 147remote_package_name.svn_remote <- function(remote, ...) { 148 description_url <- file.path(full_svn_url(remote), "DESCRIPTION") 149 tmp_file <- tempfile() 150 on.exit(rm(tmp_file)) 151 response <- system2(svn_path(), paste("cat", description_url), stdout = tmp_file) 152 if (!identical(response, 0L)) { 153 return(NA_character_) 154 } 155 read_dcf(tmp_file)$Package 156} 157 158#' @export 159remote_sha.svn_remote <- function(remote, ...) { 160 svn_revision(full_svn_url(remote)) 161} 162 163svn_revision <- function(url = NULL, svn_binary_path = svn_path()) { 164 request <- system2(svn_binary_path, paste("info --xml", url), stdout = TRUE) 165 if (!is.null(attr(request, "status")) && !identical(attr(request, "status"), 0L)) { 166 stop("There was a problem retrieving the current SVN revision", call. = FALSE) 167 } 168 gsub(".*<commit[[:space:]]+revision=\"([[:digit:]]+)\">.*", "\\1", paste(collapse = "\n", request)) 169} 170 171full_svn_url <- function(x) { 172 url <- x$url 173 if (!is.null(x$svn_subdir)) { 174 url <- file.path(url, x$svn_subdir) 175 } 176 177 url 178} 179 180format.svn_remote <- function(x, ...) { 181 "SVN" 182} 183