|
|
|   written by Rolf Ade
|   2022
|
\---------------------------------------------------------------------------*/

#include <dom.h>
#include <stdint.h>
#include <domjson.h>
#include <schema.h>

#ifndef TDOM_NO_SCHEMA

#define CHECK_TI                                                        \

    info->nextFeedbackPosition = info->feedbackAfter;
    
    Tcl_ResetResult (info->interp);
    result = 1;
    if (chan == NULL) {
        do {
            done = (len < PARSE_CHUNK_SIZE);
            status = XML_Parse (extparser, xmlstring,
                                (int)(done ? len : PARSE_CHUNK_SIZE), done);
            if (!done) {
                xmlstring += PARSE_CHUNK_SIZE;
                len -= PARSE_CHUNK_SIZE;
            }
        }  while (!done && status == XML_STATUS_OK);
        switch (status) {
        case XML_STATUS_ERROR:

        default:
            break;
        }
    } else {
        do {
            len = Tcl_Read (chan, buf, sizeof(buf));
            done = len < sizeof(buf);
            status = XML_Parse (extparser, buf, (int)len, done);
            switch (status) {
            case XML_STATUS_ERROR:
                interpResult = Tcl_GetStringResult(info->interp);
                sprintf(s, "%ld", XML_GetCurrentLineNumber(extparser));
                if (interpResult[0] == '\0') {
                    Tcl_ResetResult (info->interp);
                    Tcl_AppendResult(info->interp, "error \"",

#endif
    Tcl_Interp *interp,
    domParseForestErrorData *forestError,
    int        *resultcode
)
{
    int             done;
    domLength       tclLen, len;
    enum XML_Status status;

    domReadInfo     info;
    char            buf[8192];
    Tcl_Obj        *bufObj;
    Tcl_DString     dStr;
    int             useBinary = 0;
    char           *str;
    domDocument    *doc = domCreateDoc(baseurl, storeLineColumn);

        info.parser = parser;
        info.currentNode = doc->rootNode;
    }
    
    if (channel == NULL) {
        do {
            done = (length < PARSE_CHUNK_SIZE);
            status = XML_Parse (parser, xml,
                                (int)(done ? length : PARSE_CHUNK_SIZE), done);
            if (!done) {
                xml += PARSE_CHUNK_SIZE;
                length -= PARSE_CHUNK_SIZE;
            }
        }  while (!done && status == XML_STATUS_OK);
    } else {
        Tcl_DStringInit (&dStr);

                done = len < sizeof(buf);
            } else {
                len = Tcl_ReadChars (channel, bufObj, 1024, 0);
                done = (len < 1024);
                str = Tcl_GetStringFromObj (bufObj, &tclLen);
            }
            if (useBinary) {
                status = XML_Parse (parser, buf, (int)len, done);
            } else {
                status = XML_Parse (parser, str, (int)tclLen, done);
            }
        } while (!done && status == XML_STATUS_OK);
    }
    switch (status) {
    case XML_STATUS_SUSPENDED:
        DBG(fprintf(stderr, "XML_STATUS_SUSPENDED\n");)
            if (info.status == TCL_BREAK) {

    "FQVARIABLE", "WCARDNAME", "COMMENT", "TEXT", "PI", "NODE", "AXISNAME",
    "EOS"
};


typedef struct {

    Token      token;
    char      *strvalue;
    domLength  intvalue;
    double     realvalue;
    domLength  pos;

} XPathToken;

typedef XPathToken *XPathTokens;


/*----------------------------------------------------------------------------

    char tmp[80];
    switch (rs->type) {
        case EmptyResult:
             fprintf(stderr, "empty result \n");
             break;

        case BoolResult:
             fprintf(stderr, "boolean result: %" TCL_SIZE_MODIFIER "d \n",
                     rs->intvalue);
             break;

        case IntResult:
             fprintf(stderr, "int result: %" TCL_SIZE_MODIFIER "d \n",
                     rs->intvalue);
             break;

        case RealResult:
             fprintf(stderr, "real result: %f \n", rs->realvalue);
             break;

        case StringResult:

}
void rsSetInf ( xpathResultSet *rs ) {
    rs->type = InfResult;
}
void rsSetNInf ( xpathResultSet *rs ) {
    rs->type = NInfResult;
}
void rsSetLong ( xpathResultSet *rs, domLength i) {
    rs->type = IntResult;
    rs->intvalue = i;
}
void rsSetBool ( xpathResultSet *rs, domLength i) {
    rs->type = BoolResult;
    rs->intvalue = (i ? 1 : 0);
}
void rsSetString ( xpathResultSet *rs, const char *s) {
    rs->type = StringResult;
    if (s) {
        rs->string     = tdomstrdup(s);

        t->child->next = New1(EvalSteps, b);
    } else {
        t->child->next = b;
    }
    return t;
}

static ast NewInt( domLength i ) {
    ast t = NEWCONS;

    t->type      = Int;
    t->strvalue  = NULL;
    t->intvalue  = i;
    t->realvalue = 0.0;

    int i;

    while (t) {
        for (i=0; i<depth; i++) fprintf(stderr, "   ");
        fprintf(stderr, "%s ", astType2str[t->type]);
        switch (t->type) {

            case Int :
                fprintf(stderr, "%" TCL_SIZE_MODIFIER "d", t->intvalue);   break;
            case Real:        fprintf(stderr, "%f", t->realvalue);  break;
            case IsElement:
            case IsFQElement:
            case IsNSAttr:
            case IsAttr:
            case ExecFunction:
            case Literal:

EndProduction


/*-----------------------------------------------------------------
|   Step  production
|
\----------------------------------------------------------------*/
static domLength IsStepPredOptimizable (ast a) {
    ast b;
    domLength left;
    
    /* Must be called with a != NULL */
    DBG (
        fprintf (stderr, "IsStepPredOptimizable:\n");
        printAst (0,a);
    )
    switch (a->type) {

        }
        a = a->next;
    }
    return 0;
}

/* Must be called with a != NULL */
static int checkStepPatternPredOptimizability ( ast a , domLength *max) {
    ast b;

    switch (a->type) {
        case Literal:
        case AxisAncestor:
        case AxisAncestorOrSelf:
        case AxisChild:

        default: 
            return 0;
    }
    return 1;
}

/* Must be called with a != NULL */
static long IsStepPatternPredOptimizable ( ast a, domLength *max ) {
    long f;

    *max = 0;
    f = checkStepPatternPredOptimizability(a, max);
    DBG(
        if (f) {
            fprintf(stderr, "\nStepPattern Pred is optimizable:\n");

    if (!a) {
        if (*errMsg == NULL) { ErrExpected("StepPattern") }; 
        return NULL;
    }
    {
        ast b = NULL, c = NULL, aCopy = NULL;
        int stepIsOptimizable = 1, isFirst = 1;
        domLength max, savedmax;
        while (LA==LBRACKET) {
            b = Recurse (Predicate);
            if (!b) return a;
            if (stepIsOptimizable) {
                if (!IsStepPatternPredOptimizable(b, &max)) 
                    stepIsOptimizable = 0;
            }

        newlen = strlen(xpath);
        *errMsg = (char*)REALLOC(*errMsg, len+newlen+10);
        memmove(*errMsg + len, " for '", 6);
        memmove(*errMsg + len+6, xpath, newlen);
        memmove(*errMsg + len+6+newlen, "' ", 3);

        for (i=0; tokens[i].token != EOS; i++) {
            sprintf(tmp, "%s\n%3s%3d %-12s %5" TCL_SIZE_MODIFIER "d %09.3g %5" TCL_SIZE_MODIFIER "d  ",
                         (i==0) ? "\n\nParsed symbols:" : "",
                         (i==l) ? "-->" : "   ",
                          i,
                         token2str[tokens[i].token-LPAR],
                         tokens[i].intvalue,
                         tokens[i].realvalue,
                         tokens[i].pos

{
    double d;
    char  *pc, *tailptr;

    *NaN = 0;
    switch (rs->type) {
        case BoolResult:   return (rs->intvalue? 1.0 : 0.0);
    case IntResult:        return (double)rs->intvalue;
        case RealResult:   
            if (IS_NAN(rs->realvalue)) *NaN = 2;
            else if (IS_INF(rs->realvalue)!=0) *NaN = IS_INF(rs->realvalue);
            return rs->realvalue;
        case NaNResult:
            *NaN = 2;
            return 0.0;

    domLength    len;

    switch (rs->type) {
        case BoolResult:
            if (rs->intvalue) return (tdomstrdup("true"));
                         else return (tdomstrdup("false"));
        case IntResult:
            sprintf(tmp, "%" TCL_SIZE_MODIFIER "d", rs->intvalue);
            return (tdomstrdup(tmp));

        case RealResult:
            if (IS_NAN (rs->realvalue)) return tdomstrdup ("NaN");
            else if (IS_INF (rs->realvalue)) {
                if (IS_INF (rs->realvalue) == 1) return tdomstrdup ("Infinity");
                else                             return tdomstrdup ("-Infinity");

            if      (NaN == 2)  rsSetNaN (result);
            else if (NaN == 1)  rsSetInf (result);
            else                rsSetNInf (result);
        } else {
            if      (step->intvalue == f_floor)   leftReal = floor(leftReal);
            else if (step->intvalue == f_ceiling) leftReal = ceil(leftReal);
            else                                  leftReal = 
                                                      (double)xpathRound(leftReal);
            rsSetReal2 (result, leftReal);
        }
        xpathRSFree( &leftResult );
        break;

    case f_boolean:
        XPATH_ARITYCHECK(step,1,errMsg);

                    break;
                }
                ufStr++;
            }
            if (found) {
                if (j < len) {
                    unichar = Tcl_UniCharAtIndex (replaceStr, j);
                    utfCharLen = (int)Tcl_UniCharToUtf (unichar, utfBuf);
                    Tcl_DStringAppend (&tresult, utfBuf, utfCharLen);
                }
            } else {
                utfCharLen = (int)Tcl_UniCharToUtf (*upfrom, utfBuf);
                Tcl_DStringAppend (&tresult, utfBuf, utfCharLen);
            }
            upfrom++;
        }
        rsSetString (result, Tcl_DStringValue (&tresult));
        Tcl_DStringFree (&tstr);
        Tcl_DStringFree (&tfrom);

    domNode   * node,
    char     ** xpath,
    domLength * xpathLen,
    domLength * xpathAllocated,
    int         legacy
)
{
    domNode  *parent, *child;
    char      step[200], *nTest;
    domLength len;
    int       sameNodes, nodeIndex;

    parent = node->parentNode;
    if (parent == NULL) {
        parent = node->ownerDocument->rootNode;
    } else {
        nodeToXPath (parent, xpath, xpathLen, xpathAllocated, legacy);
    }

\---------------------------------------------------------------------------*/
char * xpathNodeToXPath (
    domNode *node,
    int      legacy
)
{
    char  * xpath;
    domLength xpathLen, xpathAllocated;


    xpathAllocated = 100;
    xpathLen       = 0;
    xpath          = MALLOC(xpathAllocated + 1);

    nodeToXPath (node, &xpath, &xpathLen, &xpathAllocated, legacy);

    return xpath;

} /* xpathNodeToXPath */

typedef struct astElem {
    astType         type;
    struct astElem *child;
    struct astElem *next;
    char           *strvalue;
    domLength       intvalue;
    double          realvalue;
} astElem;

typedef astElem *ast;


/*----------------------------------------------------------------------------

} xpathResultType;

typedef struct xpathResultSet {

    xpathResultType type;
    char           *string;
    domLength       string_len;
    domLength       intvalue;
    double          realvalue;          
    domNode       **nodes;
    domLength       nr_nodes;
    domLength       allocated;

} xpathResultSet;

char * xpathFuncStringForNode (domNode *node);
domLength xpathRound        (double r);

char * xpathGetStringValue (domNode *node, domLength *strLen);

char * xpathNodeToXPath  (domNode *node, int legacy);
    
void rsSetBool      ( xpathResultSet *rs, domLength    i    );
void rsSetLong      ( xpathResultSet *rs, domLength    i    );
void rsSetReal      ( xpathResultSet *rs, double       d    );
void rsSetReal2     ( xpathResultSet *rs, double       d    );
void rsSetString    ( xpathResultSet *rs, const char  *s    );
void rsAddNode      ( xpathResultSet *rs, domNode     *node );
void rsAddNodeFast  ( xpathResultSet *rs, domNode     *node );
void rsCopy         ( xpathResultSet *to, xpathResultSet *from );

/* This function is only used for debugging code */
void rsPrint        ( xpathResultSet *rs );

const char * xpathResultType2string (xpathResultType type);

/* This function is used (outside of tcldom.c) only by schema.c. It
 * has to have a prototype somewhere. */
int tcldom_xpathFuncCallBack (
    void            *clientData,
    char            *functionName,
    domNode         *ctxNode,
    domLength       position,
    xpathResultSet  *nodeList,
    domNode         *exprContext,
    int              argc,
    xpathResultSets *args,
    xpathResultSet  *result,
    char           **errMsg
    );

#endif

    domLength         value,
    Tcl_DString      *str,
    char             *groupingSeparator,
    long              groupingSize,
    int               addSeparater
)
{
    domLength   len, fulllen, gslen, m, i;
    int         upper = 0, e, b, v, z;
    char        tmp[80], *pt;
    Tcl_DString tmp1;
    static struct { char *digit; char *ldigit; int value; } RomanDigit[] = {
          { "M" , "m" , 1000, },
          { "CM", "cm",  900, },
          { "D" , "d" ,  500, },
          { "CD", "cd",  400, },
          { "C" , "c" ,  100, },
          { "XC", "xc",   90, },
          { "L" , "l" ,   50, },
          { "XL", "xl",   40, },
          { "X" , "x" ,   10, },
          { "IX", "ix",    9, },
          { "V" , "v" ,    5, },
          { "IV", "iv",    4, },
          { "I" , "i" ,    1  }
    };

    switch (f->tokens[*useFormatToken].type) {
    case latin_number:
        sprintf (tmp, "%" TCL_SIZE_MODIFIER "d", value);
        fulllen = len = strlen (tmp);
        if (f->tokens[*useFormatToken].minlength > fulllen) {
            fulllen = f->tokens[*useFormatToken].minlength;
        }
        if (groupingSeparator) {
            gslen = strlen (groupingSeparator);
            Tcl_DStringInit (&tmp1);

           faster / more clever. */

        if (value <= 0) {
            /* Hm, zero can't be expressed with letter sequences...
               What to do? One of the several cases, not mentioned
               by the spec. */
            /* fall back to latin numbers */
            sprintf (tmp, "%" TCL_SIZE_MODIFIER "d", value);
            break;
        }
        e = 1;
        m = b = 26;
        while (value > m) {
            b *= 26;
            m += b;
            e++;
        }
        m -= b;
        value -= m;
        for (i = 0; i < e; i++) {
            b /= 26;
            z = (int)(value / b);
            value = value - z*b;
            if (i < e -1) {
                if (value == 0) {
                    value += b;
                } else {
                    z++;
                }

        /* Side note: There exists a rarely used roman notation
           to express figures up to a few millions. Does somebody
           really need this? */

        if (value > 3999 || value <= 0) {
            /* fall back to latin numbers */
            sprintf (tmp, "%" TCL_SIZE_MODIFIER "d", value);
            break;
        }
        if (value == 0) {
            /* what to do with zero??? */
            sprintf (tmp, "%d", 0);
            break;
        }
        v = 0;  tmp[0] = '\0';
        while (value > 0) {
            while (value >= RomanDigit[v].value) {
                if (upper) { strcat(tmp,  RomanDigit[v].digit);  }
                      else { strcat(tmp,  RomanDigit[v].ldigit); }
                value -= RomanDigit[v].value;
            }
            v++;
        }
        break;

    default:
        sprintf (tmp, "%" TCL_SIZE_MODIFIER "d", value);
        break;
    }
    len = strlen (tmp);
    Tcl_DStringAppend (str, tmp, len);
 appendSeperator:
    if (addSeparater) {
        if (f->tokens[*useFormatToken].sepStart) {

|   xsltXPathFuncs
|
\---------------------------------------------------------------------------*/
static int xsltXPathFuncs (
    void            * clientData,
    char            * funcName,
    domNode         * ctxNode,
    domLength         ctxPos,
    xpathResultSet  * ctx,
    domNode         * exprContext,
    int               argc,
    xpathResultSets * argv,
    xpathResultSet  * result,
    char           ** errMsg
)

|
|
|   written by Rolf Ade
|   2018-2022
|
\---------------------------------------------------------------------------*/

#include <dom.h>
#include <tcldom.h>
#include <domxpath.h>
#include <domjson.h>
#include <schema.h>
#include <datatypes.h>

#ifndef TDOM_NO_SCHEMA

    XML_SetBase (extparser, extbase);

    Tcl_ResetResult (vdata->interp);
    result = 1;
    if (chan == NULL) {
        do {
            done = (len < PARSE_CHUNK_SIZE);
            status = XML_Parse (extparser, xmlstring,
                                (int)(done ? len : PARSE_CHUNK_SIZE), done);
            if (!done) {
                xmlstring += PARSE_CHUNK_SIZE;
                len -= PARSE_CHUNK_SIZE;
            }
        }  while (!done && status == XML_STATUS_OK);
        switch (status) {
        case XML_STATUS_ERROR:

        default:
            break;
        }
    } else {
        do {
            len = Tcl_Read (chan, buf, sizeof(buf));
            done = len < sizeof(buf);
            status = XML_Parse (extparser, buf, (int)len, done);
            switch (status) {
            case XML_STATUS_ERROR:
                interpResult = Tcl_GetStringResult(vdata->interp);
                sprintf(s, "%ld", XML_GetCurrentLineNumber(extparser));
                if (interpResult[0] == '\0') {
                    Tcl_ResetResult (vdata->interp);
                    Tcl_AppendResult(vdata->interp, "error \"",

    switch (source) {
    case VALIDATE_STRING:
        xmlstr = Tcl_GetStringFromObj (objv[0], &len);
        result = TCL_OK;
        do {
            done = (len < PARSE_CHUNK_SIZE);
            if (XML_Parse (parser, xmlstr,
                           (int)(done ? len : PARSE_CHUNK_SIZE), done)
                != XML_STATUS_OK
                || sdata->validationState == VALIDATION_ERROR) {
                validateReportError (interp, sdata, parser);
                result = TCL_ERROR;
                break;
            }
            if (!done) {

                close (fd);
                Tcl_ResetResult (interp);
                Tcl_AppendResult (interp, "error reading from file \"",
                                  filename, "\"", (char *) NULL);
                result = TCL_ERROR;
                goto cleanup;
            }
            result = XML_ParseBuffer (parser, (int)nread, nread == 0);
            if (result != XML_STATUS_OK || !nread
                || sdata->validationState == VALIDATION_ERROR) {
                close (fd);
                break;
            }
        }
        if (result != XML_STATUS_OK

        bufObj = Tcl_NewObj();
        Tcl_SetObjLength (bufObj, 6144);
        result = TCL_OK;
        do {
            len = Tcl_ReadChars (channel, bufObj, 1024, 0);
            done = (len < 1024);
            str = Tcl_GetStringFromObj(bufObj, &tclLen);
            rc = XML_Parse (parser, str, (int)tclLen, done);
            if (rc != XML_STATUS_OK 
                || sdata->validationState == VALIDATION_ERROR) {
                validateReportError (interp, sdata, parser);
                result = TCL_ERROR;
                break;
            }
        } while (!done);

|   tcldom_xpathFuncCallBack
|
\---------------------------------------------------------------------------*/
int tcldom_xpathFuncCallBack (
    void            *clientData,
    char            *functionName,
    domNode         *ctxNode,
    domLength        position,
    xpathResultSet  *nodeList,
    domNode         *UNUSED(exprContext),
    int              argc,
    xpathResultSets *args,
    xpathResultSet  *result,
    char           **errMsg
)

int  tcldom_PINameCheck(Tcl_Interp *interp, char *name);
int  tcldom_nameCheck(Tcl_Interp *interp, char *name, char *nameType,
                      int isFQName);
void tcldom_createNodeObj(Tcl_Interp * interp, domNode *node,
                          char *objCmdName);

domNode * tcldom_getNodeFromObj(Tcl_Interp  *interp, Tcl_Obj *nodeObj);
domDocument * tcldom_getDocumentFromName(Tcl_Interp *interp,
				char *docName, char **errMsg);
int tcldom_prefixNSlist (char ***prefixnsPtr, Tcl_Interp *interp, int objc,
                         Tcl_Obj *const objv[], const char *methodName);
int tcldom_setInterpAndReturnVar (Tcl_Interp *interp, domNode *node,
                                  int setVariable, Tcl_Obj *var_name);

void tcldom_initialize(void);
void tcldom_deleteDoc (Tcl_Interp *interp, domDocument *doc);

    Tcl_Interp *interp,
    TclGenExpatInfo *expat,
    char *data,
    domLength len,
    TclExpat_InputType type
) {
  int result, mode, done;
  domLength strlen, bytesread;

  char s[255], buf[8*1024];
  int fd;
  XML_Parser  parser;
  Tcl_Channel channel = NULL;
  CHandlerSet *activeCHandlerSet;
  Tcl_Obj       *bufObj = NULL;
  Tcl_DString    dStr;

  result = 1;
  switch (type) {

  case EXPAT_INPUT_STRING:
      expat->parsingState = 2;
      do {
          done = (len < PARSE_CHUNK_SIZE);
          result = XML_Parse(expat->parser, data, (int)len,
                             done ? expat->final : 0);
          if (!done) {
              data += PARSE_CHUNK_SIZE;
              len -= PARSE_CHUNK_SIZE;
          }
      } while (!done && result == XML_STATUS_OK);
      expat->parsingState = 1;

      else useBinary = 0;
      Tcl_DStringFree (&dStr);
      expat->parsingState = 2;
      if (useBinary) {
          do {
              bytesread = Tcl_Read (channel, buf, sizeof (buf));
              done = bytesread < sizeof (buf);
              result = XML_Parse (expat->parser, buf, (int)bytesread, done);
              if (result != XML_STATUS_OK) break;
          } while (!done);
      } else {
          bufObj = Tcl_NewObj();
          Tcl_IncrRefCount (bufObj);
          Tcl_SetObjLength (bufObj, 6144);
          do {
              len = Tcl_ReadChars (channel, bufObj, 1024, 0);
              done = (len < 1024);
              str = Tcl_GetStringFromObj (bufObj, &strlen);
              result = XML_Parse (expat->parser, str, (int)strlen, done);
              if (result != XML_STATUS_OK) break;
          } while (!done);
          /* In case of a parsing error we need the string rep of the
             bufObj until the error reporting is done (otherwise,
             calling XML_GetCurrentLineNumber() results in invalid mem
             reads */
          if (result) {

              close (fd);
              Tcl_ResetResult (interp);
              Tcl_AppendResult (interp, "error reading from file \"",
                                data, "\"", (char *) NULL);
              expat->parsingState = 1;
              return TCL_ERROR;
          }
          result = XML_ParseBuffer (parser, (int)nread, nread == 0);
          if (result != XML_STATUS_OK || !nread) {
              close (fd);
              break;
          }
      }
      expat->parsingState = 1;
      break;

      EXPAT_PARAMENTITYPARSINGALWAYS,
      EXPAT_PARAMENTITYPARSINGNEVER,
      EXPAT_PARAMENTITYPARSINGNOTSTANDALONE
  };
  int optionIndex, value, bool;
  Tcl_Obj *const *objPtr = objv;
  Tcl_CmdInfo cmdInfo;
  int rc;
  domLength len;
  char *handlerSetName = NULL;
  TclHandlerSet *tmpTclHandlerSet, *activeTclHandlerSet = NULL;
  Tcl_UniChar uniChar;
  double maximumAmplification;
  long activationThreshold;
#ifndef TDOM_NO_SCHEMA
  char *schemacmd;

        SetIntResult (interp, expat->ns_mode);
        return TCL_OK;

      case EXPAT_NAMESPACESEPARATOR: /* -namespaceseparator */

        if (expat->nsSeparator) {
            uniChar = expat->nsSeparator;
            len = (int) Tcl_UniCharToUtf (uniChar, utfBuf);
            Tcl_DStringInit (&dStr);
            Tcl_DStringAppend (&dStr, utfBuf, len);
            Tcl_DStringResult (interp, &dStr);
            Tcl_DStringFree (&dStr);
        }
        return TCL_OK;

      }

      dataStr = Tcl_GetStringFromObj (dataObj, &tclLen);
      switch (inputType) {
      case EXPAT_INPUT_STRING:
          do {
              done = (tclLen < PARSE_CHUNK_SIZE);
              result = XML_Parse(extparser, dataStr, (int)tclLen, done);
              if (!done) {
                  dataStr += PARSE_CHUNK_SIZE;
                  tclLen -= PARSE_CHUNK_SIZE;
              }
          } while (!done && result == XML_STATUS_OK);
          break;

              expat->parser = oldparser;
              return 0;
          }
          result = 1;
          do {
              len = Tcl_Read (chan, buf, sizeof (buf));
              done = len < sizeof (buf);
              result = XML_Parse (extparser, buf, (int)len, done);
              if (result != XML_STATUS_OK) break;
          } while (!done);
          Tcl_UnregisterChannel (expat->interp, chan);
          break;

      case EXPAT_INPUT_FILENAME:
          fd = open(dataStr, O_BINARY|O_RDONLY);

                  Tcl_AppendResult (expat->interp,
                                    "error reading from file \"",
                                    dataStr, "\"", (char *) NULL);
                  TclExpatHandlerResult (expat, activeTclHandlerSet,
                                         ERROR_IN_EXTREFHANDLER);
                  return 0;
              }
              result = XML_ParseBuffer (extparser, (int)nread, nread == 0);
              if (result != XML_STATUS_OK || !nread) {
                  close (fd);
                  break;
              }
          }
          break;
      }

|   written by Rolf Ade
|   February 2018
|
\---------------------------------------------------------------------------*/

#ifndef TDOM_NO_PULL

#include <dom.h>
#include <fcntl.h>
#ifdef _MSC_VER
#include <io.h>
#else
#include <unistd.h>
#endif

                                     pullInfo->channelReadBuf,
                                     1024, 0);
                done = (len < 1024);
                data = Tcl_GetStringFromObj (
                    pullInfo->channelReadBuf, &len
                    );
                result = XML_Parse (pullInfo->parser, data,
                                    (int)len, done);
            } while (result == XML_STATUS_OK && !done);
        } else {
            /* inputfile */
            do {
                char *fbuf = 
                    XML_GetBuffer (pullInfo->parser,
                                   TDOM_EXPAT_READ_SIZE);
                len = read (pullInfo->inputfd, fbuf,
                            TDOM_EXPAT_READ_SIZE);
                done = (len < TDOM_EXPAT_READ_SIZE);
                result = XML_ParseBuffer (pullInfo->parser,
                                          (int)len, done);
            } while (result == XML_STATUS_OK && !done);
        }
        if (result == XML_STATUS_ERROR) {
            tDOM_CleanupInputSource (pullInfo);
            tDOM_ReportXMLError (interp, pullInfo);
            pullInfo->state = PULLPARSERSTATE_PARSE_ERROR;
            return TCL_ERROR;

                    do {
                        char *fbuf =
                            XML_GetBuffer (pullInfo->parser,
                                           TDOM_EXPAT_READ_SIZE);
                        len = read(pullInfo->inputfd, fbuf,
                                   TDOM_EXPAT_READ_SIZE);
                        result = XML_ParseBuffer (pullInfo->parser,
                                                  (int)len, len == 0);
                    } while (result == XML_STATUS_OK);
                } else if (pullInfo->inputChannel) {
                    do {
                        len = Tcl_ReadChars (pullInfo->inputChannel,
                                             pullInfo->channelReadBuf,
                                             1024, 0);
                        data = Tcl_GetString (pullInfo->channelReadBuf);
                        result = XML_Parse (pullInfo->parser, data, (int)len,
                                            len == 0);
                    } while (result == XML_STATUS_OK);
                } else {
                    data = Tcl_GetStringFromObj(pullInfo->inputString, &len);
                    do {
                        done = (len < PARSE_CHUNK_SIZE);
                        result = XML_Parse (pullInfo->parser, data, (int)len,
                                            done);
                        if (!done) {
                            data += PARSE_CHUNK_SIZE;
                            len -= PARSE_CHUNK_SIZE;
                        }
                    } while (!done && result == XML_STATUS_OK);
                }
                switch (result) {