Merge pull request #2 from ralmond/NoMongo

No mongo

Author: ralmond

.gitignore

@@ -0,0 +1,3 @@
+*~
+
+makeDBuri.Rd~

ChangeLog

@@ -1,3 +1,29 @@
+2020-04-04  Russell Almond  <ralmond@Cherry>
+
+	* R/Message.R (markAsProcessed): stupid missing ! causing infinite
+	loop.  Fixed test to die on excessive loops.
+
+2020-03-17  Russell Almond  <ralmond@Cherry>
+
+	* R/Message.R (makeDBuri): Moved this code here as it seems to be
+	used just about every time we make a mongo connetion.
+	(makeDBuri): Added protocol arguement
+
+	* R/Listeners.R (ListenerSet): Added trap for blank URI to make
+	no-Mongo version.
+
+2020-02-19  Russell Almond  <ralmond@Cherry>
+
+	* R/Message.R (ununboxer): using sapply instead of lapply in
+	ununboxer causes it to simplify lists of length one in strange
+	ways.  Can I change sapply to lapply here?  NO.  This breaks lots
+	of other things.
+
+2020-02-12  Rusell Almond  <ralmond@Cherry>
+
+	* R/Message.R (saveRec, markAsProcessed, markAsError): Changed so
+	that these would not save if the col argument is NULL.
+
 2019-12-20  Rusell Almond  <ralmond@Cherry>
 
 	* R/Message.R (markAsError): Added " to ' conversion to error

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: Proc4
-Version: 0.4-6
-Date: 2019/12/20
+Version: 0.4-7
+Date: 2020/03/17
 Title: Four Process Assessment Database and Dispatcher
 Author: Russell Almond
 Maintainer: Russell Almond <[email protected]>

NAMESPACE

@@ -9,7 +9,8 @@ importFrom("utils", "limitedLabels")
 export(P4Message)
 exportClasses(P4Message)
 export(m_id,app,uid,context,timestamp,sender,mess,details,all.equal.P4Message,
-       processed, markAsProcessed, processingError, markAsError)
+       processed, markAsProcessed, processingError, markAsError,
+       makeDBuri)
 exportMethods(m_id,app,uid,context,timestamp,sender,mess,details,
               toString,show, processed, processingError)
 
@@ -22,8 +23,9 @@ exportMethods(as.json,as.jlist)
 export(receiveMessage,isListener,ListenerSet,notifyListeners,
        InjectionListener,UpdateListener,UpsertListener,CaptureListener,
        TableListener)
-exportClasses(ListenerSet,MongoDB,CaptureListener, InjectionListener,
-              UpdateListener,UpsertListener,TableListener,name)
+exportClasses(ListenerSet,MongoDB,CaptureListener,
+       InjectionListener,
+       UpdateListener,UpsertListener,TableListener,name)
 exportMethods(isListener,receiveMessage,notifyListeners,name)
 
 export(withFlogging)

R/Listeners.R

