Extract download limits directly from WFS

NEWS.md

@@ -1,3 +1,7 @@
+# bcdata 0.2.2.9000
+### IMPROVEMENTS
+- Setting the `bcdata.single_download_limit` limit dynamically from the getCapabilities endpoint. 
+
 # bcdata 0.2.2
 ### IMPROVEMENTS
 * Added `bcdc_list_groups` and `bcdc_list_group_records` to provide the ability to query on the group endpoint of the catalogue API. #234

R/bcdc_options.R

@@ -61,6 +61,7 @@
 #' )
 #' }
 #' @export
+#'
 
 bcdc_options <- function() {
   null_to_na <- function(x) {
@@ -71,14 +72,42 @@ bcdc_options <- function() {
     ~ option, ~ value, ~default,
     "bcdata.max_geom_pred_size", null_to_na(getOption("bcdata.max_geom_pred_size")), 5E5,
     "bcdata.chunk_limit", null_to_na(getOption("bcdata.chunk_limit")), 1000,
-    "bcdata.single_download_limit", null_to_na(getOption("bcdata.single_download_limit")), 10000
+    "bcdata.single_download_limit",
+    null_to_na(getOption("bcdata.single_download_limit",
+                         default = ._bcdataenv_$bcdata_dl_limit)), 10000
   )
 }
 
+
 check_chunk_limit <- function(){
-  chunk_value <- options("bcdata.chunk_limit")$bcdata.chunk_limit
+  chunk_value <- getOption("bcdata.chunk_limit")
+  chunk_limit <- getOption("bcdata.single_download_limit", default = ._bcdataenv_$bcdata_dl_limit)
+
+  if(!is.null(chunk_value) && chunk_value >= chunk_limit){
+    stop(glue::glue("Your chunk value of {chunk_value} exceed the BC Data Catalogue chunk limit of {chunk_limit}"), call. = FALSE)
+  }
+}
+
+
+bcdc_single_download_limit <- function() {
+  if (has_internet()) {
+    url <- "http://openmaps.gov.bc.ca/geo/pub/ows?service=WFS&version=2.0.0&request=Getcapabilities"
+    cli <- bcdata:::bcdc_http_client(url, auth = FALSE)
+
+    cc <- cli$get(query = list(
+      SERVICE = "WFS",
+      VERSION = "2.0.0",
+      REQUEST = "Getcapabilities"
+    ))
+
+    res <- cc$parse("UTF-8")
+    doc <- xml2::read_xml(res)
 
-  if(!is.null(chunk_value) && chunk_value >= 10000){
-    stop(glue::glue("Your chunk value of {chunk_value} exceed the BC Data Catalogue chunk limit"), call. = FALSE)
+    constraints <- xml2::xml_find_all(doc, ".//ows:Constraint")
+    count_defaults <- constraints[which(xml2::xml_attrs(constraints) %in% "CountDefault")]
+    xml2::xml_double(count_defaults)
+  } else {
+    message("No access to internet")
+    10000L
   }
 }

R/utils-classes.R

@@ -379,7 +379,7 @@ collect.bcdc_promise <- function(x, ...){
   ## Determine total number of records for pagination purposes
   number_of_records <- bcdc_number_wfs_records(query_list, cli)
 
-  if (number_of_records < getOption("bcdata.single_download_limit", default = 10000)) {
+  if (number_of_records < getOption("bcdata.single_download_limit", default = ._bcdataenv_$bcdata_dl_limit)) {
     cc <- tryCatch(cli$post(body = query_list, encode = "form"),
                    error = function(e) {
                      stop("There was an issue processing this request.

R/utils.R

@@ -210,10 +210,10 @@ gml_types <- function(x) {
 
 get_record_warn_once <- function(...) {
   silence <- isTRUE(getOption("silence_named_get_record_warning"))
-  warned <- bcdata_env$named_get_record_warned
+  warned <- ._bcdataenv_$named_get_record_warned
   if (!silence && !warned) {
     warning(..., call. = FALSE)
-    assign("named_get_record_warned", TRUE, envir = bcdata_env)
+    assign("named_get_record_warned", TRUE, envir = ._bcdataenv_)
   }
 }
 

R/zzz.R

@@ -10,10 +10,12 @@
 # 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.
 
-bcdata_env <- new.env(parent = emptyenv())
+._bcdataenv_ <- new.env(parent = emptyenv())
 
 .onLoad <- function(...) {
- assign("named_get_record_warned", FALSE, envir = bcdata_env) # nocov
+  ._bcdataenv_$named_get_record_warned <- FALSE # nocov
+  ._bcdataenv_$bcdata_dl_limit <- bcdc_single_download_limit() # nocov
+
 }
 
 # Define bcdc_sf as a subclass of sf so that it works

tests/testthat/test-options.R

@@ -33,3 +33,15 @@ test_that("bcdata.single_download_limit", {
   )
 
 })
+
+test_that("bcdata.single_download_limit can be changes",{
+  withr::local_options(list(bcdata.single_download_limit = 13))
+  expect_equal(getOption("bcdata.single_download_limit"), 13)
+})
+
+test_that("bcdc_single_download_limit returns a number",{
+  skip_on_cran()
+  skip_if_net_down()
+  lt <- bcdc_single_download_limit()
+  expect_type(lt, "double")
+})