Changeset: 7e77fb3c3551 for MonetDB URL: http://dev.monetdb.org/hg/MonetDB?cmd=changeset;node=7e77fb3c3551 Modified Files: clients/R/MonetDB.R/NEWS clients/R/MonetDB.R/R/control.R clients/R/MonetDB.R/R/monetdb.R Branch: default Log Message:
R Connector: Some reorganization and IPv6 addressing support diffs (truncated from 551 to 300 lines): diff --git a/clients/R/MonetDB.R/NEWS b/clients/R/MonetDB.R/NEWS --- a/clients/R/MonetDB.R/NEWS +++ b/clients/R/MonetDB.R/NEWS @@ -8,6 +8,7 @@ 0.9.2 schema name and quoting in the result (sys_tables, schema_names and quote) - fixed various TODO's in the code to get closer to 1.0 (exciting) - fixed a bug when the error identifier sent by MonetDB was non-numeric +- IPv6 addresses in dbConnect() should now work (another long-standing TODO) 0.9.1 - dbGetInfo() now supported on MonetDBConnection (dplyr compatibility) diff --git a/clients/R/MonetDB.R/R/control.R b/clients/R/MonetDB.R/R/control.R --- a/clients/R/MonetDB.R/R/control.R +++ b/clients/R/MonetDB.R/R/control.R @@ -223,4 +223,47 @@ monetdb.server.setup <- } # return the filepath to the batch file bfl - } \ No newline at end of file + } + + +monetdbd.liststatus <- monetdb.liststatus <- function(passphrase, host="localhost", port=50000L, + timeout=86400L) { + + rawstr <- .monetdbd.command(passphrase, host, port, timeout) + lines <- strsplit(rawstr, "\n", fixed=T)[[1]] # split by newline, first line is "=OK", so skip + lines <- lines[grepl("^=sabdb:2:", lines)] # make sure we get a db list here, protocol v.2 + lines <- sub("=sabdb:2:", "", lines, fixed=T) + # convert value into propert types etc + dbdf <- as.data.frame(do.call("rbind", strsplit(lines, ", ", fixed=T)), stringsAsFactors=F) + names(dbdf) <- c("dbname", "uri", "locked", "state", "scenarios", "startCounter", "stopCounter", + "crashCounter", "avgUptime", "maxUptime", "minUptime", "lastCrash", "lastStart", "lastStop", + "crashAvg1", "crashAvg10", "crashAvg30") + + dbdf$locked <- dbdf$locked=="1" + + states <- c("illegal", "running", "crashed", "inactive", "starting") + dbdf$state <- factor(states[as.integer(dbdf$state)+1]) + + dbdf$startCounter <- as.numeric(dbdf$startCounter) + dbdf$stopCounter <- as.numeric(dbdf$stopCounter) + dbdf$crashCounter <- as.numeric(dbdf$crashCounter) + + dbdf$avgUptime <- as.numeric(dbdf$avgUptime) + dbdf$maxUptime <- as.numeric(dbdf$maxUptime) + dbdf$minUptime <- as.numeric(dbdf$minUptime) + + convertts <- function(col) { + col[col=="-1"] <- NA + return(as.POSIXct(as.numeric(col), origin="1970-01-01")) + } + dbdf$lastCrash <- convertts(dbdf$lastCrash) + dbdf$lastStart <- convertts(dbdf$lastStart) + dbdf$lastStop <- convertts(dbdf$lastStop) + + dbdf$crashAvg1 <- dbdf$crashAvg1=="1" + dbdfcrashAvg10 <- as.numeric(dbdf$crashAvg10) + dbdf$crashAvg30 <- as.numeric(dbdf$crashAvg30) + dbdf$scenarios <- gsub("'", ", ", dbdf$scenarios, fixed=T) + + return(dbdf[order(dbdf$dbname), ]) +} \ No newline at end of file diff --git a/clients/R/MonetDB.R/R/monetdb.R b/clients/R/MonetDB.R/R/monetdb.R --- a/clients/R/MonetDB.R/R/monetdb.R +++ b/clients/R/MonetDB.R/R/monetdb.R @@ -29,7 +29,7 @@ setMethod("dbGetInfo", "MonetDBDriver", # shorthand for connecting to the DB, very handy, e.g. dbListTables(mc("acs")) mc <- function(dbname="demo", user="monetdb", password="monetdb", host="localhost", port=50000L, - timeout=86400L, wait=FALSE, language="sql", ...) { + timeout=86400L, wait=FALSE, language="sql", ...) { dbConnect(MonetDB.R(), dbname, user, password, host, port, timeout, wait, language, ...) } @@ -42,8 +42,8 @@ mq <- function(dbname, query, ...) { } setMethod("dbConnect", "MonetDBDriver", def=function(drv, dbname="demo", user="monetdb", - password="monetdb", host="localhost", port=50000L, timeout=86400L, wait=FALSE, language="sql", - ..., url="") { + password="monetdb", host="localhost", port=50000L, timeout=86400L, wait=FALSE, language="sql", + ..., url="") { if (substring(url, 1, 10) == "monetdb://") { dbname <- url @@ -53,26 +53,43 @@ setMethod("dbConnect", "MonetDBDriver", if (substring(dbname, 1, 10) == "monetdb://") { message("MonetDB.R: Using 'monetdb://...' URIs in dbConnect() is deprecated. Please switch to ", - "dbname, host, port named arguments.") + "dbname, host, port named arguments.") rest <- substring(dbname, 11, nchar(dbname)) # split at /, so we get the dbname slashsplit <- strsplit(rest, "/", fixed=TRUE) hostport <- slashsplit[[1]][1] dbname <- slashsplit[[1]][2] - # TODO: handle IPv6 IPs, they contain : chars, later - if (length(grep(":", hostport, fixed=TRUE)) == 1) { + # count the number of : in the string + ndc <- nchar(hostport) - nchar(gsub(":","",hostport,fixed=T)) + if (ndc == 0) { + host <- hostport + } + if (ndc == 1) { # ipv4 case, any ipv6 address has more than one : hostportsplit <- strsplit(hostport, ":", fixed=TRUE) host <- hostportsplit[[1]][1] port <- hostportsplit[[1]][2] - } else { - host <- hostport + } + if (ndc > 1) { # ipv6 case, now we only need to check for ]: + if (length(grep("]:", hostport, fixed=TRUE)) == 1) { # ipv6 with port number + hostportsplit <- strsplit(hostport, "]:", fixed=TRUE) + host <- substring(hostportsplit[[1]][1],2) + port <- hostportsplit[[1]][2] + } + else { + host <- hostport + } } } + # validate port number + if (length(port) != 1 || port < 1 || port > 65535) { + stop("Illegal port number ",port) + } + if (getOption("monetdb.debug.mapi", F)) message("II: Connecting to MonetDB on host ", host, " at " - ,"port ", port, " to DB ", dbname, " with user ", user, " and a non-printed password, timeout is " - , timeout, " seconds.") + ,"port ", port, " to DB ", dbname, " with user ", user, " and a non-printed password, timeout is " + , timeout, " seconds.") socket <- FALSE if (wait) { repeat { @@ -117,7 +134,7 @@ valueClass="MonetDBConnection") ### MonetDBConnection setClass("MonetDBConnection", representation("DBIConnection", socket="externalptr", - connenv="environment", fetchSize="integer", Id="integer")) + connenv="environment", fetchSize="integer", Id="integer")) setMethod("dbGetInfo", "MonetDBConnection", def=function(dbObj, ...) { envdata <- dbGetQuery(dbObj, "SELECT name, value from env()") @@ -190,78 +207,78 @@ setMethod("dbReadTable", "MonetDBConnect }) setMethod("dbGetQuery", signature(conn="MonetDBConnection", statement="character"), - def=function(conn, statement, ...) { - - res <- dbSendQuery(conn, statement, ...) - data <- fetch(res, -1) - dbClearResult(res) - return(data) -}) + def=function(conn, statement, ...) { + + res <- dbSendQuery(conn, statement, ...) + data <- fetch(res, -1) + dbClearResult(res) + return(data) + }) # This one does all the work in this class setMethod("dbSendQuery", signature(conn="MonetDBConnection", statement="character"), - def=function(conn, statement, ..., list=NULL, async=FALSE) { - - if(!is.null(list) || length(list(...))){ - if (length(list(...))) statement <- .bindParameters(statement, list(...)) - if (!is.null(list)) statement <- .bindParameters(statement, list) - } - conn@connenv$exception <- list() - env <- NULL - if (getOption("monetdb.debug.query", F)) message("QQ: '", statement, "'") - resp <- .mapiParseResponse(.mapiRequest(conn, paste0("s", statement, ";"), async=async)) - - env <- new.env(parent=emptyenv()) - - if (resp$type == Q_TABLE) { - # we have to pass this as an environment to make conn object available to result for fetching - env$success = TRUE - env$conn <- conn - env$data <- resp$tuples - resp$tuples <- NULL # clean up - env$info <- resp - env$delivered <- 0 - env$query <- statement - } - if (resp$type == Q_UPDATE || resp$type == Q_CREATE || resp$type == MSG_ASYNC_REPLY) { - env$success = TRUE - env$conn <- conn - env$query <- statement - env$info <- resp - } - if (resp$type == MSG_MESSAGE) { - env$success = FALSE - env$conn <- conn - env$query <- statement - env$info <- resp - env$message <- resp$message - } - - if (!env$success) { - sp <- strsplit(env$message, "!", fixed=T)[[1]] - # truncate statement to not hide actual error message - if (nchar(statement) > 100) { statement <- paste0(substring(statement, 1, 100), "...") } - if (length(sp) == 3) { - errno <- sp[[2]] - errmsg <- sp[[3]] - conn@connenv$exception <- list(errNum=errno, errMsg=errmsg) - stop("Unable to execute statement '", statement, "'.\nServer says '", errmsg, "' [#", - errno, "].") - } - else { - conn@connenv$exception <- list(errNum=NA, errMsg=env$message) - stop("Unable to execute statement '", statement, "'.\nServer says '", env$message, "'.") - } - } - - return(new("MonetDBResult", env=env)) -}) + def=function(conn, statement, ..., list=NULL, async=FALSE) { + + if(!is.null(list) || length(list(...))){ + if (length(list(...))) statement <- .bindParameters(statement, list(...)) + if (!is.null(list)) statement <- .bindParameters(statement, list) + } + conn@connenv$exception <- list() + env <- NULL + if (getOption("monetdb.debug.query", F)) message("QQ: '", statement, "'") + resp <- .mapiParseResponse(.mapiRequest(conn, paste0("s", statement, ";"), async=async)) + + env <- new.env(parent=emptyenv()) + + if (resp$type == Q_TABLE) { + # we have to pass this as an environment to make conn object available to result for fetching + env$success = TRUE + env$conn <- conn + env$data <- resp$tuples + resp$tuples <- NULL # clean up + env$info <- resp + env$delivered <- 0 + env$query <- statement + } + if (resp$type == Q_UPDATE || resp$type == Q_CREATE || resp$type == MSG_ASYNC_REPLY) { + env$success = TRUE + env$conn <- conn + env$query <- statement + env$info <- resp + } + if (resp$type == MSG_MESSAGE) { + env$success = FALSE + env$conn <- conn + env$query <- statement + env$info <- resp + env$message <- resp$message + } + + if (!env$success) { + sp <- strsplit(env$message, "!", fixed=T)[[1]] + # truncate statement to not hide actual error message + if (nchar(statement) > 100) { statement <- paste0(substring(statement, 1, 100), "...") } + if (length(sp) == 3) { + errno <- sp[[2]] + errmsg <- sp[[3]] + conn@connenv$exception <- list(errNum=errno, errMsg=errmsg) + stop("Unable to execute statement '", statement, "'.\nServer says '", errmsg, "' [#", + errno, "].") + } + else { + conn@connenv$exception <- list(errNum=NA, errMsg=env$message) + stop("Unable to execute statement '", statement, "'.\nServer says '", env$message, "'.") + } + } + + return(new("MonetDBResult", env=env)) + }) # adapted from RMonetDB, very useful... setMethod("dbWriteTable", "MonetDBConnection", def=function(conn, name, value, overwrite=TRUE, - ...) { - + ...) { + if (is.vector(value) && !is.list(value)) value <- data.frame(x=value) if (length(value)<1) stop("value must have at least one column") if (is.null(names(value))) names(value) <- paste("V", 1:length(value), sep='') @@ -284,7 +301,7 @@ setMethod("dbWriteTable", "MonetDBConnec if (length(value[[1]])) { inss <- paste("INSERT INTO ", qname, " VALUES(", paste(rep("?", length(value)), collapse=', '), - ")", sep='') + ")", sep='') .mapiRequest(conn, "Xauto_commit 0") for (j in 1:length(value[[1]])) dbSendUpdate(conn, inss, list=as.list(value[j, ])) _______________________________________________ checkin-list mailing list checkin-list@monetdb.org https://www.monetdb.org/mailman/listinfo/checkin-list