@@ -379,7 +379,8 @@ ListenerSet <-
                     function(sender="sender",
                              dbname="test",
                              dburi="mongodb://localhost",
-                             listeners=list(),colname="Messages",
+                             listeners=list(),
+                             colname="Messages",
                              ...) {
                       callSuper(sender=sender,db=NULL,
                                 dburi=dburi,dbname=dbname,
@@ -392,7 +393,7 @@ ListenerSet <-
 ## Listener/Message Methods
 ListenerSet$methods(
                 messdb = function () {
-                  if (is.null(db)) {
+                  if (is.null(db) && nchar(dburi) > 0L) {
                     db <<- mongo(colname,dbname,dburi)
                   }
                   db

R/Message.R

@@ -100,42 +100,54 @@ setMethod("as.jlist",c("P4Message","list"), function(obj,ml,serialize=TRUE) {
   })
 
 saveRec <- function (mess, col, serialize=TRUE) {
-  jso <- as.json(mess,serialize)
-  if (is.na(mess@"_id")) {
-    ## Insert
-    col$insert(jso)
-    it <- col$iterate(jso,'{"_id":true}',limit=1)
-    mess@"_id" <- it$one()$"_id"
-    names(mess@"_id") <- "oid" ## Aids in extraction
-  } else {
-    if (col$count(paste('{"_id":{"$oid":"',mess@"_id",'"}}',sep=""))) {
-      ## Replace
-      col$update(paste('{"_id":{"$oid":"',mess@"_id",'"}}',sep=""),
-                 paste('{"$set":',jso,'}',sep=""))
-    } else {
-      ## ID is out of date, insert and get new ID.
+  if (!is.null(col)) {
+    jso <- as.json(mess,serialize)
+    if (is.na(mess@"_id")) {
+      ## Insert
       col$insert(jso)
       it <- col$iterate(jso,'{"_id":true}',limit=1)
       mess@"_id" <- it$one()$"_id"
       names(mess@"_id") <- "oid" ## Aids in extraction
+    } else {
+      if (col$count(paste('{"_id":{"$oid":"',mess@"_id",'"}}',sep=""))) {
+        ## Replace
+        col$update(paste('{"_id":{"$oid":"',mess@"_id",'"}}',sep=""),
+                   paste('{"$set":',jso,'}',sep=""))
+      } else {
+        ## ID is out of date, insert and get new ID.
+        col$insert(jso)
+        it <- col$iterate(jso,'{"_id":true}',limit=1)
+        mess@"_id" <- it$one()$"_id"
+        names(mess@"_id") <- "oid" ## Aids in extraction
+      }
     }
+  } else {
+    flog.trace("DB is null, not saving message.")
   }
   mess
 }
 
 markAsProcessed <- function (mess,col) {
   processed(mess) <- TRUE
-  col$update(paste('{"_id":{"$oid":"',mess@"_id",'"}}',sep=""),
-             '{"$set": {"processed":true}}')
+  if (!is.null(col)) {
+    col$update(paste('{"_id":{"$oid":"',mess@"_id",'"}}',sep=""),
+               '{"$set": {"processed":true}}')
+  } else {
+    flog.trace("DB is null, not saving message.")
+  }
   mess
 }
 
 markAsError <- function (mess,col, e) {
   processingError(mess) <- e
-  col$update(paste('{"_id":{"$oid":"',mess@"_id",'"}}',sep=""),
-             paste('{"$set": {"pError":"',
-                   chartr("\"","'",     #Problem with interior quotes.
-                          encodeString(toString(e))),'"}}',sep=""))
+  if (!is.null(col)) {
+    col$update(paste('{"_id":{"$oid":"',mess@"_id",'"}}',sep=""),
+               paste('{"$set": {"pError":"',
+                     chartr("\"","'",     #Problem with interior quotes.
+                            encodeString(toString(e))),'"}}',sep=""))
+  } else {
+    flog.trace("DB is null, not saving message.")
+  }
   mess
 }
 
@@ -170,14 +182,14 @@ cleanMessageJlist <- function (rec) {
 
 parseMessage<- function (rec) {
   rec <- cleanMessageJlist(rec)
-  new("P4Message","_id"=ununboxer(rec$"_id"),
-      app=as.vector(ununboxer(rec$app)),
-      uid=as.vector(ununboxer(rec$uid)),
+  new("P4Message","_id"=as.character(ununboxer(rec$"_id")),
+      app=as.character(ununboxer(rec$app)),
+      uid=as.character(ununboxer(rec$uid)),
       context=as.vector(ununboxer(rec$context)),
-      sender=as.vector(ununboxer(rec$sender)),
-      mess=as.vector(ununboxer(rec$mess)),
+      sender=as.character(ununboxer(rec$sender)),
+      mess=as.character(ununboxer(rec$mess)),
       timestamp=as.POSIXlt(ununboxer(rec$timestamp)),
-      processed=ununboxer(rec$processed),
+      processed=as.logical(ununboxer(rec$processed)),
       pError=rec$pError,
       data=parseData(rec$data))
 }
@@ -378,3 +390,26 @@ all.equal.P4Message <- function (target, current, ...,checkTimestamp=FALSE,check
   if (length(msg)==0L) TRUE
   else msg
 }
+
+###
+## This is a construction I find myself using in a lot of places to
+## build up the "mongodb://" URI for the database.
+
+makeDBuri <- function(username="",password="", host="localhost",
+                      port="",protocol="mongodb") {
+  ## Setup DB URI
+  security <- ""
+  if (nchar(username) > 0L) {
+    if (nchar(password) > 0L)
+      security <- paste(username,password,sep=":")
+    else
+      security <- username
+  }
+  if (nchar(port) > 0L)
+    host <- paste(host,port,sep=":")
+  else
+    host <- host
+  if (nchar(security) > 0L)
+    host <- paste(security,host,sep="@")
+  paste(paste(protocol,":/",sep=""),host,sep="/")
+}

man/ListenerSet.Rd

@@ -44,7 +44,8 @@ All reference classes extend and inherit methods from
   When the notifier is called it performs the following functions:
   \enumerate{
     \item{It saves the message to the collection represented by
-      \code{messdb()}.}
+      \code{messdb()}.  If \code{messdb()} is \code{NULL} (\code{dburi}
+      is the empty string) then the messages is not saved.}
     \item{It calls the \code{\link{receiveMessage}} method on each of
       the objects in the listener list.}
     \item{It logs the messages sent using the
@@ -103,9 +104,13 @@ showClass("ListenerSet")
     \item{\code{sender}:}{Object of class \code{character}:the name of
       the source of the messages. }
     \item{\code{dburi}:}{Object of class \code{character}: the URI for
-      the \code{\link[mongolite]{mongo}} database.}
+      the \code{\link[mongolite]{mongo}} database.  If null, then no
+      recording of messages to a database is done (except possibly in
+      the listeners).}
+    \item{\code{dbname}:}{Object of class \code{character}: the name of
+      the database in which messages should be logged.}
     \item{\code{colname}:}{Object of class \code{character}: the name of
-      the column in which messages should be logged.}
+      the collection in which messages should be logged.}
     \item{\code{listeners}:}{A named \code{list} of
       \code{\linkS4class{Listener}} objects, that is objects for which
       \code{\link{isListener}} is true.}

man/MongoDB-class.Rd

@@ -2,6 +2,7 @@
 \Rdversion{1.1}
 \docType{class}
 \alias{MongoDB-class}
+\alias{MongoDB}
 
 \title{Class \code{"MongoDB"}}
 \description{

man/Proc4-package.Rd

@@ -141,7 +141,7 @@ There are five major features of this package documented below:
   it is a listener.
 
   Four listeners are currently implemented (see
-  \code{\link{ListenerConstructors}} or the individal listener classes):
+  \code{\link{Listener}} or the individal listener classes):
     \describe{
     \item{\code{CaptureListener}}{Creates an object of class
       \code{\linkS4class{CaptureListener}} which stores the messages in
@@ -162,7 +162,7 @@ There are five major features of this package documented below:
 
   The \code{\link{ListenerSet}} class is a mixin to associate a
   collection of listeners with an object (the
-  \code{\link[EIEvent]{EIEngine}} and \code{\link[EABN]{EAEngine}}
+  \code{\link[EIEvent]{EIEngine}} and \code{\link[EABN]{BNEngine}}
   classes use this).  The generic function \code{\link{notifyListeners}}
   can be called.  This logs information about the message (see logging
   system above), save a copy of the message in a \dQuote{Messages}

man/TableListener-class.Rd

@@ -4,6 +4,7 @@
 \alias{TableListener-class}
 \alias{isListener,TableListener-method}
 \alias{receiveMessage,TableListener-method}
+\alias{name,TableListener-method}
 
 \title{Class \code{"TableListener"}}
 \description{
@@ -26,6 +27,9 @@
       the message is in the \code{messSet}, it adds a row to its
       internal table using the fields specified in \code{fieldlist}. 
       (See details.) }
+    \item{name}{\code{signature(x = "TableListener")}: returns the name
+      of the table.  This is usually also the filename where the table
+      will be stored. }
   }
 }
 \references{

man/as.json.Rd

@@ -21,7 +21,7 @@ as.jlist(obj,ml, serialize=TRUE)
 \arguments{
   \item{x}{An (S4) object to be serialized.}
   \item{obj}{The object being serialized}
-  \item{ml}{A list of fields of the object.}
+  \item{ml}{A list of fields of the object; usually \code{attributes(obj)}.}
   \item{serialize}{A logical flag. If true,
     \code{\link[jsonlite]{serializeJSON}} is used to protect the
     \code{data} field (and other objects which might contain complex R

man/makeDBuri.Rd

@@ -0,0 +1,61 @@
+\name{makeDBuri}
+\alias{makeDBuri}
+\title{Creates the URI needed to connect to a mongo database.}
+\description{
+
+  This function formats the universal record indicator (URI) for
+  connecting to a Mongo database.  It is mostly a utility function for
+  formatting the string.
+  
+}
+\usage{
+makeDBuri(username = "", password = "", host = "localhost", port = "",
+protocol="mongodb")
+}
+\arguments{
+  \item{username}{The name of the database user (login credential), or
+    an empty string if no username is required.}
+  \item{password}{The name of the database password (login credential), or
+    an empty string if no password is required.}
+  \item{host}{The name or IP address of the system hosting the database.}
+  \item{port}{The port to be used for connections.  Note that the
+    port for a default configuration of mongo is 27018.  This can be
+    left blank to use the default port.}
+  \item{protocol}{A character scalar giving the protocol to use when
+    connecting, e.g., \dQuote{mongodb}.}
+}
+\value{
+
+  A character string giving the database URI which can be passed to the
+  \code{\link[mongolite]{mongo}} function to create a database
+  collection handle.
+
+  Note that the password is stored in clear text, so appropriate care
+  should be taken with the result of this function.
+
+}
+\author{Russell Almond}
+\seealso{
+
+  \code{\link{MongoDB}}, \code{\link[mongolite]{mongo}}
+
+  This is an input argument to a number of other classes which use mongo
+  connections.
+  
+}
+\examples{
+
+stopifnot(makeDBuri()=="mongodb://localhost")
+
+stopifnot(makeDBuri(user="admin",password="secret")==
+                    "mongodb://admin:secret@localhost")
+## No password
+stopifnot(makeDBuri(user="admin")==
+                    "mongodb://admin@localhost")
+
+stopifnot(makeDBuri(host="example.com",port=12345) ==
+          "mongodb://example.com:12345")
+
+}
+\keyword{ interface }
+\keyword{ database }

man/markAsProcessed.Rd

@@ -27,7 +27,8 @@ processingError(x)
   \item{mess}{An object of class \code{\linkS4class{P4Message}} to be
     modified. }
   \item{col}{A \code{\link[mongolite]{mongo}} collection where the
-    message queue is stored.
+    message queue is stored.  This can also be \code{NULL} in which case
+    the message will not be saved to the database.
   }
   \item{e}{An object indicating the error occurred.  Note this could be
     either a string giving the error message of an object of an error
@@ -110,14 +111,20 @@ mess2 <- saveRec(mess2,col,FALSE)
 
 mess <- getOneRec(buildJQuery(app="adder", processed=FALSE),
     col, parseMessage, sort = c(timestamp = 1))
+iterations <- 0
 while (!is.null(mess)) {
+  if (iterations > 4L)
+    stop ("Test not terminating, flag not being set?")
+  iterations <- iterations + 1
+  print(mess)
   print(details(mess))
   out <- try(print(details(mess)$x+details(mess)$y))
   if (is(out,'try-error'))
    mess <- markAsError(mess,col,out)
   mess <- markAsProcessed(mess,col)
   mess <- getOneRec(buildJQuery(app="adder", processed=FALSE),
     col, parseMessage, sort = c(timestamp = 1))
+
 }
 
 mess1a <- getOneRec(buildJQuery(app="adder",uid="One"),col,parseMessage)