tDOM

Check-in [c5bd39ed92]
Login
Bounty program for improvements to Tcl and certain Tcl packages.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Added schema command validatechannel, which reads the data stream to validate from a tcl channel.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | schema
Files: files | file ages | folders
SHA3-256: c5bd39ed92cd7273a00ea4aa8f8fc405b54e7835b1e51dfee3644e31456c825f
User & Date: rolf 2020-01-02 02:19:22
Context
2020-01-03
00:52
Added documentation for the schema command method validatechannel. check-in: 1774aef03a user: rolf tags: schema
2020-01-02
02:19
Added schema command validatechannel, which reads the data stream to validate from a tcl channel. check-in: c5bd39ed92 user: rolf tags: schema
2020-01-01
23:53
Added some index keywords to the schema documentation. check-in: d2f4f6bacf user: rolf tags: schema
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/schema.c.

2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
....
2762
2763
2764
2765
2766
2767
2768
2769
































































2770
2771
2772
2773
2774
2775
2776
....
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804

3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
....
4163
4164
4165
4166
4167
4168
4169


































4170
4171
4172
4173
4174
4175
4176
    } else {
        result = TCL_OK;
    }
    sdata->parser = NULL;
    XML_ParserFree (parser);
    Tcl_DStringFree (&cdata);
    FREE (vdata.uri);
    while (sdata->stack) popStack (sdata);
    return result;
}

static int
validateFile (
    Tcl_Interp *interp,
    SchemaData *sdata,
................................................................................
        result = TCL_OK;
    }
cleanup:
    sdata->parser = NULL;
    XML_ParserFree (parser);
    Tcl_DStringFree (&cdata);
    FREE (vdata.uri);
    while (sdata->stack) popStack (sdata);
































































    return result;
}

static void
schemaxpathRSFree (
    xpathResultSet *rs
    )
................................................................................
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
    )
{
    int            methodIndex, keywordIndex, hnew, hnew1, patternIndex;
    int            result = TCL_OK, forwardDef = 0, i = 0, j;
    int            savedDefineToplevel, type, len;
    unsigned int   savedNumPatternList;
    SchemaData    *savedsdata = NULL, *sdata = (SchemaData *) clientData;
    Tcl_HashTable *hashTable;
    Tcl_HashEntry *h, *h1;
    SchemaCP      *pattern, *thiscp, *current = NULL;
    void          *namespacePtr, *savedNamespacePtr;
    char          *xmlstr, *errMsg;
    domDocument   *doc;
    domNode       *node;
    Tcl_Obj       *attData;


    static const char *schemaInstanceMethods[] = {
        "defelement", "defpattern", "start",    "event",        "delete",
        "reset",      "define",     "validate", "domvalidate",  "deftext",
        "info",       "reportcmd",  "prefixns", "validatefile",
        "defelementtype", NULL
    };
    enum schemaInstanceMethod {
        m_defelement, m_defpattern, m_start,    m_event,        m_delete,
        m_reset,      m_define,     m_validate, m_domvalidate,  m_deftext,
        m_info,       m_reportcmd,  m_prefixns, m_validatefile,
        m_defelementtype
    };

    static const char *eventKeywords[] = {
        "start", "end", "text", NULL
    };

    enum eventKeyword
................................................................................
        if (sdata->validationState != VALIDATION_READY) {
            SetResult ("The schema command is busy");
            return TCL_ERROR;
        }
        xmlstr = Tcl_GetString (objv[2]);
        if (validateFile (interp, sdata, xmlstr) == TCL_OK) {
            SetBooleanResult (1);


































            if (objc == 4) {
                Tcl_SetVar (interp, Tcl_GetString (objv[3]), "", 0);
            }
        } else {
            if (objc == 4) {
                Tcl_SetVar (interp, Tcl_GetString (objv[3]),
                            Tcl_GetStringResult (interp), 0);






<







 







|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|











>





|





|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







2671
2672
2673
2674
2675
2676
2677

2678
2679
2680
2681
2682
2683
2684
....
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
....
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
....
4227
4228
4229
4230
4231
4232
4233
4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
    } else {
        result = TCL_OK;
    }
    sdata->parser = NULL;
    XML_ParserFree (parser);
    Tcl_DStringFree (&cdata);
    FREE (vdata.uri);

    return result;
}

static int
validateFile (
    Tcl_Interp *interp,
    SchemaData *sdata,
................................................................................
        result = TCL_OK;
    }
cleanup:
    sdata->parser = NULL;
    XML_ParserFree (parser);
    Tcl_DStringFree (&cdata);
    FREE (vdata.uri);
    return result;
}

