Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Add install_local.

Closes #299
  • Loading branch information...
commit fb892031953a0f5bde3de48f487030e6e751d232 1 parent 5c8d519
@hadley authored
View
1  DESCRIPTION
@@ -95,3 +95,4 @@ Collate:
'install-min.r'
'vignette-r.r'
'has-tests.r'
+ 'install-local.r'
View
2  NAMESPACE
@@ -41,6 +41,7 @@ export(install_bitbucket)
export(install_git)
export(install_github)
export(install_gitorious)
+export(install_local)
export(install_url)
export(install_version)
export(is.package)
@@ -96,7 +97,6 @@ importFrom(tools,Rd2HTML)
importFrom(tools,Rd2txt)
importFrom(tools,buildVignettes)
importFrom(tools,dependsOnPkgs)
-importFrom(tools,file_ext)
importFrom(tools,file_path_sans_ext)
importFrom(tools,package_dependencies)
importFrom(tools,parse_Rd)
View
3  NEWS
@@ -1,6 +1,9 @@
devtools 1.2.99
----------------
+* New `install_local` function for installing local package files
+ (as zip, tar, tgz, etc.) (Suggested by landroni)
+
* `install_bitbucket` gains `auth_user` and `password` params so that you can
install from private repos (thanks to Brian Bolt)
View
5 R/decompress.r
@@ -1,9 +1,14 @@
decompress <- function(src, target = tempdir()) {
+ stopifnot(file.exists(src))
if (grepl("\\.zip$", src)) {
unzip(src, exdir = target)
outdir <- getdir(as.character(unzip(src, list = TRUE)$Name[1]))
+ } else if (grepl("\\.tar$", src)) {
+ untar(src, exdir = target)
+ outdir <- getdir(untar(src, list = TRUE)[1])
+
} else if (grepl("\\.(tar\\.gz|tgz)$", src)) {
untar(src, exdir = target, compressed = "gzip")
outdir <- getdir(untar(src, compressed = "gzip", list = TRUE)[1])
View
1  R/dev-help.r
@@ -38,7 +38,6 @@ dev_help <- function(topic, stage = "render", type = getOption("help_type")) {
#' This is particular useful if you're checking macros and want to simulate
#' what happens when the package is built (\code{stage = "build"})
#' @export
-#' @importFrom tools file_ext
#' @importFrom tools Rd2txt
show_rd <- function(pkg = ".", file, ...) {
.Deprecated("dev_help")
View
16 R/install-git.r
@@ -82,21 +82,7 @@ install_git_single <- function(git_url, name = NULL, subdir = NULL,
stop("There seems to be a problem retrieving this Git-URL.", call. = FALSE)
}
- pkg_path <- if (is.null(subdir)) bundle else file.path(bundle, subdir)
- on.exit(unlink(bundle), add = TRUE)
-
- # Check it's an R package
- if (!file.exists(file.path(pkg_path, "DESCRIPTION"))) {
- stop("Does not appear to be an R package", call. = FALSE)
- }
-
- config_path <- file.path(pkg_path, "configure")
- if (file.exists(config_path)) {
- Sys.chmod(config_path, "755")
- }
-
- # Install
- install(pkg_path, local = TRUE, ...)
+ install_local_single(bundle, subdir = subdir, ...)
}
View
47 R/install-local.r
@@ -0,0 +1,47 @@
+#' Install a package from a local file
+#'
+#' This function is vectorised so you can install multiple packages in
+#' a single command.
+#'
+#' @param path path to local directory, or compressed file (tar, zip, tar.gz
+#' tar.bz2, tgz2 or tbz)
+#' @inheritParams install_url
+#' @export
+#' @examples
+#' \dontrun{
+#' dir <- tempfile()
+#' dir.create(dir)
+#' pkg <- download.packages("testthat", dir)
+#' install_local(pkg[, 2])
+#' }
+install_local <- function(path, subdir = NULL, ...) {
+ invisible(lapply(path, install_local_single, subdir = subdir, ...))
+}
+
+install_local_single <- function(path, subdir = NULL, ..., quiet = FALSE) {
+ stopifnot(file.exists(path))
+ if (!quiet) {
+ message("Installing package from ", path)
+ }
+
+ if (!file.info(path)$isdir) {
+ path <- decompress(path)
+ on.exit(unlink(path), add = TRUE)
+ }
+
+ pkg_path <- if (is.null(subdir)) path else file.path(path, subdir)
+
+ # Check it's an R package
+ if (!file.exists(file.path(pkg_path, "DESCRIPTION"))) {
+ stop("Does not appear to be an R package (no DESCRIPTION)", call. = FALSE)
+ }
+
+ # Check configure is executable if present
+ config_path <- file.path(pkg_path, "configure")
+ if (file.exists(config_path)) {
+ Sys.chmod(config_path, "777")
+ }
+
+ # Finally, run install
+ install(pkg_path, local = TRUE, quiet = quiet, ...)
+}
View
21 R/install-url.r
@@ -28,7 +28,7 @@ install_url_single <- function(url, name = NULL, subdir = NULL, config = list(),
name <- basename(url)
}
- message("Installing ", name, " from ", url)
+ message("Downloading ", name, " from ", url)
bundle <- file.path(tempdir(), name)
# Download package file
@@ -37,21 +37,6 @@ install_url_single <- function(url, name = NULL, subdir = NULL, config = list(),
writeBin(content(request), bundle)
on.exit(unlink(bundle), add = TRUE)
- unbundle <- decompress(bundle)
- on.exit(unlink(unbundle), add = TRUE)
-
- pkg_path <- if (is.null(subdir)) unbundle else file.path(unbundle, subdir)
-
- # Check it's an R package
- if (!file.exists(file.path(pkg_path, "DESCRIPTION"))) {
- stop("Does not appear to be an R package", call. = FALSE)
- }
-
- config_path <- file.path(pkg_path, "configure")
- if (file.exists(config_path)) {
- Sys.chmod(config_path, "777")
- }
-
- # Install
- install(pkg_path, local = TRUE, ...)
+ # Install local file
+ install_local_single(bundle, subdir = subdir, ...)
}
View
29 man/install_local.Rd
@@ -0,0 +1,29 @@
+\name{install_local}
+\alias{install_local}
+\title{Install a package from a local file}
+\usage{
+ install_local(path, subdir = NULL, ...)
+}
+\arguments{
+ \item{path}{path to local directory, or compressed file
+ (tar, zip, tar.gz tar.bz2, tgz2 or tbz)}
+
+ \item{subdir}{subdirectory within url bundle that
+ contains the R package.}
+
+ \item{...}{Other arguments passed on to
+ \code{\link{install}}.}
+}
+\description{
+ This function is vectorised so you can install multiple
+ packages in a single command.
+}
+\examples{
+\dontrun{
+dir <- tempfile()
+dir.create(dir)
+pkg <- download.packages("testthat", dir)
+install_local(pkg[, 2])
+}
+}
+
Please sign in to comment.
Something went wrong with that request. Please try again.