Welcome, guest | Sign In | My Account | Store | Cart

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.

Tcl, 63 lines
 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
Created by Patrick Finnegan on Thu, 26 Jun 2003 (MIT)
Tcl recipes (162)
Patrick Finnegan's recipes (56)

Required Modules

  • (none specified)

Other Information and Tasks