Skip to content

Commit

Permalink
#2 moving to OGC simple feature "sf"
Browse files Browse the repository at this point in the history
  • Loading branch information
eblondel committed Feb 16, 2018
1 parent 3a966fb commit 1a96967
Show file tree
Hide file tree
Showing 8 changed files with 40 additions and 37 deletions.
11 changes: 11 additions & 0 deletions .travis.yml
Original file line number Diff line number Diff line change
Expand Up @@ -3,10 +3,19 @@ language: R
sudo: required
cache: packages

apt_packages:
- libxml2-dev

services:
- docker

before_install:
# mainly for installing sf (which requires units/rgeos/rgdal)
- sudo add-apt-repository ppa:ubuntugis/ubuntugis-unstable --yes
- sudo apt-get --yes --force-yes update -qq
- sudo apt-get install --yes libudunits2-dev libproj-dev libgeos-dev libgdal-dev
- Rscript -e 'update.packages(ask = FALSE)'
# docker images for integration tests
- docker pull kartoza/postgis
- docker run -d --name="postgis" kartoza/postgis
- docker pull oscarfonts/geoserver
Expand All @@ -18,12 +27,14 @@ r:
- devel

r_binary_packages:
- devtools
- rgdal

r_packages:
- R6
- httr
- XML
- sf
- testthat
- covr

Expand Down
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@ Authors@R: c(person("Emmanuel", "Blondel", role = c("aut", "cre"), email = "emma
person("Norbert", "Billet", role = c("ctb")))
Maintainer: Emmanuel Blondel <emmanuel.blondel1@gmail.com>
Depends: R (>= 2.15)
Imports: R6, httr, XML (>= 3.96-1.1), sp, rgdal
Imports: R6, httr, XML (>= 3.96-1.1), sf, rgdal
Suggests: testthat
Description: Provides an interface to OGC Web-Services (OWS). In a first step, the package supports the Common
OGC Web-Services specifications the Web Feature Service (WFS). ows4R will progressively support other OGC web
Expand Down
2 changes: 1 addition & 1 deletion NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -14,5 +14,5 @@ export(WFSGetFeature)
import(XML)
import(httr)
import(rgdal)
import(sp)
import(sf)
importFrom(R6,R6Class)
2 changes: 1 addition & 1 deletion R/OWSClient.R
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@
#' @importFrom R6 R6Class
#' @import httr
#' @import XML
#' @import sp
#' @import sf
#' @import rgdal
#' @export
#' @keywords OGC Common OWS
Expand Down
2 changes: 1 addition & 1 deletion R/OWSUtils.R
Original file line number Diff line number Diff line change
Expand Up @@ -119,7 +119,7 @@ OWSUtilsInternal <- R6Class("OWSUtilsInternal",
srsDef <- NA
}
}
return(CRS(srsDef))
return(st_crs(srsDef))
},

#toEPSG
Expand Down
30 changes: 8 additions & 22 deletions R/WFSFeatureType.R
Original file line number Diff line number Diff line change
Expand Up @@ -146,8 +146,9 @@ WFSFeatureType <- R6Class("WFSFeatureType",
return(ftDescription);
},

