tDOM: Check-in [05a6175f48]

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

Overview

Comment:	Merged from trunk.
Downloads:	Tarball \| ZIP archive \| SQL archive
Timelines:	family \| ancestors \| descendants \| both \| schema
Files:	files \| file ages \| folders
SHA3-256:	05a6175f4899bb87acc42dd873289604666585f3888e0be92b7b23e9417cbc2b
User & Date:	rolf 2019-05-09 18:33:00

Context

2019-05-09
18:34		Test added. check-in: 968b411fd1 user: rolf tags: schema
18:33		Merged from trunk. check-in: 05a6175f48 user: rolf tags: schema
18:31		Reworked (and renamed) selectNodesNamespaces to make it usable from elsewhere and made it public. check-in: 4ca5de8963 user: rolf tags: trunk
2019-05-06
23:18		Added text constrain cmd base64. check-in: 68cd47d57c user: rolf tags: schema

Changes

Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tcldom.c.

    return TCL_OK;
}

/*----------------------------------------------------------------------------
|   selectNodesNamespaces
|
\---------------------------------------------------------------------------*/
static int selectNodesNamespaces (
    domDocument *doc,
    Tcl_Interp  *interp,
    int          objc,
    Tcl_Obj     *const objv[] 

    )
{

    int      len, i, result;
    Tcl_Obj *objPtr, *listPtr;

    CheckArgs (2,3,2, "?prefixUriList?");

    if (objc == 3) {












        result = Tcl_ListObjLength (interp, objv[2], &len);
        if (result != TCL_OK || (len % 2) != 0) {
            SetResult ("The optional argument to the selectNodesNamespaces"
                       " method must be a 'prefix namespace' pairs list");
            return TCL_ERROR;
        }
        i = 0;
        if (doc->prefixNSMappings) {
            while (doc->prefixNSMappings[i]) {
                FREE (doc->prefixNSMappings[i]);



                i++;
            }
        }





        if (i < len + 1) {
            if (doc->prefixNSMappings) FREE (doc->prefixNSMappings);

            doc->prefixNSMappings = MALLOC (sizeof (char*)*(len+1));

        }
        for (i = 0; i < len; i++) {
            Tcl_ListObjIndex (interp, objv[2], i, &objPtr);
            doc->prefixNSMappings[i] = tdomstrdup (Tcl_GetString (objPtr));
        }
        doc->prefixNSMappings[len] = NULL;
        Tcl_SetObjResult (interp, objv[2]);
    } else {
        listPtr = Tcl_NewListObj (0, NULL);
        i = 0;
        if (doc->prefixNSMappings) {
            while (doc->prefixNSMappings[i]) {
                objPtr = Tcl_NewStringObj (doc->prefixNSMappings[i], -1);
                Tcl_ListObjAppendElement (interp, listPtr, objPtr);
                i++;
            }
        }
        Tcl_SetObjResult (interp, listPtr);
    }
    return TCL_OK;
}

/*----------------------------------------------------------------------------
|   renameNodes
|
\---------------------------------------------------------------------------*/
................................................................................
            SetResult("DOCUMENT_NODE");
            return TCL_OK;

        case m_cdataSectionElements:
            return cdataSectionElements (doc, interp, objc, objv);

        case m_selectNodesNamespaces:

            return selectNodesNamespaces (doc, interp, objc, objv);

        case m_renameNode:
            return renameNodes (doc, interp, objc, objv);
            
        case m_deleteXPathCache:
            return deleteXPathCache (doc, interp, objc, objv);

        case m_appendChild:







|
|


|
>


>




>
|
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
<
<
<
<
>
>
>
|
|
|
>
>
>
>
>
|
<
>
|
>
|
|
|
|
|
|
|
<
<
<
<
<
<
<
<
<
<
<
<







 







>
|
|

    return TCL_OK;
}

/*----------------------------------------------------------------------------
|   selectNodesNamespaces
|
\---------------------------------------------------------------------------*/
int tcldom_prefixNSlist (
    char      ***prefixnsPtr,
    Tcl_Interp  *interp,
    int          objc,
    Tcl_Obj     *const objv[],
    const char  *methodName
    )
{
    char   **prefixns = *prefixnsPtr;
    int      len, i, result;
    Tcl_Obj *objPtr, *listPtr;

    CheckArgs (2,3,2, "?prefixUriList?");
    i = 0;
    if (objc == 2) {
        if (!prefixns) return TCL_OK;
        listPtr = Tcl_NewListObj (0, NULL);
        i = 0;
        while (prefixns[i]) {
            Tcl_ListObjAppendElement (
                interp, listPtr, Tcl_NewStringObj (prefixns[i], -1)
                );
            i++;
        }
        Tcl_SetObjResult (interp, listPtr);
        return TCL_OK;
    }
    result = Tcl_ListObjLength (interp, objv[2], &len);
    if (result != TCL_OK || (len % 2) != 0) {
        SetResult3 ("The optional argument to the ", methodName, 
                   " method must be a 'prefix namespace' pairs list");
        return TCL_ERROR;
    }




    if (prefixns) {
        while (prefixns[i]) {
            FREE (prefixns[i]);
            i++;
        }
    }
    if (len == 0) {
        FREE (prefixns);
        *prefixnsPtr = NULL;
        return TCL_OK;
    }
    if (i < len + 1) {

        if (prefixns) FREE (prefixns);
        prefixns = MALLOC (sizeof (char*) * (len+1));
        *prefixnsPtr = prefixns;
    }
    for (i = 0; i < len; i++) {
        Tcl_ListObjIndex (interp, objv[2], i, &objPtr);
        prefixns[i] = tdomstrdup (Tcl_GetString (objPtr));
    }
    prefixns[len] = NULL;
    Tcl_SetObjResult (interp, objv[2]);












    return TCL_OK;
}

