Añade tests para encoding (#19)

* Test encoding * Update docs with pkgdev * Arregla issue encoding Co-authored-by: dieghernan <[email protected]>
rOpenSpain · Feb 17, 2022 · 53c7bb4 · 53c7bb4
1 parent 2d76051
commit 53c7bb4
Show file tree

Hide file tree

Showing 22 changed files with 93 additions and 75 deletions.
diff --git a/R/atom_ad.R b/R/atom_ad.R
@@ -125,22 +125,7 @@ catr_atom_ad <- function(munic,
   # Guess what to read
   files <- list.files(exdir, full.names = TRUE, pattern = ".gml$")[1]
 
-  # Layer management
-  layers <- sf::st_layers(files)
-  df_layers <- data.frame(
-    layer = layers$name,
-    geomtype = unlist(layers$geomtype)
-  )
-  df_layers <- df_layers[!is.na(df_layers$geomtype), ]
-
-  # nocov start
-  if (nrow(df_layers) == 0) {
-    message("No spatial layers found.")
-    return(invisible(NULL))
-  }
-  # nocov end
-
-  sfobj <- sf::st_read(files, quiet = !verbose, layer = df_layers$layer[1])
+  sfobj <- st_read_layers_encoding(files, verbose)
 
   return(sfobj)
 }
diff --git a/R/atom_ad_db.R b/R/atom_ad_db.R
@@ -2,7 +2,6 @@
 #'
 #' @description
 #'
-#' **The goal of these functions is to serve as an internal helper**
 #'
 #' Create a database containing the urls provided in the INSPIRE ATOM service
 #' of the Spanish Cadastre for extracting Addresses.
@@ -78,7 +77,6 @@ catr_atom_ad_db_all <- function(cache = TRUE,
 }
 #' @rdname catr_atom_ad_db
 #' @name catr_atom_ad_to
-#' @keywords internal
 #' @export
 #' @param to Territorial office. It can be any type of string, the function
 #'  would perform a search using [base::grep()].

diff --git a/R/atom_bu.R b/R/atom_bu.R
@@ -141,7 +141,7 @@ catr_atom_bu <- function(munic,
   # Guess what to read
   files <- list.files(exdir, full.names = TRUE, pattern = ".gml$")
   files <- files[grepl(what, files, ignore.case = TRUE)]
-  sfobj <- sf::st_read(files[1], quiet = !verbose)
+  sfobj <- st_read_layers_encoding(files, verbose)
 
   return(sfobj)
 }
diff --git a/R/atom_bu_db.R b/R/atom_bu_db.R
@@ -2,7 +2,6 @@
 #'
 #' @description
 #'
-#' **The goal of these functions is to serve as an internal helper**
 #'
 #' Create a database containing the urls provided in the INSPIRE ATOM service
 #' of the Spanish Cadastre for extracting buildings.
@@ -77,7 +76,6 @@ catr_atom_bu_db_all <- function(cache = TRUE,
 }
 #' @rdname catr_atom_bu_db
 #' @name catr_atom_bu_to
-#' @keywords internal
 #' @export
 #' @param to Territorial office. It can be any type of string, the function
 #'  would perform a search using [base::grep()].

diff --git a/R/atom_cp.R b/R/atom_cp.R
@@ -132,7 +132,7 @@ catr_atom_cp <- function(munic,
   # Guess what to read
   files <- list.files(exdir, full.names = TRUE, pattern = ".gml$")
   files <- files[grepl(what, files, ignore.case = TRUE)]
-  sfobj <- sf::st_read(files[1], quiet = !verbose)
+  sfobj <- st_read_layers_encoding(files, verbose)
 
   return(sfobj)
 }
diff --git a/R/atom_cp_db.R b/R/atom_cp_db.R
@@ -2,7 +2,6 @@
 #'
 #' @description
 #'
-#' **The goal of these functions is to serve as an internal helper**
 #'
 #' Create a database containing the urls provided in the INSPIRE ATOM service
 #' of the Spanish Cadastre for extracting Cadastral Parcels.
@@ -77,7 +76,6 @@ catr_atom_cp_db_all <- function(cache = TRUE,
 }
 #' @rdname catr_atom_cp_db
 #' @name catr_atom_cp_to
-#' @keywords internal
 #' @export
 #' @param to Territorial office. It can be any type of string, the function
 #'  would perform a search using [base::grep()].

diff --git a/R/utils_read.R b/R/utils_read.R
@@ -0,0 +1,58 @@
+st_read_layers_encoding <- function(path, verbose) {
+  # Layer management and errors
+  layers <- tryCatch(sf::st_layers(path),
+    warning = function(e) {
+      return(NULL)
+    },
+    error = function(e) {
+      return(NULL)
+    }
+  )
+
+  # If NULL change to a new tempfile and retry
+  # This may be an error on encoding
+  if (is.null(layers)) {
+    newlines <- readLines(path,
+      encoding = "ISO-8859-1"
+    )
+
+    newlines <- gsub("\xd1|\xbf", "_", newlines)
+    path <- tempfile(fileext = ".gml")
+    writeLines(newlines, path)
+
+    layers <- sf::st_layers(path)
+  }
+
+  df_layers <- tibble::tibble(
+    layer = layers$name,
+    geomtype = unlist(layers$geomtype)
+  )
+
+  if (nrow(df_layers) == 0 | !"geomtype" %in% names(df_layers)) {
+    message("No spatial layers found.")
+    return(invisible(NULL))
+  }
+
+  df_layers <- df_layers[!is.na(df_layers$geomtype), ]
+
+  # nocov start
+  if (nrow(df_layers) == 0) {
+    message("No spatial layers found.")
+    return(invisible(NULL))
+  }
+  # nocov end
+
+
+  out <- try(sf::st_read(path,
+    layer = df_layers$layer[1],
+    quiet = !verbose
+  ), silent = TRUE)
+
+  # It may be an error, check
+  if (inherits(out, "try-error")) {
+    message("CatastRO: The result is an empty object")
+    return(invisible(NULL))
+  }
+
+  return(out)
+}
diff --git a/R/utils_wfs.R b/R/utils_wfs.R
@@ -88,41 +88,7 @@ wfs_api_query <- function(entry, ..., verbose = TRUE) {
 wfs_results <- function(res, verbose) {
   # Check result
   if (res$is_sf) {
-
-    # Layer management
-    layers <- sf::st_layers(res$path)
-    df_layers <- tibble::tibble(
-      layer = layers$name,
-      geomtype = unlist(layers$geomtype)
-    )
-
-    if (nrow(df_layers) == 0 | !"geomtype" %in% names(df_layers)) {
-      message("No spatial layers found.")
-      unlink(res$path, force = TRUE)
-      return(invisible(NULL))
-    }
-
-    df_layers <- df_layers[!is.na(df_layers$geomtype), ]
-
-    # nocov start
-    if (nrow(df_layers) == 0) {
-      message("No spatial layers found.")
-      unlink(res$path, force = TRUE)
-      return(invisible(NULL))
-    }
-    # nocov end
-
-    out <- try(sf::st_read(res$path,
-      layer = df_layers$layer[1],
-      quiet = !verbose
-    ), silent = TRUE)
-
-    # It may be an error, check
-    if (inherits(out, "try-error")) {
-      message("CatastRO: The result is an empty object")
-      unlink(res$path, force = TRUE)
-      return(invisible(NULL))
-    }
+    out <- st_read_layers_encoding(res$path, verbose)
 
     unlink(res$path, force = TRUE)
     return(out)

diff --git a/README.md b/README.md
@@ -128,10 +128,10 @@ This script highlights some features of **CatastRo** :
 library(CatastRo)
 
 catr_ovc_cpmrc(rc = "13077A01800039")
-#> # A tibble: 1 × 10
+#> # A tibble: 1 x 10
 #>   xcoord ycoord refcat     address pc.pc1 pc.pc2 geo.xcen geo.ycen geo.srs ldt  
 #>    <dbl>  <dbl> <chr>      <chr>   <chr>  <chr>  <chr>    <chr>    <chr>   <chr>
-#> 1  -3.46   38.6 13077A018… DS DIS… 13077… 18000… -3.4575… 38.6184… EPSG:4… DS D…
+#> 1  -3.46   38.6 13077A018~ DS DIS~ 13077~ 18000~ -3.4575~ 38.6184~ EPSG:4~ DS D~
 ```
 
 ### Extract a cadastral reference from a given set of coordinates
@@ -142,10 +142,10 @@ catr_ovc_rccoor(
   lon = -3.45624183836806,
   srs = "4230"
 )
-#> # A tibble: 1 × 8
+#> # A tibble: 1 x 8
 #>   refcat         address           pc.pc1 pc.pc2 geo.xcen geo.ycen geo.srs ldt  
 #>   <chr>          <chr>             <chr>  <chr>     <dbl>    <dbl> <chr>   <chr>
-#> 1 13077A01800039 DS DISEMINADO  P… 13077… 18000…    -3.46     38.6 EPSG:4… DS D…
+#> 1 13077A01800039 DS DISEMINADO  P~ 13077~ 18000~    -3.46     38.6 EPSG:4~ DS D~
 ```
 
 ### Extract geometries using the ATOM service

diff --git a/codemeta.json b/codemeta.json
@@ -276,7 +276,7 @@
     },
     "SystemRequirements": null
   },
-  "fileSize": "1390.267KB",
+  "fileSize": "1390.29KB",
   "citation": [
     {
       "@type": "SoftwareSourceCode",

diff --git a/man/catr_atom_ad_db.Rd b/man/catr_atom_ad_db.Rd
diff --git a/man/catr_atom_bu_db.Rd b/man/catr_atom_bu_db.Rd
diff --git a/man/catr_atom_cp_db.Rd b/man/catr_atom_cp_db.Rd
diff --git a/man/figures/README-unnamed-chunk-6-1.png b/man/figures/README-unnamed-chunk-6-1.png
diff --git a/man/figures/README-unnamed-chunk-7-1.png b/man/figures/README-unnamed-chunk-7-1.png
diff --git a/man/figures/README-unnamed-chunk-8-1.png b/man/figures/README-unnamed-chunk-8-1.png
diff --git a/tests/testthat/test-catr_atom_ad.R b/tests/testthat/test-catr_atom_ad.R
@@ -14,3 +14,15 @@ test_that("ATOM Addresses", {
   ), "Ignoring 'to' parameter. No results for XXX")
   expect_s3_class(s, "sf")
 })
+
+
+test_that("ATOM Encoding issue", {
+  skip_on_cran()
+
+  s <- catr_atom_ad("12028")
+  expect_s3_class(s, "sf")
+
+  expect_silent(catr_atom_ad("23078"))
+  expect_silent(catr_atom_ad("03050"))
+  expect_silent(catr_atom_ad("23051"))
+})
diff --git a/tests/testthat/test-catr_atom_bu.R b/tests/testthat/test-catr_atom_bu.R
@@ -25,6 +25,7 @@ test_that("ATOM Buildings", {
 test_that("ATOM Encoding issue", {
   skip_on_cran()
 
-  s <- catr_atom_bu("12028")
-  expect_s3_class(s, "sf")
+  expect_silent(catr_atom_bu("23078"))
+  expect_silent(catr_atom_bu("03050"))
+  expect_silent(catr_atom_bu("23051"))
 })
diff --git a/tests/testthat/test-catr_atom_cp.R b/tests/testthat/test-catr_atom_cp.R
@@ -15,3 +15,14 @@ test_that("ATOM Cadastral Parcels", {
   ), "Ignoring 'to' parameter. No results for XXX")
   expect_s3_class(s, "sf")
 })
+
+test_that("ATOM Encoding issue", {
+  skip_on_cran()
+
+  s <- catr_atom_cp("12028")
+  expect_s3_class(s, "sf")
+
+  expect_silent(catr_atom_cp("23078"))
+  expect_silent(catr_atom_cp("03050"))
+  expect_silent(catr_atom_cp("23051"))
+})
diff --git a/vignettes/dataviz-1.png b/vignettes/dataviz-1.png
diff --git a/vignettes/minimal-1.png b/vignettes/minimal-1.png
diff --git a/vignettes/santbernabeu-1.png b/vignettes/santbernabeu-1.png