diff --git a/R/CSWGetRecords.R b/R/CSWGetRecords.R index 71e49b1..b887e94 100644 --- a/R/CSWGetRecords.R +++ b/R/CSWGetRecords.R @@ -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 }, @@ -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 }, diff --git a/R/OGCAbstractObject.R b/R/OGCAbstractObject.R index 02824ef..6d4e782 100644 --- a/R/OGCAbstractObject.R +++ b/R/OGCAbstractObject.R @@ -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)) diff --git a/R/OGCExpression.R b/R/OGCExpression.R index f0da5d1..48ea114 100644 --- a/R/OGCExpression.R +++ b/R/OGCExpression.R @@ -306,7 +306,7 @@ 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 #' } #' } @@ -314,10 +314,9 @@ BBox <- R6Class("BBox", 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") } @@ -334,7 +333,7 @@ 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 #' } #' } @@ -342,8 +341,8 @@ And <- R6Class("And", inherit = BinaryLogicOpType, private = list(xmlElement = "And"), public = list( - initialize = function(operations){ - super$initialize(private$xmlElement, operations) + initialize = function(...){ + super$initialize(...) } ) ) @@ -356,7 +355,7 @@ 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 #' } #' } @@ -364,8 +363,8 @@ Or <- R6Class("Or", inherit = BinaryLogicOpType, private = list(xmlElement = "Or"), public = list( - initialize = function(operations){ - super$initialize(private$xmlElement, operations) + initialize = function(...){ + super$initialize(...) } ) ) @@ -380,7 +379,7 @@ 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 #' } #' } @@ -388,11 +387,9 @@ Or <- R6Class("Or", 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(...) } ) ) @@ -405,7 +402,7 @@ 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 #' } #' } @@ -413,8 +410,8 @@ Not <- R6Class("Not", inherit = UnaryLogicOpType, private = list(xmlElement = "Not"), public = list( - initialize = function(operations){ - super$initialize(private$xmlElement, operations) + initialize = function(...){ + super$initialize(...) } ) ) diff --git a/man/And.Rd b/man/And.Rd index 827d2cf..e73e12b 100644 --- a/man/And.Rd +++ b/man/And.Rd @@ -17,7 +17,7 @@ And \section{Methods}{ \describe{ - \item{\code{new(operations)}}{ + \item{\code{new(...)}}{ This method is used to instantiate an And operator } } diff --git a/man/BinaryLogicOpType.Rd b/man/BinaryLogicOpType.Rd index e8180ef..9a87707 100644 --- a/man/BinaryLogicOpType.Rd +++ b/man/BinaryLogicOpType.Rd @@ -20,7 +20,7 @@ abstract super class of all the binary logical operation classes \section{Methods}{ \describe{ - \item{\code{new(binaryOperator, operations)}}{ + \item{\code{new(...)}}{ This method is used to instantiate an BinaryLogicOpType } } diff --git a/man/CSWConstraint.Rd b/man/CSWConstraint.Rd index 5f6f533..8f08a3d 100644 --- a/man/CSWConstraint.Rd +++ b/man/CSWConstraint.Rd @@ -17,7 +17,7 @@ CSWConstraint \section{Methods}{ \describe{ - \item{\code{new(filter, cswVersion)}}{ + \item{\code{new(cqlText, filter, cswVersion)}}{ This method is used to instantiate an CSWConstraint object. } } diff --git a/man/Not.Rd b/man/Not.Rd index 646fbc1..57b0b69 100644 --- a/man/Not.Rd +++ b/man/Not.Rd @@ -17,7 +17,7 @@ Not \section{Methods}{ \describe{ - \item{\code{new(binaryOperator, operations)}}{ + \item{\code{new(...)}}{ This method is used to instantiate an Not operator } } diff --git a/man/Or.Rd b/man/Or.Rd index 69252b2..0e1f073 100644 --- a/man/Or.Rd +++ b/man/Or.Rd @@ -17,7 +17,7 @@ Or \section{Methods}{ \describe{ - \item{\code{new(operations)}}{ + \item{\code{new(...)}}{ This method is used to instantiate an Or operator } } diff --git a/man/UnaryLogicOpType.Rd b/man/UnaryLogicOpType.Rd index 6729a2b..9bba196 100644 --- a/man/UnaryLogicOpType.Rd +++ b/man/UnaryLogicOpType.Rd @@ -20,7 +20,7 @@ abstract super class of all the unary logical operation classes \section{Methods}{ \describe{ - \item{\code{new(binaryOperator, operations)}}{ + \item{\code{new(...)}}{ This method is used to instantiate an UnaryLogicOpType } } diff --git a/tests/testthat/test_CSWClient.R b/tests/testthat/test_CSWClient.R index 5a86367..180d365 100644 --- a/tests/testthat/test_CSWClient.R +++ b/tests/testthat/test_CSWClient.R @@ -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) #-------------------------------------------------------------------------- @@ -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