void
do_cqi_corpus_attributes(int type)
{
char *c, *typename;
CorpusList *cl;
c = cqi_read_string();
if (server_debug) {
switch (type) {
case ATT_POS:
typename = "POSITIONAL";
break;
case ATT_STRUC:
typename = "STRUCTURAL";
break;
case ATT_ALIGN:
typename = "ALIGNMENT";
break;
default:
cqi_general_error("INTERNAL ERROR: do_cqi_corpus_attributes(): unknown attribute type");
return;
}
Rprintf( "CQi: CQI_CORPUS_%s_ATTRIBUTES('%s')\n", typename, c);
}
cl = findcorpus(c, SYSTEM, 0);
if (cl == NULL || !access_corpus(cl)) {
cqi_command(CQI_CQP_ERROR_NO_SUCH_CORPUS);
}
else {
send_cqi_corpus_attributes(cl->corpus, type);
}
free(c);
}
void
do_cqi_corpus_full_name(void)
{
char *c;
CorpusList *cl;
c = cqi_read_string();
if (server_debug)
Rprintf( "CQi: CQI_CORPUS_FULL_NAME('%s')\n", c);
cl = findcorpus(c, SYSTEM, 0);
if (cl == NULL || !access_corpus(cl)) {
cqi_command(CQI_CQP_ERROR_NO_SUCH_CORPUS);
}
else {
cqi_data_string(cl->corpus->name);
}
free(c);
}
/*
* ------------------------------------------------------------------------
*
* "rcqpCmd_corpus_info(SEXP inCorpus)" --
*
* The CQI_CORPUS_INFO switch is not yet implemented in cqpserver.
*
* ------------------------------------------------------------------------
*/
SEXP rcqpCmd_corpus_info(SEXP inCorpus)
{
SEXP result = R_NilValue;
char * c;
CorpusList * cl;
if (!isString(inCorpus) || length(inCorpus) != 1) error("invalid corpus name");
PROTECT(inCorpus);
c = (char*)CHAR(STRING_ELT(inCorpus,0));
cl = findcorpus(c, SYSTEM, 0);
if (cl == NULL || !access_corpus(cl)) {
rcqp_error_code(CQI_CQP_ERROR_NO_SUCH_CORPUS);
} else {
describe_corpus(cl->corpus);
}
UNPROTECT(1);
return result;
}
/*
* ------------------------------------------------------------------------
*
* "rcqpCmd_attributes(SEXP inCorpus, SEXP inType)" --
*
*
*
* ------------------------------------------------------------------------
*/
SEXP rcqpCmd_attributes(SEXP inCorpus, SEXP inType)
{
SEXP result = R_NilValue;
char *c;
CorpusList *cl;
Attribute * a;
int i = 0, n = 0, type;
if (!isString(inCorpus) || length(inCorpus) != 1) error("invalid corpus name");
PROTECT(inCorpus);
c = (char*)CHAR(STRING_ELT(inCorpus,0));
type = rcqp_get_attr_type(inType);
cl = findcorpus(c, SYSTEM, 0);
if (cl == NULL || !access_corpus(cl)) {
UNPROTECT(1);
rcqp_error_code(CQI_CQP_ERROR_NO_SUCH_CORPUS);
} else {
/* First count attributes */
for (a = first_corpus_attribute(cl->corpus); a != NULL; a = next_corpus_attribute()) {
if (a->type == type) n++;
}
result = PROTECT(allocVector(STRSXP, n));
/* Then build list of names */
for (a = first_corpus_attribute(cl->corpus); a != NULL; a = next_corpus_attribute()) {
if (a->type == type) {
SET_STRING_ELT(result, i, mkChar(a->any.name));
i++;
}
}
}
UNPROTECT(2);
return result;
}
/*
* ------------------------------------------------------------------------
*
* "rcqpCmd_full_name(SEXP inCorpus)" --
*
*
*
* ------------------------------------------------------------------------
*/
SEXP rcqpCmd_full_name(SEXP inCorpus)
{
SEXP result = R_NilValue;
char * c;
CorpusList * cl;
if (!isString(inCorpus) || length(inCorpus) != 1) error("invalid corpus name");
PROTECT(inCorpus);
c = (char*)CHAR(STRING_ELT(inCorpus,0));
cl = findcorpus(c, SYSTEM, 0);
if (cl == NULL || !access_corpus(cl)) {
UNPROTECT(1);
return R_NilValue;
} else {
result = PROTECT(allocVector(STRSXP, 1));
SET_STRING_ELT(result, 0, mkChar(cl->corpus->name));
}
UNPROTECT(2);
return result;
}
/**
* Outputs a blob of information on the mother-corpus of the specified cl.
*/
void
corpus_info(CorpusList *cl)
{
FILE *fd;
FILE *outfd;
char buf[CL_MAX_LINE_LENGTH];
int i, ok, stream_ok;
struct Redir rd = { NULL, NULL, NULL, 0, 0 }; /* for paging (with open_stream()) */
CorpusList *mom = NULL;
CorpusProperty p;
/* first, the case where cl is actually a full corpus */
if (cl->type == SYSTEM) {
stream_ok = open_stream(&rd, ascii);
outfd = (stream_ok) ? rd.stream : NULL; /* use pager, or simply print to stdout if it fails */
/* print size (should be the mother_size entry) */
fprintf(outfd, "Size: %d\n", cl->mother_size);
/* print charset */
fprintf(outfd, "Charset: ");
if (cl->corpus->charset == unknown_charset) {
fprintf(outfd, "<unsupported> (%s)\n", cl_corpus_property(cl->corpus, "charset"));
}
else {
fprintf(outfd, "%s\n", cl_charset_name(cl->corpus->charset));
}
/* print properties */
fprintf(outfd, "Properties:\n");
p = cl_first_corpus_property(cl->corpus);
if (p == NULL)
fprintf(outfd, "\t<none>\n");
else
for ( ; p != NULL; p = cl_next_corpus_property(p))
fprintf(outfd, "\t%s = '%s'\n", p->property, p->value);
fprintf(outfd, "\n");
if (cl->corpus->info_file == NULL)
fprintf(outfd, "No further information available about %s\n", cl->name);
else if ((fd = open_file(cl->corpus->info_file, "rb")) == NULL)
cqpmessage(Warning,
"Can't open info file %s for reading",
cl->corpus->info_file);
else {
ok = 1;
do {
i = fread(&buf[0], sizeof(char), CL_MAX_LINE_LENGTH, fd);
if (fwrite(&buf[0], sizeof(char), i, outfd) != i)
ok = 0;
} while (ok && (i == CL_MAX_LINE_LENGTH));
fclose(fd);
}
if (stream_ok)
close_stream(&rd); /* close pipe to pager if we were using it */
}
/* if cl is not actually a full corpus, try to find its mother and call this function on that */
else if (cl->mother_name == NULL)
cqpmessage(Warning,
"Corrupt corpus information for %s", cl->name);
else if ((mom = findcorpus(cl->mother_name, SYSTEM, 0)) != NULL) {
corpus_info(mom);
}
/* if the mother is not loaded, we just have to print an error */
else {
cqpmessage(Info,
"%s is a subcorpus of %s which is not loaded. Try 'info %s' "
"for information about %s.\n",
cl->name, cl->mother_name, cl->mother_name, cl->mother_name);
}
}
