#10 more on wps

NAMESPACE

@@ -51,7 +51,13 @@ export(WMSGetFeatureInfo)
 export(WMSLayer)
 export(WPSCapabilities)
 export(WPSClient)
+export(WPSComplexInputDescription)
 export(WPSDescribeProcess)
+export(WPSDescriptionParameter)
+export(WPSFormat)
+export(WPSInputDescription)
+export(WPSLiteralInputDescription)
+export(WPSParameter)
 export(WPSProcess)
 export(WPSProcessDescription)
 import(XML)

R/WPSComplexInputDescription.R

@@ -0,0 +1,28 @@
+#' WPSComplexInputDescription
+#'
+#' @docType class
+#' @export
+#' @keywords OGC WPS Process complex input description
+#' @return Object of \code{\link{R6Class}} modelling a WPS process complex input description
+#' @format \code{\link{R6Class}} object.
+#'
+#' @section Methods:
+#' \describe{
+#'  \item{\code{new(xmlObj, version, logger)}}{
+#'    This method is used to instantiate a \code{WPSComplexInputDescription} object
+#'  }
+#' }
+#' 
+#' @note Class used internally by \pkg{ows4R}
+#' 
+#' @author Emmanuel Blondel <emmanuel.blondel1@@gmail.com>
+#'
+WPSComplexInputDescription <- R6Class("WPSComplexInputDescription",
+  inherit = WPSInputDescription,                       
+  private = list(),
+  public = list(
+    initialize = function(xmlObj = NULL, version, logger = NULL, ...){
+      super$initialize(xmlObj = xmlObj, version = version, logger = logger, ...)
+    }
+  )
+)

R/WPSDescriptionParameter.R

@@ -0,0 +1,73 @@
+#' WPSDescriptionParameter
+#'
+#' @docType class
+#' @export
+#' @keywords OGC WPS Process input description parameter
+#' @return Object of \code{\link{R6Class}} modelling a WPS process input description parameter
+#' @format \code{\link{R6Class}} object.
+#'
+#' @section Methods:
+#' \describe{
+#'  \item{\code{new(xmlObj, version, logger)}}{
+#'    This method is used to instantiate a \code{WPSDescriptionParameter} object
+#'  }
+#'  \item{\code{getFormats()}}{
+#'    Get formats
+#'  }
+#' }
+#' 
+#' @note Class used internally by \pkg{ows4R}
+#' 
+#' @author Emmanuel Blondel <emmanuel.blondel1@@gmail.com>
+#'
+WPSDescriptionParameter <- R6Class("WPSDescriptionParameter",
+   inherit = WPSParameter,                       
+   private = list(
+
+     formats = list(),
+
+     #fetchFormats
+     fetchFormats = function(xmlObj, version){
+
+       children <- xmlChildren(xmlObj)
+       dataElement <- names(children)[endsWith(names(children), "Data")][1]
+       children <- xmlChildren(children[[dataElement]])
+
+       formats <- list()
+       if(version == "1.0.0"){
+         if("Default" %in% names(children)){
+           defaultFormat <- WPSFormat$new(xmlObj = xmlChildren(children$Default)$Format, version = version)
+           defaultFormat$setIsDefault(TRUE)
+           formats <- c(formats, defaultFormat)
+         }
+         if("Supported" %in% names(children)){
+           supportedFormats <- lapply(xmlChildren(children$Supported), WPSFormat$new, version = version)
+           formats <- c(formats, supportedFormats)
+         }
+         names(formats) <- NULL
+
+       }else if(version == "2.0"){
+         formatsXML <- children[names(children) == "Format"]
+         formats <- lapply(formatsXML, lapply(formatsXML, WPSFormat$new, version = version))
+         names(formats) <- NULL
+       }
+       return(formats)
+     }
+
+   ),
+   public = list(
+     initialize = function(xmlObj = NULL, version, logger = NULL, ...){
+       super$initialize(xmlObj = xmlObj, version = version, logger = logger, ...)
+       private$version = version
+       if(!is.null(xmlObj)){
+         private$formats = private$fetchFormats(xmlObj, version)
+       }
+     },
+
+     #getFormats
+     getFormats = function(){
+       return(private$formats)
+     }
+
+   )
+)

R/WPSFormat.R

