SEXP parse_headers(SEXP sRaw) {
SEXP res = PROTECT(allocVector(STRSXP, MAX_HDR_ENTRIES)), rn = allocVector(STRSXP, MAX_HDR_ENTRIES);
Rf_setAttrib(res, R_NamesSymbol, rn);
int i = 0;
const char *cs = (const char*) RAW(sRaw), *c = cs, *e;
R_xlen_t len = XLENGTH(sRaw), ct = 0;
e = c + len;
while (c < e) {
const char *r = memchr(c, ':', e - c);
if (!r) /* we jsut ignore trailing content - it shouldn't be there ... */
break;
if (i == MAX_HDR_ENTRIES)
Rf_error("Sorry, too many header entries, aborting");
/* we have header field entry - add it */
SET_STRING_ELT(rn, i, mkCharLen(c, r - c));
c = r + 1;
while (c < e && (*c == ' ' || *c == '\t')) c++;
const char *val = c;
while (1) {
r = memchr(c, '\n', e - c);
/* if we don't find a newline then just use everything till the end */
if (!r) {
while (e > c && (e[-1] == '\r' || e[-1] == '\n')) e--;
SET_STRING_ELT(res, i, mkCharLen(val, e - val));
i++;
c = e; /* end */
break;
}
/* advance */
c = r + 1;
/* not a continuation? add it */
if (!(c < e && (*c == ' ' || *c == '\t'))) {
/* trim newlines */
while (r > val && (*r == '\n' || *r == '\t')) r--;
SET_STRING_ELT(res, i, mkCharLen(val, r - val));
i++;
break;
}
/* continuation */
}
}
SETLENGTH(rn, i);
SETLENGTH(res, i);
UNPROTECT(1);
return res;
}
SEXP dotask(SEXP Sclient, SEXP Sfun, SEXP Swork, SEXP Suval, SEXP Sback, SEXP Shigh){
rgearman_client_t *client = (rgearman_client_t *)R_ExternalPtrAddr(Sclient);
SEXP ret;
const char *fun, *work, *uval;
int back, high;
fun = (Sfun != R_NilValue)? (const char *)CHAR(STRING_ELT(Sfun,0)) : NULL;
work = (Swork != R_NilValue)? (const char *)CHAR(STRING_ELT(Swork,0)) : NULL;
uval = (Suval != R_NilValue)? (const char *)CHAR(STRING_ELT(Suval,0)) : NULL;
back = LOGICAL(Sback)[0];
high = (Shigh != R_NilValue) ? LOGICAL(Shigh)[0] : -1;
if (back){
gearman_return_t (*gm_fun)(gearman_client_st *client, const char *function_name, const char *unique, const void *workload, size_t workload_size, gearman_job_handle_t job_handle);
char *job = (char *)R_Calloc(1,gearman_job_handle_t);
gm_fun = (high == -1)? gearman_client_do_background : (high)? gearman_client_do_high_background : gearman_client_do_low_background ;
client->lastretcode = gm_fun(client->client,fun,uval,work,strlen(work),job);
ret = PROTECT(allocVector(STRSXP,1));
SET_STRING_ELT(ret,0,mkChar(job));
R_Free(job);
UNPROTECT(1);
} else {
void *(*gm_fun)(gearman_client_st *client, const char *function_name, const char *unique, const void *workload, size_t workload_size, size_t *result_size, gearman_return_t *ret_ptr);
size_t resultsize;
void *result;
gm_fun = (high == -1)? gearman_client_do : (high)? gearman_client_do_high : gearman_client_do_low ;
result = gm_fun(client->client,fun,uval,work,strlen(work),&resultsize,&client->lastretcode);
ret = PROTECT(allocVector(STRSXP,1));
SET_STRING_ELT(ret,0,mkCharLen((char *)result,resultsize));
UNPROTECT(1);
}
return ret;
}
// take lex return
// sort by tok and iterate over the list skipping duplicates
SEXP ng_extract_words(SEXP ng_ptr, SEXP ngsize_)
{
int i, j, k;
int len, retlen;
char *buf;
ngram_t *ng = (ngram_t *) getRptr(ng_ptr);
const int ngsize = INTEGER(ngsize_)[0];
wordlist_t *wl;
SEXP RET;
// Count # words
retlen = 2;
PROTECT(RET = allocVector(STRSXP, retlen));
// Convert them
k = 0;
for(i=0; i<ngsize; i++)
{
wl = ng[i].words;
while(wl)
{
print_word(ng[i].words->word);
}
if(ng[i].words->word == NULL)
{
/* SET_STRING_ELT(RET, i, mkChar("<NA>"));*/
goto nextcycle;
}
len = ng[i].words->word->len;
buf = malloc(len * sizeof(buf));
for (j=0; j<len; j++)
buf[j] = ng[i].words->word->s[j];
SET_STRING_ELT(RET, k, mkCharLen(buf, len));
free(buf);
nextcycle:
k++;
wl = wl->next;
}
UNPROTECT(1);
return RET;
}
SEXP ng_extract_str(SEXP str_ptr, SEXP R_strlen)
{
SEXP RET;
char *str = (char *) getRptr(str_ptr);
PROTECT(RET = allocVector(STRSXP, 1));
SET_STRING_ELT(RET, 0, mkCharLen(str, INTEGER(R_strlen)[0]));
UNPROTECT(1);
return RET;
}
/* type: 0=CHARSXP, 1=STRSXP, 2=RAWSXP
as_matrix: 0 or 1, ignored when type is 0
q_len, q_break, s_len: ignored when type is 0 */
static SEXP make_encoding_from_CharAE(const CharAE *buf,
int type, int as_matrix,
int q_len, int q_break, int s_len)
{
SEXP ans, ans_elt, ans_dim;
int buf_nelt, i, nrow;
buf_nelt = _CharAE_get_nelt(buf);
if (type == 0 || (type == 1 && !as_matrix)) {
PROTECT(ans = mkCharLen(buf->elts, buf_nelt));
if (type == 1) {
PROTECT(ans = ScalarString(ans));
UNPROTECT(1);
}
UNPROTECT(1);
return ans;
}
if (type == 1) {
PROTECT(ans = NEW_CHARACTER(buf_nelt));
for (i = 0; i < buf_nelt; i++) {
PROTECT(ans_elt = mkCharLen(buf->elts + i, 1));
SET_STRING_ELT(ans, i, ans_elt);
UNPROTECT(1);
}
} else {
PROTECT(ans = _new_RAW_from_CharAE(buf));
}
if (as_matrix) {
nrow = q_len;
if (q_break != 0)
nrow += 2;
PROTECT(ans_dim = NEW_INTEGER(2));
INTEGER(ans_dim)[0] = nrow;
INTEGER(ans_dim)[1] = s_len;
SET_DIM(ans, ans_dim);
UNPROTECT(1);
}
UNPROTECT(1);
return ans;
}
SEXP Rsockread(SEXP ssock, SEXP smaxlen)
{
if (length(ssock) != 1) error("invalid 'socket' argument");
int sock = asInteger(ssock), maxlen = asInteger(smaxlen);
char buf[maxlen+1], *abuf[1];
abuf[0] = buf;
if(!initialized) internet_Init();
if(initialized > 0)
(*ptr->sockread)(&sock, abuf, &maxlen);
else
error(_("socket routines cannot be loaded"));
return Rf_ScalarString(mkCharLen(buf, maxlen));
}
SEXP _new_CHARACTER_from_CharAEAE(const CharAEAE *aeae)
{
int nelt, i;
SEXP ans, ans_elt;
CharAE *ae;
nelt = _CharAEAE_get_nelt(aeae);
PROTECT(ans = NEW_CHARACTER(nelt));
for (i = 0; i < nelt; i++) {
ae = aeae->elts[i];
PROTECT(ans_elt = mkCharLen(ae->elts, _CharAE_get_nelt(ae)));
SET_STRING_ELT(ans, i, ans_elt);
UNPROTECT(1);
}
UNPROTECT(1);
return ans;
}
SEXP Rsockread(SEXP ssock, SEXP smaxlen)
{
if (length(ssock) != 1) error("invalid 'socket' argument");
int sock = asInteger(ssock), maxlen = asInteger(smaxlen);
char buf[maxlen+1], *abuf[1];
abuf[0] = buf;
if(!initialized) internet_Init();
if(initialized > 0)
(*ptr->sockread)(&sock, abuf, &maxlen);
else
error(_("socket routines cannot be loaded"));
SEXP ans = PROTECT(allocVector(STRSXP, 1));
SET_STRING_ELT(ans, 0, mkCharLen(buf, maxlen));
UNPROTECT(1);
return ans;
}
SEXP ng_extract_ngrams(SEXP ng_ptr, SEXP ngsize_)
{
int i, j, len;
char *buf;
ngramlist_t *ngl = (ngramlist_t *) getRptr(ng_ptr);
ngram_t *ng = ngl->ng;
const int ngsize = INTEGER(ngsize_)[0];
wordlist_t *wl;
SEXP RET;
PROTECT(RET = allocVector(STRSXP, ngsize));
for(i=0; i<ngsize; i++)
{
len = 0;
wl = ng[i].words;
while (wl)
{
len += wl->word->len;
len++; // spaces
wl = wl->next;
}
len--; // apparently mkCharLen handles the NUL terminator for some reason
buf = malloc(len * sizeof(*buf));
for (j=0; j<len; j++)
buf[j] = ng[i].words->word->s[j];
SET_STRING_ELT(RET, i, mkCharLen(buf, len));
free(buf);
}
UNPROTECT(1);
return RET;
}
SEXP _read_bam_header(SEXP ext, SEXP what)
{
samfile_t *sfile = BAMFILE(ext)->file;
bam_header_t *header = sfile->header;
SEXP ans = PROTECT(NEW_LIST(2));
SEXP nms = NEW_CHARACTER(2);
setAttrib(ans, R_NamesSymbol, nms);
SET_STRING_ELT(nms, 0, mkChar("targets"));
SET_STRING_ELT(nms, 1, mkChar("text"));
if (LOGICAL(what)[0] == TRUE) { /* 'targets' */
int n_elts = header->n_targets;
SET_VECTOR_ELT(ans, 0, NEW_INTEGER(n_elts));
SEXP tlen = VECTOR_ELT(ans, 0); /* target length */
SEXP tnm = NEW_CHARACTER(n_elts); /* target name */
setAttrib(tlen, R_NamesSymbol, tnm);
for (int j = 0; j < n_elts; ++j) {
INTEGER(tlen)[j] = header->target_len[j];
SET_STRING_ELT(tnm, j, mkChar(header->target_name[j]));
}
}
if (LOGICAL(what)[1] == TRUE) { /* 'text' */
int n_text_elts = 0;
for (int i = 0; i < header->l_text; ++i)
if (header->text[i] == '\n')
n_text_elts += 1;
SET_VECTOR_ELT(ans, 1, NEW_LIST(n_text_elts));
SEXP text = VECTOR_ELT(ans, 1);
SEXP tag = NEW_CHARACTER(n_text_elts);
setAttrib(text, R_NamesSymbol, tag);
int start = 0, end;
for (int i = 0; i < n_text_elts; ++i) {
int n_elts = header->text[start] == '\n' ? 0 : 1;
end = start;
while (header->text[end] != '\n') {
if (header->text[end] == '\t')
++n_elts;
++end;
}
if (n_elts == 0) {
SET_VECTOR_ELT(text, i, NEW_CHARACTER(0));
/* SET_STRING_ELT(tag, i, mkChar("")); */
start = end + 1;
continue;
}
SET_VECTOR_ELT(text, i, NEW_CHARACTER(n_elts - 1));
SEXP elts = VECTOR_ELT(text, i);
for (int j = 0; j < n_elts; ++j) {
end = start;
while (header->text[end] != '\t' && header->text[end] != '\n')
++end;
SEXP elt = mkCharLen(&header->text[start], end - start);
if (j == 0) /* tag */
SET_STRING_ELT(tag, i, elt);
else
SET_STRING_ELT(elts, j - 1, elt);
start = end + 1;
}
}
}
UNPROTECT(1);
return ans;
}
SEXP getPass_readline_masked(SEXP msg, SEXP showstars_, SEXP noblank_)
{
SEXP ret;
const int showstars = INTEGER(showstars_)[0];
const int noblank = INTEGER(noblank_)[0];
int i = 0;
int j;
char c;
ctrlc = CTRLC_NO; // must be global!
REprintf(CHARPT(msg, 0));
#if !(OS_WINDOWS)
struct termios tp, old;
tcgetattr(STDIN_FILENO, &tp);
old = tp;
tp.c_lflag &= ~(ECHO | ICANON | ISIG);
tcsetattr(0, TCSAFLUSH, &tp);
#if OS_LINUX
signal(SIGINT, ctrlc_handler);
#else
struct sigaction sa;
sa.sa_handler = ctrlc_handler;
sigemptyset(&sa.sa_mask);
sa.sa_flags = 0;
sigaction(SIGINT, &sa, NULL);
#endif
#endif
for (i=0; i<PWLEN; i++)
{
#if OS_WINDOWS
c = _getch();
#else
c = fgetc(stdin);
#endif
// newline
if (c == '\n' || c == '\r')
{
if (noblank && i == 0)
{
i--;
continue;
}
else
break;
}
// backspace
else if (c == '\b' || c == '\177')
{
if (i == 0)
{
i--;
continue;
}
else
{
if (showstars)
REprintf("\b \b");
pw[--i] = '\0';
i--;
}
}
// C-c
else if (ctrlc == CTRLC_YES || c == 3 || c == '\xff')
{
#if !(OS_WINDOWS)
tcsetattr(0, TCSANOW, &old);
#endif
REprintf("\n");
return R_NilValue;
}
// store value
else
{
if (showstars)
REprintf("*");
pw[i] = c;
}
}
#if !(OS_WINDOWS)
tcsetattr(0, TCSANOW, &old);
#endif
if (i == PWLEN)
{
REprintf("\n");
error("character limit exceeded");
}
if (showstars || strncmp(CHARPT(msg, 0), "", 1) != 0)
REprintf("\n");
PROTECT(ret = allocVector(STRSXP, 1));
SET_STRING_ELT(ret, 0, mkCharLen(pw, i));
for (j=0; j<i; j++)
pw[j] = '\0';
UNPROTECT(1);
return ret;
}
SEXP R_ng_asweka(SEXP R_str, SEXP min_n_, SEXP max_n_, SEXP R_sep)
{
int i, j;
char *str = CHARPT(R_str, 0);
char *sep = CHARPT(R_sep, 0);
const int min_n = INTEGER(min_n_)[0];
const int max_n = INTEGER(max_n_)[0];
int str_len;
sentencelist_t *sl;
wordlist_t *wptr;
int numwords;
int cur_n;
size_t len;
const char **starts = NULL;
int *lens = NULL;
int word_i;
char *errstr;
SEXP RET;
str_len = strlen(str);
if(*sep == '\0')
sep=NULL;
sl = lex_simple(str, str_len, sep);
if (sl == NULL)
error("out of memory");
numwords = 0;
for(i=0;i<sl->filled;i++)
for(wptr=sl->words[i];wptr && wptr->word->s;wptr=wptr->next)
numwords++;
if (numwords == 0){
errstr="no words";
goto memerr;
}
len = numwords;
starts = malloc(sizeof(*starts)*numwords);
if (starts == NULL){
errstr="out of memory";
goto memerr;
}
lens = malloc(sizeof(*lens)*numwords);
if (lens == NULL){
errstr="out of memory";
goto memerr;
}
for(i=sl->filled-1;i>=0;i--){
for(wptr=sl->words[i];wptr && wptr->word->s;wptr=wptr->next){
--len;
starts[len]=wptr->word->s;
lens[len]=wptr->word->len;
}
}
i = numwords-(min_n-1);
j = numwords-(max_n-1);
len = i*(i+1)/2 - j*(j-1)/2;
PROTECT(RET = allocVector(STRSXP, len));
word_i = 0;
for(cur_n=max_n;cur_n>=min_n;cur_n--){
for(i=0;i<numwords-(cur_n-1);i++){
len = starts[i+cur_n-1] - starts[i] + lens[i+cur_n-1];
SET_STRING_ELT(RET, word_i, mkCharLen(starts[i], len));
word_i++;
}
}
free(starts);
free(lens);
free_sentencelist(sl,free_wordlist);
UNPROTECT(1);
return RET;
memerr:
freeif(starts);
freeif(lens);
free_sentencelist(sl,free_wordlist);
error(errstr);
}
