#include "RS_XML.h" #include "RSCommon.h" #include #include #include #include "Utils.h" #if 0 #define R_GET_EXTERNAL_REF(type, name) \ type \ name(SEXP obj) \ { \ SEXP ref = GET_SLOT(obj, Rf_install("ref")); \ if(TYPEOF(ref) != EXTPTRSXP) { \ Rf_error("Expected external pointer object"); \ } \ \ if(R_ExternalPtrTag(ref) != Rf_install(#type)) { \ Rf_error("Expected external pointer to have internal tag %s, got %s", \ #type, PRINTNAME(ref)); \ } \ \ return((type) R_ExternalPtrAddr(ref)); \ } R_GET_EXTERNAL_REF(xmlHashTablePtr, R_libxmlTypeTableGetRef) R_GET_EXTERNAL_REF(xmlSchemaElementPtr, R_libxmlSchemaElementGetRef) #endif void * R_getExternalRef(SEXP obj, const char *className) { SEXP ref = GET_SLOT(obj, Rf_install("ref")); void *ans; if(TYPEOF(ref) != EXTPTRSXP) { Rf_error("Expected external pointer object"); } if(className && R_ExternalPtrTag(ref) != Rf_install(className)) { Rf_error("Expected external pointer to have internal tag %s, got %s", className, CHAR(PRINTNAME(R_ExternalPtrTag(ref))) ); } ans = R_ExternalPtrAddr(ref); if(!ans) { Rf_error("Got NULL value in reference for %s", className); } return(ans); } typedef struct { int pos; USER_OBJECT_ els; USER_OBJECT_ names; char *elType; } HashGatherer; #if LIBXML_VERSION >= 20908 # define CONST const #else # define CONST #endif static void getKeys(void *el, void *data, CONST xmlChar *name) { HashGatherer *d = (HashGatherer *)data; SET_STRING_ELT(d->names, d->pos, COPY_TO_USER_STRING(name)); if(d->elType) { SET_VECTOR_ELT(d->els, d->pos, R_makeRefObject(el, d->elType)); } d->pos++; } USER_OBJECT_ R_libxmlTypeTable_names(USER_OBJECT_ table, USER_OBJECT_ s_elType) { xmlHashTablePtr t; int n = 0, ctr = 0; int getElements = GET_LENGTH(s_elType) > 0; HashGatherer d = {0, NULL_USER_OBJECT, NULL_USER_OBJECT, NULL}; t = R_getExternalRef(table, NULL); /* R_libxmlTypeTableGetRef(table); */ n = xmlHashSize(t); PROTECT(d.names = NEW_CHARACTER(n)); ctr++; if(getElements) { PROTECT(d.els = NEW_LIST(n)); ctr++; d.elType = (char *) CHAR_DEREF(STRING_ELT(s_elType, 0)); } xmlHashScan(t, getKeys, &d); if(getElements) SET_NAMES(d.els, d.names); else d.els = d.names; UNPROTECT(ctr); return(d.els); } USER_OBJECT_ R_libxmlTypeTable_lookup(USER_OBJECT_ table, USER_OBJECT_ name, USER_OBJECT_ s_elType) { xmlHashTablePtr t; USER_OBJECT_ ans; void *p; t = R_getExternalRef(table, NULL); /* R_libxmlTypeTableGetRef(table); */ p = xmlHashLookup(t, (const xmlChar *)CHAR_DEREF(STRING_ELT(name, 0))); ans = R_makeRefObject(p, CHAR_DEREF(STRING_ELT(s_elType, 0))); return(ans); } #define SchemaElement(id, type) \ USER_OBJECT_ \ R_libxmlTypeTable_##id(USER_OBJECT_ s) \ { \ xmlSchemaPtr schema; \ schema = R_getExternalRef(s, "xmlSchemaRef"); \ \ return(schema->id != NULL ? R_makeRefObject(schema->id, type) : R_NilValue); \ } SchemaElement(elemDecl, "SchemaElementTable") SchemaElement(typeDecl, "SchemaTypeTable") SchemaElement(attrDecl, "SchemaAttributeTable") SchemaElement(attrgrpDecl, "SchemaAttributeGroupTable") SchemaElement(notaDecl, "SchemaNotationTable") /* USER_OBJECT_ R_libxmlTypeTable_elemDecl(USER_OBJECT_ s) { xmlSchemaPtr schema; schema = R_getExternalRef(s, "xmlSchemaRef"); return(R_makeRefObject(schema->typeDecl, "SchemaElementTable")); } */ #include typedef struct { SEXP fun; } R_SchemaValidCallback; void R_schemaValidityFunctionCall(R_SchemaValidCallback *ctx, int warning, const char *msg, va_list args) { SEXP arg; char buf[10000]; vsnprintf(buf, sizeof(buf)/sizeof(buf[0]), msg, args); PROTECT(arg = mkString(buf)); SET_CLASS(arg, mkString(warning ? "XMLSchemaWarning" : "XMLSchemaError")); SETCAR(CDR(ctx->fun), arg); Rf_eval(ctx->fun, R_GlobalEnv); UNPROTECT(1); } void R_schemaValidityErrorFunc(R_SchemaValidCallback *ctx, const char *msg, ...) { va_list args; va_start(args, msg); R_schemaValidityFunctionCall(ctx, 0, msg, args); va_end(args); } void R_schemaValidityWarningFunc(R_SchemaValidCallback *ctx, const char *msg, ...) { va_list args; va_start(args, msg); R_schemaValidityFunctionCall(ctx, 1, msg, args); va_end(args); } SEXP RS_XML_xmlSchemaValidateDoc(SEXP r_schema, SEXP r_doc, SEXP r_options, SEXP r_errorHandlers) { xmlSchemaValidCtxtPtr ctxt; xmlDocPtr doc = (xmlDocPtr) R_ExternalPtrAddr(r_doc); xmlSchemaPtr schema = (xmlSchemaPtr) R_ExternalPtrAddr(r_schema); // int nprot = 0; // ctxt = (xmlSchemaValidCtxtPtr) R_ExternalPtrAddr(r_ctxt); int status; int numErrHandlers; ctxt = xmlSchemaNewValidCtxt(schema); if(LENGTH(r_options)) xmlSchemaSetValidOptions(ctxt, INTEGER(r_options)[0]); numErrHandlers = Rf_length(r_errorHandlers); if(numErrHandlers > 0) { R_SchemaValidCallback cbinfo; PROTECT(cbinfo.fun = allocVector(LANGSXP, 2)); SETCAR(cbinfo.fun, VECTOR_ELT(r_errorHandlers, 0)); xmlSchemaSetValidErrors(ctxt, (xmlSchemaValidityErrorFunc) R_schemaValidityErrorFunc, (xmlSchemaValidityWarningFunc) R_schemaValidityWarningFunc, &cbinfo); } status = xmlSchemaValidateDoc(ctxt, doc); xmlSchemaFreeValidCtxt(ctxt); /* R_alloc this if possible. */ if(numErrHandlers > 0) UNPROTECT(1); return(ScalarInteger(status)); } #if 0 SEXP RS_XML_xmlSchemaNewValidCtxt(SEXP r_schema, SEXP r_options, SEXP r_errorHandlers) { xmlSchemaPtr schema = (xmlSchemaPtr) R_ExternalPtrAddr(r_schema); xmlSchemaValidCtxtPtr ctxt; int numErrHandlers; ctxt = xmlSchemaNewValidCtxt(schema); if(LENGTH(r_options)) xmlSchemaSetValidOptions(ctxt, INTEGER(r_options)[0]); numErrHandlers = LENGTH(r_errorHandlers); if(numErrHandlers > 0) { R_SchemaValidCallback *cbinfo = (R_SchemaValidCallback*) malloc(sizeof(R_SchemaValidCallback)); cbinfo->fun = VECTOR_ELT(r_errorHandlers); xmlSchemaSetValidErrors(routine); } return(); } #endif