diff options
Diffstat (limited to 'tclxml/tclxml-libxml2.c')
| -rwxr-xr-x | tclxml/tclxml-libxml2.c | 982 |
1 files changed, 0 insertions, 982 deletions
diff --git a/tclxml/tclxml-libxml2.c b/tclxml/tclxml-libxml2.c deleted file mode 100755 index 29ee985..0000000 --- a/tclxml/tclxml-libxml2.c +++ /dev/null @@ -1,982 +0,0 @@ -/* 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); - } -} |