.packageName <- "Rdbi"
# -*- R -*-
# $RCSfile: connectionMethods.R,v $
# $Date: 2003-11-10 06:53:33 -0800 (Mon, 10 Nov 2003) $
# $Revision: 1.2 $
# Copyright 2001, Timothy H. Keitt
# Licence: GPL
#

#
# Generic method to be subclassed for each implementation
#

dbConnect <- function(dbObj, ...) UseMethod("dbConnect")
#
# dbObj should be generated by an implementation defined function,
# e.g., PgSQL(), which returns a object with an approprite class
# name, e.g., "PostgreSQL" or "MySQL".  The implementation then
# provides a method that actually opens the connection.  The returned
# connection object should inherit from "Rdbi.conn".
#

dbDisconnect <- function(conn) UseMethod("dbDisconnect")
#
# Close connection and free resources
#

dbReconnect <- function(conn) UseMethod("dbReconnect")
#
# The conn object should store the options passed to dbConnect so that
# it can reestablish the connection.
#

dbConnectionInfo <- function(conn) UseMethod("dbConnectionInfo")
#
# Returns a list containing connection information
#

#
# Default methods
#

dbConnect.default <- function(dbObj, ...) {

  stop("Invalid database class")

}

dbDisconnect.default <- function(conn) {

  stop("Invalid connection object")

}

dbReconnect.default <- function(conn) {

  stop("Invalid connection object")

}

dbConnectionInfo.default <- function(conn) {

  stop("Invalid connection object")

}

dbReconnect.Rdbi.conn <- function(conn) {

  eval(attr(conn, "library.call"))

  return(eval(attr(conn, "connect.call")))

}

print.Rdbi.conn <- function(x, ...){
  # Commented out by JZ
  # print.Rdbi.conn <- function(conn){
  # print.list.pairs(dbConnectionInfo(conn))

  # Changed to this by JZ
  printListPairs(dbConnectionInfo(x))
}



# -*- R -*-
# $RCSfile: ioMethods.R,v $
# $Date: 2003-10-08 07:51:08 -0700 (Wed, 08 Oct 2003) $
# $Revision: 1.1 $
# Copyright 2001, Timothy H. Keitt
# Licence: GPL

#
# Generic method to be subclassed for each implementation
#

dbSendQuery <- function(conn, ...) UseMethod("dbSendQuery")
#
# This function submits a query string to the backend.  Returns an
# object that inherits from Rdbi.result.  See "resultMethods.R".
#

dbGetQuery <- function(conn, ...) UseMethod("dbGetQuery")
#
# Execute the query and return the results as a data frame
#

dbListTables <- function(conn, ...) UseMethod("dbListTables")
#
# Output a list of table names associated with the connection object.
# Output should look like output from ls().
#

dbReadTable <- function(conn, ...) UseMethod("dbReadTable")
#
# Analog of the read.table() function.  Returns a data frame.  Some
# facility for converting DB types to R types is helpfull.  Generally,
# this will just pass a "select * from mytable" to dbGetQuery() which
# returns the data frame.
#

dbWriteTable <- function(conn, ...) UseMethod("dbWriteTable")
#
# Analog of write.table().  It should assemble input into a data frame
# and write the frame into a table in database.  Locking should be
# used to insure that the operation is atomic---either the table is
# written in its entirety or it not written at all.
#

dbAppendTable <- function(conn, ...) UseMethod("dbAppendTable")
#
# Takes a dataframe and appends its contents to an existing table.
# dbWriteTable() can use this after creating an empty table.  Again,
# this must be an atomic operation, no partial updating allowed.
#





#
# Default methods
#

dbSendQuery.default <- function(conn, ...) {

  stop("Invalid connection object")

}

dbGetQuery.default <- function(conn, ...) {

  stop("Invalid connection object")

}

dbListTables.default <- function(conn, ...) {

  stop("Invalid connection object")

}

dbReadTable.default <- function(conn, ...) {

  stop("Invalid connection object")

}

dbWriteTable.default <- function(conn, ...) {

  stop("Invalid connection object")

}

dbAppendTable.default <- function(conn, ...) {

  stop("Invalid connection object")

}




# -*- R -*-
# $RCSfile: resultMethods.R,v $
# $Date: 2005-04-06 12:41:48 -0700 (Wed, 06 Apr 2005) $
# $Revision: 1.1 $
# Copyright 2001, Timothy H. Keitt
# Licence: GPL
#