/*----------------------------------------------------------------------------
|   renameNodes
|
\---------------------------------------------------------------------------*/
................................................................................
            SetResult("DOCUMENT_NODE");
            return TCL_OK;

        case m_cdataSectionElements:
            return cdataSectionElements (doc, interp, objc, objv);

        case m_selectNodesNamespaces:
            return tcldom_prefixNSlist (&(doc->prefixNSMappings), interp, objc,
                                        objv, "selectNodesNamespaces");
            
        case m_renameNode:
            return renameNodes (doc, interp, objc, objv);
            
        case m_deleteXPathCache:
            return deleteXPathCache (doc, interp, objc, objv);

        case m_appendChild:

Changes to generic/tcldom.h.

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);


void tcldom_initialize(void);

Tcl_ObjCmdProc tcldom_DomObjCmd;
Tcl_ObjCmdProc tcldom_DocObjCmd;
Tcl_ObjCmdProc tcldom_NodeObjCmd;
Tcl_ObjCmdProc TclExpatObjCmd;

|
>

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,
int tcldom_prefixNSlist (char ***prefixnsPtr, Tcl_Interp *interp, int objc,
                         Tcl_Obj *const objv[], const char *methodName);

void tcldom_initialize(void);

Tcl_ObjCmdProc tcldom_DomObjCmd;
Tcl_ObjCmdProc tcldom_DocObjCmd;
Tcl_ObjCmdProc tcldom_NodeObjCmd;
Tcl_ObjCmdProc TclExpatObjCmd;

Changes to tests/dom.test.

    dom createDocument test doc
    set result [catch {set doc foo} errMsg]
    lappend result $errMsg
    $doc delete
    unset doc
    set result
} {1 {can't set "doc": var is read-only}}














test dom-2.1 {Don't quash white space at start or end of non white space content} {
    set doc [dom parse {<root>
    some content
    </root>}]
    set root [$doc documentElement]
    $root text







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

    dom createDocument test doc
    set result [catch {set doc foo} errMsg]
    lappend result $errMsg
    $doc delete
    unset doc
    set result
} {1 {can't set "doc": var is read-only}}

test dom-1.25 {Doc var} {
    dom parse <test/> doc
    dom parse <test/> doc
    unset doc
} {}

test dom-1.26 {Doc var} {
    dom parse <test/> doc
    set result [catch {$doc documentElement doc}]
    unset doc
    set result
} {1}

test dom-2.1 {Don't quash white space at start or end of non white space content} {
    set doc [dom parse {<root>
    some content
    </root>}]
    set root [$doc documentElement]
    $root text

Changes to tests/loadtdom.tcl.

    # We still support 8.4 to some degree
    package require Tcl 8.4
} else {
    package require Tcl 8.4-
}
package require tcltest 2.2
namespace import ::tcltest::*


if {[catch {package require -exact tdom 0.9.2}]} {
    if {[catch {load [file join [file dir [info script]] ../unix/libtdom0.9.2.so]}]} {
        error "Unable to load the appropriate tDOM version!"
    }
}
if {[info commands ::tdom::xmlReadFile] == ""} {
    # tcldomsh without the script library. Source the lib.
    source [file join [file dir [info script]] ../lib tdom.tcl]
}

>
>

    # We still support 8.4 to some degree
    package require Tcl 8.4
} else {
    package require Tcl 8.4-
}
package require tcltest 2.2
namespace import ::tcltest::*
catch {tcltest::loadTestedCommands}

if {[catch {package require -exact tdom 0.9.2}]} {
    if {[catch {load [file join [file dir [info script]] ../unix/libtdom0.9.2.so]}]} {
        error "Unable to load the appropriate tDOM version!"
    }
}
if {[info commands ::tdom::xmlReadFile] == ""} {
    # tcldomsh without the script library. Source the lib.
    source [file join [file dir [info script]] ../lib tdom.tcl]
}