static void
RS_XML(xmlSAX2EndElementNs)(void * ctx,
const xmlChar * localname,
const xmlChar * prefix,
const xmlChar * URI)
{
USER_OBJECT_ args, tmp, fun;
RS_XMLParserData *rinfo = (RS_XMLParserData *) ctx;
DECL_ENCODING_FROM_EVENT_PARSER(rinfo)
if(rinfo->current) {
R_endBranch(rinfo, localname, prefix, URI);
return;
}
PROTECT(args = NEW_LIST(2));
SET_VECTOR_ELT(args, 0, ScalarString(ENC_COPY_TO_USER_STRING(localname)));
PROTECT(tmp = ScalarString(ENC_COPY_TO_USER_STRING((XMLCHAR_TO_CHAR(URI)) ? XMLCHAR_TO_CHAR(URI) : "")));
if(prefix)
SET_NAMES(tmp, ScalarString(ENC_COPY_TO_USER_STRING(prefix)));
SET_VECTOR_ELT(args, 1, tmp);
fun = findEndElementFun(localname, rinfo);
if(fun) {
USER_OBJECT_ val = RS_XML(invokeFunction)(fun, args, rinfo->stateObject, rinfo->ctx);
updateState(val, rinfo);
} else
RS_XML(callUserFunction)(HANDLER_FUN_NAME(ctx, "endElement"), NULL, (RS_XMLParserData *)ctx, args);
UNPROTECT(2);
}
static SEXP
convertNodeSetToR(xmlNodeSetPtr obj, SEXP fun, int encoding, SEXP manageMemory)
{
SEXP ans, expr = NULL, arg = NULL, ref;
int i;
if(!obj)
return(NULL_USER_OBJECT);
PROTECT(ans = NEW_LIST(obj->nodeNr));
if(GET_LENGTH(fun) && (TYPEOF(fun) == CLOSXP || TYPEOF(fun) == BUILTINSXP)) {
PROTECT(expr = allocVector(LANGSXP, 2));
SETCAR(expr, fun);
arg = CDR(expr);
} else if(TYPEOF(fun) == LANGSXP) {
expr = fun;
arg = CDR(expr);
}
for(i = 0; i < obj->nodeNr; i++) {
xmlNodePtr el;
el = obj->nodeTab[i];
if(el->type == XML_ATTRIBUTE_NODE) {
#if 0
PROTECT(ref = mkString((el->children && el->children->content) ? XMLCHAR_TO_CHAR(el->children->content) : ""));
SET_NAMES(ref, mkString(el->name));
#else
PROTECT(ref = ScalarString(mkCharCE((el->children && el->children->content) ? XMLCHAR_TO_CHAR(el->children->content) : "", encoding)));
SET_NAMES(ref, ScalarString(mkCharCE(el->name, encoding)));
#endif
SET_CLASS(ref, mkString("XMLAttributeValue"));
UNPROTECT(1);
} else if(el->type == XML_NAMESPACE_DECL)
ref = R_createXMLNsRef((xmlNsPtr) el);
else
ref = R_createXMLNodeRef(el, manageMemory);
if(expr) {
PROTECT(ref);
SETCAR(arg, ref);
PROTECT(ref = Rf_eval(expr, R_GlobalEnv)); /*XXX do we want to catch errors here? Maybe to release the namespaces. */
SET_VECTOR_ELT(ans, i, ref);
UNPROTECT(2);
} else
SET_VECTOR_ELT(ans, i, ref);
}
if(expr) {
if(TYPEOF(fun) == CLOSXP || TYPEOF(fun) == BUILTINSXP)
UNPROTECT(1);
} else
SET_CLASS(ans, mkString("XMLNodeSet"));
UNPROTECT(1);
return(ans);
}
SEXP
convertXPathObjectToR(xmlXPathObjectPtr obj, SEXP fun, int encoding, SEXP manageMemory)
{
SEXP ans = NULL_USER_OBJECT;
switch(obj->type) {
case XPATH_NODESET:
ans = convertNodeSetToR(obj->nodesetval, fun, encoding, manageMemory);
break;
case XPATH_BOOLEAN:
ans = ScalarLogical(obj->boolval);
break;
case XPATH_NUMBER:
ans = ScalarReal(obj->floatval);
if(xmlXPathIsInf(obj->floatval))
REAL(ans)[0] = xmlXPathIsInf(obj->floatval) < 0 ? R_NegInf : R_PosInf;
else if(xmlXPathIsNaN(obj->floatval))
REAL(ans)[0] = NA_REAL;
break;
case XPATH_STRING:
ans = mkString(XMLCHAR_TO_CHAR(obj->stringval)); //XXX encoding
break;
case XPATH_POINT:
case XPATH_RANGE:
case XPATH_LOCATIONSET:
case XPATH_USERS:
PROBLEM "currently unsupported xmlXPathObject type %d in convertXPathObjectToR. Please send mail to maintainer.", obj->type
WARN
default:
ans = R_NilValue;
}
return(ans);
}
void
RS_XML(cdataBlockHandler)(void *ctx, const xmlChar *value, int len)
{
USER_OBJECT_ opArgs;
RS_XMLParserData *parserData = (RS_XMLParserData*) ctx;
DECL_ENCODING_FROM_EVENT_PARSER(parserData)
if(parserData->current) {
xmlAddChild(parserData->current, xmlNewCDataBlock(NULL, value, len));
return;
}
PROTECT(opArgs = NEW_LIST(1));
SET_VECTOR_ELT(opArgs, 0, NEW_CHARACTER(1));
SET_STRING_ELT(VECTOR_ELT(opArgs, 0), 0, ENC_COPY_TO_USER_STRING(XMLCHAR_TO_CHAR(value)));
RS_XML(callUserFunction)(HANDLER_FUN_NAME(parserData, "cdata"), (const char *)NULL, (RS_XMLParserData*)ctx, opArgs);
UNPROTECT(1);
}
int
R_isBranch(const xmlChar *localname, RS_XMLParserData *rinfo)
{
int n;
if(rinfo->current)
return(-2); /* we are processing a branch */
if((n = GET_LENGTH(rinfo->branches)) > 0) {
int i;
USER_OBJECT_ names = GET_NAMES(rinfo->branches);
for(i = 0 ; i < n ; i++) {
if(strcmp(XMLCHAR_TO_CHAR(localname), CHAR_DEREF(STRING_ELT(names, i))) == 0) {
return(i);
}
}
}
return(-1);
}
static void
RS_XML(xmlSAX2StartElementNs)(void * userData,
const xmlChar * localname,
const xmlChar * prefix,
const xmlChar * URI,
int nb_namespaces,
const xmlChar ** namespaces,
int nb_attributes,
int nb_defaulted,
const xmlChar ** attributes)
{
int i, n;
USER_OBJECT_ tmp, names;
USER_OBJECT_ opArgs, ans;
RS_XMLParserData *rinfo = (RS_XMLParserData*) userData;
DECL_ENCODING_FROM_EVENT_PARSER(rinfo)
if(!localname)
return;
/* if there is a branch function in the branches argument of xmlEventParse() with this name, call that and return.*/
if((i = R_isBranch(localname, rinfo)) != -1) {
R_processBranch(rinfo, i, localname, prefix, URI, nb_namespaces, namespaces, nb_attributes, nb_defaulted, attributes, FALSE);
return;
}
PROTECT(opArgs = NEW_LIST(4));
SET_VECTOR_ELT(opArgs, 0, NEW_CHARACTER(1));
SET_STRING_ELT(VECTOR_ELT(opArgs, 0), 0, ENC_COPY_TO_USER_STRING(XMLCHAR_TO_CHAR(localname)));
/* Now convert the attributes list. */
SET_VECTOR_ELT(opArgs, 1, createSAX2AttributesList(attributes, nb_attributes, nb_defaulted, encoding));
PROTECT(tmp = NEW_CHARACTER(1));
if(URI) {
SET_STRING_ELT(tmp, 0, ENC_COPY_TO_USER_STRING(XMLCHAR_TO_CHAR(URI)));
SET_NAMES(tmp, ScalarString(CreateCharSexpWithEncoding(encoding, ( (void*)prefix ? XMLCHAR_TO_CHAR(prefix) : ""))));
}
SET_VECTOR_ELT(opArgs, 2, tmp);
UNPROTECT(1);
n = nb_namespaces;
PROTECT(tmp = NEW_CHARACTER(n));
PROTECT(names = NEW_CHARACTER(n));
for(i = 0, n = 0; n < nb_namespaces; n++, i+=2) {
SET_STRING_ELT(tmp, n, ENC_COPY_TO_USER_STRING(XMLCHAR_TO_CHAR(namespaces[i+1])));
if(namespaces[i])
SET_STRING_ELT(names, n, ENC_COPY_TO_USER_STRING(XMLCHAR_TO_CHAR(namespaces[i])));
}
SET_NAMES(tmp, names);
SET_VECTOR_ELT(opArgs, 3, tmp);
UNPROTECT(2);
ans = RS_XML(callUserFunction)(HANDLER_FUN_NAME(rinfo, "startElement"), XMLCHAR_TO_CHAR(localname), rinfo, opArgs);
/* If the handler function returned us a SAXBranchFunction function, then we need to build the node's sub-tree and
then invoke the function with that node as the main argument. (It may also get the context/parser.) */
if(isBranchFunction(ans)) {
/* Hold on to the function to avoid it being garbage collected. */
R_PreserveObject(rinfo->dynamicBranchFunction = ans);
/* Start the creation of the node's sub-tree. */
R_processBranch(rinfo, -1, localname, prefix, URI, nb_namespaces, namespaces, nb_attributes, nb_defaulted, attributes, FALSE);
}
UNPROTECT(1);
}
