From c509a5dfedf74fa258f1a494c00cac8466eab9bf Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Sun, 3 Mar 2024 13:44:17 -0800 Subject: [PATCH] for tasks in #18 - deprecate gpkg_create_dummy_features() - add gpkg_create_empty_features() - add gpkg_create_geometry_columns() - add gpkg_add_geometry_columns() - deprecate gpkg_contents(template=) column --- NAMESPACE | 3 ++ R/gpkg-dummy.R | 58 ++++++++++----------------- R/gpkg-features.R | 65 +++++++++++++++++++++++++++++++ R/gpkg-geometry-columns.R | 53 +++++++++++++++++++++++++ R/gpkg-srs.R | 14 +++++-- R/gpkg-table.R | 2 +- inst/tinytest/test_gpkg.R | 11 ++++-- man/gpkg-features.Rd | 46 ++++++++++++++++++++++ man/gpkg_create_dummy_features.Rd | 6 ++- 9 files changed, 210 insertions(+), 48 deletions(-) create mode 100644 R/gpkg-features.R create mode 100644 R/gpkg-geometry-columns.R create mode 100644 man/gpkg-features.Rd diff --git a/NAMESPACE b/NAMESPACE index 94a80df..ed7524d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -21,6 +21,7 @@ export(geopackage) export(gpkg) export(gpkg_2d_gridded_coverage_ancillary) export(gpkg_add_contents) +export(gpkg_add_geometry_columns) export(gpkg_add_metadata_extension) export(gpkg_add_relatedtables_extension) export(gpkg_add_spatial_ref_sys) @@ -30,6 +31,8 @@ export(gpkg_connect) export(gpkg_contents) export(gpkg_create_contents) export(gpkg_create_dummy_features) +export(gpkg_create_empty_features) +export(gpkg_create_geometry_columns) export(gpkg_create_spatial_ref_sys) export(gpkg_create_spatial_view) export(gpkg_delete_contents) diff --git a/R/gpkg-dummy.R b/R/gpkg-dummy.R index a63a585..8ad5981 100644 --- a/R/gpkg-dummy.R +++ b/R/gpkg-dummy.R @@ -1,10 +1,12 @@ #' Create a Dummy Feature Dataset in a GeoPackage #' -#' This function creates a minimal (empty) feature table and `gpkg_geometry_columns` table entry. +#' This function has been deprecated. Please use `gpkg_create_empty_features()`. +#' +#' Create a minimal (empty) feature table and `gpkg_geometry_columns` table entry. #' #' @details This is a workaround so that `gpkg_vect()` (via `terra::vect()`) will recognize a GeoPackage as containing geometries and allow for use of OGR query utilities. The "dummy table" is not added to `gpkg_contents` and you should not try to use it for anything. The main purpose is to be able to use `gpkg_vect()` and `gpkg_ogr_query()` on a GeoPackage that contains only gridded and/or attribute data. #' -#' @seealso [gpkg_vect()] [gpkg_ogr_query()] +#' @seealso [gpkg_create_empty_features()] [gpkg_vect()] [gpkg_ogr_query()] #' #' @param x A _geopackage_ object #' @param table_name A table name; default `"dummy_feature"` @@ -15,46 +17,26 @@ gpkg_create_dummy_features <- function(x, table_name = "dummy_feature", values = NULL) { - if (is.null(values)) { - values <- paste0("'", table_name, "', 'geom', 'GEOMETRY', -1, 0, 0") - } - - res <- 0 - if (!table_name %in% gpkg_list_tables(x)) { - res <- gpkg_execute(x, paste0("CREATE TABLE ", table_name, " ( - id INTEGER PRIMARY KEY AUTOINCREMENT, - geom GEOMETRY - );")) - } - if (!inherits(res, 'try-error') && res == 0) { - gpkg_create_spatial_ref_sys(x) - } - - if (!inherits(res, 'try-error') && res == 0 && - !"gpkg_geometry_columns" %in% gpkg_list_tables(x)) { - res <- gpkg_execute(x, " CREATE TABLE gpkg_geometry_columns ( - table_name TEXT NOT NULL, - column_name TEXT NOT NULL, - geometry_type_name TEXT NOT NULL, - srs_id INTEGER NOT NULL, - z TINYINT NOT NULL, - m TINYINT NOT NULL, - CONSTRAINT pk_geom_cols PRIMARY KEY (table_name, column_name), - CONSTRAINT uk_gc_table_name UNIQUE (table_name), - CONSTRAINT fk_gc_tn FOREIGN KEY (table_name) REFERENCES gpkg_contents(table_name), - CONSTRAINT fk_gc_srs FOREIGN KEY (srs_id) REFERENCES gpkg_spatial_ref_sys (srs_id));") - } + .Deprecated("gpkg_create_empty_features") - if (!inherits(res, 'try-error') && res == 0) { - if (!table_name %in% gpkg_collect(x, "gpkg_geometry_columns")$table_name) { - res <- gpkg_execute(x, paste0( - "INSERT INTO gpkg_geometry_columns (table_name, column_name, - geometry_type_name, srs_id, z, m) - VALUES (", values, ");" - )) + if (!is.null(values) && length(values) == 1 && is.character(values)) { + values <- strsplit(gsub("\\(|\\)|'|\"", "", values), ",")[[1]] + if (!length(values) == 6) { + stop("Invalid `values` argument. Six values are required.", call. = FALSE) } + } else { + values <- c(table_name, 'geom', 'GEOMETRY', '-1', '0', '0') } + res <- gpkg_create_empty_features(x, + table_name = values[1], + column_name = values[2], + geometry_type_name = values[3], + srs_id = as.integer(values[4]), + z = as.integer(values[5]), + m = as.integer(values[6]), + contents = FALSE) + !inherits(res, 'try-error') } \ No newline at end of file diff --git a/R/gpkg-features.R b/R/gpkg-features.R new file mode 100644 index 0000000..ce00abd --- /dev/null +++ b/R/gpkg-features.R @@ -0,0 +1,65 @@ +# gpkg feature tables + +#' Create an empty feature table +#' +#' Create an empty feature table and associated entries for `gpkg_spatial_ref_sys`, and `gpkg_geometry_columns`. +#' +#' @param x A `geopackage` Object +#' @param table_name _character_. New table name. +#' @param geometry_type_name _character_. Geometry type name. Default: `"GEOMETRY"` +#' @param column_name _character_. Geometry column name. Default `"geom"` +#' @param srs_id _integer_. Spatial Reference System ID. Must be defined in `gpkg_spatial_ref_sys` table. +#' @param z _integer_. Default: `0` +#' @param m _integer_. Default: `0` +#' @param contents _logical_. If `TRUE` (default) add the new table to `gpkg_contents` table. +#' @param description _character_. Description for `gpkg_contents` table. Default: `""` +#' @param ext _numeric_. A numeric vector of length four specifying the bounding box extent. +#' +#' @return _integer_ result of `gpkg_execute()`. Returns `1` if a new geometry record is appended to `gpkg_geometry_columns` table. +#' +#' @export +#' @rdname gpkg-features +gpkg_create_empty_features <- function(x, + table_name, + column_name = "geom", + geometry_type_name = "GEOMETRY", + srs_id = 4326, + z = 0L, + m = 0L, + contents = TRUE, + description = "", + ext = c(-180, -90, 180, 90)) { + + # gpkg_create_contents(x) + gpkg_create_spatial_ref_sys(x) + gpkg_create_geometry_columns(x) + + res <- 0 + if (!table_name %in% gpkg_list_tables(x)) { + res <- gpkg_execute(x, paste0("CREATE TABLE ", table_name, " ( + id INTEGER PRIMARY KEY AUTOINCREMENT, + geom ", geometry_type_name, ");")) + } + + if (!inherits(res, 'try-error') && res == 0) { + + if (contents) { + gpkg_add_contents(x, + table_name = table_name, + description = description, + srs_id = srs_id, + ext = ext) + } + + res <- gpkg_add_geometry_columns( + x, + table_name = table_name, + column_name = column_name, + geometry_type_name = geometry_type_name, + srs_id = srs_id, + z = z, + m = m + ) + } + res +} diff --git a/R/gpkg-geometry-columns.R b/R/gpkg-geometry-columns.R new file mode 100644 index 0000000..d231e81 --- /dev/null +++ b/R/gpkg-geometry-columns.R @@ -0,0 +1,53 @@ +#' GeoPackage Geometry Columns +#' +#' Create `gpkg_geometry_columns` table to account for geometry columns within the database with `gpkg_create_geometry_columns()`. Register new geometry columns with `gpkg_add_geometry_columns()`. +#' +#' @param x A _geopackage_ object, or path to GeoPackage file. +#' +#' @return _integer_. `1` if table created or row inserted successfully, `0` otherwise. +#' @export +#' @rdname gpkg-geometry-columns +gpkg_create_geometry_columns <- function(x) { + res <- 0 + if (!"gpkg_geometry_columns" %in% gpkg_list_tables(x)) + res <- gpkg_execute(x, "CREATE TABLE gpkg_geometry_columns ( + table_name TEXT NOT NULL, + column_name TEXT NOT NULL, + geometry_type_name TEXT NOT NULL, + srs_id INTEGER NOT NULL, + z TINYINT NOT NULL, + m TINYINT NOT NULL, + CONSTRAINT pk_geom_cols PRIMARY KEY (table_name, column_name), + CONSTRAINT uk_gc_table_name UNIQUE (table_name), + CONSTRAINT fk_gc_tn FOREIGN KEY (table_name) REFERENCES gpkg_contents (table_name), + CONSTRAINT fk_gc_srs FOREIGN KEY (srs_id) REFERENCES gpkg_spatial_ref_sys (srs_id));") + res +} + +#' @param table_name _character_. New table name. +#' @param geometry_type_name _character_. Geometry type name. Default: `"GEOMETRY"` +#' @param column_name _character_. Geometry column name. Default `"geom"` +#' @param srs_id _integer_. Spatial Reference System ID. Must be defined in `gpkg_spatial_ref_sys` table. +#' @param z _integer_. Default: `0` +#' @param m _integer_. Default: `0` +#' +#' @export +#' @rdname gpkg-geometry-columns +gpkg_add_geometry_columns <- function(x, + table_name, + column_name, + geometry_type_name = "GEOMETRY", + srs_id, z, m) { + res <- 0 + if (!table_name %in% gpkg_collect(x, "gpkg_geometry_columns")$table_name) { + values <- paste0("'", table_name, "', '", column_name, + "', '", geometry_type_name, "', ", + srs_id, ", ", z, ", ", m) + res <- gpkg_execute(x, paste0( + "INSERT INTO gpkg_geometry_columns + (table_name, column_name, geometry_type_name, srs_id, z, m) + VALUES (", values, ");" + )) + } + res +} \ No newline at end of file diff --git a/R/gpkg-srs.R b/R/gpkg-srs.R index b77e098..03e64af 100644 --- a/R/gpkg-srs.R +++ b/R/gpkg-srs.R @@ -31,8 +31,10 @@ gpkg_list_srs <- function(x, column_name = "srs_id") { #' @rdname gpkg-srs gpkg_create_spatial_ref_sys <- function(x, default = TRUE, query_string = FALSE) { x <- .gpkg_connection_from_x(x) + qout <- character() + q <- character() if (!"gpkg_spatial_ref_sys" %in% gpkg_list_tables(x)) { - q <- "CREATE TABLE gpkg_spatial_ref_sys ( + qout <- "CREATE TABLE gpkg_spatial_ref_sys ( srs_name TEXT NOT NULL, srs_id INTEGER PRIMARY KEY, organization TEXT NOT NULL, @@ -41,11 +43,15 @@ gpkg_create_spatial_ref_sys <- function(x, default = TRUE, query_string = FALSE) description TEXT );" gsrs <- data.frame(srs_id = integer(0L)) + if (!query_string) { + res <- gpkg_execute(x, qout) + } } else { - q <- character() gsrs <- gpkg_spatial_ref_sys(x) } - if (isTRUE(default) || is.character(default)) { + res <- FALSE + if (!inherits(res, 'try-error') && + (isTRUE(default) || is.character(default))) { if (is.logical(default) || length(default) == 0) { default <- c("cartesian", "geographic", "EPSG:4326") } @@ -72,7 +78,7 @@ gpkg_create_spatial_ref_sys <- function(x, default = TRUE, query_string = FALSE) } } if (query_string) { - return(q) + return(c(qout, q)) } unlist(lapply(q, function(qq) gpkg_execute(x, qq))) } diff --git a/R/gpkg-table.R b/R/gpkg-table.R index f1d8215..1092dfa 100644 --- a/R/gpkg-table.R +++ b/R/gpkg-table.R @@ -185,7 +185,7 @@ gpkg_vect <- function(x, table_name, ...) { res <- try(terra::vect(x$dsn, layer = table_name, ...), silent = TRUE) if (inherits(res, 'try-error')) { # create features, try again with layer not specified - gpkg_create_dummy_features(x) + gpkg_create_empty_features(x, table_name = "dummy_features", contents = FALSE) res2 <- try(terra::vect(x$dsn, query = paste("SELECT * FROM", table_name), ...), silent = TRUE) if (inherits(res2, 'try-error')) { stop(res2[1], call. = FALSE) diff --git a/inst/tinytest/test_gpkg.R b/inst/tinytest/test_gpkg.R index 8aceef2..ac06e84 100644 --- a/inst/tinytest/test_gpkg.R +++ b/inst/tinytest/test_gpkg.R @@ -3,6 +3,7 @@ if (requireNamespace("tinytest", quietly = TRUE)) library(tinytest) stopifnot(requireNamespace("RSQLite", quietly = TRUE)) stopifnot(requireNamespace("terra", quietly = TRUE)) +stopifnot(requireNamespace("vapour", quietly = TRUE)) dem <- system.file("extdata", "dem.tif", package = "gpkg") stopifnot(nchar(dem) > 0) @@ -107,6 +108,9 @@ expect_true(inherits(g3, 'geopackage')) # manipulating an empty gpkg_contents table expect_true(gpkg_create_contents(g3)) +# add default SRS +expect_equal(gpkg_create_spatial_ref_sys(g3), c(1, 1, 1)) + # add dummy row expect_true(gpkg_add_contents(g3, "foo", "bar", ext = c(0, 0, 0, 0), @@ -117,7 +121,7 @@ expect_true(gpkg_add_contents(g3, "foo", "bar", expect_true(gpkg_write_attributes(g3, data.frame(id = 1), "A", "the letter A")) # try various 'lazy' accessor methods -expect_warning({d1 <- gpkg_table_pragma(g3$dsn, "gpkg_contents")}) +expect_silent({d1 <- gpkg_table_pragma(g3$dsn, "gpkg_contents")}) expect_true(inherits(d1, 'data.frame')) expect_true(inherits(gpkg_table_pragma(g3, "gpkg_contents"), 'data.frame')) @@ -213,9 +217,10 @@ unlink(g$dsn) # attributes only (requires creation of "dummy" feature dataset) into temp gpkg expect_warning(g <- geopackage(list(bar = data.frame(b = 2)))) -gpkg_create_dummy_features(g) +gpkg_create_empty_features(g, "dummy_features") expect_true(inherits(gpkg_vect(g, 'bar'), 'SpatVector')) # disconnect it expect_false(gpkg_is_connected(gpkg_disconnect(g))) -unlink(g$dsn) \ No newline at end of file +unlink(g$dsn) + diff --git a/man/gpkg-features.Rd b/man/gpkg-features.Rd new file mode 100644 index 0000000..5f5b6df --- /dev/null +++ b/man/gpkg-features.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gpkg-features.R +\name{gpkg_create_empty_features} +\alias{gpkg_create_empty_features} +\title{Create an empty feature table} +\usage{ +gpkg_create_empty_features( + x, + table_name, + column_name = "geom", + geometry_type_name = "GEOMETRY", + srs_id = 4326, + z = 0L, + m = 0L, + contents = TRUE, + description = "", + ext = c(-180, -90, 180, 90) +) +} +\arguments{ +\item{x}{A \code{geopackage} Object} + +\item{table_name}{\emph{character}. New table name.} + +\item{column_name}{\emph{character}. Geometry column name. Default \code{"geom"}} + +\item{geometry_type_name}{\emph{character}. Geometry type name. Default: \code{"GEOMETRY"}} + +\item{srs_id}{\emph{integer}. Spatial Reference System ID. Must be defined in \code{gpkg_spatial_ref_sys} table.} + +\item{z}{\emph{integer}. Default: \code{0}} + +\item{m}{\emph{integer}. Default: \code{0}} + +\item{contents}{\emph{logical}. If \code{TRUE} (default) add the new table to \code{gpkg_contents} table.} + +\item{description}{\emph{character}. Description for \code{gpkg_contents} table. Default: \code{""}} + +\item{ext}{\emph{numeric}. A numeric vector of length four specifying the bounding box extent.} +} +\value{ +\emph{integer} result of \code{gpkg_execute()}. Returns \code{1} if a new geometry record is appended to \code{gpkg_geometry_columns} table. +} +\description{ +Create an empty feature table and associated entries for \code{gpkg_spatial_ref_sys}, and \code{gpkg_geometry_columns}. +} diff --git a/man/gpkg_create_dummy_features.Rd b/man/gpkg_create_dummy_features.Rd index 6a3bcd9..d904eb9 100644 --- a/man/gpkg_create_dummy_features.Rd +++ b/man/gpkg_create_dummy_features.Rd @@ -17,11 +17,13 @@ gpkg_create_dummy_features(x, table_name = "dummy_feature", values = NULL) logical. \code{TRUE} on success. } \description{ -This function creates a minimal (empty) feature table and \code{gpkg_geometry_columns} table entry. +This function has been deprecated. Please use \code{gpkg_create_empty_features()}. } \details{ +Create a minimal (empty) feature table and \code{gpkg_geometry_columns} table entry. + This is a workaround so that \code{gpkg_vect()} (via \code{terra::vect()}) will recognize a GeoPackage as containing geometries and allow for use of OGR query utilities. The "dummy table" is not added to \code{gpkg_contents} and you should not try to use it for anything. The main purpose is to be able to use \code{gpkg_vect()} and \code{gpkg_ogr_query()} on a GeoPackage that contains only gridded and/or attribute data. } \seealso{ -\code{\link[=gpkg_vect]{gpkg_vect()}} \code{\link[=gpkg_ogr_query]{gpkg_ogr_query()}} +\code{\link[=gpkg_create_empty_features]{gpkg_create_empty_features()}} \code{\link[=gpkg_vect]{gpkg_vect()}} \code{\link[=gpkg_ogr_query]{gpkg_ogr_query()}} }