Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Updates for change in DBI generics. Misc cleaning

Use Collate instead of Makefile.
Update Maintainer info


git-svn-id: https://hedgehog.fhcrc.org/compbio/r-dbi@205 dcde13d4-9b1b-0410-ac9e-ef07de68c835
  • Loading branch information...
commit 9d9900731b6aaa498011a7704a82f79ee9bafaa6 1 parent e093d04
sethf authored
8 .Rbuildignore
View
@@ -4,15 +4,7 @@ config.status
RCS
R\/\.RData$
R\/\.Rhistory$
-R\/Makefile$
-R\/S4R.R$
-R\/DBI.R$
-R\/dbObjectId.R$
-R\/MySQL.R$
-R\/MySQLSupport.R$
-R\/zzz.R$
R\/tags$
-R\/RCS
src\/Makefile$
src\/Makevars$
src\/.*\.o$
11 DESCRIPTION
View
@@ -1,14 +1,13 @@
Package: RMySQL
-Version: 0.5-9
-Date: 2006-09-25
+Version: 0.5-10
Title: R interface to the MySQL database
-Author: David A. James <dj@bell-labs.com>
- Saikat DebRoy <saikat@stat.wisc.edu>
-Maintainer: David A. James <dj@bell-labs.com>
+Author: David A. James and Saikat DebRoy
+Maintainer: David A. James <daj025@gmail.com>
Description: Database interface and MySQL driver for R.
This version complies with the database interface
definition as implemented in the package DBI 0.1-8.
SaveImage: yes
-Depends: R (>= 2.0.0), methods, DBI (>= 0.1-8)
+Depends: R (>= 2.3.0), methods, DBI (>= 0.1-11)
License: GPL
URL: stat.bell-labs.com/RS-DBI www.mysql.com www.omegahat.org
+Collate: S4R.R zzz.R dbObjectId.R MySQL.R MySQLSupport.R
38 INDEX
View
@@ -1,38 +0,0 @@
-dbApply Apply R/S-Plus functions to remote groups of
- DBMS rows (experimental)
-dbApply-methods Apply R/S-Plus functions to remote groups of
- DBMS rows (experimental)
-dbBuildTableDefinition
- Build the SQL CREATE TABLE definition as a
- string
-dbCallProc-methods Call an SQL stored procedure
-dbCommit-methods DBMS Transaction Management
-dbConnect-methods Create a connection object to an MySQL DBMS
-dbDataType-methods Determine the SQL Data Type of an S object
-dbDriver-methods MySQL implementation of the Database Interface
- (DBI) classes and drivers
-dbGetInfo Database interface meta-data
-dbListTables-methods List items from an MySQL DBMS and from objects
-dbObjectId-class Class dbObjectId
-dbReadTable-methods Convenience functions for Importing/Exporting
- DBMS tables
-dbSendQuery-methods Execute a statement on a given database
- connection
-dbSetDataMappings-methods
- Set data mappings between MySQL and R/S-Plus
-fetch-methods Fetch records from a previously executed query
-isIdCurrent Check whether a database handle object is valid
- or not
-MySQL Instantiate a MySQL client from the current R
- or S-Plus session
-MySQLConnection-class Class MySQLConnection
-mysqlDBApply Apply R/S-Plus functions to remote groups of
- DBMS rows (experimental)
-MySQLDriver-class Class MySQLDriver
-mysqlInitDriver Support Functions
-MySQLObject-class Class MySQLObject
-MySQLResult-class Class MySQLResult
-RMySQL-package R interface to the MySQL database
-SQLKeywords-methods Make R/S-Plus identifiers into legal SQL
- identifiers
-summary-methods Summarize an MySQL object
471 R/DBI.R
View
@@ -1,471 +0,0 @@
-## $Id$
-##
-## DBI.S Database Interface Definition
-## For full details see http://www.omegahat.org
-##
-## Copyright (C) 1999,2000 The Omega Project for Statistical Computing.
-##
-## This library is free software; you can redistribute it and/or
-## modify it under the terms of the GNU Lesser General Public
-## License as published by the Free Software Foundation; either
-## version 2 of the License, or (at your option) any later version.
-##
-## This library is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-## Lesser General Public License for more details.
-##
-## You should have received a copy of the GNU Lesser General Public
-## License along with this library; if not, write to the Free Software
-## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-##
-
-## Define all the classes and methods to be used by an implementation
-## of the RS-DataBase Interface. All these classes are virtual
-## and each driver should extend them to provide the actual implementation.
-## See the files Oracle.S and MySQL.S for the Oracle and MySQL
-## S implementations, respectively. The support files (they have "support"
-## in their names) for code that is R-friendly and may be easily ported
-## to R.
-
-## Class: dbManager
-## This class identifies the DataBase Management System (oracle, informix, etc)
-
-"dbManager" <-
-function(obj, ...)
-{
- do.call(as.character(obj), list(...))
-}
-
-"load" <-
-function(mgr, ...)
-{
- UseMethod("load")
-}
-
-"unload" <-
-function(mgr, ...)
-{
- UseMethod("unload")
-}
-
-"getManager" <-
-function(obj, ...)
-{
- UseMethod("getManager")
-}
-
-"getConnections" <-
-function(mgr, ...)
-{
- UseMethod("getConnections")
-}
-
-## Class: dbConnection
-
-"dbConnect" <-
-function(mgr, ...)
-{
- UseMethod("dbConnect")
-}
-
-"dbExecStatement" <-
-function(con, statement, ...)
-{
- UseMethod("dbExecStatement")
-}
-
-"dbExec" <-
-function(con, statement, ...)
-{
- UseMethod("dbExec")
-}
-
-"commit" <-
-function(con, ...)
-{
- UseMethod("commit")
-}
-
-"rollback" <-
-function(con, ...)
-{
- UseMethod("rollback")
-}
-
-"callProc" <-
-function(con, ...)
-{
- UseMethod("callProc")
-}
-
-"close.dbConnection" <-
-function(con, ...)
-{
- stop("close for dbConnection objects needs to be written")
-}
-
-"getResultSets" <-
-function(con, ...)
-{
- UseMethod("getResultSets")
-}
-
-"getException" <-
-function(con, ...)
-{
- UseMethod("getException")
-}
-
-## close is already a generic function in R
-
-## Class: dbResult
-## This is the base class for arbitrary results from TDBSM (INSERT,
-## UPDATE, RELETE, etc.) SELECT's (and SELECT-lie) statements produce
-## "dbResultSet" objects, which extend dbResult.
-
-## Class: dbResultSet
-
-"fetch" <-
-function(res, n, ...)
-{
- UseMethod("fetch")
-}
-
-"setDataMappings" <-
-function(res, ...)
-{
- UseMethod("setDataMappings")
-}
-
-"close.resultSet" <-
-function(con, ...)
-{
- stop("close method for dbResultSet objects need to be written")
-}
-
-## Need to elevate the current load() to the load.default
-if(!exists("load.default")){
- if(exists("load", mode="function", where=match("package:base", search())))
- load.default <- get("load", mode = "function",
- pos = match("package:base", search()))
- else
- "load.default" <-
- function(file, ...) stop("method must be overriden")
-}
-
-## Need to elevate the current getConnection to a default method,
-## and define getConnection to be a generic
-
-if(!exists("getConnection.default")){
- if(exists("getConnection", mode="function", where=match("package:base",search())))
- getConnection.default <- get("getConnection", mode = "function",
- pos=match("package:base", search()))
- else
- "getConnection.default" <-
- function(what, ...) stop("method must be overriden")
-}
-
-if(!usingR(1,2.1)){
- close <- function(con, ...) UseMethod("close")
-}
-
-"getConnection" <-
-function(what, ...)
-{
- UseMethod("getConnection")
-}
-
-"getFields" <-
-function(res, ...)
-{
- UseMethod("getFields")
-}
-
-"getStatement" <-
-function(res, ...)
-{
- UseMethod("getStatement")
-}
-
-"getRowsAffected" <-
-function(res, ...)
-{
- UseMethod("getRowsAffected")
-}
-
-"getRowCount" <-
-function(res, ...)
-{
- UseMethod("getRowCount")
-}
-
-"getNullOk" <-
-function(res, ...)
-{
- UseMethod("getNullOk")
-}
-
-"hasCompleted" <-
-function(res, ...)
-{
- UseMethod("hasCompleted")
-}
-## these next 2 are meant to be used with tables (not general purpose
-## result sets) thru connections
-
-"getNumRows" <-
-function(con, name, ...)
-{
- UseMethod("getNumRows")
-}
-
-"getNumCols" <-
-function(con, name, ...)
-{
- UseMethod("getNumCols")
-}
-
-"getNumCols.default" <-
-function(con, name, ...)
-{
- nrow(getFields(con, name))
-}
-
-## (I don't know how to efficiently and portably get num of rows of a table)
-
-## Meta-data:
-## The approach in the current implementation is to have .Call()
-## functions return named lists with all the known features for
-## the various objects (dbManager, dbConnection, dbResultSet,
-## etc.) and then each meta-data function (e.g., getVersion) extract
-## the appropriate field from the list. Of course, there are meta-data
-## elements that need to access to DBMS data dictionaries (e.g., list
-## of databases, priviledges, etc) so they better be implemented using
-## the SQL inteface itself, say thru quickSQL.
-##
-## It may be possible to get some of the following meta-data from the
-## dbManager object iteslf, or it may be necessary to get it from a
-## dbConnection because the dbManager does not talk itself to the
-## actual DBMS. The implementation will be driver-specific.
-##
-## TODO: what to do about permissions? privileges? users? Some
-## databses, e.g., mSQL, do not support multiple users. Can we get
-## away without these? The basis for defining the following meta-data
-## is to provide the basics for writing methods for attach(db) and
-## related methods (objects, exist, assign, remove) so that we can even
-## abstract from SQL and the RS-Database interface itself.
-
-"getInfo" <-
-function(obj, ...)
-{
- UseMethod("getInfo")
-}
-
-"describe" <-
-function(obj, verbose = F, ...)
-{
- UseMethod("describe")
-}
-
-"getVersion" <-
-function(obj, ...)
-{
- UseMethod("getVersion")
-}
-
-"getCurrentDatabase" <-
-function(obj, ...)
-{
- UseMethod("getCurrentDatabase")
-}
-
-"getDatabases" <-
-function(obj, ...)
-{
- UseMethod("getDatabases")
-}
-
-"getTables" <-
-function(obj, dbname, row.names, ...)
-{
- UseMethod("getTables")
-}
-
-"getTableFields" <-
-function(res, table, dbname, ...)
-{
- UseMethod("getTableFields")
-}
-
-"getTableIndices" <-
-function(res, table, dbname, ...)
-{
- UseMethod("getTableIndices")
-}
-
-## These are convenience functions that mimic S database access methods
-## get(), assign(), exists(), and remove().
-
-"getTable" <- function(con, name, ...)
-{
- UseMethod("getTable")
-}
-
-"getTable.dbConnection" <-
-function(con, name, row.names = "row.names", check.names = T, ...)
-## Should we also allow row.names to be a character vector (as in read.table)?
-## is it "correct" to set the row.names of output data.frame?
-## Use NULL, "", or 0 as row.names to prevent using any field as row.names.
-{
- out <- quickSQL(con, paste("SELECT * from", name))
- if(check.names)
- names(out) <- make.names(names(out), unique = T)
- ## should we set the row.names of the output data.frame?
- nms <- names(out)
- j <- switch(mode(row.names),
- "character" = if(row.names=="") 0 else
- match(tolower(row.names), tolower(nms),
- nomatch = if(missing(row.names)) 0 else -1),
- "numeric" = row.names,
- "NULL" = 0,
- 0)
- if(j==0)
- return(out)
- if(j<0 || j>ncol(out)){
- warning("row.names not set on output data.frame (non-existing field)")
- return(out)
- }
- rnms <- as.character(out[,j])
- if(all(!duplicated(rnms))){
- out <- out[,-j, drop = F]
- row.names(out) <- rnms
- } else warning("row.names not set on output (duplicate elements in field)")
- out
-}
-
-"existsTable" <- function(con, name, ...)
-{
- UseMethod("existsTable")
-}
-
-"existsTable.dbConnection" <- function(con, name, ...)
-{
-## name is an SQL (not an R/S!) identifier.
- match(name, getTables(con), nomatch = 0) > 0
-}
-
-"removeTable" <- function(con, name, ...)
-{
- UseMethod("removeTable")
-}
-
-"removeTable.dbConnection" <- function(con, name, ...)
-{
- if(existsTable(con, name, ...)){
- rc <- try(quickSQL(con, paste("DROP TABLE", name)))
- !inherits(rc, "Error")
- }
- else FALSE
-}
-
-"assignTable" <- function(con, name, value, row.names, ...)
-{
- UseMethod("assignTable")
-}
-
-## The following generic returns the closest data type capable
-## of representing an R/S object in a DBMS.
-## TODO: Lots! We should have a base SQL92 method that individual
-## drivers extend? Currently there is no default. Should
-## we also allow data type mapping from SQL -> R/S?
-
-"SQLDataType" <- function(mgr, obj, ...)
-{
- UseMethod("SQLDataType")
-}
-
-"SQLDataType.default" <-
-function(mgr, obj, ...)
-## should we supply an SQL89/SQL92 default implementation?
-{
- stop("must be implemented by a specific driver")
-}
-
-"make.SQL.names" <-
-function(snames, keywords = .SQL92Keywords, unique = T, allow.keywords = T)
-## produce legal SQL identifiers from strings in a character vector
-## unique, in this function, means unique regardless of lower/upper case
-{
- "makeUnique" <- function(x, sep="_"){
- out <- x
- lc <- make.names(tolower(x), unique=F)
- i <- duplicated(lc)
- lc <- make.names(lc, unique = T)
- out[i] <- paste(out[i], substring(lc[i], first=nchar(out[i])+1), sep=sep)
- out
- }
- snames <- make.names(snames, unique=F)
- if(unique)
- snames <- makeUnique(snames)
- if(!allow.keywords){
- snames <- makeUnique(c(keywords, snames))
- snames <- snames[-seq(along = keywords)]
- }
- .Call("RS_DBI_makeSQLNames", snames)
-}
-
-"isSQLKeyword" <-
-function(x, keywords = .SQL92Keywords, case = c("lower", "upper", "any")[3])
-{
- n <- pmatch(case, c("lower", "upper", "any"), nomatch=0)
- if(n==0)
- stop('case must be one of "lower", "upper", or "any"')
- kw <- switch(c("lower", "upper", "any")[n],
- lower = tolower(keywords),
- upper = toupper(keywords),
- any = toupper(keywords))
- if(n==3)
- x <- toupper(x)
- match(x, keywords, nomatch=0) > 0
-}
-
-## SQL ANSI 92 (plus ISO's) keywords --- all 220 of them!
-## (See pp. 22 and 23 in X/Open SQL and RDA, 1994, isbn 1-872630-68-8)
-
-".SQL92Keywords" <-
-c("ABSOLUTE", "ADD", "ALL", "ALLOCATE", "ALTER", "AND", "ANY", "ARE", "AS",
- "ASC", "ASSERTION", "AT", "AUTHORIZATION", "AVG", "BEGIN", "BETWEEN",
- "BIT", "BIT_LENGTH", "BY", "CASCADE", "CASCADED", "CASE", "CAST",
- "CATALOG", "CHAR", "CHARACTER", "CHARACTER_LENGTH", "CHAR_LENGTH",
- "CHECK", "CLOSE", "COALESCE", "COLLATE", "COLLATION", "COLUMN",
- "COMMIT", "CONNECT", "CONNECTION", "CONSTRAINT", "CONSTRAINTS",
- "CONTINUE", "CONVERT", "CORRESPONDING", "COUNT", "CREATE", "CURRENT",
- "CURRENT_DATE", "CURRENT_TIMESTAMP", "CURRENT_TYPE", "CURSOR", "DATE",
- "DAY", "DEALLOCATE", "DEC", "DECIMAL", "DECLARE", "DEFAULT",
- "DEFERRABLE", "DEFERRED", "DELETE", "DESC", "DESCRIBE", "DESCRIPTOR",
- "DIAGNOSTICS", "DICONNECT", "DICTIONATRY", "DISPLACEMENT", "DISTINCT",
- "DOMAIN", "DOUBLE", "DROP", "ELSE", "END", "END-EXEC", "ESCAPE",
- "EXCEPT", "EXCEPTION", "EXEC", "EXECUTE", "EXISTS", "EXTERNAL",
- "EXTRACT", "FALSE", "FETCH", "FIRST", "FLOAT", "FOR", "FOREIGN",
- "FOUND", "FROM", "FULL", "GET", "GLOBAL", "GO", "GOTO", "GRANT",
- "GROUP", "HAVING", "HOUR", "IDENTITY", "IGNORE", "IMMEDIATE", "IN",
- "INCLUDE", "INDEX", "INDICATOR", "INITIALLY", "INNER", "INPUT",
- "INSENSITIVE", "INSERT", "INT", "INTEGER", "INTERSECT", "INTERVAL",
- "INTO", "IS", "ISOLATION", "JOIN", "KEY", "LANGUAGE", "LAST", "LEFT",
- "LEVEL", "LIKE", "LOCAL", "LOWER", "MATCH", "MAX", "MIN", "MINUTE",
- "MODULE", "MONTH", "NAMES", "NATIONAL", "NCHAR", "NEXT", "NOT", "NULL",
- "NULLIF", "NUMERIC", "OCTECT_LENGTH", "OF", "OFF", "ONLY", "OPEN",
- "OPTION", "OR", "ORDER", "OUTER", "OUTPUT", "OVERLAPS", "PARTIAL",
- "POSITION", "PRECISION", "PREPARE", "PRESERVE", "PRIMARY", "PRIOR",
- "PRIVILEGES", "PROCEDURE", "PUBLIC", "READ", "REAL", "REFERENCES",
- "RESTRICT", "REVOKE", "RIGHT", "ROLLBACK", "ROWS", "SCHEMA", "SCROLL",
- "SECOND", "SECTION", "SELECT", "SET", "SIZE", "SMALLINT", "SOME", "SQL",
- "SQLCA", "SQLCODE", "SQLERROR", "SQLSTATE", "SQLWARNING", "SUBSTRING",
- "SUM", "SYSTEM", "TABLE", "TEMPORARY", "THEN", "TIME", "TIMESTAMP",
- "TIMEZONE_HOUR", "TIMEZONE_MINUTE", "TO", "TRANSACTION", "TRANSLATE",
- "TRANSLATION", "TRUE", "UNION", "UNIQUE", "UNKNOWN", "UPDATE", "UPPER",
- "USAGE", "USER", "USING", "VALUE", "VALUES", "VARCHAR", "VARYING",
- "VIEW", "WHEN", "WHENEVER", "WHERE", "WITH", "WORK", "WRITE", "YEAR",
- "ZONE"
- )
7 R/Makefile
View
@@ -1,7 +0,0 @@
-S_SRC = S4R.R zzz.R dbObjectId.R MySQL.R MySQLSupport.R
-
-RMySQL.R: $(S_SRC)
- cat $(S_SRC) > RMySQL.R
-
-tags: $(S_SRC)
- rtags.py $(S_SRC) > tags
10 R/MySQL.R
View
@@ -316,8 +316,10 @@ setMethod("dbDataType",
setMethod("make.db.names",
signature(dbObj="MySQLObject", snames = "character"),
- def = function(dbObj, snames, ...){
- make.db.names.default(snames, keywords = .MySQLKeywords, ...)
+ def = function(dbObj, snames, keywords = .MySQLKeywords,
+ unique, allow.keywords, ...){
+ make.db.names.default(snames, keywords = .MySQLKeywords, unique = unique,
+ allow.keywords = allow.keywords)
},
valueClass = "character"
)
@@ -329,8 +331,8 @@ setMethod("SQLKeywords", "MySQLObject",
setMethod("isSQLKeyword",
signature(dbObj="MySQLObject", name="character"),
- def = function(dbObj, name, ...){
- isSQLKeyword.default(name, keywords = .MySQLKeywords)
+ def = function(dbObj, name, keywords = .MySQLKeywords, case, ...){
+ isSQLKeyword.default(name, keywords = .MySQLKeywords, case = case)
},
valueClass = "character"
)
1,208 R/RMySQL.R
View
@@ -1,1208 +0,0 @@
-##
-## $Id: S4R.R,v 1.4 2002/09/10 11:48:30 dj Exp dj $
-##
-## R/S-Plus compatibility
-
-usingR <- function(major=0, minor=0){
- if(is.null(version$language))
- return(FALSE)
- if(version$language!="R")
- return(FALSE)
- version$major>=major && version$minor>=minor
-}
-
-## constant holding the appropriate error class returned by try()
-if(usingR()){
- ErrorClass <- "try-error"
-} else {
- ErrorClass <- "Error"
-}
-##
-## $Id: zzz.R,v 1.5 2003/12/02 16:01:04 dj Exp dj $
-##
-
-".conflicts.OK" <- TRUE
-## need DBI and methods *prior* to having library.dynam() invoked!
-library(methods)
-library(DBI, warn.conflicts = FALSE)
-
-".First.lib" <-
-function(lib, pkg)
-{
- library(methods)
- library(DBI, warn.conflicts = FALSE)
- library.dynam("RMySQL", pkg, lib)
-}
-##
-## $Id: dbObjectId.R,v 1.4 2002/09/10 11:50:46 dj Exp $
-##
-## Copyright (C) 1999-2002 The Omega Project for Statistical Computing.
-##
-## This library is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public
-## License as published by the Free Software Foundation; either
-## version 2 of the License, or (at your option) any later version.
-##
-## This library is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-## General Public License for more details.
-##
-## You should have received a copy of the GNU General Public
-## License along with this library; if not, write to the Free Software
-## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-##
-
-## Class: dbObjectId
-##
-## This mixin helper class is NOT part of the database interface definition,
-## but it is extended by the Oracle, MySQL, and SQLite implementations to
-## MySQLObject and OracleObject to allow us to conviniently (and portably)
-## implement all database foreign objects methods (i.e., methods for show(),
-## print() format() the dbManger, dbConnection, dbResultSet, etc.)
-## A dbObjectId is an identifier into an actual remote database objects.
-## This class and its derived classes <driver-manager>Object need to
-## be VIRTUAL to avoid coercion (green book, p.293) during method dispatching.
-##
-## TODO: Convert the Id slot to be an external object (as per Luke Tierney's
-## implementation), even at the expense of S-plus compatibility?
-
-setClass("dbObjectId", representation(Id = "integer", "VIRTUAL"))
-
-## coercion methods
-setAs("dbObjectId", "integer",
- def = function(from) as(slot(from,"Id"), "integer")
-)
-setAs("dbObjectId", "numeric",
- def = function(from) as(slot(from, "Id"), "integer")
-)
-setAs("dbObjectId", "character",
- def = function(from) as(slot(from, "Id"), "character")
-)
-
-## formating, showing, printing,...
-setMethod("format", "dbObjectId",
- def = function(x, ...) {
- paste("(", paste(as(x, "integer"), collapse=","), ")", sep="")
- },
- valueClass = "character"
-)
-
-setMethod("show", "dbObjectId", def = function(object) print(object))
-
-setMethod("print", "dbObjectId",
- def = function(x, ...){
- expired <- if(isIdCurrent(x)) "" else "Expired "
- str <- paste("<", expired, class(x), ":", format(x), ">", sep="")
- cat(str, "\n")
- invisible(NULL)
- }
-)
-
-"isIdCurrent" <-
-function(obj)
-## verify that obj refers to a currently open/loaded database
-{
- obj <- as(obj, "integer")
- .Call("RS_DBI_validHandle", obj, PACKAGE = .MySQLPkgName)
-}
-##
-## $Id: MySQL.R,v 1.11 2006/02/15 18:01:03 dj Exp dj $
-##
-## Copyright (C) 1999 The Omega Project for Statistical Computing.
-##
-## This library is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either
-## version 2 of the License, or (at your option) any later version.
-##
-## This library is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-## General Public License for more details.
-##
-## You should have received a copy of the GNU General Public
-## License along with this library; if not, write to the Free Software
-## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-
-##
-## Constants
-##
-
-.MySQLRCS <- "$Id: MySQL.R,v 1.11 2006/02/15 18:01:03 dj Exp dj $"
-.MySQLPkgName <- "RMySQL" ## should we set thru package.description()?
-.MySQLVersion <- "0.5-8" ##package.description(.MySQLPkgName, fields = "Version")
-.MySQL.NA.string <- "\\N" ## on input, MySQL interprets \N as NULL (NA)
-
-setOldClass("data.frame") ## to appease setMethod's signature warnings...
-
-##
-## Class: DBIObject
-##
-setClass("MySQLObject", representation("DBIObject", "dbObjectId", "VIRTUAL"))
-
-##
-## Class: dbDriver
-##
-
-"MySQL" <-
-function(max.con=16, fetch.default.rec = 500, force.reload=FALSE)
-{
- mysqlInitDriver(max.con = max.con, fetch.default.rec = fetch.default.rec,
- force.reload = force.reload)
-}
-
-##
-## Class: DBIDriver
-##
-setClass("MySQLDriver", representation("DBIDriver", "MySQLObject"))
-
-## coerce (extract) any MySQLObject into a MySQLDriver
-setAs("MySQLObject", "MySQLDriver",
- def = function(from) new("MySQLDriver", Id = as(from, "integer")[1:2])
-)
-
-setMethod("dbUnloadDriver", "MySQLDriver",
- def = function(drv, ...) mysqlCloseDriver(drv, ...),
- valueClass = "logical"
-)
-
-setMethod("dbGetInfo", "MySQLDriver",
- def = function(dbObj, ...) mysqlDriverInfo(dbObj, ...)
-)
-
-setMethod("dbListConnections", "MySQLDriver",
- def = function(drv, ...) dbGetInfo(drv, "connectionIds")[[1]]
-)
-
-setMethod("summary", "MySQLDriver",
- def = function(object, ...) mysqlDescribeDriver(object, ...)
-)
-
-##
-## Class: DBIConnection
-##
-setClass("MySQLConnection", representation("DBIConnection", "MySQLObject"))
-
-setMethod("dbConnect", "MySQLDriver",
- def = function(drv, ...) mysqlNewConnection(drv, ...),
- valueClass = "MySQLConnection"
-)
-
-setMethod("dbConnect", "character",
- def = function(drv, ...) mysqlNewConnection(dbDriver(drv), ...),
- valueClass = "MySQLConnection"
-)
-
-## clone a connection
-setMethod("dbConnect", "MySQLConnection",
- def = function(drv, ...) mysqlCloneConnection(drv, ...),
- valueClass = "MySQLConnection"
-)
-
-setMethod("dbDisconnect", "MySQLConnection",
- def = function(conn, ...) mysqlCloseConnection(conn, ...),
- valueClass = "logical"
-)
-
-setMethod("dbSendQuery",
- signature(conn = "MySQLConnection", statement = "character"),
- def = function(conn, statement,...) mysqlExecStatement(conn, statement,...),
- valueClass = "MySQLResult"
-)
-
-setMethod("dbGetQuery",
- signature(conn = "MySQLConnection", statement = "character"),
- def = function(conn, statement, ...) mysqlQuickSQL(conn, statement, ...)
-)
-
-setMethod("dbGetException", "MySQLConnection",
- def = function(conn, ...){
- if(!isIdCurrent(conn))
- stop(paste("expired", class(conn)))
- .Call("RS_MySQL_getException", as(conn, "integer"),
- PACKAGE = .MySQLPkgName)
- },
- valueClass = "list"
-)
-
-setMethod("dbGetInfo", "MySQLConnection",
- def = function(dbObj, ...) mysqlConnectionInfo(dbObj, ...)
-)
-
-setMethod("dbListResults", "MySQLConnection",
- def = function(conn, ...) dbGetInfo(conn, "rsId")[[1]]
-)
-
-setMethod("summary", "MySQLConnection",
- def = function(object, ...) mysqlDescribeConnection(object, ...)
-)
-
-## convenience methods
-setMethod("dbListTables", "MySQLConnection",
- def = function(conn, ...){
- tbls <- dbGetQuery(conn, "show tables")
- if(length(tbls)>0)
- tbls <- tbls[,1]
- else
- tbls <- character()
- tbls
- },
- valueClass = "character"
-)
-
-setMethod("dbReadTable", signature(conn="MySQLConnection", name="character"),
- def = function(conn, name, ...) mysqlReadTable(conn, name, ...),
- valueClass = "data.frame"
-)
-
-setMethod("dbWriteTable",
- signature(conn="MySQLConnection", name="character", value="data.frame"),
- def = function(conn, name, value, ...){
- mysqlWriteTable(conn, name, value, ...)
- },
- valueClass = "logical"
-)
-
-## write table from filename (TODO: connections)
-setMethod("dbWriteTable",
- signature(conn="MySQLConnection", name="character", value="character"),
- def = function(conn, name, value, ...){
- mysqlImportFile(conn, name, value, ...)
- },
- valueClass = "logical"
-)
-
-setMethod("dbExistsTable",
- signature(conn="MySQLConnection", name="character"),
- def = function(conn, name, ...){
- ## TODO: find out the appropriate query to the MySQL metadata
- avail <- dbListTables(conn)
- if(length(avail)==0) avail <- ""
- match(tolower(name), tolower(avail), nomatch=0)>0
- },
- valueClass = "logical"
-)
-
-setMethod("dbRemoveTable",
- signature(conn="MySQLConnection", name="character"),
- def = function(conn, name, ...){
- if(dbExistsTable(conn, name)){
- rc <- try(dbGetQuery(conn, paste("DROP TABLE", name)))
- !inherits(rc, ErrorClass)
- }
- else FALSE
- },
- valueClass = "logical"
-)
-
-## return field names (no metadata)
-setMethod("dbListFields",
- signature(conn="MySQLConnection", name="character"),
- def = function(conn, name, ...){
- flds <- dbGetQuery(conn, paste("describe", name))[,1]
- if(length(flds)==0)
- flds <- character()
- flds
- },
- valueClass = "character"
-)
-
-setMethod("dbCommit", "MySQLConnection",
- def = function(conn, ...) .NotYetImplemented()
-)
-
-setMethod("dbRollback", "MySQLConnection",
- def = function(conn, ...) .NotYetImplemented()
-)
-
-setMethod("dbCallProc", "MySQLConnection",
- def = function(conn, ...) .NotYetImplemented()
-)
-
-##
-## Class: DBIResult
-##
-setClass("MySQLResult", representation("DBIResult", "MySQLObject"))
-
-setAs("MySQLResult", "MySQLConnection",
- def = function(from) new("MySQLConnection", Id = as(from, "integer")[1:3])
-)
-setAs("MySQLResult", "MySQLDriver",
- def = function(from) new("MySQLDriver", Id = as(from, "integer")[1:2])
-)
-
-setMethod("dbClearResult", "MySQLResult",
- def = function(res, ...) mysqlCloseResult(res, ...),
- valueClass = "logical"
-)
-
-setMethod("fetch", signature(res="MySQLResult", n="numeric"),
- def = function(res, n, ...){
- out <- mysqlFetch(res, n, ...)
- if(is.null(out))
- out <- data.frame(out)
- out
- },
- valueClass = "data.frame"
-)
-
-setMethod("fetch",
- signature(res="MySQLResult", n="missing"),
- def = function(res, n, ...){
- out <- mysqlFetch(res, n=0, ...)
- if(is.null(out))
- out <- data.frame(out)
- out
- },
- valueClass = "data.frame"
-)
-
-setMethod("dbGetInfo", "MySQLResult",
- def = function(dbObj, ...) mysqlResultInfo(dbObj, ...),
- valueClass = "list"
-)
-
-setMethod("dbGetStatement", "MySQLResult",
- def = function(res, ...){
- st <- dbGetInfo(res, "statement")[[1]]
- if(is.null(st))
- st <- character()
- st
- },
- valueClass = "character"
-)
-
-setMethod("dbListFields",
- signature(conn="MySQLResult", name="missing"),
- def = function(conn, name, ...){
- flds <- dbGetInfo(conn, "fields")$fields$name
- if(is.null(flds))
- flds <- character()
- flds
- },
- valueClass = "character"
-)
-
-setMethod("dbColumnInfo", "MySQLResult",
- def = function(res, ...) mysqlDescribeFields(res, ...),
- valueClass = "data.frame"
-)
-
-setMethod("dbGetRowsAffected", "MySQLResult",
- def = function(res, ...) dbGetInfo(res, "rowsAffected")[[1]],
- valueClass = "numeric"
-)
-
-setMethod("dbGetRowCount", "MySQLResult",
- def = function(res, ...) dbGetInfo(res, "rowCount")[[1]],
- valueClass = "numeric"
-)
-
-setMethod("dbHasCompleted", "MySQLResult",
- def = function(res, ...) dbGetInfo(res, "completed")[[1]] == 1,
- valueClass = "logical"
-)
-
-setMethod("dbGetException", "MySQLResult",
- def = function(conn, ...){
- id <- as(conn, "integer")[1:2]
- .Call("RS_MySQL_getException", id, PACKAGE = .MySQLPkgName)
- },
- valueClass = "list" ## TODO: should be a DBIException?
-)
-
-setMethod("summary", "MySQLResult",
- def = function(object, ...) mysqlDescribeResult(object, ...)
-)
-
-setMethod("dbDataType",
- signature(dbObj = "MySQLObject", obj = "ANY"),
- def = function(dbObj, obj, ...) mysqlDataType(obj, ...),
- valueClass = "character"
-)
-
-setMethod("make.db.names",
- signature(dbObj="MySQLObject", snames = "character"),
- def = function(dbObj, snames, ...){
- make.db.names.default(snames, keywords = .MySQLKeywords, ...)
- },
- valueClass = "character"
-)
-
-setMethod("SQLKeywords", "MySQLObject",
- def = function(dbObj, ...) .MySQLKeywords,
- valueClass = "character"
-)
-
-setMethod("isSQLKeyword",
- signature(dbObj="MySQLObject", name="character"),
- def = function(dbObj, name, ...){
- isSQLKeyword.default(name, keywords = .MySQLKeywords)
- },
- valueClass = "character"
-)
-## extension to the DBI 0.1-4
-setGeneric("dbApply", def = function(res, ...) standardGeneric("dbApply"))
-setMethod("dbApply", "MySQLResult",
- def = function(res, ...) mysqlDBApply(res, ...),
-)
-##
-## $Id: MySQLSupport.R,v 1.9 2003/12/02 15:20:39 dj Exp dj $
-##
-## Copyright (C) 1999 The Omega Project for Statistical Computing.
-##
-## This library is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public
-## License as published by the Free Software Foundation; either
-## version 2 of the License, or (at your option) any later version.
-##
-## This library is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-## General Public License for more details.
-##
-## You should have received a copy of the GNU General Public
-## License along with this library; if not, write to the Free Software
-## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-##
-
-"mysqlInitDriver" <-
-function(max.con=16, fetch.default.rec = 500, force.reload=FALSE)
-## create a MySQL database connection manager. By default we allow
-## up to "max.con" connections and single fetches of up to "fetch.default.rec"
-## records. These settings may be changed by re-loading the driver
-## using the "force.reload" = T flag (note that this will close all
-## currently open connections).
-## Returns an object of class "MySQLManger".
-## Note: This class is a singleton.
-{
- if(fetch.default.rec<=0)
- stop("default num of records per fetch must be positive")
- config.params <- as.integer(c(max.con, fetch.default.rec))
- force <- as.logical(force.reload)
- drvId <- .Call("RS_MySQL_init", config.params, force,
- PACKAGE = .MySQLPkgName)
- new("MySQLDriver", Id = drvId)
-}
-
-"mysqlCloseDriver"<-
-function(drv, ...)
-{
- if(!isIdCurrent(drv))
- return(TRUE)
- drvId <- as(drv, "integer")
- .Call("RS_MySQL_closeManager", drvId, PACKAGE = .MySQLPkgName)
-}
-
-"mysqlDescribeDriver" <-
-function(obj, verbose = FALSE, ...)
-## Print out nicely a brief description of the connection Driver
-{
- info <- dbGetInfo(obj)
- print(obj)
- cat(" Driver name: ", info$drvName, "\n")
- cat(" Max connections:", info$length, "\n")
- cat(" Conn. processed:", info$counter, "\n")
- cat(" Default records per fetch:", info$"fetch_default_rec", "\n")
- if(verbose){
- cat(" DBI API version: ", dbGetDBIVersion(), "\n")
- cat(" MySQL client version: ", info$clientVersion, "\n")
- }
- cat(" Open connections:", info$"num_con", "\n")
- if(verbose && !is.null(info$connectionIds)){
- for(i in seq(along = info$connectionIds)){
- cat(" ", i, " ")
- print(info$connectionIds[[i]])
- }
- }
- invisible(NULL)
-}
-
-"mysqlDriverInfo" <-
-function(obj, what="", ...)
-{
- if(!isIdCurrent(obj))
- stop(paste("expired", class(obj)))
- drvId <- as(obj, "integer")
- info <- .Call("RS_MySQL_managerInfo", drvId, PACKAGE = .MySQLPkgName)
- ## replace drv/connection id w. actual drv/connection objects
- conObjs <- vector("list", length = info$"num_con")
- ids <- info$connectionIds
- for(i in seq(along = ids))
- conObjs[[i]] <- new("MySQLConnection", Id = c(drvId, ids[i]))
- info$connectionIds <- conObjs
- info$managerId <- new("MySQLDriver", Id = drvId)
- if(!missing(what))
- info[what]
- else
- info
-}
-
-"mysqlNewConnection" <-
-## note that dbname may be a database name, an empty string "", or NULL.
-## The distinction between "" and NULL is that "" is interpreted by
-## the MySQL API as the default database (MySQL config specific)
-## while NULL means "no database".
-function(drv, dbname = "", username="",
- password="", host="",
- unix.socket = "", port = 0, client.flag = 0,
- groups = NULL, default.file = character(0))
-{
- if(!isIdCurrent(drv))
- stop("expired manager")
- con.params <- as.character(c(username, password, host,
- dbname, unix.socket, port,
- client.flag))
- groups <- as.character(groups)
- if(length(default.file)==1){
- default.file <- file.path(dirname(default.file), basename(default.file))
- if(!file.exists(default.file))
- stop(sprintf("mysql default file %s does not exist", default.file))
- }
- drvId <- as(drv, "integer")
- conId <- .Call("RS_MySQL_newConnection", drvId, con.params, groups,
- default.file, PACKAGE = .MySQLPkgName)
- new("MySQLConnection", Id = conId)
-}
-
-"mysqlCloneConnection" <-
-function(con, ...)
-{
- if(!isIdCurrent(con))
- stop(paste("expired", class(con)))
- conId <- as(con, "integer")
- newId <- .Call("RS_MySQL_cloneConnection", conId, PACKAGE = .MySQLPkgName)
- new("MySQLConnection", Id = newId)
-}
-
-"mysqlDescribeConnection" <-
-function(obj, verbose = FALSE, ...)
-{
- info <- dbGetInfo(obj)
- print(obj)
- cat(" User:", info$user, "\n")
- cat(" Host:", info$host, "\n")
- cat(" Dbname:", info$dbname, "\n")
- cat(" Connection type:", info$conType, "\n")
- if(verbose){
- cat(" MySQL server version: ", info$serverVersion, "\n")
- cat(" MySQL client version: ",
- dbGetInfo(as(obj, "MySQLDriver"), what="clientVersion")[[1]], "\n")
- cat(" MySQL protocol version: ", info$protocolVersion, "\n")
- cat(" MySQL server thread id: ", info$threadId, "\n")
- }
- if(length(info$rsId)>0){
- for(i in seq(along = info$rsId)){
- cat(" ", i, " ")
- print(info$rsId[[i]])
- }
- } else
- cat(" No resultSet available\n")
- invisible(NULL)
-}
-
-"mysqlCloseConnection" <-
-function(con, ...)
-{
- if(!isIdCurrent(con))
- return(TRUE)
- rs <- dbListResults(con)
- if(length(rs)>0){
- if(dbHasCompleted(rs[[1]]))
- dbClearResult(rs[[1]])
- else
- stop("connection has pending rows (close open results set first)")
- }
- conId <- as(con, "integer")
- .Call("RS_MySQL_closeConnection", conId, PACKAGE = .MySQLPkgName)
-}
-
-"mysqlConnectionInfo" <-
-function(obj, what="", ...)
-{
- if(!isIdCurrent(obj))
- stop(paste("expired", class(obj), deparse(substitute(obj))))
- id <- as(obj, "integer")
- info <- .Call("RS_MySQL_connectionInfo", id, PACKAGE = .MySQLPkgName)
- rsId <- vector("list", length = length(info$rsId))
- for(i in seq(along = info$rsId))
- rsId[[i]] <- new("MySQLResult", Id = c(id, info$rsId[i]))
- info$rsId <- rsId
- if(!missing(what))
- info[what]
- else
- info
-}
-
-"mysqlExecStatement" <-
-function(con, statement)
-## submits the sql statement to MySQL and creates a
-## dbResult object if the SQL operation does not produce
-## output, otherwise it produces a resultSet that can
-## be used for fetching rows.
-{
- if(!isIdCurrent(con))
- stop(paste("expired", class(con)))
- conId <- as(con, "integer")
- statement <- as(statement, "character")
- rsId <- .Call("RS_MySQL_exec", conId, statement, PACKAGE = .MySQLPkgName)
- new("MySQLResult", Id = rsId)
-}
-
-## helper function: it exec's *and* retrieves a statement. It should
-## be named somehting else.
-"mysqlQuickSQL" <-
-function(con, statement)
-{
- if(!isIdCurrent(con))
- stop(paste("expired", class(con)))
- nr <- length(dbListResults(con))
- if(nr>0){ ## are there resultSets pending on con?
- new.con <- dbConnect(con) ## yep, create a clone connection
- on.exit(dbDisconnect(new.con))
- rs <- dbSendQuery(new.con, statement)
- } else rs <- dbSendQuery(con, statement)
- if(dbHasCompleted(rs)){
- dbClearResult(rs) ## no records to fetch, we're done
- invisible()
- return(NULL)
- }
- res <- fetch(rs, n = -1)
- if(dbHasCompleted(rs))
- dbClearResult(rs)
- else
- warning("pending rows")
- res
-}
-
-"mysqlDescribeFields" <-
-function(res, ...)
-{
- flds <- dbGetInfo(res, "fieldDescription")[[1]][[1]]
- if(!is.null(flds)){
- flds$Sclass <- .Call("RS_DBI_SclassNames", flds$Sclass,
- PACKAGE = .MySQLPkgName)
- flds$type <- .Call("RS_MySQL_typeNames", as.integer(flds$type),
- PACKAGE = .MySQLPkgName)
- ## no factors
- structure(flds, row.names = paste(seq(along=flds$type)),
- class = "data.frame")
- }
- else data.frame(flds)
-}
-
-"mysqlDBApply" <-
-function(res, INDEX, FUN = stop("must specify FUN"),
- begin = NULL,
- group.begin = NULL,
- new.record = NULL,
- end = NULL,
- batchSize = 100, maxBatch = 1e6,
- ..., simplify = TRUE)
-## (Experimental)
-## This function is meant to handle somewhat gracefully(?) large amounts
-## of data from the DBMS by bringing into R manageable chunks (about
-## batchSize records at a time, but not more than maxBatch); the idea
-## is that the data from individual groups can be handled by R, but
-## not all the groups at the same time.
-##
-## dbApply apply functions to groups of rows coming from a remote
-## database resultSet upon the following fetching events:
-## begin (prior to fetching the first record)
-## group.begin (the record just fetched begins a new group)
-## new_record (a new record just fetched)
-## group.end (the record just fetched ends the current group)
-## end (the record just fetched is the very last record)
-##
-## The "begin", "begin.group", etc., specify R functions to be
-## invoked upon the corresponding events. (For compatibility
-## with other apply functions the arg FUN is used to specify the
-## most common case where we only specify the "group.end" event.)
-##
-## The following describes the exact order and form of invocation for the
-## various callbacks in the underlying C code. All callback functions
-## (except FUN) are optional.
-## begin()
-## group.begin(group.name)
-## new.record(df.record)
-## FUN(df.group, group.name) (aka group.end)
-## end()
-##
-## TODO: (1) add argument output=F/T to suppress the creation of
-## an expensive(?) output list.
-## (2) allow INDEX to be a list as in tapply()
-## (3) add a "counter" event, to callback every k rows
-## (3) should we implement a simplify argument, as in sapply()?
-## (4) should it report (instead of just warning) when we're forced
-## to handle partial groups (groups larger than maxBatch).
-## (5) extend to the case where even individual groups are too
-## big for R (as in incremental quantiles).
-## (6) Highly R-dependent, not sure yet how to port it to S-plus.
-{
- if(dbHasCompleted(res))
- stop("result set has completed")
- if(is.character(INDEX)){
- flds <- tolower(as.character(dbColumnInfo(res)$name))
- INDEX <- match(tolower(INDEX[1]), flds, 0)
- }
- if(INDEX<1)
- stop(paste("INDEX field", INDEX, "not in result set"))
-
- "null.or.fun" <- function(fun) # get fun obj, but a NULL is ok
- {
- if(is.null(fun))
- fun
- else
- match.fun(fun)
- }
- begin <- null.or.fun(begin)
- group.begin <- null.or.fun(group.begin)
- group.end <- null.or.fun(FUN) ## probably this is the most important
- end <- null.or.fun(end)
- new.record <- null.or.fun(new.record)
- rsId <- as(res, "integer")
- con <- as(res, "MySQLConnection")
- on.exit({
- rc <- dbGetException(con)
- if(!is.null(rc$errorNum) && rc$errorNum!=0)
- cat("dbApply aborted with MySQL error ", rc$errorNum,
- " (", rc$errorMsg, ")\n", sep = "")
-
- })
- ## BEGIN event handler (re-entrant, only prior to reading first row)
- if(!is.null(begin) && dbGetRowCount(res)==0)
- begin()
- rho <- environment()
- funs <- list(begin = begin, end = end,
- group.begin = group.begin,
- group.end = group.end, new.record = new.record)
- out <- .Call("RS_MySQL_dbApply",
- rs = rsId,
- INDEX = as.integer(INDEX-1),
- funs, rho, as.integer(batchSize), as.integer(maxBatch),
- PACKAGE = .MySQLPkgName)
- if(!is.null(end) && dbHasCompleted(res))
- end()
- out
-}
-
-"mysqlFetch" <-
-function(res, n=0, ...)
-## Fetch at most n records from the opened resultSet (n = -1 means
-## all records, n=0 means extract as many as "default_fetch_rec",
-## as defined by MySQLDriver (see describe(drv, T)).
-## The returned object is a data.frame.
-## Note: The method dbHasCompleted() on the resultSet tells you whether
-## or not there are pending records to be fetched.
-##
-## TODO: Make sure we don't exhaust all the memory, or generate
-## an object whose size exceeds option("object.size"). Also,
-## are we sure we want to return a data.frame?
-{
- n <- as(n, "integer")
- rsId <- as(res, "integer")
- rel <- .Call("RS_MySQL_fetch", rsId, nrec = n, PACKAGE = .MySQLPkgName)
- if(length(rel)==0 || length(rel[[1]])==0)
- return(NULL)
- ## create running row index as of previous fetch (if any)
- cnt <- dbGetRowCount(res)
- nrec <- length(rel[[1]])
- indx <- seq(from = cnt - nrec + 1, length = nrec)
- attr(rel, "row.names") <- as.character(indx)
- if(usingR())
- class(rel) <- "data.frame"
- else
- oldClass(rel) <- "data.frame"
- rel
-}
-
-## Note that originally we had only resultSet both for SELECTs
-## and INSERTS, ... Later on we created a base class dbResult
-## for non-Select SQL and a derived class resultSet for SELECTS.
-
-"mysqlResultInfo" <-
-function(obj, what = "", ...)
-{
- if(!isIdCurrent(obj))
- stop(paste("expired", class(obj), deparse(substitute(obj))))
- id <- as(obj, "integer")
- info <- .Call("RS_MySQL_resultSetInfo", id, PACKAGE = .MySQLPkgName)
- if(!missing(what))
- info[what]
- else
- info
-}
-
-"mysqlDescribeResult" <-
-function(obj, verbose = FALSE, ...)
-{
-
- if(!isIdCurrent(obj)){
- print(obj)
- invisible(return(NULL))
- }
- print(obj)
- cat(" Statement:", dbGetStatement(obj), "\n")
- cat(" Has completed?", if(dbHasCompleted(obj)) "yes" else "no", "\n")
- cat(" Affected rows:", dbGetRowsAffected(obj), "\n")
- cat(" Rows fetched:", dbGetRowCount(obj), "\n")
- flds <- dbColumnInfo(obj)
- if(verbose && !is.null(flds)){
- cat(" Fields:\n")
- out <- print(dbColumnInfo(obj))
- }
- invisible(NULL)
-}
-
-"mysqlCloseResult" <-
-function(res, ...)
-{
- if(!isIdCurrent(res))
- return(TRUE)
- rsId <- as(res, "integer")
- .Call("RS_MySQL_closeResultSet", rsId, PACKAGE = .MySQLPkgName)
-}
-
-"mysqlReadTable" <-
-function(con, name, row.names = "row_names", check.names = TRUE, ...)
-## Use NULL, "", or 0 as row.names to prevent using any field as row.names.
-{
- out <- dbGetQuery(con, paste("SELECT * from", name))
- if(check.names)
- names(out) <- make.names(names(out), unique = TRUE)
- ## should we set the row.names of the output data.frame?
- nms <- names(out)
- j <- switch(mode(row.names),
- "character" = if(row.names=="") 0 else
- match(tolower(row.names), tolower(nms),
- nomatch = if(missing(row.names)) 0 else -1),
- "numeric" = row.names,
- "NULL" = 0,
- 0)
- if(j==0)
- return(out)
- if(j<0 || j>ncol(out)){
- warning("row.names not set on output data.frame (non-existing field)")
- return(out)
- }
- rnms <- as.character(out[,j])
- if(all(!duplicated(rnms))){
- out <- out[,-j, drop = FALSE]
- row.names(out) <- rnms
- } else warning("row.names not set on output (duplicate elements in field)")
- out
-}
-
-"mysqlImportFile" <-
-function(con, name, value, field.types = NULL, overwrite = FALSE,
- append = FALSE, header, row.names, nrows = 50, sep = ",",
- eol="\n", skip = 0, quote = '"', ...)
-{
- if(overwrite && append)
- stop("overwrite and append cannot both be TRUE")
-
- ## Do we need to clone the connection (ie., if it is in use)?
- if(length(dbListResults(con))!=0){
- new.con <- dbConnect(con) ## there's pending work, so clone
- on.exit(dbDisconnect(new.con))
- }
- else
- new.con <- con
-
- if(dbExistsTable(con,name)){
- if(overwrite){
- if(!dbRemoveTable(con, name)){
- warning(paste("table", name, "couldn't be overwritten"))
- return(FALSE)
- }
- }
- else if(!append){
- warning(paste("table", name, "exists in database: aborting dbWriteTable"))
- return(FALSE)
- }
- }
-
- ## compute full path name (have R expand ~, etc)
- fn <- file.path(dirname(value), basename(value))
- if(missing(header) || missing(row.names)){
- f <- file(fn, open="r")
- if(skip>0)
- readLines(f, n=skip)
- txtcon <- textConnection(readLines(f, n=2))
- flds <- count.fields(txtcon, sep)
- close(txtcon)
- close(f)
- nf <- length(unique(flds))
- }
- if(missing(header)){
- header <- nf==2
- }
- if(missing(row.names)){
- if(header)
- row.names <- if(nf==2) TRUE else FALSE
- else
- row.names <- FALSE
- }
-
- new.table <- !dbExistsTable(con, name)
- if(new.table){
- ## need to init table, say, with the first nrows lines
- d <- read.table(fn, sep=sep, header=header, skip=skip, nrows=nrows, ...)
- sql <-
- dbBuildTableDefinition(new.con, name, obj=d, field.types = field.types,
- row.names = row.names)
- rs <- try(dbSendQuery(new.con, sql))
- if(inherits(rs, ErrorClass)){
- warning("could not create table: aborting sqliteImportFile")
- return(FALSE)
- }
- else
- dbClearResult(rs)
- }
- else if(!append){
- warning(sprintf("table %s already exists -- use append=TRUE?", name))
- }
-
- fmt <-
- paste("LOAD DATA LOCAL INFILE '%s' INTO TABLE %s ",
- "FIELDS TERMINATED BY '%s' ",
- if(!is.null(quote)) "OPTIONALLY ENCLOSED BY '%s' " else "",
- "LINES TERMINATED BY '%s' ",
- "IGNORE %d LINES ", sep="")
- if(is.null(quote))
- sql <- sprintf(fmt, fn, name, sep, eol, skip + as.integer(header))
- else
- sql <- sprintf(fmt, fn, name, sep, quote, eol, skip + as.integer(header))
-
- rs <- try(dbSendQuery(new.con, sql))
- if(inherits(rs, ErrorClass)){
- warning("could not load data into table")
- return(FALSE)
- }
- dbClearResult(rs)
- TRUE
-}
-
-"mysqlWriteTable" <-
-function(con, name, value, field.types, row.names = TRUE,
- overwrite = FALSE, append = FALSE, ..., allow.keywords = FALSE)
-## Create table "name" (must be an SQL identifier) and populate
-## it with the values of the data.frame "value"
-## TODO: This function should execute its sql as a single transaction,
-## and allow converter functions.
-## TODO: In the unlikely event that value has a field called "row_names"
-## we could inadvertently overwrite it (here the user should set
-## row.names=F) I'm (very) reluctantly adding the code re: row.names,
-## because I'm not 100% comfortable using data.frames as the basic
-## data for relations.
-{
- if(overwrite && append)
- stop("overwrite and append cannot both be TRUE")
- if(!is.data.frame(value))
- value <- as.data.frame(value)
- if(row.names){
- value <- cbind(row.names(value), value) ## can't use row.names= here
- names(value)[1] <- "row.names"
- }
- if(missing(field.types) || is.null(field.types)){
- ## the following mapping should be coming from some kind of table
- ## also, need to use converter functions (for dates, etc.)
- field.types <- sapply(value, dbDataType, dbObj = con)
- }
-
- ## Do we need to coerce any field prior to write it out?
- ## TODO: MySQL 4.1 introduces the boolean data type.
- for(i in seq(along = value)){
- if(is(value[[i]], "logical"))
- value[[i]] <- as(value[[i]], "integer")
- }
- i <- match("row.names", names(field.types), nomatch=0)
- if(i>0) ## did we add a row.names value? If so, it's a text field.
- field.types[i] <- dbDataType(dbObj=con, field.types$row.names)
- names(field.types) <- make.db.names(con, names(field.types),
- allow.keywords = allow.keywords)
- ## Do we need to clone the connection (ie., if it is in use)?
- if(length(dbListResults(con))!=0){
- new.con <- dbConnect(con) ## there's pending work, so clone
- on.exit(dbDisconnect(new.con))
- }
- else {
- new.con <- con
- }
-
- if(dbExistsTable(con,name)){
- if(overwrite){
- if(!dbRemoveTable(con, name)){
- warning(paste("table", name, "couldn't be overwritten"))
- return(F)
- }
- }
- else if(!append){
- warning(paste("table",name,"exists in database: aborting assignTable"))
- return(F)
- }
- }
- if(!dbExistsTable(con,name)){ ## need to re-test table for existance
- ## need to create a new (empty) table
- sql1 <- paste("create table ", name, "\n(\n\t", sep="")
- sql2 <- paste(paste(names(field.types), field.types), collapse=",\n\t",
- sep="")
- sql3 <- "\n)\n"
- sql <- paste(sql1, sql2, sql3, sep="")
- rs <- try(dbSendQuery(new.con, sql))
- if(inherits(rs, ErrorClass)){
- warning("could not create table: aborting assignTable")
- return(F)
- }
- else
- dbClearResult(rs)
- }
-
- ## TODO: here, we should query the MySQL to find out if it supports
- ## LOAD DATA thru pipes; if so, should open the pipe instead of a file.
-
- fn <- tempfile("rsdbi")
- fn <- gsub("\\\\", "/", fn) # Since MySQL on Windows wants \ double (BDR)
- safe.write(value, file = fn)
- on.exit(unlink(fn), add = TRUE)
- sql4 <- paste("LOAD DATA LOCAL INFILE '", fn, "'",
- " INTO TABLE ", name,
- " LINES TERMINATED BY '\n' ", sep="")
- rs <- try(dbSendQuery(new.con, sql4))
- if(inherits(rs, ErrorClass)){
- warning("could not load data into table")
- return(F)
- }
- else
- dbClearResult(rs)
- TRUE
-}
-
-"dbBuildTableDefinition" <-
-function(dbObj, name, obj, field.types = NULL, row.names = TRUE, ...)
-{
- if(!is.data.frame(obj))
- obj <- as.data.frame(obj)
- if(!is.null(row.names) && row.names){
- obj <- cbind(row.names(obj), obj) ## can't use row.names= here
- names(obj)[1] <- "row.names"
- }
- if(is.null(field.types)){
- ## the following mapping should be coming from some kind of table
- ## also, need to use converter functions (for dates, etc.)
- field.types <- sapply(obj, dbDataType, dbObj = dbObj)
- }
- i <- match("row.names", names(field.types), nomatch=0)
- if(i>0) ## did we add a row.names value? If so, it's a text field.
- field.types[i] <- dbDataType(dbObj, field.types$row.names)
- names(field.types) <-
- make.db.names(dbObj, names(field.types), allow.keywords = FALSE)
-
- ## need to create a new (empty) table
- flds <- paste(names(field.types), field.types)
- paste("CREATE TABLE", name, "\n(", paste(flds, collapse=",\n\t"), "\n)")
-}
-
-## the following is almost exactly from the ROracle driver
-"safe.write" <-
-function(value, file, batch, ...)
-## safe.write makes sure write.table doesn't exceed available memory by batching
-## at most batch rows (but it is still slowww)
-{
- N <- nrow(value)
- if(N<1){
- warning("no rows in data.frame")
- return(NULL)
- }
- digits <- options(digits = 17)
- on.exit(options(digits))
- if(missing(batch) || is.null(batch))
- batch <- 10000
- else if(batch<=0)
- batch <- N
- from <- 1
- to <- min(batch, N)
- while(from<=N){
- if(usingR())
- write.table(value[from:to,, drop=FALSE], file = file, append = TRUE,
- quote = FALSE, sep="\t", na = .MySQL.NA.string,
- row.names=FALSE, col.names=FALSE, eol = '\n', ...)
- else
- write.table(value[from:to,, drop=FALSE], file = file, append = TRUE,
- quote.string = FALSE, sep="\t", na = .MySQL.NA.string,
- dimnames.write=FALSE, end.of.row = '\n', ...)
- from <- to+1
- to <- min(to+batch, N)
- }
- invisible(NULL)
-}
-
-"mysqlDataType" <-
-function(obj, ...)
-## find a suitable SQL data type for the R/S object obj
-## TODO: Lots and lots!! (this is a very rough first draft)
-## need to register converters, abstract out MySQL and generalize
-## to Oracle, Informix, etc. Perhaps this should be table-driven.
-## NOTE: MySQL data types differ from the SQL92 (e.g., varchar truncate
-## trailing spaces). MySQL enum() maps rather nicely to factors (with
-## up to 65535 levels)
-{
- rs.class <- data.class(obj) ## this differs in R 1.4 from older vers
- rs.mode <- storage.mode(obj)
- if(rs.class=="numeric" || rs.class == "integer"){
- sql.type <- if(rs.mode=="integer") "bigint" else "double"
- }
- else {
- sql.type <- switch(rs.class,
- character = "text",
- logical = "tinyint", ## but we need to coerce to int!!
- factor = "text", ## up to 65535 characters
- ordered = "text",
- "text")
- }
- sql.type
-}
-
-## the following reserved words were taken from Section 6.1.7
-## of the MySQL Manual, Version 4.1.1-alpha, html format.
-
-".MySQLKeywords" <-
-c("ADD", "ALL", "ALTER", "ANALYZE", "AND", "AS", "ASC", "ASENSITIVE",
- "AUTO_INCREMENT", "BDB", "BEFORE", "BERKELEYDB", "BETWEEN", "BIGINT",
- "BINARY", "BLOB", "BOTH", "BY", "CALL", "CASCADE", "CASE", "CHANGE",
- "CHAR", "CHARACTER", "CHECK", "COLLATE", "COLUMN", "COLUMNS",
- "CONDITION", "CONNECTION", "CONSTRAINT", "CONTINUE", "CREATE",
- "CROSS", "CURRENT_DATE", "CURRENT_TIME", "CURRENT_TIMESTAMP",
- "CURSOR", "DATABASE", "DATABASES", "DAY_HOUR", "DAY_MICROSECOND",
- "DAY_MINUTE", "DAY_SECOND", "DEC", "DECIMAL", "DECLARE", "DEFAULT",
- "DELAYED", "DELETE", "DESC", "DESCRIBE", "DISTINCT", "DISTINCTROW",
- "DIV", "DOUBLE", "DROP", "ELSE", "ELSEIF", "ENCLOSED", "ESCAPED",
- "EXISTS", "EXIT", "EXPLAIN", "FALSE", "FETCH", "FIELDS", "FLOAT",
- "FOR", "FORCE", "FOREIGN", "FOUND", "FROM", "FULLTEXT", "GRANT",
- "GROUP", "HAVING", "HIGH_PRIORITY", "HOUR_MICROSECOND", "HOUR_MINUTE",
- "HOUR_SECOND", "IF", "IGNORE", "IN", "INDEX", "INFILE", "INNER",
- "INNODB", "INOUT", "INSENSITIVE", "INSERT", "INT", "INTEGER",
- "INTERVAL", "INTO", "IO_THREAD", "IS", "ITERATE", "JOIN", "KEY",
- "KEYS", "KILL", "LEADING", "LEAVE", "LEFT", "LIKE", "LIMIT",
- "LINES", "LOAD", "LOCALTIME", "LOCALTIMESTAMP", "LOCK", "LONG",
- "LONGBLOB", "LONGTEXT", "LOOP", "LOW_PRIORITY", "MASTER_SERVER_ID",
- "MATCH", "MEDIUMBLOB", "MEDIUMINT", "MEDIUMTEXT", "MIDDLEINT",
- "MINUTE_MICROSECOND", "MINUTE_SECOND", "MOD", "NATURAL", "NOT",
- "NO_WRITE_TO_BINLOG", "NULL", "NUMERIC", "ON", "OPTIMIZE", "OPTION",
- "OPTIONALLY", "OR", "ORDER", "OUT", "OUTER", "OUTFILE", "PRECISION",
- "PRIMARY", "PRIVILEGES", "PROCEDURE", "PURGE", "READ", "REAL",
- "REFERENCES", "REGEXP", "RENAME", "REPEAT", "REPLACE", "REQUIRE",
- "RESTRICT", "RETURN", "RETURNS", "REVOKE", "RIGHT", "RLIKE",
- "SECOND_MICROSECOND", "SELECT", "SENSITIVE", "SEPARATOR", "SET",
- "SHOW", "SMALLINT", "SOME", "SONAME", "SPATIAL", "SPECIFIC",
- "SQL", "SQLEXCEPTION", "SQLSTATE", "SQLWARNING", "SQL_BIG_RESULT",
- "SQL_CALC_FOUND_ROWS", "SQL_SMALL_RESULT", "SSL", "STARTING",
- "STRAIGHT_JOIN", "STRIPED", "TABLE", "TABLES", "TERMINATED",
- "THEN", "TINYBLOB", "TINYINT", "TINYTEXT", "TO", "TRAILING",
- "TRUE", "TYPES", "UNDO", "UNION", "UNIQUE", "UNLOCK", "UNSIGNED",
- "UPDATE", "USAGE", "USE", "USER_RESOURCES", "USING", "UTC_DATE",
- "UTC_TIME", "UTC_TIMESTAMP", "VALUES", "VARBINARY", "VARCHAR",
- "VARCHARACTER", "VARYING", "WHEN", "WHERE", "WHILE", "WITH",
- "WRITE", "XOR", "YEAR_MONTH", "ZEROFILL"
- )
9 R/zzz.R
View
@@ -3,14 +3,9 @@
##
".conflicts.OK" <- TRUE
-## need DBI and methods *prior* to having library.dynam() invoked!
-library(methods)
-library(DBI, warn.conflicts = FALSE)
".First.lib" <-
-function(lib, pkg)
+function(libname, pkgname)
{
- library(methods)
- library(DBI, warn.conflicts = FALSE)
- library.dynam("RMySQL", pkg, lib)
+ library.dynam("RMySQL", pkgname, libname)
}
2  src/Makevars
View
@@ -1,2 +1,2 @@
-PKG_CPPFLAGS = -I/usr/include/mysql -Wall -pedantic
+PKG_CPPFLAGS = -I/usr/include/mysql
PKG_LIBS = -lmysqlclient -lz
Please sign in to comment.
Something went wrong with that request. Please try again.