diff --git a/R/gpkg-contents.R b/R/gpkg-contents.R index e55f615..3cde2e0 100644 --- a/R/gpkg-contents.R +++ b/R/gpkg-contents.R @@ -32,9 +32,9 @@ 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 @@ -42,7 +42,7 @@ gpkg_ogr_contents <- function(x) { #' @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,10 +122,11 @@ 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 { @@ -134,15 +134,15 @@ gpkg_add_contents <- function(x, table_name, data_type = NULL, description = "", 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)