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
}