@@ -0,0 +1,106 @@
+#' WPSFormat
+#'
+#' @docType class
+#' @export
+#' @keywords OGC WPS Process input description
+#' @return Object of \code{\link{R6Class}} modelling a WPS process input description
+#' @format \code{\link{R6Class}} object.
+#'
+#' @section Methods:
+#' \describe{
+#'  \item{\code{new(xmlObj, version, logger)}}{
+#'    This method is used to instantiate a \code{WPSFormat} object
+#'  }
+#'  \item{\code{getMimeType()}}{
+#'    Get mimetype
+#'  }
+#'  \item{\code{getEncoding()}}{
+#'    Get encoding
+#'  }
+#'  \ìtem{\code{getSchema()}}{
+#'    Get schema
+#'  }
+#'  \item{\code{setIsDefault(default)}}{
+#'    Set if default format or not
+#'  }
+#'  \item{\code{isDefault()}}{
+#'    Is default format?
+#'  }
+#' }
+#' 
+#' @note Class used internally by \pkg{ows4R}
+#' 
+#' @author Emmanuel Blondel <emmanuel.blondel1@@gmail.com>
+#'
+WPSFormat <- R6Class("WPSFormat",
+   inherit = OGCAbstractObject,                       
+   private = list(
+     version = NA,
+     mimeType = NA,
+     encoding = NA,
+     schema = NA,
+     default = FALSE,
+
+     #fetchFormat
+     fetchFormat = function(xmlObj, version){
+
+       format <- NULL
+       if(version == "1.0.0"){
+         children <- xmlChildren(xmlObj)
+         format = list(
+           mimeType = if(!is.null(children$MimeType)) xmlValue(children$MimeType) else NA,
+           encoding = if(!is.null(children$Encoding)) xmlValue(children$Encoding) else NA,
+           schema = if(!is.null(children$Schema)) xmlValue(children$Schema) else NA
+         ) 
+       }else if(version == "2.0"){
+         format = list(
+           mimeType = xmlGetAttr(xmlObj, "mimeType"),
+           encoding = xmlGetAttr(xmlObj, "encoding"),
+           schema = xmlGetAttr(xmlObj, "schema"),
+           default = xmlGetAttr(xmlObj, "default") == "true"
+         )
+       }
+       return(format)
+     }
+
+   ),
+   public = list(
+     initialize = function(xmlObj = NULL, version, logger = NULL, ...){
+       super$initialize(logger = logger)
+       private$version = version
+       if(!is.null(xmlObj)){
+         format = private$fetchFormat(xmlObj, version)
+         private$mimeType = format$mimeType
+         private$encoding = format$encoding
+         private$schema = format$schema
+         private$default = format$default
+       }
+     },
+
+     #getMimeType
+     getMimeType = function(){
+       return(private$mimeType)
+     },
+
+     #getEncoding
+     getEncoding = function(){
+       return(private$encoding)
+     },
+
+     #getSchema
+     getSchema = function(){
+       return(private$schema)
+     },
+
+     #setIsDefault
+     setIsDefault = function(default){
+       private$default = default
+     },
+
+     #isDefault
+     isDefault = function(){
+       return(private$default)
+     }
+
+   )
+)

R/WPSInputDescription.R

