diff options
author | William Joye <wjoye@cfa.harvard.edu> | 2019-01-03 16:54:16 (GMT) |
---|---|---|
committer | William Joye <wjoye@cfa.harvard.edu> | 2019-01-03 16:54:16 (GMT) |
commit | c0573da8973e0ae8650d787d639a9acf9ab4a1ac (patch) | |
tree | ae0daad36caaacde226aa18a75415b247b89148b /tclxml-libxml2.c | |
download | blt-c0573da8973e0ae8650d787d639a9acf9ab4a1ac.zip blt-c0573da8973e0ae8650d787d639a9acf9ab4a1ac.tar.gz blt-c0573da8973e0ae8650d787d639a9acf9ab4a1ac.tar.bz2 |
Squashed 'tclxml/' content from commit 22ffbb5a
git-subtree-dir: tclxml
git-subtree-split: 22ffbb5a3e984efb993e8b58cdf7a11ffddd1836
Diffstat (limited to 'tclxml-libxml2.c')
-rwxr-xr-x | tclxml-libxml2.c | 982 |
1 files changed, 982 insertions, 0 deletions
diff --git a/tclxml-libxml2.c b/tclxml-libxml2.c new file mode 100755 index 0000000..29ee985 --- /dev/null +++ b/tclxml-libxml2.c @@ -0,0 +1,982 @@ +/* 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: tclxml-libxml2.c,v 1.1.1.1 2009/01/16 22:11:49 joye 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, + * + *---------------------------------------------------------------------------- + */ + +int +Tclxml_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. + */ + +int +Tclxml_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 ClientData +ReaderCreate(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 int +TclXMLlibxml2Delete(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 int +ReaderReset(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 int +ReaderParse(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; + } + } + + 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 int +TclXMLlibxml2Configure(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 int +TclXMLlibxml2Get(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 xmlParserInputPtr +Result2ParserInput(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 xmlParserInputPtr +TclXMLlibxml2ExternalEntityLoader(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); + } +} |