From ce636137832baa300341f252ec147e33583bd262 Mon Sep 17 00:00:00 2001 From: eblondel Date: Tue, 27 Feb 2024 08:53:48 +0100 Subject: [PATCH] fix #69 --- NAMESPACE | 1 + R/GSCoverageStoreManager.R | 169 +++++++++++++++++++++++--------- R/GSDatastoreManager.R | 196 +++++++++++++++++++++++++++---------- R/GSLayerManager.R | 140 +++++++++++++++++++------- R/GSManager.R | 32 ++++-- R/GSMonitorManager.R | 12 ++- R/GSNamespaceManager.R | 62 ++++++++---- R/GSServiceManager.R | 39 ++++++-- R/GSStyleManager.R | 103 ++++++++++++++----- R/GSWorkspaceManager.R | 132 ++++++++++++++++++------- 10 files changed, 662 insertions(+), 224 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 2a047dd..ad2231e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -47,6 +47,7 @@ export(GSWorkspace) export(GSWorkspaceManager) export(GSWorkspaceSettings) export(GSWorldImageCoverageStore) +import(cli) import(httr) import(keyring) import(magrittr) diff --git a/R/GSCoverageStoreManager.R b/R/GSCoverageStoreManager.R index 673f6ac..978218f 100644 --- a/R/GSCoverageStoreManager.R +++ b/R/GSCoverageStoreManager.R @@ -28,7 +28,9 @@ GSCoverageStoreManager <- R6Class("GSCoverageStoreManager", #'@param ws workspace name #'@return the list of coverage stores getCoverageStores = function(ws){ - self$INFO(sprintf("Fetching list of coverage stores in workspace '%s'", ws)) + msg = sprintf("Fetching list of coverage stores in workspace '%s'", ws) + cli::cli_alert_info(msg) + self$INFO(msg) req <- GSUtils$GET( self$getUrl(), private$user, private$keyring_backend$get(service = private$keyring_service, username = private$user), sprintf("/workspaces/%s/coveragestores.xml", ws), @@ -48,9 +50,13 @@ GSCoverageStoreManager <- R6Class("GSCoverageStoreManager", ) return(coverageStore) }) - self$INFO(sprintf("Successfully fetched %s coverage stores!", length(covList))) + msg = sprintf("Successfully fetched %s coverage stores!", length(covList)) + cli::cli_alert_success(msg) + self$INFO(msg) }else{ - self$ERROR("Error while fetching list of datastores") + err = "Error while fetching list of datastores" + cli::cli_alert_danger(err) + self$ERROR(err) } return(covList) }, @@ -68,7 +74,9 @@ GSCoverageStoreManager <- R6Class("GSCoverageStoreManager", #'@param cs coverage store name #'@return the coverage store getCoverageStore = function(ws, cs){ - self$INFO(sprintf("Fetching coverage store '%s' in workspace '%s'", cs, ws)) + msg = sprintf("Fetching coverage store '%s' in workspace '%s'", cs, ws) + cli::cli_alert_info(msg) + self$INFO(msg) req <- GSUtils$GET( self$getUrl(), private$user, private$keyring_backend$get(service = private$keyring_service, username = private$user), sprintf("/workspaces/%s/coveragestores/%s.xml", ws, cs), @@ -84,9 +92,13 @@ GSCoverageStoreManager <- R6Class("GSCoverageStoreManager", "ArcGrid" = GSArcGridCoverageStore$new(xml = covXML), GSAbstractCoverageStore$new(xml = covXML) ) - self$INFO("Successfully fetched coverage store!") + msg = "Successfully fetched coverage store!" + cli::cli_alert_success(msg) + self$INFO(msg) }else{ - self$ERROR("Error while fetching coverage store") + err = "Error while fetching coverage store" + cli::cli_alert_danger(err) + self$ERROR(err) } return(coverageStore) }, @@ -97,7 +109,9 @@ GSCoverageStoreManager <- R6Class("GSCoverageStoreManager", #'@param coverageStore coverage store object #'@return \code{TRUE} if created, \code{FALSE} otherwise createCoverageStore = function(ws, coverageStore){ - self$INFO(sprintf("Creating coverage store '%s' in workspace '%s'", coverageStore$name, ws)) + msg = sprintf("Creating coverage store '%s' in workspace '%s'", coverageStore$name, ws) + cli::cli_alert_info(msg) + self$INFO(msg) created <- FALSE if(is.null(coverageStore$workspace)) coverageStore$workspace <- ws req <- GSUtils$POST( @@ -110,10 +124,14 @@ GSCoverageStoreManager <- R6Class("GSCoverageStoreManager", verbose = self$verbose.debug ) if(status_code(req) == 201){ - self$INFO("Successfully created coverage store!") + msg = "Successfully created coverage store!" + cli::cli_alert_success(msg) + self$INFO(msg) created = TRUE }else{ - self$ERROR("Error while creating coverage store") + err = "Error while creating coverage store" + cli::cli_alert_danger(err) + self$ERROR(err) } }, @@ -125,7 +143,9 @@ GSCoverageStoreManager <- R6Class("GSCoverageStoreManager", updateCoverageStore = function(ws, coverageStore){ if(is.null(coverageStore$workspace)) coverageStore$workspace <- ws updated <- FALSE - self$INFO(sprintf("Updating coverage store '%s' in workspace '%s'", coverageStore$name, ws)) + msg = sprintf("Updating coverage store '%s' in workspace '%s'", coverageStore$name, ws) + cli::cli_alert_info(msg) + self$INFO(msg) req <- GSUtils$PUT( url = self$getUrl(), user = private$user, pwd = private$keyring_backend$get(service = private$keyring_service, username = private$user), path = sprintf("/workspaces/%s/coveragestores/%s.xml", ws, coverageStore$name), @@ -134,10 +154,14 @@ GSCoverageStoreManager <- R6Class("GSCoverageStoreManager", verbose = self$verbose.debug ) if(status_code(req) == 200){ - self$INFO("Successfully updated coverage store!") + msg = "Successfully updated coverage store!" + cli::cli_alert_success(msg) + self$INFO(msg) updated = TRUE }else{ - self$ERROR("Error while updating coverage store") + err = "Error while updating coverage store" + cli::cli_alert_danger(err) + self$ERROR(err) } return(updated) }, @@ -153,25 +177,33 @@ GSCoverageStoreManager <- R6Class("GSCoverageStoreManager", #'@param purge purge #'@return \code{TRUE} if deleted, \code{FALSE} otherwise deleteCoverageStore = function(ws, cs, recurse = FALSE, purge = NULL){ - self$INFO(sprintf("Deleting coverage store '%s' in workspace '%s'", cs, ws)) + msg = sprintf("Deleting coverage store '%s' in workspace '%s'", cs, ws) + cli::cli_alert_info(msg) + self$INFO(msg) deleted <- FALSE path <- sprintf("/workspaces/%s/coveragestores/%s.xml", ws, cs) if(recurse) path <- paste0(path, "?recurse=true") if(!is.null(purge)){ allowedPurgeValues <- c("none","metadata","all") if(!(purge %in% allowedPurgeValues)){ - stop(sprintf("Purge value should be among allowed purge values [%s]", - paste(allowedPurgeValues, collapse=","))) + err = sprintf("Purge value should be among allowed purge values [%s]", + paste(allowedPurgeValues, collapse=",")) + cli::cli_alert_danger(err) + stop(err) } path <- paste0(path, ifelse(recurse,"&","?"), "purge=", purge) } req <- GSUtils$DELETE(self$getUrl(), private$user, private$keyring_backend$get(service = private$keyring_service, username = private$user), path = path, verbose = self$verbose.debug) if(status_code(req) == 200){ - self$INFO("Successfully deleted coverage store!") + msg = "Successfully deleted coverage store!" + cli::cli_alert_success(msg) + self$INFO(msg) deleted = TRUE }else{ - self$ERROR("Error while deleting coverage store") + err = "Error while deleting coverage store" + cli::cli_alert_danger(err) + self$ERROR(err) } return(deleted) }, @@ -185,7 +217,9 @@ GSCoverageStoreManager <- R6Class("GSCoverageStoreManager", #'@param cs coverage store name #'@return the list of \link{GSCoverage} getCoverages = function(ws, cs){ - self$INFO(sprintf("Fetching coverages for coverage store '%s' in workspace '%s'", cs, ws)) + msg = sprintf("Fetching coverages for coverage store '%s' in workspace '%s'", cs, ws) + cli::cli_alert_info(msg) + self$INFO(msg) req <- GSUtils$GET( self$getUrl(), private$user, private$keyring_backend$get(service = private$keyring_service, username = private$user), @@ -196,9 +230,13 @@ GSCoverageStoreManager <- R6Class("GSCoverageStoreManager", covXML <- GSUtils$parseResponseXML(req) covXMLList <- as(xml2::xml_find_all(covXML, "//coverages/coverage"), "list") covList <- lapply(covXMLList, GSCoverage$new) - self$INFO(sprintf("Successfully fetched %s coverages!", length(covList))) + msg = sprintf("Successfully fetched %s coverages!", length(covList)) + cli::cli_alert_success(msg) + self$INFO(msg) }else{ - self$ERROR("Error while fetching list of coverages") + err = "Error while fetching list of coverages" + cli::cli_alert_danger(err) + self$ERROR(err) } return(covList) }, @@ -218,7 +256,9 @@ GSCoverageStoreManager <- R6Class("GSCoverageStoreManager", #'@param cs coverage store name #'@param cv coverage name getCoverage = function(ws, cs, cv){ - self$INFO(sprintf("Fetching coverage '%s' in coverage store '%s' (workspace '%s')", cv, cs, ws)) + msg = sprintf("Fetching coverage '%s' in coverage store '%s' (workspace '%s')", cv, cs, ws) + cli::cli_alert_info(msg) + self$INFO(msg) req <- GSUtils$GET( self$getUrl(), private$user, private$keyring_backend$get(service = private$keyring_service, username = private$user), @@ -228,9 +268,13 @@ GSCoverageStoreManager <- R6Class("GSCoverageStoreManager", if(status_code(req) == 200){ covXML <- GSUtils$parseResponseXML(req) coverage <- GSCoverage$new(xml = covXML) - self$INFO("Successfully fetched coverage!") + msg = "Successfully fetched coverage!" + cli::cli_alert_success(msg) + self$INFO(msg) }else{ - self$ERROR("Error while fetching coverage") + err = "Error while fetching coverage" + cli::cli_alert_danger(err) + self$ERROR(err) } return(coverage) }, @@ -241,7 +285,9 @@ GSCoverageStoreManager <- R6Class("GSCoverageStoreManager", #'@param coverage object of class \link{GSCoverage} #'@return \code{TRUE} if created, \code{FALSE} otherwise createCoverage = function(ws, cs, coverage){ - self$INFO(sprintf("Creating coverage '%s' in coverage store '%s' (workspace '%s')", coverage$name, cs, ws)) + msg = sprintf("Creating coverage '%s' in coverage store '%s' (workspace '%s')", coverage$name, cs, ws) + cli::cli_alert_info(msg) + self$INFO(msg) created <- FALSE req <- GSUtils$POST( url = self$getUrl(), @@ -253,10 +299,14 @@ GSCoverageStoreManager <- R6Class("GSCoverageStoreManager", verbose = self$verbose.debug ) if(status_code(req) == 201){ - self$INFO("Successfully created coverage!") + msg = "Successfully created coverage!" + cli::cli_alert_success(msg) + self$INFO(msg) created = TRUE }else{ - self$ERROR("Error while creating coverage") + err = "Error while creating coverage" + cli::cli_alert_danger(err) + self$ERROR(err) } return(created) }, @@ -267,7 +317,9 @@ GSCoverageStoreManager <- R6Class("GSCoverageStoreManager", #'@param coverage object of class \link{GSCoverage} #'@return \code{TRUE} if updated, \code{FALSE} otherwise updateCoverage = function(ws, cs, coverage){ - self$INFO(sprintf("Updating coverage '%s' in coverage store '%s' (workspace '%s')", coverage$name, cs, ws)) + msg = sprintf("Updating coverage '%s' in coverage store '%s' (workspace '%s')", coverage$name, cs, ws) + cli::cli_alert_info(msg) + self$INFO(msg) updated <- FALSE req <- GSUtils$PUT( url = self$getUrl(), user = private$user, @@ -279,10 +331,14 @@ GSCoverageStoreManager <- R6Class("GSCoverageStoreManager", verbose = self$verbose.debug ) if(status_code(req) == 200){ - self$INFO("Successfully updated coverage!") + msg = "Successfully updated coverage!" + cli::cli_alert_success(msg) + self$INFO(msg) updated = TRUE }else{ - self$ERROR("Error while updating coverage") + err = "Error while updating coverage" + cli::cli_alert_danger(err) + self$ERROR(err) } return(updated) }, @@ -295,7 +351,9 @@ GSCoverageStoreManager <- R6Class("GSCoverageStoreManager", #'@param cv coverage name #'@param recurse recurse deleteCoverage = function(ws, cs, cv, recurse = FALSE){ - self$INFO(sprintf("Deleting coverage '%s' in coverage '%s' (workspace '%s')", cv, cs, ws)) + msg = sprintf("Deleting coverage '%s' in coverage '%s' (workspace '%s')", cv, cs, ws) + cli::cl_alert_info(msg) + self$INFO(msg) deleted <- FALSE path <- sprintf("/workspaces/%s/coveragestores/%s/coverages/%s.xml", ws, cs, cv) if(recurse) path <- paste0(path, "?recurse=true") @@ -303,10 +361,14 @@ GSCoverageStoreManager <- R6Class("GSCoverageStoreManager", private$keyring_backend$get(service = private$keyring_service, username = private$user), path = path, verbose = self$verbose.debug) if(status_code(req) == 200){ - self$INFO("Successfuly deleted coverage!") + msg = "Successfuly deleted coverage!" + cli::cli_alert_success(msg) + self$INFO(msg) deleted = TRUE }else{ - self$ERROR("Error while deleting coverage") + err = "Error while deleting coverage" + cli::cli_alert_danger(err) + self$ERROR(err) } return(deleted) }, @@ -334,33 +396,47 @@ GSCoverageStoreManager <- R6Class("GSCoverageStoreManager", endpoint = "file", extension, filename, configure = "first", update = "append", contentType){ - self$INFO(sprintf("Uploading %s coverage in new datastore '%s' (workspace '%s')", - toupper(extension), cs, ws)) + msg = sprintf("Uploading %s coverage in new datastore '%s' (workspace '%s')", + toupper(extension), cs, ws) + cli::cli_alert_info(msg) + self$INFO(msg) uploaded <- FALSE supportedEndpoints <- c("file","url","external") if(!(endpoint %in% supportedEndpoints)){ - stop(sprintf("Unsupported endpoint '%s'. Possible values: [%s]", - endpoint, paste0(supportedEndpoints, collapse=","))) + err = sprintf("Unsupported endpoint '%s'. Possible values: [%s]", + endpoint, paste0(supportedEndpoints, collapse=",")) + cli::cli_alert_danger(err) + self$ERROR(err) + stop(err) } supportedExtensions <- c("geotiff", "worldimage", "imagemosaic", "arcgrid") if(!(extension %in% supportedExtensions)){ - stop(sprintf("Unsupported extension '%s'. Possible values: [%s]", - extension, paste0(supportedExtensions, collapse=","))) + err = sprintf("Unsupported extension '%s'. Possible values: [%s]", + extension, paste0(supportedExtensions, collapse=",")) + cli::cli_alert_danger(err) + self$ERROR(err) + stop(err) } supportedConfigurations <- c("first", "none", "all") if(!(configure %in% supportedConfigurations)){ - stop(sprintf("Unsupported configure parameter '%s'. Possible values: [%s]", - configure, paste0(supportedConfigurations, collapse=","))) + err = sprintf("Unsupported configure parameter '%s'. Possible values: [%s]", + configure, paste0(supportedConfigurations, collapse=",")) + cli::cli_alert_danger(err) + self$ERROR(err) + stop(err) } supportedUpdates <- c("append","overwrite") if(!(update %in% supportedUpdates)){ - stop(sprintf("Unsupported update parameter '%s'. Possible values: [%s]", - update, paste0(supportedUpdates, collapse=","))) + err = sprintf("Unsupported update parameter '%s'. Possible values: [%s]", + update, paste0(supportedUpdates, collapse=",")) + cli::cli_alert_danger(err) + self$ERROR(err) + stop(err) } req <- GSUtils$PUT( @@ -373,12 +449,15 @@ GSCoverageStoreManager <- R6Class("GSCoverageStoreManager", verbose = self$verbose.debug ) if(status_code(req) == 201){ - self$INFO("Successfull coverage upload!") + msg = "Successfull coverage upload!" + cli::cli_alert_success(msg) + self$INFO(msg) uploaded = TRUE } if(!uploaded){ - self$ERROR("Error while uploading coverage") - self$ERROR(http_status(req)$message) + err = sprintf("Error while uploading coverage: %s", http_status(req)$message) + cli::cli_alert_danger(err) + self$ERROR(err) } return(uploaded) }, diff --git a/R/GSDatastoreManager.R b/R/GSDatastoreManager.R index 9842bc7..32aaa95 100644 --- a/R/GSDatastoreManager.R +++ b/R/GSDatastoreManager.R @@ -27,7 +27,9 @@ GSDataStoreManager <- R6Class("GSDataStoreManager", #'@param ws workspace name #'@return an object of class \code{list} giving items of class \code{\link{GSAbstractDataStore}} getDataStores = function(ws){ - self$INFO(sprintf("Fetching list of datastores in workspace '%s'", ws)) + msg = sprintf("Fetching list of datastores in workspace '%s'", ws) + cli::cli_alert_info(msg) + self$INFO(msg) req <- GSUtils$GET( self$getUrl(), private$user, private$keyring_backend$get(service = private$keyring_service, username = private$user), @@ -49,9 +51,13 @@ GSDataStoreManager <- R6Class("GSDataStoreManager", ) return(dataStore) }) - self$INFO(sprintf("Successfully fetched %s datastores!", length(dsList))) + msg = sprintf("Successfully fetched %s datastores!", length(dsList)) + cli::cli_alert_success(msg) + self$INFO(msg) }else{ - self$ERROR("Error while fetching list of datastores") + err = "Error while fetching list of datastores" + cli::cli_alert_danger(err) + self$ERROR(err) } return(dsList) }, @@ -69,7 +75,9 @@ GSDataStoreManager <- R6Class("GSDataStoreManager", #'@param ds datastore name #'@return the datastore getDataStore = function(ws, ds){ - self$INFO(sprintf("Fetching datastore '%s' in workspace '%s'", ds, ws)) + msg = sprintf("Fetching datastore '%s' in workspace '%s'", ds, ws) + cli::cli_alert_info(msg) + self$INFO(msg) req <- GSUtils$GET( self$getUrl(), private$user, private$keyring_backend$get(service = private$keyring_service, username = private$user), @@ -87,9 +95,13 @@ GSDataStoreManager <- R6Class("GSDataStoreManager", "Oracle NG" = GSOracleNGDataStore$new(xml = dsXML), GSAbstractDataStore$new(xml = dsXML) ) - self$INFO("Successfully fetched datastore!") + msg = "Successfully fetched datastore!" + cli::cli_alert_success(msg) + self$INFO(msg) }else{ - self$ERROR("Error while fetching datastore") + err = "Error while fetching datastore" + cli::cli_alert_danger(err) + self$ERROR(err) } return(dataStore) }, @@ -99,7 +111,9 @@ GSDataStoreManager <- R6Class("GSDataStoreManager", #'@param dataStore datastore object of class \link{GSAbstractDataStore} #'@return \code{TRUE} if created, \code{FALSE} otherwise createDataStore = function(ws, dataStore){ - self$INFO(sprintf("Creating datastore '%s' in workspace '%s'", dataStore$name, ws)) + msg = sprintf("Creating datastore '%s' in workspace '%s'", dataStore$name, ws) + cli::cli_alert_info(msg) + self$INFO(msg) created <- FALSE req <- GSUtils$POST( url = self$getUrl(), @@ -111,10 +125,14 @@ GSDataStoreManager <- R6Class("GSDataStoreManager", verbose = self$verbose.debug ) if(status_code(req) == 201){ - self$INFO("Successfully created datastore!") + msg = "Successfully created datastore!" + cli::cli_alert_success(msg) + self$INFO(msg) created = TRUE }else{ - self$ERROR("Error while creating datastore") + err = "Error while creating datastore" + cli::cli_alert_danger(err) + self$ERROR(err) } }, @@ -125,7 +143,9 @@ GSDataStoreManager <- R6Class("GSDataStoreManager", #'@return \code{TRUE} if updated, \code{FALSE} otherwise updateDataStore = function(ws, dataStore){ updated <- FALSE - self$INFO(sprintf("Updating datastore '%s' in workspace '%s'", dataStore$name, ws)) + msg = sprintf("Updating datastore '%s' in workspace '%s'", dataStore$name, ws) + cli::cli_alert_info(msg) + self$INFO(msg) req <- GSUtils$PUT( url = self$getUrl(), user = private$user, pwd = private$keyring_backend$get(service = private$keyring_service, username = private$user), @@ -135,10 +155,14 @@ GSDataStoreManager <- R6Class("GSDataStoreManager", verbose = self$verbose.debug ) if(status_code(req) == 200){ - self$INFO("Successfully updated datastore!") + msg = "Successfully updated datastore!" + cli::cli_alert_success(msg) + self$INFO(msg) updated = TRUE }else{ - self$ERROR("Error while updating datastore") + err = "Error while updating datastore" + cli::cli_alert_danger(err) + self$ERROR(err) } return(updated) }, @@ -151,7 +175,9 @@ GSDataStoreManager <- R6Class("GSDataStoreManager", #'@param recurse recurse #'@return \code{TRUE} if deleted, \code{FALSE} otherwise deleteDataStore = function(ws, ds, recurse = FALSE){ - self$INFO(sprintf("Deleting datastore '%s' in workspace '%s'", ds, ws)) + msg = sprintf("Deleting datastore '%s' in workspace '%s'", ds, ws) + cli::cli_alert_info(msg) + self$INFO(msg) deleted <- FALSE path <- sprintf("/workspaces/%s/datastores/%s.xml", ws, ds) if(recurse) path <- paste0(path, "?recurse=true") @@ -159,10 +185,14 @@ GSDataStoreManager <- R6Class("GSDataStoreManager", private$keyring_backend$get(service = private$keyring_service, username = private$user), path = path, verbose = self$verbose.debug) if(status_code(req) == 200){ - self$INFO("Successfully deleted datastore!") + msg = "Successfully deleted datastore!" + cli::cli_alert_info(msg) + self$INFO(msg) deleted = TRUE }else{ - self$ERROR("Error while deleting datastore") + err = "Error while deleting datastore" + cli::cli_alert_danger(err) + self$ERROR(err) } return(deleted) }, @@ -176,11 +206,16 @@ GSDataStoreManager <- R6Class("GSDataStoreManager", #'@param list list type value, among "configured", "available", "available_with_geom", "all" #'@return an object of class \code{list} giving items of class \code{\link{GSFeatureType}} getFeatureTypes = function(ws, ds, list = "configured"){ - self$INFO(sprintf("Fetching featureTypes for datastore '%s' in workspace '%s'", ds, ws)) + msg = sprintf("Fetching featureTypes for datastore '%s' in workspace '%s'", ds, ws) + cli::cli_alert_info(msg) + self$INFO(msg) supportedListValues <- c("configured", "available", "available_with_geom", "all") if(!(list %in% supportedListValues)){ - stop(sprintf("Unsupported 'list' parameter value '%s'. Possible values: [%s]", - list, paste0(supportedListValues, collapse=","))) + err = sprintf("Unsupported 'list' parameter value '%s'. Possible values: [%s]", + list, paste0(supportedListValues, collapse=",")) + cli::cli_alert_danger(err) + self$ERROR(err) + stop(err) } req <- GSUtils$GET( @@ -193,9 +228,13 @@ GSDataStoreManager <- R6Class("GSDataStoreManager", ftXML <- GSUtils$parseResponseXML(req) ftXMLList <- as(xml2::xml_find_all(ftXML, "//featureTypes/featureType"), "list") ftList <- lapply(ftXMLList, GSFeatureType$new) - self$INFO(sprintf("Successfully fetched %s featureTypes!", length(ftList))) + msg = sprintf("Successfully fetched %s featureTypes!", length(ftList)) + cli::cli_alert_success(msg) + self$INFO(msg) }else{ - self$ERROR("Error while fetching list of featureTypes") + err = "Error while fetching list of featureTypes" + cli::cli_alert_danger(err) + self$ERROR(err) } return(ftList) }, @@ -215,7 +254,9 @@ GSDataStoreManager <- R6Class("GSDataStoreManager", #'@param ft feature type name #'@return an object of class \link{GSFeatureType} getFeatureType = function(ws, ds, ft){ - self$INFO(sprintf("Fetching featureType '%s' in datastore '%s' (workspace '%s')", ft, ds, ws)) + msg = sprintf("Fetching featureType '%s' in datastore '%s' (workspace '%s')", ft, ds, ws) + cli::cli_alert_info(msg) + self$INFO(msg) req <- GSUtils$GET( self$getUrl(), private$user, private$keyring_backend$get(service = private$keyring_service, username = private$user), @@ -225,9 +266,13 @@ GSDataStoreManager <- R6Class("GSDataStoreManager", if(status_code(req) == 200){ ftXML <- GSUtils$parseResponseXML(req) featureType <- GSFeatureType$new(xml = ftXML) - self$INFO("Successfully fetched featureType!") + msg = "Successfully fetched featureType!" + cli::cli_alert_success(msg) + self$INFO(msg) }else{ - self$ERROR("Error while fetching featureType") + err = "Error while fetching featureType" + cli::cli_alert_danger(err) + self$ERROR(err) } return(featureType) }, @@ -238,7 +283,9 @@ GSDataStoreManager <- R6Class("GSDataStoreManager", #'@param featureType feature type #'@return \code{TRUE} if created, \code{FALSE} otherwise createFeatureType = function(ws, ds, featureType){ - self$INFO(sprintf("Creating featureType '%s' in datastore '%s' (workspace '%s')", featureType$name, ds, ws)) + msg = sprintf("Creating featureType '%s' in datastore '%s' (workspace '%s')", featureType$name, ds, ws) + cli::cli_alert_info(msg) + self$INFO(msg) created <- FALSE req <- GSUtils$POST( url = self$getUrl(), @@ -250,10 +297,14 @@ GSDataStoreManager <- R6Class("GSDataStoreManager", verbose = self$verbose.debug ) if(status_code(req) == 201){ - self$INFO("Successfully created featureType!") + msg = "Successfully created featureType!" + cli::cli_alert_success(msg) + self$INFO(msg) created = TRUE }else{ - self$ERROR("Error while creating featureType") + err = "Error while creating featureType" + cli::cli_alert_danger(err) + self$ERROR(err) } return(created) }, @@ -264,7 +315,9 @@ GSDataStoreManager <- R6Class("GSDataStoreManager", #'@param featureType feature type #'@return \code{TRUE} if updated, \code{FALSE} otherwise updateFeatureType = function(ws, ds, featureType){ - self$INFO(sprintf("Updating featureType '%s' in datastore '%s' (workspace '%s')", featureType$name, ds, ws)) + msg = sprintf("Updating featureType '%s' in datastore '%s' (workspace '%s')", featureType$name, ds, ws) + cli::cli_alert_info(msg) + self$INFO(msg) updated <- FALSE req <- GSUtils$PUT( url = self$getUrl(), user = private$user, @@ -276,10 +329,14 @@ GSDataStoreManager <- R6Class("GSDataStoreManager", verbose = self$verbose.debug ) if(status_code(req) == 200){ - self$INFO("Successfully updated featureType!") + msg = "Successfully updated featureType!" + cli::cli_alert_success(msg) + self$INFO(msg) updated = TRUE }else{ - self$ERROR("Error while updating featureType") + err = "Error while updating featureType" + cli::cli_alert_danger(err) + self$ERROR(err) } return(updated) }, @@ -293,7 +350,9 @@ GSDataStoreManager <- R6Class("GSDataStoreManager", #'@param recurse recurse #'@return \code{TRUE} if deleted, \code{FALSE} otherwise deleteFeatureType = function(ws, ds, ft, recurse = FALSE){ - self$INFO(sprintf("Deleting featureType '%s' in datastore '%s' (workspace '%s')", ft, ds, ws)) + msg = sprintf("Deleting featureType '%s' in datastore '%s' (workspace '%s')", ft, ds, ws) + cli::cli_alert_info(msg) + self$INFO(msg) deleted <- FALSE path <- sprintf("/workspaces/%s/datastores/%s/featuretypes/%s.xml", ws, ds, ft) if(recurse) path <- paste0(path, "?recurse=true") @@ -301,10 +360,14 @@ GSDataStoreManager <- R6Class("GSDataStoreManager", private$keyring_backend$get(service = private$keyring_service, username = private$user), path = path, verbose = self$verbose.debug) if(status_code(req) == 200){ - self$INFO("Successfuly deleted featureType!") + msg = "Successfuly deleted featureType!" + cli::cli_alert_success(msg) + self$INFO(msg) deleted = TRUE }else{ - self$ERROR("Error while deleting featureType") + err = "Error while deleting featureType" + cli::cli_alert_danger(err) + self$ERROR(err) } return(deleted) }, @@ -319,7 +382,9 @@ GSDataStoreManager <- R6Class("GSDataStoreManager", #'@param layer object of class \link{GSLayer} #'@return \code{TRUE} if published, \code{FALSE} otherwise publishLayer = function(ws, ds, featureType, layer){ - self$INFO(sprintf("Publishing layer '%s'", layer$name)) + msg = sprintf("Publishing layer '%s'", layer$name) + cli::cli_alert_info(msg) + self$INFO(msg) published <- FALSE if(featureType$name != layer$name){ stop("FeatureType and Layer names differ!") @@ -329,15 +394,23 @@ GSDataStoreManager <- R6Class("GSDataStoreManager", lyrCreated <- self$createLayer(layer) if(lyrCreated){ published <- TRUE - self$INFO("Successfully published layer!") + msg = "Successfully published layer!" + cli::cli_alert_success(msg) + self$INFO(msg) }else{ #rolling back published <- FALSE - self$INFO("Rolling back - deleting previously created FeatureType!") + msg = "Rolling back - deleting previously created FeatureType!" + cli::cli_alert_warning(msg) + self$WARN(msg) ftDeleted <- self$deleteFeatureType(ws, ds, featureType$name) } } - if(!published) self$ERROR("Error while publishing layer") + if(!published){ + err = "Error while publishing layer" + cli::cli_alert_danger(err) + self$ERROR(err) + } return(published) }, @@ -348,7 +421,9 @@ GSDataStoreManager <- R6Class("GSDataStoreManager", #'@param lyr layer name #'@return \code{TRUE} if published, \code{FALSE} otherwise unpublishLayer = function(ws, ds, lyr){ - self$INFO(sprintf("Unpublishing layer '%s'", lyr)) + msg = sprintf("Unpublishing layer '%s'", lyr) + cli::cli_alert_info(msg) + self$INFO(msg) unpublished <- FALSE layer <- self$getLayer(lyr) if(is(layer, "GSLayer")){ @@ -359,7 +434,9 @@ GSDataStoreManager <- R6Class("GSDataStoreManager", ftDeleted <- self$deleteFeatureType(ws, ds, lyr) if(ftDeleted){ unpublished <- TRUE - self$INFO("Successfully unpublished layer!") + msg = "Successfully unpublished layer!" + cli::cli_alert_success(msg) + self$INFO(msg) } } return(unpublished) @@ -386,33 +463,47 @@ GSDataStoreManager <- R6Class("GSDataStoreManager", uploadData = function(ws, ds, endpoint = "file", extension, configure = "first", update = "append", filename, charset, contentType){ - self$INFO(sprintf("Uploading %s data in datastore '%s' (workspace '%s')", - toupper(extension), ds, ws)) + msg = sprintf("Uploading %s data in datastore '%s' (workspace '%s')", + toupper(extension), ds, ws) + cli::cli_alert_info(msg) + self$INFO(msg) uploaded <- FALSE supportedEndpoints <- c("file","url","external") if(!(endpoint %in% supportedEndpoints)){ - stop(sprintf("Unsupported endpoint '%s'. Possible values: [%s]", - endpoint, paste0(supportedEndpoints, collapse=","))) + err = sprintf("Unsupported endpoint '%s'. Possible values: [%s]", + endpoint, paste0(supportedEndpoints, collapse=",")) + cli::cli_alert_danger(err) + self$ERROR(err) + stop(err) } supportedExtensions <- c("shp", "spatialite", "h2", "gpkg") if(!(extension %in% supportedExtensions)){ - stop(sprintf("Unsupported extension '%s'. Possible values: [%s]", - extension, paste0(supportedExtensions, collapse=","))) + err = sprintf("Unsupported extension '%s'. Possible values: [%s]", + extension, paste0(supportedExtensions, collapse=",")) + cli::cli_alert_danger(err) + self$ERROR(err) + stop(err) } supportedConfigurations <- c("first", "none", "all") if(!(configure %in% supportedConfigurations)){ - stop(sprintf("Unsupported configure parameter '%s'. Possible values: [%s]", - configure, paste0(supportedConfigurations, collapse=","))) + err = sprintf("Unsupported configure parameter '%s'. Possible values: [%s]", + configure, paste0(supportedConfigurations, collapse=",")) + cli::cli_alert_danger(err) + self$ERROR(err) + stop(err) } supportedUpdates <- c("append","overwrite") if(!(update %in% supportedUpdates)){ - stop(sprintf("Unsupported update parameter '%s'. Possible values: [%s]", - update, paste0(supportedUpdates, collapse=","))) + err = sprintf("Unsupported update parameter '%s'. Possible values: [%s]", + update, paste0(supportedUpdates, collapse=",")) + cli::cli_alert_danger(err) + self$ERROR(err) + stop(err) } req <- GSUtils$PUT( @@ -426,12 +517,15 @@ GSDataStoreManager <- R6Class("GSDataStoreManager", verbose = self$verbose.debug ) if(status_code(req) == 201){ - self$INFO("Successfull data upload!") + msg = "Successfull data upload!" + cli::cli_alert_success(msg) + self$INFO(msg) uploaded = TRUE } if(!uploaded){ - self$ERROR("Error while uploading data") - self$ERROR(http_status(req)$message) + err = sprintf("Error while uploading data: %s", http_status(req)$message) + cli::cli_alert_danger(err) + self$ERROR(err) self$ERROR("Response headers -->") print(headers(req)) self$ERROR("Response content -->") diff --git a/R/GSLayerManager.R b/R/GSLayerManager.R index 0bd4b9a..32e7a6e 100644 --- a/R/GSLayerManager.R +++ b/R/GSLayerManager.R @@ -26,7 +26,9 @@ GSLayerManager <- R6Class("GSLayerManager", #'@description Get the list of layers. #'@return an object of class \code{list} giving items of class \code{\link{GSLayer}} getLayers = function(){ - self$INFO("Fetching layers") + msg = "Fetching layers" + cli::cli_alert_info(msg) + self$INFO(msg) req <- GSUtils$GET( self$getUrl(), private$user, private$keyring_backend$get(service = private$keyring_service, username = private$user), @@ -36,9 +38,13 @@ GSLayerManager <- R6Class("GSLayerManager", lyrXML <- GSUtils$parseResponseXML(req) lyrXMLList <- as(xml2::xml_find_all(lyrXML, "//layers/layer"), "list") lyrList <- lapply(lyrXMLList, GSLayer$new) - self$INFO(sprintf("Successfuly fetched %s layers!", length(lyrList))) + msg = sprintf("Successfuly fetched %s layers!", length(lyrList)) + cli::cli_alert_success(msg) + self$INFO(msg) }else{ - self$ERROR("Error while fetching layers") + err = "Error while fetching layers" + cli::cli_alert_danger(err) + self$ERROR(err) } return(lyrList) }, @@ -54,7 +60,9 @@ GSLayerManager <- R6Class("GSLayerManager", #'@param lyr layer name #'@return an object of class \link{GSLayer} getLayer = function(lyr){ - self$INFO(sprintf("Fetching layer '%s'", lyr)) + msg = sprintf("Fetching layer '%s'", lyr) + cli::cli_alert_info(msg) + self$INFO(msg) req <- GSUtils$GET( self$getUrl(), private$user, private$keyring_backend$get(service = private$keyring_service, username = private$user), @@ -64,9 +72,13 @@ GSLayerManager <- R6Class("GSLayerManager", if(status_code(req) == 200){ lyrXML <- GSUtils$parseResponseXML(req) layer <- GSLayer$new(xml = lyrXML) - self$INFO("Successfuly fetched layer!") + msg = "Successfuly fetched layer!" + cli::cli_alert_success(msg) + self$INFO(msg) }else{ - self$ERROR("Error while fetching layer") + err = "Error while fetching layer" + cli::cli_alert_danger(err) + self$ERROR(err) } return(layer) }, @@ -75,7 +87,9 @@ GSLayerManager <- R6Class("GSLayerManager", #'@param layer object of class \link{GSLayer} #'@return \code{TRUE} if created, \code{FALSE} otherwise createLayer = function(layer){ - self$INFO(sprintf("Creating layer '%s'", layer$name)) + msg = sprintf("Creating layer '%s'", layer$name) + cli::cli_alert_info(msg) + self$INFO(msg) created <- FALSE req <- GSUtils$PUT( url = self$getUrl(), user = private$user, @@ -86,10 +100,14 @@ GSLayerManager <- R6Class("GSLayerManager", verbose = self$verbose.debug ) if(status_code(req) == 200){ - self$INFO("Successfuly created layer!") + msg = "Successfuly created layer!" + cli::cli_alert_success(msg) + self$INFO(msg) created = TRUE }else{ - self$ERROR("Error while creating layer") + err = "Error while creating layer" + cli::cli_alert_danger(err) + self$ERROR(err) } return(created) }, @@ -98,7 +116,9 @@ GSLayerManager <- R6Class("GSLayerManager", #'@param layer object of class \link{GSLayer} #'@return \code{TRUE} if updated, \code{FALSE} otherwise updateLayer = function(layer){ - self$INFO(sprintf("Updating layer '%s'", layer$name)) + msg = sprintf("Updating layer '%s'", layer$name) + cli::cli_alert_info(msg) + self$INFO(msg) updated <- FALSE req <- GSUtils$PUT( url = self$getUrl(), user = private$user, @@ -109,10 +129,14 @@ GSLayerManager <- R6Class("GSLayerManager", verbose = self$verbose.debug ) if(status_code(req) == 200){ - self$INFO("Successfuly updated layer!") + msg = "Successfuly updated layer!" + cli::cli_alert_success(msg) + self$INFO(msg) updated = TRUE }else{ - self$ERROR("Error while updating layer") + err = "Error while updating layer" + cli::cli_alert_danger(err) + self$ERROR(err) } return(updated) }, @@ -121,17 +145,23 @@ GSLayerManager <- R6Class("GSLayerManager", #'@param lyr layer name #'@return \code{TRUE} if deleted, \code{FALSE} otherwise deleteLayer = function(lyr){ - self$INFO(sprintf("Deleting layer '%s'", lyr)) + msg = sprintf("Deleting layer '%s'", lyr) + cli::cli_alert_info(msg) + self$INFO(msg) deleted <- FALSE path <- sprintf("/layers/%s.xml", lyr) req <- GSUtils$DELETE(self$getUrl(), private$user, private$keyring_backend$get(service = private$keyring_service, username = private$user), path = path, verbose = self$verbose.debug) if(status_code(req) == 200){ - self$INFO("Successfuly deleted layer!") + msg = "Successfuly deleted layer!" + cli::cli_alert_success(msg) + self$INFO(msg) deleted = TRUE }else{ - self$ERROR("Error while deleting layer") + err = "Error while deleting layer" + cli::cli_alert_danger(err) + self$ERROR(err) } return(deleted) }, @@ -144,9 +174,13 @@ GSLayerManager <- R6Class("GSLayerManager", #'@return a list of objects of class \link{GSLayerGroup} getLayerGroups = function(ws = NULL){ if(missing(ws)){ - self$INFO("Fetching layer groups") + msg = "Fetching layer groups" + cli::cli_alert_info(msg) + self$INFO(msg) }else{ - self$INFO(sprintf("Fetching layer groups for workspace '%s'", ws)) + msg = sprintf("Fetching layer groups for workspace '%s'", ws) + cli::cli_alert_info(msg) + self$INFO(msg) } req <- GSUtils$GET( self$getUrl(), private$user, @@ -158,9 +192,13 @@ GSLayerManager <- R6Class("GSLayerManager", lyrXML <- GSUtils$parseResponseXML(req) lyrXMLList <- as(xml2::xml_find_all(lyrXML, "//layerGroups/layerGroup"), "list") lyrList <- lapply(lyrXMLList, GSLayerGroup$new) - self$INFO(sprintf("Successfuly fetched %s layer groups!", length(lyrList))) + msg = sprintf("Successfuly fetched %s layer groups!", length(lyrList)) + cli::cli_alert_success(msg) + self$INFO(msg) }else{ - self$ERROR("Error while fetching layer groups") + err = "Error while fetching layer groups" + cli::cli_alert_danger(err) + self$ERROR(err) } return(lyrList) }, @@ -179,9 +217,13 @@ GSLayerManager <- R6Class("GSLayerManager", #'@return an object of class \link{GSLayerGroup} getLayerGroup = function(lyr, ws = NULL){ if(is.null(ws)){ - self$INFO(sprintf("Fetching layer group '%s'", lyr)) + msg = sprintf("Fetching layer group '%s'", lyr) + cli::cli_alert_info(msg) + self$INFO(msg) }else{ - self$INFO(sprintf("Fetching layer group '%s' in workspace '%s'", lyr, ws)) + msg = sprintf("Fetching layer group '%s' in workspace '%s'", lyr, ws) + cli::cli_alert_info(msg) + self$INFO(msg) } req <- GSUtils$GET( self$getUrl(), private$user, @@ -194,9 +236,13 @@ GSLayerManager <- R6Class("GSLayerManager", if(status_code(req) == 200){ lyrXML <- GSUtils$parseResponseXML(req) layer <- GSLayerGroup$new(xml = lyrXML) - self$INFO("Successfuly fetched layer group!") + msg = "Successfuly fetched layer group!" + cli::cli_alert_success(msg) + self$INFO(msg) }else{ - self$ERROR("Error while fetching layer group") + err = "Error while fetching layer group" + cli::cli_alert_danger(err) + self$ERROR(err) } return(layer) }, @@ -207,9 +253,13 @@ GSLayerManager <- R6Class("GSLayerManager", #'@return \code{TRUE} if created, \code{FALSE} otherwise createLayerGroup = function(layerGroup, ws = NULL){ if(is.null(ws)){ - self$INFO(sprintf("Creating layer group '%s'", layerGroup$name)) + msg = sprintf("Creating layer group '%s'", layerGroup$name) + cli::cli_alert_info(msg) + self$INFO(msg) }else{ - self$INFO(sprintf("Creating layer group '%s' in workspace '%s'", layerGroup$name, ws)) + msg = sprintf("Creating layer group '%s' in workspace '%s'", layerGroup$name, ws) + cli::cli_alert_info(msg) + self$INFO(msg) } created <- FALSE req <- GSUtils$POST( @@ -222,10 +272,14 @@ GSLayerManager <- R6Class("GSLayerManager", verbose = self$verbose.debug ) if(status_code(req) == 201){ - self$INFO("Successfuly created layer group!") + msg = "Successfuly created layer group!" + cli::cli_alert_success(msg) + self$INFO(msg) created = TRUE }else{ - self$ERROR("Error while creating layer group") + err = "Error while creating layer group" + cli::cli_alert_danger(err) + self$ERROR(err) } return(created) }, @@ -236,9 +290,13 @@ GSLayerManager <- R6Class("GSLayerManager", #'@return \code{TRUE} if updated, \code{FALSE} otherwise updateLayerGroup = function(layerGroup, ws = NULL){ if(is.null(ws)){ - self$INFO(sprintf("Updating layer '%s'", layerGroup$name)) + msg = sprintf("Updating layer '%s'", layerGroup$name) + cli::cli_alert_info(msg) + self$INFO(msg) }else{ - self$INFO(sprintf("Updating layer '%s' in workspace '%s'", layerGroup$name, ws)) + msg = sprintf("Updating layer '%s' in workspace '%s'", layerGroup$name, ws) + cli::cli_alert_info(msg) + self$INFO(msg) } updated <- FALSE req <- GSUtils$PUT( @@ -252,10 +310,14 @@ GSLayerManager <- R6Class("GSLayerManager", verbose = self$verbose.debug ) if(status_code(req) == 200){ - self$INFO("Successfuly updated layer group!") + msg = "Successfuly updated layer group!" + cli::cli_alert_success(msgg) + self$INFO(msg) updated = TRUE }else{ - self$ERROR("Error while updating layer group") + err = "Error while updating layer group" + cli::cli_alert_danger(err) + self$ERROR(err) } return(updated) }, @@ -266,9 +328,13 @@ GSLayerManager <- R6Class("GSLayerManager", #'@return \code{TRUE} if deleted, \code{FALSE} otherwise deleteLayerGroup = function(lyr, ws = NULL){ if(is.null(ws)){ - self$INFO(sprintf("Deleting layer group '%s'", lyr)) + msg = sprintf("Deleting layer group '%s'", lyr) + cli::cli_alert_info(msg) + self$INFO(msg) }else{ - self$INFO(sprintf("Deleting layer group '%s' in workspace '%s'", lyr, ws)) + msg = sprintf("Deleting layer group '%s' in workspace '%s'", lyr, ws) + cli::cli_alert_info(msg) + self$INFO(msg) } deleted <- FALSE path <- ifelse(is.null(ws), @@ -278,10 +344,14 @@ GSLayerManager <- R6Class("GSLayerManager", private$keyring_backend$get(service = private$keyring_service, username = private$user), path = path, verbose = self$verbose.debug) if(status_code(req) == 200){ - self$INFO("Successfuly deleted layer group!") + msg = "Successfuly deleted layer group!" + cli::cli_alert_success(msg) + self$INFO(msg) deleted = TRUE }else{ - self$ERROR("Error while deleting layer group") + err = "Error while deleting layer group" + cli::cli_alert_danger(err) + self$ERROR(err) } return(deleted) } diff --git a/R/GSManager.R b/R/GSManager.R index 7d97a5d..f6364e9 100644 --- a/R/GSManager.R +++ b/R/GSManager.R @@ -6,6 +6,7 @@ #' @import httr #' @import xml2 #' @import keyring +#' @import cli #' @import magrittr #' @importFrom readr read_csv #' @importFrom readr write_csv @@ -168,20 +169,25 @@ GSManager <- R6Class("GSManager", ) if(status_code(req) == 401){ err <- "Impossible to connect to GeoServer: Wrong credentials" + cli::cli_alert_danger(err) self$ERROR(err) stop(err) } if(status_code(req) == 404){ err <- "Impossible to connect to GeoServer: Incorrect URL or GeoServer temporarily unavailable" + cli::cli_alert_danger(err) self$ERROR(err) stop(err) } if(status_code(req) != 200){ err <- sprintf("Impossible to connect to Geoserver: Unexpected error (status code %s)", status_code(req)) + cli::cli_alert_danger(err) self$ERROR(err) stop(err) }else{ - self$INFO("Successfully connected to GeoServer!") + msg = "Successfully connected to GeoServer!" + cli::cli_alert_success(msg) + self$INFO(msg) } return(TRUE) }, @@ -189,7 +195,9 @@ GSManager <- R6Class("GSManager", #'@description Reloads the GeoServer catalog #'@return \code{TRUE} if reloaded, \code{FALSE} otherwise reload = function(){ - self$INFO("Reloading GeoServer catalog") + msg = "Reloading GeoServer catalog" + cli::cli_alert_info(msg) + self$INFO(msg) reloaded <- FALSE req <- GSUtils$POST(self$getUrl(), private$user, private$keyring_backend$get(service = private$keyring_service, username = private$user), @@ -197,10 +205,14 @@ GSManager <- R6Class("GSManager", content = NULL, contentType = "text/plain", self$verbose.debug) if(status_code(req) == 200){ - self$INFO("Successfully reloaded GeoServer catalog!") + msg = "Successfully reloaded GeoServer catalog!" + cli::cli_alert_success(msg) + self$INFO(msg) reloaded <- TRUE }else{ - self$ERROR("Error while reloading the GeoServer catalog") + err = "Error while reloading the GeoServer catalog" + cli::cli_alert_danger(err) + self$ERROR(err) } return(reloaded) }, @@ -208,7 +220,9 @@ GSManager <- R6Class("GSManager", #'@description Get system status #'@return an object of class \code{data.frame} given the date time and metrics value getSystemStatus = function(){ - self$INFO("Get system status") + msg = "Get system status" + cli::cli_alert_info(msg) + self$INFO(msg) datetime <- Sys.time() req <- GSUtils$GET(self$getUrl(), private$user, private$keyring_backend$get(service = private$keyring_service, username = private$user), @@ -216,9 +230,13 @@ GSManager <- R6Class("GSManager", contentType = "application/json", self$verbose.debug) if(status_code(req) == 200){ - self$INFO("Successfully fetched system status") + msg = "Successfully fetched system status" + cli::cli_alert_success(msg) + self$INFO(msg) }else{ - self$ERROR("Error while fetching system status") + err = "Error while fetching system status" + cli::cli_alert_danger(err) + self$ERROR(err) } content <- httr::content(req) status <- list( diff --git a/R/GSMonitorManager.R b/R/GSMonitorManager.R index 275140a..e1fbaac 100644 --- a/R/GSMonitorManager.R +++ b/R/GSMonitorManager.R @@ -23,7 +23,9 @@ GSMonitorManager <- R6Class("GSMonitorManager", #'@param offset offset #'@return an object of class \code{data.frame} getRequests = function(offset = 0){ - self$INFO("Fetching requests") + msg = "Fetching requests" + cli::cli_alert_info(msg) + self$INFO(msg) tmp = tempfile(fileext = ".csv") req <- GSUtils$GET( self$getUrl(), private$user, @@ -33,9 +35,13 @@ GSMonitorManager <- R6Class("GSMonitorManager", if(status_code(req) == 200){ out <- readr::read_csv(tmp) unlink(tmp) - self$INFO(sprintf("Successfully fetched %s requests", nrow(out))) + msg = sprintf("Successfully fetched %s requests", nrow(out)) + cli::cli_alert_success(msg) + self$INFO(msg) }else{ - self$ERROR("Error while fetching requests") + err = "Error while fetching requests" + cli::cli_alert_danger(err) + self$ERROR(err) } return(out) } diff --git a/R/GSNamespaceManager.R b/R/GSNamespaceManager.R index 144f837..407edea 100644 --- a/R/GSNamespaceManager.R +++ b/R/GSNamespaceManager.R @@ -23,7 +23,9 @@ GSNamespaceManager <- R6Class("GSNamespaceManager", #'@description Get the list of available namespace. Re #'@return an object of class \code{list} containing items of class \code{\link{GSNamespace}} getNamespaces = function(){ - self$INFO("Fetching list of namespaces") + msg = "Fetching list of namespaces" + cli::cli_alert_info(msg) + self$INFO(msg) req <- GSUtils$GET(self$getUrl(), private$user, private$keyring_backend$get(service = private$keyring_service, username = private$user), "/namespaces.xml", self$verbose.debug) @@ -32,9 +34,13 @@ GSNamespaceManager <- R6Class("GSNamespaceManager", nsXML <- GSUtils$parseResponseXML(req) nsXMLList <- as(xml2::xml_find_all(nsXML, "//namespace"), "list") nsList <- lapply(nsXMLList, GSNamespace$new) - self$INFO(sprintf("Successfully fetched %s namespaces", length(nsList))) + msg = sprintf("Successfully fetched %s namespaces", length(nsList)) + cli::cli_alert_success(msg) + self$INFO(msg) }else{ - self$ERROR("Error while fetching list of namespaces") + err = "Error while fetching list of namespaces" + cli::cli_alert_danger(err) + self$ERROR(err) } return(nsList) }, @@ -50,7 +56,9 @@ GSNamespaceManager <- R6Class("GSNamespaceManager", #'@param ns namespace #'@return an object of class \link{GSNamespace} getNamespace = function(ns){ - self$INFO(sprintf("Fetching workspace '%s'", ns)) + msg = sprintf("Fetching workspace '%s'", ns) + cli::cli_alert_info(msg) + self$INFO(msg) req <- GSUtils$GET(self$getUrl(), private$user, private$keyring_backend$get(service = private$keyring_service, username = private$user), sprintf("/namespaces/%s.xml", ns), self$verbose.debug) @@ -58,9 +66,13 @@ GSNamespaceManager <- R6Class("GSNamespaceManager", if(status_code(req) == 200){ nsXML <- GSUtils$parseResponseXML(req) namespace <- GSNamespace$new(xml = nsXML) - self$INFO("Successfully fetched namespace!") + msg = "Successfully fetched namespace!" + cli::cli_alert_success(msg) + self$INFO(msg) }else{ - self$ERROR("Error while fetching namespace") + err = "Error while fetching namespace" + cli::cli_alert_danger(err) + self$ERROR(err) } return(namespace) }, @@ -70,8 +82,9 @@ GSNamespaceManager <- R6Class("GSNamespaceManager", #'@param uri uri #'@return \code{TRUE} if the namespace has been successfully created, \code{FALSE} otherwise createNamespace = function(prefix, uri){ - - self$INFO(sprintf("Creating namespace '%s'", prefix)) + msg = sprintf("Creating namespace '%s'", prefix) + cli::cli_alert_info(msg) + self$INFO(msg) created <- FALSE namespace <- GSNamespace$new(prefix = prefix, uri = uri) @@ -85,10 +98,14 @@ GSNamespaceManager <- R6Class("GSNamespaceManager", verbose = self$verbose.debug ) if(status_code(req) == 201){ - self$INFO("Successfully created namespace!") + msg = "Successfully created namespace!" + cli::cli_alert_success(msg) + self$INFO(msg) created = TRUE }else{ - self$ERROR("Error while creating namespace") + err = "Error while creating namespace" + cli::cli_alert_danger(err) + self$ERROR(err) } return(created) }, @@ -98,8 +115,9 @@ GSNamespaceManager <- R6Class("GSNamespaceManager", #'@param uri uri #'@return \code{TRUE} if the namespace has been successfully updated, \code{FALSE} otherwise updateNamespace = function(prefix, uri){ - - self$INFO(sprintf("Updating namespace '%s'", prefix)) + msg = sprintf("Updating namespace '%s'", prefix) + cli::cli_alert_info(msg) + self$INFO(msg) updated <- FALSE namespace <- GSNamespace$new(prefix = prefix, uri = uri) @@ -112,10 +130,14 @@ GSNamespaceManager <- R6Class("GSNamespaceManager", self$verbose.debug ) if(status_code(req) == 200){ - self$INFO("Successfully updated namespace!") + msg = "Successfully updated namespace!" + cli::cli_alert_success(msg) + self$INFO(msg) updated = TRUE }else{ - self$ERROR("Error while updating namespace") + err = "Error while updating namespace" + cli::cli_alert_danger(err) + self$ERROR(err) } return(updated) }, @@ -125,7 +147,9 @@ GSNamespaceManager <- R6Class("GSNamespaceManager", #'@param recurse recurse #'@return \code{TRUE} if the namespace has been successfully deleted, \code{FALSE} otherwise deleteNamespace = function(name, recurse = FALSE){ - self$INFO(sprintf("Deleting namespace '%s'", name)) + msg = sprintf("Deleting namespace '%s'", name) + cli::cli_alert_info(msg) + self$INFO(msg) deleted <- FALSE path <- sprintf("/namespaces/%s", name) if(recurse) path <- paste0(path, "?recurse=true") @@ -135,10 +159,14 @@ GSNamespaceManager <- R6Class("GSNamespaceManager", private$keyring_backend$get(service = private$keyring_service, username = private$user), path = path, self$verbose.debug) if(status_code(req) == 200){ - self$INFO("Successfully deleted namespace!") + msg = "Successfully deleted namespace!" + cli::cli_alert_success(msg) + self$INFO(msg) deleted = TRUE }else{ - self$ERROR("Error while deleting namespace") + err = "Error while deleting namespace" + cli::cli_alert_danger(err) + self$ERROR(err) } return(deleted) } diff --git a/R/GSServiceManager.R b/R/GSServiceManager.R index 6d150fb..4bc7479 100644 --- a/R/GSServiceManager.R +++ b/R/GSServiceManager.R @@ -29,7 +29,10 @@ GSServiceManager <- R6Class("GSServiceManager", #'@return an object of class \link{GSServiceSettings} getServiceSettings = function(service, ws = NULL){ if(self$version$lowerThan("2.12")){ - stop("This feature is available starting from GeoServer 2.12") + err = "This feature is available starting from GeoServer 2.12" + cli::cli_alert_danger(err) + self$ERROR(err) + stop(err) } restPath <- NULL service <- tolower(service) @@ -47,9 +50,13 @@ GSServiceManager <- R6Class("GSServiceManager", if(status_code(req) == 200){ settingsXML <- GSUtils$parseResponseXML(req) serviceSettings <- GSServiceSettings$new(xml = settingsXML, service = tolower(xml2::xml_name(xml2::as_xml_document(settingsXML)))) - self$INFO("Successfully fetched service settings!") + msg = "Successfully fetched service settings!" + cli::cli_alert_success(msg) + self$INFO(msg) }else{ - self$ERROR("Error while fetching service settings") + err = "Error while fetching service settings" + cli::cli_alert_danger(err) + self$ERROR(err) } return(serviceSettings) }, @@ -90,7 +97,10 @@ GSServiceManager <- R6Class("GSServiceManager", #'@return \code{TRUE} if updated, \code{FALSE} otherwise updateServiceSettings = function(serviceSettings, service, ws = NULL){ if(self$version$lowerThan("2.12")){ - stop("This feature is available starting from GeoServer 2.12") + err = "This feature is available starting from GeoServer 2.12" + cli::cli_alert_danger(err) + self$ERROR(err) + stop(err) } updated <- FALSE restPath <- NULL @@ -111,10 +121,14 @@ GSServiceManager <- R6Class("GSServiceManager", verbose = self$verbose.debug ) if(status_code(req) == 200){ - self$INFO("Successfully updated service settings!") + msg = "Successfully updated service settings!" + cli::cli_alert_success(msg) + self$INFO(msg) updated = TRUE }else{ - self$ERROR("Error while updating service settings") + err = "Error while updating service settings" + cli::cli_alert_danger(err) + self$ERROR(err) } return(updated) }, @@ -126,7 +140,10 @@ GSServiceManager <- R6Class("GSServiceManager", #'@return \code{TRUE} if deleted, \code{FALSE} otherwise deleteServiceSettings = function(service, ws = NULL){ if(self$version$lowerThan("2.12")){ - stop("This feature is available starting from GeoServer 2.12") + err = "This feature is available starting from GeoServer 2.12" + cli::cli_alert_danger(err) + self$ERROR(err) + stop(err) } deleted <- FALSE restPath <- NULL @@ -145,10 +162,14 @@ GSServiceManager <- R6Class("GSServiceManager", path = restPath, verbose = self$verbose.debug ) if(status_code(req) == 200){ - self$INFO("Successfully deleted service settings!") + msg = "Successfully deleted service settings!" + cli::cli_alert_success(msg) + self$INFO(msg) deleted = TRUE }else{ - self$ERROR("Error while deleted service settings") + err = "Error while deleted service settings" + cli::cli_alert_danger(err) + self$ERROR(err) } return(deleted) }, diff --git a/R/GSStyleManager.R b/R/GSStyleManager.R index e5187f6..09eb5aa 100644 --- a/R/GSStyleManager.R +++ b/R/GSStyleManager.R @@ -23,7 +23,9 @@ GSStyleManager <- R6Class("GSStyleManager", #'@param ws an optional workspace name #'@return an object of class \code{list} containing items of class \code{\link{GSStyle}} getStyles = function(ws = NULL){ - self$INFO("Fetching list of styles") + msg = "Fetching list of styles" + cli::cli_alert_info(msg) + self$INFO(msg) req_url <- "/styles.xml" if(!is.null(ws)) req_url <- sprintf("/workspaces/%s/styles.xml", ws) req <- GSUtils$GET(self$getUrl(), private$user, @@ -34,9 +36,13 @@ GSStyleManager <- R6Class("GSStyleManager", styleXML <- GSUtils$parseResponseXML(req) styleXMLList <- as(xml2::xml_find_all(styleXML, "//style"), "list") styleList <- lapply(styleXMLList, GSStyle$new) - self$INFO(sprintf("Successfully fetched %s styles", length(styleList))) + msg = sprintf("Successfully fetched %s styles", length(styleList)) + cli::cli_alert_success(msg) + self$INFO(msg) }else{ - self$ERROR("Error while fetching list of styles") + err = "Error while fetching list of styles" + cli::cli_alert_danger(err) + self$ERROR(err) } return(styleList) }, @@ -54,7 +60,9 @@ GSStyleManager <- R6Class("GSStyleManager", #'@param ws workspace name. Optional #'@return object of class \link{GSStyle} getStyle = function(style, ws = NULL){ - self$INFO(sprintf("Fetching style '%s'", style)) + msg = sprintf("Fetching style '%s'", style) + cli::cli_alert_info(msg) + self$INFO(msg) reqUrl <- "" if(!missing(ws) & !is.null(ws)){ reqUrl <- sprintf("/workspaces/%s", ws) @@ -67,9 +75,13 @@ GSStyleManager <- R6Class("GSStyleManager", if(status_code(req) == 200){ styleXML <- GSUtils$parseResponseXML(req) style <- GSStyle$new(xml = styleXML) - self$INFO("Successfully fetched style!") + msg = "Successfully fetched style!" + cli::cli_alert_success(msg) + self$INFO(msg) }else{ - self$ERROR("Error while fetching style") + err = "Error while fetching style" + cli::cli_alert_danger(err) + self$ERROR(err) } return(style) }, @@ -82,19 +94,27 @@ GSStyleManager <- R6Class("GSStyleManager", #'@param ws workspace name #'@return \code{TRUE} if the style has been successfully created, \code{FALSE} otherwise createStyle = function(file, sldBody = NULL, name, raw = FALSE, ws = NULL){ - self$INFO(sprintf("Creating style '%s'", name)) + msg = sprintf("Creating style '%s'", name) + cli::cli_alert_info(msg) + self$INFO(msg) created <- FALSE if(!missing(file)){ content <- readChar(file, file.info(file)$size) if(!GSUtils$isXMLString(content)){ - stop("SLD style is not recognized XML") + err = "SLD style is not recognized XML" + cli::cli_alert_danger(err) + self$ERROR(err) + stop(err) } sldBody <- xml2::read_xml(content) } if(!is(sldBody, "xml_document")){ - stop("SLD body is not an XML document object") + err = "SLD body is not an XML document object" + cli::cli_alert_danger(err) + self$ERROR(err) + stop(err) } contentType <- switch(self$getSLDVersion(sldBody), @@ -103,7 +123,10 @@ GSStyleManager <- R6Class("GSStyleManager", NULL ) if(is.null(contentType)){ - stop("Not contentType specified for style creation") + err = "No contentType specified for style creation" + cli::cli_alert_danger(err) + self$ERROR(err) + stop(err) } reqUrl <- "" @@ -123,10 +146,14 @@ GSStyleManager <- R6Class("GSStyleManager", verbose = self$verbose.debug ) if(status_code(req) == 201){ - self$INFO("Successfully created style!") + msg = "Successfully created style!" + cli::cli_alert_success(msg) + self$INFO(msg) created = TRUE }else{ - self$ERROR("Error while creating style") + err = "Error while creating style" + cli::cli_alert_danger(err) + self$ERROR(err) } return(created) }, @@ -139,18 +166,26 @@ GSStyleManager <- R6Class("GSStyleManager", #'@param ws workspace name #'@return \code{TRUE} if the style has been successfully updated, \code{FALSE} otherwise updateStyle = function(file, sldBody = NULL, name, raw = FALSE, ws = NULL){ - self$INFO(sprintf("Updating style '%s'", name)) + msg = sprintf("Updating style '%s'", name) + cli::cli_alert_info(msg) + self$INFO(msg) if(!missing(file)){ content <- readChar(file, file.info(file)$size) if(!GSUtils$isXMLString(content)){ - stop("SLD style is not recognized XML") + err = "SLD style is not recognized XML" + cli::cli_alert_danger(err) + self$ERROR(err) + stop(err) } sldBody <- xml2::read_xml(content) } if(!is(sldBody, "xml_document")){ - stop("SLD body is not an XML document object") + err = "SLD body is not an XML document object" + cli::cli_alert_danger(err) + self$ERROR(err) + stop(err) } contentType <- switch(self$getSLDVersion(sldBody), @@ -159,7 +194,10 @@ GSStyleManager <- R6Class("GSStyleManager", NULL ) if(is.null(contentType)){ - stop("Not contentType specified for style creation") + err = "No contentType specified for style creation" + cli::cli_alert_danger(err) + self$ERROR(err) + stop(err) } reqUrl <- "" @@ -179,10 +217,14 @@ GSStyleManager <- R6Class("GSStyleManager", verbose = self$verbose.debug ) if(status_code(req) == 200){ - self$INFO("Successfully updated style!") + msg = "Successfully updated style!" + cli::cli_alert_success(msg) + self$INFO(msg) updated = TRUE }else{ - self$ERROR("Error while updating style") + err = "Error while updating style" + cli::cli_alert_danger(err) + self$ERROR(err) } return(updated) }, @@ -197,7 +239,9 @@ GSStyleManager <- R6Class("GSStyleManager", #'@param ws workspace name #'@return \code{TRUE} if the style has been successfully deleted, \code{FALSE} otherwise deleteStyle = function(name, recurse = FALSE, purge = FALSE, ws = NULL){ - self$INFO(sprintf("Deleting style '%s'", name)) + msg = sprintf("Deleting style '%s'", name) + cli::cli_alert_info(msg) + self$INFO(msg) deleted <- FALSE path <- "" @@ -213,10 +257,14 @@ GSStyleManager <- R6Class("GSStyleManager", private$keyring_backend$get(service = private$keyring_service, username = private$user), path = path, self$verbose.debug) if(status_code(req) == 200){ - self$INFO("Successfully deleted style!") + msg = "Successfully deleted style!" + cli::cli_alert_success(msg) + self$INFO(msg) deleted = TRUE }else{ - self$ERROR("Error while deleting style") + err = "Error while deleting style" + cli::cli_alert_danger(err) + self$ERROR(err) } return(deleted) }, @@ -235,11 +283,14 @@ GSStyleManager <- R6Class("GSStyleManager", if(self$version$lowerThan("2.2")){ err <- sprintf("Unsupported method for GeoServer %s", self$version$version) + cli::cli_alert_danger(err) self$ERROR(err) stop(err) } - self$INFO(sprintf("Fetching SLD body for style '%s'", style)) + msg = sprintf("Fetching SLD body for style '%s'", style) + cli::cli_alert_info(msg) + self$INFO(msg) reqUrl <- "" if(!missing(ws) & !is.null(ws)){ reqUrl <- sprintf("/workspaces/%s", ws) @@ -251,9 +302,13 @@ GSStyleManager <- R6Class("GSStyleManager", style <- NULL if(status_code(req) == 200){ style <- GSUtils$parseResponseXML(req) - self$INFO("Successfully fetched SLD body!") + msg = "Successfully fetched SLD body!" + cli::cli_alert_success(msg) + self$INFO(msg) }else{ - self$ERROR("Error while fetching SLD body") + err = "Error while fetching SLD body" + cli::cli_alert_danger(err) + self$ERROR(err) } return(style) } diff --git a/R/GSWorkspaceManager.R b/R/GSWorkspaceManager.R index fe85fb6..8d3b873 100644 --- a/R/GSWorkspaceManager.R +++ b/R/GSWorkspaceManager.R @@ -24,7 +24,9 @@ GSWorkspaceManager <- R6Class("GSWorkspaceManager", #' containing items of class \code{\link{GSWorkspace}} #'@param a list of \link{GSWorkspace} getWorkspaces = function(){ - self$INFO("Fetching list of workspaces") + msg = "Fetching list of workspaces" + cli::cli_alert_info(msg) + self$INFO(msg) req <- GSUtils$GET(self$getUrl(), private$user, private$keyring_backend$get(service = private$keyring_service, username = private$user), "/workspaces.xml", self$verbose.debug) @@ -33,9 +35,13 @@ GSWorkspaceManager <- R6Class("GSWorkspaceManager", wsXML <- GSUtils$parseResponseXML(req) wsXMLList <- as(xml2::xml_find_all(wsXML, "//workspace"), "list") wsList <- lapply(wsXMLList, GSWorkspace$new) - self$INFO(sprintf("Successfully fetched %s workspaces", length(wsList))) + msg = sprintf("Successfully fetched %s workspaces", length(wsList)) + cli::cli_alert_success(msg) + self$INFO(msg) }else{ - self$ERROR("Error while fetching list of workspaces") + err = "Error while fetching list of workspaces" + cli::cli_alert_danger(err) + self$ERROR(err) } return(wsList) }, @@ -51,7 +57,9 @@ GSWorkspaceManager <- R6Class("GSWorkspaceManager", #'@param ws workspace name #'@return an object of class \link{GSWorkspace} getWorkspace = function(ws){ - self$INFO(sprintf("Fetching workspace '%s'", ws)) + msg = sprintf("Fetching workspace '%s'", ws) + cli::cli_alert_info(msg) + self$INFO(msg) req <- GSUtils$GET(self$getUrl(), private$user, private$keyring_backend$get(service = private$keyring_service, username = private$user), sprintf("/workspaces/%s.xml", ws), self$verbose.debug) @@ -59,9 +67,13 @@ GSWorkspaceManager <- R6Class("GSWorkspaceManager", if(status_code(req) == 200){ wsXML <- GSUtils$parseResponseXML(req) workspace <- GSWorkspace$new(xml = wsXML) - self$INFO("Successfully fetched workspace!") + msg = "Successfully fetched workspace!" + cli::cli_alert_success(msg) + self$INFO(msg) }else{ - self$ERROR("Error while fetching workspace") + err = "Error while fetching workspace" + cli::cli_alert_danger(err) + self$ERROR(err) } return(workspace) }, @@ -75,7 +87,9 @@ GSWorkspaceManager <- R6Class("GSWorkspaceManager", #'@param uri uri #'@return \code{TRUE} if created, \code{FALSE} otherwise createWorkspace = function(name, uri){ - self$INFO(sprintf("Creating workspace '%s'", name)) + msg = sprintf("Creating workspace '%s'", name) + cli::cli_alert_info(msg) + self$INFO(msg) created <- FALSE if(missing(uri)){ @@ -91,13 +105,19 @@ GSWorkspaceManager <- R6Class("GSWorkspaceManager", verbose = self$verbose.debug ) if(status_code(req) == 201){ - self$INFO("Successfully created workspace!") + msg = "Successfully created workspace!" + cli::cli_alert_info(msg) + self$INFO(msg) created = TRUE }else{ - self$ERROR("Error while creating workspace") + err = "Error while creating workspace" + cli::cli_alert_danger(err) + self$ERROR(err) } }else{ - self$INFO("Delegating workspace creation to namespace manager") + msg = "Delegating workspace creation to namespace manager" + cli::cli_alert_info(msg) + self$INFO(msg) nsman <- GSNamespaceManager$new(self$getUrl(), private$user, private$keyring_backend$get(service = private$keyring_service, username = private$user), self$loggerType) @@ -115,7 +135,9 @@ GSWorkspaceManager <- R6Class("GSWorkspaceManager", #'@param uri uri #'@return \code{TRUE} if created, \code{FALSE} otherwise updateWorkspace = function(name, uri){ - self$INFO(sprintf("Updating workspace '%s'", name)) + msg = sprintf("Updating workspace '%s'", name) + cli::cli_alert_info(msg) + self$INFO(msg) updated <- FALSE if(missing(uri)){ workspace <- GSWorkspace$new(name = name) @@ -128,13 +150,19 @@ GSWorkspaceManager <- R6Class("GSWorkspaceManager", verbose = self$verbose.debug ) if(status_code(req) == 200){ - self$INFO("Successfully updated workspace!") + msg = "Successfully updated workspace!" + cli::cli_alert_success(msg) + self$INFO(msg) updated = TRUE }else{ - self$ERROR("Error while updating workspace") + err = "Error while updating workspace" + cli::cli_alert_danger(err) + self$ERROR(err) } }else{ - self$INFO("Delegating workspace update to namespace manager") + msg = "Delegating workspace update to namespace manager" + cli::cli_alert_info(msg) + self$INFO(msg) nsman <- GSNamespaceManager$new(self$getUrl(), private$user, private$keyring_backend$get(service = private$keyring_service, username = private$user), self$loggerType) @@ -148,7 +176,9 @@ GSWorkspaceManager <- R6Class("GSWorkspaceManager", #'@param recurse recurse #'@return \code{TRUE} if the workspace has been successfully deleted, \code{FALSE} otherwise deleteWorkspace = function(name, recurse = FALSE){ - self$INFO(sprintf("Deleting workspace '%s'", name)) + msg = sprintf("Deleting workspace '%s'", name) + cli::cli_alert_info(msg) + self$INFO(msg) deleted <- FALSE path <- sprintf("/workspaces/%s", name) if(recurse) path <- paste0(path, "?recurse=true") @@ -158,10 +188,14 @@ GSWorkspaceManager <- R6Class("GSWorkspaceManager", private$keyring_backend$get(service = private$keyring_service, username = private$user), path = path, self$verbose.debug) if(status_code(req) == 200){ - self$INFO("Successfully deleted workspace!") + msg = "Successfully deleted workspace!" + cli::cli_alert_info(msg) + self$INFO(msg) deleted = TRUE }else{ - self$ERROR("Error while deleting workspace") + err = "Error while deleting workspace" + cli::cli_alert_danger(err) + self$ERROR(err) } return(deleted) }, @@ -171,9 +205,13 @@ GSWorkspaceManager <- R6Class("GSWorkspaceManager", #'@return an object of class \link{GSWorkspaceSettings} getWorkspaceSettings = function(ws){ if(self$version$lowerThan("2.12")){ - stop("This feature is available starting from GeoServer 2.12") + err = "This feature is available starting from GeoServer 2.12" + cli::cli_alert_danger(err) + stop(err) } - self$INFO(sprintf("Fetching settings for workspace '%s'", ws)) + msg = sprintf("Fetching settings for workspace '%s'", ws) + cli::cli_alert_info(msg) + self$INFO(msg) req <- GSUtils$GET(self$getUrl(), private$user, private$keyring_backend$get(service = private$keyring_service, username = private$user), sprintf("/workspaces/%s/settings.xml", ws), self$verbose.debug) @@ -181,9 +219,13 @@ GSWorkspaceManager <- R6Class("GSWorkspaceManager", if(status_code(req) == 200){ wsSettingXML <- GSUtils$parseResponseXML(req) workspaceSettings <- GSWorkspaceSettings$new(xml = wsSettingXML) - self$INFO("Successfully fetched workspace settings!") + msg = "Successfully fetched workspace settings!" + cli::cli_alert_success(msg) + self$INFO(msg) }else{ - self$ERROR("Error while fetching workspace settings") + err = "Error while fetching workspace settings" + cli::cli_alert_danger(err) + self$ERROR(err) } return(workspaceSettings) }, @@ -194,9 +236,13 @@ GSWorkspaceManager <- R6Class("GSWorkspaceManager", #'@return \code{TRUE} if created, \code{FALSE} otherwise createWorkspaceSettings = function(ws, workspaceSettings){ if(self$version$lowerThan("2.12")){ - stop("This feature is available starting from GeoServer 2.12") + err = "This feature is available starting from GeoServer 2.12" + cli::cli_alert_danger(err) + stop(err) } - self$INFO(sprintf("Creating settings for workspace '%s'", ws)) + msg = sprintf("Creating settings for workspace '%s'", ws) + cli::cli_alert_info(msg) + self$INFO(msg) created <- FALSE req <- GSUtils$PUT( url = self$getUrl(), @@ -208,10 +254,14 @@ GSWorkspaceManager <- R6Class("GSWorkspaceManager", verbose = self$verbose.debug ) if(status_code(req) == 200){ - self$INFO("Successfully created workspace settings!") + msg = "Successfully created workspace settings!" + cli::cli_alert_success(msg) + self$INFO(msg) created = TRUE }else{ - self$ERROR("Error while creating workspace settings") + err = "Error while creating workspace settings" + cli::cli_alert_danger(err) + self$ERROR(err) } return(created) }, @@ -222,9 +272,13 @@ GSWorkspaceManager <- R6Class("GSWorkspaceManager", #'@return \code{TRUE} if updated, \code{FALSE} otherwise updateWorkspaceSettings = function(ws, workspaceSettings){ if(self$version$lowerThan("2.12")){ - stop("This feature is available starting from GeoServer 2.12") + err = "This feature is available starting from GeoServer 2.12" + cli::cli_alert_danger(err) + stop(err) } - self$INFO(sprintf("Updating settings for workspace '%s'", ws)) + msg = sprintf("Updating settings for workspace '%s'", ws) + cli::cli_alert_info(msg) + self$INFO(msg) updated <- FALSE req <- GSUtils$PUT( url = self$getUrl(), user = private$user, @@ -235,10 +289,14 @@ GSWorkspaceManager <- R6Class("GSWorkspaceManager", verbose = self$verbose.debug ) if(status_code(req) == 200){ - self$INFO("Successfully updated workspace settings!") + msg = "Successfully updated workspace settings!" + cli::cli_alert_success(msg) + self$INFO(msg) updated = TRUE }else{ - self$ERROR("Error while updating workspace settings") + err = "Error while updating workspace settings" + cli::cli_alert_danger(err) + self$ERROR(err) } return(updated) }, @@ -248,19 +306,27 @@ GSWorkspaceManager <- R6Class("GSWorkspaceManager", #'@return \code{TRUE} if deleted, \code{FALSE} otherwise deleteWorkspaceSettings = function(ws){ if(self$version$lowerThan("2.12")){ - stop("This feature is available starting from GeoServer 2.12") + err = "This feature is available starting from GeoServer 2.12" + cli::cli_alert_danger(err) + stop(err) } - self$INFO(sprintf("Deleting settings for workspace '%s'", ws)) + msg = sprintf("Deleting settings for workspace '%s'", ws) + cli::cli_alert_info(msg) + self$INFO(msg) deleted <- FALSE path <- sprintf("/workspaces/%s/settings", ws) req <- GSUtils$DELETE(self$getUrl(), private$user, private$keyring_backend$get(service = private$keyring_service, username = private$user), path = path, self$verbose.debug) if(status_code(req) == 200){ - self$INFO("Successfully deleted workspace settings!") + msg = "Successfully deleted workspace settings!" + cli::cli_alert_success(msg) + self$INFO(msg) deleted = TRUE }else{ - self$ERROR("Error while deleting workspace settings") + err = "Error while deleting workspace settings" + cli::cli_alert_danger(err) + self$ERROR(err) } return(deleted) }