-
Notifications
You must be signed in to change notification settings - Fork 15
/
pgWriteGeom.R
740 lines (707 loc) · 31.6 KB
/
pgWriteGeom.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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
## 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)
}
}
}