diff --git a/.travis.yml b/.travis.yml index 421d0fd..958fafe 100644 --- a/.travis.yml +++ b/.travis.yml @@ -18,7 +18,7 @@ before_install: # docker images for integration tests # --> pycsw - docker pull geopython/pycsw:2.2.0 - - docker run --name pycsw --publish 8000:8000 --detach geopython/pycsw + - docker run --name pycsw -v /inst/extdata/pycsw/pycsw.cfg:/etc/pycsw/pycsw.cfg --publish 8000:8000 geopython/pycsw # --> GeoNetwork - docker pull kartoza/postgis - docker run -d --name="postgis" kartoza/postgis diff --git a/R/CSWClient.R b/R/CSWClient.R index a0e1595..46c7cc1 100644 --- a/R/CSWClient.R +++ b/R/CSWClient.R @@ -97,6 +97,64 @@ CSWClient <- R6Class("CSWClient", request <- CSWGetRecords$new(op, self$getUrl(), self$getVersion(), constraint = constraint, logger = self$loggerType, ...) return(request$response) + }, + + #transaction + transaction = function(type, record, constraint = NULL, ...){ + self$INFO(sprintf("Transaction (%s) ...", type)) + operations <- self$capabilities$getOperationsMetadata()$getOperations() + op <- operations[sapply(operations,function(x){x$getName()=="Transaction"})] + if(length(op)>0){ + op <- op[[1]] + }else{ + errorMsg <- "Operation 'Transaction' not supported by this service" + self$ERROR(errorMsg) + stop(errorMsg) + } + + transaction <- CSWTransaction$new(op, self$getUrl(), self$getVersion(), + type = type, record = record, constraint = constraint, + logger = self$loggerType, ...) + + exception <- getNodeSet(transaction$response, "//ows:ExceptionText", c(ows = xmlNamespaces(transaction$response)$ows$uri)) + if(length(exception)>0){ + exception <- exception[[1]] + transaction$exception <- xmlValue(exception) + self$ERROR(transaction$exception) + } + + summaryKey <- switch(type, + "Insert" = "Inserted", + "Update" = "Updated", + "Delete" = "Deleted" + ) + transaction[[tolower(summaryKey)]] <- FALSE + result <- getNodeSet(transaction$response,paste0("//csw:total",summaryKey), + c(csw = xmlNamespaces(transaction$response)$csw$uri)) + if(length(result)>0){ + result <- result[[1]] + if(xmlValue(result)>0) transaction[[tolower(summaryKey)]] <- TRUE + } + if(transaction[[tolower(summaryKey)]]){ + self$INFO(sprintf("Successful transaction (%s)!", type)) + } + + return(transaction) + }, + + #insertRecord + insertRecord = function(record, ...){ + return(self$transaction("Insert", record, constraint = NULL, ...)) + }, + + #updateRecord + updateRecord = function(record = NULL, constraint = NULL, ...){ + return(self$transaction("Update", record, constraint, ...)) + }, + + #deleteRecord + deleteRecord = function(record = NULL, constraint = NULL, ...){ + return(self$transaction("Delete", record, constraint, ...)) } ) ) diff --git a/R/CSWDescribeRecord.R b/R/CSWDescribeRecord.R index 3ab97a2..05f7953 100644 --- a/R/CSWDescribeRecord.R +++ b/R/CSWDescribeRecord.R @@ -40,12 +40,36 @@ CSWDescribeRecord <- R6Class("CSWDescribeRecord", ) namedParams <- c(namedParams, namespace = namespace, typeName = typeName) - super$initialize(op, url, namedParams, mimeType = "text/xml", logger = logger, ...) + super$initialize(op, "GET", url, namedParams = namedParams, mimeType = "text/xml", logger = logger, ...) #binding to XML schema xsdObjs <- getNodeSet(self$response, "//ns:schema", c(ns = "http://www.w3.org/2001/XMLSchema")) if(length(xsdObjs)>0){ xsdObj <- xsdObjs[[1]] + xmlNamespaces(xsdObj) <- c(as.vector(xmlNamespace(xsdObj)), gco = "http://www.isotc211.org/2005/gco") + xmlNamespaces(xsdObj) <- xmlNamespaces(xmlObj) + + #post-process xs imports + mainNamespace <- NULL + getRemoteSchemaLocation <- function(import, useMainNamespace = FALSE){ + ns <- ifelse(useMainNamespace, mainNamespace, xmlGetAttr(import, "namespace")) + if(is.null(mainNamespace)) mainNamespace <<- ns + schemaLocation <- xmlGetAttr(import, "schemaLocation") + schemaLocation.split <- unlist(strsplit(schemaLocation, "../", fixed = TRUE)) + n.dir <- length(unlist(regmatches(schemaLocation, gregexpr("\\.\\./", schemaLocation)))) + ns.split <- unlist(strsplit(ns, "/")) + schemaLocation.new <- paste( + paste(ns.split[1:(length(ns.split)-n.dir)], collapse="/"), + schemaLocation.split[length(schemaLocation.split)], + sep="/" + ) + attrs <-c(schemaLocation = schemaLocation.new) + #if(!useMainNamespace) attrs <- c(namespace = ns, attrs) + xmlAttrs(import) <- attrs + } + invisible(sapply(xpathApply(xsdObj, "//xs:import"), getRemoteSchemaLocation)) + invisible(sapply(xpathApply(xsdObj, "//xs:include"), getRemoteSchemaLocation, TRUE)) + tempf = tempfile() destfile = paste(tempf,".xsd",sep='') saveXML(xsdObj, destfile) diff --git a/R/CSWGetRecordById.R b/R/CSWGetRecordById.R index 8a164b1..5f62442 100644 --- a/R/CSWGetRecordById.R +++ b/R/CSWGetRecordById.R @@ -32,7 +32,7 @@ CSWGetRecordById <- R6Class("CSWGetRecordById", namedParams <- c(namedParams, outputSchema = outputSchema) } - super$initialize(op, url, namedParams, mimeType = "text/xml", logger = logger, ...) + super$initialize(op, "GET", url, namedParams = namedParams, mimeType = "text/xml", logger = logger, ...) #check response in case of ISO isoSchemas <- c("http://www.isotc211.org/2005/gmd","http://www.isotc211.org/2005/gfc") diff --git a/R/CSWGetRecords.R b/R/CSWGetRecords.R index 91e85cd..9965c80 100644 --- a/R/CSWGetRecords.R +++ b/R/CSWGetRecords.R @@ -44,7 +44,7 @@ CSWGetRecords <- R6Class("CSWGetRecords", namedParams[["resultType"]] <- "results" namedParams[["CONSTRAINTLANGUAGE"]] <- "CQL_TEXT" - super$initialize(op, url, namedParams, mimeType = "text/xml", logger = logger, ...) + super$initialize(op, "GET", url, namedParams = namedParams, mimeType = "text/xml", logger = logger, ...) #bindings self$response <- switch(outputSchema, diff --git a/R/CSWTransaction.R b/R/CSWTransaction.R new file mode 100644 index 0000000..ea3569d --- /dev/null +++ b/R/CSWTransaction.R @@ -0,0 +1,43 @@ +#' CSWTransaction +#' +#' @docType class +#' @export +#' @keywords OGC CSW Transaction +#' @return Object of \code{\link{R6Class}} for modelling a CSW Transaction request +#' @format \code{\link{R6Class}} object. +#' +#' @section Methods: +#' \describe{ +#' \item{\code{new(url, version, id)}}{ +#' This method is used to instantiate a CSWTransaction object +#' } +#' } +#' +#' @author Emmanuel Blondel +#' +CSWTransaction <- R6Class("CSWTransaction", + lock_objects = FALSE, + inherit = OWSRequest, + private = list( + name = "Transaction", + defaultNamespace = "http://www.opengis.net/cat/csw" + ), + public = list( + initialize = function(op, url, version, type, record, constraint = NULL, logger = NULL, ...) { + namespace = c(csw = paste(private$defaultNamespace, version, sep="/")) + + namedParams <- list(request = private$name, transaction = record) + names(namedParams)[2] <- type + if(!is.null(namedParams)) namedParams <- c(namedParams, constraint = constraint) + + namedAttrs <- list(service = "CSW", version = version) + + super$initialize(op, "POST", url, namedParams = namedParams, namedAttrs = namedAttrs, + namespace = namespace, contentType = "text/xml", mimeType = "text/xml", + logger = logger, ...) + + + } + + ) +) \ No newline at end of file diff --git a/R/OWSCapabilities.R b/R/OWSCapabilities.R index 0222625..9996b1a 100644 --- a/R/OWSCapabilities.R +++ b/R/OWSCapabilities.R @@ -56,7 +56,7 @@ OWSCapabilities <- R6Class("OWSCapabilities", initialize = function(url, service, version, logger = NULL) { super$initialize(logger = logger) namedParams <- list(request = "GetCapabilities", version = version) - private$request <- OWSRequest$new(op = NULL, url, namedParams, "text/xml", logger = logger) + private$request <- OWSRequest$new(op = NULL, "GET", url, namedParams, "text/xml", logger = logger) xmlObj <- private$request$response private$serviceIdentification <- OWSServiceIdentification$new(xmlObj, service, version) private$serviceProvider <- OWSServiceProvider$new(xmlObj, service, version) diff --git a/R/OWSRequest.R b/R/OWSRequest.R index 484630a..feea722 100644 --- a/R/OWSRequest.R +++ b/R/OWSRequest.R @@ -23,8 +23,8 @@ OWSRequest <- R6Class("OWSRequest", inherit = OWSLogger, #private methods private = list( - #buildRequest - buildRequest = function(url, namedParams, mimeType){ + #GET + GET = function(url, namedParams, mimeType){ params <- paste(names(namedParams), namedParams, sep = "=", collapse = "&") request <- paste(url, "&", params, sep = "") self$INFO(sprintf("Fetching %s", request)) @@ -48,6 +48,77 @@ OWSRequest <- R6Class("OWSRequest", } response <- list(request = request, status = status_code(r), response = responseContent) return(response) + }, + + #POST + POST = function(url, namedParams, namedAttrs, namespace, + contentType = "text/xml", mimeType = "text/xml"){ + + #Prepare request + requestName <- namedParams$request + namedParams <- namedParams[names(namedParams) != "request"] + rootXML <- xmlOutputDOM( + tag = requestName, + nameSpace = names(namespace), + nsURI = namespace, + attrs = namedAttrs + ) + for(param in names(namedParams)){ + wrapperNode <- xmlOutputDOM(tag = param, nameSpace = names(namespace)) + content <- namedParams[[param]] + if(is(content, "XMLInternalDocument")){ + content <- as(content, "character") + content <- gsub("<\\?xml.*?\\?>", "", content) + content <- gsub("", "", content) + content <- xmlRoot(xmlParse(content, encoding = "UTF-8")) + }else{ + content <- xmlTextNode(as(content,"character")) + } + wrapperNode$addNode(content) + rootXML$addNode(wrapperNode$value()) + } + outXML <- rootXML$value() + outXML <- as(outXML, "XMLInternalNode") + if(length(namedAttrs)>0){ + suppressWarnings(xmlAttrs(outXML) <- namedAttrs) + } + outbuf <- xmlOutputBuffer("") + outbuf$add(as(outXML, "character")) + outXML <- xmlParse(outbuf$value(), encoding = "UTF-8") + + #send request + if(self$verbose.debug){ + r <- with_verbose(httr::POST( + url = url, + add_headers( + "Content-type" = contentType + ), + body = as(outXML, "character") + )) + }else{ + r <- httr::POST( + url = url, + add_headers( + "Content-type" = contentType + ), + body = as(outXML, "character") + ) + } + + responseContent <- NULL + if(is.null(mimeType)){ + responseContent <- content(r, encoding = "UTF-8") + }else{ + if(regexpr("xml",mimeType)>0){ + text <- content(r, type = "text", encoding = "UTF-8") + text <- gsub("", "", text) + responseContent <- xmlParse(text) + }else{ + responseContent <- content(r, type = mimeType, encoding = "UTF-8") + } + } + response <- list(request = outXML, status = status_code(r), response = responseContent) + return(response) } ), #public methods @@ -56,7 +127,9 @@ OWSRequest <- R6Class("OWSRequest", status = NA, response = NA, #initialize - initialize = function(op, url, namedParams, mimeType = "text/xml", logger = NULL, ...) { + initialize = function(op, type, url, namedParams, namedAttrs = NULL, namespace = NULL, + contentType = "text/xml", mimeType = "text/xml", + logger = NULL, ...) { super$initialize(logger = logger) vendorParams <- list(...) #if(!is.null(op)){ @@ -80,7 +153,11 @@ OWSRequest <- R6Class("OWSRequest", vendorParams <- vendorParams[!sapply(vendorParams, is.null)] vendorParams <- lapply(vendorParams, curl::curl_escape) namedParams <- c(namedParams, vendorParams) - req <- private$buildRequest(url, namedParams, mimeType) + + req <- switch(type, + "GET" = private$GET(url, namedParams, mimeType), + "POST" = private$POST(url, namedParams, namedAttrs, namespace, contentType, mimeType) + ) self$request <- req$request self$status <- req$status self$response <- req$response diff --git a/R/WFSDescribeFeatureType.R b/R/WFSDescribeFeatureType.R index d538c52..3d7c3ac 100644 --- a/R/WFSDescribeFeatureType.R +++ b/R/WFSDescribeFeatureType.R @@ -23,7 +23,7 @@ WFSDescribeFeatureType <- R6Class("WFSDescribeFeatureType", public = list( initialize = function(op, url, version, typeName, ...) { namedParams <- list(request = private$name, version = version, typeName = typeName) - super$initialize(op, url, namedParams, mimeType = "text/xml", ...) + super$initialize(op, "GET", url, namedParams = namedParams, mimeType = "text/xml", ...) } ) ) \ No newline at end of file diff --git a/R/WFSGetFeature.R b/R/WFSGetFeature.R index 4de84d9..7e69d7a 100644 --- a/R/WFSGetFeature.R +++ b/R/WFSGetFeature.R @@ -23,7 +23,7 @@ WFSGetFeature <- R6Class("WFSGetFeature", public = list( initialize = function(op, url, version, typeName, ...) { namedParams <- list(request = private$name, version = version, typeName = typeName) - super$initialize(op, url, namedParams, mimeType = "text/xml", ...) + super$initialize(op, "GET", url, namedParams = namedParams, mimeType = "text/xml", ...) } ) ) \ No newline at end of file diff --git a/README.md b/README.md index ddee996..25f126f 100644 --- a/README.md +++ b/README.md @@ -9,7 +9,7 @@ R client for OGC Web-Services ``ows4R`` is a new project that aims to set-up a pure R interface to OGC Web-Services. In a first time (ongoing work), ``ows4R`` will target: * the Common OGC Web-Services specifications, version ``1.1.0`` -* the Catalogue Service (CSW), version ``2.0.2`` +* the Catalogue Service for the Web (CSW), versions ``2.0.2`` and ``3.0`` * the Web Feature Service (WFS), versions ``1.0.0``, ``1.1.0``, and ``2.0.0`` ## OGC standards coverage status @@ -17,7 +17,7 @@ R client for OGC Web-Services Standard |Description|Supported versions|Supported R bindings|Support ----------|-----------|------------------|--------------------|------| OGC Common|[Web Service Common](http://www.opengeospatial.org/standards/common)|``1.1.0``||ongoing -OGC CSW |[Catalogue Service](http://www.opengeospatial.org/standards/cat)|``2.0.2``|[geometa](https://github.com/eblondel/geometa) (ISO 19115 / 19119 / 19110)|ongoing +OGC CSW |[Catalogue Service](http://www.opengeospatial.org/standards/cat)|``2.0.2``,``3.0.0``|[geometa](https://github.com/eblondel/geometa) (ISO 19115 / 19119 / 19110)|ongoing / seeking fundings OGC WFS |[Web Feature Service](http://www.opengeospatial.org/standards/wfs)|``1.0.0``,``1.1.0``,``2.0.0``|[sf](https://github.com/r-spatial/sf) (OGC Simple Feature)|ongoing In case of a missing feature, [create a ticket](https://github.com/eblondel/ows4R/issues/new). @@ -26,5 +26,5 @@ In case of a missing feature, [create a ticket](https://github.com/eblondel/ows4 * Support for additional OGC web-service standard specifications -For more information, or if you are interested in funding this R package project or to contribute to it, do not hesitate to contact me by [e-mail](mailto:emmanuel.blondel1@gmail.com) +For more information, or if you are interested in funding this R project or to contribute to it, do not hesitate to contact me by [e-mail](mailto:emmanuel.blondel1@gmail.com) diff --git a/inst/extdata/data/metadata.xml b/inst/extdata/data/metadata.xml new file mode 100644 index 0000000..71f6d00 --- /dev/null +++ b/inst/extdata/data/metadata.xml @@ -0,0 +1,570 @@ + + + + + + my-metadata-identifier + + + + + + + + + my-parent-metadata-identifier + + + + + + + + someone1 + + + somewhere + + + someposition1 + + + + + + + myphonenumber1 + + + myfacsimile1 + + + + + + + theaddress + + + thecity + + + 111 + + + France + + + someone@theorg.org + + + + + + + http://somelink + + + someresourcename + + + + + + + + + + + + + + someone2 + + + somewhere + + + someposition2 + + + + + + + myphonenumber2 + + + myfacsimile2 + + + + + + + theaddress + + + thecity + + + 111 + + + France + + + someone@theorg.org + + + + + + + http://somelink + + + someresourcename + + + + + + + + + + + + 2015-01-01T01:00:00 + + + ISO 19115:2003/19139 + + + 1.0 + + + my-dataset-identifier + + + + + + + 4326 + + + EPSG + + + + + + + + + + + sometitle + + + + + 2015-01-01 + + + + + + + + 1.0 + + + 2015-01-01 + + + + + identifier + + + + + + + someone + + + somewhere + + + someposition + + + + + + + myphonenumber + + + myfacsimile + + + + + + + theaddress + + + thecity + + + 111 + + + France + + + someone@theorg.org + + + + + + + http://somelink + + + somename + + + + + + + + + + + + + + + + + abstract + + + purpose + + + credit1 + + + credit2 + + + + + + + + + + + someone + + + somewhere + + + someposition + + + + + + + myphonenumber + + + myfacsimile + + + + + + + theaddress + + + thecity + + + 111 + + + France + + + someone@theorg.org + + + + + + + http://somelink + + + somename + + + + + + + + + + + + + + + + + + + + + http://wwww.somefile.org/png1 + + + Map Overview 1 + + + image/png + + + + + + + keyword1 + + + keyword2 + + + + + + + + General + + + + + 2015-01-01 + + + + + + + + + + + + + + limitation1 + + + limitation2 + + + limitation3 + + + + + + + + + + + + + + + + + + + + + + + + + + biota + + + oceans + + + + + + + true + + + -180 + + + 180 + + + -90 + + + 90 + + + + + + + some additional information + + + + + + + + + + + http://somelink1 + + + WWW:LINK-1.0-http--link + + + name1 + + + description1 + + + + + + + http://somelink2 + + + WWW:LINK-1.0-http--link + + + name2 + + + description2 + + + + + + + http://somelink3 + + + WWW:LINK-1.0-http--link + + + name3 + + + description3 + + + + + + + + + + + + + + + + + + + + + + + + specification title + + + specification alternate title + + + + + 2015-01-01 + + + + + + + + + + some explanation about the conformance + + + true + + + + + + + + + statement + + + + + + \ No newline at end of file diff --git a/inst/extdata/pycsw/pycsw.cfg b/inst/extdata/pycsw/pycsw.cfg new file mode 100644 index 0000000..f68d91a --- /dev/null +++ b/inst/extdata/pycsw/pycsw.cfg @@ -0,0 +1,97 @@ +# ================================================================= +# +# Authors: Tom Kralidis +# +# Copyright (c) 2015 Tom Kralidis +# +# Permission is hereby granted, free of charge, to any person +# obtaining a copy of this software and associated documentation +# files (the "Software"), to deal in the Software without +# restriction, including without limitation the rights to use, +# copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the +# Software is furnished to do so, subject to the following +# conditions: +# +# The above copyright notice and this permission notice shall be +# included in all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +# OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +# OTHER DEALINGS IN THE SOFTWARE. +# +# ================================================================= + +[server] +home=/var/www/pycsw +url=http://localhost/pycsw/csw.py +mimetype=application/xml; charset=UTF-8 +encoding=UTF-8 +language=en-US +maxrecords=10 +loglevel=DEBUG +logfile=pycsw.log +#ogc_schemas_base=http://foo +#federatedcatalogues=http://catalog.data.gov/csw +#pretty_print=true +gzip_compresslevel=9 +#domainquerytype=range +#domaincounts=true +#spatial_ranking=true +profiles=apiso + +[manager] +transactions=true +allowed_ips=172.17.0.1 +#csw_harvest_pagesize=10 + +[metadata:main] +identification_title=pycsw Geospatial Catalogue +identification_abstract=pycsw is an OGC CSW server implementation written in Python +identification_keywords=catalogue,discovery,metadata +identification_keywords_type=theme +identification_fees=None +identification_accessconstraints=None +provider_name=Organization Name +provider_url=http://pycsw.org/ +contact_name=Lastname, Firstname +contact_position=Position Title +contact_address=Mailing Address +contact_city=City +contact_stateorprovince=Administrative Area +contact_postalcode=Zip or Postal Code +contact_country=Country +contact_phone=+xx-xxx-xxx-xxxx +contact_fax=+xx-xxx-xxx-xxxx +contact_email=you@example.org +contact_url=Contact URL +contact_hours=Hours of Service +contact_instructions=During hours of service. Off on weekends. +contact_role=pointOfContact + +[repository] +# sqlite +database=sqlite:////home/pycsw/tests/functionaltests/suites/cite/data/cite.db +# postgres +#database=postgresql://username:password@localhost/pycsw +# mysql +#database=mysql://username:password@localhost/pycsw?charset=utf8 +#mappings=path/to/mappings.py +table=records +#filter=type = 'http://purl.org/dc/dcmitype/Dataset' + +[metadata:inspire] +enabled=true +languages_supported=eng,gre +default_language=eng +date=YYYY-MM-DD +gemet_keywords=Utility and governmental services +conformity_service=notEvaluated +contact_name=Organization Name +contact_email=Email Address +temp_extent=YYYY-MM-DD/YYYY-MM-DD diff --git a/test.xml b/test.xml new file mode 100644 index 0000000..2a57ea6 --- /dev/null +++ b/test.xml @@ -0,0 +1,563 @@ + + + + + + my-metadata-identifier + + + English + + + utf8 + + + my-parent-metadata-identifier + + + dataset + + + + + someone1 + + + somewhere + + + someposition1 + + + + + + + myphonenumber1 + + + myfacsimile1 + + + + + + + theaddress + + + thecity + + + 111 + + + France + + + someone@theorg.org + + + + + + + http://somelink + + + someresourcename + + + + + + + pointOfContact + + + + + + + someone2 + + + somewhere + + + someposition2 + + + + + + + myphonenumber2 + + + myfacsimile2 + + + + + + + theaddress + + + thecity + + + 111 + + + France + + + someone@theorg.org + + + + + + + http://somelink + + + someresourcename + + + + + + + pointOfContact + + + + + 2015-01-01T01:00:00 + + + ISO 19115:2003/19139 + + + 1.0 + + + my-dataset-identifier + + + + + + + 4326 + + + EPSG + + + + + + + + + + + sometitle + + + + + 2015-01-01 + + + publication + + + + + 1.0 + + + 2015-01-01 + + + + + identifier + + + + + + + someone + + + somewhere + + + someposition + + + + + + + myphonenumber + + + myfacsimile + + + + + + + theaddress + + + thecity + + + 111 + + + France + + + someone@theorg.org + + + + + + + http://somelink + + + somename + + + + + + + pointOfContact + + + + + mapDigital + + + + + abstract + + + purpose + + + credit1 + + + credit2 + + + + + + + + + + + someone + + + somewhere + + + someposition + + + + + + + myphonenumber + + + myfacsimile + + + + + + + theaddress + + + thecity + + + 111 + + + France + + + someone@theorg.org + + + + + + + http://somelink + + + somename + + + + + + + pointOfContact + + + + + + + daily + + + + + + + http://wwww.somefile.org/png1 + + + Map Overview 1 + + + image/png + + + + + + + keyword1 + + + keyword2 + + + theme + + + + + General + + + + + 2015-01-01 + + + publication + + + + + + + + + + + limitation1 + + + limitation2 + + + limitation3 + + + copyright + + + license + + + copyright + + + license + + + + + vector + + + English + + + utf8 + + + biota + + + oceans + + + + + + + true + + + -180 + + + 180 + + + -90 + + + 90 + + + + + + + some additional information + + + + + + + + + + + http://somelink1 + + + WWW:LINK-1.0-http--link + + + name1 + + + description1 + + + + + + + http://somelink2 + + + WWW:LINK-1.0-http--link + + + name2 + + + description2 + + + + + + + http://somelink3 + + + WWW:LINK-1.0-http--link + + + name3 + + + description3 + + + + + + + + + + + + + dataset + + + + + + + + + + + specification title + + + specification alternate title + + + + + 2015-01-01 + + + publication + + + + + + + some explanation about the conformance + + + true + + + + + + + + + statement + + + + + + + + diff --git a/tests/testthat/test_CSWClient.R b/tests/testthat/test_CSWClient.R index fc29584..84faa90 100644 --- a/tests/testthat/test_CSWClient.R +++ b/tests/testthat/test_CSWClient.R @@ -8,11 +8,18 @@ require(geometa) require(testthat) context("CSW") +#data +mdfile <- system.file("extdata/data", "metadata.xml", package = "ows4R") +md <- geometa::ISOMetadata$new(xml = xmlParse(mdfile)) + +#CSW 2.0.2 +#-------------------------------------------------------------------------- +csw <- CSWClient$new("http://localhost:8000/csw", "2.0.2", logger="DEBUG") + #CSW 2.0.2 – GetCapabilities #-------------------------------------------------------------------------- #--> pycsw test_that("CSW 2.0.2 - GetCapabilities | pycsw",{ - csw <- CSWClient$new("http://localhost:8000/csw", "2.0.2", logger="INFO") expect_is(csw, "CSWClient") caps <- csw$getCapabilities() expect_is(caps, "CSWCapabilities") @@ -62,23 +69,46 @@ test_that("CSW 2.0.2 - GetCapabilities | pycsw",{ }) -#--> GeoNetwork -test_that("CSW 2.0.2 - GetCapabilities | GeoNetwork",{ - csw <- CSWClient$new("http://localhost:8282/geonetwork/srv/eng/csw", "2.0.2", logger = "INFO") - expect_is(csw, "CSWClient") - caps <- csw$getCapabilities() - expect_is(caps, "CSWCapabilities") -}) - #CSW 2.0.2 – DescribeRecord #-------------------------------------------------------------------------- #test_that("CSW 2.0.2 - DescribeRecord",{ -# csw <- CSWClient$new("http://localhost:8000/csw", "2.0.2", logger = "DEBUG") # xsd <- csw$describeRecord(namespace = "http://www.isotc211.org/2005/gmd") #}) +#CSW 2.0.2 – Transaction +#-------------------------------------------------------------------------- + +#Insert +test_that("CSW 2.0.2 - Transaction - Insert",{ + insert <- csw$insertRecord(record = md$encode()) + expect_true(insert$inserted) +}) + +#Update (Full) +test_that("CSW 2.0.2 - Transaction - Update (Full)",{ + md$identificationInfo[[1]]$citation$setTitle("a new title") + update <- csw$updateRecord(record = md$encode()) + expect_true(update$updated) +}) + +test_that("CSW 2.0.2 - Transaction - Update (Partial)",{ + #TBD requires OGC Filter implementation +}) + +#Delete +test_that("CSW 2.0.2 - Transaction - Delete",{ + #TBD requires OGC Filter implementation +}) + #CSW 2.0.2 – GetRecordById #-------------------------------------------------------------------------- +test_that("CSW 2.0.2 - GetRecordById",{ + + md <- csw$getRecordById("my-metadata-identifier", outputSchema = "http://www.isotc211.org/2005/gmd") + expect_is(md, "ISOMetadata") +}) + + test_that("CSW 2.0.2 - GetRecordById",{ csw <- CSWClient$new("http://www.fao.org/geonetwork/srv/en/csw", "2.0.2", logger = "INFO") md <- csw$getRecordById("fao-species-map-tth", outputSchema = "http://www.isotc211.org/2005/gmd")