# This file is a part of the rwfs package (http://github.com/rOpenGov/rwfs)
# in association with the rOpenGov project (ropengov.github.io)
# Copyright (C) 2014 Jussi Jousimo
# All rights reserved.
# This program is open source software; you can redistribute it and/or modify
# it under the terms of the FreeBSD License (keep this notice):
# http://en.wikipedia.org/wiki/BSD_licenses
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#' Class represeting a WFS client
#'
#' An abstract class to represent OGC's WFS client in R. Other client classes
#' in this package inherit this this class.
#'
#' @format \code{\link{R6Class}} object.
#'
#' @usage NULL
#'
#' @field test
#'
#' @section Methods:
#' \describe{
#' \item{\code{new(request)}}{This method is used to create object of this
#' class with \code{request} as the request object containing WFS
#' connection information and methods. NOTE: as this is abstract class,
#' you shouldn't be creating instances of it.}
#' \item{setRequest(request)}{Set client's request object to \code{request},
#' which must inherit from \code{\link{WFSRequest}}.}
#' \item{listLayers()}{Not implemented in this abstract class, but it classes
#' inheriting this class.}
#' \item{getLayer}{Not implemented in this abstract class, but it classes
#' inheriting this class.}
#' \item{getRaster}{Get a raster layer from WFS }
#' }
#'
#' @import R6
#' @import raster
#' @import sf
#' @export WFSClient
#'
#' @seealso \code{\link{WFSStreamingClient}}, \code{\link{WFSCachingClient}},
#' \code{\link{WFSRequest}}
#' @author Jussi Jousimo \email{jvj@@iki.fi},
#' Joona Lehtomaki \email{joona.lehtomaki@@gmail.com}
#'
#'
WFSClient <- R6::R6Class(
"WFSClient",
private = list(
request = NULL,
.listLayers = function(dataSource) {
if (missing(dataSource)) {
stop("Required argument 'dataSource' missing.")
}
if (!inherits(dataSource, "character")) {
stop("Argument 'dataSource' must be a descendant of class 'character'.")
}
layers <- try(sf::st_layers(dsn = dataSource))
if (inherits(layers, "try-error")) {
if (length(grep("Cannot open data source", layers)) == 1) {
warning("Unable to connect to the data source or error in query result.")
return(character(0))
}
else stop("Fatal error.")
}
return(layers)
},
.getLayer = function(dataSource, layer, ...) {
if (missing(dataSource)) {
stop("Required argument 'dataSource' missing.")
}
if (missing(layer)) {
stop("Required argument 'layer' missing.")
}
if (!inherits(dataSource, "character")) {
stop("Argument 'dataSource' must be a descendant of class 'character'.")
}
response <- try(sf::st_read(dsn = dataSource, layer = layer,
stringsAsFactors = FALSE, ...))
if (inherits(response, "try-error")) {
if (length(grep("Cannot open data source", response)) == 1) {
warning("Unable to connect to the data source or error in query result.")
return(character(0))
}
else {
stop("Fatal error.")
}
}
return(response)
},
getRasterURL = function(parameters) {
stop("Unimplemented method.", call. = FALSE)
},
importRaster = function(destFile) {
raster <- raster::brick(destFile)
return(raster)
}
),
public = list(
initialize = function(request) {
self$setRequest(request = request)
return(invisible(self))
},
setRequest = function(request) {
if (missing(request)) {
stop("Required argument 'request' missing.")
}
if (!inherits(request, "WFSRequest")) {
stop("Argument 'request' must be a descedant of class 'WFSRequest'")
}
private$request <- request
return(invisible(self))
},
listLayers = function() {
stop("Unimplemented method.", call. = FALSE)
},
getLayer = function(layer, ...) {
stop("Unimplemented method.")
},
getRaster = function(parameters) {
rasterURL <- private$getRasterURL(parameters = parameters)
if (length(rasterURL) == 0) {
return(character())
}
destFile <- tempfile()
# NOTE! mode = "wb" is required on Windows.
success <- download.file(rasterURL, destfile = destFile, mode = "wb")
if (success != 0) {
warning("Failed to download raster file.")
return(character())
}
raster <- private$importRaster(destFile)
return(raster)
}
)
)
#' @title Streams response from a WFS
#' @description Dispatches a WFS request and parses response from the stream directly.
#' @seealso \code{\link{WFSRequest}}, \code{\link{WFSCachingClient}}
#' @usage NULL
#' @format NULL
#' @import R6
#' @author Jussi Jousimo \email{jvj@@iki.fi}
#' @export
WFSStreamingClient <- R6::R6Class(
"WFSStreamClient",
inherit = WFSClient,
public = list(
listLayers = function() {
message("Streaming layers directly from the data source\n",
private$request$getDataSource())
layers <- private$.listLayers(dataSource = private$request$getDataSource())
return(layers)
},
getLayer = function(layer, ...) {
if (missing(layer)) {
stop("Required argument 'layer' missing.")
}
message("Reading layers directly from the data source\n",
private$request$getDataSource())
response <- private$.getLayer(dataSource = private$request$getDataSource(),
layer = layer, ...)
return(response)
}
)
)
#' @title Downloads response from a WFS and parses the intermediate file
#' @description Dispatches a WFS request, saves the response to a file and parses the file. The data can be converted
#' using ogr2ogr of RGDAL. Provides a caching mechanism for subsequent queries on the same data.
#' @seealso \code{\link{WFSRequest}}, \code{\link{WFSStreamingClient}}
#' @usage NULL
#' @format NULL
#' @import R6
#' @import digest
#' @author Jussi Jousimo \email{jvj@@iki.fi}
#' @export
WFSCachingClient <- R6::R6Class(
"WFSCachingClient",
inherit = WFSClient,
private = list(
cachedResponseFile = NULL,
requestHash = NULL, # Save the hash of the request object to detect changed request
cacheResponse = function() {
if (is.null(private$cachedResponseFile) || private$requestHash != digest(private$request)) {
destFile <- private$request$getDataSource()
if (length(destFile) == 0) {
return(character(0))
}
private$cachedResponseFile <- destFile
private$requestHash <- digest(private$request)
}
return(invisible(self))
}
),
public = list(
saveGMLFile = function(destFile) {
"Saves cached response to a file in GML format."
if (missing(destFile)) {
stop("Required argument 'destFile' missing.")
}
if (private$cachedResponseFile == "" || !file.exists(private$cachedResponseFile)) {
stop("Response file missing. No query has been made?")
}
file.copy(private$cachedResponseFile, destFile)
return(invisible(self))
},
loadGMLFile = function(fromFile) {
"Loads saved GML file into the object for parsing."
if (missing(fromFile)) {
stop("Required argument 'fromFile' missing.")
}
if (!file.exists(fromFile)) {
stop("File does not exist.")
}
# FIXME: Woah, what's going on here?
private$cachedResponseFile <<- fromFile
return(invisible(self))
},
listLayers = function() {
if (is.character(private$cacheResponse())) {
return(character(0))
}
layers <- private$.listLayers(dataSource = private$cachedResponseFile)
return(layers)
},
getLayer = function(layer, ...) {
# If a character is returned, there is no destFile
if (is.character(private$cacheResponse())) {
return(character(0))
}
# Get the path to the response file
sourceFile <- private$cachedResponseFile
# Use (cached) response file path as data source.
response <- private$.getLayer(dataSource = sourceFile,
layer = layer, ...)
return(response)
}
)
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.