static int
validateChannel (
    Tcl_Interp *interp,
    SchemaData *sdata,
    Tcl_Channel channel
    )
{
    XML_Parser parser;
    char sep = '\xFF';
    ValidateMethodData vdata;
    Tcl_DString cdata;
    Tcl_Obj *resultObj, *bufObj;
    char sl[50], sc[50], *str;
    int result = TCL_OK, len, done, tclLen, rc;

    parser = XML_ParserCreate_MM (NULL, MEM_SUITE, &sep);
    vdata.interp = interp;
    vdata.sdata = sdata;
    vdata.parser = parser;
    sdata->parser = parser;
    Tcl_DStringInit (&cdata);
    vdata.cdata = &cdata;
    vdata.onlyWhiteSpace = 1;
    vdata.uri = (char *) MALLOC (URI_BUFFER_LEN_INIT);
    vdata.maxUriLen = URI_BUFFER_LEN_INIT;
    XML_SetUserData (parser, &vdata);
    XML_SetElementHandler (parser, startElement, endElement);
    XML_SetCharacterDataHandler (parser, characterDataHandler);

    bufObj = Tcl_NewObj();
    Tcl_SetObjLength (bufObj, 6144);
    do {
        len = Tcl_ReadChars (channel, bufObj, 1024, 0);
        done = (len < 1024);
        str = Tcl_GetStringFromObj(bufObj, &tclLen);
        rc = XML_Parse (parser, str, tclLen, done);
        if (rc != XML_STATUS_OK 
            || sdata->validationState == VALIDATION_ERROR) {
            resultObj = Tcl_NewObj ();
            sprintf(sl, "%ld", XML_GetCurrentLineNumber(parser));
            sprintf(sc, "%ld", XML_GetCurrentColumnNumber(parser));
            if (sdata->validationState == VALIDATION_ERROR) {
                Tcl_AppendStringsToObj (resultObj, "error \"",
                                        Tcl_GetStringResult (interp),
                                        "\" at line ", sl, " character ", sc,
                                        NULL);
            } else {
                Tcl_AppendStringsToObj (resultObj, "error \"",
                                        XML_ErrorString(XML_GetErrorCode(parser)),
                                        "\" at line ", sl, " character ", sc,
                                        NULL);
            }
            Tcl_SetObjResult (interp, resultObj);
            result = TCL_ERROR;
            break;
        }
    } while (!done);
    Tcl_DecrRefCount (bufObj);
    sdata->parser = NULL;
    XML_ParserFree (parser);
    Tcl_DStringFree (&cdata);
    FREE (vdata.uri);
    return result;
}

static void
schemaxpathRSFree (
    xpathResultSet *rs
    )
