From 658118d51124006bd658b2318d6d11c895e62251 Mon Sep 17 00:00:00 2001
From: Andrew Gene Brown <andrew.g.brown@usda.gov>
Date: Fri, 10 Mar 2023 13:23:18 -0800
Subject: [PATCH] createSSURGO: add minimal gpkg_contents entries for attribute
 tables (#283)

* createSSURGO: add minimal gpkg_contents entries for attribute tables

* gpkg_contents: only for .gpkg output (not .sqlite); create contents if don't exist (i.e. when include_spatial=FALSE)
---
 R/createSSURGO.R | 108 ++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 107 insertions(+), 1 deletion(-)

diff --git a/R/createSSURGO.R b/R/createSSURGO.R
index 5e34dd2e..eda512a9 100644
--- a/R/createSSURGO.R
+++ b/R/createSSURGO.R
@@ -122,6 +122,13 @@ createSSURGO <- function(filename,
                          header = FALSE,
                          quiet = TRUE,
                          ...) {
+  
+  if (missing(filename) || length(filename) == 0) {
+    stop("`filename` should be a path to a .gpkg or .sqlite file to create or append to.")
+  }
+  
+  IS_GPKG <- grepl("\\.gpkg$", filename, ignore.case = TRUE)[1]
+  
   f <- list.files(exdir, recursive = TRUE, pattern = pattern, full.names = TRUE)
   
   if (!requireNamespace("sf"))
@@ -184,6 +191,7 @@ createSSURGO <- function(filename,
   }
   
   con <- RSQLite::dbConnect(RSQLite::SQLite(), filename, loadable.extensions = TRUE)  
+  on.exit(RSQLite::dbDisconnect(con))
   lapply(names(f.txt.grp), function(x) {
     
     if (!is.null(mstabcol)) {
@@ -233,6 +241,17 @@ createSSURGO <- function(filename,
         }, silent = quiet)
       }
       
+      # for GPKG output, add gpkg_contents (metadata for features and attributes)
+      if (IS_GPKG) {
+        # update gpkg_contents table entry
+        if (!include_spatial) {
+          # if no spatial data inserted, there will be no gpkg_contents table initally
+          try(.gpkg_create_contents(con))
+        }
+        try(.gpkg_delete_contents(con, mstab_lut[x]))
+        try(.gpkg_add_contents(con, mstab_lut[x]))
+      }
+      
       # TODO: other foreign keys/relationships? ALTER TABLE/ADD CONSTRAINT not available in SQLite
       #  the only way to add a foreign key is via CREATE TABLE which means refactoring above two
       #  steps into a single SQL statement (create table with primary and foreign keys)
@@ -240,6 +259,93 @@ createSSURGO <- function(filename,
   })
   
   res <- RSQLite::dbListTables(con)
-  RSQLite::dbDisconnect(con)
   invisible(res)
 }
+
+## From https://github.com/brownag/gpkg -----
+
+#' Add, Remove, Update and Create `gpkg_contents` table and records
+#' @description `gpkg_add_contents()`: Add a record to `gpkg_contents`
+#' @param con A _geopackage_
+#' @param table_name Name of table to add or remove record for in _gpkg_contents_
+#' @param description Default `""`
+#' @param template Default `NULL` uses global EPSG:4326 with bounds -180,-90:180,90
+#' @return Result of `RSQLite::dbExecute()`
+#' @noRd
+#' @keywords internal
+.gpkg_add_contents <- function(con, table_name, description = "", template = NULL) {
+  
+  stopifnot(requireNamespace("RSQLite"))
+  
+  if (!missing(template) &&
+      !is.null(template) &&
+      is.list(template) &&
+      all(c("ext", "srsid") %in% names(template))) {
+    ex <- template$ext
+    cr <- as.integer(template$srsid)
+  } else {
+    ex <- c(-180, -90, 180, 90)
+    cr <- 4326
+  }
+  
+  # append to gpkg_contents
+  RSQLite::dbExecute(con,
+                    paste0(
+                      "INSERT INTO gpkg_contents (table_name, data_type, identifier, 
+                                  description, last_change,
+                                  min_x, min_y, max_x, max_y, srs_id) 
+       VALUES ('",
+       table_name ,
+       "', 'attributes', '",
+       table_name,
+       "', '",
+       description,
+       "','",
+       strftime(Sys.time(), '%Y-%m-%dT%H:%M:%OS3Z'),
+       "', ", ex[1], ", ", ex[2], ", ",
+       ex[3], ", ", ex[4], ", ",
+       cr, "
+                      );"
+                    )
+  )
+}
+
+#' @description `.gpkg_delete_contents()`: Delete a record from `gpkg_contents` based on table name
+#' @noRd
+#' @keywords internal
+.gpkg_delete_contents <- function(con, table_name) {
+  stopifnot(requireNamespace("RSQLite"))
+  RSQLite::dbExecute(con, paste0("DELETE FROM gpkg_contents WHERE table_name = '", table_name, "'"))
+}
+
+#' @description `.gpkg_has_contents()`: Determine if a database has table named `"gpkg_contents"` 
+#' @noRd
+#' @keywords internal
+.gpkg_has_contents <- function(con) {
+  stopifnot(requireNamespace("RSQLite"))
+  isTRUE("gpkg_contents" %in% RSQLite::dbListTables(con))
+}
+
+#' @description `.gpkg_has_contents()`: Determine if a database has table named `"gpkg_contents"` 
+#' @noRd
+#' @keywords internal
+.gpkg_create_contents <- function(con) {
+    stopifnot(requireNamespace("RSQLite"))
+    q <- "CREATE TABLE gpkg_contents (
+      table_name TEXT NOT NULL PRIMARY KEY,
+      data_type TEXT NOT NULL,
+      identifier TEXT UNIQUE,
+      description TEXT DEFAULT '',
+      last_change DATETIME NOT NULL DEFAULT (strftime('%Y-%m-%dT%H:%M:%fZ','now')),
+      min_x DOUBLE,
+      min_y DOUBLE,
+      max_x DOUBLE,
+      max_y DOUBLE,
+      srs_id INTEGER,
+      CONSTRAINT fk_gc_r_srs_id FOREIGN KEY (srs_id) REFERENCES gpkg_spatial_ref_sys(srs_id)
+    )"
+    
+    if (!.gpkg_has_contents(con)) {
+      RSQLite::dbExecute(con, q)
+    } else return(1)
+}