include synonyms in odbcListObjects() output

NAMESPACE

@@ -2,6 +2,7 @@
 
 S3method(odbcListColumns,OdbcConnection)
 S3method(odbcListObjectTypes,default)
+S3method(odbcListObjects,"Microsoft SQL Server")
 S3method(odbcListObjects,OdbcConnection)
 S3method(odbcPreviewObject,OdbcConnection)
 export(databricks)

NEWS.md

@@ -10,6 +10,10 @@
 * The `"OdbcConnection"` method for `dbQuoteIdentifier()` will no longer 
   pass `x` to `encodeString()` before returning, for consistency with the
   default implementation in DBI (@simonpcouch, #765).
+
+* `dbListTables()`, `dbExistsTable()`, and `odbcListObjects()` now support
+  synonyms with Microsoft SQL Server. This also means that users can now
+  interact with synonyms using the Connections pane (@simonpcouch, #773).
 
 # odbc 1.4.2
 

R/driver-sql-server.R

@@ -73,11 +73,15 @@ setMethod("dbExistsTable", c("Microsoft SQL Server", "character"),
     stopifnot(length(name) == 1)
     if (isTempTable(conn, name, ...)) {
       query <- paste0("SELECT OBJECT_ID('tempdb..", name, "')")
-      !is.na(dbGetQuery(conn, query)[[1]])
-    } else {
-      df <- odbcConnectionTables(conn, name = name, ...)
-      NROW(df) > 0
+      return(!is.na(dbGetQuery(conn, query)[[1]]))
     }
+    df <- odbcConnectionTables(conn, name = name, ...)
+    if (NROW(df) > 0) {
+      return(TRUE)
+    }
+
+    synonyms <- dbGetQuery(conn, synonyms_query(...))
+    name %in% synonyms$name
   }
 )
 
@@ -107,7 +111,9 @@ setMethod("dbListTables", "Microsoft SQL Server",
       res <- c(res, res_temp)
     }
 
-    res
+    synonyms <- dbGetQuery(conn, synonyms_query(catalog_name, schema_name))
+
+    c(res, synonyms$name)
   }
 )
 
@@ -204,3 +210,64 @@ setMethod("odbcDataType", "Microsoft SQL Server",
     )
   }
 )
+
+#' @rdname SQLServer
+#' @description
+#' ## `odbcListObjects()`
+#'
+#' This method makes tables that are synonyms visible in the Connections pane.
+# See (#221).
+#' @usage NULL
+#' @export
+`odbcListObjects.Microsoft SQL Server` <- function(connection,
+                                                   catalog = NULL,
+                                                   schema = NULL,
+                                                   name = NULL,
+                                                   type = NULL,
+                                                   ...) {
+  objects <- NextMethod(
+    object = connection,
+    catalog = catalog,
+    schema = schema,
+    name = name,
+    type = type,
+    ...
+  )
+
+  if (!any(objects$type == "table") && nrow(objects) > 0) {
+    return(objects)
+  }
+
+  synonyms <- dbGetQuery(connection, synonyms_query(catalog, schema))
+
+  if (!is.null(name)) {
+    synonyms <- synonyms[synonyms$name == name, , drop = FALSE]
+  }
+
+  rbind(
+    objects,
+    data.frame(name = synonyms$name, type = rep("table", length(synonyms$name)))
+  )
+}
+
+synonyms_query <- function(catalog_name = NULL, schema_name = NULL) {
+  sys_synonyms <- paste0(c(catalog_name, "sys.synonyms"), collapse = ".")
+
+  res <- paste0("IF DB_ID(", sQuote(catalog_name, "'"), ") IS NOT NULL
+                 SELECT
+                   [schema] = SCHEMA_NAME(Syn.schema_id),
+                   name     = Syn.name
+                 FROM ", sys_synonyms, " AS Syn")
+
+  if (is.null(schema_name)) {
+    return(paste0(res, " WHERE ", filter_is_table))
+  }
+
+  paste0(
+    res,
+    " WHERE SCHEMA_NAME(Syn.schema_id) = '", schema_name, "' AND ",
+    filter_is_table
+  )
+}
+
+filter_is_table <- "OBJECTPROPERTY(Object_ID(Syn.base_object_name), 'IsTable') = 1;"

tests/testthat/test-driver-sql-server.R

@@ -337,3 +337,51 @@ test_that("captures multiline errors message", {
     }
   )
 })
+
+test_that("odbcListObjects shows synonyms (#221)", {
+  con <- test_con("SQLSERVER")
+  db <- dbGetQuery(con, "SELECT db_name()")[1,1]
+  dbExecute(con, "CREATE SCHEMA testSchema")
+  dbExecute(con, "CREATE SCHEMA testSchema2")
+
+  on.exit({
+    dbExecute(con, "DROP TABLE IF EXISTS testSchema.tbl")
+    dbExecute(con, "DROP SYNONYM IF EXISTS testSchema.tbl2")
+    dbExecute(con, "DROP SYNONYM IF EXISTS testSchema2.tbl2")
+    dbExecute(con, "DROP SCHEMA IF EXISTS testSchema")
+    dbExecute(con, "DROP SCHEMA IF EXISTS testSchema2")
+  })
+
+  dbExecute(con, "CREATE TABLE testSchema.tbl (x int)")
+  expect_equal(nrow(odbcListObjects(con, catalog = db, schema = "testSchema")), 1)
+
+  dbExecute(con, "CREATE SYNONYM testSchema.tbl2 for testSchema.tbl")
+  expect_equal(nrow(odbcListObjects(con, catalog = db, schema = "testSchema")), 2)
+  expect_length(dbListTables(con, catalog_name = db, schema_name = "testSchema"), 2)
+  expect_equal(
+    nrow(odbcListObjects(con, catalog = db, schema = "testSchema", name = "tbl")),
+    1
+  )
+  expect_false("tbl2" %in% odbcListObjects(con)$name)
+  expect_false("tbl2" %in% odbcListObjects(con, catalog = db)$name)
+  expect_true(
+    dbExistsTable(con, name = "tbl2", catalog_name = db, schema_name = "testSchema")
+  )
+  expect_true(dbExistsTable(con, name = Id(db, "testSchema", "tbl2")))
+  expect_true(dbExistsTable(con, name = Id("testSchema", "tbl2")))
+  expect_true(dbExistsTable(con, name = Id("tbl2")))
+  expect_true(dbExistsTable(con, name = "tbl2"))
+  dbExecute(con, "DROP SYNONYM testSchema.tbl2")
+  expect_false(dbExistsTable(con, name = Id(db, "testSchema", "tbl2")))
+
+  # ensure query filters out synonyms in schemas other than the one
+  # where the base object lives effectively
+  dbExecute(con, "CREATE SYNONYM testSchema2.tbl2 for testSchema.tbl")
+  expect_equal(nrow(odbcListObjects(con, catalog = db, schema = "testSchema")), 1)
+  expect_equal(nrow(odbcListObjects(con, catalog = db, schema = "testSchema2")), 1)
+  expect_length(dbListTables(con, catalog_name = db, schema_name = "testSchema2"), 1)
+  expect_true(
+    dbExistsTable(con, name = "tbl2", catalog_name = db, schema_name = "testSchema2")
+  )
+  expect_true(dbExistsTable(con, name = Id(db, "testSchema2", "tbl2")))
+})