Posted to tcl by colin at Fri Aug 05 02:25:34 GMT 2011view pretty
package require tdom package require fileutil proc domattrs {node} { set result {} foreach n [$node attributes] { set n [lindex $n 0] if {[catch {lappend result $n [$node getAttribute $n]} e eo]} { puts stderr "attr error: $e ($eo)" } } return $result } proc explore {node} { set type [$node nodeType] switch -- $type { ELEMENT_NODE { set name [$node nodeName] set attributes [$node attributes] switch -- $name { path - rect - circle - ellipse - line - polyline - polygon - image - use { puts "$node is a Graphic $name $type ($attributes)" set result [list $name {*}[domattrs $node]] set c {} foreach child [$node childNodes] { lappend c -[$child nodeName] [lindex [explore $child] 1] } if {[llength $c]} { lappend result $c } return $result } text - title - desc - script { set text [[$node firstChild] nodeValue] puts "$node is a $name $type ($text)" return [list $name {*}[domattrs $node] $text] } g - defs - symbol - clipPath - mask - pattern - marker - a - switch - svg { puts "$node is a Container $name $type ($attributes)" set c {} set m {} foreach child [$node childNodes] { set cname [$child nodeName] if {$cname in {title desc script}} { dict append m -$cname [lindex [explore $child] 1] } else { lappend c [explore $child] } } set result [list $name {*}$m {*}[domattrs $node]] if {[llength $c]} { lappend result $c } return $result } default { error "unknown node type $name ($attributes)" } } } default { error "unknown element type $type" } } } set XML [::fileutil::cat [lindex $argv 0]] set doc [dom parse $XML] set root [$doc documentElement] puts "R: [explore $root]" proc parse {} { package require tdom package require fileutil set XML [::fileutil::cat [lindex $argv 0]] set doc [dom parse $XML] set root [$doc documentElement] my explore $root }