## pgWriteGeom
##' Inserts data into a PostgreSQL table.
##'
##' This function takes a take an R \code{sf}, a \code{SpatVector} or \code{sp} object (\code{Spatial*} or
##' \code{Spatial*DataFrame}); or a regular \code{data.frame}, and performs the
##' database insert (and table creation, when the table does not exist)
##' on the database.
##'
##' If \code{new.id} is specified, a new sequential integer field is
##' added to the data frame for insert. For \code{spatial}-only
##' objects (no data frame), a new ID column is created by default with name
##' \code{"gid"}.
##'
##' This function will use \code{\link[sf]{st_as_text}} for geography types, and
##' \code{\link[sf]{st_as_binary}} for geometry types.
##'
##' In the event of function or database error, the database uses
##' ROLLBACK to revert to the previous state.
##'
##' If the user specifies \code{return.pgi = TRUE}, and data preparation is
##' successful, the function will return
##' a \code{pgi} object (see next paragraph), regardless of whether the
##' insert was successful or not. This object can be useful for debugging,
##' or re-used as the \code{data.obj} in \code{pgWriteGeom};
##' (e.g., when data preparation is slow, and the exact same data
##' needs to be inserted into tables in two separate
##' tables or databases). If \code{return.pgi = FALSE}
##' (default), the function will return \code{TRUE} for successful insert and
##' \code{FALSE} for failed inserts.
##'
##' Use this function with \code{df.mode = TRUE} to save data frames from
##' \code{spatial}-class objects to the database in "data frame mode". Along with normal
##' \code{dbwriteDataFrame} operation, the proj4string of the spatial
##' data will also be saved, and re-attached to the data when using
##' \code{pgGetGeom} to import the data. Note that other attributes
##' of \code{spatial} objects are \strong{not} saved (e.g., \code{coords.nrs},
##' which is used to specify the column index of x/y columns in \code{*POINT} and
##' \code{SpatialPoints*}).
##'
##' pgi objects are a list containing four character strings: (1)
##' in.table, the table name which will be created or inserted
##' into (2) db.new.table, the SQL statement to create the new
##' table, (3) db.cols.insert, a character string of the database column
##' names to insert into, and (4) insert.data, a character string
##' of the data to insert.
##'
##'
##' @param conn A connection object to a PostgreSQL database
##' @param name A character string specifying a PostgreSQL schema and
##' table name (e.g., \code{name = c("schema","table")}).
##' If not already existing, the table will be
##' created. If the table already exists, the function will check
##' if all R data frame columns match database columns, and if so,
##' do the insert. If not, the insert will be aborted. The
##' argument \code{partial.match} allows for inserts with only
##' partial matches of data frame and database column names, and
##' \code{overwrite} allows for overwriting the existing database
##' table.
##' @param data.obj A \code{sf},\code{SpatVector}, \code{sp}-class, or \code{data.frame}
##' @param geom character string. For \code{Spatial*} datasets, the name of
##' geometry/(geography) column in the database table. (existing or to be
##' created; defaults to \code{"geom"}). The special name "geog" will
##' automatically set \code{geog} to TRUE.
##' @param df.mode Logical; Whether to write the (Spatial) data frame in data frame mode
##' (preserving data frame column attributes and row.names).
##' A new table must be created with this mode (or overwrite set to TRUE),
##' and the \code{row.names}, \code{alter.names}, and \code{new.id} arguments will
##' be ignored (see \code{\link[rpostgis]{dbWriteDataFrame}} for more information).
##' @param partial.match Logical; allow insert on partial column
##' matches between data frame and database table. If \code{TRUE},
##' columns in R data frame will be compared with the existing
##' database table \code{name}. Columns in the data frame that
##' exactly match the database table will be inserted into the
##' database table.
##' @param overwrite Logical; if true, a new table (\code{name}) will
##' overwrite the existing table (\code{name}) in the database. Note:
##' overwriting a view must be done manually (e.g., with \code{\link[rpostgis]{dbDrop}}).
##' @param new.id Character, name of a new sequential integer ID
##' column to be added to the table for insert (for spatial objects without
##' data frames, this column is created even if left \code{NULL}
##' and defaults to the name \code{"gid"}). If \code{partial.match
##' = TRUE} and the column does not exist in the database table,
##' it will be discarded.
##' @param row.names Whether to add the data frame row names to the
##' database table. Column name will be '.R_rownames'.
##' @param upsert.using Character, name of the column(s) in the database table
##' or constraint name used to identify already-existing rows in the table, which will
##' be updated rather than inserted. The column(s) must have a unique constraint
##' already created in the database table (e.g., a primary key).
##' Requires PostgreSQL 9.5+.
##' @param alter.names Logical, whether to make database column names
##' DB-compliant (remove special characters/capitalization). Default is
##' \code{FALSE}. (This must be set to \code{FALSE} to match
##' with non-standard names in an existing database table.)
##' @param encoding Character vector of length 2, containing the
##' from/to encodings for the data (as in the function
##' \code{\link[base]{iconv}}). For example, if the dataset contain certain
##' latin characters (e.g., accent marks), and the database is in
##' UTF-8, use \code{encoding = c("latin1", "UTF-8")}. Left
##' \code{NULL}, no conversion will be done.
##' @param return.pgi Whether to return a formatted list of insert parameters
##' (i.e., a \code{pgi} object; see function details.)
##' @param df.geom Character vector, name of a character column in an R data.frame
##' storing PostGIS geometries, this argument can be used to insert a geometry
##' stored as character type in a data.frame (do not use with Spatial* data types).
##' If only the column name is used (e.g., \code{df.geom = "geom"}),
##' the column type will be a generic (GEOMETRY); use a two-length character vector
##' (e.g., \code{df.geom = c("geom", "(POINT,4326)")} to also specify a
##' specific PostGIS geometry type and SRID for the column. Only recommended for
##' for new tables/overwrites, since this method will change the
##' existing column type.
##' @param geog Logical; Whether to write the spatial data as a PostGIS
##' 'GEOGRAPHY' type. By default, FALSE, unless \code{geom = "geog"}.
##' @author David Bucklin \email{david.bucklin@@gmail.com} and Adrián Cidre
##' González \email{adrian.cidre@@gmail.com}
##' @importFrom sf st_geometry_type st_as_sf st_transform st_crs
##' @export
##' @return Returns \code{TRUE} if the insertion was successful,
##' \code{FALSE} if failed, or a \code{pgi} object if specified.
##' @examples
##' \dontrun{
##' library(sf)
##' pts <- st_sf(a = 1:2, geom = st_sfc(st_point(0:1), st_point(1:2)), crs = 4326)
##'
##' ## Insert data in new database table
##' pgWriteGeom(conn, name = c("public", "my_pts"), data.obj = pts)
##'
##' ## The same command will insert into already created table (if all R
##' ## columns match)
##' pgWriteGeom(conn, name = c("public", "my_pts"), data.obj = pts)
##'
##' ## If not all database columns match, need to use partial.match = TRUE,
##' ## where non-matching columns are not inserted
##' names(pts)[1] <- "b"
##' pgWriteGeom(conn, name = c("public", "my_pts"), data.obj = pts,
##' partial.match = TRUE)
##' }
pgWriteGeom <- function(conn, name, data.obj, geom = "geom", df.mode = FALSE, partial.match = FALSE,
overwrite = FALSE, new.id = NULL, row.names = FALSE, upsert.using = NULL,
alter.names = FALSE, encoding = NULL, return.pgi = FALSE, df.geom = NULL, geog = FALSE) {
## Check if connection exists, and PostGIS extension
dbConnCheck(conn)
if (!suppressMessages(pgPostGIS(conn))) {
stop("PostGIS is not enabled on this database.")
}
## Convert to sf object (terra and sp) -> exclude data frame and pgi
if (!inherits(data.obj, "sf")
& !inherits(data.obj, "data.frame")
& !inherits(data.obj, "pgi")) data.obj <- sf::st_as_sf(data.obj)
# If name of geometry is "geog", it should be geography object
if (geom == "geog") geog <- TRUE
## For data frame mode, we need some parameters
## Data frame mode will create new tables or overwrite
if (df.mode) {
if (!dbExistsTable(conn, name, table.only = TRUE) | overwrite) {
partial.match <- FALSE
new.id <- ".db_pkid"
row.names <- TRUE
upsert.using <- NULL
alter.names <- FALSE
} else if (!overwrite & dbExistsTable(conn,name, table.only = TRUE)) {
stop("df.mode = TRUE only allowed for new tables or with overwrite = TRUE.")
}
}
## Check version for upserts
if (!is.null(upsert.using)) {
ver <- dbVersion(conn)
if (ver[1] < 9 | (ver[1] == 9 && ver[2] < 5)) {
stop("'Upsert' not supported in your PostgreSQL version (",paste(ver,collapse = "."),
"). Requires version 9.5 or above.")
}
}
## Check data class of table to insert
cls <- class(data.obj)[1]
## If class is "pgi", it needs a table in pgi$in.table
if (cls == "pgi") {
if (is.null(data.obj$in.table)) {
stop("Table to insert into not specified (in pgi$in.table). Set this and re-run.")
} else {
name <- data.obj$in.table
}
}
## Check for existing table
exists.t <- dbExistsTable(conn, name, table.only = TRUE)
if (!exists.t) {
message("Creating new table...")
create.table <- name
force.match <- NULL
} else if (exists.t & overwrite & !partial.match) {
create.table <- name
force.match <- NULL
} else {
force.match <- name
create.table <- NULL
}
## Prepare pgi with insertize functions. Set to NULL before attempting
## Pgi will be prepared depending on data object
pgi <- NULL
if (cls == "sf") {
if (geog) data.obj <- sf::st_transform(data.obj, sf::st_crs("+proj=longlat +datum=WGS84 +no_defs"))
try(suppressMessages(pgSRID(conn, sf::st_crs(data.obj),
create.srid = TRUE, new.srid = NULL)), silent = TRUE)
try(pgi <- pgInsertizeGeom(data.obj, geom, create.table, force.match, conn,
new.id, row.names, alter.names, partial.match, df.mode,
geog), silent = TRUE)
} else if (cls == "data.frame") {
try(pgi <- pgInsertize(data.obj, create.table, force.match, conn, new.id, row.names,
alter.names, partial.match, df.mode = TRUE), silent = TRUE)
} else if (cls == "pgi") {
pgi <- data.obj
message("Using previously created pgi object. All arguments except for \"conn\", \"overwrite\", and \"encoding\" will be ignored.")
} else {
#dbExecute(conn, "ROLLBACK;")
stop("Input data object not of correct class - must be a Spatial*, Spatial*DataFrame, (MULTI)(POINT, LINESTRING, POLYGON) or data frame.")
}
## If pgi is still NULL, return error (no changes detected)
if (is.null(pgi)) {
#dbExecute(conn, "ROLLBACK;")
stop("Table preparation failed. No changes made to database.")
}
## Begin transanction to ensure data consistency
dbExecute(conn, "BEGIN TRANSACTION;")
## Change encoding if specified
if (!is.null(encoding)) {
pgi$insert.data <- iconv(pgi$insert.data, encoding[1], encoding[2])
}
## Create table if specified
if (!is.null(pgi$db.new.table)) {
if (overwrite & exists.t) {
over.t <- dbDrop(conn, name = name, type = "table",
ifexists = TRUE)
if (!over.t) {
dbExecute(conn, "ROLLBACK;")
message("Could not drop existing table. No changes made to database.")
if (return.pgi) {
return(pgi)
} else {
return(FALSE)
}
}
}
quet <- NULL
try({
for (q in pgi$db.new.table) quet <- dbExecute(conn, q)
})
if (is.null(quet)) {
dbExecute(conn, "ROLLBACK;")
message("Table creation failed. No changes made to database.")
if (return.pgi) {
return(pgi)
} else {
return(FALSE)
}
}
} else if (is.null(pgi$db.new.table) & overwrite) {
message("No create table definition in pgi object (pgi$db.new.table);
not dropping existing table...")
}
## Set name of table
name <- pgi$in.table
nameque <- dbTableNameFix(conn,name)
# df with geom add column
if (!is.null(df.geom)) {
if (alter.names) df.geom[1] <- tolower(gsub("[+-.,!@$%^&*();/|<>]", "_", df.geom[1]))
if (length(df.geom) == 1) df.geom <- list(df.geom, NULL) else df.geom <- as.list(df.geom)
try(dbExecute(conn, paste0("ALTER TABLE ", nameque[1],
".", nameque[2], " ALTER COLUMN ",dbQuoteIdentifier(conn, df.geom[[1]]),
" TYPE GEOMETRY",df.geom[[2]],";")))
}
# Columns and values for PostgreSQL
cols <- pgi$db.cols.insert
values <- pgi$insert.data
db.cols <- dbTableInfo(conn, name = name)$column_name
## Return error if database table not found, and return pgi when specified
if (is.null(db.cols)) {
dbExecute(conn, "ROLLBACK;")
message(paste0("Database table ", paste(name, collapse = "."),
" not found; No changes made to database."))
if (return.pgi) {
return(pgi)
} else {
return(FALSE)
}
}
## Check that R and PostgreSQL database columns are the same
test <- match(cols, db.cols)
unmatched <- cols[is.na(test)]
if (length(unmatched) > 0) {
dbExecute(conn, "ROLLBACK;")
message(paste0("The column(s) (", paste(unmatched, collapse = ","),
") are not in the database table. No changes made to database."))
if (return.pgi) {
return(pgi)
} else {
return(FALSE)
}
}
## Upsert data
up.query <- NULL
if (is.null(pgi$db.new.table) && !is.null(upsert.using)) {
excl <- dbQuoteIdentifier(conn,pgi$db.cols.insert[!pgi$db.cols.insert %in% upsert.using])
excl2 <- paste(excl, " = excluded.",excl,sep = "")
excl.q <- paste(excl2,collapse = ", ")
up <- dbQuoteIdentifier(conn,upsert.using)
if (length(excl) == length(pgi$db.cols.insert)) {
message("Upserting using constraint name...")
up.query <- paste0(" ON CONFLICT ON CONSTRAINT ",paste(up,collapse = ",")," DO UPDATE SET ",
excl.q)
} else {
message("Upserting using column name(s)...")
up.query <- paste0(" ON CONFLICT (",paste(up,collapse = ","),") DO UPDATE SET ",
excl.q)
}
}
## Column names in SQL quote format
cols2 <- paste0("(", paste(dbQuoteIdentifier(conn,cols), collapse = ","), ")")
quei <- NULL
## Send insert query
temp.query <- paste0("INSERT INTO ", nameque[1],
".", nameque[2], cols2, " VALUES ", values, up.query,";")
try(quei <- dbExecute(conn, temp.query))
if (!is.null(quei)) {
## In df mode set .db_pkid as primary key
if (df.mode) {suppressMessages(dbAddKey(conn, name, colname = ".db_pkid", type = "primary"))}
dbExecute(conn, "COMMIT;")
message(paste0("Data inserted into table ",nameque[1],".",nameque[2]))
## Return TRUE
if (return.pgi) {
return(pgi)
} else {
return(TRUE)
}
} else {
dbExecute(conn, "ROLLBACK;")
message("Insert failed. No changes made to database.")
if (return.pgi) {
return(pgi)
} else {
return(FALSE)
}
}
}
## print.pgi
##' @rdname pgWriteGeom
##' @param x A list of class \code{pgi}
##' @param ... Further arguments not used.
##' @export
print.pgi <- function(x, ...) {
cat("pgi object: PostgreSQL insert object from pgInsertize* function in rpostgis. Use with pgWriteGeom() to insert into database table.")
cat("\n************************************\n")
if (!is.null(x$in.tab)) {
cat(paste0("Insert table: ", paste(x$in.tab, collapse = ".")))
cat("\n************************************\n")
}
if (!is.null(x$db.new.table)) {
cat(paste0("SQL to create new table: ", x$db.new.table))
cat("\n************************************\n")
}
cat(paste0("Columns to insert into: ", paste(x$db.cols.insert,
collapse = ",")))
cat("\n************************************\n")
cat(paste0("Formatted insert data: ", substr(x$insert.data,
0, 1000)))
if (nchar(x$insert.data) > 1000) {
cat("........Only the first 1000 characters shown")
}
}
## pgInsert
##' Inserts data into a PostgreSQL table.
##'
##' @description
##' `r lifecycle::badge("deprecated")`
##'
##' This function has been deprecated in favour of [pgWriteGeom()] and will be
##' removed in a future release.
##'
##' This function takes a take an R \code{sp} object (\code{Spatial*} or
##' \code{Spatial*DataFrame}), or a regular \code{data.frame}, and performs the
##' database insert (and table creation, when the table does not exist)
##' on the database.
##'
##' If \code{new.id} is specified, a new sequential integer field is
##' added to the data frame for insert. For \code{Spatial*}-only
##' objects (no data frame), a new ID column is created by default with name
##' \code{"gid"}.
##'
##' This function will use \code{\link[sf]{st_as_text}} for geography types, and
##' \code{\link[sf]{st_as_binary}} for geometry types.
##'
##' In the event of function or database error, the database uses
##' ROLLBACK to revert to the previous state.
##'
##' If the user specifies \code{return.pgi = TRUE}, and data preparation is
##' successful, the function will return
##' a \code{pgi} object (see next paragraph), regardless of whether the
##' insert was successful or not. This object can be useful for debugging,
##' or re-used as the \code{data.obj} in \code{pgInsert};
##' (e.g., when data preparation is slow, and the exact same data
##' needs to be inserted into tables in two separate
##' tables or databases). If \code{return.pgi = FALSE}
##' (default), the function will return \code{TRUE} for successful insert and
##' \code{FALSE} for failed inserts.
##'
##' Use this function with \code{df.mode = TRUE} to save data frames from
##' \code{Spatial*}-class objects to the database in "data frame mode". Along with normal
##' \code{dbwriteDataFrame} operation, the proj4string of the spatial
##' data will also be saved, and re-attached to the data when using
##' \code{pgGetGeom} to import the data. Note that other attributes
##' of \code{Spatial*} objects are \strong{not} saved (e.g., \code{coords.nrs},
##' which is used to specify the column index of x/y columns in \code{SpatialPoints*}).
##'
##' pgi objects are a list containing four character strings: (1)
##' in.table, the table name which will be created or inserted
##' into (2) db.new.table, the SQL statement to create the new
##' table, (3) db.cols.insert, a character string of the database column
##' names to insert into, and (4) insert.data, a character string
##' of the data to insert.
##'
##'
##' @param conn A connection object to a PostgreSQL database
##' @param name A character string specifying a PostgreSQL schema and
##' table name (e.g., \code{name = c("schema","table")}).
##' If not already existing, the table will be
##' created. If the table already exists, the function will check
##' if all R data frame columns match database columns, and if so,
##' do the insert. If not, the insert will be aborted. The
##' argument \code{partial.match} allows for inserts with only
##' partial matches of data frame and database column names, and
##' \code{overwrite} allows for overwriting the existing database
##' table.
##' @param data.obj A \code{Spatial*} or \code{Spatial*DataFrame}, or \code{data.frame}
##' @param geom character string. For \code{Spatial*} datasets, the name of
##' geometry/(geography) column in the database table. (existing or to be
##' created; defaults to \code{"geom"}). The special name "geog" will
##' automatically set \code{geog} to TRUE.
##' @param df.mode Logical; Whether to write the (Spatial) data frame in data frame mode
##' (preserving data frame column attributes and row.names).
##' A new table must be created with this mode (or overwrite set to TRUE),
##' and the \code{row.names}, \code{alter.names}, and \code{new.id} arguments will
##' be ignored (see \code{\link[rpostgis]{dbWriteDataFrame}} for more information).
##' @param partial.match Logical; allow insert on partial column
##' matches between data frame and database table. If \code{TRUE},
##' columns in R data frame will be compared with the existing
##' database table \code{name}. Columns in the data frame that
##' exactly match the database table will be inserted into the
##' database table.
##' @param overwrite Logical; if true, a new table (\code{name}) will
##' overwrite the existing table (\code{name}) in the database. Note:
##' overwriting a view must be done manually (e.g., with \code{\link[rpostgis]{dbDrop}}).
##' @param new.id Character, name of a new sequential integer ID
##' column to be added to the table for insert (for spatial objects without
##' data frames, this column is created even if left \code{NULL}
##' and defaults to the name \code{"gid"}). If \code{partial.match
##' = TRUE} and the column does not exist in the database table,
##' it will be discarded.
##' @param row.names Whether to add the data frame row names to the
##' database table. Column name will be '.R_rownames'.
##' @param upsert.using Character, name of the column(s) in the database table
##' or constraint name used to identify already-existing rows in the table, which will
##' be updated rather than inserted. The column(s) must have a unique constraint
##' already created in the database table (e.g., a primary key).
##' Requires PostgreSQL 9.5+.
##' @param alter.names Logical, whether to make database column names
##' DB-compliant (remove special characters/capitalization). Default is
##' \code{FALSE}. (This must be set to \code{FALSE} to match
##' with non-standard names in an existing database table.)
##' @param encoding Character vector of length 2, containing the
##' from/to encodings for the data (as in the function
##' \code{\link[base]{iconv}}). For example, if the dataset contain certain
##' latin characters (e.g., accent marks), and the database is in
##' UTF-8, use \code{encoding = c("latin1", "UTF-8")}. Left
##' \code{NULL}, no conversion will be done.
##' @param return.pgi Whether to return a formatted list of insert parameters
##' (i.e., a \code{pgi} object; see function details.)
##' @param df.geom Character vector, name of a character column in an R data.frame
##' storing PostGIS geometries, this argument can be used to insert a geometry
##' stored as character type in a data.frame (do not use with Spatial* data types).
##' If only the column name is used (e.g., \code{df.geom = "geom"}),
##' the column type will be a generic (GEOMETRY); use a two-length character vector
##' (e.g., \code{df.geom = c("geom", "(POINT,4326)")} to also specify a
##' specific PostGIS geometry type and SRID for the column. Only recommended for
##' for new tables/overwrites, since this method will change the
##' existing column type.
##' @param geog Logical; Whether to write the spatial data as a PostGIS
##' 'GEOGRAPHY' type. By default, FALSE, unless \code{geom = "geog"}.
##' @author David Bucklin \email{david.bucklin@@gmail.com}
##' @export
##' @return Returns \code{TRUE} if the insertion was successful,
##' \code{FALSE} if failed, or a \code{pgi} object if specified.
##' @importFrom sp CRS
##' @examples
##' \dontrun{
##' library(sp)
##' data(meuse)
##' coords <- SpatialPoints(meuse[, c("x", "y")])
##' spdf <- SpatialPointsDataFrame(coords, meuse)
##'
##' ## Insert data in new database table
##' pgInsert(conn, name = c("public", "meuse_data"), data.obj = spdf)
##'
##' ## The same command will insert into already created table (if all R
##' ## columns match)
##' pgInsert(conn, name = c("public", "meuse_data"), data.obj = spdf)
##'
##' ## If not all database columns match, need to use partial.match = TRUE,
##' ## where non-matching columns are not inserted
##' colnames(spdf@data)[4] <- "cu"
##' pgInsert(conn, name = c("public", "meuse_data"), data.obj = spdf,
##' partial.match = TRUE)
##' }
pgInsert <- function(conn, name, data.obj, geom = "geom", df.mode = FALSE, partial.match = FALSE,
overwrite = FALSE, new.id = NULL, row.names = FALSE, upsert.using = NULL,
alter.names = FALSE, encoding = NULL, return.pgi = FALSE, df.geom = NULL, geog = FALSE) {
# Startup message
message("This function has been deprecated in version 1.5.0.
Please use `pgWriteGeom` instead.")
# auto-geog
if (geom == "geog") geog <- TRUE
if (df.mode) {
if (!dbExistsTable(conn,name, table.only = TRUE) | overwrite) {
# set necessary argument values
partial.match <- FALSE
new.id <- ".db_pkid"
row.names <- TRUE
upsert.using <- NULL
alter.names <- FALSE
} else if (!overwrite & dbExistsTable(conn,name, table.only = TRUE)) {
stop("df.mode = TRUE only allowed for new tables or with overwrite = TRUE.")
}
}
dbConnCheck(conn)
## Check if PostGIS installed
if (!suppressMessages(pgPostGIS(conn))) {
stop("PostGIS is not enabled on this database.")
}
## Check version for upserts
if (!is.null(upsert.using)) {
ver<-dbVersion(conn)
if (ver[1] < 9 | (ver[1] == 9 && ver[2] < 5)) {
stop("'Upsert' not supported in your PostgreSQL version (",paste(ver,collapse = "."),
"). Requires version 9.5 or above.")
}
}
# data.obj class
cls <- class(data.obj)[1]
if (cls == "pgi") {
if (is.null(data.obj$in.table)) {
stop("Table to insert into not specified (in pgi$in.table). Set this and re-run.")
} else {
name <- data.obj$in.table
}
}
## Check for existing table
exists.t <- dbExistsTable(conn, name, table.only = TRUE)
if (!exists.t) {
message("Creating new table...")
create.table <- name
force.match <- NULL
} else if (exists.t & overwrite & !partial.match) {
create.table <- name
force.match <- NULL
} else {
force.match <- name
create.table <- NULL
}
geo.classes <- c("SpatialPoints", "SpatialPointsDataFrame",
"SpatialLines", "SpatialLinesDataFrame", "SpatialPolygons",
"SpatialPolygonsDataFrame")
pgi <- NULL
if (cls %in% geo.classes) {
if (geog) data.obj <- sp::spTransform(data.obj, CRS("+proj=longlat +datum=WGS84 +no_defs", doCheckCRSArgs = FALSE))
try(suppressMessages(pgSRID(conn, data.obj@proj4string,
create.srid = TRUE, new.srid = NULL)), silent = TRUE)
try(pgi <- pgInsertizeGeom(data.obj, geom, create.table,
force.match, conn, new.id, row.names, alter.names, partial.match, df.mode, geog))
} else if (cls == "data.frame") {
try(pgi <- pgInsertize(data.obj, create.table, force.match,
conn, new.id, row.names, alter.names, partial.match, df.mode))
} else if (cls == "pgi") {
pgi <- data.obj
message("Using previously create pgi object. All arguments except for \"conn\", \"overwrite\", and \"encoding\" will be ignored.")
} else {
#dbExecute(conn, "ROLLBACK;")
stop("Input data object not of correct class - must be a Spatial*, Spatial*DataFrame, or data frame.")
}
if (is.null(pgi)) {
#dbExecute(conn, "ROLLBACK;")
stop("Table preparation failed. No changes made to database.")
}
dbExecute(conn, "BEGIN TRANSACTION;")
## Change encoding if specified
if (!is.null(encoding)) {
pgi$insert.data <- iconv(pgi$insert.data, encoding[1],
encoding[2])
}
## Create table if specified
if (!is.null(pgi$db.new.table)) {
if (overwrite & exists.t) {
over.t <- dbDrop(conn, name = name, type = "table",
ifexists = TRUE)
if (!over.t) {
dbExecute(conn, "ROLLBACK;")
message("Could not drop existing table. No changes made to database.")
if (return.pgi) {
return(pgi)
} else {
return(FALSE)
}
}
}
quet <- NULL
try({
for (q in pgi$db.new.table) quet <- dbExecute(conn, q)
})
if (is.null(quet)) {
dbExecute(conn, "ROLLBACK;")
message("Table creation failed. No changes made to database.")
if (return.pgi) {
return(pgi)
} else {
return(FALSE)
}
}
} else if (is.null(pgi$db.new.table) & overwrite) {
message("No create table definition in pgi object (pgi$db.new.table);
not dropping existing table...")
}
## Set name of table
name <- pgi$in.table
nameque <- dbTableNameFix(conn,name)
# df with geom add column
if (!is.null(df.geom)) {
if (alter.names) df.geom[1]<-tolower(gsub("[+-.,!@$%^&*();/|<>]", "_", df.geom[1]))
if (length(df.geom) == 1) df.geom <- list(df.geom, NULL) else df.geom <- as.list(df.geom)
try(dbExecute(conn, paste0("ALTER TABLE ", nameque[1],
".", nameque[2], " ALTER COLUMN ",dbQuoteIdentifier(conn, df.geom[[1]]),
" TYPE GEOMETRY",df.geom[[2]],";")))
}
# end df.geom
cols <- pgi$db.cols.insert
values <- pgi$insert.data
db.cols <- dbTableInfo(conn, name = name)$column_name
if (is.null(db.cols)) {
dbExecute(conn, "ROLLBACK;")
message(paste0("Database table ", paste(name, collapse = "."),
" not found; No changes made to database."))
if (return.pgi) {
return(pgi)
} else {
return(FALSE)
}
}
test <- match(cols, db.cols)
unmatched <- cols[is.na(test)]
if (length(unmatched) > 0) {
dbExecute(conn, "ROLLBACK;")
message(paste0("The column(s) (", paste(unmatched, collapse = ","),
") are not in the database table. No changes made to database."))
if (return.pgi) {
return(pgi)
} else {
return(FALSE)
}
}
#upsert
up.query<-NULL
if (is.null(pgi$db.new.table) && !is.null(upsert.using)) {
excl<-dbQuoteIdentifier(conn,pgi$db.cols.insert[!pgi$db.cols.insert %in% upsert.using])
excl2<-paste(excl, " = excluded.",excl,sep="")
excl.q<-paste(excl2,collapse = ", ")
up<-dbQuoteIdentifier(conn,upsert.using)
if(length(excl) == length(pgi$db.cols.insert)) {
message("Upserting using constraint name...")
up.query<-paste0(" ON CONFLICT ON CONSTRAINT ",paste(up,collapse = ",")," DO UPDATE SET ",
excl.q)
} else {
message("Upserting using column name(s)...")
up.query<-paste0(" ON CONFLICT (",paste(up,collapse = ","),") DO UPDATE SET ",
excl.q)
}
}
cols2 <- paste0("(", paste(dbQuoteIdentifier(conn,cols), collapse = ","), ")")
quei <- NULL
## Send insert query
temp.query<-paste0("INSERT INTO ", nameque[1],
".", nameque[2], cols2, " VALUES ", values, up.query,";")
try(quei <- dbExecute(conn, temp.query))
if (!is.null(quei)) {
if (df.mode) {suppressMessages(dbAddKey(conn, name, colname = ".db_pkid", type = "primary"))}
dbExecute(conn, "COMMIT;")
message(paste0("Data inserted into table ",nameque[1],".",nameque[2]))
## Return TRUE
if (return.pgi) {
return(pgi)
} else {
return(TRUE)
}
} else {
dbExecute(conn, "ROLLBACK;")
message("Insert failed. No changes made to database.")
if (return.pgi) {
return(pgi)
} else {
return(FALSE)
}
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.