rendered paste body/* tcllibxml2.c -- * * A Tcl wrapper for libxml2. * * Copyright (c) 2005-2008 Explain. * http://www.explain.com.au/ * Copyright (c) 2003-2004 Zveno Pty Ltd * http://www.zveno.com/ * * See the file "LICENSE" for information on usage and * redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * $Id: tcllibxml2.c,v 1.10.2.1 2005/12/28 06:49:51 balls Exp $ */#include <tclxml-libxml2/tclxml-libxml2.h>#include <libxml/globals.h>#include <libxml/tree.h>#include <libxml/parserInternals.h>#include <libxml/xmlreader.h>#include <libxml/SAX2.h>#include <libxml/xmlerror.h>#include <libxml/uri.h>#include <string.h>#define TCL_DOES_STUBS \ (TCL_MAJOR_VERSION > 8 || TCL_MAJOR_VERSION == 8 && (TCL_MINOR_VERSION > 1 || \ (TCL_MINOR_VERSION == 1 && TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE)))/* * The structure below is used to refer to a libxml2 parser object. */typedef struct TclXMLlibxml2Info { Tcl_Interp *interp; /* Interpreter for this instance */ xmlTextReaderPtr reader; /* New TextReader interface */ Tcl_Obj *docObjPtr; /* Result of parsing */ TclXML_libxml2_DocumentHandling keep; /* Document handling flag */ Tcl_Obj *preserve; /* XPath for retaining (a portion of) the document */ Tcl_Obj *preservens; /* list of namespace declarations */ TclXML_Info *xmlinfo; /* Generic data structure */ Tcl_HashTable *scope; /* XML namespaces in scope */} TclXMLlibxml2Info;/* * Forward declarations for private functions. */static ClientData ReaderCreate _ANSI_ARGS_((Tcl_Interp *interp, TclXML_Info *xmlinfo));static int ReaderReset _ANSI_ARGS_((ClientData clientData));static int TclXMLlibxml2Delete _ANSI_ARGS_((ClientData clientData));static int ReaderParse _ANSI_ARGS_((ClientData clientData, char *data, int len, int final));static int TclXMLlibxml2Configure _ANSI_ARGS_((ClientData clientdata, Tcl_Obj *CONST optionPtr, Tcl_Obj *CONST valuePtr));static int TclXMLlibxml2Get _ANSI_ARGS_((ClientData clientData, int objc, Tcl_Obj *CONST objv[]));static xmlParserInputPtr TclXMLlibxml2ExternalEntityLoader _ANSI_ARGS_((const char *URL, const char *ID, xmlParserCtxtPtr ctxt));/* * Externally visible functions */typedef struct ThreadSpecificData { int initialized; Tcl_Interp *interp; /* * Interpose on default external entity loader */ TclXMLlibxml2Info *current; xmlExternalEntityLoader defaultLoader;} ThreadSpecificData;static Tcl_ThreadDataKey dataKey;/* * libxml2 is mostly thread-safe, but there are issues with error callbacks */TCL_DECLARE_MUTEX(libxml2)#ifndef CONST84#define CONST84 /* Before 8.4 no 'const' required */#endif/* *---------------------------------------------------------------------------- * * Tclxml_libxml2_Init -- * * Initialisation routine for loadable module * * Results: * None. * * Side effects: * Creates commands in the interpreter, * *---------------------------------------------------------------------------- */intTclxml_libxml2_Init (interp) Tcl_Interp *interp; /* Interpreter to initialise */{ ThreadSpecificData *tsdPtr; TclXML_ParserClassInfo *classinfo;#ifdef USE_TCL_STUBS if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { return TCL_ERROR; }#endif#ifdef USE_TCLXML_STUBS if (TclXML_InitStubs(interp, TCLXML_VERSION, 1) == NULL) { return TCL_ERROR; }#endif classinfo = (TclXML_ParserClassInfo *) ckalloc(sizeof(TclXML_ParserClassInfo)); classinfo->name = Tcl_NewStringObj("libxml2", -1); classinfo->create = ReaderCreate; classinfo->createCmd = NULL; classinfo->createEntity = NULL; /* TclXMLlibxml2CreateEntityParser; */ classinfo->createEntityCmd = NULL; classinfo->parse = ReaderParse; classinfo->parseCmd = NULL; classinfo->configure = TclXMLlibxml2Configure; classinfo->configureCmd = NULL; classinfo->get = TclXMLlibxml2Get; classinfo->getCmd = NULL; classinfo->destroy = TclXMLlibxml2Delete; classinfo->destroyCmd = NULL; classinfo->reset = ReaderReset; classinfo->resetCmd = NULL; if (TclXML_RegisterXMLParser(interp, classinfo) != TCL_OK) { Tcl_SetResult(interp, "unable to register parser", NULL); return TCL_ERROR; } /* Configure the libxml2 parser */ Tcl_MutexLock(&libxml2); xmlInitParser(); xmlSubstituteEntitiesDefault(1); /* * TODO: provide configuration option for setting this value. */ xmlLoadExtDtdDefaultValue |= 1; xmlLoadExtDtdDefaultValue |= XML_COMPLETE_ATTRS; /* * Override default entity loader so we can implement callbacks */ tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (!tsdPtr->initialized) { tsdPtr->initialized = 1; tsdPtr->interp = interp; tsdPtr->current = NULL; tsdPtr->defaultLoader = xmlGetExternalEntityLoader(); xmlSetExternalEntityLoader(TclXMLlibxml2ExternalEntityLoader); } /* only need to init the library once per process */ /* Setting the variable is insufficient - must create namespace too. */ if (Tcl_VarEval(interp, "namespace eval ::xml::libxml2 {variable libxml2version ", xmlParserVersion, "}\n", NULL) != TCL_OK) { return TCL_ERROR; } Tcl_MutexUnlock(&libxml2); TclXML_libxml2_InitDocObj(interp); #if (TCL_DOES_STUBS && USE_TCLXML_STUBS) { extern Tclxml_libxml2Stubs tclxml_libxml2Stubs; if (Tcl_PkgProvideEx(interp, "xml::libxml2", TCLXML_VERSION, (ClientData) &tclxml_libxml2Stubs) != TCL_OK) { return TCL_ERROR; } } #else if (Tcl_PkgProvide(interp, "xml::libxml2", TCLXML_VERSION) != TCL_OK) { return TCL_ERROR; } #endif return TCL_OK;}/* * TclXML/libxml2 is made safe by preventing the use of the default * external entity loader. */intTclxml_libxml2_SafeInit (interp) Tcl_Interp *interp; /* Interpreter to initialise */{ return Tclxml_libxml2_Init(interp);}/* *---------------------------------------------------------------------------- * * TclXMLlibxml2Create -- * * Prepare for parsing. * * Results: * Standard Tcl result. * * Side effects: * This creates a Text Reader. * *---------------------------------------------------------------------------- */static ClientDataReaderCreate(interp, xmlinfo) Tcl_Interp *interp; TclXML_Info *xmlinfo;{ TclXMLlibxml2Info *info; xmlParserInputBufferPtr inputPtr; if (!(info = (TclXMLlibxml2Info *) Tcl_Alloc(sizeof(TclXMLlibxml2Info)))) { Tcl_Free((char *) info); Tcl_SetResult(interp, "unable to create parser", NULL); return NULL; } info->interp = interp; info->xmlinfo = xmlinfo; info->preserve = NULL; info->preservens = NULL; /* Create a dummy input buffer for the purpose of creating the TextReader. * This will be replaced when we come to actually parse the document. */ Tcl_MutexLock(&libxml2); inputPtr = xmlAllocParserInputBuffer(XML_CHAR_ENCODING_NONE); if (inputPtr == NULL) { Tcl_MutexUnlock(&libxml2); Tcl_Free((char *) info); Tcl_SetResult(interp, "unable to create input buffer", NULL); return NULL; } info->reader = xmlNewTextReader(inputPtr, NULL); if (info->reader == NULL) { Tcl_MutexUnlock(&libxml2); Tcl_Free((char *) info); Tcl_SetResult(interp, "unable to create XML reader", NULL); return NULL; } xmlTextReaderSetStructuredErrorHandler(info->reader, (xmlStructuredErrorFunc) TclXML_libxml2_ErrorHandler, NULL); Tcl_MutexUnlock(&libxml2); info->docObjPtr = NULL; info->keep = TCLXML_LIBXML2_DOCUMENT_IMPLICIT; info->scope = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(info->scope, TCL_STRING_KEYS); return (ClientData) info;}/* *---------------------------------------------------------------------------- * * TclXMLlibxml2Delete -- * * Destroy the libxml2 parser structure. * * Results: * None. * * Side effects: * Frees any memory allocated for the XML parser. * *---------------------------------------------------------------------------- */static intTclXMLlibxml2Delete(clientData) ClientData clientData;{ TclXMLlibxml2Info *info = (TclXMLlibxml2Info *) clientData; if (info->reader) { xmlFreeTextReader(info->reader); } if (info->docObjPtr) { Tcl_DecrRefCount(info->docObjPtr); } if (info->preserve) { Tcl_DecrRefCount(info->preserve); } if (info->preservens) { Tcl_DecrRefCount(info->preservens); } Tcl_DeleteHashTable(info->scope); Tcl_Free((char *) info->scope); Tcl_Free((char *) info); return TCL_OK;}/* *---------------------------------------------------------------------------- * * ReaderReset -- * * Reset the libxml2 parser structure. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------------- */static intReaderReset(clientData)ClientData clientData;{ TclXML_Info *xmlinfo = (TclXML_Info *) clientData; if (xmlinfo->clientData == NULL) { xmlinfo->clientData = (ClientData) ReaderCreate(xmlinfo->interp, xmlinfo); if (xmlinfo->clientData == NULL) { return TCL_ERROR; } } return TCL_OK;}/* *---------------------------------------------------------------------------- * * ReaderParse -- * * Wrapper to invoke libxml2 parser and check return result. * * NB. Most of the logic from xmlSAXUserParseMemory is used here. * * Results: * TCL_OK if no errors, TCL_ERROR otherwise. * * Side effects: * Sets interpreter result as appropriate. * *---------------------------------------------------------------------------- */static intReaderParse(clientData, data, len, final) ClientData clientData; char *data; int len; int final;{ ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); TclXMLlibxml2Info *info = (TclXMLlibxml2Info *) clientData; Tcl_Obj *nameObj, *nsObj, *nsdeclObj, *valueObj, *attrsObj, *errObj, *baseuriObj, *sysidObj, *extidObj; const char *baseuri, *encoding, *name, *ns, *value; xmlChar **preservens = NULL; int ret, result = TCL_OK, i, listlen, options = 0, empty; /* not used... at present (see case XML_READER_TYPE_DOCUMENT_TYPE) xmlNodePtr nodePtr; */ xmlEntityPtr entityPtr = NULL; if (final == 0) { Tcl_SetResult(info->interp, "partial input not yet supported", NULL); return TCL_ERROR; } if (info->preserve && info->preservens) { if (Tcl_ListObjLength(info->interp, info->preservens, &listlen) != TCL_OK) { return TCL_ERROR; } preservens = (xmlChar **) Tcl_Alloc(len * sizeof(xmlChar *) + 1); for (i = 0; i < listlen; i++) { Tcl_Obj *objPtr; const char *str; int strlen; if (Tcl_ListObjIndex(info->interp, info->preservens, i, &objPtr) != TCL_OK) { Tcl_Free((char *) preservens); return TCL_ERROR; } str = Tcl_GetStringFromObj(objPtr, &strlen); preservens[i] = xmlCharStrndup(str, strlen); } preservens[listlen] = NULL; } if (info->xmlinfo->base) { baseuri = Tcl_GetStringFromObj(info->xmlinfo->base, NULL); } else { baseuri = NULL; } if (info->xmlinfo->encoding) { encoding = Tcl_GetStringFromObj(info->xmlinfo->encoding, NULL); if (strcmp(encoding, "unknown") == 0) { encoding = NULL; } } else { encoding = "utf-8"; } TclXML_libxml2_ResetError(info->interp); options |= XML_PARSE_NOCDATA; tsdPtr->current = info; Tcl_MutexLock(&libxml2); if (info->xmlinfo->expandinternalentities) { options |= XML_PARSE_NOENT; xmlSubstituteEntitiesDefault(1); } else { xmlSubstituteEntitiesDefault(0); } if (info->xmlinfo->nowhitespace) { options |= XML_PARSE_NOBLANKS; } if (xmlReaderNewMemory(info->reader, data, len, baseuri, encoding, options) != 0) { Tcl_MutexUnlock(&libxml2); if (preservens) { int i; for (i = 0; preservens[i]; i++) { xmlFree(preservens[i]); } Tcl_Free((char *) preservens); } tsdPtr->current = NULL; Tcl_SetResult(info->interp, "unable to prepare parser", NULL); return TCL_ERROR; } if (info->preserve) { int preserveret; preserveret = xmlTextReaderPreservePattern(info->reader, (const xmlChar *) Tcl_GetStringFromObj(info->preserve, NULL), (const xmlChar **) preservens); if (preserveret < 0) { Tcl_MutexUnlock(&libxml2); if (preservens) { int i; for (i = 0; preservens[i]; i++) { xmlFree(preservens[i]); } Tcl_Free((char *) preservens); } tsdPtr->current = NULL; Tcl_ResetResult(info->interp); Tcl_AppendResult(info->interp, "preparation for parsing failed: unable to preserve pattern \"", Tcl_GetStringFromObj(info->preserve, NULL), "\"", NULL); return TCL_ERROR; } } xmlTextReaderSetStructuredErrorHandler(info->reader, (xmlStructuredErrorFunc) TclXML_libxml2_ErrorHandler, NULL); for (ret = xmlTextReaderRead(info->reader); ret == 1; ret = xmlTextReaderRead(info->reader)) { result = TCL_OK; switch (xmlTextReaderNodeType(info->reader)) { case XML_READER_TYPE_ELEMENT: name = (const char *) xmlTextReaderConstLocalName(info->reader); ns = (const char *) xmlTextReaderConstNamespaceUri(info->reader); Tcl_MutexUnlock(&libxml2); if (name != NULL) { nameObj = Tcl_NewStringObj(name, -1); } else { nameObj = Tcl_NewObj(); } Tcl_IncrRefCount(nameObj); if (ns != NULL) { nsObj = Tcl_NewStringObj(ns, -1); } else { nsObj = Tcl_NewObj(); } Tcl_IncrRefCount(nsObj); attrsObj = Tcl_NewObj(); Tcl_IncrRefCount(attrsObj); Tcl_MutexLock(&libxml2); if (xmlTextReaderHasAttributes(info->reader)) { if (xmlTextReaderMoveToFirstAttribute(info->reader) == 1) { Tcl_Obj *itemObj; itemObj = Tcl_NewObj(); Tcl_SetStringObj(itemObj, (CONST char *) xmlTextReaderConstLocalName(info->reader), -1); Tcl_ListObjAppendElement(info->interp, attrsObj, itemObj); itemObj = Tcl_NewStringObj((CONST char *) xmlTextReaderConstValue(info->reader), -1); Tcl_ListObjAppendElement(info->interp, attrsObj, itemObj); while (xmlTextReaderMoveToNextAttribute(info->reader) == 1) { itemObj = Tcl_NewStringObj((CONST char *) xmlTextReaderConstLocalName(info->reader), -1); Tcl_ListObjAppendElement(info->interp, attrsObj, itemObj); itemObj = Tcl_NewStringObj((CONST char *) xmlTextReaderConstValue(info->reader), -1); Tcl_ListObjAppendElement(info->interp, attrsObj, itemObj); } } } empty = xmlTextReaderIsEmptyElement(info->reader); Tcl_MutexUnlock(&libxml2); nsdeclObj = Tcl_NewObj(); Tcl_IncrRefCount(nsdeclObj); TclXML_ElementStartHandler(info->xmlinfo, nameObj, nsObj, attrsObj, nsdeclObj); Tcl_DecrRefCount(nsdeclObj); if (empty) { TclXML_ElementEndHandler(info->xmlinfo, nameObj); } Tcl_DecrRefCount(nameObj); Tcl_DecrRefCount(nsObj); Tcl_DecrRefCount(attrsObj); break; case XML_READER_TYPE_END_ELEMENT: name = (const char *) xmlTextReaderConstLocalName(info->reader); ns = (const char *) xmlTextReaderConstNamespaceUri(info->reader); Tcl_MutexUnlock(&libxml2); if (name != NULL) { nameObj = Tcl_NewStringObj(name, -1); } else { nameObj = Tcl_NewObj(); } Tcl_IncrRefCount(nameObj); if (ns != NULL) { nsObj = Tcl_NewStringObj(ns, -1); } else { nsObj = Tcl_NewObj(); } Tcl_IncrRefCount(nsObj); TclXML_ElementEndHandler(info->xmlinfo, nameObj); Tcl_DecrRefCount(nameObj); Tcl_DecrRefCount(nsObj); break; case XML_READER_TYPE_TEXT: case XML_READER_TYPE_CDATA: case XML_READER_TYPE_WHITESPACE: case XML_READER_TYPE_SIGNIFICANT_WHITESPACE: value = (const char *) xmlTextReaderConstValue(info->reader); Tcl_MutexUnlock(&libxml2); if (value != NULL) { valueObj = Tcl_NewStringObj(value, -1); } else { valueObj = Tcl_NewObj(); } Tcl_IncrRefCount(valueObj); TclXML_CharacterDataHandler(info->xmlinfo, valueObj); Tcl_DecrRefCount(valueObj); break; case XML_READER_TYPE_COMMENT: value = (const char *) xmlTextReaderConstValue(info->reader); Tcl_MutexUnlock(&libxml2); if (value != NULL) { valueObj = Tcl_NewStringObj(value, -1); } else { valueObj = Tcl_NewObj(); } TclXML_CommentHandler(info->xmlinfo, valueObj); break; case XML_READER_TYPE_PROCESSING_INSTRUCTION: name = (const char *) xmlTextReaderConstName(info->reader); value = (const char *) xmlTextReaderConstValue(info->reader); Tcl_MutexUnlock(&libxml2); if (name != NULL) { nameObj = Tcl_NewStringObj(name, -1); } else { nameObj = Tcl_NewObj(); } if (value != NULL) { valueObj = Tcl_NewStringObj(value, -1); } else { valueObj = Tcl_NewObj(); } TclXML_ProcessingInstructionHandler(info->xmlinfo, nameObj, valueObj); break; case XML_READER_TYPE_ENTITY_REFERENCE: name = (const char *) xmlTextReaderConstName(info->reader); baseuri = (const char *) xmlTextReaderConstBaseUri(info->reader); entityPtr = xmlGetDocEntity(xmlTextReaderCurrentDoc(info->reader), (const xmlChar *) name); Tcl_MutexUnlock(&libxml2); nameObj = Tcl_NewStringObj(name, -1); Tcl_IncrRefCount(nameObj); baseuriObj = Tcl_NewStringObj(baseuri, -1); Tcl_IncrRefCount(baseuriObj); sysidObj = Tcl_NewStringObj((CONST char *) entityPtr->SystemID, -1); Tcl_IncrRefCount(sysidObj); extidObj = Tcl_NewStringObj((CONST char *) entityPtr->ExternalID, -1); Tcl_IncrRefCount(extidObj); result = TclXML_ExternalEntityRefHandler(info->xmlinfo, nameObj, baseuriObj, sysidObj, extidObj); Tcl_MutexLock(&libxml2); Tcl_DecrRefCount(nameObj); Tcl_DecrRefCount(baseuriObj); Tcl_DecrRefCount(sysidObj); Tcl_DecrRefCount(extidObj); if (result == TCL_ERROR || result == TCL_BREAK) { Tcl_MutexUnlock(&libxml2); xmlTextReaderClose(info->reader); break; } Tcl_MutexUnlock(&libxml2); break; case XML_READER_TYPE_DOCUMENT_TYPE: /* these are not used... at present name = xmlTextReaderName(info->reader); nodePtr = xmlTextReaderCurrentNode(info->reader); */ Tcl_MutexUnlock(&libxml2); default: break; } Tcl_MutexLock(&libxml2); } Tcl_MutexUnlock(&libxml2); if (preservens) { int i; for (i = 0; preservens[i]; i++) { xmlFree(preservens[i]); } Tcl_Free((char *) preservens); } if (ret != 0 || result != TCL_OK) { errObj = TclXML_libxml2_GetErrorObj(info->interp); if (errObj) { Tcl_SetObjResult(info->interp, errObj); } else { Tcl_SetResult(info->interp, "parsing error", NULL); } tsdPtr->current = NULL; return TCL_ERROR; } info->docObjPtr = TclXML_libxml2_CreateObjFromDoc(xmlTextReaderCurrentDoc(info->reader)); TclXML_libxml2_DocKeep(info->docObjPtr, info->keep); /* TODO: errObjPtr may contain warnings, flush them through */ tsdPtr->current = NULL; return TCL_OK;}/* *---------------------------------------------------------------------------- * * TclXMLlibxml2Configure -- * * Set options for the parser. * * Results: * None. * * Side effects: * None (there are no options to set). * *---------------------------------------------------------------------------- */static intTclXMLlibxml2Configure(clientData, optionPtr, valuePtr) ClientData clientData; Tcl_Obj *CONST optionPtr; Tcl_Obj *CONST valuePtr;{ TclXMLlibxml2Info *info = (TclXMLlibxml2Info *) clientData; int option, len; char *value; CONST84 char *Options[] = { "-keep", "-retainpath", "-retainpathns", NULL }; enum Options { OPTION_KEEP, OPTION_RETAINPATH, OPTION_RETAINPATHNS }; CONST84 char *KeepOptions[] = { "normal", "implicit", NULL }; enum KeepOptions { OPTION_KEEP_NORMAL, OPTION_KEEP_IMPLICIT }; if (Tcl_GetIndexFromObj(info->interp, optionPtr, Options, "option", 0, &option) != TCL_OK) { /* * Just ignore options we don't understand */ return TCL_OK; } switch ((enum Options) option) { case OPTION_KEEP: value = Tcl_GetStringFromObj(valuePtr, &len); if (len == 0) { info->keep = TCLXML_LIBXML2_DOCUMENT_KEEP; if (info->docObjPtr) { TclXML_libxml2_DocKeep(info->docObjPtr, TCLXML_LIBXML2_DOCUMENT_KEEP); return TCL_BREAK; } } else { if (Tcl_GetIndexFromObj(info->interp, valuePtr, KeepOptions, "value", 0, &option) != TCL_OK) { return TCL_ERROR; } switch ((enum KeepOptions) option) { case OPTION_KEEP_NORMAL: info->keep = TCLXML_LIBXML2_DOCUMENT_KEEP; if (info->docObjPtr) { TclXML_libxml2_DocKeep(info->docObjPtr, TCLXML_LIBXML2_DOCUMENT_KEEP); } return TCL_BREAK; case OPTION_KEEP_IMPLICIT: info->keep = TCLXML_LIBXML2_DOCUMENT_IMPLICIT; if (info->docObjPtr) { TclXML_libxml2_DocKeep(info->docObjPtr, TCLXML_LIBXML2_DOCUMENT_IMPLICIT); } return TCL_BREAK; default: Tcl_SetResult(info->interp, "bad value", NULL); return TCL_ERROR; } } break; case OPTION_RETAINPATH: if (info->preserve) { Tcl_DecrRefCount(info->preserve); } info->preserve = valuePtr; Tcl_IncrRefCount(valuePtr); return TCL_BREAK; case OPTION_RETAINPATHNS: if (info->preservens) { Tcl_DecrRefCount(info->preservens); } info->preservens = valuePtr; Tcl_IncrRefCount(valuePtr); return TCL_BREAK; default: Tcl_SetResult(info->interp, "no such option", NULL); return TCL_ERROR; } return TCL_OK;}/* *---------------------------------------------------------------------------- * * TclXMLlibxml2Get -- * * Retrieve data from the parser. * * Results: * Depends on argument. * * Side effects: * May create Tcl object. * *---------------------------------------------------------------------------- */static intTclXMLlibxml2Get(clientData, objc, objv) ClientData clientData; int objc; Tcl_Obj *CONST objv[];{ TclXMLlibxml2Info *info = (TclXMLlibxml2Info *) clientData; CONST84 char *methods[] = { "document", NULL }; enum methods { TCLXML_LIBXML2_GET_DOCUMENT }; int option; if (objc != 1) { Tcl_WrongNumArgs(info->interp, 0, objv, "method"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(info->interp, objv[0], methods, "method", 0, &option) != TCL_OK) { return TCL_ERROR; } switch ((enum methods) option) { case TCLXML_LIBXML2_GET_DOCUMENT: if (info->docObjPtr) { Tcl_SetObjResult(info->interp, info->docObjPtr); } break; default: Tcl_SetResult(info->interp, "unknown method", NULL); return TCL_ERROR; } return TCL_OK;}/* *---------------------------------------------------------------------------- * * TclXMLlibxml2ExternalEntityLoader -- * * Retrieve an external entity, allowing interposing by the application. * * Results: * External entity parsed. * * Side effects: * Depends on application callback. * *---------------------------------------------------------------------------- */static xmlParserInputPtrResult2ParserInput(interp, ctxt, URL) Tcl_Interp *interp; xmlParserCtxtPtr ctxt; const char *URL;{ xmlParserInputPtr inputPtr = NULL; /* build our own xmlParserInput from returned data */ inputPtr = xmlNewStringInputStream(ctxt, (const xmlChar *) Tcl_GetStringFromObj(Tcl_GetObjResult(interp), NULL)); if (inputPtr == NULL) { Tcl_SetResult(interp, "unable to create input stream", NULL); Tcl_BackgroundError(interp); return NULL; } inputPtr->filename = (char *) xmlCanonicPath((const xmlChar *) URL); return inputPtr;}static xmlParserInputPtrTclXMLlibxml2ExternalEntityLoader(URL, ID, ctxt) const char *URL; const char *ID; xmlParserCtxtPtr ctxt;{ ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); TclXMLlibxml2Info *info; Tcl_Interp *interp; int result; info = tsdPtr->current; if (info) { result = TclXML_ExternalEntityRefHandler(info->xmlinfo, NULL, NULL, Tcl_NewStringObj(URL, -1), Tcl_NewStringObj(ID, -1)); interp = info->interp; } else { result = TclXML_ExternalEntityRefHandler(NULL, NULL, NULL, Tcl_NewStringObj(URL, -1), Tcl_NewStringObj(ID, -1)); interp = tsdPtr->interp; } switch (result) { case TCL_OK: return Result2ParserInput(interp, ctxt, URL); case TCL_BREAK: return NULL; case TCL_CONTINUE: break; case TCL_ERROR: case TCL_RETURN: default: Tcl_BackgroundError(interp); return NULL; } if (Tcl_IsSafe(interp)) { return NULL; } else { return (tsdPtr->defaultLoader)(URL, ID, ctxt); }}