RMySQL/0000755000176200001440000000000014751667432011360 5ustar liggesusersRMySQL/tests/0000755000176200001440000000000014751652206012513 5ustar liggesusersRMySQL/tests/testthat/0000755000176200001440000000000014751667432014362 5ustar liggesusersRMySQL/tests/testthat/test-dbQuoteString.R0000644000176200001440000000046614751652206020253 0ustar liggesuserscontext("dbQuoteString") test_that("quoting works", { if (!mysqlHasDefault()) skip("Test database not available") con <- dbConnect(MySQL(), dbname = "test") on.exit(dbDisconnect(con)) expect_equal(dbQuoteString(con, "\\'"), SQL("'\\\\\\''")) expect_equal(dbQuoteString(con, "'"), SQL("'\\''")) }) RMySQL/tests/testthat/test-tables.R0000644000176200001440000000100614751652206016722 0ustar liggesuserscontext("tables") test_that("basic roundtrip is succesful", { if (!mysqlHasDefault()) skip("Test database not available") myDF <- data.frame( x = paste("x", 1:5, sep = ""), y = paste("y", 1:5, sep = ""), row.names = letters[1:5], stringsAsFactors = FALSE) conn <- dbConnect(RMySQL::MySQL(), dbname = "test") dbRemoveTable(conn, "mydf") dbWriteTable(conn, name = "mydf", value = myDF) expect_equal(dbReadTable(conn, "mydf"), myDF) dbRemoveTable(conn, "mydf") dbDisconnect(conn) }) RMySQL/tests/testthat/dat-n.bin0000644000176200001440000000002514751652206016045 0ustar liggesusersa|b 1|x 2|y 3|z \N|E RMySQL/tests/testthat/test-queries.R0000644000176200001440000000175714751652206017142 0ustar liggesuserscontext("queries") test_that("query returns expected number of rows", { if (!mysqlHasDefault()) skip("Test database not available") conn <- dbConnect(RMySQL::MySQL(), dbname = "test") dbRemoveTable(conn, "iris") dbWriteTable(conn, 'iris', datasets::iris, row.names = FALSE) rs <- dbSendQuery(conn, "SELECT * FROM iris WHERE Species='versicolor'") x <- dbFetch(rs, n = 2) expect_equal(nrow(x), 2) expect_equal(dbGetRowCount(rs), 2) dbClearResult(rs) dbRemoveTable(conn, "iris") dbDisconnect(conn) }) test_that("correctly computes affected rows", { if (!mysqlHasDefault()) skip("Test database not available") conn <- dbConnect(RMySQL::MySQL(), dbname="test") dbRemoveTable(conn, "iris") dbWriteTable(conn, 'iris', datasets::iris, row.names = FALSE) rs <- dbSendQuery(conn, "DELETE FROM iris WHERE Species = 'versicolor'") expect_equal(dbGetRowsAffected(rs), sum(iris$Species == 'versicolor')) dbClearResult(rs) dbRemoveTable(conn, "iris") dbDisconnect(conn) }) RMySQL/tests/testthat/test-dbWriteTable.R0000644000176200001440000000066014751652206020025 0ustar liggesuserscontext("dbWriteTable") test_that("options work", { if (!mysqlHasDefault()) skip("Test database not available") con <- dbConnect(MySQL(), dbname = "test") on.exit(dbDisconnect(con)) expected <- data.frame( a = c(1:3, NA), b = c("x", "y", "z", "E"), stringsAsFactors = FALSE ) dbWriteTable(con, "dat", "dat-n.bin", sep="|", eol="\n", overwrite = TRUE) expect_equal(dbReadTable(con, "dat"), expected) }) RMySQL/tests/testthat.R0000644000176200001440000000007014751652206014473 0ustar liggesuserslibrary(testthat) library(RMySQL) test_check("RMySQL") RMySQL/MD50000644000176200001440000000637514751667432011703 0ustar liggesusers8c2899a9fc60a4336e74116ea8411d01 *DESCRIPTION 9896ccc9c7b3ae7ddf6a87fd6291d629 *NAMESPACE 5e19d2180ce2af376d51bf98f5a164c0 *NEWS.md 770ee6371f3964979622625f3a8d2059 *R/connection.R 774aa880209ec8ef84354125fa657574 *R/data-type.R f77975c929581d80f07b5b1181cd9568 *R/default.R 4ed5ccc20b76a4d7840e0eaf53cefe60 *R/driver.R 0b9fa437854f33139a28764023f5e0fc *R/escaping.R 9a8c061239333a79f6f6748ebe12c066 *R/extension.R 6522900008fdc03348f2e91130b06ee5 *R/is-valid.R 35f83db05db8dfe4d07db73a6af6e15b *R/mysql.R 09f394712d90166719d4ac976b151044 *R/result.R 504a03ba3c6cf6bf84aa98d9afe5057d *R/table.R bb9bd59374a86fb9ef886fdbaff60efd *R/transaction.R bc7baead3b6080f04dc81efd2fe1ff39 *cleanup 16e48d31b0d78e0c27caece84f1d42b2 *configure d41d8cd98f00b204e9800998ecf8427e *configure.win 4a6bbeeaae56c5b968e8dbde2c3eff3d *man/MySQLConnection-class.Rd 2fdfff757aaaa2d166b301f07505bebb *man/MySQLDriver-class.Rd f596c6d258f317745cfcfa2633558543 *man/MySQLResult-class.Rd 6364b30972cb3141b69d3e7229d91527 *man/constants.Rd 4c97c868849a992736e3332a896e858f *man/db-meta.Rd 90bebc9a0cfa2c772ace7b657823bb48 *man/dbApply.Rd 4d47cfea1a45586a855c7108ccfd0233 *man/dbColumnInfo-MySQLConnection-method.Rd ac312d085e5673d1ba78172dfdc51f89 *man/dbConnect-MySQLDriver-method.Rd 29707c90f492cfa81309f46bd3354ceb *man/dbDataType-MySQLDriver-method.Rd a409c3d66d8702185ba927e8e7a0d26d *man/dbEscapeStrings.Rd a98210ce2cbdc61c046614692063e6fe *man/dbGetInfo-MySQLDriver-method.Rd e0fe5548bb94dedd2fe832f806acc9fa *man/dbNextResult.Rd ce8e06f5337abaf39aaccf5f65e61930 *man/dbQuoteIdentifier-MySQLConnection-character-method.Rd a3198c18de5476e9111632404f44c000 *man/dbReadTable.Rd eeab96c62fea4f8948bb93412415b16f *man/dbUnloadDriver-MySQLDriver-method.Rd 54e70b5c86663a45333e0f8670b25b72 *man/dbWriteTable.Rd 3030ea622da8b140f6c23a9a59a700b7 *man/isIdCurrent.Rd e14a787c4590cc5877ad2f45bacce7ce *man/make.db.names-MySQLConnection-character-method.Rd 0ad513c181cab40bc35f642030a5440b *man/mysqlBuildTableDefinition.Rd 7e8b2abe92d9ce005c65375c2a759e91 *man/mysqlClientLibraryVersions.Rd 2194c91722a487674cc342a00ac75371 *man/mysqlHasDefault.Rd 476cc4a1f9df5a4313f8db760bb0ee7a *man/query.Rd a89de2d298da31726f5053e1ae04b2b0 *man/result-meta.Rd dfc293edf9a287cbd316b7377debd5d0 *man/transactions.Rd 907343d8176df8e5611a85761a3e91f1 *src/Makevars.in 5c31ee64e05993d68566f4cfc88cab1f *src/Makevars.win 0c16d992df778d6c9c6db0f2364b9481 *src/RMySQL-init.c 567b67b317923e4d9b12bd4146119043 *src/RS-MySQL.h b419b66a86b8c70b6e02e28e29711c23 *src/S4R.h ab02157be3f52fb2ca36c37aa10e3bb8 *src/connection.c c7f128b5102e96d022459a8e2333cb74 *src/db-apply.c ed126d89ac62976c66c97e66b696cf4c *src/driver.c c740cad960e5ae28dc071200a0db74fd *src/exception.c 04b87fae5a133bec62e874a5dd1545f2 *src/fields.c 04e5914a4a36d4ef4821c227dba50ee7 *src/getopt.h 1b87bfb1059b2cf5a666e3afb586ec16 *src/result.c 4e940f72c5b22c0c029686f5a58644e7 *src/utils.c 1ac630d06a0a5f7c98ac113f301f7477 *tests/testthat.R a068d5330949c7f13f695ca5f62e1364 *tests/testthat/dat-n.bin 3c09a21af4a8590c9469191e114ec167 *tests/testthat/test-dbQuoteString.R cac23acd19d0eb40542556735cad49ae *tests/testthat/test-dbWriteTable.R 8c216377a643bc5acf5fca8ca2e969a5 *tests/testthat/test-queries.R 13d5f7a6836a61d22028f28fe8a21f0e *tests/testthat/test-tables.R 3ff87e58aff280211b5a1cac5961ee0a *tools/winlibs.R RMySQL/configure.win0000644000176200001440000000000014751652206014037 0ustar liggesusersRMySQL/R/0000755000176200001440000000000014751652206011552 5ustar liggesusersRMySQL/R/table.R0000644000176200001440000002364514751652206012776 0ustar liggesusers#' @include connection.R NULL #' Convenience functions for importing/exporting DBMS tables #' #' These functions mimic their R/S-Plus counterpart \code{get}, \code{assign}, #' \code{exists}, \code{remove}, and \code{objects}, except that they generate #' code that gets remotely executed in a database engine. #' #' @return A data.frame in the case of \code{dbReadTable}; otherwise a logical #' indicating whether the operation was successful. #' @note Note that the data.frame returned by \code{dbReadTable} only has #' primitive data, e.g., it does not coerce character data to factors. #' #' @param conn a \code{\linkS4class{MySQLConnection}} object, produced by #' \code{\link[DBI]{dbConnect}} #' @param name a character string specifying a table name. #' @param check.names If \code{TRUE}, the default, column names will be #' converted to valid R identifiers. #' @param row.names A string or an index specifying the column in the DBMS table #' to use as \code{row.names} in the output data.frame. Defaults to using the #' \code{row_names} column if present. Set to \code{NULL} to never use #' row names. #' @param ... Unused, needed for compatiblity with generic. #' @export #' @rdname dbReadTable #' @examples #' if (mysqlHasDefault()) { #' con <- dbConnect(RMySQL::MySQL(), dbname = "test") #' #' # By default, row names are written in a column to row_names, and #' # automatically read back into the row.names() #' dbWriteTable(con, "mtcars", mtcars[1:5, ], overwrite = TRUE) #' dbReadTable(con, "mtcars") #' dbReadTable(con, "mtcars", row.names = NULL) #' } setMethod("dbReadTable", c("MySQLConnection", "character"), function(conn, name, row.names, check.names = TRUE, ...) { out <- dbGetQuery(conn, paste("SELECT * FROM", name)) if (check.names) { names(out) <- make.names(names(out), unique = TRUE) } row.names <- rownames_column(out, row.names) if (is.null(row.names)) return(out) rnms <- as.character(out[[row.names]]) if (anyDuplicated(rnms)) { warning("row.names not set (duplicate elements in field)", call. = FALSE) } else { out <- out[, -row.names, drop = F] row.names(out) <- rnms } out } ) ## 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. #' Write a local data frame or file to the database. #' #' @export #' @rdname dbWriteTable #' @param conn a \code{\linkS4class{MySQLConnection}} object, produced by #' \code{\link[DBI]{dbConnect}} #' @param name a character string specifying a table name. #' @param value a data.frame (or coercible to data.frame) object or a #' file name (character). In the first case, the data.frame is #' written to a temporary file and then imported to SQLite; when \code{value} #' is a character, it is interpreted as a file name and its contents imported #' to SQLite. #' @param row.names A logical specifying whether the \code{row.names} should be #' output to the output DBMS table; if \code{TRUE}, an extra field whose name #' will be whatever the R identifier \code{"row.names"} maps to the DBMS (see #' \code{\link[DBI]{make.db.names}}). If \code{NA} will add rows names if #' they are characters, otherwise will ignore. #' @param overwrite a logical specifying whether to overwrite an existing table #' or not. Its default is \code{FALSE}. (See the BUGS section below) #' @param append a logical specifying whether to append to an existing table #' in the DBMS. Its default is \code{FALSE}. #' @param field.types character vector of named SQL field types where #' the names are the names of new table's columns. If missing, types inferred #' with \code{\link[DBI]{dbDataType}}). #' @param allow.keywords logical indicating whether column names that happen to #' be MySQL keywords be used as column names in the resulting relation (table) #' being written. Defaults to FALSE, forcing mysqlWriteTable to modify column #' names to make them legal MySQL identifiers. #' @param header logical, does the input file have a header line? Default is the #' same heuristic used by \code{read.table}, i.e., \code{TRUE} if the first #' line has one fewer column that the second line. #' @param nrows number of lines to rows to import using \code{read.table} from #' the input file to create the proper table definition. Default is 50. #' @param sep field separator character #' @param eol End-of-line separator #' @param skip number of lines to skip before reading data in the input file. #' @param quote the quote character used in the input file (defaults to #' \code{\"}.) #' @param ... Unused, needs for compatibility with generic. #' @export setMethod("dbWriteTable", c("MySQLConnection", "character", "data.frame"), function(conn, name, value, field.types = NULL, row.names = TRUE, overwrite = FALSE, append = FALSE, ..., allow.keywords = FALSE) { if (overwrite && append) stop("overwrite and append cannot both be TRUE", call. = FALSE) found <- dbExistsTable(conn, name) if (found && !overwrite && !append) { stop("Table ", name, " exists in database, and both overwrite and", " append are FALSE", call. = FALSE) } if (found && overwrite) { dbRemoveTable(conn, name) } value <- explict_rownames(value, row.names) if (!found || overwrite) { sql <- mysqlBuildTableDefinition(conn, name, value, field.types = field.types, row.names = FALSE) dbGetQuery(conn, sql) } if (nrow(value) == 0) return(TRUE) ## Save file to disk, then use LOAD DATA command fn <- normalizePath(tempfile("rsdbi"), winslash = "/", mustWork = FALSE) safe.write(value, file = fn) on.exit(unlink(fn), add = TRUE) sql <- paste0( "LOAD DATA LOCAL INFILE ", dbQuoteString(conn, fn), " INTO TABLE ", dbQuoteIdentifier(conn, name), " FIELDS TERMINATED BY '\t' ", " LINES TERMINATED BY '\n' ", " (", paste(dbQuoteIdentifier(conn, names(value)), collapse=", "), ");" ) dbGetQuery(conn, sql) TRUE } ) #' @export #' @rdname dbWriteTable setMethod("dbWriteTable", c("MySQLConnection", "character", "character"), function(conn, name, value, field.types = NULL, overwrite = FALSE, append = FALSE, header = TRUE, row.names = FALSE, nrows = 50, sep = ",", eol="\n", skip = 0, quote = '"', ...) { if (overwrite && append) stop("overwrite and append cannot both be TRUE", call. = FALSE) found <- dbExistsTable(conn, name) if (found && !overwrite && !append) { stop("Table ", name, " exists in database, and both overwrite and", " append are FALSE", call. = FALSE) } if (found && overwrite) { dbRemoveTable(conn, name) } if (!found || overwrite) { # Initialise table with first `nrows` lines d <- read.table(value, sep = sep, header = header, skip = skip, nrows = nrows, na.strings = "\\N", comment.char = "", stringsAsFactors = FALSE) sql <- mysqlBuildTableDefinition(conn, name, d, field.types = field.types, row.names = row.names) dbGetQuery(conn, sql) } path <- normalizePath(value, winslash = "/", mustWork = TRUE) sql <- paste0( "LOAD DATA LOCAL INFILE ", dbQuoteString(conn, path), "\n", "INTO TABLE ", dbQuoteIdentifier(conn, name), "\n", "FIELDS TERMINATED BY ", dbQuoteString(conn, sep), "\n", "OPTIONALLY ENCLOSED BY ", dbQuoteString(conn, quote), "\n", "LINES TERMINATED BY ", dbQuoteString(conn, eol), "\n", "IGNORE ", skip + as.integer(header), " LINES") dbSendQuery(conn, sql) TRUE } ) #' @export #' @rdname dbReadTable setMethod("dbListTables", "MySQLConnection", function(conn, ...) { dbGetQuery(conn, "SHOW TABLES")[[1]] }) #' @export #' @rdname dbReadTable setMethod("dbExistsTable", c("MySQLConnection", "character"), function(conn, name, ...) { name %in% dbListTables(conn) } ) #' @export #' @rdname dbReadTable setMethod("dbRemoveTable", c("MySQLConnection", "character"), function(conn, name, ...){ if (!dbExistsTable(conn, name)) return(FALSE) dbGetQuery(conn, paste("DROP TABLE", name)) TRUE } ) #' @export #' @rdname dbReadTable setMethod("dbListFields", c("MySQLConnection", "character"), function(conn, name, ...){ dbGetQuery(conn, paste("DESCRIBE", name))[[1]] } ) #' Experimental dbColumnInfo method for a connection #' #' @export #' @keywords internal setMethod("dbColumnInfo", "MySQLConnection", function(res, name, ...) { rs <- dbSendQuery(res, paste0("SELECT * from ", dbQuoteIdentifier(res, name))) on.exit(dbClearResult(rs)) dbColumnInfo(rs) }) # Row name handling ------------------------------------------------------------ explict_rownames <- function(df, row.names = NA) { if (is.na(row.names)) { row.names <- is.character(attr(df, "row.names")) } if (!row.names) return(df) rn <- data.frame(row_names = row.names(df)) cbind(rn, df) } # Figure out which column to rownames_column <- function(df, row.names) { if (missing(row.names)) { if (!"row_names" %in% names(df)) { return(NULL) } row.names <- "row_names" } if (is.null(row.names) || identical(row.names, FALSE)) { NULL } else if (is.character(row.names)) { if (!(row.names %in% names(df))) { stop("Column ", row.names, " not present in output", call. = FALSE) } match(row.names, names(df)) } else if (is.numeric(row.names)) { if (row.names == 0) return(NULL) if (row.names < 0 || row.names > ncol(df)) { stop("Column ", row.names, " not present in output", call. = FALSE) } row.names } else { stop("Unknown specification for row.names") } } RMySQL/R/data-type.R0000644000176200001440000000220514751652206013564 0ustar liggesusers#' Determine the SQL Data Type of an S object #' #' This method is a straight-forward implementation of the corresponding #' generic function. #' #' @param dbObj A \code{MySQLDriver} or \code{MySQLConnection}. #' @param obj R/S-Plus object whose SQL type we want to determine. #' @export #' @examples #' dbDataType(RMySQL::MySQL(), "a") #' dbDataType(RMySQL::MySQL(), 1:3) #' dbDataType(RMySQL::MySQL(), 2.5) setMethod("dbDataType", c("MySQLDriver", "ANY"), function(dbObj, obj) { mysqlDataType(obj) }) #' @export #' @rdname dbDataType-MySQLDriver-method setMethod("dbDataType", c("MySQLConnection", "ANY"), function(dbObj, obj) { mysqlDataType(obj) }) mysqlDataType <- function(obj) { 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") { if (rs.mode == "integer") { "bigint" } else { "double" } } else { switch(rs.class, character = "text", logical = "tinyint", ## but we need to coerce to int!! factor = "text", ## up to 65535 characters ordered = "text", "text" ) } } RMySQL/R/default.R0000644000176200001440000000142114751652206013317 0ustar liggesusers#' Check if default database is available. #' #' RMySQL examples and tests connect to a database defined by the #' \code{rs-dbi} group in \code{~/.my.cnf}. This function checks if that #' database is available, and if not, displays an informative message. #' #' @export #' @examples #' if (mysqlHasDefault()) { #' db <- dbConnect(RMySQL::MySQL(), dbname = "test") #' dbListTables(db) #' dbDisconnect(db) #' } mysqlHasDefault <- function() { tryCatch({ dbConnect(MySQL(), dbname = "test") TRUE }, error = function(...) { message( "Could not initialise default MySQL database. If MySQL is running\n", "check that you have a ~/.my.cnf file that contains a [rs-dbi] section\n", "describing how to connect to a test database." ) FALSE }) } RMySQL/R/transaction.R0000644000176200001440000000226714751652206014231 0ustar liggesusers#' @include connection.R NULL #' DBMS Transaction Management #' #' Commits or roll backs the current transaction in an MySQL connection. #' Note that in MySQL DDL statements (e.g. \code{CREATE TABLE}) can not #' be rolled back. #' #' @param conn a \code{MySQLConnection} object, as produced by #' \code{\link[DBI::dbConnect]{DBI::dbConnect()}}. #' @param ... Unused. #' @examples #' if (mysqlHasDefault()) { #' con <- dbConnect(RMySQL::MySQL(), dbname = "test") #' df <- data.frame(id = 1:5) #' #' dbWriteTable(con, "df", df) #' dbBegin(con) #' dbGetQuery(con, "UPDATE df SET id = id * 10") #' dbGetQuery(con, "SELECT id FROM df") #' dbRollback(con) #' #' dbGetQuery(con, "SELECT id FROM df") #' #' dbRemoveTable(con, "df") #' dbDisconnect(con) #' } #' @name transactions NULL #' @export #' @rdname transactions setMethod("dbCommit", "MySQLConnection", function(conn, ...) { dbGetQuery(conn, "COMMIT") TRUE }) #' @export #' @rdname transactions setMethod("dbBegin", "MySQLConnection", function(conn, ...) { dbGetQuery(conn, "START TRANSACTION") TRUE }) #' @export #' @rdname transactions setMethod("dbRollback", "MySQLConnection", function(conn, ...) { dbGetQuery(conn, "ROLLBACK") TRUE }) RMySQL/R/driver.R0000644000176200001440000001025214751652206013170 0ustar liggesusers#' @include mysql.R NULL #' Class MySQLDriver with constructor MySQL. #' #' An MySQL driver implementing the R database (DBI) API. #' This class should always be initialized with the \code{MySQL()} function. #' It returns a singleton that allows you to connect to MySQL. #' #' @export #' @aliases RMySQL-package RMySQL setClass("MySQLDriver", contains = "DBIDriver", slots = list(Id = "integer") ) #' @param max.con maximum number of connections that can be open #' at one time. There's no intrinic limit, since strictly speaking this limit #' applies to MySQL \emph{servers}, but clients can have (at least in theory) #' more than this. Typically there are at most a handful of open connections, #' thus the internal \code{RMySQL} code uses a very simple linear search #' algorithm to manage its connection table. #' @param fetch.default.rec number of records to fetch at one time from the #' database. (The \code{\link[DBI]{fetch}} method uses this number as a #' default.) #' @export #' @import methods DBI #' @importFrom utils packageVersion read.table write.table #' @useDynLib RMySQL #' @rdname MySQLDriver-class #' @examples #' if (mysqlHasDefault()) { #' # connect to a database and load some data #' con <- dbConnect(RMySQL::MySQL(), dbname = "test") #' dbWriteTable(con, "USArrests", datasets::USArrests, overwrite = TRUE) #' #' # query #' rs <- dbSendQuery(con, "SELECT * FROM USArrests") #' d1 <- dbFetch(rs, n = 10) # extract data in chunks of 10 rows #' dbHasCompleted(rs) #' d2 <- dbFetch(rs, n = -1) # extract all remaining data #' dbHasCompleted(rs) #' dbClearResult(rs) #' dbListTables(con) #' #' # clean up #' dbRemoveTable(con, "USArrests") #' dbDisconnect(con) #' } #' @useDynLib RMySQL rmysql_driver_init MySQL <- function(max.con=16, fetch.default.rec = 500) { if (fetch.default.rec <= 0) { stop("default num of records per fetch must be positive") } drvId <- .Call(rmysql_driver_init, max.con, fetch.default.rec) new("MySQLDriver", Id = drvId) } #' Unload MySQL driver. #' #' @param drv Object created by \code{\link{MySQL}}. #' @param ... Ignored. Needed for compatibility with generic. #' @return A logical indicating whether the operation succeeded or not. #' @export #' @useDynLib RMySQL rmysql_driver_close setMethod("dbUnloadDriver", "MySQLDriver", function(drv, ...) { if(!dbIsValid(drv)) return(TRUE) .Call(rmysql_driver_close) }) #' Get information about a MySQL driver. #' #' @param dbObj,object,drv Object created by \code{\link{MySQL}}. #' @param what Optional #' @param ... Ignored. Needed for compatibility with generic. #' @export #' @examples #' db <- RMySQL::MySQL() #' #' db #' dbGetInfo(db) #' dbListConnections(db) #' summary(db) #' @useDynLib RMySQL rmysql_driver_info setMethod("dbGetInfo", "MySQLDriver", function(dbObj, what="", ...) { checkValid(dbObj) info <- .Call(rmysql_driver_info) info$connectionIds <- lapply(info$connectionIds, function(conId) { new("MySQLConnection", Id = c(dbObj@Id, conId)) }) # Don't need to insert self into info info$managerId <- NULL if (!missing(what)) { info[what] } else { info } }) #' @rdname dbGetInfo-MySQLDriver-method #' @export setMethod("dbListConnections", "MySQLDriver", function(drv, ...) { dbGetInfo(drv, "connectionIds")[[1]] }) #' @rdname dbGetInfo-MySQLDriver-method #' @param verbose If \code{TRUE}, print extra info. #' @export setMethod("summary", "MySQLDriver", function(object, verbose = FALSE, ...) { info <- dbGetInfo(object) print(object) cat(" Max connections: ", info$length, "\n") cat(" Cur connections: ", info$`num_con`, "\n") cat(" Total connections:", info$counter, "\n") cat(" Default records per fetch:", info$`fetch_default_rec`, "\n") if (verbose) { cat(" DBI API version: ", as.character(packageVersion("DBI")), "\n") cat(" MySQL client version: ", info$clientVersion, "\n") cat("\nConnections:\n") lapply(info$connectionIds, function(x) print(summary(x))) } invisible(NULL) }) #' @rdname dbGetInfo-MySQLDriver-method #' @export setMethod("show", "MySQLDriver", function(object) { expired <- if(dbIsValid(object)) "" else "Expired " cat("<", expired, "MySQLDriver>\n", sep = "") invisible(NULL) }) RMySQL/R/result.R0000644000176200001440000001366214751652206013223 0ustar liggesusers#' Class MySQLResult #' #' MySQL's query results class. This classes encapsulates the result of an SQL #' statement (either \code{select} or not). #' #' @export #' @keywords internal setClass("MySQLResult", contains = "DBIResult", slots = list(Id = "integer") ) setAs("MySQLResult", "MySQLConnection", function(from) { new("MySQLConnection", Id = from@Id[1:2]) }) mysqlFetch <- function(res, n, ...) { rel <- .Call(RS_MySQL_fetch, res@Id, nrec = as.integer(n)) if (is.null(rel)) return(data.frame()) if (length(rel) > 0) { n <- length(rel[[1]]) } else { n <- 0 } attr(rel, "row.names") <- .set_row_names(n) class(rel) <- "data.frame" rel } #' Execute a SQL statement on a database connection. #' #' To retrieve results a chunk at a time, use \code{dbSendQuery}, #' \code{dbFetch}, then \code{dbClearResult}. Alternatively, if you want all the #' results (and they'll fit in memory) use \code{dbGetQuery} which sends, #' fetches and clears for you. #' #' \code{fetch()} will be deprecated in the near future; please use #' \code{dbFetch()} instead. #' #' @param conn an \code{\linkS4class{MySQLConnection}} object. #' @param res,dbObj A \code{\linkS4class{MySQLResult}} object. #' @param statement a character vector of length one specifying the SQL #' statement that should be executed. Only a single SQL statment should be #' provided. #' @param ... Unused. Needed for compatibility with generic. #' @export #' @examples #' if (mysqlHasDefault()) { #' con <- dbConnect(RMySQL::MySQL(), dbname = "test") #' dbWriteTable(con, "arrests", datasets::USArrests, overwrite = TRUE) #' #' # Run query to get results as dataframe #' dbGetQuery(con, "SELECT * FROM arrests limit 3") #' #' # Send query to pull requests in batches #' res <- dbSendQuery(con, "SELECT * FROM arrests") #' data <- dbFetch(res, n = 2) #' data #' dbHasCompleted(res) #' #' dbListResults(con) #' dbClearResult(res) #' dbRemoveTable(con, "arrests") #' dbDisconnect(con) #' } #' @rdname query #' @useDynLib RMySQL RS_MySQL_fetch setMethod("dbFetch", c("MySQLResult", "numeric"), mysqlFetch) #' @export #' @rdname query setMethod("fetch", c("MySQLResult", "numeric"), mysqlFetch) #' @param n maximum number of records to retrieve per fetch. Use \code{-1} to #' retrieve all pending records; use \code{0} for to fetch the default #' number of rows as defined in \code{\link{MySQL}} #' @rdname query #' @export setMethod("dbFetch", c("MySQLResult", "missing"), function(res, n, ...) { mysqlFetch(res, n = 0, ...) }) #' @rdname query #' @export setMethod("fetch", c("MySQLResult", "missing"), function(res, n, ...) { mysqlFetch(res, n = 0, ...) }) #' @rdname query #' @export #' @useDynLib RMySQL RS_MySQL_exec setMethod("dbSendQuery", c("MySQLConnection", "character"), function(conn, statement, ...) { checkValid(conn) rsId <- .Call(RS_MySQL_exec, conn@Id, as.character(statement)) new("MySQLResult", Id = rsId) } ) #' @rdname query #' @export #' @useDynLib RMySQL RS_MySQL_closeResultSet setMethod("dbClearResult", "MySQLResult", function(res, ...) { if (!dbIsValid(res)) return(TRUE) .Call(RS_MySQL_closeResultSet, res@Id) }) #' @rdname query #' @param what optional #' @export #' @useDynLib RMySQL RS_MySQL_resultSetInfo setMethod("dbGetInfo", "MySQLResult", function(dbObj, what = "", ...) { checkValid(dbObj) info <- .Call(RS_MySQL_resultSetInfo, dbObj@Id) if (!missing(what)) { info[what] } else { info } }) #' @rdname query #' @export setMethod("dbGetStatement", "MySQLResult", function(res, ...) { dbGetInfo(res)$statement }) #' @param name Table name. #' @rdname query #' @export #' @useDynLib RMySQL rmysql_fields_info setMethod("dbListFields", c("MySQLResult", "missing"), function(conn, name, ...) { .Call(rmysql_fields_info, conn@Id)$name }) #' Database interface meta-data. #' #' See documentation of generics for more details. #' #' @param res,conn,object An object of class \code{\linkS4class{MySQLResult}} #' @param ... Ignored. Needed for compatibility with generic #' @examples #' if (mysqlHasDefault()) { #' con <- dbConnect(RMySQL::MySQL(), dbname = "test") #' dbWriteTable(con, "t1", datasets::USArrests, overwrite = TRUE) #' #' rs <- dbSendQuery(con, "SELECT * FROM t1 WHERE UrbanPop >= 80") #' dbGetStatement(rs) #' dbHasCompleted(rs) #' #' dbGetInfo(rs) #' dbColumnInfo(rs) #' #' dbClearResult(rs) #' dbRemoveTable(con, "t1") #' dbDisconnect(con) #' } #' @name result-meta NULL #' @export #' @rdname result-meta setMethod("dbColumnInfo", "MySQLResult", function(res, ...) { as.data.frame(.Call(rmysql_fields_info, res@Id)) }) #' @export #' @rdname result-meta setMethod("dbGetRowsAffected", "MySQLResult", function(res, ...) { dbGetInfo(res)$rowsAffected }) #' @export #' @rdname result-meta setMethod("dbGetRowCount", "MySQLResult", function(res, ...) { dbGetInfo(res)$rowCount }) #' @export #' @rdname result-meta setMethod("dbHasCompleted", "MySQLResult", function(res, ...) { dbGetInfo(res)$completed == 1 }) #' @export #' @rdname result-meta #' @useDynLib RMySQL rmysql_exception_info setMethod("dbGetException", "MySQLResult", function(conn, ...) { .Call(rmysql_exception_info, conn@Id[1:2]) }) #' @export #' @param verbose If \code{TRUE}, print extra information. #' @rdname result-meta setMethod("summary", "MySQLResult", function(object, verbose = FALSE, ...) { checkValid(object) print(object) cat(" Statement:", dbGetStatement(object), "\n") cat(" Has completed?", if(dbHasCompleted(object)) "yes" else "no", "\n") cat(" Affected rows:", dbGetRowsAffected(object), "\n") cat(" Rows fetched:", dbGetRowCount(object), "\n") flds <- dbColumnInfo(object) if (verbose && !is.null(flds)) { cat(" Fields:\n") print(dbColumnInfo(object)) } invisible(NULL) }) #' @export #' @rdname result-meta setMethod("show", "MySQLResult", function(object) { expired <- if (dbIsValid(object)) "" else "Expired " cat("<", expired, "MySQLResult:", paste(object@Id, collapse = ","), ">\n", sep = "") invisible(NULL) }) RMySQL/R/escaping.R0000644000176200001440000001065614751652206013476 0ustar liggesusers#' @include connection.R NULL #' Make R/S-Plus identifiers into legal SQL identifiers #' #' These methods are straight-forward implementations of the corresponding #' generic functions. #' #' @param dbObj any MySQL object (e.g., \code{MySQLDriver}). #' @param snames a character vector of R/S-Plus #' identifiers (symbols) from which we need to make SQL identifiers. #' @param name a character vector of SQL identifiers we want to check against #' keywords from the DBMS. #' @param unique logical describing whether the resulting set of SQL names #' should be unique. Its default is \code{TRUE}. Following the SQL 92 #' standard, uniqueness of SQL identifiers is determined regardless of whether #' letters are upper or lower case. #' @param allow.keywords logical describing whether SQL keywords should be #' allowed in the resulting set of SQL names. Its default is \code{TRUE} #' @param keywords a character vector with SQL keywords, by default it is #' \code{.MySQLKeywords} define in \code{RMySQL}. This may be overriden by #' users. #' @param case a character string specifying whether to make the #' comparison as lower case, upper case, or any of the two. it defaults to #' \code{any}. #' @param ... Unused, needed for compatibility with generic. #' @export setMethod("make.db.names", c("MySQLConnection", "character"), function(dbObj, snames, keywords, unique, allow.keywords, ...) { make.db.names.default(snames, .MySQLKeywords, unique, allow.keywords) } ) #' @export #' @rdname make.db.names-MySQLConnection-character-method setMethod("SQLKeywords", "MySQLConnection", def = function(dbObj, ...) { .MySQLKeywords }) #' @export #' @rdname make.db.names-MySQLConnection-character-method setMethod("isSQLKeyword", c("MySQLConnection", "character"), function(dbObj, name, keywords = .MySQLKeywords, case, ...) { isSQLKeyword.default(name, keywords = .MySQLKeywords, case = case) } ) ## 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" ) RMySQL/R/is-valid.R0000644000176200001440000000301214751652206013401 0ustar liggesusers#' @include driver.R connection.R result.R NULL #' Check if a database object is valid. #' #' Support function that verifies that an object holding a reference to a #' foreign object is still valid for communicating with the RDBMS. #' \code{isIdCurrent} will be deprecated in the near future; please use #' the \code{\link[DBI]{dbIsValid}()} generic instead. #' #' \code{dbObjects} are R/S-Plus remote references to foreign objects. This #' introduces differences to the object's semantics such as persistence (e.g., #' connections may be closed unexpectedly), thus this function provides a #' minimal verification to ensure that the foreign object being referenced can #' be contacted. #' #' @param dbObj,obj A \code{MysqlDriver}, \code{MysqlConnection}, #' \code{MysqlResult}. #' @return a logical scalar. #' @export #' @examples #' dbIsValid(MySQL()) isIdCurrent <- function(obj) { dbIsValid(obj) } checkValid <- function(obj) { if (dbIsValid(obj)) return(TRUE) stop("Expired ", class(obj), call. = FALSE) } #' @export #' @rdname isIdCurrent #' @useDynLib RMySQL rmysql_driver_valid setMethod("dbIsValid", "MySQLDriver", function(dbObj) { .Call(rmysql_driver_valid) }) #' @export #' @rdname isIdCurrent #' @useDynLib RMySQL rmysql_connection_valid setMethod("dbIsValid", "MySQLConnection", function(dbObj) { .Call(rmysql_connection_valid, dbObj@Id) }) #' @export #' @rdname isIdCurrent #' @useDynLib RMySQL rmysql_result_valid setMethod("dbIsValid", "MySQLResult", function(dbObj) { .Call(rmysql_result_valid, dbObj@Id) }) RMySQL/R/mysql.R0000644000176200001440000000565514751652206013055 0ustar liggesusers## 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 #' #' @aliases .MySQLPkgName .MySQLPkgVersion .MySQLPkgRCS #' .MySQLSQLKeywords CLIENT_LONG_PASSWORD CLIENT_FOUND_ROWS CLIENT_LONG_FLAG #' CLIENT_CONNECT_WITH_DB CLIENT_NO_SCHEMA CLIENT_COMPRESS CLIENT_ODBC #' CLIENT_LOCAL_FILES CLIENT_IGNORE_SPACE CLIENT_PROTOCOL_41 CLIENT_INTERACTIVE #' CLIENT_SSL CLIENT_IGNORE_SIGPIPE CLIENT_TRANSACTIONS CLIENT_RESERVED #' CLIENT_SECURE_CONNECTION CLIENT_MULTI_STATEMENTS CLIENT_MULTI_RESULTS #' @section Constants: \code{.MySQLPkgName} (currently \code{"RMySQL"}), #' \code{.MySQLPkgVersion} (the R package version), \code{.MySQLPkgRCS} (the #' RCS revision), \code{.MySQLSQLKeywords} (a lot!) #' @name constants NULL ## The following client flags were copied from mysql_com.h (version 4.1.13) ## but it may not make sense to set some of this from RMySQL. #' @export CLIENT_LONG_PASSWORD <- 1 # new more secure passwords #' @export CLIENT_FOUND_ROWS <- 2 # Found instead of affected rows #' @export CLIENT_LONG_FLAG <- 4 # Get all column flags #' @export CLIENT_CONNECT_WITH_DB <- 8 # One can specify db on connect #' @export CLIENT_NO_SCHEMA <- 16 # Don't allow database.table.column #' @export CLIENT_COMPRESS <- 32 # Can use compression protocol #' @export CLIENT_ODBC <- 64 # Odbc client #' @export CLIENT_LOCAL_FILES <- 128 # Can use LOAD DATA LOCAL #' @export CLIENT_IGNORE_SPACE <- 256 # Ignore spaces before '(' #' @export CLIENT_PROTOCOL_41 <- 512 # New 4.1 protocol #' @export CLIENT_INTERACTIVE <- 1024 # This is an interactive client #' @export CLIENT_SSL <- 2048 # Switch to SSL after handshake #' @export CLIENT_IGNORE_SIGPIPE <- 4096 # IGNORE sigpipes #' @export CLIENT_TRANSACTIONS <- 8192 # Client knows about transactions #' @export CLIENT_RESERVED <- 16384 # Old flag for 4.1 protocol #' @export CLIENT_SECURE_CONNECTION <- 32768 # New 4.1 authentication #' @export CLIENT_MULTI_STATEMENTS <- 65536 # Enable/disable multi-stmt support #' @export CLIENT_MULTI_RESULTS <- 131072 # Enable/disable multi-results setOldClass("data.frame") ## to appease setMethod's signature warnings... setGeneric("summary") setGeneric("format") RMySQL/R/connection.R0000644000176200001440000001560414751652206014042 0ustar liggesusers#' @include driver.R mysql.R NULL #' Class MySQLConnection. #' #' \code{MySQLConnection.} objects are usually created by #' \code{\link[DBI]{dbConnect}} #' #' @export #' @keywords internal setClass("MySQLConnection", contains = "DBIConnection", slots = list(Id = "integer") ) #' Connect/disconnect to a MySQL DBMS #' #' These methods are straight-forward implementations of the corresponding #' generic functions. #' #' @param drv an object of class \code{MySQLDriver}, or the character string #' "MySQL" or an \code{MySQLConnection}. #' @param conn an \code{MySQLConnection} object as produced by \code{dbConnect}. #' @param username,password Username and password. If username omitted, #' defaults to the current user. If password is ommitted, only users #' without a password can log in. #' @param dbname string with the database name or NULL. If not NULL, the #' connection sets the default daabase to this value. #' @param host string identifying the host machine running the MySQL server or #' NULL. If NULL or the string \code{"localhost"}, a connection to the local #' host is assumed. #' @param unix.socket (optional) string of the unix socket or named pipe. #' @param port (optional) integer of the TCP/IP default port. #' @param client.flag (optional) integer setting various MySQL client flags. See #' the MySQL manual for details. #' @param groups string identifying a section in the \code{default.file} to use #' for setting authentication parameters (see \code{\link{MySQL}}). #' @param default.file string of the filename with MySQL client options. #' Defaults to \code{\$HOME/.my.cnf} #' @param ... Unused, needed for compatibility with generic. #' @export #' @examples #' \dontrun{ #' # Connect to a MySQL database running locally #' con <- dbConnect(RMySQL::MySQL(), dbname = "mydb") #' # Connect to a remote database with username and password #' con <- dbConnect(RMySQL::MySQL(), host = "mydb.mycompany.com", #' user = "abc", password = "def") #' # But instead of supplying the username and password in code, it's usually #' # better to set up a group in your .my.cnf (usually located in your home #' directory). Then it's less likely you'll inadvertently share them. #' con <- dbConnect(RMySQL::MySQL(), group = "test") #' #' # Always cleanup by disconnecting the database #' dbDisconnect(con) #' } #' #' # All examples use the rs-dbi group by default. #' if (mysqlHasDefault()) { #' con <- dbConnect(RMySQL::MySQL(), dbname = "test") #' summary(con) #' dbDisconnect(con) #' } #' @export #' @useDynLib RMySQL RS_MySQL_newConnection setMethod("dbConnect", "MySQLDriver", function(drv, dbname=NULL, username=NULL, password=NULL, host=NULL, unix.socket=NULL, port = 0, client.flag = 0, groups = 'rs-dbi', default.file = NULL, ...) { checkValid(drv) if (!is.null(dbname) && !is.character(dbname)) stop("Argument dbname must be a string or NULL") if (!is.null(username) && !is.character(username)) stop("Argument username must be a string or NULL") if (!is.null(password) && !is.character(password)) stop("Argument password must be a string or NULL") if (!is.null(host) && !is.character(host)) stop("Argument host must be a string or NULL") if (!is.null(unix.socket) && !is.character(unix.socket)) stop("Argument unix.socket must be a string or NULL") if (is.null(port) || !is.numeric(port)) stop("Argument port must be an integer value") if (is.null(client.flag) || !is.numeric(client.flag)) stop("Argument client.flag must be an integer value") if (!is.null(groups) && !is.character(groups)) stop("Argument groups must be a string or NULL") if(!is.null(default.file) && !is.character(default.file)) stop("Argument default.file must be a string") if(!is.null(default.file) && !file.exists(default.file[1])) stop(sprintf("mysql default file %s does not exist", default.file)) conId <- .Call(RS_MySQL_newConnection, drv@Id, dbname, username, password, host, unix.socket, as.integer(port), as.integer(client.flag), groups, default.file[1]) new("MySQLConnection", Id = conId) } ) #' @export #' @rdname dbConnect-MySQLDriver-method #' @useDynLib RMySQL RS_MySQL_cloneConnection setMethod("dbConnect", "MySQLConnection", function(drv, ...) { checkValid(drv) newId <- .Call(RS_MySQL_cloneConnection, drv@Id) new("MySQLConnection", Id = newId) }) #' @export #' @rdname dbConnect-MySQLDriver-method #' @useDynLib RMySQL RS_MySQL_closeConnection setMethod("dbDisconnect", "MySQLConnection", function(conn, ...) { if (!dbIsValid(conn)) return(TRUE) rs <- dbListResults(conn) if (length(rs) > 0) { warning("Closing open result sets", call. = FALSE) lapply(rs, dbClearResult) } .Call(RS_MySQL_closeConnection, conn@Id) }) #' Database interface meta-data #' #' @name db-meta #' @param conn,dbObj,object MySQLConnection object. #' @param ... Other arguments for compatibility with generic. #' @examples #' if (mysqlHasDefault()) { #' con <- dbConnect(RMySQL::MySQL(), dbname = "test") #' #' summary(con) #' #' dbGetInfo(con) #' dbListResults(con) #' dbListTables(con) #' #' dbDisconnect(con) #' } NULL #' @rdname db-meta #' @param what optional #' @export #' @useDynLib RMySQL RS_MySQL_connectionInfo setMethod("dbGetInfo", "MySQLConnection", function(dbObj, what="", ...) { checkValid(dbObj) info <- .Call(RS_MySQL_connectionInfo, dbObj@Id) info$rsId <- lapply(info$rsId, function(id) { new("MySQLResult", Id = c(dbObj@Id, id)) }) if (!missing(what)) { info[what] } else { info } }) #' @rdname db-meta #' @export setMethod("dbListResults", "MySQLConnection", def = function(conn, ...) dbGetInfo(conn)$rsId ) #' @rdname db-meta #' @param verbose If \code{TRUE}, add extra info. #' @export setMethod("summary", "MySQLConnection", function(object, verbose = FALSE, ...) { print(object) info <- dbGetInfo(object) 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(MySQL())$clientVersion, "\n") cat(" MySQL protocol version:", info$protocolVersion, "\n") cat(" MySQL server thread id:", info$threadId, "\n") } cat("\nResults:\n") lapply(info$rsId, function(x) print(summary(x))) invisible(NULL) } ) #' @rdname db-meta #' @export #' @useDynLib RMySQL rmysql_exception_info setMethod("dbGetException", "MySQLConnection", def = function(conn, ...) { checkValid(conn) .Call(rmysql_exception_info, conn@Id) } ) #' @rdname db-meta #' @export setMethod("show", "MySQLConnection", function(object) { expired <- if(dbIsValid(object)) "" else "Expired " cat("<", expired, "MySQLConnection:", paste(object@Id, collapse = ","), ">\n", sep = "") invisible(NULL) }) RMySQL/R/extension.R0000644000176200001440000003257014751652206013720 0ustar liggesusers#' @include mysql.R result.R NULL ## the following code was kindly provided ny J. T. Lindgren. #' @useDynLib RMySQL rmysql_escape_strings mysqlEscapeStrings <- function(con, strings) { checkValid(con) out <- .Call(rmysql_escape_strings, con@Id, as.character(strings)) names(out) <- names(strings) out } #' Escape SQL-special characters in strings. #' #' @param con a connection object (see \code{\link[DBI]{dbConnect}}). #' @param strings a character vector. #' @param ... any additional arguments to be passed to the dispatched method. #' @return A character vector with SQL special characters properly escaped. #' @export #' @examples #' if (mysqlHasDefault()) { #' con <- dbConnect(RMySQL::MySQL(), dbname = "test") #' #' tmp <- sprintf("SELECT * FROM emp WHERE lname = %s", "O'Reilly") #' dbEscapeStrings(con, tmp) #' #' dbDisconnect(con) #' } setGeneric("dbEscapeStrings", function(con, strings, ...) { standardGeneric("dbEscapeStrings") }) #' @rdname dbEscapeStrings #' @export setMethod("dbEscapeStrings", sig = signature(con = "MySQLConnection", strings = "character"), def = mysqlEscapeStrings, valueClass = "character" ) #' @rdname dbEscapeStrings #' @export setMethod("dbEscapeStrings", sig = signature(con = "MySQLResult", strings = "character"), def = function(con, strings, ...) mysqlEscapeStrings(as(con, "MySQLConnection"), strings), valueClass = "character" ) #' Apply R/S-Plus functions to remote groups of DBMS rows (experimental) #' #' Applies R/S-Plus functions to groups of remote DBMS rows without bringing an #' entire result set all at once. The result set is expected to be sorted by #' the grouping field. #' #' This function is meant to handle somewhat gracefully(?) large #' amounts of data from the DBMS by bringing into R manageable chunks (about #' \code{batchSize} records at a time, but not more than \code{maxBatch}); the #' idea is that the data from individual groups can be handled by R, but not #' all the groups at the same time. #' #' @export setGeneric("dbApply", function(res, ...) { standardGeneric("dbApply") }) #' The MySQL implementation allows us to register R #' functions that get invoked when certain fetching events occur. These include #' the ``begin'' event (no records have been yet fetched), ``begin.group'' (the #' record just fetched belongs to a new group), ``new record'' (every fetched #' record generates this event), ``group.end'' (the record just fetched was the #' last row of the current group), ``end'' (the very last record from the #' result set). Awk and perl programmers will find this paradigm very familiar #' (although SAP's ABAP language is closer to what we're doing). #' #' @param res a result set (see \code{\link[DBI]{dbSendQuery}}). #' @param INDEX a character or integer specifying the field name or field #' number that defines the various groups. #' @param FUN a function to be invoked upon identifying the last row from every #' group. This function will be passed a data frame holding the records of the #' current group, a character string with the group label, plus any other #' arguments passed to \code{dbApply} as \code{"..."}. #' @param begin a function of no arguments to be invoked just prior to retrieve #' the first row from the result set. #' @param end a function of no arguments to be invoked just after retrieving #' the last row from the result set. #' @param group.begin a function of one argument (the group label) to be #' invoked upon identifying a row from a new group #' @param new.record a function to be invoked as each individual record is #' fetched. The first argument to this function is a one-row data.frame #' holding the new record. #' @param batchSize the default number of rows to bring from the remote result #' set. If needed, this is automatically extended to hold groups bigger than #' \code{batchSize}. #' @param maxBatch the absolute maximum of rows per group that may be extracted #' from the result set. #' @param ... any additional arguments to be passed to \code{FUN}. #' @param simplify Not yet implemented #' @return A list with as many elements as there were groups in the result set. #' @export #' @rdname dbApply #' @examples #' if (mysqlHasDefault()) { #' con <- dbConnect(RMySQL::MySQL(), dbname = "test") #' #' dbWriteTable(con, "mtcars", mtcars, overwrite = TRUE) #' res <- dbSendQuery(con, "SELECT * FROM mtcars ORDER BY cyl") #' dbApply(res, "cyl", function(x, grp) quantile(x$mpg, names=FALSE)) #' #' dbClearResult(res) #' dbRemoveTable(con, "mtcars") #' dbDisconnect(con) #' } #' @useDynLib RMySQL RS_MySQL_dbApply setMethod("dbApply", "MySQLResult", function(res, INDEX, FUN = stop("must specify FUN"), begin = NULL, group.begin = NULL, new.record = NULL, end = NULL, batchSize = 100, maxBatch = 1e6, ..., simplify = TRUE) ## 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) 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 = res@Id, INDEX = as.integer(INDEX-1), funs, rho, as.integer(batchSize), as.integer(maxBatch)) if(!is.null(end) && dbHasCompleted(res)) end() out } ) #' Fetch next result set from an SQL script or stored procedure (experimental) #' #' SQL scripts (i.e., multiple SQL statements separated by ';') and stored #' procedures oftentimes generate multiple result sets. These generic #' functions provide a means to process them sequentially. \code{dbNextResult} #' fetches the next result from the sequence of pending results sets; #' \code{dbMoreResults} returns a logical to indicate whether there are #' additional results to process. #' #' @param con a connection object (see \code{\link[DBI]{dbConnect}}). #' @param ... any additional arguments to be passed to the dispatched method #' @return #' \code{dbNextResult} returns a result set or \code{NULL}. #' #' \code{dbMoreResults} returns a logical specifying whether or not there are #' additional result sets to process in the connection. #' @export #' @examples #' if (mysqlHasDefault()) { #' con <- dbConnect(RMySQL::MySQL(), dbname = "test", client.flag = CLIENT_MULTI_STATEMENTS) #' dbWriteTable(con, "mtcars", datasets::mtcars, overwrite = TRUE) #' #' sql <- "SELECT cyl FROM mtcars LIMIT 5; SELECT vs FROM mtcars LIMIT 5" #' rs1 <- dbSendQuery(con, sql) #' dbFetch(rs1, n = -1) #' #' if (dbMoreResults(con)) { #' rs2 <- dbNextResult(con) #' dbFetch(rs2, n = -1) #' } #' #' dbClearResult(rs1) #' dbClearResult(rs2) #' dbRemoveTable(con, "mtcars") #' dbDisconnect(con) #' } setGeneric("dbNextResult", function(con, ...) { standardGeneric("dbNextResult") }) #' @export #' @rdname dbNextResult #' @useDynLib RMySQL RS_MySQL_nextResultSet setMethod("dbNextResult", "MySQLConnection", function(con, ...) { for(rs in dbListResults(con)){ dbClearResult(rs) } id = .Call(RS_MySQL_nextResultSet, con@Id) new("MySQLResult", Id = id) } ) #' @export #' @rdname dbNextResult setGeneric("dbMoreResults", function(con, ...) { standardGeneric("dbMoreResults") }) #' @export #' @rdname dbNextResult #' @useDynLib RMySQL RS_MySQL_moreResultSets setMethod("dbMoreResults", "MySQLConnection", function(con, ...) { .Call(RS_MySQL_moreResultSets, con@Id) }) #' Build the SQL CREATE TABLE definition as a string #' #' The output SQL statement is a simple \code{CREATE TABLE} with suitable for #' \code{dbGetQuery} #' #' @param dbObj any DBI object (used only to dispatch according to the engine #' (e.g., MySQL, Oracle, PostgreSQL, SQLite) #' @param name name of the new SQL table #' @param obj an R object coerceable to data.frame for which we want to create #' a table #' @param field.types optional named list of the types for each field in #' \code{obj} #' @param row.names logical, should row.name of \code{value} be exported as a #' \code{row\_names} field? Default is TRUE #' @param \dots reserved for future use #' @return An SQL string #' @export #' @keywords internal mysqlBuildTableDefinition <- function(dbObj, name, obj, field.types = NULL, row.names = TRUE, ...) { if (!is.data.frame(obj)) { obj <- as.data.frame(obj) } value <- explict_rownames(obj, row.names) if (is.null(field.types)) { field.types <- vapply(value, dbDataType, dbObj = dbObj, FUN.VALUE = character(1)) } # Escape field names names(field.types) <- dbQuoteIdentifier(dbObj, names(field.types)) flds <- paste(names(field.types), field.types) paste("CREATE TABLE", name, "\n(", paste(flds, collapse = ",\n\t"), "\n)") } ## Escape problematic characters in the data frame. ## These are: - tab, as this is the field separator ## - newline, as this is the record separator ## - backslash, the escaping character ## Obviously, not all data types can contain these, e.g. numeric types ## can not. So we only substitute character and factor types. ## (FIXME: is there anything else?) escape <- function(table) { table <- as.data.frame(table) repcols <- which(sapply(table, is.character) | sapply(table, is.factor)) for (rc in repcols) { table[,rc] <- gsub("\\\\", "\\\\\\\\", table[,rc]) table[,rc] <- gsub("\\n", "\\\\n", table[,rc]) table[,rc] <- gsub("\\t", "\\\\t", table[,rc]) } table } ## safe.write makes sure write.table doesn't exceed available memory by batching ## at most batch rows (but it is still slowww) safe.write <- function(value, file, batch, ...) { 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) conb <- file(file,open="wb") while(from<=N){ write.table(escape(value[from:to,, drop=FALSE]), file = conb, append = TRUE, quote = FALSE, sep="\t", na = "\\N", row.names=FALSE, col.names=FALSE, eol = '\n', ...) from <- to+1 to <- min(to+batch, N) } close(conb) invisible(NULL) } #' MySQL Check for Compiled Versus Loaded Client Library Versions #' #' This function prints out the compiled and loaded client library versions. #' #' @return A named integer vector of length two, the first element representing #' the compiled library version and the second element representint the loaded #' client library version. #' @export #' @examples #' mysqlClientLibraryVersions() #' @useDynLib RMySQL rmysql_version mysqlClientLibraryVersions <- function() { .Call(rmysql_version) } #' Quote method for MySQL identifiers #' #' In MySQL, identifiers are enclosed in backticks, e.g. \code{`x`}. #' #' @export #' @keywords internal setMethod("dbQuoteIdentifier", c("MySQLConnection", "character"), function(conn, x, ...) { x <- gsub('`', '``', x, fixed = TRUE) SQL(paste('`', x, '`', sep = "")) } ) #' Quote method for MySQL strings #' #' In MySQL, strings are enclosed in single quotes, e.g. \code{'x'}. #' #' @export #' @keywords internal setMethod("dbQuoteString", c("MySQLConnection", "character"), function(conn, x, ...) { ret <- paste("'", dbEscapeStrings(conn, x), "'", sep = "") ret[is.na(x)] <- "NULL" SQL(ret) } ) #' @export #' @keywords internal setMethod("dbQuoteString", c("MySQLConnection", "SQL"), function(conn, x, ...) { x } ) RMySQL/cleanup0000755000176200001440000000005314751663331012725 0ustar liggesusers#!/bin/sh rm -f src/Makevars configure.log RMySQL/src/0000755000176200001440000000000014751657102012140 5ustar liggesusersRMySQL/src/utils.c0000644000176200001440000001523314751662343013453 0ustar liggesusers#include "RS-MySQL.h" // Turn a list in to a data frame, in place void make_data_frame(SEXP data) { int n = length(VECTOR_ELT(data, 0)); SEXP rownames = PROTECT(allocVector(REALSXP, 2)); REAL(rownames)[0] = NA_REAL; REAL(rownames)[1] = -n; setAttrib(data, R_RowNamesSymbol, rownames); setAttrib(data, R_ClassSymbol, mkString("data.frame")); UNPROTECT(1); return; } void RS_DBI_allocOutput(SEXP output, RMySQLFields* flds, int num_rec, int expand) { SEXP names, s_tmp; int j; int num_fields; SEXPTYPE *fld_Sclass; PROTECT(output); num_fields = flds->num_fields; if(expand){ for(j = 0; j < (int) num_fields; j++){ /* Note that in R-1.2.3 (at least) we need to protect SET_LENGTH */ s_tmp = LST_EL(output,j); PROTECT(SET_LENGTH(s_tmp, num_rec)); SET_ELEMENT(output, j, s_tmp); UNPROTECT(1); } UNPROTECT(1); return; } fld_Sclass = flds->Sclass; for(j = 0; j < (int) num_fields; j++){ switch((int)fld_Sclass[j]){ case LGLSXP: SET_ELEMENT(output, j, NEW_LOGICAL(num_rec)); break; case STRSXP: SET_ELEMENT(output, j, NEW_CHARACTER(num_rec)); break; case INTSXP: SET_ELEMENT(output, j, NEW_INTEGER(num_rec)); break; case REALSXP: SET_ELEMENT(output, j, NEW_NUMERIC(num_rec)); break; case VECSXP: SET_ELEMENT(output, j, NEW_LIST(num_rec)); break; default: error("unsupported data type"); } } PROTECT(names = NEW_CHARACTER((int) num_fields)); for(j = 0; j< (int) num_fields; j++){ SET_CHR_EL(names,j, mkChar(flds->name[j])); } SET_NAMES(output, names); UNPROTECT(2); return; } /* wrapper to strcpy */ char* RS_DBI_copyString(const char *str) { char *buffer; buffer = (char *) malloc((size_t) strlen(str)+1); if(!buffer) error("internal error in RS_DBI_copyString: could not alloc string space"); return strcpy(buffer, str); } /* wrapper to strncpy, plus (optionally) deleting trailing spaces */ SEXP RS_DBI_createNamedList(char **names, SEXPTYPE *types, int *lengths, int n) { SEXP output, output_names, obj = R_NilValue; int num_elem; int j; PROTECT(output = NEW_LIST(n)); PROTECT(output_names = NEW_CHARACTER(n)); for(j = 0; j < n; j++){ num_elem = lengths[j]; switch((int)types[j]){ case LGLSXP: PROTECT(obj = NEW_LOGICAL(num_elem)); break; case INTSXP: PROTECT(obj = NEW_INTEGER(num_elem)); break; case REALSXP: PROTECT(obj = NEW_NUMERIC(num_elem)); break; case STRSXP: PROTECT(obj = NEW_CHARACTER(num_elem)); break; case VECSXP: PROTECT(obj = NEW_LIST(num_elem)); break; default: error("unsupported data type"); } SET_ELEMENT(output, (int)j, obj); SET_CHR_EL(output_names, j, mkChar(names[j])); UNPROTECT(1); } SET_NAMES(output, output_names); UNPROTECT(2); return(output); } /* Very simple objectId (mapping) table. newEntry() returns an index * to an empty cell in table, and lookup() returns the position in the * table of obj_id. Notice that we decided not to touch the entries * themselves to give total control to the invoking functions (this * simplify error management in the invoking routines.) */ int RS_DBI_newEntry(int *table, int length) { int i, indx, empty_val; indx = empty_val = (int) -1; for(i = 0; i < length; i++){ if(table[i] == empty_val){ indx = i; break; } } return indx; } int RS_DBI_lookup(int *table, int length, int obj_id) { int i, indx; indx = (int) -1; for(i = 0; i < length; ++i){ if(table[i]==obj_id){ indx = i; break; } } return indx; } /* return a list of entries pointed by *entries (we allocate the space, * but the caller should free() it). The function returns the number * of entries. */ int RS_DBI_listEntries(int *table, int length, int *entries) { int i,n; for(i=n=0; idrvConnection; int n = length(strings); SEXP output = PROTECT(allocVector(STRSXP, n)); long size = 100; char* escaped = S_alloc(size, sizeof(escaped)); for(int i = 0; i < n; i++){ const char* string = CHAR(STRING_ELT(strings, i)); size_t len = strlen(string); if (size <= 2 * len + 1) { escaped = S_realloc(escaped, (2 * len + 1), size, sizeof(escaped)); size = 2 * len + 1; } if (escaped == NULL) { UNPROTECT(1); error("Could not allocate memory to escape string"); } mysql_real_escape_string(con, escaped, string, len); SET_STRING_ELT(output, i, mkChar(escaped)); } UNPROTECT(1); return output; } SEXP rmysql_version(void) { SEXP output = PROTECT(allocVector(INTSXP, 2)); SEXP output_nms = PROTECT(allocVector(STRSXP, 2)); SET_NAMES(output, output_nms); UNPROTECT(1); #ifdef MARIADB_BASE_VERSION SET_STRING_ELT(output_nms, 0, mkChar(MARIADB_BASE_VERSION)); #else SET_STRING_ELT(output_nms, 0, mkChar(MYSQL_SERVER_VERSION)); #endif INTEGER(output)[0] = MYSQL_VERSION_ID; SET_STRING_ELT(output_nms, 1, mkChar(mysql_get_client_info())); INTEGER(output)[1] = mysql_get_client_version(); UNPROTECT(1); return output; } RMySQL/src/fields.c0000644000176200001440000002005614751652206013555 0ustar liggesusers#include "RS-MySQL.h" void rmysql_fields_free(RMySQLFields* flds) { int i; if (flds->name) { for(i = 0; i < flds->num_fields; i++) { if (flds->name[i]) free(flds->name[i]); } free(flds->name); } if(flds->type) free(flds->type); if(flds->length) free(flds->length); if(flds->precision) free(flds->precision); if(flds->scale) free(flds->scale); if(flds->nullOk) free(flds->nullOk); if(flds->isVarLength) free(flds->isVarLength); if(flds->Sclass) free(flds->Sclass); free(flds); flds = NULL; return; } RMySQLFields* RS_MySQL_createDataMappings(SEXP rsHandle) { // Fetch MySQL field descriptions RS_DBI_resultSet* result = RS_DBI_getResultSet(rsHandle); MYSQL_RES* my_result = result->drvResultSet; MYSQL_FIELD* select_dp = mysql_fetch_fields(my_result); int num_fields = mysql_num_fields(my_result); // Allocate memory for output object RMySQLFields* flds = malloc(sizeof(RMySQLFields)); if (!flds) { error("Could not allocate memory for database fields"); } flds->num_fields = num_fields; flds->name = calloc(num_fields, sizeof(char *)); flds->type = calloc(num_fields, sizeof(int)); flds->length = calloc(num_fields, sizeof(int)); flds->precision = calloc(num_fields, sizeof(int)); flds->scale = calloc(num_fields, sizeof(int)); flds->nullOk = calloc(num_fields, sizeof(int)); flds->isVarLength = calloc(num_fields, sizeof(int)); flds->Sclass = calloc(num_fields, sizeof(SEXPTYPE)); /* WARNING: TEXT fields are represented as BLOBS (sic), * not VARCHAR or some kind of string type. More troublesome is the * fact that a TEXT fields can be BINARY to indicate case-sensitivity. * The bottom line is that MySQL has a serious deficiency re: text * types (IMHO). A binary object (in SQL92, X/SQL at least) can * store all kinds of non-ASCII, non-printable stuff that can * potentially screw up S and R CHARACTER_TYPE. We are on thin ice. * * I'm aware that I'm introducing a potential bug here by following * the MySQL convention of treating BLOB's as TEXT (I'm symplifying * in order to properly handle commonly-found TEXT fields, at the * risk of core dumping when bona fide Binary objects are being * retrieved. * * Possible workaround: if strlen() of the field equals the * MYSQL_FIELD->length for all rows, then we are probably(?) safe * in considering TEXT a character type (non-binary). */ for (int j = 0; j < num_fields; j++){ /* First, save the name, MySQL internal field name, type, length, etc. */ flds->name[j] = RS_DBI_copyString(select_dp[j].name); flds->type[j] = select_dp[j].type; /* recall that these are enum*/ flds->length[j] = select_dp[j].length; flds->precision[j] = select_dp[j].length; flds->scale[j] = select_dp[j].decimals; flds->nullOk[j] = (!IS_NOT_NULL(select_dp[j].flags)); int internal_type = select_dp[j].type; switch(internal_type) { case FIELD_TYPE_VAR_STRING: case FIELD_TYPE_STRING: flds->Sclass[j] = STRSXP; flds->isVarLength[j] = (int) 1; break; case FIELD_TYPE_TINY: /* 1-byte TINYINT */ case FIELD_TYPE_SHORT: /* 2-byte SMALLINT */ case FIELD_TYPE_INT24: /* 3-byte MEDIUMINT */ flds->Sclass[j] = INTSXP; case FIELD_TYPE_LONG: /* 4-byte INTEGER */ /* if unsigned, turn into numeric (may be too large for ints/long)*/ if(select_dp[j].flags & UNSIGNED_FLAG) { warning("Unsigned INTEGER in col %d imported as numeric", j); flds->Sclass[j] = REALSXP; } else { flds->Sclass[j] = INTSXP; } break; case FIELD_TYPE_LONGLONG: /* 8-byte BIGINT */ flds->Sclass[j] = REALSXP; break; #if defined(MYSQL_VERSION_ID) && MYSQL_VERSION_ID >= 50003 /* 5.0.3 */ case FIELD_TYPE_BIT: if(flds->precision[j] <= sizeof(int)) { /* can R int hold the bytes? */ flds->Sclass[j] = INTSXP; } else { flds->Sclass[j] = STRSXP; warning( "BIT field in column %d too long (%d bits) for an R integer (imported as character)", j+1, flds->precision[j] ); } break; #endif flds->Sclass[j] = REALSXP; break; case FIELD_TYPE_DECIMAL: #if defined(MYSQL_VERSION_ID) && MYSQL_VERSION_ID >= 50003 /* 5.0.3 */ case FIELD_TYPE_NEWDECIMAL: #endif warning("Decimal MySQL column %d imported as numeric", j); flds->Sclass[j] = REALSXP; break; case FIELD_TYPE_FLOAT: case FIELD_TYPE_DOUBLE: flds->Sclass[j] = REALSXP; break; case FIELD_TYPE_BLOB: /* TODO: how should we bring large ones*/ case FIELD_TYPE_TINY_BLOB: case FIELD_TYPE_MEDIUM_BLOB: case FIELD_TYPE_LONG_BLOB: flds->Sclass[j] = STRSXP; /* Grr! Hate this! */ flds->isVarLength[j] = (int) 1; break; case FIELD_TYPE_DATE: case FIELD_TYPE_TIME: case FIELD_TYPE_DATETIME: case FIELD_TYPE_YEAR: case FIELD_TYPE_NEWDATE: flds->Sclass[j] = STRSXP; flds->isVarLength[j] = (int) 1; break; case FIELD_TYPE_ENUM: flds->Sclass[j] = STRSXP; /* see the MySQL ref. manual */ flds->isVarLength[j] = (int) 1; break; case FIELD_TYPE_SET: flds->Sclass[j] = STRSXP; flds->isVarLength[j] = (int) 0; break; default: flds->Sclass[j] = STRSXP; flds->isVarLength[j] = (int) 1; warning("unrecognized MySQL field type %d in column %d imported as character", internal_type, j); break; } } return flds; } struct data_types { char *typeName; int typeId; }; struct data_types rmysql_types[] = { { "DECIMAL", FIELD_TYPE_DECIMAL}, { "TINYINT", FIELD_TYPE_TINY}, { "SMALLINT", FIELD_TYPE_SHORT}, { "INTEGER", FIELD_TYPE_LONG}, { "MEDIUMINT", FIELD_TYPE_INT24}, { "BIGINT", FIELD_TYPE_LONGLONG}, { "FLOAT", FIELD_TYPE_FLOAT}, { "DOUBLE", FIELD_TYPE_DOUBLE}, { "NULL", FIELD_TYPE_NULL}, { "TIMESTAMP", FIELD_TYPE_TIMESTAMP}, { "DATE", FIELD_TYPE_DATE}, { "TIME", FIELD_TYPE_TIME}, { "DATETIME", FIELD_TYPE_DATETIME}, { "YEAR", FIELD_TYPE_YEAR}, { "ENUM", FIELD_TYPE_ENUM}, { "SET", FIELD_TYPE_SET}, { "BLOB/TEXT", FIELD_TYPE_BLOB}, { "VAR_STRING", FIELD_TYPE_VAR_STRING}, { "STRING", FIELD_TYPE_STRING}, { NULL, -1 } }; char* rmysql_type(int type) { for (int i = 0; rmysql_types[i].typeName != NULL; i++) { if (rmysql_types[i].typeId == type) return rmysql_types[i].typeName; } return ""; } SEXP rmysql_fields_info(SEXP rsHandle) { RS_DBI_resultSet* result = RS_DBI_getResultSet(rsHandle); RMySQLFields* flds = result->fields; int n = flds->num_fields; // Allocate output SEXP output = PROTECT(allocVector(VECSXP, 4)); SEXP output_nms = PROTECT(allocVector(STRSXP, 4)); SET_NAMES(output, output_nms); UNPROTECT(1); SET_STRING_ELT(output_nms, 0, mkChar("name")); SEXP names = PROTECT(allocVector(STRSXP, n)); for (int j = 0; j < n; j++) { SET_STRING_ELT(names, j, mkChar(flds->name[j])); } SET_VECTOR_ELT(output, 0, names); UNPROTECT(1); SET_STRING_ELT(output_nms, 1, mkChar("Sclass")); SEXP sclass = PROTECT(allocVector(STRSXP, n)); for (int j = 0; j < n; j++) { const char* type = type2char(flds->Sclass[j]); SET_STRING_ELT(sclass, j, mkChar(type)); } SET_VECTOR_ELT(output, 1, sclass); UNPROTECT(1); SET_STRING_ELT(output_nms, 2, mkChar("type")); SEXP types = PROTECT(allocVector(STRSXP, n)); for (int j = 0; j < n; j++) { char* type = rmysql_type(flds->type[j]); SET_STRING_ELT(types, j, mkChar(type)); } SET_VECTOR_ELT(output, 2, types); UNPROTECT(1); SET_STRING_ELT(output_nms, 3, mkChar("length")); SEXP lens = PROTECT(allocVector(INTSXP, n)); for (int j = 0; j < n; j++) { INTEGER(lens)[j] = flds->length[j]; } SET_VECTOR_ELT(output, 3, lens); UNPROTECT(1); UNPROTECT(1); return output; } RMySQL/src/RS-MySQL.h0000644000176200001440000001477314751652206013614 0ustar liggesusers#ifndef _RS_MYSQL_H #define _RS_MYSQL_H 1 // 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 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 #ifdef _cplusplus extern "C" { #endif #include "S4R.h" #include #include #if MYSQL_VERSION_ID >= 80000 && MYSQL_VERSION_ID < 100000 #define my_bool bool #endif // Objects ===================================================================== typedef struct RMySQLFields { int num_fields; char **name; // DBMS field names int *type; // DBMS internal types int *length; // DBMS lengths in bytes int *precision; // DBMS num of digits for numeric types int *scale; // DBMS num of decimals for numeric types int *nullOk; // DBMS indicator for DBMS' NULL type int *isVarLength; // DBMS variable-length char type SEXPTYPE *Sclass; // R/S class (type) -- may be overriden } RMySQLFields; typedef struct st_sdbi_resultset { void *drvResultSet; // the actual (driver's) cursor/result set int managerId; // the 3 *Id's are used for int connectionId; // validating stuff coming from S int resultSetId; int isSelect; // boolean for testing SELECTs char *statement; // SQL statement int rowsAffected; // used by non-SELECT statements int rowCount; // rows fetched so far (SELECT-types) int completed; // have we fetched all rows? RMySQLFields* fields; } RS_DBI_resultSet; typedef struct st_sdbi_connection { void *conParams; // pointer to connection params (host, user, etc) void *drvConnection; // pointer to the actual DBMS connection struct RS_DBI_resultSet **resultSets; // vector to result set ptrs int *resultSetIds; int length; // max num of concurrent resultSets int num_res; // num of open resultSets int counter; // total number of queries int managerId; int connectionId; } RS_DBI_connection; typedef struct st_sdbi_conParams { char *dbname; char *username; char *password; char *host; char *unix_socket; unsigned int port; unsigned int client_flag; char *groups; char *default_file; } RS_MySQL_conParams; // dbManager typedef struct MySQLDriver { RS_DBI_connection **connections; // list of dbConnections int *connectionIds; // array of connectionIds int length; // max num of concurrent connections int num_con; // num of opened connections int counter; // num of connections handled so far int fetch_default_rec; // default num of records per fetch int managerId; // typically, process id } MySQLDriver; // Functions =================================================================== #define MGR_ID(handle) INTEGER(handle)[0] #define CON_ID(handle) INTEGER(handle)[1] #define RES_ID(handle) INTEGER(handle)[2] // Driver ---------------------------------------------------------------------- MySQLDriver* rmysql_driver(void); SEXP rmysql_driver_init(SEXP max_con_, SEXP fetch_default_rec_); SEXP rmysql_driver_info(void); SEXP rmysql_exception_info(SEXP conHandle); // Connection ------------------------------------------------------------------ SEXP RS_DBI_allocConnection(SEXP mgrHandle, int max_res); void RS_DBI_freeConnection(SEXP conHandle); RS_DBI_connection *RS_DBI_getConnection(SEXP handle); SEXP RS_DBI_asConHandle(int mgrId, int conId); SEXP RS_DBI_connectionInfo(SEXP con_Handle); SEXP RS_MySQL_newConnection(SEXP mgrHandle, SEXP s_dbname, SEXP s_username, SEXP s_password, SEXP s_myhost, SEXP s_unix_socket, SEXP s_port, SEXP s_client_flag, SEXP s_groups, SEXP s_default_file); SEXP RS_MySQL_createConnection(SEXP mgrHandle, RS_MySQL_conParams *conParams); SEXP RS_MySQL_cloneConnection(SEXP conHandle); SEXP RS_MySQL_closeConnection(SEXP conHandle); SEXP RS_MySQL_connectionInfo(SEXP conHandle); RS_MySQL_conParams* RS_MySQL_allocConParams(void); RS_MySQL_conParams* RS_MySQL_cloneConParams(RS_MySQL_conParams *conParams); void RS_MySQL_freeConParams(RS_MySQL_conParams *conParams); // Result set ------------------------------------------------------------------ SEXP RS_DBI_allocResultSet(SEXP conHandle); void RS_DBI_freeResultSet(SEXP rsHandle); RS_DBI_resultSet* RS_DBI_getResultSet(SEXP rsHandle); SEXP RS_DBI_asResHandle(int pid, int conId, int resId); SEXP RS_DBI_resultSetInfo(SEXP rsHandle); SEXP RS_MySQL_exec(SEXP conHandle, SEXP statement); SEXP RS_MySQL_fetch(SEXP rsHandle, SEXP max_rec); SEXP RS_MySQL_closeResultSet(SEXP rsHandle); SEXP RS_MySQL_nextResultSet(SEXP conHandle); SEXP RS_MySQL_moreResultSets(SEXP conHandle); SEXP RS_MySQL_resultSetInfo(SEXP rsHandle); // Fields ---------------------------------------------------------------------- void rmysql_fields_free(RMySQLFields* flds); void RS_DBI_allocOutput(SEXP output, RMySQLFields* flds, int num_rec, int expand); void make_data_frame(SEXP data); SEXP RS_DBI_copyFields(RMySQLFields* flds); RMySQLFields* RS_MySQL_createDataMappings(SEXP resHandle); // Utilities ------------------------------------------------------------------- char *RS_DBI_copyString(const char* str); SEXP RS_DBI_createNamedList(char** names, SEXPTYPE* types, int* lengths, int n); void RS_na_set(void* ptr, SEXPTYPE type); int RS_is_na(void* ptr, SEXPTYPE type); SEXP rmysql_escape_strings(SEXP conHandle, SEXP statement); // Object database ------------------------------------------------------------- // Simple object database used for storing all connections for a driver, // and all result sets for a connection. int RS_DBI_newEntry(int* table, int length); int RS_DBI_lookup(int* table, int length, int obj_id); int RS_DBI_listEntries(int* table, int length, int* entries); void RS_DBI_freeEntry(int* table, int indx); #ifdef _cplusplus } #endif #endif // _RS_MYSQL_H RMySQL/src/Makevars.win0000644000176200001440000000142214751657102014427 0ustar liggesusersPKG_CONFIG_NAME = libmariadbclient PKG_CONFIG ?= $(BINPREF)pkg-config PKG_LIBS := $(shell $(PKG_CONFIG) --libs $(PKG_CONFIG_NAME)) # Remove hack when dropping support for R-4.1 ifeq ($(R_COMPILED_BY),gcc 8.3.0) RTOOLS40_LIBS = -lssl -lcrypto endif ifneq ($(PKG_LIBS),) $(info using $(PKG_CONFIG_NAME) from Rtools) PKG_CPPFLAGS := $(shell $(PKG_CONFIG) --cflags $(PKG_CONFIG_NAME)) else RWINLIB = ../windows/libmariadbclient PKG_CPPFLAGS = -I$(RWINLIB)/include/mariadb PKG_LIBS = -L$(RWINLIB)/lib$(R_ARCH) -L$(RWINLIB)/lib \ -lmariadbclient $(RTOOLS40_LIBS) -lz -lbcrypt -lsecur32 -lshlwapi -lcrypt32 -lgdi32 -lws2_32 -pthread endif all: $(SHLIB) $(OBJECTS): $(RWINLIB) $(RWINLIB): "${R_HOME}/bin${R_ARCH_BIN}/Rscript.exe" "../tools/winlibs.R" clean: rm -f $(SHLIB) $(OBJECTS) RMySQL/src/connection.c0000644000176200001440000003146014751652206014447 0ustar liggesusers#include "RS-MySQL.h" /* RS_MySQL_createConnection - internal function * * Used by both RS_MySQL_newConnection and RS_MySQL_cloneConnection. * It is responsible for the memory associated with conParams. */ SEXP RS_MySQL_createConnection(SEXP mgrHandle, RS_MySQL_conParams *conParams) { RS_DBI_connection *con; SEXP conHandle; MYSQL *my_connection; /* Initialize MySQL connection */ my_connection = mysql_init(NULL); // Always enable INFILE option, since needed for dbWriteTable mysql_options(my_connection, MYSQL_OPT_LOCAL_INFILE, 0); /* Load MySQL default connection values from a group. * * MySQL will combine the options found in the '[client]' group and one more group * specified by MYSQL_READ_DEFAULT_GROUP. Typically, this will * be '[rs-dbi]' but the user can override with another group. Note that * while our interface will allow a user to pass in a vector of groups, * only the first group in the vector will be combined with '[client]'. * * Should we make this an error in a later release?) */ if (conParams->groups) mysql_options(my_connection, MYSQL_READ_DEFAULT_GROUP, conParams->groups); /* MySQL reads defaults from my.cnf or equivalent, but the user can supply * an alternative. */ if(conParams->default_file) mysql_options(my_connection, MYSQL_READ_DEFAULT_FILE, conParams->default_file); if(!mysql_real_connect(my_connection, conParams->host, conParams->username, conParams->password, conParams->dbname, conParams->port, conParams->unix_socket, conParams->client_flag)){ RS_MySQL_freeConParams(conParams); error( "Failed to connect to database: Error: %s\n", mysql_error(my_connection) ); } /* MySQL connections can only have 1 result set open at a time */ conHandle = RS_DBI_allocConnection(mgrHandle, (int) 1); con = RS_DBI_getConnection(conHandle); if(!con){ mysql_close(my_connection); RS_MySQL_freeConParams(conParams); error("could not alloc space for connection object"); } con->conParams = (void *) conParams; con->drvConnection = (void *) my_connection; return conHandle; } SEXP RS_DBI_allocConnection(SEXP mgrHandle, int max_res) { MySQLDriver* mgr = rmysql_driver(); int indx = RS_DBI_newEntry(mgr->connectionIds, mgr->length); if (indx < 0) { error( "Cannot allocate a new connection: %d connections already opened", mgr->length ); } RS_DBI_connection* con = malloc(sizeof(RS_DBI_connection)); if (!con){ error("Could not allocate memory for connection"); } int con_id = mgr->counter; con->connectionId = con_id; con->drvConnection = (void *) NULL; con->conParams = (void *) NULL; con->counter = (int) 0; con->length = max_res; /* length of resultSet vector */ /* result sets for this connection */ con->resultSets = calloc(max_res, sizeof(RS_DBI_resultSet)); if (!con->resultSets) { error("Could not allocate memory for result sets"); } con->num_res = (int) 0; con->resultSetIds = (int *) calloc((size_t) max_res, sizeof(int)); if (!con->resultSetIds) { error("Could not allocate memory for result set ids"); } for(int i = 0; i < max_res; i++){ con->resultSets[i] = (RS_DBI_resultSet *) NULL; con->resultSetIds[i] = -1; } /* Finally, update connection table in mgr */ mgr->num_con += 1; mgr->counter += 1; mgr->connections[indx] = con; mgr->connectionIds[indx] = con_id; SEXP conHandle = RS_DBI_asConHandle(MGR_ID(mgrHandle), con_id); return conHandle; } /* the invoking (freeing) function must provide a function for * freeing the conParams, and by setting the (*free_drvConParams)(void *) * pointer. */ void RS_DBI_freeConnection(SEXP conHandle) { int indx; RS_DBI_connection* con = RS_DBI_getConnection(conHandle); MySQLDriver* mgr = rmysql_driver(); /* Are there open resultSets? If so, free them first */ if (con->num_res > 0) { int i; SEXP rsHandle; for(i=0; i < con->num_res; i++){ rsHandle = RS_DBI_asResHandle(con->managerId, con->connectionId, (int) con->resultSetIds[i]); RS_DBI_freeResultSet(rsHandle); } warning("opened resultSet(s) forcebly closed"); } if(con->drvConnection) { error("internal error in RS_DBI_freeConnection: driver might have left open its connection on the server"); } if(con->conParams){ error("internal error in RS_DBI_freeConnection: non-freed con->conParams (tiny memory leaked)"); } /* delete this connection from manager's connection table */ if(con->resultSets) free(con->resultSets); if(con->resultSetIds) free(con->resultSetIds); /* update the manager's connection table */ indx = RS_DBI_lookup(mgr->connectionIds, mgr->length, con->connectionId); RS_DBI_freeEntry(mgr->connectionIds, indx); mgr->connections[indx] = (RS_DBI_connection *) NULL; mgr->num_con -= (int) 1; free(con); con = (RS_DBI_connection *) NULL; return; } SEXP RS_DBI_asConHandle(int mgrId, int conId) { SEXP conHandle; PROTECT(conHandle = NEW_INTEGER((int) 2)); MGR_ID(conHandle) = mgrId; CON_ID(conHandle) = conId; UNPROTECT(1); return conHandle; } RS_DBI_connection* RS_DBI_getConnection(SEXP conHandle) { MySQLDriver *mgr; int indx; mgr = rmysql_driver(); indx = RS_DBI_lookup(mgr->connectionIds, mgr->length, CON_ID(conHandle)); if(indx < 0) error("internal error in RS_DBI_getConnection: corrupt connection handle"); if(!mgr->connections[indx]) error("internal error in RS_DBI_getConnection: corrupt connection object"); return mgr->connections[indx]; } SEXP RS_DBI_connectionInfo(SEXP conHandle) { RS_DBI_connection *con; int i; int n = (int) 8; char *conDesc[] = {"host", "user", "dbname", "conType", "serverVersion", "protocolVersion", "threadId", "rsHandle"}; SEXPTYPE conType[] = {STRSXP, STRSXP, STRSXP, STRSXP, STRSXP, INTSXP, INTSXP, INTSXP}; int conLen[] = {1, 1, 1, 1, 1, 1, 1, -1}; con = RS_DBI_getConnection(conHandle); conLen[7] = con->num_res; /* number of resultSets opened */ SEXP output = PROTECT(RS_DBI_createNamedList(conDesc, conType, conLen, n)); /* dummy */ SET_LST_CHR_EL(output,0,0,mkChar("NA")); /* host */ SET_LST_CHR_EL(output,1,0,mkChar("NA")); /* dbname */ SET_LST_CHR_EL(output,2,0,mkChar("NA")); /* user */ SET_LST_CHR_EL(output,3,0,mkChar("NA")); /* conType */ SET_LST_CHR_EL(output,4,0,mkChar("NA")); /* serverVersion */ LST_INT_EL(output,5,0) = (int) -1; /* protocolVersion */ LST_INT_EL(output,6,0) = (int) -1; /* threadId */ for(i=0; i < con->num_res; i++) LST_INT_EL(output,7,(int) i) = con->resultSetIds[i]; UNPROTECT(1); return output; } /* Are there more results on this connection (as in multi results or * SQL scripts */ SEXP RS_MySQL_moreResultSets(SEXP conHandle) { RS_DBI_connection *con; MYSQL *my_connection; my_bool tmp; con = RS_DBI_getConnection(conHandle); my_connection = (MYSQL *) con->drvConnection; tmp = mysql_more_results(my_connection); return ScalarLogical(tmp); } /* open a connection with the same parameters used for in conHandle */ SEXP RS_MySQL_cloneConnection(SEXP conHandle) { SEXP out = RS_MySQL_createConnection( PROTECT(ScalarInteger(0)), RS_MySQL_cloneConParams(RS_DBI_getConnection(conHandle)->conParams)); UNPROTECT(1); return out; } RS_MySQL_conParams* RS_MySQL_allocConParams(void) { RS_MySQL_conParams *conParams; conParams = (RS_MySQL_conParams *) malloc(sizeof(RS_MySQL_conParams)); if(!conParams){ error("could not malloc space for connection params"); } conParams->dbname = NULL; conParams->username = NULL; conParams->password = NULL; conParams->host = NULL; conParams->unix_socket = NULL; conParams->port = 0; conParams->client_flag = 0; conParams->groups = NULL; conParams->default_file = NULL; return conParams; } RS_MySQL_conParams* RS_MySQL_cloneConParams(RS_MySQL_conParams *cp) { RS_MySQL_conParams *new = RS_MySQL_allocConParams(); if (cp->dbname) new->dbname = RS_DBI_copyString(cp->dbname); if (cp->username) new->username = RS_DBI_copyString(cp->username); if (cp->password) new->password = RS_DBI_copyString(cp->password); if (cp->host) new->host = RS_DBI_copyString(cp->host); if (cp->unix_socket) new->unix_socket = RS_DBI_copyString(cp->unix_socket); new->port = cp->port; new->client_flag = cp->client_flag; if (cp->groups) new->groups = RS_DBI_copyString(cp->groups); if (cp->default_file) new->default_file = RS_DBI_copyString(cp->default_file); return new; } void RS_MySQL_freeConParams(RS_MySQL_conParams *conParams) { if(conParams->dbname) free(conParams->dbname); if(conParams->username) free(conParams->username); if(conParams->password) free(conParams->password); if(conParams->host) free(conParams->host); if(conParams->unix_socket) free(conParams->unix_socket); /* port and client_flag are unsigned ints */ if(conParams->groups) free(conParams->groups); if(conParams->default_file) free(conParams->default_file); free(conParams); return; } SEXP RS_MySQL_newConnection(SEXP mgrHandle, SEXP s_dbname, SEXP s_username, SEXP s_password, SEXP s_myhost, SEXP s_unix_socket, SEXP s_port, SEXP s_client_flag, SEXP s_groups, SEXP s_default_file) { RS_MySQL_conParams *conParams; /* Create connection parameters structure and initialize */ conParams = RS_MySQL_allocConParams(); /* Arguments override defaults in config file */ if(s_dbname != R_NilValue) conParams->dbname = RS_DBI_copyString(CHAR(asChar(s_dbname))); if(s_username != R_NilValue) conParams->username = RS_DBI_copyString(CHAR(asChar(s_username))); if(s_password != R_NilValue) conParams->password = RS_DBI_copyString(CHAR(asChar(s_password))); if(s_myhost != R_NilValue) conParams->host = RS_DBI_copyString(CHAR(asChar(s_myhost))); if(s_unix_socket != R_NilValue) conParams->unix_socket = RS_DBI_copyString(CHAR(asChar(s_unix_socket))); if (s_port != R_NilValue) conParams->port = asInteger(s_port); if (s_client_flag != R_NilValue) conParams->client_flag = asInteger(s_client_flag); if(s_groups != R_NilValue) conParams->groups = RS_DBI_copyString(CHAR(asChar(s_groups))); if(s_default_file != R_NilValue) conParams->default_file = RS_DBI_copyString(CHAR(asChar(s_default_file))); return RS_MySQL_createConnection(mgrHandle, conParams); } SEXP RS_MySQL_closeConnection(SEXP conHandle) { RS_DBI_connection *con; MYSQL *my_connection; con = RS_DBI_getConnection(conHandle); if(con->num_res>0){ error("close the pending result sets before closing this connection"); } /* make sure we first free the conParams and mysql connection from * the RS-RBI connection object. */ if(con->conParams){ RS_MySQL_freeConParams(con->conParams); con->conParams = (RS_MySQL_conParams *) NULL; } my_connection = (MYSQL *) con->drvConnection; mysql_close(my_connection); con->drvConnection = (void *) NULL; RS_DBI_freeConnection(conHandle); return ScalarLogical(TRUE); } SEXP RS_MySQL_connectionInfo(SEXP conHandle) { MYSQL *my_con; RS_MySQL_conParams *conParams; RS_DBI_connection *con; SEXP output; int i, n = 8, *res, nres; char *conDesc[] = {"host", "user", "dbname", "conType", "serverVersion", "protocolVersion", "threadId", "rsId"}; SEXPTYPE conType[] = {STRSXP, STRSXP, STRSXP, STRSXP, STRSXP, INTSXP, INTSXP, INTSXP}; int conLen[] = {1, 1, 1, 1, 1, 1, 1, 1}; char *tmp; con = RS_DBI_getConnection(conHandle); conLen[7] = con->num_res; /* num of open resultSets */ my_con = (MYSQL *) con->drvConnection; output = RS_DBI_createNamedList(conDesc, conType, conLen, n); conParams = (RS_MySQL_conParams *) con->conParams; PROTECT(output); tmp = conParams->host? conParams->host : (my_con->host?my_con->host:""); SET_LST_CHR_EL(output,0,0,mkChar(tmp)); tmp = conParams->username? conParams->username : (my_con->user?my_con->user:""); SET_LST_CHR_EL(output,1,0,mkChar(tmp)); tmp = conParams->dbname? conParams->dbname : (my_con->db?my_con->db:""); SET_LST_CHR_EL(output,2,0,mkChar(tmp)); SET_LST_CHR_EL(output,3,0,mkChar(mysql_get_host_info(my_con))); SET_LST_CHR_EL(output,4,0,mkChar(mysql_get_server_info(my_con))); LST_INT_EL(output,5,0) = (int) mysql_get_proto_info(my_con); LST_INT_EL(output,6,0) = (int) mysql_thread_id(my_con); res = (int *) S_alloc( (long) con->length, (int) sizeof(int)); nres = RS_DBI_listEntries(con->resultSetIds, con->length, res); if(nres != con->num_res){ UNPROTECT(1); error("internal error: corrupt RS_DBI resultSet table"); } for( i = 0; i < con->num_res; i++){ LST_INT_EL(output,7,i) = (int) res[i]; } UNPROTECT(1); return output; } SEXP rmysql_connection_valid(SEXP con_) { RS_DBI_connection* con = RS_DBI_getConnection(con_); if(!con) return ScalarLogical(FALSE); if(!con->resultSets) return ScalarLogical(FALSE); return ScalarLogical(TRUE); } RMySQL/src/db-apply.c0000644000176200001440000003630014751652206014016 0ustar liggesusers#include "RS-MySQL.h" /* * RS_MySQL_dbApply. * * R/S: dbApply(rs, INDEX, FUN, group.begin, group.end, end, ...) * * This first implementation of R's dbApply() * extracts rows from an open result set rs and applies functions * to those rows of each group. This is how it works: it keeps tracks of * the values of the field pointed by "group" and it identifies events: * BEGIN_GROUP (just read the first row of a different group), * NEW_RECORD (every record fetched generates this event), * and END_GROUP (just finished with the current group). At these points * we invoke the R functions group.end() and group.begin() in the * environment() of dbApply * [should it be the environment where dbApply was called from (i.e., * dbApply's parent's * frame)?] * Except for the very first group, the order of invocation is * end.group() followed by begin.group() * * NOTE: We're thinking of groups as commonly defined in awk scripts * (but also in SAP's ABAP/4) were rows are assumed to be sorted by * the "group" fields and we detect a different (new) group when any of * the "group" fields changes. Our implementation does not require * the result set to be sorted by group, but for performance-sake, * it better be. * * TODO: 1. Notify the reason for exiting (normal, exhausted maxBatches, etc.) * 2. Allow INDEX to be a list, as in tapply(). * 3. Handle NA's (SQL NULL's) in the INDEX and/or data fields. * Currently they are ignored, thus effectively causing a * new BEGIN_GROUP event. * 4. Re-write fetch() in terms of events (END_OF_DATA, * EXHAUST_DATAFRAME, DB_ERROR, etc.) * 5. Create a table of R callback functions indexed by events, * then a handle_event() could conveniently handle all the events. */ SEXP expand_list(SEXP old, int new_len); void add_group(SEXP group_names, SEXP data, SEXPTYPE *fld_Sclass, int group, int ngroup, int i); unsigned int check_groupEvents(SEXP data, SEXPTYPE fld_Sclass[], int row, int col); /* The following are the masks for the events/states we recognize as we * bring rows from the result set/cursor */ #define NEVER 0 #define BEGIN 1 /* prior to reading 1st row from the resultset */ #define END 2 /* after reading last row from the result set */ #define BEGIN_GROUP 4 /* just read in 1'st row for a different group */ #define END_GROUP 8 /* just read the last row of the current group */ #define NEW_RECORD 16 /* uninteresting ... */ #define PARTIAL_GROUP 32 /* too much data (>max_rex) partial buffer */ /* the following are non-grouping events (e.g., db errors, memory) */ #define EXHAUSTED_DF 64 /* exhausted the allocated data.frame */ #define EXHAUSTED_OUT 128 /* exhausted the allocated output list */ #define END_OF_DATA 256 /* end of data from the result set */ #define DBMS_ERROR 512 /* error in remote dbms */ /* beginGroupFun takes only one arg: the name of the current group */ SEXP RS_DBI_invokeBeginGroup(SEXP callObj, /* should be initialized */ const char *group_name, /* one string */ SEXP rho) { SEXP s_group_name; /* make a copy of the argument */ PROTECT(s_group_name = NEW_CHARACTER((int) 1)); SET_CHR_EL(s_group_name, 0, mkChar(group_name)); /* and stick into call object */ SETCADR(callObj, s_group_name); eval(callObj, rho); UNPROTECT(1); return R_NilValue; } SEXP RS_DBI_invokeNewRecord(SEXP callObj, /* should be initialized already */ SEXP new_record,/* a 1-row data.frame */ SEXP rho) { SEXP df; /* make a copy of the argument */ PROTECT(df = duplicate(new_record)); /* and stick it into the call object */ SETCADR(callObj, df); eval(callObj, rho); UNPROTECT(1); return R_NilValue; } /* endGroupFun takes two args: a data.frame and the group name */ SEXP RS_DBI_invokeEndGroup(SEXP callObj, SEXP data, const char *group_name, SEXP rho) { SEXP s_x, s_group_name, val; /* make copies of the arguments */ PROTECT(callObj = duplicate(callObj)); PROTECT(s_x = duplicate(data)); PROTECT(s_group_name = NEW_CHARACTER((int) 1)); SET_CHR_EL(s_group_name, 0, mkChar(group_name)); /* stick copies of args into the call object */ SETCADR(callObj, s_x); SETCADDR(callObj, s_group_name); SETCADDDR(callObj, R_DotsSymbol); val = eval(callObj, rho); UNPROTECT(3); return val; } SEXP /* output is a named list */ RS_MySQL_dbApply(SEXP rsHandle, /* resultset handle */ SEXP s_group_field,/* this is a 0-based field number */ SEXP s_funs, /* a 5-elem list with handler funs */ SEXP rho, /* the env where to run funs */ SEXP s_batch_size, /* alloc these many rows */ SEXP s_max_rec) /* max rows per group */ { RS_DBI_resultSet *result; RMySQLFields* flds; MYSQL_RES *my_result; MYSQL_ROW row; SEXP data, cur_rec, out_list, group_names, val; unsigned long *lens = (unsigned long *)0; SEXPTYPE *fld_Sclass; int i, j, null_item, expand, completed; int num_rec, num_groups; int num_fields; int max_rec = INT_EL(s_max_rec,0); /* max rec per group */ int ngroup = 0, group_field = INT_EL(s_group_field,0); long total_records; int pushed_back = FALSE; unsigned int event = NEVER; int np = 0; /* keeps track of PROTECT()'s */ SEXP beginGroupCall, beginGroupFun = LST_EL(s_funs, 2); SEXP endGroupCall, endGroupFun = LST_EL(s_funs, 3); SEXP newRecordCall, newRecordFun = LST_EL(s_funs, 4); int invoke_beginGroup = (GET_LENGTH(beginGroupFun)>0); int invoke_endGroup = (GET_LENGTH(endGroupFun)>0); int invoke_newRecord = (GET_LENGTH(newRecordFun)>0); row = NULL; beginGroupCall = R_NilValue; /* -Wall */ if(invoke_beginGroup){ PROTECT(beginGroupCall=lang2(beginGroupFun, R_NilValue)); ++np; } endGroupCall = R_NilValue; /* -Wall */ if(invoke_endGroup){ /* TODO: append list(...) to the call object */ PROTECT(endGroupCall = lang4(endGroupFun, R_NilValue, R_NilValue, R_NilValue)); ++np; } newRecordCall = R_NilValue; /* -Wall */ if(invoke_newRecord){ PROTECT(newRecordCall = lang2(newRecordFun, R_NilValue)); ++np; } result = RS_DBI_getResultSet(rsHandle); flds = result->fields; if(!flds) error("corrupt resultSet, missing fieldDescription"); num_fields = flds->num_fields; fld_Sclass = flds->Sclass; PROTECT(data = NEW_LIST((int) num_fields)); /* buffer records */ PROTECT(cur_rec = NEW_LIST((int) num_fields)); /* current record */ np += 2; RS_DBI_allocOutput(cur_rec, flds, (int) 1, 0); make_data_frame(cur_rec); num_rec = INT_EL(s_batch_size, 0); /* this is num of rec per group! */ max_rec = INT_EL(s_max_rec,0); /* max rec **per group** */ num_groups = num_rec; PROTECT(out_list = NEW_LIST(num_groups)); PROTECT(group_names = NEW_CHARACTER(num_groups)); np += 2; /* set conversion for group names */ if(result->rowCount==0){ event = BEGIN; /* here we could invoke the begin function*/ } /* actual fetching.... */ my_result = (MYSQL_RES *) result->drvResultSet; completed = (int) 0; total_records = 0; expand = 0; /* expand or init each data vector? */ i = 0; /* index into row number **within** groups */ while(1){ if(i==0 || i==num_rec){ /* BEGIN, EXTEND_DATA, BEGIN_GROUP */ /* reset num_rec upon a new group, double it if needs to expand */ num_rec = (i==0) ? INT_EL(s_batch_size, 0) : 2*num_rec; if(idrvConnection); completed = (int) (err_no ? -1 : 1); break; } if(!pushed_back){ /* recompute fields lengths? */ lens = mysql_fetch_lengths(my_result); /* lengths for each field */ ++total_records; } /* coerce each entry row[j] to an R/S type according to its Sclass. * TODO: converter functions are badly needed. */ for(j = 0; j < num_fields; j++){ null_item = (row[j] == NULL); switch((int)fld_Sclass[j]){ case INTSXP: if(null_item) NA_SET(&(LST_INT_EL(data,j,i)), INTSXP); else LST_INT_EL(data,j,i) = atol(row[j]); LST_INT_EL(cur_rec,j,0) = LST_INT_EL(data,j,i); break; case STRSXP: /* BUG: I need to verify that a TEXT field (which is stored as * a BLOB by MySQL!) is indeed char and not a true * Binary obj (MySQL does not truly distinguish them). This * test is very gross. */ if(null_item) SET_LST_CHR_EL(data,j,i,NA_STRING); else { if((size_t) lens[j] != strlen(row[j])){ warning("internal error: row %d field %d truncated", i, j); } SET_LST_CHR_EL(data,j,i,mkChar(row[j])); } SET_LST_CHR_EL(cur_rec, j, 0, mkChar(LST_CHR_EL(data,j,i))); break; case REALSXP: if(null_item) NA_SET(&(LST_NUM_EL(data,j,i)), REALSXP); else LST_NUM_EL(data,j,i) = (double) atof(row[j]); LST_NUM_EL(cur_rec,j,0) = LST_NUM_EL(data,j,i); break; default: /* error, but we'll try the field as character (!)*/ if(null_item) SET_LST_CHR_EL(data,j,i, NA_STRING); else { warning("unrecognized field type %d in column %d", fld_Sclass[j], j); SET_LST_CHR_EL(data,j,i,mkChar(row[j])); } SET_LST_CHR_EL(cur_rec,j,0, mkChar(LST_CHR_EL(data,j,i))); break; } } if(!pushed_back){ if(invoke_newRecord) RS_DBI_invokeNewRecord(newRecordCall, cur_rec, rho); } else { pushed_back = FALSE; } /* We just finished processing the new record, now we check * for some events (in addition to NEW_RECORD, of course). */ event = check_groupEvents(data, fld_Sclass, i, group_field); if(BEGIN_GROUP & event){ if(ngroup==num_groups){ /* exhausted output list? */ num_groups = 2 * num_groups; PROTECT(SET_LENGTH(out_list, num_groups)); PROTECT(SET_LENGTH(group_names, num_groups)); np += 2; } if(invoke_beginGroup) RS_DBI_invokeBeginGroup( beginGroupCall, CHR_EL(group_names, ngroup), rho); } if(END_GROUP & event){ add_group(group_names, data, fld_Sclass, group_field, ngroup, i-1); RS_DBI_allocOutput(data, flds, i, expand++); make_data_frame(data); val = RS_DBI_invokeEndGroup(endGroupCall, data, CHR_EL(group_names, ngroup), rho); SET_ELEMENT(out_list, ngroup, val); /* set length of data to zero to force initialization * for next group */ RS_DBI_allocOutput(data, flds, (int) 0, (int) 1); i = 0; /* flush */ ++ngroup; pushed_back = TRUE; continue; } i++; } /* we fetched all the rows we needed/could; compute actual number of * records fetched. * TODO: What should we return in the case of partial groups??? */ if(completed < 0) warning("error while fetching rows"); else if(completed) event = (END_GROUP|END); else event = PARTIAL_GROUP; /* wrap up last group */ if((END_GROUP & event) || (PARTIAL_GROUP & event)){ add_group(group_names, data, fld_Sclass, group_field, ngroup, i-i); if(irowCount += total_records; result->completed = (int) completed; SET_NAMES(out_list, group_names); /* do I need to PROTECT? */ UNPROTECT(np); return out_list; } unsigned int check_groupEvents(SEXP data, SEXPTYPE fld_Sclass[], int irow, int jcol) { if(irow==0) /* Begin */ return (BEGIN|BEGIN_GROUP); SEXP col = VECTOR_ELT(data, jcol); switch(fld_Sclass[jcol]) { case LGLSXP: if (LOGICAL(col)[irow] == LOGICAL(col)[irow - 1]) return (END_GROUP|BEGIN_GROUP); break; case INTSXP: if (INTEGER(col)[irow] == INTEGER(col)[irow - 1]) return (END_GROUP|BEGIN_GROUP); break; case REALSXP: if (REAL(col)[irow] == REAL(col)[irow - 1]) return (END_GROUP|BEGIN_GROUP); break; case STRSXP: if (STRING_ELT(col, irow) == STRING_ELT(col, irow - 1)) return (END_GROUP|BEGIN_GROUP); break; default: error("un-regongnized R/S data type %d", fld_Sclass[jcol]); break; } return NEW_RECORD; } /* append current group (as character) to the vector of group names */ void add_group(SEXP group_names, SEXP data, SEXPTYPE *fld_Sclass, int group_field, int ngroup, int i) { char buff[1024]; SEXP col = VECTOR_ELT(data, group_field); switch((int) fld_Sclass[group_field]){ case LGLSXP: (void) snprintf(buff, 1024, "%ld", (long) LOGICAL(col)[i]); break; case INTSXP: (void) snprintf(buff, 1024, "%ld", (long) INTEGER(col)[i]); break; case REALSXP: (void) snprintf(buff, 1024, "%f", (double) REAL(col)[i]); break; case STRSXP: strcpy(buff, CHAR(STRING_ELT(col, i))); break; default: error("unrecognized R/S type for group"); break; } SET_CHR_EL(group_names, ngroup, mkChar(buff)); return; } RMySQL/src/exception.c0000644000176200001440000000127714751652206014311 0ustar liggesusers#include "RS-MySQL.h" SEXP rmysql_exception_info(SEXP conHandle) { RS_DBI_connection* con = RS_DBI_getConnection(conHandle); if (!con->drvConnection) error("RMySQL error: corrupt connection handle"); MYSQL* my_connection = con->drvConnection; // Allocate output SEXP output = PROTECT(allocVector(VECSXP, 2)); SEXP output_nms = PROTECT(allocVector(STRSXP, 2)); SET_NAMES(output, output_nms); UNPROTECT(1); SET_CHR_EL(output_nms, 0, mkChar("errorNum")); SET_VECTOR_ELT(output, 0, ScalarInteger(mysql_errno(my_connection))); SET_CHR_EL(output_nms, 1, mkChar("errorMsg")); SET_VECTOR_ELT(output, 1, mkString(mysql_error(my_connection))); UNPROTECT(1); return output; } RMySQL/src/driver.c0000644000176200001440000000561614751652206013607 0ustar liggesusers#include "RS-MySQL.h" static MySQLDriver* dbManager = NULL; MySQLDriver* rmysql_driver(void) { if (!dbManager) error("Corrupt MySQL handle"); return dbManager; } SEXP rmysql_driver_valid(void) { if(!dbManager || !dbManager->connections) { return ScalarLogical(FALSE); } else { return ScalarLogical(TRUE); } } SEXP rmysql_driver_init(SEXP max_con_, SEXP fetch_default_rec_) { SEXP mgrHandle = ScalarInteger(0); if (dbManager) return mgrHandle; PROTECT(mgrHandle); int max_con = asInteger(max_con_), fetch_default_rec = asInteger(fetch_default_rec_); int counter = 0; MySQLDriver* mgr = (MySQLDriver*) malloc(sizeof(MySQLDriver)); if (!mgr) error("Could not allocate memory for the MySQL driver"); /* Ok, we're here to expand number of connections, etc.*/ mgr->managerId = 0; mgr->connections = calloc(max_con, sizeof(RS_DBI_connection)); if (!mgr->connections) { free(mgr); error("Could not allocate memory for connections"); } mgr->connectionIds = calloc(max_con, sizeof(int)); if (!mgr->connectionIds){ free(mgr->connections); free(mgr); error("Could not allocation memory for connection Ids"); } mgr->counter = counter; mgr->length = max_con; mgr->num_con = (int) 0; mgr->fetch_default_rec = fetch_default_rec; for(int i = 0; i < max_con; i++){ mgr->connectionIds[i] = -1; mgr->connections[i] = (RS_DBI_connection *) NULL; } dbManager = mgr; UNPROTECT(1); return mgrHandle; } SEXP rmysql_driver_close(void) { MySQLDriver *mgr = rmysql_driver(); if(mgr->num_con) error("Open connections -- close them first"); if(mgr->connections) { free(mgr->connections); mgr->connections = (RS_DBI_connection **) NULL; } if(mgr->connectionIds) { free(mgr->connectionIds); mgr->connectionIds = (int *) NULL; } return ScalarLogical(TRUE); } SEXP rmysql_driver_info(void) { MySQLDriver *mgr = rmysql_driver(); // Allocate output SEXP output = PROTECT(allocVector(VECSXP, 6)); SEXP output_nms = PROTECT(allocVector(STRSXP, 6)); SET_NAMES(output, output_nms); UNPROTECT(1); SET_CHR_EL(output_nms, 0, mkChar("connectionIds")); SEXP cons = PROTECT(allocVector(INTSXP, mgr->num_con)); RS_DBI_listEntries(mgr->connectionIds, mgr->num_con, INTEGER(cons)); SET_VECTOR_ELT(output, 0, cons); UNPROTECT(1); SET_CHR_EL(output_nms, 1, mkChar("fetch_default_rec")); SET_VECTOR_ELT(output, 1, ScalarInteger(mgr->fetch_default_rec)); SET_CHR_EL(output_nms, 2, mkChar("length")); SET_VECTOR_ELT(output, 2, ScalarInteger(mgr->length)); SET_CHR_EL(output_nms, 3, mkChar("num_con")); SET_VECTOR_ELT(output, 3, ScalarInteger(mgr->num_con)); SET_CHR_EL(output_nms, 4, mkChar("counter")); SET_VECTOR_ELT(output, 4, ScalarInteger(mgr->counter)); SET_CHR_EL(output_nms, 5, mkChar("clientVersion")); SET_VECTOR_ELT(output, 5, mkString(mysql_get_client_info())); UNPROTECT(1); return output; } RMySQL/src/getopt.h0000644000176200001440000001114214751652206013612 0ustar liggesusers/* Declarations for getopt. Copyright (C) 1989, 90, 91, 92, 93, 94 Free Software Foundation, Inc. This file is part of the GNU C Library. Its master source is NOT part of the C library, however. The master source lives in /gd/gnu/lib. The GNU C Library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. The GNU C 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with the GNU C Library; see the file COPYING.LIB. If not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifndef _GETOPT_H #define _GETOPT_H 1 #ifdef __cplusplus extern "C" { #endif /* For communication from `getopt' to the caller. When `getopt' finds an option that takes an argument, the argument value is returned here. Also, when `ordering' is RETURN_IN_ORDER, each non-option ARGV-element is returned here. */ extern char *optarg; /* Index in ARGV of the next element to be scanned. This is used for communication to and from the caller and for communication between successive calls to `getopt'. On entry to `getopt', zero means this is the first call; initialize. When `getopt' returns EOF, this is the index of the first of the non-option elements that the caller should itself scan. Otherwise, `optind' communicates from one call to the next how much of ARGV has been scanned so far. */ extern int optind; /* Callers store zero here to inhibit the error message `getopt' prints for unrecognized options. */ extern int opterr; /* Set to an option character which was unrecognized. */ extern int optopt; /* Describe the long-named options requested by the application. The LONG_OPTIONS argument to getopt_long or getopt_long_only is a vector of `struct option' terminated by an element containing a name which is zero. The field `has_arg' is: no_argument (or 0) if the option does not take an argument, required_argument (or 1) if the option requires an argument, optional_argument (or 2) if the option takes an optional argument. If the field `flag' is not NULL, it points to a variable that is set to the value given in the field `val' when the option is found, but left unchanged if the option is not found. To have a long-named option do something other than set an `int' to a compiled-in constant, such as set a value from `optarg', set the option's `flag' field to zero and its `val' field to a nonzero value (the equivalent single-letter option character, if there is one). For long options that have a zero `flag' field, `getopt' returns the contents of the `val' field. */ struct option { #if defined (__STDC__) && __STDC__ const char *name; #else char *name; #endif /* has_arg can't be an enum because some compilers complain about type mismatches in all the code that assumes it is an int. */ int has_arg; int *flag; int val; }; /* Names for the values of the `has_arg' field of `struct option'. */ #define no_argument 0 #define required_argument 1 #define optional_argument 2 #if ( defined (__STDC__) && __STDC__ ) || defined(__cplusplus) || defined(MSDOS) #ifdef __GNU_LIBRARY__ /* Many other libraries have conflicting prototypes for getopt, with differences in the consts, in stdlib.h. To avoid compilation errors, only prototype getopt for the GNU C library. */ extern int getopt (int argc, char *const *argv, const char *shortopts); #else /* not __GNU_LIBRARY__ */ extern int getopt (int argc, char *const *argv, const char *optstring); #endif /* __GNU_LIBRARY__ */ extern int getopt_long (int argc, char *const *argv, const char *shortopts, const struct option *longopts, int *longind); extern int getopt_long_only (int argc, char *const *argv, const char *shortopts, const struct option *longopts, int *longind); /* Internal only. Users should not call this directly. */ extern int _getopt_internal (int argc, char *const *argv, const char *shortopts, const struct option *longopts, int *longind, int long_only); #else /* not __STDC__ */ extern int getopt (); extern int getopt_long (); extern int getopt_long_only (); extern int _getopt_internal (); #endif /* __STDC__ */ #ifdef __cplusplus } #endif #endif /* _GETOPT_H */ RMySQL/src/RMySQL-init.c0000644000176200001440000000242414751652206014336 0ustar liggesusers#include #include #include #include void R_init_RMySQL(DllInfo *info){ mysql_library_init(0,NULL,NULL); R_registerRoutines(info, NULL, NULL, NULL, NULL); R_useDynamicSymbols(info, TRUE); /* Test release vs. compiled client library, warning * when the major or minor revision number differ. The integer format is XYYZZ * where X is the major revision, YY is the minor revision, and ZZ is the revision * within the minor revision. * Jeroen 2014: this is incorrect. It merely compares the VERSION and VERSION.server * files contained within the connector library. It has nothing to do with build vs * compile. Disabling this. int compiled=MYSQL_VERSION_ID; int loaded = (int)mysql_get_client_version(); if ( (compiled-(compiled%100)) != (loaded-(loaded%100)) ){ warning("\n\n RMySQL was compiled with MySQL %s but loading MySQL %s instead!\n This may cause problems with your database connections.\n\n Please install MySQL %s.\n\n If you have already done so, you may need to set your environment\n variable MYSQL_HOME to the proper install directory.",MYSQL_SERVER_VERSION,mysql_get_client_info(),MYSQL_SERVER_VERSION); } */ } void R_unload_RMySQL(DllInfo *info){ mysql_library_end(); } RMySQL/src/result.c0000644000176200001440000003041714751652206013627 0ustar liggesusers#include "RS-MySQL.h" SEXP RS_DBI_allocResultSet(SEXP conHandle) { RS_DBI_connection *con = RS_DBI_getConnection(conHandle); int indx = RS_DBI_newEntry(con->resultSetIds, con->length); if (indx < 0) { error( "cannot allocate a new resultSet -- maximum of %d resultSets already reached", con->length ); } RS_DBI_resultSet* result = malloc(sizeof(RS_DBI_resultSet)); if (!result) { RS_DBI_freeEntry(con->resultSetIds, indx); error("could not malloc dbResultSet"); } result->drvResultSet = (void *) NULL; /* driver's own resultSet (cursor)*/ result->statement = (char *) NULL; result->connectionId = CON_ID(conHandle); result->resultSetId = con->counter; result->isSelect = (int) -1; result->rowsAffected = (int) -1; result->rowCount = (int) 0; result->completed = (int) -1; result->fields = NULL; /* update connection's resultSet table */ int res_id = con->counter; con->num_res += (int) 1; con->counter += (int) 1; con->resultSets[indx] = result; con->resultSetIds[indx] = res_id; return RS_DBI_asResHandle(MGR_ID(conHandle), CON_ID(conHandle), res_id); } void RS_DBI_freeResultSet(SEXP rsHandle) { RS_DBI_connection* con = RS_DBI_getConnection(rsHandle); RS_DBI_resultSet* result = RS_DBI_getResultSet(rsHandle); if(result->drvResultSet) { error("internal error in RS_DBI_freeResultSet: non-freed result->drvResultSet (some memory leaked)"); } if (result->statement) free(result->statement); if (result->fields) rmysql_fields_free(result->fields); free(result); result = NULL; /* update connection's resultSet table */ int indx = RS_DBI_lookup(con->resultSetIds, con->length, RES_ID(rsHandle)); RS_DBI_freeEntry(con->resultSetIds, indx); con->resultSets[indx] = NULL; con->num_res -= 1; } SEXP RS_DBI_asResHandle(int mgrId, int conId, int resId) { SEXP resHandle = PROTECT(allocVector(INTSXP, 3)); CON_ID(resHandle) = conId; RES_ID(resHandle) = resId; UNPROTECT(1); return resHandle; } RS_DBI_resultSet* RS_DBI_getResultSet(SEXP rsHandle) { RS_DBI_connection* con = RS_DBI_getConnection(rsHandle); int indx = RS_DBI_lookup(con->resultSetIds, con->length, RES_ID(rsHandle)); if (indx < 0) error("internal error in RS_DBI_getResultSet: could not find resultSet in connection"); if (!con->resultSets[indx]) error("internal error in RS_DBI_getResultSet: missing resultSet"); return con->resultSets[indx]; } SEXP RS_DBI_resultSetInfo(SEXP rsHandle) { RS_DBI_resultSet *result; SEXP flds; int n = (int) 6; char *rsDesc[] = {"statement", "isSelect", "rowsAffected", "rowCount", "completed", "fields"}; SEXPTYPE rsType[] = {STRSXP, INTSXP, INTSXP, INTSXP, INTSXP, VECSXP}; int rsLen[] = {1, 1, 1, 1, 1, 1}; result = RS_DBI_getResultSet(rsHandle); flds = R_NilValue; SEXP output = PROTECT(RS_DBI_createNamedList(rsDesc, rsType, rsLen, n)); SET_LST_CHR_EL(output,0,0,mkChar(result->statement)); LST_INT_EL(output,1,0) = result->isSelect; LST_INT_EL(output,2,0) = result->rowsAffected; LST_INT_EL(output,3,0) = result->rowCount; LST_INT_EL(output,4,0) = result->completed; SET_ELEMENT(LST_EL(output, 5), (int) 0, flds); UNPROTECT(1); return output; } SEXP RS_MySQL_nextResultSet(SEXP conHandle) { RS_DBI_resultSet *result; SEXP rsHandle; int num_fields, is_select; RS_DBI_connection* con = RS_DBI_getConnection(conHandle); MYSQL* my_connection = con->drvConnection; int rc = mysql_next_result(my_connection); if (rc < 0) { error("no more result sets"); } else if (rc > 0){ error("error in getting next result set"); } /* the following comes verbatim from RS_MySQL_exec() */ MYSQL_RES* my_result = mysql_use_result(my_connection); if (!my_result) my_result = NULL; num_fields = mysql_field_count(my_connection); is_select = TRUE; if (!my_result) { if (num_fields > 0) { error("error in getting next result set"); } else { is_select = FALSE; } } /* we now create the wrapper and copy values */ rsHandle = PROTECT(RS_DBI_allocResultSet(conHandle)); result = RS_DBI_getResultSet(rsHandle); result->statement = RS_DBI_copyString(""); result->drvResultSet = (void *) my_result; result->rowCount = (int) 0; result->isSelect = is_select; if (!is_select){ result->rowsAffected = (int) mysql_affected_rows(my_connection); result->completed = 1; } else { result->rowsAffected = (int) -1; result->completed = 0; } if (is_select) result->fields = RS_MySQL_createDataMappings(rsHandle); UNPROTECT(1); return rsHandle; } /* Execute (currently) one sql statement (INSERT, DELETE, SELECT, etc.), * set coercion type mappings between the server internal data types and * S classes. Returns an S handle to a resultSet object. */ SEXP RS_MySQL_exec(SEXP conHandle, SEXP statement) { RS_DBI_connection *con; SEXP rsHandle; RS_DBI_resultSet *result; MYSQL *my_connection; MYSQL_RES *my_result; int num_fields, state; int res_id, is_select; char *dyn_statement; con = RS_DBI_getConnection(conHandle); my_connection = (MYSQL *) con->drvConnection; dyn_statement = RS_DBI_copyString(CHR_EL(statement,0)); /* Do we have a pending resultSet in the current connection? * MySQL only allows one resultSet per connection. */ if(con->num_res>0){ res_id = (int) con->resultSetIds[0]; /* recall, MySQL has only 1 res */ rsHandle = RS_DBI_asResHandle(MGR_ID(conHandle), CON_ID(conHandle), res_id); result = RS_DBI_getResultSet(rsHandle); if(result->completed == 0){ free(dyn_statement); error("connection with pending rows, close resultSet before continuing"); } else RS_MySQL_closeResultSet(rsHandle); } /* Here is where we actually run the query */ state = mysql_query(my_connection, dyn_statement); if(state) { error("could not run statement: %s", mysql_error(my_connection)); } /* Do we need output column/field descriptors? Only for SELECT-like * statements. The MySQL reference manual suggests invoking * mysql_use_result() and if it succeed the statement is SELECT-like * that can use a resultSet. Otherwise call mysql_field_count() * and if it returns zero, the sql was not a SELECT-like statement. * Finally a non-zero means a failed SELECT-like statement. */ my_result = mysql_use_result(my_connection); if(!my_result) my_result = (MYSQL_RES *) NULL; num_fields = (int) mysql_field_count(my_connection); is_select = (int) TRUE; if(!my_result){ if(num_fields>0){ free(dyn_statement); error("error in select/select-like"); } else is_select = FALSE; } /* we now create the wrapper and copy values */ rsHandle = PROTECT(RS_DBI_allocResultSet(conHandle)); result = RS_DBI_getResultSet(rsHandle); result->statement = RS_DBI_copyString(dyn_statement); result->drvResultSet = (void *) my_result; result->rowCount = (int) 0; result->isSelect = is_select; if(!is_select){ result->rowsAffected = (int) mysql_affected_rows(my_connection); result->completed = 1; } else { result->rowsAffected = (int) -1; result->completed = 0; } if(is_select) result->fields = RS_MySQL_createDataMappings(rsHandle); free(dyn_statement); UNPROTECT(1); return rsHandle; } // output is a named list SEXP RS_MySQL_fetch(SEXP rsHandle, SEXP max_rec) { MySQLDriver *mgr; RS_DBI_resultSet *result; RMySQLFields* flds; MYSQL_RES *my_result; MYSQL_ROW row; SEXP output, s_tmp; unsigned long *lens; int i, j, null_item, expand; int completed; SEXPTYPE *fld_Sclass; int num_rec; int num_fields; result = RS_DBI_getResultSet(rsHandle); flds = result->fields; if(!flds) return R_NilValue; num_rec = asInteger(max_rec); expand = (num_rec < 0); // dyn expand output to accommodate all rows if(expand || num_rec == 0){ mgr = rmysql_driver(); num_rec = mgr->fetch_default_rec; } num_fields = flds->num_fields; PROTECT(output = NEW_LIST((int) num_fields)); RS_DBI_allocOutput(output, flds, num_rec, 0); fld_Sclass = flds->Sclass; // actual fetching.... my_result = (MYSQL_RES *) result->drvResultSet; completed = (int) 0; for(i = 0; ; i++){ if(i==num_rec){ // exhausted the allocated space if(expand){ // do we extend or return the records fetched so far num_rec = 2 * num_rec; RS_DBI_allocOutput(output, flds, num_rec, expand); } else break; // okay, no more fetching for now } row = mysql_fetch_row(my_result); if(row==NULL){ // either we finish or we encounter an error unsigned int err_no; RS_DBI_connection *con; con = RS_DBI_getConnection(rsHandle); err_no = mysql_errno((MYSQL *) con->drvConnection); completed = (int) (err_no ? -1 : 1); break; } lens = mysql_fetch_lengths(my_result); for(j = 0; j < num_fields; j++){ null_item = (row[j] == NULL); switch((int)fld_Sclass[j]){ case INTSXP: if(null_item) NA_SET(&(LST_INT_EL(output,j,i)), INTSXP); else LST_INT_EL(output,j,i) = (int) atol(row[j]); break; case STRSXP: // BUG: I need to verify that a TEXT field (which is stored as // a BLOB by MySQL!) is indeed char and not a true // Binary obj (MySQL does not truly distinguish them). This // test is very gross. if(null_item) SET_LST_CHR_EL(output,j,i,NA_STRING); else { if((size_t) lens[j] != strlen(row[j])){ warning("internal error: row %d field %d truncated", i, j); } SET_LST_CHR_EL(output,j,i,mkChar(row[j])); } break; case REALSXP: if(null_item) NA_SET(&(LST_NUM_EL(output,j,i)), REALSXP); else LST_NUM_EL(output,j,i) = (double) atof(row[j]); break; default: // error, but we'll try the field as character (!) if(null_item) SET_LST_CHR_EL(output,j,i, NA_STRING); else { warning("unrecognized field type %d in column %d", fld_Sclass[j], j); SET_LST_CHR_EL(output,j,i,mkChar(row[j])); } break; } } } // actual number of records fetched if(i < num_rec){ num_rec = i; // adjust the length of each of the members in the output_list for(j = 0; jrowCount += num_rec; result->completed = (int) completed; UNPROTECT(1); return output; } SEXP RS_MySQL_closeResultSet(SEXP resHandle) { RS_DBI_resultSet *result; MYSQL_RES *my_result; result = RS_DBI_getResultSet(resHandle); my_result = (MYSQL_RES *) result->drvResultSet; if(my_result){ // we need to flush any possibly remaining rows (see Manual Ch 20 p358) MYSQL_ROW row; while((row = mysql_fetch_row(result->drvResultSet))) ; } mysql_free_result(my_result); // need to NULL drvResultSet, otherwise can't free the rsHandle result->drvResultSet = (void *) NULL; RS_DBI_freeResultSet(resHandle); return ScalarLogical(TRUE); } SEXP RS_MySQL_resultSetInfo(SEXP rsHandle) { RS_DBI_resultSet *result; SEXP flds; int n = 6; char *rsDesc[] = {"statement", "isSelect", "rowsAffected", "rowCount", "completed", "fieldDescription"}; SEXPTYPE rsType[] = {STRSXP, INTSXP, INTSXP, INTSXP, INTSXP, VECSXP}; int rsLen[] = {1, 1, 1, 1, 1, 1}; result = RS_DBI_getResultSet(rsHandle); flds = R_NilValue; SEXP output = PROTECT(RS_DBI_createNamedList(rsDesc, rsType, rsLen, n)); SET_LST_CHR_EL(output,0,0,mkChar(result->statement)); LST_INT_EL(output,1,0) = result->isSelect; LST_INT_EL(output,2,0) = result->rowsAffected; LST_INT_EL(output,3,0) = result->rowCount; LST_INT_EL(output,4,0) = result->completed; if(flds != R_NilValue) SET_ELEMENT(LST_EL(output, 5), (int) 0, flds); UNPROTECT(1); return output; } SEXP rmysql_result_valid(SEXP res_) { RS_DBI_connection* con = RS_DBI_getConnection(res_); int indx = RS_DBI_lookup(con->resultSetIds, con->length, RES_ID(res_)); if (indx < 0) return ScalarLogical(0); if (!con->resultSets[indx]) return ScalarLogical(0); return ScalarLogical(1); } RMySQL/src/Makevars.in0000644000176200001440000000012514751652206014237 0ustar liggesusersPKG_CPPFLAGS=@cflags@ PKG_LIBS=@libs@ all: clean clean: rm -f $(SHLIB) $(OBJECTS) RMySQL/src/S4R.h0000644000176200001440000000336014751652206012723 0ustar liggesusers/* Jeroen 2016: Removed #include S.h as requested by BDR. */ #ifndef S4R_H #define S4R_H #ifdef __cplusplus extern "C" { #endif #include #include #include /* We simplify one- and two-level access to object and list * (mostly built on top of jmc's macros) * * NOTE: Recall that list element vectors should *not* be set * directly, but only thru SET_ELEMENT (Green book, Appendix A), e.g., * LIST_POINTER(x)[i] = NEW_CHARACTER(100); BAD!! * LST_EL(x,i) = NEW_CHARACTER(100); BAD!! * SET_ELEMENT(x, i, NEW_CHARACTER(100)); Okay * * It's okay to directly set the i'th element of the j'th list element: * LST_CHR_EL(x,i,j) = C_S_CPY(str); Okay (but not in R-1.2.1) * * For R >= 1.2.0 define * SET_LST_CHR_EL(x,i,j,val) */ /* x[i] */ #define INT_EL(x,i) INTEGER((x))[(i)] #define NUM_EL(x,i) REAL((x))[(i)] #define LST_EL(x,i) VECTOR_ELT((x),(i)) #define CHR_EL(x,i) CHAR(STRING_ELT((x),(i))) #define SET_CHR_EL(x,i,val) SET_STRING_ELT((x),(i), (val)) /* x[[i]][j] -- can be also assigned if x[[i]] is a numeric type */ #define LST_CHR_EL(x,i,j) CHR_EL(LST_EL((x),(i)), (j)) #define LST_INT_EL(x,i,j) INT_EL(LST_EL((x),(i)), (j)) #define LST_NUM_EL(x,i,j) NUM_EL(LST_EL((x),(i)), (j)) /* x[[i]][j] -- for the case when x[[i]] is a character type */ #define SET_LST_CHR_EL(x,i,j,val) SET_STRING_ELT(LST_EL(x,i), j, val) /* setting and querying NA's -- in the case of R, we need to * use our own RS_na_set and RS_is_na functions (these need work!) */ # define NA_SET(p,t) RS_na_set((p),(t)) # define NA_CHR_SET(p) SET_CHR_EL(p, 0, NA_STRING) # define IS_NA(p,t) RS_is_na((p),(t)) /* end of RS-DBI macros */ #ifdef __cplusplus } #endif #endif /* S4R_H */ RMySQL/NAMESPACE0000644000176200001440000000535014751652206012573 0ustar liggesusers# Generated by roxygen2: do not edit by hand export(CLIENT_COMPRESS) export(CLIENT_CONNECT_WITH_DB) export(CLIENT_FOUND_ROWS) export(CLIENT_IGNORE_SIGPIPE) export(CLIENT_IGNORE_SPACE) export(CLIENT_INTERACTIVE) export(CLIENT_LOCAL_FILES) export(CLIENT_LONG_FLAG) export(CLIENT_LONG_PASSWORD) export(CLIENT_MULTI_RESULTS) export(CLIENT_MULTI_STATEMENTS) export(CLIENT_NO_SCHEMA) export(CLIENT_ODBC) export(CLIENT_PROTOCOL_41) export(CLIENT_RESERVED) export(CLIENT_SECURE_CONNECTION) export(CLIENT_SSL) export(CLIENT_TRANSACTIONS) export(MySQL) export(dbApply) export(dbEscapeStrings) export(dbMoreResults) export(dbNextResult) export(isIdCurrent) export(mysqlBuildTableDefinition) export(mysqlClientLibraryVersions) export(mysqlHasDefault) exportClasses(MySQLConnection) exportClasses(MySQLDriver) exportClasses(MySQLResult) exportMethods(SQLKeywords) exportMethods(dbApply) exportMethods(dbBegin) exportMethods(dbClearResult) exportMethods(dbColumnInfo) exportMethods(dbCommit) exportMethods(dbConnect) exportMethods(dbDataType) exportMethods(dbDisconnect) exportMethods(dbEscapeStrings) exportMethods(dbExistsTable) exportMethods(dbFetch) exportMethods(dbGetException) exportMethods(dbGetInfo) exportMethods(dbGetRowCount) exportMethods(dbGetRowsAffected) exportMethods(dbGetStatement) exportMethods(dbHasCompleted) exportMethods(dbIsValid) exportMethods(dbListConnections) exportMethods(dbListFields) exportMethods(dbListResults) exportMethods(dbListTables) exportMethods(dbMoreResults) exportMethods(dbNextResult) exportMethods(dbQuoteIdentifier) exportMethods(dbReadTable) exportMethods(dbRemoveTable) exportMethods(dbRollback) exportMethods(dbSendQuery) exportMethods(dbUnloadDriver) exportMethods(dbWriteTable) exportMethods(fetch) exportMethods(isSQLKeyword) exportMethods(make.db.names) exportMethods(show) exportMethods(summary) import(DBI) import(methods) importFrom(utils,packageVersion) importFrom(utils,read.table) importFrom(utils,write.table) useDynLib(RMySQL) useDynLib(RMySQL,RS_MySQL_cloneConnection) useDynLib(RMySQL,RS_MySQL_closeConnection) useDynLib(RMySQL,RS_MySQL_closeResultSet) useDynLib(RMySQL,RS_MySQL_connectionInfo) useDynLib(RMySQL,RS_MySQL_dbApply) useDynLib(RMySQL,RS_MySQL_exec) useDynLib(RMySQL,RS_MySQL_fetch) useDynLib(RMySQL,RS_MySQL_moreResultSets) useDynLib(RMySQL,RS_MySQL_newConnection) useDynLib(RMySQL,RS_MySQL_nextResultSet) useDynLib(RMySQL,RS_MySQL_resultSetInfo) useDynLib(RMySQL,rmysql_connection_valid) useDynLib(RMySQL,rmysql_driver_close) useDynLib(RMySQL,rmysql_driver_info) useDynLib(RMySQL,rmysql_driver_init) useDynLib(RMySQL,rmysql_driver_valid) useDynLib(RMySQL,rmysql_escape_strings) useDynLib(RMySQL,rmysql_exception_info) useDynLib(RMySQL,rmysql_fields_info) useDynLib(RMySQL,rmysql_result_valid) useDynLib(RMySQL,rmysql_version) RMySQL/NEWS.md0000644000176200001440000001234414751657155012463 0ustar liggesusers# Version 0.11.0 * Windows: use libmariadbclient from Rtools if found # Version 0.10.28 * Fix anchor link note for CRAN # Version 0.10.27 * Fix some printf warnings for CRAN # Version 0.10.26 * Windows: update libs with arm support * Drop CXX11 in Makevars.win # Version 0.10.25 * Replace sprintf with snprintf for CRAN # Version 0.10.24 * Fix strict-prototypes warnings # Version 0.10.23 * Windows: update to mariadb-connector-c 3.2.5. This new version still uses OpenSSL for R <= 4.1 but R 4.2 (ucrt) it switches to the new native Windows schannel TLS. # Version 0.10.22 * Windows: add support for UCRT builds # Version 0.10.21 * Windows: update to libmariadbclient 3.1.11 # Version 0.10.20 * Fixed improper escaping with dbQuoteString and dbQuoteLiteral, which can lead to SQL injection (Found by Nikolay Simakov and patched by Andrew Kane, CVE-2020-10380). # Version 0.10.19 * Fix new warning for CRAN * Small tweaks for configure script # Version 0.10.18 * MacOS: CRAN binaries have been updated to mariadb-connector-c to 3.1.6 # Version 0.10.17 * Fix rcheck problems requested by CRAN # Version 0.10.16 * Windows: Update mariadb-connector-c to v2.3.7 + OpenSSL 1.1.1 * MacOS: Update mariadb-connector-c to 3.0.8 * Fix for MySQL 8 (issue #223) # Version 0.10.15 * Windows: Update mariadbclient to v 2.3.5 # Version 0.10.14 * Windows: Update mariadbclient to v 2.3.4 * Fix headers and linker flags for mariadb-connector-c 3.0 compatibility * Remove some redundant include headers # Version 0.10.13 * Add cleanup script (requested by CRAN) * Fix PROTECT() bugs from rchk # Version 0.10.12 * Windows: update libmariadbclient to v2.3.3 (fixes a timeout bug) # Version 0.10.11 * Fix for OSX Mavericks # Version 0.10.10 * Window: update libmariadbclient to v2.3.2 * OSX: extract autobrew script # Version 0.10.9 * OSX binary packages for OSX now use mariadb-connector-c instead of mysql-connector-c * CMD check fix for DBI 0.4 # Version 0.10.8 * Replace #include S.h with R.h as required by BDR # Version 0.10.6 * Fix configure script for OSX # Version 0.10.5 * Refactor configure script * Fix for setInternet2 in R-devel on Windows # Version 0.10.4 * Fix dbWriteTable bug with MySQL-based Infobright database * Use mariadb_config if available * Properly import used utils functions # Version 0.10.3 * Fix the RPostgreSQL conflict * Remove the workaround for the bug in TSMySQL * Update URL to MariaDB client in DESCRIPTION # Version 0.10.2 * Backport fixes from Rcpp branch. * Configure script now uses `mysql_config` if available. * MariaDB windows libraries have been updated to 2.1.0 * Add SSL support to MariaDB windows libraries. # Version 0.10.1 * Fix configure script for OSX 10.6 Snow Leopard * Issue in `dbWriteTable()` with temporary files on Windows fixed. # Version 0.10 * New maintainer: Jeroen Ooms * Internal changes to support static linking on Windows; this means that windows a binary is now available on CRAN. * The following internal functions are no longer exported: please use the corresponding DBI generic instead: `mysqlInitDriver`, `mysqlCloseDriver`, `mysqlDescribeDriver`, `mysqlDriverInfo`, `mysqlNewConnection`, `mysqlCloneConnection`, `mysqlDescribeConnection`, `mysqlConnectionInfo`, `mysqlCloseConnection`, `mysqlExecStatement`, `mysqlQuickSQL`, `mysqlDBApply`, `mysqlFetch`, `mysqlResultInfo`, `mysqlDescribeResult`, `mysqlDescribeFields`, `mysqlCloseResult`, `mysqlImportFile`, `mysqlReadTable`, `mysqlWriteTable`, `mysqlEscapeStrings`, `mysqlDataType`, `safe.write`. * RMySQL gains transaction support with `dbBegin()`, `dbCommit()`, and `dbRollback()`, but note that MySQL does not allow data definition language statements to be rolled back. * The MySQLObject base class has been removed - there is no real shared behaviour for MySQLDriver, MySQLConnection and MySQLResult so this simplifies the code * Implemented methods for `dbIsValid()`; please use these instead of `isIdCurrent()`. * Implement `dbFetch()` method; please use this in preference to `fetch()`. `dbFetch()` now returns a 0-row data frame (instead of an 0-col data frame) if there are no results. * Methods no longer automatically close open result sets. This was implemented inconsistently in a handful of places. * `dbBuildTableDefinition()` has been renamed to `mysqlBuildTableDefinition()`. * `dbWriteTable()` has been rewritten: * It quotes field names using `dbQuoteIdentifier()`, rather than use a flawed black-list based approach with name munging. * It now throws errors on failure, rather than returning FALSE. * It will automatically add row names only if they are character, not integer. * When loading a file from disk, `dbWriteTable()` will no longer attempt to guess the correct values for `row.names` and `header` - instead supply them explicitly if the defaults are incorrect. * When given a zero-row data frame it will just creates the table definition. * Assorted fixes accumulated since last release 3 years ago. * `MySQL()` no longer has `force.reload` argument - it's not obvious that this ever worked. RMySQL/tools/0000755000176200001440000000000014751652206012511 5ustar liggesusersRMySQL/tools/winlibs.R0000644000176200001440000000171014751652206014302 0ustar liggesusersif(!file.exists("../windows/libssl/include/mysql.h")){ unlink("../windows", recursive = TRUE) url <- if(grepl("aarch", R.version$platform)){ "https://github.com/r-windows/bundles/releases/download/libmariadbclient-3.2.5/libmariadbclient-3.2.5-clang-aarch64.tar.xz" } else if(grepl("clang", Sys.getenv('R_COMPILED_BY'))){ "https://github.com/r-windows/bundles/releases/download/libmariadbclient-3.2.5/libmariadbclient-3.2.5-clang-x86_64.tar.xz" } else if(getRversion() >= "4.2") { "https://github.com/r-windows/bundles/releases/download/libmariadbclient-3.2.5/libmariadbclient-3.2.5-ucrt-x86_64.tar.xz" } else { "https://github.com/rwinlib/libmariadbclient/archive/v3.2.5.tar.gz" } download.file(url, basename(url), quiet = TRUE) dir.create("../windows", showWarnings = FALSE) untar(basename(url), exdir = "../windows", tar = 'internal') unlink(basename(url)) setwd("../windows") file.rename(list.files(), 'libmariadbclient') } RMySQL/configure0000755000176200001440000000577114751663331013273 0ustar liggesusers# Anticonf script by Jeroen Ooms (2020) # The script will try 'mariadb_config' and 'mysql_config' to find required # cflags and ldflags. Make sure this executable is in PATH when installing # the package. Alternatively, you can set INCLUDE_DIR and LIB_DIR manually: # R CMD INSTALL --configure-vars='INCLUDE_DIR=/.../include LIB_DIR=/.../lib' # Library settings PKG_DEB_NAME="libmariadbclient-dev | libmariadb-client-lgpl-dev" PKG_RPM_NAME="mariadb-connector-c-devel | mariadb-devel | mysql-devel" PKG_CSW_NAME="mysql56_dev" PKG_BREW_NAME="mariadb-connector-c" PKG_TEST_HEADER="" PKG_LIBS="-lmysqlclient" # Use mysql_config (on Solaris /opt/csw/bin must be in PATH) if [ `command -v mariadb_config` ]; then PKGCONFIG_CFLAGS=`mariadb_config --cflags` PKGCONFIG_LIBS=`mariadb_config --libs` elif [ `command -v mysql_config` ]; then PKGCONFIG_CFLAGS=`mysql_config --cflags` PKGCONFIG_LIBS=`mysql_config --libs` fi # Note that cflags may be empty in case of success if [ "$INCLUDE_DIR" ] || [ "$LIB_DIR" ]; then echo "Found INCLUDE_DIR and/or LIB_DIR!" PKG_CFLAGS="-I$INCLUDE_DIR $PKG_CFLAGS" PKG_LIBS="-L$LIB_DIR $PKG_LIBS" elif [ "$PKGCONFIG_CFLAGS" ] || [ "$PKGCONFIG_LIBS" ]; then echo "Found mysql_config cflags and libs!" PKG_CFLAGS=${PKGCONFIG_CFLAGS} PKG_LIBS=${PKGCONFIG_LIBS} # Workaround for homebrew linkin bug if [ `uname` = "Darwin" ]; then PKG_LIBS="-L/usr/local/opt/openssl/lib $PKG_LIBS" fi elif [ `uname` = "Darwin" ]; then test ! "$CI" && brew --version 2>/dev/null if [ $? -eq 0 ]; then BREWDIR=`brew --prefix` else curl -sfL "https://autobrew.github.io/scripts/$PKG_BREW_NAME" > autobrew . ./autobrew fi fi # Find compiler CC=`${R_HOME}/bin/R CMD config CC` CFLAGS=`${R_HOME}/bin/R CMD config CFLAGS` CPPFLAGS=`${R_HOME}/bin/R CMD config CPPFLAGS` # For debugging echo "Using PKG_CFLAGS=$PKG_CFLAGS" echo "Using PKG_LIBS=$PKG_LIBS" # Test configuration echo "#include $PKG_TEST_HEADER" | ${CC} ${CPPFLAGS} ${PKG_CFLAGS} ${CFLAGS} -E -xc - >/dev/null 2> configure.log # Customize the error if [ $? -ne 0 ]; then echo "-----------------------------[ ANTICONF ]-----------------------------" echo "Configure could not find suitable mysql/mariadb client library. Try installing:" echo " * deb: $PKG_DEB_NAME (Debian, Ubuntu)" echo " * rpm: $PKG_RPM_NAME (Fedora, CentOS, RHEL)" echo " * csw: $PKG_CSW_NAME (Solaris)" echo " * brew: $PKG_BREW_NAME (OSX)" echo "If you already have a mysql client library installed, verify that either" echo "mariadb_config or mysql_config is on your PATH. If these are unavailable" echo "you can also set INCLUDE_DIR and LIB_DIR manually via:" echo "R CMD INSTALL --configure-vars='INCLUDE_DIR=... LIB_DIR=...'" echo "--------------------------[ ERROR MESSAGE ]----------------------------" cat configure.log echo "-----------------------------------------------------------------------" exit 1 fi # Write to Makevars sed -e "s|@cflags@|$PKG_CFLAGS|" -e "s|@libs@|$PKG_LIBS|" src/Makevars.in > src/Makevars # Success exit 0 RMySQL/man/0000755000176200001440000000000014751652206012124 5ustar liggesusersRMySQL/man/db-meta.Rd0000644000176200001440000000210014751652206013715 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/connection.R \name{db-meta} \alias{db-meta} \alias{dbGetInfo,MySQLConnection-method} \alias{dbListResults,MySQLConnection-method} \alias{summary,MySQLConnection-method} \alias{dbGetException,MySQLConnection-method} \alias{show,MySQLConnection-method} \title{Database interface meta-data} \usage{ \S4method{dbGetInfo}{MySQLConnection}(dbObj, what = "", ...) \S4method{dbListResults}{MySQLConnection}(conn, ...) \S4method{summary}{MySQLConnection}(object, verbose = FALSE, ...) \S4method{dbGetException}{MySQLConnection}(conn, ...) \S4method{show}{MySQLConnection}(object) } \arguments{ \item{what}{optional} \item{...}{Other arguments for compatibility with generic.} \item{conn, dbObj, object}{MySQLConnection object.} \item{verbose}{If \code{TRUE}, add extra info.} } \description{ Database interface meta-data } \examples{ if (mysqlHasDefault()) { con <- dbConnect(RMySQL::MySQL(), dbname = "test") summary(con) dbGetInfo(con) dbListResults(con) dbListTables(con) dbDisconnect(con) } } RMySQL/man/make.db.names-MySQLConnection-character-method.Rd0000644000176200001440000000351414751652206023214 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/escaping.R \name{make.db.names,MySQLConnection,character-method} \alias{make.db.names,MySQLConnection,character-method} \alias{SQLKeywords,MySQLConnection-method} \alias{isSQLKeyword,MySQLConnection,character-method} \title{Make R/S-Plus identifiers into legal SQL identifiers} \usage{ \S4method{make.db.names}{MySQLConnection,character}( dbObj, snames, keywords = .SQL92Keywords, unique = TRUE, allow.keywords = TRUE, ... ) \S4method{SQLKeywords}{MySQLConnection}(dbObj, ...) \S4method{isSQLKeyword}{MySQLConnection,character}( dbObj, name, keywords = .MySQLKeywords, case = c("lower", "upper", "any")[3], ... ) } \arguments{ \item{dbObj}{any MySQL object (e.g., \code{MySQLDriver}).} \item{snames}{a character vector of R/S-Plus identifiers (symbols) from which we need to make SQL identifiers.} \item{keywords}{a character vector with SQL keywords, by default it is \code{.MySQLKeywords} define in \code{RMySQL}. This may be overriden by users.} \item{unique}{logical describing whether the resulting set of SQL names should be unique. Its default is \code{TRUE}. Following the SQL 92 standard, uniqueness of SQL identifiers is determined regardless of whether letters are upper or lower case.} \item{allow.keywords}{logical describing whether SQL keywords should be allowed in the resulting set of SQL names. Its default is \code{TRUE}} \item{...}{Unused, needed for compatibility with generic.} \item{name}{a character vector of SQL identifiers we want to check against keywords from the DBMS.} \item{case}{a character string specifying whether to make the comparison as lower case, upper case, or any of the two. it defaults to \code{any}.} } \description{ These methods are straight-forward implementations of the corresponding generic functions. } RMySQL/man/dbNextResult.Rd0000644000176200001440000000330114751652206015033 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/extension.R \name{dbNextResult} \alias{dbNextResult} \alias{dbNextResult,MySQLConnection-method} \alias{dbMoreResults} \alias{dbMoreResults,MySQLConnection-method} \title{Fetch next result set from an SQL script or stored procedure (experimental)} \usage{ dbNextResult(con, ...) \S4method{dbNextResult}{MySQLConnection}(con, ...) dbMoreResults(con, ...) \S4method{dbMoreResults}{MySQLConnection}(con, ...) } \arguments{ \item{con}{a connection object (see \code{\link[DBI]{dbConnect}}).} \item{...}{any additional arguments to be passed to the dispatched method} } \value{ \code{dbNextResult} returns a result set or \code{NULL}. \code{dbMoreResults} returns a logical specifying whether or not there are additional result sets to process in the connection. } \description{ SQL scripts (i.e., multiple SQL statements separated by ';') and stored procedures oftentimes generate multiple result sets. These generic functions provide a means to process them sequentially. \code{dbNextResult} fetches the next result from the sequence of pending results sets; \code{dbMoreResults} returns a logical to indicate whether there are additional results to process. } \examples{ if (mysqlHasDefault()) { con <- dbConnect(RMySQL::MySQL(), dbname = "test", client.flag = CLIENT_MULTI_STATEMENTS) dbWriteTable(con, "mtcars", datasets::mtcars, overwrite = TRUE) sql <- "SELECT cyl FROM mtcars LIMIT 5; SELECT vs FROM mtcars LIMIT 5" rs1 <- dbSendQuery(con, sql) dbFetch(rs1, n = -1) if (dbMoreResults(con)) { rs2 <- dbNextResult(con) dbFetch(rs2, n = -1) } dbClearResult(rs1) dbClearResult(rs2) dbRemoveTable(con, "mtcars") dbDisconnect(con) } } RMySQL/man/transactions.Rd0000644000176200001440000000211614751652206015123 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/transaction.R \name{transactions} \alias{transactions} \alias{dbCommit,MySQLConnection-method} \alias{dbBegin,MySQLConnection-method} \alias{dbRollback,MySQLConnection-method} \title{DBMS Transaction Management} \usage{ \S4method{dbCommit}{MySQLConnection}(conn, ...) \S4method{dbBegin}{MySQLConnection}(conn, ...) \S4method{dbRollback}{MySQLConnection}(conn, ...) } \arguments{ \item{conn}{a \code{MySQLConnection} object, as produced by \code{\link[DBI:dbConnect]{DBI::dbConnect()}}.} \item{...}{Unused.} } \description{ Commits or roll backs the current transaction in an MySQL connection. Note that in MySQL DDL statements (e.g. \code{CREATE TABLE}) can not be rolled back. } \examples{ if (mysqlHasDefault()) { con <- dbConnect(RMySQL::MySQL(), dbname = "test") df <- data.frame(id = 1:5) dbWriteTable(con, "df", df) dbBegin(con) dbGetQuery(con, "UPDATE df SET id = id * 10") dbGetQuery(con, "SELECT id FROM df") dbRollback(con) dbGetQuery(con, "SELECT id FROM df") dbRemoveTable(con, "df") dbDisconnect(con) } } RMySQL/man/dbReadTable.Rd0000644000176200001440000000427414751652206014553 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/table.R \name{dbReadTable,MySQLConnection,character-method} \alias{dbReadTable,MySQLConnection,character-method} \alias{dbListTables,MySQLConnection-method} \alias{dbExistsTable,MySQLConnection,character-method} \alias{dbRemoveTable,MySQLConnection,character-method} \alias{dbListFields,MySQLConnection,character-method} \title{Convenience functions for importing/exporting DBMS tables} \usage{ \S4method{dbReadTable}{MySQLConnection,character}(conn, name, row.names, check.names = TRUE, ...) \S4method{dbListTables}{MySQLConnection}(conn, ...) \S4method{dbExistsTable}{MySQLConnection,character}(conn, name, ...) \S4method{dbRemoveTable}{MySQLConnection,character}(conn, name, ...) \S4method{dbListFields}{MySQLConnection,character}(conn, name, ...) } \arguments{ \item{conn}{a \code{\linkS4class{MySQLConnection}} object, produced by \code{\link[DBI]{dbConnect}}} \item{name}{a character string specifying a table name.} \item{row.names}{A string or an index specifying the column in the DBMS table to use as \code{row.names} in the output data.frame. Defaults to using the \code{row_names} column if present. Set to \code{NULL} to never use row names.} \item{check.names}{If \code{TRUE}, the default, column names will be converted to valid R identifiers.} \item{...}{Unused, needed for compatiblity with generic.} } \value{ A data.frame in the case of \code{dbReadTable}; otherwise a logical indicating whether the operation was successful. } \description{ These functions mimic their R/S-Plus counterpart \code{get}, \code{assign}, \code{exists}, \code{remove}, and \code{objects}, except that they generate code that gets remotely executed in a database engine. } \note{ Note that the data.frame returned by \code{dbReadTable} only has primitive data, e.g., it does not coerce character data to factors. } \examples{ if (mysqlHasDefault()) { con <- dbConnect(RMySQL::MySQL(), dbname = "test") # By default, row names are written in a column to row_names, and # automatically read back into the row.names() dbWriteTable(con, "mtcars", mtcars[1:5, ], overwrite = TRUE) dbReadTable(con, "mtcars") dbReadTable(con, "mtcars", row.names = NULL) } } RMySQL/man/dbApply.Rd0000644000176200001440000000533214751652206014011 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/extension.R \name{dbApply} \alias{dbApply} \alias{dbApply,MySQLResult-method} \title{Apply R/S-Plus functions to remote groups of DBMS rows (experimental)} \usage{ dbApply(res, ...) \S4method{dbApply}{MySQLResult}( res, INDEX, FUN = stop("must specify FUN"), begin = NULL, group.begin = NULL, new.record = NULL, end = NULL, batchSize = 100, maxBatch = 1e+06, ..., simplify = TRUE ) } \arguments{ \item{res}{a result set (see \code{\link[DBI]{dbSendQuery}}).} \item{...}{any additional arguments to be passed to \code{FUN}.} \item{INDEX}{a character or integer specifying the field name or field number that defines the various groups.} \item{FUN}{a function to be invoked upon identifying the last row from every group. This function will be passed a data frame holding the records of the current group, a character string with the group label, plus any other arguments passed to \code{dbApply} as \code{"..."}.} \item{begin}{a function of no arguments to be invoked just prior to retrieve the first row from the result set.} \item{group.begin}{a function of one argument (the group label) to be invoked upon identifying a row from a new group} \item{new.record}{a function to be invoked as each individual record is fetched. The first argument to this function is a one-row data.frame holding the new record.} \item{end}{a function of no arguments to be invoked just after retrieving the last row from the result set.} \item{batchSize}{the default number of rows to bring from the remote result set. If needed, this is automatically extended to hold groups bigger than \code{batchSize}.} \item{maxBatch}{the absolute maximum of rows per group that may be extracted from the result set.} \item{simplify}{Not yet implemented} } \value{ A list with as many elements as there were groups in the result set. } \description{ Applies R/S-Plus functions to groups of remote DBMS rows without bringing an entire result set all at once. The result set is expected to be sorted by the grouping field. } \details{ This function is meant to handle somewhat gracefully(?) large amounts of data from the DBMS by bringing into R manageable chunks (about \code{batchSize} records at a time, but not more than \code{maxBatch}); the idea is that the data from individual groups can be handled by R, but not all the groups at the same time. } \examples{ if (mysqlHasDefault()) { con <- dbConnect(RMySQL::MySQL(), dbname = "test") dbWriteTable(con, "mtcars", mtcars, overwrite = TRUE) res <- dbSendQuery(con, "SELECT * FROM mtcars ORDER BY cyl") dbApply(res, "cyl", function(x, grp) quantile(x$mpg, names=FALSE)) dbClearResult(res) dbRemoveTable(con, "mtcars") dbDisconnect(con) } } RMySQL/man/dbEscapeStrings.Rd0000644000176200001440000000176514751652206015504 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/extension.R \name{dbEscapeStrings} \alias{dbEscapeStrings} \alias{dbEscapeStrings,MySQLConnection,character-method} \alias{dbEscapeStrings,MySQLResult,character-method} \title{Escape SQL-special characters in strings.} \usage{ dbEscapeStrings(con, strings, ...) \S4method{dbEscapeStrings}{MySQLConnection,character}(con, strings) \S4method{dbEscapeStrings}{MySQLResult,character}(con, strings, ...) } \arguments{ \item{con}{a connection object (see \code{\link[DBI]{dbConnect}}).} \item{strings}{a character vector.} \item{...}{any additional arguments to be passed to the dispatched method.} } \value{ A character vector with SQL special characters properly escaped. } \description{ Escape SQL-special characters in strings. } \examples{ if (mysqlHasDefault()) { con <- dbConnect(RMySQL::MySQL(), dbname = "test") tmp <- sprintf("SELECT * FROM emp WHERE lname = \%s", "O'Reilly") dbEscapeStrings(con, tmp) dbDisconnect(con) } } RMySQL/man/dbDataType-MySQLDriver-method.Rd0000644000176200001440000000132514751652206020032 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data-type.R \name{dbDataType,MySQLDriver-method} \alias{dbDataType,MySQLDriver-method} \alias{dbDataType,MySQLConnection-method} \title{Determine the SQL Data Type of an S object} \usage{ \S4method{dbDataType}{MySQLDriver}(dbObj, obj) \S4method{dbDataType}{MySQLConnection}(dbObj, obj) } \arguments{ \item{dbObj}{A \code{MySQLDriver} or \code{MySQLConnection}.} \item{obj}{R/S-Plus object whose SQL type we want to determine.} } \description{ This method is a straight-forward implementation of the corresponding generic function. } \examples{ dbDataType(RMySQL::MySQL(), "a") dbDataType(RMySQL::MySQL(), 1:3) dbDataType(RMySQL::MySQL(), 2.5) } RMySQL/man/query.Rd0000644000176200001440000000476114751652206013570 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/result.R \name{dbFetch,MySQLResult,numeric-method} \alias{dbFetch,MySQLResult,numeric-method} \alias{fetch,MySQLResult,numeric-method} \alias{dbFetch,MySQLResult,missing-method} \alias{fetch,MySQLResult,missing-method} \alias{dbSendQuery,MySQLConnection,character-method} \alias{dbClearResult,MySQLResult-method} \alias{dbGetInfo,MySQLResult-method} \alias{dbGetStatement,MySQLResult-method} \alias{dbListFields,MySQLResult,missing-method} \title{Execute a SQL statement on a database connection.} \usage{ \S4method{dbFetch}{MySQLResult,numeric}(res, n = -1, ...) \S4method{fetch}{MySQLResult,numeric}(res, n = -1, ...) \S4method{dbFetch}{MySQLResult,missing}(res, n = -1, ...) \S4method{fetch}{MySQLResult,missing}(res, n = -1, ...) \S4method{dbSendQuery}{MySQLConnection,character}(conn, statement, ...) \S4method{dbClearResult}{MySQLResult}(res, ...) \S4method{dbGetInfo}{MySQLResult}(dbObj, what = "", ...) \S4method{dbGetStatement}{MySQLResult}(res, ...) \S4method{dbListFields}{MySQLResult,missing}(conn, name, ...) } \arguments{ \item{res, dbObj}{A \code{\linkS4class{MySQLResult}} object.} \item{n}{maximum number of records to retrieve per fetch. Use \code{-1} to retrieve all pending records; use \code{0} for to fetch the default number of rows as defined in \code{\link{MySQL}}} \item{...}{Unused. Needed for compatibility with generic.} \item{conn}{an \code{\linkS4class{MySQLConnection}} object.} \item{statement}{a character vector of length one specifying the SQL statement that should be executed. Only a single SQL statment should be provided.} \item{what}{optional} \item{name}{Table name.} } \description{ To retrieve results a chunk at a time, use \code{dbSendQuery}, \code{dbFetch}, then \code{dbClearResult}. Alternatively, if you want all the results (and they'll fit in memory) use \code{dbGetQuery} which sends, fetches and clears for you. } \details{ \code{fetch()} will be deprecated in the near future; please use \code{dbFetch()} instead. } \examples{ if (mysqlHasDefault()) { con <- dbConnect(RMySQL::MySQL(), dbname = "test") dbWriteTable(con, "arrests", datasets::USArrests, overwrite = TRUE) # Run query to get results as dataframe dbGetQuery(con, "SELECT * FROM arrests limit 3") # Send query to pull requests in batches res <- dbSendQuery(con, "SELECT * FROM arrests") data <- dbFetch(res, n = 2) data dbHasCompleted(res) dbListResults(con) dbClearResult(res) dbRemoveTable(con, "arrests") dbDisconnect(con) } } RMySQL/man/MySQLResult-class.Rd0000644000176200001440000000051514751652206015663 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/result.R \docType{class} \name{MySQLResult-class} \alias{MySQLResult-class} \title{Class MySQLResult} \description{ MySQL's query results class. This classes encapsulates the result of an SQL statement (either \code{select} or not). } \keyword{internal} RMySQL/man/MySQLDriver-class.Rd0000644000176200001440000000311314751652206015635 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/driver.R \docType{class} \name{MySQLDriver-class} \alias{MySQLDriver-class} \alias{RMySQL-package} \alias{RMySQL} \alias{MySQL} \title{Class MySQLDriver with constructor MySQL.} \usage{ MySQL(max.con = 16, fetch.default.rec = 500) } \arguments{ \item{max.con}{maximum number of connections that can be open at one time. There's no intrinic limit, since strictly speaking this limit applies to MySQL \emph{servers}, but clients can have (at least in theory) more than this. Typically there are at most a handful of open connections, thus the internal \code{RMySQL} code uses a very simple linear search algorithm to manage its connection table.} \item{fetch.default.rec}{number of records to fetch at one time from the database. (The \code{\link[DBI]{fetch}} method uses this number as a default.)} } \description{ An MySQL driver implementing the R database (DBI) API. This class should always be initialized with the \code{MySQL()} function. It returns a singleton that allows you to connect to MySQL. } \examples{ if (mysqlHasDefault()) { # connect to a database and load some data con <- dbConnect(RMySQL::MySQL(), dbname = "test") dbWriteTable(con, "USArrests", datasets::USArrests, overwrite = TRUE) # query rs <- dbSendQuery(con, "SELECT * FROM USArrests") d1 <- dbFetch(rs, n = 10) # extract data in chunks of 10 rows dbHasCompleted(rs) d2 <- dbFetch(rs, n = -1) # extract all remaining data dbHasCompleted(rs) dbClearResult(rs) dbListTables(con) # clean up dbRemoveTable(con, "USArrests") dbDisconnect(con) } } RMySQL/man/mysqlClientLibraryVersions.Rd0000644000176200001440000000110414751652206017771 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/extension.R \name{mysqlClientLibraryVersions} \alias{mysqlClientLibraryVersions} \title{MySQL Check for Compiled Versus Loaded Client Library Versions} \usage{ mysqlClientLibraryVersions() } \value{ A named integer vector of length two, the first element representing the compiled library version and the second element representint the loaded client library version. } \description{ This function prints out the compiled and loaded client library versions. } \examples{ mysqlClientLibraryVersions() } RMySQL/man/mysqlBuildTableDefinition.Rd0000644000176200001440000000172014751652206017521 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/extension.R \name{mysqlBuildTableDefinition} \alias{mysqlBuildTableDefinition} \title{Build the SQL CREATE TABLE definition as a string} \usage{ mysqlBuildTableDefinition( dbObj, name, obj, field.types = NULL, row.names = TRUE, ... ) } \arguments{ \item{dbObj}{any DBI object (used only to dispatch according to the engine (e.g., MySQL, Oracle, PostgreSQL, SQLite)} \item{name}{name of the new SQL table} \item{obj}{an R object coerceable to data.frame for which we want to create a table} \item{field.types}{optional named list of the types for each field in \code{obj}} \item{row.names}{logical, should row.name of \code{value} be exported as a \code{row\_names} field? Default is TRUE} \item{\dots}{reserved for future use} } \value{ An SQL string } \description{ The output SQL statement is a simple \code{CREATE TABLE} with suitable for \code{dbGetQuery} } \keyword{internal} RMySQL/man/dbColumnInfo-MySQLConnection-method.Rd0000644000176200001440000000057714751652206021244 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/table.R \name{dbColumnInfo,MySQLConnection-method} \alias{dbColumnInfo,MySQLConnection-method} \title{Experimental dbColumnInfo method for a connection} \usage{ \S4method{dbColumnInfo}{MySQLConnection}(res, name, ...) } \description{ Experimental dbColumnInfo method for a connection } \keyword{internal} RMySQL/man/dbWriteTable.Rd0000644000176200001440000000575314751652206014775 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/table.R \name{dbWriteTable,MySQLConnection,character,data.frame-method} \alias{dbWriteTable,MySQLConnection,character,data.frame-method} \alias{dbWriteTable,MySQLConnection,character,character-method} \title{Write a local data frame or file to the database.} \usage{ \S4method{dbWriteTable}{MySQLConnection,character,data.frame}( conn, name, value, field.types = NULL, row.names = TRUE, overwrite = FALSE, append = FALSE, ..., allow.keywords = FALSE ) \S4method{dbWriteTable}{MySQLConnection,character,character}( conn, name, value, field.types = NULL, overwrite = FALSE, append = FALSE, header = TRUE, row.names = FALSE, nrows = 50, sep = ",", eol = "\\n", skip = 0, quote = "\\"", ... ) } \arguments{ \item{conn}{a \code{\linkS4class{MySQLConnection}} object, produced by \code{\link[DBI]{dbConnect}}} \item{name}{a character string specifying a table name.} \item{value}{a data.frame (or coercible to data.frame) object or a file name (character). In the first case, the data.frame is written to a temporary file and then imported to SQLite; when \code{value} is a character, it is interpreted as a file name and its contents imported to SQLite.} \item{field.types}{character vector of named SQL field types where the names are the names of new table's columns. If missing, types inferred with \code{\link[DBI]{dbDataType}}).} \item{row.names}{A logical specifying whether the \code{row.names} should be output to the output DBMS table; if \code{TRUE}, an extra field whose name will be whatever the R identifier \code{"row.names"} maps to the DBMS (see \code{\link[DBI]{make.db.names}}). If \code{NA} will add rows names if they are characters, otherwise will ignore.} \item{overwrite}{a logical specifying whether to overwrite an existing table or not. Its default is \code{FALSE}. (See the BUGS section below)} \item{append}{a logical specifying whether to append to an existing table in the DBMS. Its default is \code{FALSE}.} \item{...}{Unused, needs for compatibility with generic.} \item{allow.keywords}{logical indicating whether column names that happen to be MySQL keywords be used as column names in the resulting relation (table) being written. Defaults to FALSE, forcing mysqlWriteTable to modify column names to make them legal MySQL identifiers.} \item{header}{logical, does the input file have a header line? Default is the same heuristic used by \code{read.table}, i.e., \code{TRUE} if the first line has one fewer column that the second line.} \item{nrows}{number of lines to rows to import using \code{read.table} from the input file to create the proper table definition. Default is 50.} \item{sep}{field separator character} \item{eol}{End-of-line separator} \item{skip}{number of lines to skip before reading data in the input file.} \item{quote}{the quote character used in the input file (defaults to \code{\"}.)} } \description{ Write a local data frame or file to the database. } RMySQL/man/mysqlHasDefault.Rd0000644000176200001440000000105614751652206015523 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/default.R \name{mysqlHasDefault} \alias{mysqlHasDefault} \title{Check if default database is available.} \usage{ mysqlHasDefault() } \description{ RMySQL examples and tests connect to a database defined by the \code{rs-dbi} group in \code{~/.my.cnf}. This function checks if that database is available, and if not, displays an informative message. } \examples{ if (mysqlHasDefault()) { db <- dbConnect(RMySQL::MySQL(), dbname = "test") dbListTables(db) dbDisconnect(db) } } RMySQL/man/dbQuoteIdentifier-MySQLConnection-character-method.Rd0000644000176200001440000000065714751652206024224 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/extension.R \name{dbQuoteIdentifier,MySQLConnection,character-method} \alias{dbQuoteIdentifier,MySQLConnection,character-method} \title{Quote method for MySQL identifiers} \usage{ \S4method{dbQuoteIdentifier}{MySQLConnection,character}(conn, x, ...) } \description{ In MySQL, identifiers are enclosed in backticks, e.g. \code{`x`}. } \keyword{internal} RMySQL/man/dbUnloadDriver-MySQLDriver-method.Rd0000644000176200001440000000075414751652206020722 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/driver.R \name{dbUnloadDriver,MySQLDriver-method} \alias{dbUnloadDriver,MySQLDriver-method} \title{Unload MySQL driver.} \usage{ \S4method{dbUnloadDriver}{MySQLDriver}(drv, ...) } \arguments{ \item{drv}{Object created by \code{\link{MySQL}}.} \item{...}{Ignored. Needed for compatibility with generic.} } \value{ A logical indicating whether the operation succeeded or not. } \description{ Unload MySQL driver. } RMySQL/man/dbGetInfo-MySQLDriver-method.Rd0000644000176200001440000000157714751652206017663 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/driver.R \name{dbGetInfo,MySQLDriver-method} \alias{dbGetInfo,MySQLDriver-method} \alias{dbListConnections,MySQLDriver-method} \alias{summary,MySQLDriver-method} \alias{show,MySQLDriver-method} \title{Get information about a MySQL driver.} \usage{ \S4method{dbGetInfo}{MySQLDriver}(dbObj, what = "", ...) \S4method{dbListConnections}{MySQLDriver}(drv, ...) \S4method{summary}{MySQLDriver}(object, verbose = FALSE, ...) \S4method{show}{MySQLDriver}(object) } \arguments{ \item{dbObj, object, drv}{Object created by \code{\link{MySQL}}.} \item{what}{Optional} \item{...}{Ignored. Needed for compatibility with generic.} \item{verbose}{If \code{TRUE}, print extra info.} } \description{ Get information about a MySQL driver. } \examples{ db <- RMySQL::MySQL() db dbGetInfo(db) dbListConnections(db) summary(db) } RMySQL/man/dbConnect-MySQLDriver-method.Rd0000644000176200001440000000524214751652206017712 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/connection.R \name{dbConnect,MySQLDriver-method} \alias{dbConnect,MySQLDriver-method} \alias{dbConnect,MySQLConnection-method} \alias{dbDisconnect,MySQLConnection-method} \title{Connect/disconnect to a MySQL DBMS} \usage{ \S4method{dbConnect}{MySQLDriver}( drv, dbname = NULL, username = NULL, password = NULL, host = NULL, unix.socket = NULL, port = 0, client.flag = 0, groups = "rs-dbi", default.file = NULL, ... ) \S4method{dbConnect}{MySQLConnection}(drv, ...) \S4method{dbDisconnect}{MySQLConnection}(conn, ...) } \arguments{ \item{drv}{an object of class \code{MySQLDriver}, or the character string "MySQL" or an \code{MySQLConnection}.} \item{dbname}{string with the database name or NULL. If not NULL, the connection sets the default daabase to this value.} \item{username, password}{Username and password. If username omitted, defaults to the current user. If password is ommitted, only users without a password can log in.} \item{host}{string identifying the host machine running the MySQL server or NULL. If NULL or the string \code{"localhost"}, a connection to the local host is assumed.} \item{unix.socket}{(optional) string of the unix socket or named pipe.} \item{port}{(optional) integer of the TCP/IP default port.} \item{client.flag}{(optional) integer setting various MySQL client flags. See the MySQL manual for details.} \item{groups}{string identifying a section in the \code{default.file} to use for setting authentication parameters (see \code{\link{MySQL}}).} \item{default.file}{string of the filename with MySQL client options. Defaults to \code{\$HOME/.my.cnf}} \item{...}{Unused, needed for compatibility with generic.} \item{conn}{an \code{MySQLConnection} object as produced by \code{dbConnect}.} } \description{ These methods are straight-forward implementations of the corresponding generic functions. } \examples{ \dontrun{ # Connect to a MySQL database running locally con <- dbConnect(RMySQL::MySQL(), dbname = "mydb") # Connect to a remote database with username and password con <- dbConnect(RMySQL::MySQL(), host = "mydb.mycompany.com", user = "abc", password = "def") # But instead of supplying the username and password in code, it's usually # better to set up a group in your .my.cnf (usually located in your home directory). Then it's less likely you'll inadvertently share them. con <- dbConnect(RMySQL::MySQL(), group = "test") # Always cleanup by disconnecting the database dbDisconnect(con) } # All examples use the rs-dbi group by default. if (mysqlHasDefault()) { con <- dbConnect(RMySQL::MySQL(), dbname = "test") summary(con) dbDisconnect(con) } } RMySQL/man/MySQLConnection-class.Rd0000644000176200001440000000047414751652206016510 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/connection.R \docType{class} \name{MySQLConnection-class} \alias{MySQLConnection-class} \title{Class MySQLConnection.} \description{ \code{MySQLConnection.} objects are usually created by \code{\link[DBI]{dbConnect}} } \keyword{internal} RMySQL/man/isIdCurrent.Rd0000644000176200001440000000225614751652206014653 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/is-valid.R \name{isIdCurrent} \alias{isIdCurrent} \alias{dbIsValid,MySQLDriver-method} \alias{dbIsValid,MySQLConnection-method} \alias{dbIsValid,MySQLResult-method} \title{Check if a database object is valid.} \usage{ isIdCurrent(obj) \S4method{dbIsValid}{MySQLDriver}(dbObj) \S4method{dbIsValid}{MySQLConnection}(dbObj) \S4method{dbIsValid}{MySQLResult}(dbObj) } \arguments{ \item{dbObj, obj}{A \code{MysqlDriver}, \code{MysqlConnection}, \code{MysqlResult}.} } \value{ a logical scalar. } \description{ Support function that verifies that an object holding a reference to a foreign object is still valid for communicating with the RDBMS. \code{isIdCurrent} will be deprecated in the near future; please use the \code{\link[DBI]{dbIsValid}()} generic instead. } \details{ \code{dbObjects} are R/S-Plus remote references to foreign objects. This introduces differences to the object's semantics such as persistence (e.g., connections may be closed unexpectedly), thus this function provides a minimal verification to ensure that the foreign object being referenced can be contacted. } \examples{ dbIsValid(MySQL()) } RMySQL/man/constants.Rd0000644000176200001440000000165514751652206014436 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/mysql.R \name{constants} \alias{constants} \alias{.MySQLPkgName} \alias{.MySQLPkgVersion} \alias{.MySQLPkgRCS} \alias{.MySQLSQLKeywords} \alias{CLIENT_LONG_PASSWORD} \alias{CLIENT_FOUND_ROWS} \alias{CLIENT_LONG_FLAG} \alias{CLIENT_CONNECT_WITH_DB} \alias{CLIENT_NO_SCHEMA} \alias{CLIENT_COMPRESS} \alias{CLIENT_ODBC} \alias{CLIENT_LOCAL_FILES} \alias{CLIENT_IGNORE_SPACE} \alias{CLIENT_PROTOCOL_41} \alias{CLIENT_INTERACTIVE} \alias{CLIENT_SSL} \alias{CLIENT_IGNORE_SIGPIPE} \alias{CLIENT_TRANSACTIONS} \alias{CLIENT_RESERVED} \alias{CLIENT_SECURE_CONNECTION} \alias{CLIENT_MULTI_STATEMENTS} \alias{CLIENT_MULTI_RESULTS} \title{Constants} \description{ Constants } \section{Constants}{ \code{.MySQLPkgName} (currently \code{"RMySQL"}), \code{.MySQLPkgVersion} (the R package version), \code{.MySQLPkgRCS} (the RCS revision), \code{.MySQLSQLKeywords} (a lot!) } RMySQL/man/result-meta.Rd0000644000176200001440000000262314751652206014660 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/result.R \name{result-meta} \alias{result-meta} \alias{dbColumnInfo,MySQLResult-method} \alias{dbGetRowsAffected,MySQLResult-method} \alias{dbGetRowCount,MySQLResult-method} \alias{dbHasCompleted,MySQLResult-method} \alias{dbGetException,MySQLResult-method} \alias{summary,MySQLResult-method} \alias{show,MySQLResult-method} \title{Database interface meta-data.} \usage{ \S4method{dbColumnInfo}{MySQLResult}(res, ...) \S4method{dbGetRowsAffected}{MySQLResult}(res, ...) \S4method{dbGetRowCount}{MySQLResult}(res, ...) \S4method{dbHasCompleted}{MySQLResult}(res, ...) \S4method{dbGetException}{MySQLResult}(conn, ...) \S4method{summary}{MySQLResult}(object, verbose = FALSE, ...) \S4method{show}{MySQLResult}(object) } \arguments{ \item{res, conn, object}{An object of class \code{\linkS4class{MySQLResult}}} \item{...}{Ignored. Needed for compatibility with generic} \item{verbose}{If \code{TRUE}, print extra information.} } \description{ See documentation of generics for more details. } \examples{ if (mysqlHasDefault()) { con <- dbConnect(RMySQL::MySQL(), dbname = "test") dbWriteTable(con, "t1", datasets::USArrests, overwrite = TRUE) rs <- dbSendQuery(con, "SELECT * FROM t1 WHERE UrbanPop >= 80") dbGetStatement(rs) dbHasCompleted(rs) dbGetInfo(rs) dbColumnInfo(rs) dbClearResult(rs) dbRemoveTable(con, "t1") dbDisconnect(con) } } RMySQL/DESCRIPTION0000644000176200001440000000314214751667432013066 0ustar liggesusersPackage: RMySQL Version: 0.11.0 Title: Database Interface and 'MySQL' Driver for R Description: Legacy 'DBI' interface to 'MySQL' / 'MariaDB' based on old code ported from S-PLUS. A modern 'MySQL' client written in 'C++' is available from the 'RMariaDB' package. Authors@R: c(person("Jeroen", "Ooms", email = "jeroenooms@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-4035-0289")), person("David", "James", role = "aut"), person("Saikat", "DebRoy", role = "aut"), person("Hadley", "Wickham", email = "hadley@rstudio.com", role = "aut"), person("Jeffrey", "Horner", role = "aut"), person("RStudio", role = "cph")) Depends: R (>= 2.8.0), DBI (>= 0.4) Imports: methods License: GPL-2 URL: https://r-dbi.r-universe.dev/RMySQL https://downloads.mariadb.org/connector-c/ BugReports: https://github.com/r-dbi/rmysql/issues SystemRequirements: libmariadb-client-dev | libmariadb-client-lgpl-dev | libmysqlclient-dev (deb), mariadb-devel (rpm), mariadb | mysql-connector-c (brew), mysql56_dev (csw) NeedsCompilation: yes Collate: 'mysql.R' 'driver.R' 'connection.R' 'data-type.R' 'default.R' 'escaping.R' 'result.R' 'extension.R' 'is-valid.R' 'table.R' 'transaction.R' Suggests: testthat, curl RoxygenNote: 7.3.2.9000 Packaged: 2025-02-08 14:14:49 UTC; jeroen Author: Jeroen Ooms [aut, cre] (), David James [aut], Saikat DebRoy [aut], Hadley Wickham [aut], Jeffrey Horner [aut], RStudio [cph] Maintainer: Jeroen Ooms Repository: CRAN Date/Publication: 2025-02-08 14:50:02 UTC