Two wfs

R/utils-classes.R

@@ -87,6 +87,7 @@ print.bcdc_record <- function(x, ...) {
 record_print_helper <- function(r, n, print_avail = FALSE){
  cat(n, ") ", clean_wfs(r$name), "\n", sep = "")
  #cat(" description:", r$description, "\n")
+ cat(" warehouse name:", ifelse(is_whse_object_name(r$whse_name), r$whse_name, NA_character_), "\n")
  cat(" format:", clean_wfs(formats_from_resource(r)), "\n")
  if (r$format != "wms") cat(" url:", r$url, "\n")
  cat(" resource:", r$id, "\n")

R/utils.R

@@ -184,6 +184,7 @@ get_record_warn_once <- function(...) {
 clean_wfs <- function(x){
  dplyr::case_when(
  x == "WMS getCapabilities request" ~ "WFS request (Spatial Data)",
+ x == "WMS getCapabilities request (Generalized View)" ~ "WFS request (Spatial Data)",
  x == "wms" ~ "wfs",
  TRUE ~ x
  )
@@ -231,6 +232,7 @@ resource_to_tibble <- function(x){
  dplyr::tibble(
  name = purrr::map_chr(x, "name"),
  url = purrr::map_chr(x, "url"),
+ whse_name = parse_url_for_whse_name(url),
  id = purrr::map_chr(x, "id"),
  format = purrr::map_chr(x, "format"),
  ext = purrr::map_chr(x, safe_file_ext),
@@ -336,3 +338,15 @@ catch_catalogue_error <- function(catalogue_response) {
  stop(msg, call. = FALSE)
  }
 }
+
+get_whse_from_resource <- function(record, resource){
+
+ #record <- bcdc_get_record(record)
+ rdf <- record$resource_df$url[record$resource_df$id == resource]
+ parse_url_for_whse_name(rdf)
+
+}
+
+parse_url_for_whse_name <- function(x) {
+ basename(dirname(x))
+}

scratch/scratch_dem.R

@@ -0,0 +1,47 @@
+# Copyright 2019 Province of British Columbia
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and limitations under the License.
+
+
+
+bcdc_get_dem <- function(bbox) {
+
+ if (inherits(bbox, "bbox")) {
+ bbox <- paste(bbox, collapse = ",")
+ }
+
+ query_list <- list(
+ service="WCS",
+ version="1.0.0",
+ request="GetCoverage",
+ coverage="pub:bc_elevation_25m_bcalb",
+ bbox=bbox,
+ CRS="EPSG:3005",
+ RESPONSE_CRS = "EPSG:3005",
+ Format="GeoTIFF",
+ resx=25,
+ resy=25
+ )
+
+ ## Drop any NULLS from the list
+ query_list <- compact(query_list)
+
+ ## GET and parse data to sf object
+ cli <- bcdc_http_client(url = "https://delivery.openmaps.gov.bc.ca/om/wcs")
+
+
+
+ tiff_file <- tempfile(fileext = ".tif")
+ res <- cli$get(query = query_list, disk = tiff_file)
+ close(file(tiff_file))
+
+ raster::raster(res$content)
+}