USER_OBJECT_ RS_XML_copyNodesToDoc(USER_OBJECT_ s_node, USER_OBJECT_ s_doc, USER_OBJECT_ manageMemory) { xmlDocPtr doc; xmlNodePtr node, ptr; int len, i; SEXP ans; doc = (xmlDocPtr) R_ExternalPtrAddr(s_doc); if(TYPEOF(s_node) == EXTPTRSXP) { node = (xmlNodePtr) R_ExternalPtrAddr(s_node); ptr = xmlDocCopyNode(node, doc, 1); return(R_createXMLNodeRef(ptr, manageMemory)); } len = Rf_length(s_node); PROTECT(ans = NEW_LIST(len)); for(i = 0; i < len; i++) { node = (xmlNodePtr) R_ExternalPtrAddr(VECTOR_ELT(s_node, i)); ptr = xmlDocCopyNode(node, doc, 1); SET_VECTOR_ELT(ans, i, R_createXMLNodeRef(ptr, manageMemory)); } UNPROTECT(1); return(ans); }
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); }
void R_endBranch(RS_XMLParserData *rinfo, const xmlChar * localname, const xmlChar * prefix, const xmlChar * URI) { if(rinfo->current) { xmlNodePtr tmp; xmlDocPtr doc = NULL; tmp = rinfo->current; if(tmp->parent == NULL) { /* Call the function with the given node.*/ SEXP fun, args; USER_OBJECT_ rnode; if(rinfo->dynamicBranchFunction) fun = rinfo->dynamicBranchFunction; else { fun = VECTOR_ELT(rinfo->branches, rinfo->branchIndex); } PROTECT(args = NEW_LIST(1)); if(tmp->doc == NULL) { doc = xmlNewDoc("1.0"); initDocRefCounter(doc); xmlDocSetRootElement(doc, tmp); /* fprintf(stderr, "<r:createDoc addr='%p'/>\n", doc); */ numDocsCreated++; } SET_VECTOR_ELT(args, 0, rnode = R_createXMLNodeRef(tmp, rinfo->finalize)); RS_XML(invokeFunction)(fun, args, NULL, rinfo->ctx); UNPROTECT(1); /* xmlFreeNode(rinfo->top); rinfo->top = NULL; */ #if 0 fprintf(stderr, "Finishing branch for %s %s\n", tmp->name, tmp->properties->children->content); #endif /* if(rinfo->dynamicBranchFunction) R_ReleaseObject(rinfo->dynamicBranchFunction); */ } rinfo->current = rinfo->current->parent; if(rinfo->current && (rinfo->current->type == XML_DOCUMENT_NODE || rinfo->current->type == XML_HTML_DOCUMENT_NODE)) rinfo->current = NULL; } }