-
Notifications
You must be signed in to change notification settings - Fork 2
/
WFSClient.R
executable file
·265 lines (240 loc) · 8.43 KB
/
WFSClient.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
# 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)
}
)
)