This script validates XML files while recursively traversing a specified directory tree. It requires three packages fileutil, tnc and tdom. Tnc and tdom are not part of the standard Tcl distro.
Tdom is available from http://www.tdom.org/ Tdom tutorial is available from http://mini.net/tcl/1948
Tnc is included with tdom zip file. Tnc info at http://mini.net/tcl/4577 and http://www.tdom.org/tnc.html.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 | #
# Check xml files in target directory tree
#
package require fileutil
package require tnc
package require tdom
######################################
# Proc for Parser
######################################
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]"
} else {
regsub {^[a-zA-Z]+:} $systemId systemId
}
if {[catch {set fd [open $systemId]}]} {
return -code error \
-errorinfo "Failed to open external entity $systemId"
}
return [list channel $systemId $fd]
}
######################################
# Proc - checkxml
######################################
proc checkXml {xmlfile} {
set parser [expat -externalentitycommand externalEntityRefHandler \
-baseurl $xmlfile \
-paramentityparsing notstandalone]
catch {$parser parsefile $xmlfile} result_var
return $result_var
$parser reset
$parser free
}
######################################################
# Proc - check xmlfile syntax
######################################################
proc checkXmlFiles {xmlDir} {
puts "\n Base dir is $xmlDir\n"
set xmlFiles [::fileutil::find $xmlDir {string match *.xml*}]
foreach match $xmlFiles {
set r [checkXml $match]
if {$r == ""} {
continue
} else {
puts $match
puts $r
}
}
}
checkXmlFiles d:\\xmlDirectory1
checkXmlFiles d:\\xmlDirectory2
|
Tags: xml