................................................................................
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
    )
{
    int            methodIndex, keywordIndex, hnew, hnew1, patternIndex;
    int            result = TCL_OK, forwardDef = 0, i = 0, j, mode;
    int            savedDefineToplevel, type, len;
    unsigned int   savedNumPatternList;
    SchemaData    *savedsdata = NULL, *sdata = (SchemaData *) clientData;
    Tcl_HashTable *hashTable;
    Tcl_HashEntry *h, *h1;
    SchemaCP      *pattern, *thiscp, *current = NULL;
    void          *namespacePtr, *savedNamespacePtr;
    char          *xmlstr, *errMsg;
    domDocument   *doc;
    domNode       *node;
    Tcl_Obj       *attData;
    Tcl_Channel  chan = NULL;

    static const char *schemaInstanceMethods[] = {
        "defelement", "defpattern", "start",    "event",        "delete",
        "reset",      "define",     "validate", "domvalidate",  "deftext",
        "info",       "reportcmd",  "prefixns", "validatefile",
        "validatechannel",          "defelementtype", NULL
    };
    enum schemaInstanceMethod {
        m_defelement, m_defpattern, m_start,    m_event,        m_delete,
        m_reset,      m_define,     m_validate, m_domvalidate,  m_deftext,
        m_info,       m_reportcmd,  m_prefixns, m_validatefile,
        m_validatechannel,          m_defelementtype
    };

    static const char *eventKeywords[] = {
        "start", "end", "text", NULL
    };

    enum eventKeyword
................................................................................
        if (sdata->validationState != VALIDATION_READY) {
            SetResult ("The schema command is busy");
            return TCL_ERROR;
        }
        xmlstr = Tcl_GetString (objv[2]);
        if (validateFile (interp, sdata, xmlstr) == TCL_OK) {
            SetBooleanResult (1);
            if (objc == 4) {
                Tcl_SetVar (interp, Tcl_GetString (objv[3]), "", 0);
            }
        } else {
            if (objc == 4) {
                Tcl_SetVar (interp, Tcl_GetString (objv[3]),
                            Tcl_GetStringResult (interp), 0);
            }
            if (sdata->evalError) {
                 result = TCL_ERROR;
            } else {
                SetBooleanResult (0);
            }
        }
        schemaReset (sdata);
        break;

    case m_validatechannel:
        CHECK_EVAL
        if (objc < 3 || objc > 4) {
            Tcl_WrongNumArgs (interp, 2, objv, "<channel> ?resultVarName?");
            return TCL_ERROR;
        }
        if (sdata->validationState != VALIDATION_READY) {
            SetResult ("The schema command is busy");
            return TCL_ERROR;
        }
        chan = Tcl_GetChannel(interp, Tcl_GetString (objv[2]), &mode);
        if (chan == NULL) {
            SetResult ("The channel argument isn't a tcl channel");
            return TCL_ERROR;
        }
        if (validateChannel (interp, sdata, chan) == TCL_OK) {
            SetBooleanResult (1);
            if (objc == 4) {
                Tcl_SetVar (interp, Tcl_GetString (objv[3]), "", 0);
            }
        } else {
            if (objc == 4) {
                Tcl_SetVar (interp, Tcl_GetString (objv[3]),
                            Tcl_GetStringResult (interp), 0);

Changes to generic/tcldom.c.

6482
6483
6484
6485
6486
6487
6488
6489
6490
6491
6492
6493
6494
6495
6496
        xml_string = NULL;
        xml_string_len = 0;
        if (takeSimpleParser || takeHTMLParser || takeJSONParser
#ifdef TDOM_HAVE_GUMBO
                || takeGUMBOParser
#endif
            ) {
            Tcl_AppendResult(interp, "simple, JSON or HTML parser(s) "
                             " don't support channel reading", NULL);
            return TCL_ERROR;
        }
        if (objc == 2) {
            newObjName = objv[1];
            setVariable = 1;
        }






|







6482
6483
6484
6485
6486
6487
6488
6489
6490
6491
6492
6493
6494
6495
6496
        xml_string = NULL;
        xml_string_len = 0;
        if (takeSimpleParser || takeHTMLParser || takeJSONParser
#ifdef TDOM_HAVE_GUMBO
                || takeGUMBOParser
#endif
            ) {
            Tcl_AppendResult(interp, "simple, JSON and HTML parser "
                             " don't support channel reading", NULL);
            return TCL_ERROR;
        }
        if (objc == 2) {
            newObjName = objv[1];
            setVariable = 1;
        }

Changes to tests/schema.test.

20
21
22
23
24
25
26

27
28
29
30
31
32
33
....
7174
7175
7176
7177
7178
7179
7180
7181
7182













7183
7184
7185
7186
7187
#    schema-17.*: info
#    schema-18.*: reportcmd
#    schema-19.*: keyspace
#    schema-20.*: domunique
#    schema-21.*: internal: buffers
#    schema-22.*: defelementtype, elementtype
#    schema-23.*: validatefile

#
# Copyright (c) 2018-2019 Rolf Ade.

source [file join [file dir [info script]] loadtdom.tcl]

if {[dom featureinfo schema]} {

................................................................................
test schema-23.1 {validatefile} {
    tdom::schema s
    s define {
        set fd [open [file join [file dir [info script]] ../doc/tmml.schema] r]
        eval [read $fd]
        close $fd
    }
    set result [s validatefile [file join [file dir [info script]] ../doc/schema.xml] errMsg]
    puts $errMsg













    s delete
    set result
} 1

}






>







 







|
|
>
>
>
>
>
>
>
>
>
>
>
>
>





20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
....
7175
7176
7177
7178
7179
7180
7181
7182
7183
7184
7185
7186
7187
7188
7189
7190
7191
7192
7193
7194
7195
7196
7197
7198
7199
7200
7201
#    schema-17.*: info
#    schema-18.*: reportcmd
#    schema-19.*: keyspace
#    schema-20.*: domunique
#    schema-21.*: internal: buffers
#    schema-22.*: defelementtype, elementtype
#    schema-23.*: validatefile
#    schema-24.*: validatechannel
#
# Copyright (c) 2018-2019 Rolf Ade.

source [file join [file dir [info script]] loadtdom.tcl]

if {[dom featureinfo schema]} {

................................................................................
test schema-23.1 {validatefile} {
    tdom::schema s
    s define {
        set fd [open [file join [file dir [info script]] ../doc/tmml.schema] r]
        eval [read $fd]
        close $fd
    }
    set result [s validatefile [file join [file dir [info script]] ../doc/schema.xml]]
    s delete
    set result
} 1

test schema-24.1 {validatechannel} {
    tdom::schema s
    s define {
        set fd [open [file join [file dir [info script]] ../doc/tmml.schema] r]
        eval [read $fd]
        close $fd
    }
    set fd [open [file join [file dir [info script]] ../doc/schema.xml] r]
    set result [s validatechannel $fd]
    close $fd
    s delete
    set result
} 1

}