Merge pull request #337 from wdwatkins/geojob2webdata

deal with namespaces, XMLs with no start/end time
DOI-USGS · Apr 20, 2017 · ea70886 · ea70886
2 parents 9c342ea + 8aef35c
commit ea70886
Show file tree

Hide file tree

Showing 8 changed files with 35 additions and 14 deletions.
diff --git a/R/01-webdata-obj.R b/R/01-webdata-obj.R
@@ -8,6 +8,13 @@ pkg.env$gconfig <- list('wps.url'='https://cida.usgs.gov/gdp/process/WebProcessi
                         'verbose' = FALSE,
                         'retries' = 1,
                         'version' = '1.0.0')
+pkg.env$NAMESPACES <- c(wps = 'http://www.opengis.net/wps/1.0.0',
+                        xsi = 'http://www.w3.org/2001/XMLSchema-instance',
+                        xlink = 'http://www.w3.org/1999/xlink',
+                        ogc = 'http://www.opengis.net/ogc',
+                        ows = 'http://www.opengis.net/ows/1.1',
+                        gml = 'http://www.opengis.net/gml',
+                        wfs = 'http://www.opengis.net/wfs')
 
 #' @importFrom utils lsf.str packageName
 .onLoad <- function(libname, pkgname){
@@ -108,7 +115,11 @@ setMethod("webdata", signature("character"), function(.Object=c("prism",  "iclus
 setMethod("webdata", signature("geojob"), function(.Object, ...) {
   xmlVals <- inputs(xmlParse(xml(.Object)))
   url <- xmlVals[["DATASET_URI"]]
-  times <- c(xmlVals[["TIME_START"]], xmlVals[["TIME_END"]])
+  times <- c(start = xmlVals[["TIME_START"]], end = xmlVals[["TIME_END"]])
+  if(is.null(times[['start']])) {times[['start']] <- NA}
+  if(length(times) == 1) {times[['end']] <- NA}
+  times <- as.POSIXct(c(times[['start']], times[['end']])) #could get out of order with one missing
+
   variables <- xmlVals[names(xmlVals) %in% c("OBSERVED_PROPERTY", "DATASET_ID")]
   webdata <- webdata(url = url, times = times, 
                         variables = unlist(variables), ...)

diff --git a/R/02-webgeom-obj.R b/R/02-webgeom-obj.R
@@ -56,8 +56,8 @@ setMethod("initialize", signature = "webgeom",
             .Object@geom = geom
             .Object@attribute = attribute
             .Object@version = version
-            .Object@GML_NAMESPACE = 'http://www.opengis.net/gml'
-            .Object@WFS_NAMESPACE   = 'http://www.opengis.net/wfs'
+            .Object@GML_NAMESPACE = pkg.env$NAMESPACES[['gml']]
+            .Object@WFS_NAMESPACE   = pkg.env$NAMESPACES[['wfs']]
             .Object@GML_SCHEMA_LOCATION = 'http://schemas.opengis.net/gml/3.1.1/base/feature.xsd'
 
             values(.Object) = values

diff --git a/R/04-webprocess-obj.R b/R/04-webprocess-obj.R
@@ -32,12 +32,12 @@ setClass(
   prototype = prototype(
     version = gconfig('version'),
     WPS_SCHEMA_LOCATION = 'http://schemas.opengis.net/wps/1.0.0/wpsExecute_request.xsd',
-    WPS_NAMESPACE = 'http://www.opengis.net/wps/1.0.0',
+    WPS_NAMESPACE = pkg.env$NAMESPACES[['wps']],
     XSI_SCHEMA_LOCATION = 'http://www.opengis.net/wfs ../wfs/1.1.0/WFS.xsd',
-    XSI_NAMESPACE = 'http://www.w3.org/2001/XMLSchema-instance',
-    OGC_NAMESPACE = 'http://www.opengis.net/ogc',
-    XLINK_NAMESPACE = 'http://www.w3.org/1999/xlink',
-    OWS_NAMESPACE = 'http://www.opengis.net/ows/1.1',
+    XSI_NAMESPACE = pkg.env$NAMESPACES[['xsi']],
+    OGC_NAMESPACE = pkg.env$NAMESPACES[['ogc']],
+    XLINK_NAMESPACE = pkg.env$NAMESPACES[['xlink']],
+    OWS_NAMESPACE = pkg.env$NAMESPACES[['ows']],
     emailK = 'gov.usgs.cida.gdp.wps.algorithm.communication.EmailWhenFinishedAlgorithm'
   ),
   representation = representation(

diff --git a/R/algorithm-webprocess.R b/R/algorithm-webprocess.R
@@ -49,7 +49,7 @@ setMethod(f = "algorithm",signature="XMLAbstractDocument",
           definition = function(.Object){
             xpath <- "//wps:Execute/ows:Identifier"
 
-            algo <- getNodeSet(.Object, xpath)
+            algo <- getNodeSet(.Object, xpath, namespaces = pkg.env$NAMESPACES)
             if (length(algo) != 1) {
               stop("Invalid XML, algorithm must be defined (or only once)")
             }

diff --git a/R/algorithmVersion-webprocess.R b/R/algorithmVersion-webprocess.R
@@ -4,6 +4,7 @@ algorithmVersion <- function(knife){
     'service' = 'WPS', 'version' = version(knife),'request' = 'DescribeProcess', 'identifier'=algorithm(knife)[[1]]))
   doc <- gcontent(getCaps)
 
-  version <- xmlAttrs(getNodeSet(doc,'//ProcessDescription')[[1]])[['processVersion']]
+  version <- xmlAttrs(getNodeSet(doc,'//ProcessDescription', 
+                                 namespaces = pkg.env$NAMESPACES)[[1]])[['processVersion']]
   return(version)
 }
diff --git a/R/geoknife-generic.R b/R/geoknife-generic.R
@@ -99,10 +99,12 @@ parseXMLalgorithms  <-  function(xml){
   childKey <- "ows:Identifier"
   titleKey <- "ows:Title"
 
-  nodes <- getNodeSet(xml, sprintf("//%s/%s",parentKey,childKey))
+  nodes <- getNodeSet(xml, sprintf("//%s/%s",parentKey,childKey), 
+                      namespaces = pkg.env$NAMESPACES)
   values  <-  lapply(nodes,xmlValue)
 
-  nodes <- getNodeSet(xml, sprintf("//%s/%s",parentKey,titleKey))
+  nodes <- getNodeSet(xml, sprintf("//%s/%s",parentKey,titleKey),
+                      namespaces = pkg.env$NAMESPACES)
   names(values) <- sapply(nodes,xmlValue)
 
   return(values)
@@ -116,7 +118,7 @@ parseXMLgeoms	<-	function(xml){
   key="Name"
   # ignore namespaces
   xpath <- sprintf("//*[local-name()='%s']/*[local-name()='%s']/*[local-name()='%s']",parentKey,childKey,key)
-  nodes <- getNodeSet(xml, xpath)
+  nodes <- getNodeSet(xml, xpath, namespaces = pkg.env$NAMESPACES)
 	values	<-	sapply(nodes,xmlValue)
 	return(values)
 }

diff --git a/R/inputs-webprocess.R b/R/inputs-webprocess.R
@@ -57,7 +57,7 @@ setMethod(f = "inputs",signature = "XMLAbstractDocument",
           definition = function(.Object, ...){
             inputXpath <- "//wps:Execute/wps:DataInputs/wps:Input"
 
-            inputs <- getNodeSet(.Object, inputXpath)
+            inputs <- getNodeSet(.Object, inputXpath, namespaces = pkg.env$NAMESPACES)
             results <- list()
             names <- c()
             for (i in 1:length(inputs)) {

diff --git a/tests/testthat/test-webdata_object.R b/tests/testthat/test-webdata_object.R
@@ -18,6 +18,13 @@ test_that("create webdata from geojob", {
   expect_is(url(wd), "character")
   expect_is(variables(wd), "character")
   expect_gt(length(variables(wd)), 0)
+
+  #test XML missing time slots
+  testthat::skip_on_cran()
+  noTimesJob <- geojob('https://cida.usgs.gov/gdp/process/request?id=b327be82-8bd5-4a7e-8fda-4288c1a6ef3d')
+  wd <- webdata(noTimesJob)
+  expect_equal(length(times(wd)), 2)
+  expect_is(times(wd), "POSIXct")
 })
 
 context("Test getting fields of webdata object")