diff --git a/NEWS.md b/NEWS.md index f2f2ea7f..dedb27e0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,14 @@ content was incorrectly published to a new location rather than reusing an existing deployment. (#981, #1007, #1013, #1019) +* When `deployApp()` is not given `appName`, the name is generated from an + incoming title, when provided. When the title is not provided, a title is + generated from the content path, which is then used to generate the + normalized application name. (#1022) + +* The application title recorded in the deployment record is updated with + server data. (#1008) + * `showLogs()`, `configureApp()`, `setProperty()`, and `unsetProperty()` search for the application by name when there are no matching deployment records. (#985, #989) diff --git a/R/deploymentTarget.R b/R/deploymentTarget.R index 7e6dd55b..8f4e4213 100644 --- a/R/deploymentTarget.R +++ b/R/deploymentTarget.R @@ -91,7 +91,13 @@ findDeploymentTarget <- function( # Otherwise, identify a target account (given just one available or prompted # by the user), generate a name, and locate the deployment. accountDetails <- findAccountInfo(account, server, error_call = error_call) - appName <- generateAppName(appTitle, recordPath, accountDetails$name, unique = FALSE) + appTitle <- generateTitle(recordPath = recordPath, title = appTitle) + appName <- generateAppName( + appTitle = appTitle, + appPath = recordPath, + account = accountDetails$name, + unique = FALSE + ) return(findDeploymentTargetByAppName( recordPath = recordPath, appName = appName, @@ -315,30 +321,30 @@ updateDeployment <- function(previous, appTitle = NULL, envVars = NULL) { ) } -defaultAppName <- function(recordPath, server = NULL) { +# Generate a title from a content path. +titleFromPath <- function(recordPath) { if (isDocumentPath(recordPath)) { - name <- file_path_sans_ext(basename(recordPath)) - if (name == "index") { - # parent directory will give more informative name - name <- basename(dirname(recordPath)) + title <- file_path_sans_ext(basename(recordPath)) + if (title == "index") { + # parent directory will give more informative name+title + title <- basename(dirname(recordPath)) } else { # deploying a document } } else { # deploying a directory - name <- basename(recordPath) + title <- basename(recordPath) } + title +} - if (isShinyappsServer(server)) { - # Replace non-alphanumerics with underscores, trim to length 64 - name <- tolower(gsub("[^[:alnum:]_-]+", "_", name, perl = TRUE)) - name <- gsub("_+", "_", name) - if (nchar(name) > 64) { - name <- substr(name, 1, 64) - } +# Generate a title when a title was not already specified. +generateTitle <- function(recordPath, title = NULL) { + if (is.null(title)) { + titleFromPath(recordPath) + } else { + title } - - name } shouldUpdateApp <- function(application, diff --git a/R/deployments.R b/R/deployments.R index 076455bb..a4abd028 100644 --- a/R/deployments.R +++ b/R/deployments.R @@ -98,7 +98,7 @@ saveDeployment <- function(recordDir, addToHistory = TRUE) { deployment <- deploymentRecord( name = deployment$name, - title = deployment$title, + title = application$title %||% deployment$title, username = deployment$username, account = deployment$account, server = deployment$server, diff --git a/R/title.R b/R/title.R index 16d725b7..015a1455 100644 --- a/R/title.R +++ b/R/title.R @@ -57,18 +57,7 @@ generateAppName <- function(appTitle, appPath = NULL, account = NULL, unique = T # if we wound up with too few characters, try generating from the directory # name instead if (nchar(name) < 3 && !is.null(appPath) && file.exists(appPath)) { - # strip extension if present - base <- basename(appPath) - if (nzchar(tools::file_ext(base))) { - base <- file_path_sans_ext(base) - - # if we stripped an extension and the name is now "index", use the parent - # folder's name - if (identical(base, "index")) { - base <- basename(dirname(appPath)) - } - } - name <- munge(base) + name <- munge(titleFromPath(appPath)) } # validate that we wound up with a valid name diff --git a/tests/testthat/test-deploymentTarget.R b/tests/testthat/test-deploymentTarget.R index 5757d813..8a8e8412 100644 --- a/tests/testthat/test-deploymentTarget.R +++ b/tests/testthat/test-deploymentTarget.R @@ -362,22 +362,19 @@ test_that("succeeds if there are no deployments and a single account", { expect_equal(deployment$server, "example.com") }) -test_that("default title is the empty string", { +test_that("default name and title derived from path", { local_temp_config() addTestServer() addTestAccount("ron") local_mocked_bindings( - getAppByName = function(...) data.frame( - name = "remotename", - url = "app-url", - stringsAsFactors = FALSE - ) + getAppByName = function(...) NULL ) - app_dir <- withr::local_tempdir() + app_dir <- dirCreate(file.path(withr::local_tempdir(), "MyApplication")) target <- findDeploymentTarget(app_dir, forceUpdate = TRUE) deployment <- target$deployment - expect_equal(deployment$title, "") + expect_equal(deployment$title, "MyApplication") + expect_equal(deployment$name, "myapplication") }) confirm_existing_app_used <- function(server) { @@ -385,7 +382,8 @@ confirm_existing_app_used <- function(server) { addTestServer() addTestAccount("ron", server = server) local_mocked_bindings(getAppByName = function(...) data.frame( - name = "my_app", + name = "remoteapp", + title = "Remote Application", id = 123, url = "http://example.com/test", stringsAsFactors = FALSE @@ -397,6 +395,8 @@ confirm_existing_app_used <- function(server) { target <- findDeploymentTarget(app_dir, appName = "my_app", server = server) deployment <- target$deployment expect_equal(deployment$appId, 123) + expect_equal(deployment$name, "remoteapp") + expect_equal(deployment$title, "Remote Application") } test_that("can find existing application on server & use it", { @@ -435,21 +435,43 @@ test_that("can find existing application on shinyapps.io & not use it", { confirm_existing_app_not_used("shinyapps.io") }) -# defaultAppName ---------------------------------------------------------- +# generateTitle --------------------------------------------------------- -test_that("defaultAppName works with sites, documents, and directories", { - expect_equal(defaultAppName("foo/bar.Rmd"), "bar") - expect_equal(defaultAppName("foo/index.html"), "foo") - expect_equal(defaultAppName("foo/bar"), "bar") -}) +test_that("generateTitle works with sites, documents, and directories", { + expect_equal( + generateTitle("foo/bar.Rmd", "This/is/a/TITLE"), + "This/is/a/TITLE" + ) + expect_equal( + generateTitle("foo/bar.Rmd", "NO"), + "NO" + ) -test_that("defaultAppName reifies appNames for shinyApps", { - expect_equal(defaultAppName("a b c", "shinyapps.io"), "a_b_c") - expect_equal(defaultAppName("a!b!c", "shinyapps.io"), "a_b_c") - expect_equal(defaultAppName("a b c", "shinyapps.io"), "a_b_c") + expect_equal( + generateTitle("foo/bar.Rmd"), + "bar" + ) + expect_equal( + generateTitle("foo/index.html"), + "foo" + ) + expect_equal( + generateTitle("foo/bar"), + "bar" + ) - long_name <- strrep("abcd", 64 / 4) - expect_equal(defaultAppName(paste(long_name, "..."), "shinyapps.io"), long_name) + expect_equal( + generateTitle("foo/Awesome Document.Rmd"), + "Awesome Document" + ) + expect_equal( + generateTitle("My Report/index.html"), + "My Report" + ) + expect_equal( + generateTitle("foo/The-Application"), + "The-Application" + ) }) # helpers -----------------------------------------------------------------