Skip to content

Commit

Permalink
#3 CSW GetRecords integration tests
Browse files Browse the repository at this point in the history
  • Loading branch information
eblondel committed Jun 30, 2018
1 parent f3da80a commit 64825d8
Show file tree
Hide file tree
Showing 10 changed files with 99 additions and 55 deletions.
50 changes: 28 additions & 22 deletions R/CSWGetRecords.R
Original file line number Diff line number Diff line change
Expand Up @@ -133,17 +133,20 @@ CSWGetRecords <- R6Class("CSWGetRecords",
self$WARN(warnMsg)
self$WARN("Dublin Core returned as R lists...")
out <- private$response
if(query$ElementSetName == "full"){
out <- list()
recordsXML <- getNodeSet(private$response, "//csw:GetRecordsResponse/csw:SearchResults/csw:Record", private$xmlNamespace[1])
if(length(recordsXML)>0){
out <- lapply(recordsXML, function(recordXML){
children <- xmlChildren(recordXML)
out.obj <- lapply(children, xmlValue)
names(out.obj) <- names(children)
return(out.obj)
})
}
resultElement <- switch(query$ElementSetName,
"full" = "csw:Record",
"brief" = "csw:BriefRecord",
"summary" = "csw:SummaryRecord"
)
out <- list()
recordsXML <- getNodeSet(private$response,paste0("//csw:GetRecordsResponse/csw:SearchResults/",resultElement), private$xmlNamespace[1])
if(length(recordsXML)>0){
out <- lapply(recordsXML, function(recordXML){
children <- xmlChildren(recordXML)
out.obj <- lapply(children, xmlValue)
names(out.obj) <- names(children)
return(out.obj)
})
}
out
},
Expand All @@ -152,17 +155,20 @@ CSWGetRecords <- R6Class("CSWGetRecords",
self$WARN(warnMsg); warnings(warnMsg)
self$WARN("Dublin Core records returned as R lists...")
out <- private$response
if(query$ElementSetName == "full"){
out <- list()
recordsXML <- getNodeSet(private$response, "//csw:GetRecordsResponse/csw:SearchResults/csw:Record", private$xmlNamespace[1])
if(length(recordsXML)>0){
out <- lapply(recordsXML, function(recordXML){
children <- xmlChildren(recordXML)
out.obj <- lapply(children, xmlValue)
names(out.obj) <- names(children)
return(out.obj)
})
}
resultElement <- switch(query$ElementSetName,
"full" = "csw:Record",
"brief" = "csw:BriefRecord",
"summary" = "csw:SummaryRecord"
)
out <- list()
recordsXML <- getNodeSet(private$response,paste0("//csw:GetRecordsResponse/csw:SearchResults/",resultElement), private$xmlNamespace[1])
if(length(recordsXML)>0){
out <- lapply(recordsXML, function(recordXML){
children <- xmlChildren(recordXML)
out.obj <- lapply(children, xmlValue)
names(out.obj) <- names(children)
return(out.obj)
})
}
out
},
Expand Down
27 changes: 18 additions & 9 deletions R/OGCAbstractObject.R
Original file line number Diff line number Diff line change
Expand Up @@ -153,17 +153,26 @@ OGCAbstractObject <- R6Class("OGCAbstractObject",
rootXML$addNode(fieldObjXml)
}
}else if(is(fieldObj, "list")){
wrapperNode <- xmlOutputDOM(
tag = field,
nameSpace = names(private$xmlNamespace)[1]
)
for(item in fieldObj){
if(!is.null(item)){
nodeValueXml <- item$encode()
wrapperNode$addNode(as(nodeValueXml, "XMLInternalNode"))
if(self$wrap){
wrapperNode <- xmlOutputDOM(
tag = field,
nameSpace = names(private$xmlNamespace)[1]
)
for(item in fieldObj){
if(!is.null(item)){
nodeValueXml <- item$encode()
wrapperNode$addNode(as(nodeValueXml, "XMLInternalNode"))
}
}
rootXML$addNode(wrapperNode$value())
}else{
for(item in fieldObj){
if(!is.null(item)){
nodeValueXml <- item$encode()
rootXML$addNode(as(nodeValueXml, "XMLInternalNode"))
}
}
}
rootXML$addNode(wrapperNode$value())
}else{
wrapperNode <- xmlOutputDOM(tag = field, nameSpace = names(private$xmlNamespace)[1])
wrapperNode$addNode(xmlTextNode(fieldObj))
Expand Down
33 changes: 15 additions & 18 deletions R/OGCExpression.R
Original file line number Diff line number Diff line change
Expand Up @@ -306,18 +306,17 @@ BBox <- R6Class("BBox",
#' @format \code{\link{R6Class}} object.
#' @section Methods:
#' \describe{
#' \item{\code{new(binaryOperator, operations)}}{
#' \item{\code{new(...)}}{
#' This method is used to instantiate an BinaryLogicOpType
#' }
#' }
#' @note abstract super class of all the binary logical operation classes
BinaryLogicOpType <- R6Class("BinaryLogicOpType",
inherit = OGCExpression,
public = list(
binaryOperator = NULL,
operations = list(),
initialize = function(binaryOperator, operations){
self$binaryOperator = binaryOperator
initialize = function(...){
operations <- list(...)
if(length(operations)<2){
stop("Binary operations (And / Or) require a minimum of two operations")
}
Expand All @@ -334,16 +333,16 @@ BinaryLogicOpType <- R6Class("BinaryLogicOpType",
#' @format \code{\link{R6Class}} object.
#' @section Methods:
#' \describe{
#' \item{\code{new(operations)}}{
#' \item{\code{new(...)}}{
#' This method is used to instantiate an And operator
#' }
#' }
And <- R6Class("And",
inherit = BinaryLogicOpType,
private = list(xmlElement = "And"),
public = list(
initialize = function(operations){
super$initialize(private$xmlElement, operations)
initialize = function(...){
super$initialize(...)
}
)
)
Expand All @@ -356,16 +355,16 @@ And <- R6Class("And",
#' @format \code{\link{R6Class}} object.
#' @section Methods:
#' \describe{
#' \item{\code{new(operations)}}{
#' \item{\code{new(...)}}{
#' This method is used to instantiate an Or operator
#' }
#' }
Or <- R6Class("Or",
inherit = BinaryLogicOpType,
private = list(xmlElement = "Or"),
public = list(
initialize = function(operations){
super$initialize(private$xmlElement, operations)
initialize = function(...){
super$initialize(...)
}
)
)
Expand All @@ -380,19 +379,17 @@ Or <- R6Class("Or",
#' @format \code{\link{R6Class}} object.
#' @section Methods:
#' \describe{
#' \item{\code{new(binaryOperator, operations)}}{
#' \item{\code{new(...)}}{
#' This method is used to instantiate an UnaryLogicOpType
#' }
#' }
#' @note abstract super class of all the unary logical operation classes
UnaryLogicOpType <- R6Class("UnaryLogicOpType",
inherit = OGCExpression,
public = list(
unaryOperator = NULL,
operations = list(),
initialize = function(unaryOperator, operations){
self$unaryOperator = unaryOperator
self$operations = operations
initialize = function(...){
self$operations = list(...)
}
)
)
Expand All @@ -405,16 +402,16 @@ UnaryLogicOpType <- R6Class("UnaryLogicOpType",
#' @format \code{\link{R6Class}} object.
#' @section Methods:
#' \describe{
#' \item{\code{new(binaryOperator, operations)}}{
#' \item{\code{new(...)}}{
#' This method is used to instantiate an Not operator
#' }
#' }
Not <- R6Class("Not",
inherit = UnaryLogicOpType,
private = list(xmlElement = "Not"),
public = list(
initialize = function(operations){
super$initialize(private$xmlElement, operations)
initialize = function(...){
super$initialize(...)
}
)
)
2 changes: 1 addition & 1 deletion man/And.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/BinaryLogicOpType.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/CSWConstraint.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/Not.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/Or.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/UnaryLogicOpType.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

32 changes: 32 additions & 0 deletions tests/testthat/test_CSWClient.R
Original file line number Diff line number Diff line change
Expand Up @@ -167,6 +167,37 @@ test_that("CSW 2.0.2 - GetRecords - Filter / AnyText Equal"{
expect_equal(length(records), 0L)
})

test_that("CSW 2.0.2 - GetRecords - Filter / AnyText And Not"{
filter <- OGCFilter$new(And$new(
PropertyIsLike$new("csw:AnyText", "%lorem%"),
PropertyIsLike$new("csw:AnyText", "%ipsum%"),
Not$new(
PropertyIsLike$new("csw:AnyText", "%dolor%")
)
))
cons <- CSWConstraint$new(filter = filter)
query <- CSWQuery$new(constraint = cons)
records <- csw2$getRecords(query = query)
expect_equal(length(records), 1L)
})

test_that("CSW 2.0.2 - GetRecords - Filter / AnyText And nested Or"{
filter <- OGCFilter$new(And$new(
PropertyIsEqualTo$new("dc:title", "Aliquam fermentum purus quis arcu"),
PropertyIsEqualTo$new("dc:format", "application/pdf"),
Or$new(
PropertyIsEqualTo$new("dc:type", "http://purl.org/dc/dcmitype/Dataset"),
PropertyIsEqualTo$new("dc:type", "http://purl.org/dc/dcmitype/Service"),
PropertyIsEqualTo$new("dc:type", "http://purl.org/dc/dcmitype/Image"),
PropertyIsEqualTo$new("dc:type", "http://purl.org/dc/dcmitype/Text")
)
))
cons <- CSWConstraint$new(filter = filter)
query <- CSWQuery$new(elementSetName = "brief", constraint = cons)
records <- csw2$getRecords(query = query)
expect_equal(length(records), 1L)
})

#CSW 2.0.2 – GetRecords / gmd:MD_Metadata (ISO 19115/19319 - R geometa binding)
#--------------------------------------------------------------------------

Expand All @@ -175,6 +206,7 @@ test_that("CSW 2.0.2 - GetRecords - cqlText / dc:identifier"{
query <- CSWQuery$new(constraint = cons)
records <- csw2$getRecords(query = query, outputSchema = "http://www.isotc211.org/2005/gmd")
expect_equal(length(records), 1L)
expect_is(records[[1]], "ISOMetadata")
})

#CSW 3.0
Expand Down

0 comments on commit 64825d8

Please sign in to comment.