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