Updated 2013-12-04 22:44:23 by de

Tcl package, XML DTD validation extension to tDOM. Usage example contributed by RS:
 package require tnc ;# implies tdom

 #---------------------------------------- modified from expat man page
 proc externalEntityRefHandler {base systemId publicId} {
    if {![regexp {^[/a-zA-Z]+:/} $systemId]}  {
        regsub {^[/a-zA-Z]+:} $base {} base
        set basedir [file dirname $base]
        set systemId "[set basedir]/[set systemId]"
    }
    regsub {^[/a-zA-Z]+:} $systemId "" systemId
    set fd [open $systemId]
    list channel $systemId $fd
 }

 set parser [expat -externalentitycommand externalEntityRefHandler\
                   -baseurl "file://[file join [pwd] $file]" \
                   -paramentityparsing always]
 tnc $parser enable
 foreach file [glob $argv] {
    if [file readable $file] {
        catch {$parser parsefile $file} res
        if {$res==""} {set res ok}
        puts $file:$res
        $parser reset
    }
 }
 $parser free

The externalEntityRefHandler is freely configurable by the user. From tDOM 0.7.5, a convenience proc will be included in the release (planned for mid November 2002).

dcd 2010-09-27. Here's an example of letting tnc do all the validation. The drawback is that if it fails, you generally have no idea why.
 
 # Test if an XML file can be validated against a DTD.
 # Input: DTD contents and the XML file contents
 proc validateXMLwithDTD {dtd_contents file_contents} {
 
    set all $dtd_contents
    append all $file_contents
 
    set parser [expat]
 
    # For tnc to validate:
    # - enable a parser with tnc
    # - parse an XML doc and its DTD
    # - use the created command to validate a dom tree
    tnc $parser enable
 
    if {[catch {$parser parse $all} err]} {
       # $err contains the reason for the error, either an xml
       # well-fomred error reported by expat or a validation
       # error reported by tnc, for more reporting.
       return "parse_error"
    }
    $parser free
    return "valid"
 }

and here's a test set for it.
set dtd_contents {
<!DOCTYPE test [
<!ELEMENT test (a|b)*>
<!ELEMENT a EMPTY>
<!ELEMENT c EMPTY>
<!ELEMENT b (c)*>

<!ATTLIST test id CDATA #REQUIRED>

<!ATTLIST a ts CDATA #REQUIRED>
<!ATTLIST a name CDATA #REQUIRED>

<!ATTLIST b name CDATA #REQUIRED>

<!ATTLIST c ts CDATA #REQUIRED>
<!ATTLIST c v CDATA #REQUIRED>
]>
}
set xml_contents {
<test id="test-one">
<a ts="today" name="a1"></a>
<b name="b1">
<c ts="yesterday" v="1"/>
<c ts="today" v="0"></c>
<c ts="tomorrow" v="1"/>
</b>
<a ts="tomorrow" name="a2"></a>
</test>
}