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 freeThe 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>
}