diff --git a/.travis.yml b/.travis.yml index b578515..421d0fd 100644 --- a/.travis.yml +++ b/.travis.yml @@ -16,6 +16,10 @@ before_install: - sudo apt-get install --yes libudunits2-dev libproj-dev libgeos-dev libgdal-dev - Rscript -e 'update.packages(ask = FALSE)' # docker images for integration tests + # --> pycsw + - docker pull geopython/pycsw:2.2.0 + - docker run --name pycsw --publish 8000:8000 --detach geopython/pycsw + # --> GeoNetwork - docker pull kartoza/postgis - docker run -d --name="postgis" kartoza/postgis - docker pull oscarfonts/geoserver diff --git a/NAMESPACE b/NAMESPACE index 1ac2b6a..bb0f973 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,6 +11,7 @@ export(OWSOperation) export(OWSOperationsMetadata) export(OWSRequest) export(OWSServiceIdentification) +export(OWSServiceProvider) export(OWSUtils) export(WFSCapabilities) export(WFSClient) diff --git a/R/OWSCapabilities.R b/R/OWSCapabilities.R index cd9e766..0222625 100644 --- a/R/OWSCapabilities.R +++ b/R/OWSCapabilities.R @@ -29,6 +29,9 @@ #' \item{\code{getServiceIdentification()}}{ #' Get the service identification #' } +#' \item{\code{getServiceProvider()}}{ +#' Get the service provider +#' } #' \item{\code{getOperationsMetadata()}}{ #' Get the service operations metadata #' } @@ -43,6 +46,7 @@ OWSCapabilities <- R6Class("OWSCapabilities", version = NA, request = NA, serviceIdentification = NULL, + serviceProvider = NULL, operationsMetadata = NULL ), @@ -55,6 +59,7 @@ OWSCapabilities <- R6Class("OWSCapabilities", private$request <- OWSRequest$new(op = NULL, url, namedParams, "text/xml", logger = logger) xmlObj <- private$request$response private$serviceIdentification <- OWSServiceIdentification$new(xmlObj, service, version) + private$serviceProvider <- OWSServiceProvider$new(xmlObj, service, version) private$operationsMetadata <- OWSOperationsMetadata$new(xmlObj, service, version) }, @@ -78,6 +83,11 @@ OWSCapabilities <- R6Class("OWSCapabilities", return(private$serviceIdentification) }, + #getServiceProvider + getServiceProvider = function(){ + return(private$serviceProvider) + }, + #getOperationsMetadata getOperationsMetadata = function(){ return(private$operationsMetadata) diff --git a/R/OWSServiceIdentification.R b/R/OWSServiceIdentification.R index 972bf0c..e41b477 100644 --- a/R/OWSServiceIdentification.R +++ b/R/OWSServiceIdentification.R @@ -109,7 +109,10 @@ OWSServiceIdentification <- R6Class("OWSServiceIdentification", serviceKeywords <- strsplit(gsub(" ", "", xmlValue(children$Keywords)), ",")[[1]] }else{ serviceKeywordListXML <- xmlChildren(children$Keywords) - serviceKeywords <- as.vector(sapply(serviceKeywordListXML, xmlValue)) + serviceKeywords <- sapply(serviceKeywordListXML, function(x){ + if(xmlName(x)=="Keyword") return(xmlValue(x))}) + serviceKeywords <- serviceKeywords[!sapply(serviceKeywords, is.null)] + serviceKeywords <- as.vector(unlist(serviceKeywords)) } } diff --git a/R/OWSServiceProvider.R b/R/OWSServiceProvider.R new file mode 100644 index 0000000..e6cfa41 --- /dev/null +++ b/R/OWSServiceProvider.R @@ -0,0 +1,154 @@ +#' OWSServiceProvider +#' +#' @docType class +#' @export +#' @keywords OGC OWS Service Provider +#' @return Object of \code{\link{R6Class}} for modelling an OGC Service Provider +#' @format \code{\link{R6Class}} object. +#' +#' @section Methods: +#' \describe{ +#' \item{\code{new(xmlObj, url, service)}}{ +#' This method is used to instantiate a OWSServiceProvider object +#' } +#' \item{\code{getProviderName()}}{ +#' Get the provider name +#' } +#' \item{\code{getProviderSite()}}{ +#' Get the provide site +#' } +#' \item{\code{getServiceContact()}}{ +#' Get the service contact, as object of class \code{ISOResponsibleParty} +#' from package \pkg{geometa} +#' } +#' } +#' +#' @author Emmanuel Blondel +#' +OWSServiceProvider <- R6Class("OWSServiceProvider", + private = list( + providerName = NA, + providerSite = NA, + serviceContact = NA, + + #fetchServiceProvider + fetchServiceProvider = function(xmlObj, service, version){ + + namespaces <- NULL + if(all(class(xmlObj) == c("XMLInternalDocument","XMLAbstractDocument"))){ + namespaces <- OWSUtils$getNamespaces(xmlObj) + } + namespaces <- as.data.frame(namespaces) + namespace <- tolower(service) + + serviceXML <- NULL + if(nrow(namespaces) > 0){ + ns <- OWSUtils$findNamespace(namespaces, namespace) + if(length(ns)>0){ + if(namespace %in% names(ns)){ + serviceXML <- getNodeSet(xmlObj, "//ns:ServiceProvider", ns) + } + } + if(length(serviceXML)==0){ + ns <- OWSUtils$findNamespace(namespaces, "ows") + if(length(ns)>0){ + serviceXML <- getNodeSet(xmlObj, "//ns:ServiceProvider", ns) + } + } + }else{ + serviceXML <- getNodeSet(xmlObj, "//ServiceProvider") + } + + providerName <- NULL + providerSite <- NULL + serviceContact <- NULL + if(length(serviceXML) > 0){ + serviceXML <- serviceXML[[1]] + children <- xmlChildren(serviceXML) + + if(!is.null(children$ProviderName)){ + providerName <- xmlValue(children$ProviderName) + } + if(!is.null(children$ProviderSite)){ + siteLink <- xmlGetAttr(children$ProviderSite, "xlink:href") + providerSite <- ISOOnlineResource$new() + providerSite$setLinkage(siteLink) + } + sc <- children$ServiceContact + if(!is.null(sc)){ + sc.children <- xmlChildren(sc) + individualName <- xmlValue(sc.children$IndividualName) + positionName <- xmlValue(sc.children$PositionName) + serviceContact <- ISOResponsibleParty$new() + serviceContact$setIndividualName(individualName) + serviceContact$setPositionName(positionName) + contactInfo <- sc.children$ContactInfo + if(!is.null(contactInfo)){ + infos <- xmlChildren(contactInfo) + contact <- ISOContact$new() + + if(!is.null(infos$Phone)){ + phone <- ISOTelephone$new() + voice <- xmlValue(xmlChildren(infos$Phone)$Voice) + phone$setVoice(voice) + facsimile <- xmlValue(xmlChildren(infos$Phone)$Facsimile) + phone$setFacsimile(facsimile) + contact$setPhone(phone) + } + + if(!is.null(infos$Address)){ + address <- ISOAddress$new() + address$setDeliveryPoint(xmlValue(xmlChildren(infos$Address)$DeliveryPoint)) + address$setCity(xmlValue(xmlChildren(infos$Address)$City)) + address$setPostalCode(xmlValue(xmlChildren(infos$Address)$PostalCode)) + address$setCountry(xmlValue(xmlChildren(infos$Address)$Country)) + address$setEmail(xmlValue(xmlChildren(infos$Address)$ElectronicMailAddress)) + contact$setAddress(address) + } + + if(!is.null(infos$OnlineResource)){ + or <- ISOOnlineResource$new() + or$setLinkage(xmlGetAttr(infos$OnlineResource, "xlink:href")) + contact$setOnlineResource(or) + } + + serviceContact$setContactInfo(contact) + } + } + + } + + serviceProvider <- list( + providerName = providerName, + providerSite = providerSite, + serviceContact = serviceContact + ) + + return(serviceProvider) + } + ), + public = list( + initialize = function(xmlObj, service, version){ + serviceProvider <- private$fetchServiceProvider(xmlObj, service, version) + private$providerName <- serviceProvider$providerName + private$providerSite <- serviceProvider$providerSite + private$serviceContact <- serviceProvider$serviceContact + }, + + #getProviderName + getProviderName = function(){ + return(private$providerName) + }, + + #getProviderSite + getProviderSite = function(){ + return(private$providerSite) + }, + + #getServiceContact + getServiceContact = function(){ + return(private$serviceContact) + } + + ) +) \ No newline at end of file diff --git a/man/OWSCapabilities.Rd b/man/OWSCapabilities.Rd index afba651..119269f 100644 --- a/man/OWSCapabilities.Rd +++ b/man/OWSCapabilities.Rd @@ -33,6 +33,9 @@ OWSGetCapabilities \item{\code{getServiceIdentification()}}{ Get the service identification } + \item{\code{getServiceProvider()}}{ + Get the service provider + } \item{\code{getOperationsMetadata()}}{ Get the service operations metadata } diff --git a/man/OWSServiceProvider.Rd b/man/OWSServiceProvider.Rd new file mode 100644 index 0000000..845b5a1 --- /dev/null +++ b/man/OWSServiceProvider.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/OWSServiceProvider.R +\docType{class} +\name{OWSServiceProvider} +\alias{OWSServiceProvider} +\title{OWSServiceProvider} +\format{\code{\link{R6Class}} object.} +\usage{ +OWSServiceProvider +} +\value{ +Object of \code{\link{R6Class}} for modelling an OGC Service Provider +} +\description{ +OWSServiceProvider +} +\section{Methods}{ + +\describe{ + \item{\code{new(xmlObj, url, service)}}{ + This method is used to instantiate a OWSServiceProvider object + } + \item{\code{getProviderName()}}{ + Get the provider name + } + \item{\code{getProviderSite()}}{ + Get the provide site + } + \item{\code{getServiceContact()}}{ + Get the service contact, as object of class \code{ISOResponsibleParty} + from package \pkg{geometa} + } +} +} + +\author{ +Emmanuel Blondel +} +\keyword{OGC} +\keyword{OWS} +\keyword{Provider} +\keyword{Service} diff --git a/tests/testthat/test_CSWClient.R b/tests/testthat/test_CSWClient.R index fb4de1d..fc29584 100644 --- a/tests/testthat/test_CSWClient.R +++ b/tests/testthat/test_CSWClient.R @@ -9,30 +9,76 @@ require(testthat) context("CSW") #CSW 2.0.2 – GetCapabilities - -test_that("CSW 2.0.2 - GetCapabilities | GeoNetwork",{ - csw <- CSWClient$new("http://localhost:8282/geonetwork/srv/eng/csw", "2.0.2", logger = "INFO") +#-------------------------------------------------------------------------- +#--> 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") + + #service identification + SI <- caps$getServiceIdentification() + expect_equal(SI$getTitle(), "pycsw Geospatial Catalogue") + expect_equal(SI$getAbstract(), "pycsw is an OGC CSW server implementation written in Python") + expect_equal(SI$getServiceType(), "CSW") + expect_equal(SI$getServiceTypeVersion(), "2.0.2") + expect_equal(SI$getKeywords(), c("catalogue","discovery","metadata")) + expect_equal(SI$getFees(), "None") + expect_equal(SI$getAccessConstraints(), "None") + + #service provider + SP <- caps$getServiceProvider() + expect_equal(SP$getProviderName(), "Organization Name") + expect_is(SP$getProviderSite(), "ISOOnlineResource") + expect_equal(SP$getProviderSite()$linkage$value, "http://pycsw.org/") + rp <- SP$getServiceContact() + expect_is(rp, "ISOResponsibleParty") + expect_equal(rp$individualName, "Lastname, Firstname") + expect_equal(rp$positionName, "Position Title") + contact <- rp$contactInfo + expect_is(contact, "ISOContact") + expect_is(contact$phone, "ISOTelephone") + expect_equal(contact$phone$voice, "+xx-xxx-xxx-xxxx") + expect_equal(contact$phone$facsimile, "+xx-xxx-xxx-xxxx") + expect_is(contact$address, "ISOAddress") + expect_equal(contact$address$deliveryPoint, "Mailing Address") + expect_equal(contact$address$city, "City") + expect_equal(contact$address$postalCode, "Zip or Postal Code") + expect_equal(contact$address$country, "Country") + expect_equal(contact$address$electronicMailAddress, "you@example.org") + expect_is(contact$onlineResource, "ISOOnlineResource") + expect_equal(contact$onlineResource$linkage$value, "Contact URL") + + #service operation metadata + OPM <- caps$getOperationsMetadata() + OP <- OPM$getOperations() + expect_is(OP, "list") + expect_equal(length(OP), 8L) + expect_equal(unique(sapply(OP, function(i){class(i)[1]})), "OWSOperation") + operations <- sapply(OP,function(op){op$getName()}) + expect_equal(operations, c("GetCapabilities", "DescribeRecord", "GetDomain", "GetRecords", + "GetRecordById", "GetRepositoryItem", "Transaction", "Harvest")) + }) -test_that("CSW 2.0.2 - GetCapabilities | pycsw",{ - csw <- CSWClient$new("http://demo.pycsw.org/cite/csw", "2.0.2", logger="INFO") +#--> 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:8282/geonetwork/srv/en/csw", "2.0.2", logger = "INFO") -# xsd <- csw$describeRecord(outputSchema = "http://www.isotc211.org/2005/gmd") +# 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 – GetRecordById - +#-------------------------------------------------------------------------- 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")