@@ -0,0 +1,78 @@
+#' WPSInputDescription
+#'
+#' @docType class
+#' @export
+#' @keywords OGC WPS Process input description
+#' @return Object of \code{\link{R6Class}} modelling a WPS process input description
+#' @format \code{\link{R6Class}} object.
+#'
+#' @section Methods:
+#' \describe{
+#'  \item{\code{new(xmlObj, capabilities, version, logger)}}{
+#'    This method is used to instantiate a \code{WPSInputDescription} object
+#'  }
+#'  \item{\code{getMinOccurs()}}{
+#'    Get input min occurs
+#'  }
+#'  \item{\code{getMaxOccurs()}}{
+#'    Get input max occurs
+#'  }
+#' }
+#' 
+#' @note Class used internally by \pkg{ows4R}
+#' 
+#' @author Emmanuel Blondel <emmanuel.blondel1@@gmail.com>
+#'
+WPSInputDescription <- R6Class("WPSInputDescription",
+   inherit = WPSDescriptionParameter,                       
+   private = list(
+     minOccurs = NA,
+     maxOccurs = NA,
+
+     #fetchInputDescription
+     fetchInputDescription = function(xmlObj, version){
+
+       inputDescription <- list(
+         minOccurs = xmlGetAttr(xmlObj, "minOccurs"),
+         maxOccurs = xmlGetAttr(xmlObj, "maxOccurs")
+       )
+
+       return(inputDescription)
+     }
+
+   ),
+   public = list(
+     initialize = function(xmlObj = NULL, version, logger = NULL, ...){
+       super$initialize(xmlObj = xmlObj, version = version, logger = logger, ...)
+       private$version = version
+       if(!is.null(xmlObj)){
+          inputDescription = private$fetchInputDescription(xmlObj, version)
+          private$minOccurs = inputDescription$minOccurs
+          private$maxOccurs = inputDescription$maxOccurs
+       }
+     },
+
+     #getMinOccurs
+     getMinOccurs = function(){
+       return(private$minOccurs)
+     },
+
+     #getMaxOccurs
+     getMaxOccurs = function(){
+       return(private$maxOccurs)
+     },
+
+     #asDataFrame
+     asDataFrame = function(){
+       return(data.frame(
+         identifier = self$getIdentifier(),
+         title = self$getTitle(),
+         abstract = self$getAbstract(),
+         minOccurs = self$getMinOccurs(),
+         maxOccurs = self$getMaxOccurs(),
+         stringsAsFactors = FALSE
+       ))
+     }
+
+   )
+)

R/WPSLiteralInputDescription.R

@@ -0,0 +1,80 @@
+#' WPSLiteralInputDescription
+#'
+#' @docType class
+#' @export
+#' @keywords OGC WPS Process input description
+#' @return Object of \code{\link{R6Class}} modelling a WPS process input description
+#' @format \code{\link{R6Class}} object.
+#'
+#' @section Methods:
+#' \describe{
+#'  \item{\code{new(xmlObj, version, logger)}}{
+#'    This method is used to instantiate a \code{WPSLiteralInputDescription} object
+#'  }
+#'  \item{\code{getDataType()}}{
+#'    Get data type
+#'  }
+#'  \item{\code{getDefaultValue()}}{
+#'    Get default value
+#'  }
+#'  \item{\code{getAllowedValues()}}{
+#'    Get allowed values
+#'  }
+#' }
+#' 
+#' @note Class used internally by \pkg{ows4R}
+#' 
+#' @author Emmanuel Blondel <emmanuel.blondel1@@gmail.com>
+#'
+WPSLiteralInputDescription <- R6Class("WPSLiteralInputDescription",
+   inherit = WPSInputDescription,                       
+   private = list(
+     dataType = NA,
+     defaultValue = NA,
+     allowedValues = c(),
+     anyValue = FALSE, #NOT IMPLEMENTED
+     uoms = list(), #NOT IMPLEMENTED
+
+     #fetchLiteralInput
+     fetchLiteralInput = function(xmlObj, version){
+
+       children <- xmlChildren(xmlChildren(xmlObj)$LiteralData)
+
+       literalInput <- list(
+         dataType = xmlGetAttr(children$DataType, "ows:reference"),
+         defaultValue = xmlValue(children$DefaultValue),
+         allowedValues = sapply(xmlChildren(children$AllowedValues), xmlValue)
+       )
+
+       return(literalInput)
+     }
+
+   ),
+   public = list(
+     initialize = function(xmlObj = NULL, version, logger = NULL, ...){
+       super$initialize(xmlObj = xmlObj, version = version, logger = logger, ...)
+       private$version = version
+       if(!is.null(xmlObj)){
+         literalInput = private$fetchLiteralInput(xmlObj, version)
+         private$dataType = literalInput$dataType
+         private$defaultValue = literalInput$defaultValue
+         private$allowedValues = literalInput$allowedValues
+       }
+     },
+
+     #getDataType
+     getDataType = function(){
+       return(private$dataType)
+     },
+
+     #getDefaultValue
+     getDefaultValue = function(){
+       return(private$defaultValue)
+     },
+
+     #getAllowedValues
+     getAllowedValues = function(){
+       return(private$allowedValues)
+     }
+   )
+)