From fd4821c43f920bb89286918660ae1ecb745382f8 Mon Sep 17 00:00:00 2001 From: eblondel Date: Mon, 5 Jul 2021 23:12:06 +0200 Subject: [PATCH] #10 work on execute --- NAMESPACE | 4 ++++ R/OGCAbstractObject.R | 41 ++++++++++++++++++++++++++++++++------ R/OWSCodeType.R | 33 +++++++++++++++++++++++++++++++ R/WPSClient.R | 4 ++-- R/WPSExecute.R | 46 +++++++++++++++++++++++++++++++++++++++++++ R/WPSInput.R | 36 +++++++++++++++++++++++++++++++++ R/WPSLiteralData.R | 32 ++++++++++++++++++++++++++++++ R/WPSProcess.R | 19 +++++++++++++++++- man/OWSCodeType.Rd | 30 ++++++++++++++++++++++++++++ man/WPSClient.Rd | 6 +++--- man/WPSExecute.Rd | 33 +++++++++++++++++++++++++++++++ man/WPSInput.Rd | 30 ++++++++++++++++++++++++++++ man/WPSLiteralData.Rd | 30 ++++++++++++++++++++++++++++ 13 files changed, 332 insertions(+), 12 deletions(-) create mode 100644 R/OWSCodeType.R create mode 100644 R/WPSExecute.R create mode 100644 R/WPSInput.R create mode 100644 R/WPSLiteralData.R create mode 100644 man/OWSCodeType.Rd create mode 100644 man/WPSExecute.Rd create mode 100644 man/WPSInput.Rd create mode 100644 man/WPSLiteralData.Rd diff --git a/NAMESPACE b/NAMESPACE index a029c06..99f8a5c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -20,6 +20,7 @@ export(OGCExpression) export(OGCFilter) export(OWSCapabilities) export(OWSClient) +export(OWSCodeType) export(OWSGetCapabilities) export(OWSHttpRequest) export(OWSOperation) @@ -55,8 +56,11 @@ export(WPSComplexInputDescription) export(WPSComplexOutputDescription) export(WPSDescribeProcess) export(WPSDescriptionParameter) +export(WPSExecute) export(WPSFormat) +export(WPSInput) export(WPSInputDescription) +export(WPSLiteralData) export(WPSLiteralInputDescription) export(WPSOutputDescription) export(WPSParameter) diff --git a/R/OGCAbstractObject.R b/R/OGCAbstractObject.R index 38b6849..3e3ace2 100644 --- a/R/OGCAbstractObject.R +++ b/R/OGCAbstractObject.R @@ -77,6 +77,29 @@ OGCAbstractObject <- R6Class("OGCAbstractObject", sep = ""), sep = "") } return(out) + }, + #fromComplexTypes + fromComplexTypes = function(value){ + #datetime types + if(suppressWarnings(all(class(value)==c("POSIXct","POSIXt")))){ + tz <- attr(value, "tzone") + if(length(tz)>0){ + if(tz %in% c("UTC","GMT")){ + value <- format(value,"%Y-%m-%dT%H:%M:%S") + value <- paste0(value,"Z") + }else{ + utc_offset <- format(value, "%z") + utc_offset <- paste0(substr(utc_offset,1,3),":",substr(utc_offset,4,5)) + value <- paste0(format(value,"%Y-%m-%dT%H:%M:%S"), utc_offset) + } + }else{ + value <- format(value,"%Y-%m-%dT%H:%M:%S") + } + }else if(class(value)[1] == "Date"){ + value <- format(value,"%Y-%m-%d") + } + + return(value) } ), public = list( @@ -189,9 +212,9 @@ OGCAbstractObject <- R6Class("OGCAbstractObject", wrapperNode <- xmlOutputDOM( tag = field, nameSpace = names(private$xmlNamespace)[1], - attrs = field$attrs + attrs = fieldObj$attrs ) - if(!fieldObj$isNull) wrapperNode$addNode(fieldObjXml) + wrapperNode$addNode(fieldObjXml) rootXML$addNode(wrapperNode$value()) }else{ rootXML$addNode(fieldObjXml) @@ -208,7 +231,7 @@ OGCAbstractObject <- R6Class("OGCAbstractObject", nameSpace = names(private$xmlNamespace)[1], attrs = fieldObj$attrs ) - if(!fieldObj$isNull) wrapperNode$addNode(fieldObjXml) + wrapperNode$addNode(fieldObjXml) rootXML$addNode(wrapperNode$value()) }else{ rootXML$addNode(fieldObjXml) @@ -253,9 +276,15 @@ OGCAbstractObject <- R6Class("OGCAbstractObject", } } }else{ - wrapperNode <- xmlOutputDOM(tag = field, nameSpace = names(private$xmlNamespace)[1]) - wrapperNode$addNode(xmlTextNode(fieldObj)) - rootXML$addNode(wrapperNode$value()) + if(field == "value"){ + if(is.logical(fieldObj)) fieldObj <- tolower(as.character(is.logical(fieldObj))) + fieldObj <- private$fromComplexTypes(fieldObj) + rootXML$addNode(xmlTextNode(fieldObj)) + }else{ + wrapperNode <- xmlOutputDOM(tag = field, nameSpace = names(private$xmlNamespace)[1]) + wrapperNode$addNode(xmlTextNode(fieldObj)) + rootXML$addNode(wrapperNode$value()) + } } } } diff --git a/R/OWSCodeType.R b/R/OWSCodeType.R new file mode 100644 index 0000000..acdf019 --- /dev/null +++ b/R/OWSCodeType.R @@ -0,0 +1,33 @@ +#' OWSCodeType +#' @docType class +#' @export +#' @keywords OWS CodeType +#' @return Object of \code{\link{R6Class}} for modelling an OWS CodeType +#' @format \code{\link{R6Class}} object. +#' @section Methods: +#' \describe{ +#' \item{\code{new(expr)}}{ +#' This method is used to instantiate an OWSCodeType object. The unique +#' argument should be an object of class \code{character} +#' } +#' } +#' +#' @author Emmanuel Blondel +#' +OWSCodeType <- R6Class("OWSCodeType", + inherit = OGCAbstractObject, + private = list( + xmlElement = "Identifier", + xmlNamespace = c(ows = "http://www.opengis.net/ows") + ), + public = list( + value = NULL, + initialize = function(xml = NULL, serviceVersion = "1.1", value){ + private$xmlNamespace <- paste0(private$xmlNamespace, "/", serviceVersion) + names(private$xmlNamespace) <- "ows" + if(is.null(xml)){ + self$value <- value + } + } + ) +) \ No newline at end of file diff --git a/R/WPSClient.R b/R/WPSClient.R index c8e1568..227739b 100644 --- a/R/WPSClient.R +++ b/R/WPSClient.R @@ -97,7 +97,7 @@ WPSClient <- R6Class("WPSClient", }, #execute - execute = function(identifier, dataInputs, responseForm, language){ + execute = function(identifier, request, dataInputs, responseForm, language){ processes <- self$getProcesses() processes <- processes[sapply(processes, function(process){process$identifier == identifier})] if(length(processes)==0){ @@ -106,7 +106,7 @@ WPSClient <- R6Class("WPSClient", stop(errMsg) } process <- processes[[1]] - return(process$execute(dataInputs, responseForm, language)) + return(process$execute(dataInputs, request, responseForm, language)) } ) diff --git a/R/WPSExecute.R b/R/WPSExecute.R new file mode 100644 index 0000000..bd87c92 --- /dev/null +++ b/R/WPSExecute.R @@ -0,0 +1,46 @@ +#' WPSExecute +#' +#' @docType class +#' @export +#' @keywords OGC WPS Execute +#' @return Object of \code{\link{R6Class}} for modelling a WPS Execute request +#' @format \code{\link{R6Class}} object. +#' +#' @section Methods: +#' \describe{ +#' \item{\code{new(op, url, serviceVersion, identifier, logger, ...)}}{ +#' This method is used to instantiate a WPSExecute object +#' } +#' } +#' +#' @note Abstract class used by \pkg{ows4R} to trigger a WPS Execute request +#' +#' @author Emmanuel Blondel +#' +WPSExecute <- R6Class("WPSExecute", + inherit = OWSHttpRequest, + private = list( + xmlElement = "Execute", + xmlNamespace = c(wps = "http://www.opengis.net/wps") + ), + public = list( + Identifier = "", + DataInputs = list(), + initialize = function(op, url, serviceVersion, identifier, + dataInputs = list(), logger = NULL, ...) { + private$xmlNamespace = paste(private$xmlNamespace, serviceVersion, sep="/") + names(private$xmlNamespace) <- "wps" + namedParams <- list(service = "WPS", version = version, identifier = identifier) + super$initialize(op, "POST", url, request = private$name, + namedParams = namedParams, mimeType = "text/xml", logger = logger, + ...) + self$Identifier <- OWSCodeType$new(value = identifier) + dataInputNames <- names(dataInputs) + self$DataInputs <- lapply(dataInputNames, function(dataInputName){ + dataInput <- dataInputs[[dataInputName]] + WPSInput$new(identifier = dataInputName, data = dataInput) + }) + #self$execute() + } + ) +) \ No newline at end of file diff --git a/R/WPSInput.R b/R/WPSInput.R new file mode 100644 index 0000000..0963063 --- /dev/null +++ b/R/WPSInput.R @@ -0,0 +1,36 @@ +#' WPSInput +#' +#' @docType class +#' @export +#' @keywords OGC WPS Input +#' @return Object of \code{\link{R6Class}} for modelling a WPS Input +#' @format \code{\link{R6Class}} object. +#' +#' @section Methods: +#' \describe{ +#' \item{\code{new(identifier, data)}}{ +#' This method is used to instantiate a WPSInput object +#' } +#' } +#' +#' +#' @author Emmanuel Blondel +#' +WPSInput <- R6Class("WPSInput", + inherit = OGCAbstractObject, + private = list( + xmlElement = "Input", + xmlNamespace = c(wps = "http://www.opengis.net/wps") + ), + public = list( + Identifier = NULL, + Data = NULL, + initialize = function(identifier, data) { + if(is(identifier, "character")){ + identifier <- OWSCodeType$new(value = identifier) + } + self$Identifier <- identifier + self$Data <- data + } + ) +) \ No newline at end of file diff --git a/R/WPSLiteralData.R b/R/WPSLiteralData.R new file mode 100644 index 0000000..1877419 --- /dev/null +++ b/R/WPSLiteralData.R @@ -0,0 +1,32 @@ +#' WPSLiteralData +#' +#' @docType class +#' @export +#' @keywords OGC WPS LiteralData +#' @return Object of \code{\link{R6Class}} for modelling a WPS Literal Data +#' @format \code{\link{R6Class}} object. +#' +#' @section Methods: +#' \describe{ +#' \item{\code{new(identifier, data)}}{ +#' This method is used to instantiate a WPSLiteralData object +#' } +#' } +#' +#' +#' @author Emmanuel Blondel +#' +WPSLiteralData <- R6Class("WPSLiteralData", + inherit = OGCAbstractObject, + private = list( + xmlElement = "LiteralData", + xmlNamespace = c(wps = "http://www.opengis.net/wps") + ), + public = list( + value = NULL, + wrap = TRUE, + initialize = function(value) { + self$value <- value + } + ) +) \ No newline at end of file diff --git a/R/WPSProcess.R b/R/WPSProcess.R index 88b2ef1..b2402e9 100644 --- a/R/WPSProcess.R +++ b/R/WPSProcess.R @@ -118,7 +118,24 @@ WPSProcess <- R6Class("WPSProcess", #execute execute = function(dataInputs, responseForm, language){ - stop("Not yet implemented") + op <- NULL + operations <- private$capabilities$getOperationsMetadata()$getOperations() + if(length(operations)>0){ + op <- operations[sapply(operations,function(x){x$getName()=="Execute"})] + if(length(op)>0){ + op <- op[[1]] + }else{ + stop("Operation 'Execute' not supported by this service") #control altough Execute request is mandatory for WPS + } + } + + client = private$capabilities$getClient() + processExecute <- WPSExecute$new(op = op, private$url, private$version, private$identifier, + dataInputs = dataInputs, responseForm = responseForm, language = language, + user = client$getUser(), pwd = client$getPwd(), token = client$getToken(), headers = client$getHeaders(), + logger = self$loggerType) + xmlObj <- processExecute$getResponse() + return(xmlObj) } ) ) \ No newline at end of file diff --git a/man/OWSCodeType.Rd b/man/OWSCodeType.Rd new file mode 100644 index 0000000..e241f06 --- /dev/null +++ b/man/OWSCodeType.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/OWSCodeType.R +\docType{class} +\name{OWSCodeType} +\alias{OWSCodeType} +\title{OWSCodeType} +\format{ +\code{\link{R6Class}} object. +} +\value{ +Object of \code{\link{R6Class}} for modelling an OWS CodeType +} +\description{ +OWSCodeType +} +\section{Methods}{ + +\describe{ + \item{\code{new(expr)}}{ + This method is used to instantiate an OWSCodeType object. The unique + argument should be an object of class \code{character} + } +} +} + +\author{ +Emmanuel Blondel +} +\keyword{CodeType} +\keyword{OWS} diff --git a/man/WPSClient.Rd b/man/WPSClient.Rd index 6b5d8f9..4525cdc 100644 --- a/man/WPSClient.Rd +++ b/man/WPSClient.Rd @@ -37,10 +37,10 @@ WPSClient case a the WPS client will request a process description (with more information about the process) for each process listed in the capabilities. } - \item{\code{describeProcess(processId)}}{ - Get the description of a process, given its \code{processId}, returning an object of class \code{WPSProcessDescription} + \item{\code{describeProcess(identifier)}}{ + Get the description of a process, given its \code{identifier}, returning an object of class \code{WPSProcessDescription} } - \item{\code{execute(processId, inputs, output)}}{ + \item{\code{execute(identifier, dataInputs, responseForm, language)}}{ Execute a process } } diff --git a/man/WPSExecute.Rd b/man/WPSExecute.Rd new file mode 100644 index 0000000..eb770de --- /dev/null +++ b/man/WPSExecute.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/WPSExecute.R +\docType{class} +\name{WPSExecute} +\alias{WPSExecute} +\title{WPSExecute} +\format{ +\code{\link{R6Class}} object. +} +\value{ +Object of \code{\link{R6Class}} for modelling a WPS Execute request +} +\description{ +WPSExecute +} +\note{ +Abstract class used by \pkg{ows4R} to trigger a WPS Execute request +} +\section{Methods}{ + +\describe{ + \item{\code{new(op, url, serviceVersion, identifier, logger, ...)}}{ + This method is used to instantiate a WPSExecute object + } +} +} + +\author{ +Emmanuel Blondel +} +\keyword{Execute} +\keyword{OGC} +\keyword{WPS} diff --git a/man/WPSInput.Rd b/man/WPSInput.Rd new file mode 100644 index 0000000..c8e55f4 --- /dev/null +++ b/man/WPSInput.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/WPSInput.R +\docType{class} +\name{WPSInput} +\alias{WPSInput} +\title{WPSInput} +\format{ +\code{\link{R6Class}} object. +} +\value{ +Object of \code{\link{R6Class}} for modelling a WPS Input +} +\description{ +WPSInput +} +\section{Methods}{ + +\describe{ + \item{\code{new(identifier, data)}}{ + This method is used to instantiate a WPSInput object + } +} +} + +\author{ +Emmanuel Blondel +} +\keyword{Input} +\keyword{OGC} +\keyword{WPS} diff --git a/man/WPSLiteralData.Rd b/man/WPSLiteralData.Rd new file mode 100644 index 0000000..a385efd --- /dev/null +++ b/man/WPSLiteralData.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/WPSLiteralData.R +\docType{class} +\name{WPSLiteralData} +\alias{WPSLiteralData} +\title{WPSLiteralData} +\format{ +\code{\link{R6Class}} object. +} +\value{ +Object of \code{\link{R6Class}} for modelling a WPS Literal Data +} +\description{ +WPSLiteralData +} +\section{Methods}{ + +\describe{ + \item{\code{new(identifier, data)}}{ + This method is used to instantiate a WPSLiteralData object + } +} +} + +\author{ +Emmanuel Blondel +} +\keyword{LiteralData} +\keyword{OGC} +\keyword{WPS}