Merge pull request #488 from yihui/bugfix/220

fix #220: the first entry in zip is not necessarily a directory
This commit is contained in:
Joe Cheng
2014-05-20 00:32:11 -07:00
2 changed files with 14 additions and 8 deletions

3
NEWS
View File

@@ -33,6 +33,9 @@ shiny 0.9.1.9XXX
* `renderPrint` gained a new argument 'width' to control the width of the text
output, e.g. renderPrint({mtcars}, width = 40).
* Fixed #220: the zip file for a directory created by some programs may not have
the directory name as its first entry, in which case runUrl() can fail. (#220)
shiny 0.9.1
--------------------------------------------------------------------------------

View File

@@ -137,6 +137,8 @@ runUrl <- function(url, filetype = NULL, subdir = NULL, port = NULL,
message("Downloading ", url)
filePath <- tempfile('shinyapp', fileext=fileext)
fileDir <- tempfile('shinyapp')
dir.create(fileDir, showWarnings = FALSE)
if (download(url, filePath, mode = "wb", quiet = TRUE) != 0)
stop("Failed to download URL ", url)
on.exit(unlink(filePath))
@@ -148,17 +150,18 @@ runUrl <- function(url, filetype = NULL, subdir = NULL, port = NULL,
# 2) If the internal untar implementation is used, it chokes on the 'g'
# type flag that github uses (to stash their commit hash info).
# By using our own forked/modified untar2 we sidestep both issues.
dirname <- untar2(filePath, list=TRUE)[1]
untar2(filePath, exdir = dirname(filePath))
first <- untar2(filePath, list=TRUE)[1]
untar2(filePath, exdir = fileDir)
} else if (fileext == ".zip") {
dirname <- as.character(unzip(filePath, list=TRUE)$Name[1])
unzip(filePath, exdir = dirname(filePath))
first <- as.character(unzip(filePath, list=TRUE)$Name)[1]
unzip(filePath, exdir = fileDir)
}
on.exit(unlink(fileDir, recursive = TRUE), add = TRUE)
appdir <- file.path(dirname(filePath), dirname)
on.exit(unlink(appdir, recursive = TRUE), add = TRUE)
appdir <- file.path(fileDir, first)
if (!file_test('-d', appdir)) appdir <- dirname(appdir)
appsubdir <- ifelse(is.null(subdir), appdir, file.path(appdir, subdir))
runApp(appsubdir, port=port, launch.browser=launch.browser)
if (!is.null(subdir)) appdir <- file.path(appdir, subdir)
runApp(appdir, port=port, launch.browser=launch.browser)
}