-
Notifications
You must be signed in to change notification settings - Fork 0
/
gpkg-connection.R
129 lines (111 loc) · 3.52 KB
/
gpkg-connection.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
#' Create SQLite Connection to GeoPackage
#'
#' Method for creating and connecting `SQLiteConnection` object stored within `geopackage` object.
#'
#' @details The S3 method for `geopackage` objects does not require the use of assignment to create an object containing an active SQLiteConnection. e.g. `gpkg_connect(g)` connects the existing `geopackage` object `g`
#' @param x Path to GeoPackage
#'
#' @return A DBIConnection (SQLiteConnection) object. `NULL` on error.
#' @export
#' @rdname gpkg-connection
#'
#'
gpkg_connect <- function(x)
UseMethod("gpkg_connect", x)
#' @export
#' @rdname gpkg-connection
gpkg_connect.geopackage <- function(x) {
econ <- x$env$con
if (is.null(econ) || !DBI::dbIsValid(econ))
x$env$con <- gpkg_connect(x$dsn)$env$con
x
}
#' @export
#' @importFrom DBI dbConnect
#' @rdname gpkg-connection
gpkg_connect.character <- function(x) {
if (!requireNamespace("RSQLite", quietly = TRUE))
stop('package `RSQLite` is required to open a connection to a GeoPackage', call. = FALSE)
con <- try(DBI::dbConnect(RSQLite::SQLite(), x), silent = TRUE)
if (!inherits(con, 'try-error')) {
geopackage(con)
} else message(con[1])
}
#' @export
#' @rdname gpkg-connection
gpkg_is_connected <- function(x)
UseMethod("gpkg_is_connected", x)
#' @export
#' @rdname gpkg-connection
gpkg_is_connected.geopackage <- function(x) {
!is.null(x$env$con)
}
#' Create SQLite Connection to GeoPackage
#'
#' @param x A _geopackage_ or _SQLiteConnection_ object
#' @return If `x` is _geopackage_, the disconnected object is returned. If x is a _SQLiteConnection_, logical (`TRUE` if successfully disconnected).
#' @export
#' @importFrom DBI dbDisconnect
#' @rdname gpkg-connection
gpkg_disconnect <- function(x)
UseMethod("gpkg_disconnect", x)
#' @export
#' @rdname gpkg-connection
gpkg_disconnect.geopackage <- function(x) {
if (gpkg_is_connected(x)) {
gpkg_disconnect(x$env$con)
x$env$con <- NULL
}
invisible(x)
}
#' @export
#' @rdname gpkg-connection
gpkg_disconnect.SQLiteConnection <- function(x) {
return(DBI::dbDisconnect(x))
}
#' .gpkg_connection_from_x
#'
#' @param x A _geopackage_ object, a path to a GeoPackage or an _SQLiteConnection_
#' @return An SQLiteConnection with logical attribute `"disconnect"` indicating whether it should be disconnected after use.
#' @noRd
#' @importFrom DBI dbIsValid
#' @keywords internal
.gpkg_connection_from_x <- function(x) {
disconnect <- TRUE
if (is.character(x)) {
con <- gpkg_connect(x)$env$con
} else if (inherits(x, 'geopackage')) {
if (!gpkg_is_connected(x)) {
p <- x$dsn
con <- gpkg_connect(p)$env$con
} else {
con <- x$env$con
disconnect <- FALSE
}
} else if (inherits(x, 'SQLiteConnection')) {
con <- x
disconnect <- FALSE
} else stop('`x` should be `geopackage` object, a path to a GeoPackage or an _SQLiteConnection_')
if (!DBI::dbIsValid(con)) {
attr(con, 'disconnect') <- TRUE
} else if (!is.null(con)) {
attr(con, 'disconnect') <- disconnect
}
con
}
.gpkg_proxy_from_x <- function(x, table_name = NULL) {
if (inherits(x, 'SpatVectorProxy')) {
return(x)
}
if (is.character(x)) {
con <- x
} else if (inherits(x, 'geopackage')) {
con <- x$dsn
} else if (inherits(x, 'SQLiteConnection')) {
con <- x$env$con@dbname
} else stop('`x` should be `geopackage` object, a path to a GeoPackage, a `SpatVectorProxy`, or an _SQLiteConnection_')
if (is.null(table_name)) {
table_name <- ""
}
suppressWarnings(terra::vect(con, layer = table_name, proxy = TRUE))
}