Merge branch 'main' into v0010

R/gpkg-contents.R

@@ -32,17 +32,17 @@ gpkg_ogr_contents <- function(x) {
 
 
 #' List Tables Registered in a GeoPackage `gpkg_contents`
-#' 
+#'
 #' Get a vector of grid, feature and attribute table names registered in GeoPackage.
-#' 
+#'
 #' @param x A _geopackage_ object, path to a GeoPackage or an _SQLiteConnection_
 #' @param ogr Intersect `gpkg_contents` table name result with OGR tables that are listed in `gpkg_ogr_contents`? Default: `FALSE`
 #' @export
 #' @return character. Vector of grid, feature and attribute table names registered in GeoPackage.
 #' @seealso [gpkg_contents()] [gpkg_list_tables()]
 gpkg_list_contents <- function(x, ogr = FALSE) {
   y <- gpkg_contents(x)$table_name
-  if (is.null(y)) 
+  if (is.null(y))
     y <- character()
   if (isTRUE(ogr)) {
     z <- gpkg_ogr_contents(x)$table_name
@@ -60,7 +60,7 @@ gpkg_list_contents <- function(x, ogr = FALSE) {
 #' @param data_type _character_. One of: `2d-gridded-coverage`, `"features"`, `"attributes"`. Default `NULL` will attempt to auto-detect table type based on `gpkg_table_pragma()` information; falls back to `"attributes"` if raster or vector data are not detected.
 #' @param description Default: `""`
 #' @param template Deprecated. A list containing elements `"srsid"` and `"ext"`.
-#' @param srs_id _integer_. Spatial Reference System ID. Must be defined in `gpkg_spatial_ref_sys` table. 
+#' @param srs_id _integer_. Spatial Reference System ID. Must be defined in `gpkg_spatial_ref_sys` table.
 #' @param ext _numeric_. A numeric vector of length four specifying the bounding box extent.
 #' @param query_string _logical_. Return SQLite statement rather than executing it? Default: `FALSE`
 #'
@@ -69,19 +69,18 @@ gpkg_list_contents <- function(x, ogr = FALSE) {
 #' @export
 gpkg_add_contents <- function(x, table_name, data_type = NULL, description = "", srs_id = NULL, ext = NULL, template = NULL, query_string = FALSE) {
   dt <- data_type
-
   if (!missing(srs_id) && !is.null(srs_id)) {
     if (!length(srs_id) == 1 || !is.integer(as.integer(srs_id)))
       stop("`srs_id` should be an integer of length 1")
     cr <- srs_id
-  } 
-  
+  }
+
   if (!missing(ext) && !is.null(ext)) {
     if (!length(ext) == 4 || !is.numeric(ext))
       stop("`ext` should be a numeric vector of length 4")
     ex <- ext
   }
-  
+
   if (!missing(template) && !is.null(template)) {
     .Deprecated(msg = "`template` argument is deprecated, use `ext` and `srs_id` arguments directly")
     # template as a list
@@ -94,12 +93,12 @@ gpkg_add_contents <- function(x, table_name, data_type = NULL, description = "",
       # if (!requireNamespace("terra", quietly = TRUE)) {
       #   stop("package `terra` is required to add contents with a custom extent", call. = FALSE)
       # }
-      # 
+      #
       # # convert sf object to SpatVector
       # if (inherits(template, 'sf')) {
       #   template <- terra::vect(template)
       # }
-      # 
+      #
       # # template as terra object
       # if (inherits(template, c("SpatRaster", "SpatVector", "SpatVectorProxy"))){
       #   ex <- as.numeric(terra::ext(template))
@@ -110,7 +109,7 @@ gpkg_add_contents <- function(x, table_name, data_type = NULL, description = "",
     ex <- c(-180, -90, 180, 90)
     cr <- 4326
   }
-  
+
   if (is.null(dt)) {
     gtp <- try(gpkg_table_pragma(x, table_name), silent = TRUE)
     if (inherits(gtp, 'try-error')) {
@@ -123,26 +122,27 @@ gpkg_add_contents <- function(x, table_name, data_type = NULL, description = "",
       # has tile information: 2D coverage
       dt <- "2d-gridded-coverage"
     } else if (any(c("POINT", "CURVE","LINESTRING", "SURFACE",
-                     "CURVEPOLYGON", "POLYGON", "GEOMETRYCOLLECTION",
-                     "MULTISURFACE", "MULTIPOLYGON", "MULTICURVE", 
+                     "CURVEPOLYGON", "POLYGON",
+                     "GEOMETRY", "GEOMETRYCOLLECTION",
+                     "MULTISURFACE", "MULTIPOLYGON", "MULTICURVE",
                      "MULTILINESTRING", "MULTIPOINT")
-                   %in% gtp$table_info.type)) {
+                   %in% toupper(gtp$table_info.type))) {
       # has a geometry column: vector geometry
       dt <- "features"
     } else {
       # all other cases are attributes
       dt <- "attributes"
     }
   }
-  
+
   # create gpkg_contents empty table if needed
   if (!"gpkg_contents" %in% gpkg_list_tables(x)) {
     x <- gpkg_create_contents(x)
   }
   q <- paste0(
-    "INSERT INTO gpkg_contents (table_name, data_type, identifier, 
+    "INSERT INTO gpkg_contents (table_name, data_type, identifier,
                                   description, last_change,
-                                  min_x, min_y, max_x, max_y, srs_id) 
+                                  min_x, min_y, max_x, max_y, srs_id)
        VALUES ('",
           table_name ,
           "', '", dt, "', '",
@@ -152,14 +152,14 @@ gpkg_add_contents <- function(x, table_name, data_type = NULL, description = "",
           "','",
           strftime(Sys.time(), '%Y-%m-%dT%H:%M:%OS3Z'),
           "', ", ex[1], ", ", ex[2], ", ",
-          ex[3], ", ", ex[4], ", ", 
+          ex[3], ", ", ex[4], ", ",
           cr,"
                             );")
-  
+
   if (query_string) {
     return(q)
   }
-  
+
   # append to gpkg_contents
   x <- gpkg_execute(x, q)
 
@@ -182,18 +182,18 @@ gpkg_update_contents <- function(x) {
   tables_nonstandard <- tables[!grepl("^gpkg_.*|rtree_.*|gpkgext_|sqlite_sequence", tables)]
   todo <- tables_nonstandard[!tables_nonstandard %in% contents$table_name]
   torem <- contents$table_name[!contents$table_name %in% tables]
-  
-  # create gpkg_contents records, 
+
+  # create gpkg_contents records,
   # TODO: set extent via template?
   for (y in todo) {
     gpkg_add_contents(x, table_name = y, description = y)
   }
-  
+
   # remove gpkg_contents records
   for (y in torem) {
     gpkg_delete_contents(x, table_name = y)
   }
-  
+
   !inherits(x, 'try-error')
 }
 
@@ -202,7 +202,7 @@ gpkg_update_contents <- function(x) {
 #' @export
 gpkg_delete_contents <- function(x, table_name, query_string = FALSE) {
   q <- paste0("DELETE FROM gpkg_contents WHERE table_name = '", table_name, "'")
-  
+
   if (query_string) {
     return(q)
   }
@@ -227,7 +227,7 @@ gpkg_create_contents <- function(x, query_string = FALSE) {
           srs_id INTEGER,
           CONSTRAINT fk_gc_r_srs_id FOREIGN KEY (srs_id) REFERENCES gpkg_spatial_ref_sys(srs_id)
         )"
-  
+
   if (query_string) {
     return(q)
   }
@@ -243,7 +243,7 @@ gpkg_create_contents <- function(x, query_string = FALSE) {
 #         )")
 #   !inherits(res, 'try-error')
 # }
-# 
+#
 # gpkg_add_ogr_contents <- function(x, table_name, feature_count) {
 #   res <- gpkg_execute(x, paste0(
 #     "INSERT INTO gpkg_ogr_contents (table_name, feature_count)