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

Reply via email to