#
# Generic method to be subclassed for each implementation
#

dbGetResult <- function(result, as.matrix=FALSE) UseMethod("dbGetResult")
#
# Return a data frame with results
#

dbClearResult <- function(result) UseMethod("dbClearResult")
#
# Free resources associated with result object
#

dbResultInfo <- function(result) UseMethod("dbResultInfo")
#
# Returns a list with result information, e.g., status
#

dbColumnInfo <- function(result) UseMethod("dbColumnInfo")
#
# Type information about each column is stored in successive
# rows of the output.
#


#
# Default methods
#

dbGetResult.default <- function(result, as.matrix = FALSE) {

  stop("Invalid result class")

}

dbClearResult.default <- function(result) {

  stop("Invalid result object")

}

dbResultInfo.default <- function(result) {

  stop("Invalid result object")

}

dbColumnInfo.default <- function(result) {

  stop("Invalid result class")

}

print.Rdbi.result <- function(x, ...){
  # Commented out by JZ
  # print.Rdbi.result <- function(result){
  # Commented out by JZ
 # print.list.pairs(dbResultInfo(result))

  # Changed to this by JZ
  printListPairs(dbResultInfo(x))
}


# -*- R -*-
# $RCSfile: util.R,v $
# $Date: 2003-10-08 07:51:08 -0700 (Wed, 08 Oct 2003) $
# $Revision: 1.1 $
# Copyright 2001, Timothy H. Keitt
# Licence: GPL

list.to.csv <- function(...)
  return(paste(collapse=", ", ...))

single.quote <- function(...) {
  text <- gsub("'", "\\\\'", as.character(...))
  return(paste("'", unlist(text), "'", sep = ""))
}

double.quote <- function(...)
  return(paste('"', unlist(as.character(...)), '"', sep=""))

list.to.key.pair.string <- function(key.list,
                                    key.sep = "=",
                                    pair.sep = " ") {

  out <- ""

  if (length(key.list) > 0)
    out <- paste(names(key.list)[1], key.sep,
                 single.quote(key.list[1]))

  if (length(key.list) > 1) {

    for (i in 2:length(key.list))
      out <- paste(out,
                   paste(names(key.list)[i], key.sep,
                         single.quote(key.list[i])),
                   sep = pair.sep)

  }

  return(out)

}

strip.line.feeds <- function(x)
  ifelse(is.character(x), gsub("\n", "", x), x)

# Name of this function was changed from the line commented below. JZ
printListPairs <- function(list){
  # Commented out by JZ
  # print.list.pairs <- function(list) {

  for (key in names(list)) {

    value <- as.character(list[[key]])

    if (key == "" || value == "") next

    cat(key, "=", value, "\n")

  }

}

expand.asis <- function(as.is, len = length(as.is)) {
  # This is taken (almost) verbatim from read.table (v 1.1.0)
  if (is.logical(as.is)) {
    as.is <- rep(as.is, length = len)
  }
  else if (is.numeric(as.is)) {
    if (any(as.is < 1 | as.is > len))
      stop("invalid numeric as.is expression")
    i <- rep(FALSE, len)
    i[as.is] <- TRUE
    as.is <- i
  }
  else if (length(as.is) != len)
    stop(paste("as.is has the wrong length", length(as.is),
               "!= ", len))
  # End borrowed code
  return(as.is)
}
# -*- R -*-
# $RCSfile: zzz.R,v $
# $Date: 2006-09-21 08:11:22 -0700 (Thu, 21 Sep 2006) $
# $Revision: 1.3 $
# Copyright 2001, Timothy H. Keitt
# Licence: GPL

.onLoad <- function(lib, pkg) {
  # Changed by JZ from Rdbi.PgSQL to RdbiPgSQL
#  autoload("PgSQL", "RdbiPgSQL")
# autoload("MySQL", "Rdbi.MySQL")
# autoload("ODBC", Rdbi.ODBC")

# Reconnect any connection objects in environment -- doesn't work now
# that .Rprofile get run before objects are restored
  for (objName in ls(envir = globalenv())) {

      obj <- globalenv()[[objName]]

    if (inherits(obj, "Rdbi.conn"))
      assign(objName, dbReconnect(obj), envir = globalenv())

  }


  return(invisible())
}

.Last.lib <- function(...) {

  for (objName in ls(envir = globalenv())) {

      obj <- globalenv()[[objName]]

    if (inherits(obj, "Rdbi.conn")) dbDisconnect(obj)

  }

}
