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

@@ -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)

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')
 }

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
+}

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
+}

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)))
 }

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)

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)
+unlink(g$dsn)
+