#fetchFeatures-
#fetchFeatures
fetchFeatures = function(){

description <- self$getDescription()
ftFeatures <- WFSGetFeature$new(private$url, private$version, private$name)
xmlObj <- ftFeatures$getRequest()$response
Expand All @@ -157,27 +158,19 @@ WFSFeatureType <- R6Class("WFSFeatureType",
destfile = paste(tempf,".gml",sep='')
saveXML(xmlObj, destfile)

#download.file(wfsRequest, destfile, mode="wb")
layername <- ogrListLayers(destfile)
if (length(layername) != 1) {
stop("Error with layers in the input dataset")
}

#hasGeometry?
hasGeometry = FALSE
for(element in description$getContent()){
if(element$getType() == "Spatial"){
if(element$getType() == "geometry"){
hasGeometry = TRUE
break
}
}

#ftFeatures
if(hasGeometry){
srs <- CRSargs(self$getDefaultCRS())
ftFeatures = readOGR(destfile, layername, p4s = srs, disambiguateFIDs = TRUE)
ftFeatures <- spChFIDs(ftFeatures, as.character(ftFeatures@data[,private$gmlIdAttributeName]))

ftFeatures <- sf::st_read(destfile, quiet = TRUE)
st_crs(ftFeatures) <- self$getDefaultCRS()
}else{
if(private$version == "1.0.0"){
membersContent <- sapply(getNodeSet(xmlObj, "//gml:featureMember"), function(x) xmlChildren(x))
Expand All @@ -202,24 +195,17 @@ WFSFeatureType <- R6Class("WFSFeatureType",
nodes = getNodeSet(xmlObj, "//wfs:member/*[@*]"),
stringsAsFactors = FALSE
)

}

ftFeatures <- cbind(fid, membersAttributes, stringsAsFactors = FALSE)
}

#validating attributes
#validating attributes vs. schema
for(element in description$getContent()){
attrType <- element$getType()
if(!is.null(attrType) && attrType != "Spatial"){
if(!is.null(attrType) && attrType != "geometry"){
attrName = element$getName()
if(hasGeometry){
ftFeatures@data[,attrName] <- as(ftFeatures@data[,attrName],
element$getType())
}else{
ftFeatures[,attrName] <- as(ftFeatures[,attrName],
element$getType())
}
ftFeatures[[attrName]] <- as(ftFeatures[[attrName]],attrType)
}
}
return(ftFeatures);
Expand Down
19 changes: 11 additions & 8 deletions R/WFSFeatureTypeElement.R
Original file line number Diff line number Diff line change
Expand Up @@ -54,14 +54,17 @@ WFSFeatureTypeElement <- R6Class("WFSFeatureTypeElement",
#type
elementType <- NULL
type <- xmlGetAttr(xmlObj, "type")
if(attr(regexpr("gml", type),
"match.length") > 0) elementType <- "Spatial"
if(type == "xsd:string") elementType <- "character"
if(type == "xsd:int") elementType <- "integer"
if(type == "xsd:decimal") elementType <- "double"
if(type == "xsd:boolean") elementType <- "logical"
if(type == "xsd:date") elementType <- "character" #TODO
if(type == "xsd:dateTime") elementType <- "character" #TODO
elementType <- switch(type,
"xsd:string" = "character",
"xsd:long" = "numeric",
"xsd:int" = "integer",
"xsd:decimal" = "double",
"xsd:boolean" = "logical",
"xsd:date" = "character", #TODO
"xsd:datetime" = "character", #TODO
NULL
)
if(attr(regexpr("gml", type), "match.length") > 0) elementType <- "geometry"

element <- list(
minOccurs = elementMinOccurs,
Expand Down
9 changes: 6 additions & 3 deletions tests/testthat/test_WFSClient.R
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,8 @@ test_that("WFS 1.0.0",{
ft <- caps$findFeatureTypeByName("topp:tasmania_water_bodies", exact = TRUE)
expect_is(ft, "WFSFeatureType")
ft.sp <- ft$getFeatures()
expect_is(ft.sp, "SpatialPolygonsDataFrame")
expect_is(ft.sp, "sf")
expect_is(ft.sp, "data.frame")
})

test_that("WFS 1.1.0",{
Expand All @@ -26,7 +27,8 @@ test_that("WFS 1.1.0",{
ft <- caps$findFeatureTypeByName("topp:tasmania_water_bodies", exact = TRUE)
expect_is(ft, "WFSFeatureType")
ft.sp <- ft$getFeatures()
expect_is(ft.sp, "SpatialPolygonsDataFrame")
expect_is(ft.sp, "sf")
expect_is(ft.sp, "data.frame")
})

test_that("WFS 2.0.0",{
Expand All @@ -37,5 +39,6 @@ test_that("WFS 2.0.0",{
ft <- caps$findFeatureTypeByName("topp:tasmania_water_bodies", exact = TRUE)
expect_is(ft, "WFSFeatureType")
ft.sp <- ft$getFeatures()
expect_is(ft.sp, "SpatialPolygonsDataFrame")
expect_is(ft.sp, "sf")
expect_is(ft.sp, "data.frame")
})

0 comments on commit 1a96967

Please sign in to comment.