SEXP receiveString(SEXP socket_) {
SEXP ans;
bool status(false);
zmq::message_t msg;
zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
try {
status = socket->recv(&msg);
} catch(std::exception& e) {
REprintf("%s\n",e.what());
}
if(status) {
PROTECT(ans = allocVector(STRSXP,1));
char* string_msg = new char[msg.size() + 1];
if(string_msg == NULL) {
UNPROTECT(1);
return R_NilValue;
}
memcpy(string_msg,msg.data(),msg.size());
string_msg[msg.size()] = 0;
SET_STRING_ELT(ans, 0, mkChar(string_msg));
UNPROTECT(1);
return ans;
}
return R_NilValue;
}
SEXP sendNullMsg(SEXP socket_, SEXP send_more_) {
SEXP ans; PROTECT(ans = allocVector(LGLSXP,1));
bool status(false);
if(TYPEOF(send_more_) != LGLSXP) {
REprintf("send.more type must be logical (LGLSXP).\n");
UNPROTECT(1);
return R_NilValue;
}
zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
zmq::message_t msg(0);
bool send_more = LOGICAL(send_more_)[0];
try {
if(send_more) {
status = socket->send(msg,ZMQ_SNDMORE);
} else {
status = socket->send(msg);
}
} catch(std::exception& e) {
REprintf("%s\n",e.what());
}
LOGICAL(ans)[0] = static_cast<int>(status);
UNPROTECT(1);
return ans;
}
SEXP receiveSocket(SEXP socket_, SEXP dont_wait_) {
SEXP ans;
zmq::message_t msg;
if(TYPEOF(dont_wait_) != LGLSXP) {
REprintf("dont_wait type must be logical (LGLSXP).\n");
return R_NilValue;
}
int flags = LOGICAL(dont_wait_)[0];
zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
if(!socket) { REprintf("bad socket object.\n"); return R_NilValue; }
try {
if(socket->recv(&msg, flags)) {
PROTECT(ans = allocVector(RAWSXP,msg.size()));
memcpy(RAW(ans),msg.data(),msg.size());
UNPROTECT(1);
return ans;
} else {
// socket->recv returned false, but did not throw
// this condition implies EAGAIN
// see here for logic: https://github.com/zeromq/cppzmq/blob/master/zmq.hpp#L449
return R_NilValue;
}
} catch(std::exception& e) {
REprintf("%s\n",e.what());
}
return R_NilValue;
}
SEXP initSocket(SEXP context_, SEXP socket_type_) {
SEXP socket_;
if(TYPEOF(socket_type_) != STRSXP) {
REprintf("socket type must be a string.\n");
return R_NilValue;
}
int socket_type = string_to_socket_type(CHAR(STRING_ELT(socket_type_,0)));
if(socket_type < 0) {
REprintf("socket type not found.\n");
return R_NilValue;
}
zmq::context_t* context(NULL);
try {
context = reinterpret_cast<zmq::context_t*>(checkExternalPointer(context_,"zmq::context_t*"));
} catch(std::logic_error &e) {
REprintf("%s\n",e.what());
return R_NilValue;
}
zmq::socket_t* socket = new zmq::socket_t(*context,socket_type);
if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
// for debugging
//uint64_t hwm = 1;
//socket->setsockopt(ZMQ_HWM, &hwm, sizeof (hwm));
PROTECT(socket_ = R_MakeExternalPtr(reinterpret_cast<void*>(socket),install("zmq::socket_t*"),R_NilValue));
R_RegisterCFinalizerEx(socket_, socketFinalizer, TRUE);
UNPROTECT(1);
return socket_;
}
static void socketFinalizer(SEXP socket_) {
zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
if(socket) {
delete socket;
R_ClearExternalPtr(socket_);
}
}
SEXP unsubscribe(SEXP socket_, SEXP option_value_) {
zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
if(TYPEOF(option_value_)!=STRSXP) { REprintf("option value must be a string.\n");return R_NilValue; }
SEXP ans; PROTECT(ans = allocVector(LGLSXP,1)); LOGICAL(ans)[0] = 1;
const char* option_value = CHAR(STRING_ELT(option_value_,0));
try {
socket->setsockopt(ZMQ_UNSUBSCRIBE, option_value,strlen(option_value));
} catch(std::exception& e) {
REprintf("%s\n",e.what());
LOGICAL(ans)[0] = 0;
}
UNPROTECT(1);
return ans;
}
SEXP receiveNullMsg(SEXP socket_) {
SEXP ans; PROTECT(ans = allocVector(LGLSXP,1));
bool status(false);
zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
zmq::message_t msg;
try {
status = socket->recv(&msg);
} catch(std::exception& e) {
REprintf("%s\n",e.what());
}
LOGICAL(ans)[0] = static_cast<int>(status) && (msg.size() == 0);
UNPROTECT(1);
return ans;
}
// removed from libzmq3
SEXP set_mcast_loop(SEXP socket_, SEXP option_value_) {
zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
if(TYPEOF(option_value_)!=LGLSXP) { REprintf("option value must be a logical.\n");return R_NilValue; }
SEXP ans; PROTECT(ans = allocVector(LGLSXP,1)); LOGICAL(ans)[0] = 1;
int64_t option_value(LOGICAL(option_value_)[0]);
try {
socket->setsockopt(ZMQ_MCAST_LOOP, &option_value, sizeof(int64_t));
} catch(std::exception& e) {
REprintf("%s\n",e.what());
LOGICAL(ans)[0] = 0;
}
UNPROTECT(1);
return ans;
}
SEXP set_reconnect_ivl_max(SEXP socket_, SEXP option_value_) {
zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
if(TYPEOF(option_value_)!=INTSXP) { REprintf("option value must be an int.\n");return R_NilValue; }
SEXP ans; PROTECT(ans = allocVector(LGLSXP,1)); LOGICAL(ans)[0] = 1;
int option_value(INTEGER(option_value_)[0]);
try {
socket->setsockopt(ZMQ_RECONNECT_IVL_MAX, &option_value, sizeof(int));
} catch(std::exception& e) {
REprintf("%s\n",e.what());
LOGICAL(ans)[0] = 0;
}
UNPROTECT(1);
return ans;
}
SEXP connectSocket(SEXP socket_, SEXP address_) {
SEXP ans; PROTECT(ans = allocVector(LGLSXP,1)); LOGICAL(ans)[0] = 1;
if(TYPEOF(address_) != STRSXP) {
REprintf("address type must be a string.\n");
UNPROTECT(1);
return R_NilValue;
}
try {
zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
socket->connect(CHAR(STRING_ELT(address_,0)));
} catch(std::exception& e) {
REprintf("%s\n",e.what());
LOGICAL(ans)[0] = 0;
}
UNPROTECT(1);
return ans;
}
SEXP receiveSocket(SEXP socket_) {
SEXP ans;
bool status(false);
zmq::message_t msg;
zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
try {
status = socket->recv(&msg);
} catch(std::exception& e) {
REprintf("%s\n",e.what());
}
if(status) {
PROTECT(ans = allocVector(RAWSXP,msg.size()));
memcpy(RAW(ans),msg.data(),msg.size());
UNPROTECT(1);
return ans;
}
return R_NilValue;
}
SEXP set_recovery_ivl(SEXP socket_, SEXP option_value_) {
zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
if(TYPEOF(option_value_)!=INTSXP) { REprintf("option value must be an int.\n");return R_NilValue; }
SEXP ans; PROTECT(ans = allocVector(LGLSXP,1)); LOGICAL(ans)[0] = 1;
#if ZMQ_VERSION_MAJOR > 2
int option_value;
#else
int64_t option_value;
#endif
option_value = INTEGER(option_value_)[0];
try {
socket->setsockopt(ZMQ_RECOVERY_IVL, &option_value, sizeof(int64_t));
} catch(std::exception& e) {
REprintf("%s\n",e.what());
LOGICAL(ans)[0] = 0;
}
UNPROTECT(1);
return ans;
}
SEXP get_rcvmore(SEXP socket_) {
zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
if(!socket) { REprintf("bad socket object.\n");return R_NilValue; }
#if ZMQ_VERSION_MAJOR > 2
int option_value;
#else
int64_t option_value;
#endif
size_t option_value_len = sizeof(option_value);
try {
socket->getsockopt(ZMQ_RCVMORE, &option_value, &option_value_len);
} catch(std::exception& e) {
REprintf("%s\n",e.what());
return R_NilValue;
}
SEXP ans; PROTECT(ans = allocVector(LGLSXP,1));
LOGICAL(ans)[0] = static_cast<int>(option_value);
UNPROTECT(1);
return ans;
}
SEXP receiveDouble(SEXP socket_) {
SEXP ans;
bool status(false);
zmq::message_t msg;
try {
zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
status = socket->recv(&msg);
} catch(std::exception& e) {
REprintf("%s\n",e.what());
}
if(status) {
if(msg.size() != sizeof(double)) {
REprintf("bad double size on remote machine.\n");
return R_NilValue;
}
PROTECT(ans = allocVector(REALSXP,1));
memcpy(REAL(ans),msg.data(),msg.size());
UNPROTECT(1);
return ans;
}
return R_NilValue;
}
SEXP sendRawString(SEXP socket_, SEXP data_, SEXP send_more_) {
SEXP ans;
bool status(false);
if(TYPEOF(data_) != STRSXP) {
REprintf("data type must be raw (STRSXP).\n");
return R_NilValue;
}
if(TYPEOF(send_more_) != LGLSXP) {
REprintf("send.more type must be logical (LGLSXP).\n");
return R_NilValue;
}
zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(socket_,"zmq::socket_t*"));
if(!socket) {
REprintf("bad socket object.\n");
return R_NilValue;
}
const char* data = CHAR(STRING_ELT(data_,0));
zmq::message_t msg (strlen(data));
memcpy(msg.data(), data, strlen(data));
bool send_more = LOGICAL(send_more_)[0];
try {
if(send_more) {
status = socket->send(msg,ZMQ_SNDMORE);
} else {
status = socket->send(msg);
}
} catch(std::exception& e) {
REprintf("%s\n",e.what());
}
PROTECT(ans = allocVector(LGLSXP,1));
LOGICAL(ans)[0] = static_cast<int>(status);
UNPROTECT(1);
return ans;
}
// [[Rcpp::export]]
Rcpp::DataFrame getBars_Impl(SEXP con,
std::string security,
std::string eventType,
int barInterval,
std::string startDateTime,
std::string endDateTime,
bool gapFillInitialBar=false,
bool verbose=false) {
// via Rcpp Attributes we get a try/catch block with error propagation to R "for free"
bbg::Session* session =
reinterpret_cast<bbg::Session*>(checkExternalPointer(con,"blpapi::Session*"));
if (!session->openService("//blp/refdata")) {
Rcpp::stop("Failed to open //blp/refdata");
}
bbg::Service refDataService = session->getService("//blp/refdata");
bbg::Request request = refDataService.createRequest("IntradayBarRequest");
// only one security/eventType per request
request.set("security", security.c_str());
request.set("eventType", eventType.c_str());
request.set("interval", barInterval);
request.set("startDateTime", startDateTime.c_str());
request.set("endDateTime", endDateTime.c_str());
request.set("gapFillInitialBar", gapFillInitialBar);
if (verbose) Rcpp::Rcout <<"Sending Request: " << request << std::endl;
session->sendRequest(request);
Bars bars;
// eventLoop
bool done = false;
while (!done) {
bbg::Event event = session->nextEvent();
if (event.eventType() == bbg::Event::PARTIAL_RESPONSE) {
if (verbose) Rcpp::Rcout << "Processing Partial Response" << std::endl;
processResponseEvent(event, bars, barInterval, verbose);
} else if (event.eventType() == bbg::Event::RESPONSE) {
if (verbose) Rcpp::Rcout << "Processing Response" << std::endl;
processResponseEvent(event, bars, barInterval, verbose);
done = true;
} else {
bbg::MessageIterator msgIter(event);
while (msgIter.next()) {
bbg::Message msg = msgIter.message();
if (event.eventType() == bbg::Event::SESSION_STATUS) {
if (msg.messageType() == SESSION_TERMINATED) {
done = true;
}
}
}
}
}
return Rcpp::DataFrame::create(Rcpp::Named("times") = createPOSIXtVector(bars.time),
Rcpp::Named("open") = bars.open,
Rcpp::Named("high") = bars.high,
Rcpp::Named("low") = bars.low,
Rcpp::Named("close") = bars.close,
Rcpp::Named("numEvents") = bars.numEvents,
Rcpp::Named("volume") = bars.volume,
Rcpp::Named("value") = bars.value);
}
SEXP pollSocket(SEXP sockets_, SEXP events_, SEXP timeout_) {
SEXP result;
if(TYPEOF(timeout_) != INTSXP) {
error("poll timeout must be an integer.");
}
if(TYPEOF(sockets_) != VECSXP || LENGTH(sockets_) == 0) {
error("A non-empy list of sockets is required as first argument.");
}
int nsock = LENGTH(sockets_);
PROTECT(result = allocVector(VECSXP, nsock));
if (TYPEOF(events_) != VECSXP) {
error("event list must be a list of strings or a list of vectors of strings.");
}
if(LENGTH(events_) != nsock) {
error("event list must be the same length as socket list.");
}
zmq_pollitem_t *pitems = (zmq_pollitem_t*)R_alloc(nsock, sizeof(zmq_pollitem_t));
if (pitems == NULL) {
error("failed to allocate memory for zmq_pollitem_t array.");
}
try {
for (int i = 0; i < nsock; i++) {
zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(VECTOR_ELT(sockets_, i), "zmq::socket_t*"));
pitems[i].socket = (void*)*socket;
pitems[i].events = rzmq_build_event_bitmask(VECTOR_ELT(events_, i));
}
int rc = zmq::poll(pitems, nsock, *INTEGER(timeout_));
if(rc >= 0) {
for (int i = 0; i < nsock; i++) {
SEXP events, names;
// Pre count number of polled events so we can
// allocate appropriately sized lists.
short eventcount = 0;
if (pitems[i].events & ZMQ_POLLIN) eventcount++;
if (pitems[i].events & ZMQ_POLLOUT) eventcount++;
if (pitems[i].events & ZMQ_POLLERR) eventcount++;
PROTECT(events = allocVector(VECSXP, eventcount));
PROTECT(names = allocVector(VECSXP, eventcount));
eventcount = 0;
if (pitems[i].events & ZMQ_POLLIN) {
SET_VECTOR_ELT(events, eventcount, ScalarLogical(pitems[i].revents & ZMQ_POLLIN));
SET_VECTOR_ELT(names, eventcount, mkChar("read"));
eventcount++;
}
if (pitems[i].events & ZMQ_POLLOUT) {
SET_VECTOR_ELT(names, eventcount, mkChar("write"));
SET_VECTOR_ELT(events, eventcount, ScalarLogical(pitems[i].revents & ZMQ_POLLOUT));
eventcount++;
}
if (pitems[i].events & ZMQ_POLLERR) {
SET_VECTOR_ELT(names, eventcount, mkChar("error"));
SET_VECTOR_ELT(events, eventcount, ScalarLogical(pitems[i].revents & ZMQ_POLLERR));
}
setAttrib(events, R_NamesSymbol, names);
SET_VECTOR_ELT(result, i, events);
}
} else {
error("polling zmq sockets failed.");
}
} catch(std::exception& e) {
error(e.what());
}
// Release the result list (1), and per socket
// events lists with associated names (2*nsock).
UNPROTECT(1 + 2*nsock);
return result;
}
