From af89851b537b67caaaa57c23740bfd60c4de3b5f Mon Sep 17 00:00:00 2001 From: Bruno Tremblay Date: Tue, 4 Jan 2022 21:30:50 -0500 Subject: [PATCH] adding observer --- DESCRIPTION | 1 + R/dbConnect_PqDriver.R | 24 +++ R/dbDisconnect_PqConnection.R | 1 + R/dbRemoveTable_PqConnection_character.R | 1 + ...eTable_PqConnection_character_data.frame.R | 1 + R/viewer.R | 196 ++++++++++++++++++ inst/icons/elephant.png | Bin 0 -> 2767 bytes inst/icons/redshift.png | Bin 0 -> 738 bytes inst/rstudio/connections.dcf | 7 + inst/rstudio/connections/PostgreSQL.R | 15 ++ inst/rstudio/connections/Redshift.R | 15 ++ 11 files changed, 261 insertions(+) create mode 100644 R/viewer.R create mode 100644 inst/icons/elephant.png create mode 100644 inst/icons/redshift.png create mode 100644 inst/rstudio/connections.dcf create mode 100644 inst/rstudio/connections/PostgreSQL.R create mode 100644 inst/rstudio/connections/Redshift.R diff --git a/DESCRIPTION b/DESCRIPTION index e94a2241..da6c4a18 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -114,5 +114,6 @@ Collate: 'tables.R' 'transactions.R' 'utils.R' + 'viewer.R' Config/autostyle/scope: line_breaks Config/autostyle/strict: false diff --git a/R/dbConnect_PqDriver.R b/R/dbConnect_PqDriver.R index 5a2425d9..2095e07c 100644 --- a/R/dbConnect_PqDriver.R +++ b/R/dbConnect_PqDriver.R @@ -111,6 +111,30 @@ dbConnect_PqDriver <- function(drv, dbname = NULL, conn@typnames <- dbGetQuery(conn, "SELECT oid, typname FROM pg_type", immediate = TRUE) on.exit(NULL) + + # perform the connection notification at the top level, to ensure that it's had + # a chance to get its external pointer connected, and so we can capture the + # expression that created it + if (!is.null(getOption("connectionObserver"))) { # nocov start + addTaskCallback(function(expr, ...) { + tryCatch({ + if (is.call(expr) && + as.character(expr[[1]]) %in% c("<-", "=") && + "dbConnect" %in% as.character(expr[[3]][[1]])) { + + # notify if this is an assignment we can replay + on_connection_opened(eval(expr[[2]]), paste( + c("library(DBI)", deparse(expr)), collapse = "\n")) + } + }, error = function(e) { + warning("Could not notify connection observer. ", e$message, call. = FALSE) + }) + + # always return false so the task callback is run at most once + FALSE + }) + } # nocov end + conn } diff --git a/R/dbDisconnect_PqConnection.R b/R/dbDisconnect_PqConnection.R index ec25c5a3..e58394a5 100644 --- a/R/dbDisconnect_PqConnection.R +++ b/R/dbDisconnect_PqConnection.R @@ -2,6 +2,7 @@ #' @rdname Postgres #' @usage NULL dbDisconnect_PqConnection <- function(conn, ...) { + on_connection_closed(conn) connection_release(conn@ptr) invisible(TRUE) } diff --git a/R/dbRemoveTable_PqConnection_character.R b/R/dbRemoveTable_PqConnection_character.R index b66ea49e..f112f4c8 100644 --- a/R/dbRemoveTable_PqConnection_character.R +++ b/R/dbRemoveTable_PqConnection_character.R @@ -16,6 +16,7 @@ dbRemoveTable_PqConnection_character <- function(conn, name, ..., temporary = FA extra <- paste0(extra, temp_schema, ".") } dbExecute(conn, paste0("DROP TABLE ", extra, name)) + on_connection_updated(conn) invisible(TRUE) } diff --git a/R/dbWriteTable_PqConnection_character_data.frame.R b/R/dbWriteTable_PqConnection_character_data.frame.R index 8e44bda6..7ea40a68 100644 --- a/R/dbWriteTable_PqConnection_character_data.frame.R +++ b/R/dbWriteTable_PqConnection_character_data.frame.R @@ -90,6 +90,7 @@ dbWriteTable_PqConnection_character_data.frame <- function(conn, name, value, .. } on.exit(NULL) + on_connection_updated(conn) invisible(TRUE) } diff --git a/R/viewer.R b/R/viewer.R new file mode 100644 index 00000000..c52acc1c --- /dev/null +++ b/R/viewer.R @@ -0,0 +1,196 @@ +# nocov start + +#' connection display name +#' @noRd +pq_host_name <- function(connection) { + info <- dbGetInfo(connection) + paste(collapse = ":", info$host, info$port) +} + +#' connection display name +#' @noRd +pq_display_name <- function(connection) { + info <- dbGetInfo(connection) + server_name <- paste(collapse = "@", info$username, info$host) + display_name <- paste(collapse = " - ", info$dbname, server_name) + display_name +} + +#' connection icon +#' @noRd +pq_connection_icon <- function(connection) { + switch( + class(connection)[1], + "PqConnection" = system.file("icons/elephant.png", package = "RPostgres"), + "RedshiftConnection" = system.file("icons/redshift.png", package = "RPostgres") + ) +} + +#' @noRd +pq_list_object_types <- function(connection) { + obj_types <- list(table = list(contains = "data")) + obj_types <- list(schema = list(contains = obj_types)) + obj_types +} + +#' @noRd +pq_list_objects <- function(connection, schema = NULL, name = NULL, type = NULL, ...) { + # if no schema was supplied but this database has schema, return a list of + # schema + if (is.null(schema)) { + schemas <- dbGetQuery(conn, "SELECT schema_name FROM information_schema.schemata;")$schema_name + if (length(schemas) > 0) { + return( + data.frame( + name = schemas, + type = rep("schema", times = length(schemas)), + stringsAsFactors = FALSE + )) + } + } + + sql_view <- paste(" + select table_schema, + table_name, + 'view' as table_type + from information_schema.views + where table_schema not in ('information_schema', 'pg_catalog') + ", + if (!is.null(schema)) { + sprintf("and table_schema = '%s'", schema) + } else {""}, + if (!is.null(name)) { + sprintf("and table_name = '%s'", name) + } else {""}) + + sql_table <- paste(" + select schemaname as table_schema, + tablename as table_name, + 'table' as table_type + from pg_catalog.pg_tables + where 1=1 + ", + if (!is.null(schema)) { + sprintf("and schemaname = '%s'", schema) + }, + if (!is.null(name)) { + sprintf("and tablename = '%s'", name) + }) + + sql <- sprintf("%s union all %s;", sql_table, sql_view) + + objs <- dbGetQuery(connection, sql) + + data.frame( + name = objs[["table_name"]], + type = objs[["table_type"]], + stringsAsFactors = FALSE + ) +} + +#' @noRd +pq_list_columns <- function(connection, schema = NULL, table = NULL, ...) { + sql <- sprintf(" + select column_name, + data_type + from information_schema.columns + where table_schema not in ('information_schema', 'pg_catalog') + and table_schema = '%s' + and table_name = '%s' + order by table_schema, + table_name, + ordinal_position; + ", schema, table) + cols <- dbGetQuery(connection, sql) + data.frame( + name = cols[["column_name"]], + type = cols[["data_type"]], + stringsAsFactors = FALSE) +} + +#' @noRd +pq_preview_object <- function(connection, rowLimit, schema = NULL, table = NULL, ...) { + sql <- sprintf("select * from %s.%s limit %s", schema, table, rowLimit) + dbGetQuery(connection, sql) +} + +#' @noRd +on_connection_closed <- function(connection) { + # make sure we have an observer + observer <- getOption("connectionObserver") + if (is.null(observer)) + return(invisible(NULL)) + + type <- class(connection)[1] + host <- pq_host_name(connection) + observer$connectionClosed(type, host) +} + +#' @noRd +on_connection_updated <- function(connection, hint) { + # make sure we have an observer + observer <- getOption("connectionObserver") + if (is.null(observer)) + return(invisible(NULL)) + + type <- class(connection)[1] + host <- pq_host_name(connection) + observer$connectionUpdated(type, host, hint = hint) +} + +#' @noRd +on_connection_opened <- function(connection, code) { + + observer <- getOption("connectionObserver") + if (is.null(observer)) + return(invisible(NULL)) + + observer$connectionOpened( + # connection type + type = class(connection)[1], + + # name displayed in connection pane + displayName = pq_display_name(connection), + + # host key + host = pq_host_name(connection), + + # icon for connection + icon = pq_connection_icon(connection), + + # connection code + connectCode = code, + + # disconnection code + disconnect = function() { + dbDisconnect(connection) + }, + + listObjectTypes = function() { + pq_list_object_types(connection) + }, + + # table enumeration code + listObjects = function(...) { + pq_list_objects(connection, ...) + }, + + # column enumeration code + listColumns = function(...) { + pq_list_columns(connection, ...) + }, + + # table preview code + previewObject = function(rowLimit, ...) { + pq_preview_object(connection, rowLimit, ...) + }, + + # no actions + + # raw connection object + connectionObject = connection + + ) +} + +# nocov end diff --git a/inst/icons/elephant.png b/inst/icons/elephant.png new file mode 100644 index 0000000000000000000000000000000000000000..312023357e7aa531d8ae6b2c89980b4a5ada37c3 GIT binary patch literal 2767 zcmV;=3NZDFP)R zO=93^n>GheTcv5zY}O_w)|wg{x@i&;rACFwQ4A_X0VN=tAOf<;u+A{-1JgeM!#ZOc z`#tCV@!tLYe)sd;^?{S6jV0Q z)!UCC2-sU&;O*kTL;fCkIV(s`P9`ZS3AI|C0&D>~#{$ZMOL1{=3lAOokTbazq+BSZ zvY~a-xI5Zf5;RN2%3yDz7R{ldRm;KDY|dZ5MZbPcL|T$LoOUy6^jC9$!wWM*dO0Z~BvDB!-8D_6dJ>U0{rK1%2Ejp|8YMy6zPT><99z^`w#XR*?4C(3VnLwln za25oi`o@hLvW(I;{&6o zx`+MQv2HQ`ettAGG;9=rrz0XFWGXjLKFKUF*@=b3oUM;7W?xFy_ksiH?j7KlBVX^0 zt&buSP5ejUKbK3WXwB-(X@hfuPwcB13$rYG~z& zC4Q4u3zdU4H8nK=^ySv-kLSk+*xQkLjhpv~kOZ{2@@I2%>B8j-!nwa+!p#-tYcspP5Sb6&C}PiGlj+>S`w!rMpQ$ z8%qlu6mnuCg81b8x8#=H!Pnghxy+oMG0P~aX(GFL>fsjwzyDbj8Tl26L?SwLJ!Irp z@Wrc}$0c|Ng&dWGHMzOD0Qmw?R#H;JES0@UK!Cbt4L^D9C|_h1(b?Tc!uq8|h4^sh zN*OB`dQaHQnQ;SLj?f%FD}XYHAt;E(<_mK|uj? z-JMLrb@%mSfO|_-yRL_IzfI<){i&4HG%?3bIj!%gk4Plq*!cp!z14`TqYZbOJI2{9 zpYKUpS{gtBpca6>hD$I6Ah*80USC&thd{3xMgh$Pfx)3kB^xmOHLWeA zm zXX@o`Xasz!ZWnYS>2(-$<_)0@0kt+dOC9W@L_l3zYC>W`mg(W2?%N1=0h z{q@(WtE=m0cyDwV_!>A41e%TU=>vT9di{db!p zPlY3sh;etaMQkQeT62GO^%uJk}oy|f+LnC5hVuH7C-|pe)=;)W1 zmlr)TX)TmWrTLYWm7)*N7L#_hd|acwLeAe_d4`iI|0X^@9+61I-o1NycH4G7PS53q zCm!NAN7AP)7)B*EHzV!sEgU^pKy$l}RUtkoZRGU!>uJ?=6Xx$m_QfnBBP09FCivbR z92^YQ>2z}v6Si{la>>0)LnaY(V8?n2uY65>d^}-cVeH(wlkG1h@QZ_Aa_(9s-YyO} zDCB%oQfm~@bA}zU;X&*?aFWtmHECDN$;hjqv%8P*g|lh8bDIqtHlWdH4o_8S?mBYh zNaUtXnp1-UVQHa#nnwL@OB}5;cQYa6dHvC zu(FV1E;b|m?JacZda;yAuvb`cyQ+$V``+NdfdhuVzP`T$Kc8-0dPS*JzLS=ghWl(^ z1`P((cdCevj^?YczCx~?NpgA~jjdX&ETk+C^kU5tUs_w5Ia}1opHs7q0!D`Tu=!yR zwr$&ny}dnJt(MBlN*Wp(48T?3_rMu|>1y@8EiEl}OO`B2jE;^L#9}dNX=#T3{{CB! zKmNFPVqzj2!oyLi7NON@$;ruK`LZn}BqU&P@;CVfXV_a)RaHfHc6KT78N&xtRX{E< zZUP(IO#E7}*B?K9`g9CnKJrFc_4W1fJ9g}N9`Iv0O&NeDKr=KnG*>WEEQ|%LEiDAd z1Ab@B*3@n%Z{!-Q_eU-(h7X*2MgU*c>-BqN6Y9mO#O+rxm(rff~W?)|G%r_&*q8Q&cWA`vPF1yxm50LJqX4;HYwy}ccU z-1xS^$<7LyL`-F6C5#lM#`GWoYZ@9Fa2!)1Po=qTj#O7y)7jbC1za~3^g#j^6%`fr z&USIY+Cn<5(W+o?&YnFB!^g+Hrh-05!0y7r!i>U#>uin+p3)#P#D|Fap6uVh-vGRO zKS6)UUp$o##mC35IiHz{*i0ZJzXAYXH%C?l`w-x6Ph8w)LuqO0A>i@@?)$#=uaJ-s zLwb6;L8H+aG#ZT|Cnv|SXU`skN~O{R?*XQB(f?6mU>Czn)(|iN6fr!c^S^Jf{{s1E V0Z`60WB~vG002ovPDHLkV1gtRCd&W- literal 0 HcmV?d00001 diff --git a/inst/icons/redshift.png b/inst/icons/redshift.png new file mode 100644 index 0000000000000000000000000000000000000000..e4618724f71cef408bf91b210881eff827294cac GIT binary patch literal 738 zcmV<80v-K{P)Z0jdSK7QguzyEsTLkKWKd`dWdwr!w(pg_M7PiiolS)B&i20^}Fw zi>ZmPwg`Qnp6+KNW$h;Ycb|3;(OJPtlR`vl%CFb4bI#J%A|iF$4YeaA!x56<2+44S zWH>@H93dHwkPJsih9e}y5t88u$xxViX|tEi%wUe&*N)=M%$xQDmJ~{uG6rA_z!RM8P>T!pSH=bAKU_Qf1K6F0=4r3A+pM1G~wEc!!7GN0f1;qVy!!NIa7=s_gUCKLI*79_eHuq_Upc`Pc z5K+L|j**uc)N2~5rx_;Q%nIdR_V@yUR2jeDyPT(G_Y1?_ndw^i4=bkW UXv&Wqxc~qF07*qoM6N<$f;=T#ZU6uP literal 0 HcmV?d00001 diff --git a/inst/rstudio/connections.dcf b/inst/rstudio/connections.dcf new file mode 100644 index 00000000..15363c25 --- /dev/null +++ b/inst/rstudio/connections.dcf @@ -0,0 +1,7 @@ +Name: PostgreSQL +HelpUrl: https://www.postgresql.org/docs/ +Icon: icons/elephant.png + +Name: Redshift +HelpUrl: https://docs.aws.amazon.com/redshift/index.html +Icon: icons/redshift.png diff --git a/inst/rstudio/connections/PostgreSQL.R b/inst/rstudio/connections/PostgreSQL.R new file mode 100644 index 00000000..160c3be8 --- /dev/null +++ b/inst/rstudio/connections/PostgreSQL.R @@ -0,0 +1,15 @@ +library(RPostgres) +conn <- dbConnect( + Postgres(), + dbname = NULL, + host = NULL, + port = NULL, + password = NULL, + user = NULL, + service = NULL, + ..., + bigint = c("integer64", "integer", "numeric", "character"), + check_interrupts = FALSE, + timezone = "UTC", + timezone_out = NULL +) diff --git a/inst/rstudio/connections/Redshift.R b/inst/rstudio/connections/Redshift.R new file mode 100644 index 00000000..5bb094a7 --- /dev/null +++ b/inst/rstudio/connections/Redshift.R @@ -0,0 +1,15 @@ +library(RPostgres) +conn <- dbConnect( + Redshift(), + dbname = NULL, + host = NULL, + port = NULL, + password = NULL, + user = NULL, + service = NULL, + ..., + bigint = c("integer64", "integer", "numeric", "character"), + check_interrupts = FALSE, + timezone = "UTC", + timezone_out = NULL +)