#10 work on execute

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)

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())
+            }
           }
         }
       }

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 <emmanuel.blondel1@@gmail.com>
+#' 
+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
+      }
+    }
+  )
+)

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))
      }
 
    )

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 <emmanuel.blondel1@@gmail.com>
+#'
+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()
+    }
+  )
+)

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 <emmanuel.blondel1@@gmail.com>
+#'
+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
+    }
+  )
+)

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 <emmanuel.blondel1@@gmail.com>
+#'
+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
+    }
+  )
+)

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)
     }
   )
 )