title is swizzled to record the title of images, which is now stored in the sessionimage table

Author: mlilback

CMakeLists.txt

@@ -118,3 +118,4 @@ install(CODE "execute_process(COMMAND \"${CMAKE_SOURCE_DIR}/prepareRInside.sh\"
 install(TARGETS rserver rsession  RUNTIME DESTINATION .)
 install(DIRECTORY ${CMAKE_BINARY_DIR}/RInside DESTINATION . ${INSTALL_PATH})
 install(DIRECTORY ${CMAKE_SOURCE_DIR}/R/rc2 DESTINATION . ${INSTALL_PATH})
+install(DIRECTORY ${CMAKE_SOURCE_DIR}/rsrc DESTINATION . ${INSTALL_PATH})

R/rc2/DESCRIPTION

@@ -1,11 +1,10 @@
 Package: rc2
 Type: Package
 Title: Assists communication with rc2compute engine
-Version: 2.0
-Date: 2016-05-23
+Version: 3.0
+Date: 2017-03-23
 Author: Mark Lilback
 Maintainer: Mark Lilback <[email protected]>
 Description:Assists rc2compute engine
 License: BSD
-Depends: stringr
 LazyLoad: yes

R/rc2/NAMESPACE

@@ -1 +1 @@
-export("help", "rc2.defineFunction", "rc2.pngdev", "rc2.pngoff")
+export("help", "rc2.defineFunction", "rc2.pngdev", "rc2.pngoff", "rc2.errlog")

R/rc2/R/rc2.R

@@ -1,11 +1,16 @@
 helpIndexSearch <- getFromNamespace("index.search", getNamespace("utils"))
 
+utils::suppressForeignCheck("rc2cache")
+rc2cache <- new.env(parent = emptyenv())
+assign("imgNum", 100, envir=rc2cache)
+
 #called from EnvList.cpp c++ code
 rc2.defineFunction <- function(func) {
-	zz <- textConnection("def", open = "w", local = TRUE)
+	zz <- textConnection(NULL, open = "w", local = TRUE)
 	capture.output(print(func), file=zz)
+	result <- paste(textConnectionValue(zz), sep="\n")
 	close(zz)
-	paste(def, sep="\n")
+	result
 }
 
 #override to just return help paths
@@ -29,11 +34,20 @@ help <- function(topic) {
 
 rc2.pngdev <- function()
 {
-	png("rc2img%03d.png")
+	imgNum <- as.integer(get("imgNum", envir=rc2:::rc2cache))
+	assign("imgNum", imgNum + 1, envir=rc2:::rc2cache)
+	fname <- sprintf("rc2img%03d.png", imgNum, envir=rc2:::rc2cache)
+	png(fname)
+	rc2.errlog("rc2.imgstart=%s\n", fname)
 }
 
 rc2.pngoff <- function()
 {
+	rc2.errlog("dev off")
 	if (dev.cur()[1] != 1)
 		dev.off();
 }
+
+
+rc2.errlog <- function(...) cat(sprintf(...), sep='', file=stderr())
+

computeClient/.perl-version

@@ -0,0 +1 @@
+5.23.4

computeClient/query.json

@@ -0,0 +1 @@
+{"msg": "execScript", "argument": "rnorm(11)"}

rc2root

@@ -0,0 +1,51 @@
+library(inline)
+local( {
+myenv <- new.env(parent = emptyenv())
+oldtitle <- graphics::title
+#assign("oldtitle", graphics::title, envir = myenv)
+
+#oldtitle <- title
+mytitle <- function(...) {
+	args <- list(...)
+	if (!is.null(args$main)) { 
+		rc2.errlog("rc2.imgtitle=%s\n", args$main)
+	}
+	oldtitle(...)
+}
+
+inc <- '
+/* This is taken from envir.c in the R 2.15.1 source 
+   https://github.com/SurajGupta/r-source/blob/master/src/main/envir.c
+*/
+#define FRAME_LOCK_MASK (1<<14)
+#define FRAME_IS_LOCKED(e) (ENVFLAGS(e) & FRAME_LOCK_MASK)
+#define UNLOCK_FRAME(e) SET_ENVFLAGS(e, ENVFLAGS(e) & (~ FRAME_LOCK_MASK))
+'
+
+src <- '
+  if (TYPEOF(env) == NILSXP)
+    error("use of NULL environment is defunct");
+  if (TYPEOF(env) != ENVSXP)
+    error("not an environment");
+  UNLOCK_FRAME(env);
+  // Return TRUE if unlocked; FALSE otherwise
+  SEXP result = PROTECT( Rf_allocVector(LGLSXP, 1) );
+  LOGICAL(result)[0] = FRAME_IS_LOCKED(env) == 0;
+  UNPROTECT(1);
+  return result;
+'
+
+unlockEnvironment <- cfunction(signature(env = "environment"),
+                        includes = inc,
+                        body = src)
+
+
+ns_g <- asNamespace('graphics')
+unlockEnvironment(ns_g)
+unlockBinding("title", ns_g)
+ns_g$title <- mytitle
+lockBinding("title", ns_g)
+detach(package:graphics)
+library(graphics)
+
+})

rsrc/swizzle.R

@@ -66,6 +66,7 @@ class RC2::FileManager::Impl : public ZeroInitializedClass {
 		int							inotifyFd_;
 		FSDirectory					rootDir_;
 		boost::regex				imgRegex_;
+		map<string, string>			imgNameToTitle_;
 		bool						ignoreFSNotifications_;
 		bool						ignoreDBNotifications_;
 
@@ -150,6 +151,10 @@ RC2::FileManager::Impl::connect(std::shared_ptr<PGDBConnection> connection, long
 long
 RC2::FileManager::Impl::insertImage(string fname, string imgNumStr)
 {
+	string title = "";
+	if (imgNameToTitle_.count(fname) > 0) {
+		dbConnection_->escapeLiteral(imgNameToTitle_[fname], title);
+	}
 	string filePath = workingDir + "/" + fname;
 	size_t size;
 	unique_ptr<char[]> buffer = ReadFileBlob(filePath, size);
@@ -166,8 +171,11 @@ RC2::FileManager::Impl::insertImage(string fname, string imgNumStr)
 		sessionImageBatch_ = dbConnection_->longFromQuery(batchq.str().c_str()) + 1;
 	}
 	stringstream query;
-	query << "insert into sessionimage (id,sessionid,batchid,name,imgdata) values (" << imgId 
-		<< "," << sessionRecId_ << "," << sessionImageBatch_ << ",'img" << imgId << ".png',$1::bytea)";
+	query << "insert into sessionimage (id,sessionid,batchid,name,title,imgdata) values (" << imgId 
+		<< "," << sessionRecId_ << "," << sessionImageBatch_ 
+		<< ",'img" << imgId << ".png',"
+		<< title << ","
+		<< "$1::bytea)";
 	int pformats = 1;
 	int pSizes[] = {(int)size};
  	const char *params[] = {buffer.get()};
@@ -527,7 +535,6 @@ RC2::FileManager::resetWatch()
 //	LOG(INFO) << "fm:resetWatch called: " << _impl->imageIds_.size();
 	if (_impl->imageIds_.size() > 0) {
 		_impl->sessionImageBatch_++;
-		LOG(INFO) << "incrementing batch_id:" << _impl->sessionImageBatch_;
 	}
 	_impl->imageIds_.erase(_impl->imageIds_.begin(), _impl->imageIds_.end());
 	_impl->manuallyAddedFiles_.clear();
@@ -541,9 +548,15 @@ RC2::FileManager::checkWatch(vector<long> &imageIds, long &batchId)
 //	_impl->sessionImageBatch_ = 0;
 }
 
+void RC2::FileManager::setTitle(std::string title, std::string imageName)
+{
+	_impl->imgNameToTitle_[imageName] = title;
+}
+
 void RC2::FileManager::cleanupImageWatch()
 {
 	_impl->cleanupImageWatch();
+	_impl->imgNameToTitle_.clear();
 }
 
 bool

src/FileManager.cpp

@@ -64,6 +64,7 @@ namespace RC2 {
 		virtual void	suspendNotifyEvents();
 		virtual void	resumeNotifyEvents();
 
+		virtual void	setTitle(std::string title, std::string imageName);
 		//for unit testing
 		virtual void	processDBNotification(std::string message);